X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=Data%2FJsonRpc.hs;h=15b1d88e99d9e447ccb650b061707458350bfc0b;hp=64d184c72809f778a092cd82cd2ee14df075fadd;hb=a0ac4a88c7f48dac8e4a79d1b7ac17a19057d662;hpb=fd964990cb0ff04f9789dcff2aef520bd093c704

diff --git a/Data/JsonRpc.hs b/Data/JsonRpc.hs
index 64d184c..15b1d88 100644
--- a/Data/JsonRpc.hs
+++ b/Data/JsonRpc.hs
@@ -1,46 +1,82 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module JsonRpc  ( JsonRpcRequestV1
-                , JsonRpcRequestV2
+module JsonRpc  ( JsonRpcVersion(JsonRpcV1, JsonRpcV2)
+                , JsonRpcRequest
                 , JsonRpcNotification
-                , JsonRpcResponse
+                , JsonRpcError(..)
+                , parseJsonRpc
                 ) where
 
 import Data.ByteString.Lazy (ByteString)
 import Control.Applicative ((<$>), (<*>), empty)
+import Data.Either
 import Data.Aeson
 
-data JsonRpcRequestV1 = JsonRpcRequestV1 { jrpcReqMethod1  :: ByteString
-                                         , jrpcReqParams1  :: [ByteString]
-                                         , jrpcReqId1      :: ByteString
-                                         } deriving (Show)
-instance ToJSON JsonRpcRequestV1 where
-  toJSON (JsonRpcRequestV1 method params id) =
-    object [ "method"  .= method
-           , "params"  .= params
-           , "id"      .= id ]
-    
-data JsonRpcRequestV2 = JsonRpcRequestV2 { jrpcReqMethod2  :: ByteString
-                                         , jrpcReqParams2  :: [ByteString]
-                                         , jrpcReqId2      :: ByteString
-                                         } deriving (Show)
-instance ToJSON JsonRpcRequestV2 where
-  toJSON (JsonRpcRequestV2 jrpcReqMethod2 jrpcReqParams2 jrpcReqId2) =
-    object [ "jsonrpc" .= toJSON ("2.0" :: ByteString)
-           , "method"  .= jrpcReqMethod2
-           , "params"  .= jrpcReqParams2
-           , "id"      .= jrpcReqId2 ]
-
-data JsonRpcNotification = JsonRpcNotification { jrpcNtfMethod :: ByteString
-                                               , jrpcNtfParams :: [ByteString]
-                                               } deriving (Show)
+data JsonRpcVersion = JsonRpcV1 | JsonRpcV2
+        deriving (Show)
+
+data JsonRpcRequest = JsonRpcRequest { jrpcVersion    :: JsonRpcVersion
+                                     , jrpcReqMethod  :: ByteString
+                                     , jrpcReqParams  :: [ByteString]
+                                     , jrpcReqId      :: ByteString
+                                     } 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 .: "error"
+                                <*> o .: "data"
+  parseJSON x = return $ JsonRpcError
+                                (-32600)
+                                "Unparseable error object"
+                                Nothing
 
 data JsonRpcResponse = JsonRpcResponse { jrpcRspResult :: Maybe Value
                                        , jrpcRspError  :: JsonRpcError
                                        , jrpcRspId     :: ByteString
                                        } 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"
+                                        Nothing
+                                )
+                                ""
+
+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" Nothing
+      Nothing -> Left error
+  Nothing -> Left $ JsonRpcError (-32800) "Unparseable response" Nothing