X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=Data%2FJsonRpcClient.hs;fp=Data%2FJsonRpcClient.hs;h=0000000000000000000000000000000000000000;hp=6038695359b83a0131d96bf0219a13a976e043ce;hb=e8fbbca8429c42f84bab9e1ab14bb1ff52c5e4cd;hpb=9e72c063ba8c5d23ad3061d31098ce05dcfcc3cd diff --git a/Data/JsonRpcClient.hs b/Data/JsonRpcClient.hs deleted file mode 100644 index 6038695..0000000 --- a/Data/JsonRpcClient.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Data.JsonRpcClient - ( JsonRpcVersion(JsonRpcV1, JsonRpcV2) - , JsonRpcRequest(..) - , JsonRpcNotification - , JsonRpcError(..) - , parseJsonRpc - ) where - -import Data.ByteString.Lazy (ByteString) -import Control.Applicative ((<$>), (<*>), empty) -import Data.Either -import Data.Aeson - -data JsonRpcVersion = JsonRpcV1 | JsonRpcV2 - deriving (Show) - -data JsonRpcRequest = JsonRpcRequest { jrpcVersion :: JsonRpcVersion - , jrpcReqMethod :: ByteString - , jrpcReqParams :: [ByteString] - , jrpcReqId :: Value - } deriving (Show) -instance ToJSON JsonRpcRequest where - toJSON (JsonRpcRequest version method params id) = - let l = [ "method" .= method, "params" .= params, "id" .= id ] - in case version of - JsonRpcV1 -> object l - JsonRpcV2 -> object $ ("jsonrpc" .= toJSON ("2.0" :: ByteString)):l - -data JsonRpcNotification = JsonRpcNotification - { jrpcNtfVersion :: JsonRpcVersion - , jrpcNtfMethod :: ByteString - , jrpcNtfParams :: [ByteString] - } deriving (Show) -instance ToJSON JsonRpcNotification where - toJSON (JsonRpcNotification version method params) = - let l = [ "method" .= method, "params" .= params ] - in case version of - JsonRpcV1 -> object l - JsonRpcV2 -> object $ ("jsonrpc" .= toJSON ("2.0" :: ByteString)):l - -data JsonRpcError = JsonRpcError { jrpcErrCode :: Int - , jrpcErrMessage :: ByteString - , jrpcErrData :: Maybe Value - } deriving (Show) -instance FromJSON JsonRpcError where - parseJSON (Object o) = JsonRpcError - <$> o .: "code" - <*> o .: "message" - <*> o .:? "data" - parseJSON x = return $ JsonRpcError - (-32600) - "Unparseable error object" - (Just (toJSON x)) - -data JsonRpcResponse = JsonRpcResponse { jrpcRspResult :: Maybe Value - , jrpcRspError :: JsonRpcError - , jrpcRspId :: Value - } deriving (Show) -instance FromJSON JsonRpcResponse where - parseJSON (Object o) = JsonRpcResponse - <$> o .:? "result" - <*> o .: "error" - <*> o .: "id" - parseJSON x = return $ JsonRpcResponse - Nothing - (JsonRpcError - (-32700) - "Unparseable response object" - (Just (toJSON x)) - ) - (String "n/a") - -parseJsonRpc :: (FromJSON a) => ByteString -> Either JsonRpcError a -parseJsonRpc s = case (decode s :: Maybe JsonRpcResponse) of - Just (JsonRpcResponse result error id) -> - case result of - Just v -> case fromJSON v of - Success a -> Right a - Error s -> Left $ JsonRpcError (-32900) "Unparseable result" (Just v) - Nothing -> Left error - Nothing -> Left $ JsonRpcError (-32800) "Unparseable response" (Just (toJSON s))