JsonRpcClient.hs

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