From: Eugene Crosser Date: Thu, 27 Mar 2014 21:57:05 +0000 (+0400) Subject: move Json to top dir X-Git-Tag: 0.9.0.0~116 X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=commitdiff_plain;h=e8fbbca8429c42f84bab9e1ab14bb1ff52c5e4cd move Json to top dir --- 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)) diff --git a/JsonRpcClient.hs b/JsonRpcClient.hs new file mode 100644 index 0000000..c66516d --- /dev/null +++ b/JsonRpcClient.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +module 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)) diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs index d374911..f61d7ba 100644 --- a/pdns-pipe-nmc.hs +++ b/pdns-pipe-nmc.hs @@ -11,8 +11,8 @@ import Data.Aeson (encode, decode, Value(..)) import Network.HTTP.Types import Data.Conduit import Network.HTTP.Conduit -import Data.JsonRpcClient +import JsonRpcClient import Config import PowerDns import NmcJson