Data/JsonRpc.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module JsonRpc  ( JsonRpcVersion(JsonRpcV1, JsonRpcV2)
   4                 , JsonRpcRequest
   5                 , JsonRpcNotification
   6                 , JsonRpcError(..)
   7                 , parseJsonRpc
   8                 ) where
   9
  10 import Data.ByteString.Lazy (ByteString)
  11 import Control.Applicative ((<$>), (<*>), empty)
  12 import Data.Either
  13 import Data.Aeson
  14
  15 data JsonRpcVersion = JsonRpcV1 | JsonRpcV2
  16         deriving (Show)
  17
  18 data JsonRpcRequest = JsonRpcRequest { jrpcVersion    :: JsonRpcVersion
  19                                      , jrpcReqMethod  :: ByteString
  20                                      , jrpcReqParams  :: [ByteString]
  21                                      , jrpcReqId      :: ByteString
  22                                      } deriving (Show)
  23 instance ToJSON JsonRpcRequest where
  24   toJSON (JsonRpcRequest version method params id) =
  25     let l = [ "method" .= method, "params" .= params, "id" .= id ]
  26     in case version of
  27       JsonRpcV1 -> object l
  28       JsonRpcV2 -> object $ ("jsonrpc" .= toJSON ("2.0" :: ByteString)):l
  29
  30 data JsonRpcNotification = JsonRpcNotification
  31                                      { jrpcNtfVersion :: JsonRpcVersion
  32                                      , jrpcNtfMethod  :: ByteString
  33                                      , jrpcNtfParams  :: [ByteString]
  34                                      } deriving (Show)
  35 instance ToJSON JsonRpcNotification where
  36   toJSON (JsonRpcNotification version method params) =
  37     let l = [ "method" .= method, "params" .= params ]
  38     in case version of
  39       JsonRpcV1 -> object l
  40       JsonRpcV2 -> object $ ("jsonrpc" .= toJSON ("2.0" :: ByteString)):l
  41
  42 data JsonRpcError = JsonRpcError { jrpcErrCode    :: Int
  43                                  , jrpcErrMessage :: ByteString
  44                                  , jrpcErrData    :: Maybe Value
  45                                  } deriving (Show)
  46 instance FromJSON JsonRpcError where
  47   parseJSON (Object o) = JsonRpcError
  48                                 <$> o .: "code"
  49                                 <*> o .: "error"
  50                                 <*> o .: "data"
  51   parseJSON x = return $ JsonRpcError
  52                                 (-32600)
  53                                 "Unparseable error object"
  54                                 Nothing
  55
  56 data JsonRpcResponse = JsonRpcResponse { jrpcRspResult :: Maybe Value
  57                                        , jrpcRspError  :: JsonRpcError
  58                                        , jrpcRspId     :: ByteString
  59                                        } deriving (Show)
  60 instance FromJSON JsonRpcResponse where
  61   parseJSON (Object o) = JsonRpcResponse
  62                                 <$> o .: "result"
  63                                 <*> o .: "error"
  64                                 <*> o .: "id"
  65   parseJSON x = return $ JsonRpcResponse
  66                                 Nothing
  67                                 (JsonRpcError
  68                                         (-32700)
  69                                         "Unparseable response object"
  70                                         Nothing
  71                                 )
  72                                 ""
  73
  74 parseJsonRpc :: (FromJSON a) => ByteString -> Either JsonRpcError a
  75 parseJsonRpc s = case (decode s :: Maybe JsonRpcResponse) of
  76   Just (JsonRpcResponse result error id) ->
  77     case result of
  78       Just v -> case (fromJSON v) of
  79         Success a -> Right a
  80         Error s   -> Left $ JsonRpcError (-32900) "Unparseable result" Nothing
  81       Nothing -> Left error
  82   Nothing -> Left $ JsonRpcError (-32800) "Unparseable response" Nothing