1 {-# LANGUAGE OverloadedStrings #-}
3 module JsonRpc ( JsonRpcVersion(JsonRpcV1, JsonRpcV2)
10 import Data.ByteString.Lazy (ByteString)
11 import Control.Applicative ((<$>), (<*>), empty)
15 data JsonRpcVersion = JsonRpcV1 | JsonRpcV2
18 data JsonRpcRequest = JsonRpcRequest { jrpcVersion :: JsonRpcVersion
19 , jrpcReqMethod :: ByteString
20 , jrpcReqParams :: [ByteString]
21 , jrpcReqId :: ByteString
23 instance ToJSON JsonRpcRequest where
24 toJSON (JsonRpcRequest version method params id) =
25 let l = [ "method" .= method, "params" .= params, "id" .= id ]
28 JsonRpcV2 -> object $ ("jsonrpc" .= toJSON ("2.0" :: ByteString)):l
30 data JsonRpcNotification = JsonRpcNotification
31 { jrpcNtfVersion :: JsonRpcVersion
32 , jrpcNtfMethod :: ByteString
33 , jrpcNtfParams :: [ByteString]
35 instance ToJSON JsonRpcNotification where
36 toJSON (JsonRpcNotification version method params) =
37 let l = [ "method" .= method, "params" .= params ]
40 JsonRpcV2 -> object $ ("jsonrpc" .= toJSON ("2.0" :: ByteString)):l
42 data JsonRpcError = JsonRpcError { jrpcErrCode :: Int
43 , jrpcErrMessage :: ByteString
44 , jrpcErrData :: Maybe Value
46 instance FromJSON JsonRpcError where
47 parseJSON (Object o) = JsonRpcError
51 parseJSON x = return $ JsonRpcError
53 "Unparseable error object"
56 data JsonRpcResponse = JsonRpcResponse { jrpcRspResult :: Maybe Value
57 , jrpcRspError :: JsonRpcError
58 , jrpcRspId :: ByteString
60 instance FromJSON JsonRpcResponse where
61 parseJSON (Object o) = JsonRpcResponse
65 parseJSON x = return $ JsonRpcResponse
69 "Unparseable response object"
74 parseJsonRpc :: (FromJSON a) => ByteString -> Either JsonRpcError a
75 parseJsonRpc s = case (decode s :: Maybe JsonRpcResponse) of
76 Just (JsonRpcResponse result error id) ->
78 Just v -> case (fromJSON v) of
80 Error s -> Left $ JsonRpcError (-32900) "Unparseable result" Nothing
82 Nothing -> Left $ JsonRpcError (-32800) "Unparseable response" Nothing