X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=Data%2FJsonRpc.hs;h=d8a22b3075fa4728a1a045b1f22ba9dbf3381b2b;hp=9b3ff48965fe47a3731567e70652831aae9e6ba7;hb=1391152d2dee843493e6c7d962b55474ac92f832;hpb=b8fcca7aff6b55c000b4bd4b6da352b23780d0c8

diff --git a/Data/JsonRpc.hs b/Data/JsonRpc.hs
index 9b3ff48..d8a22b3 100644
--- a/Data/JsonRpc.hs
+++ b/Data/JsonRpc.hs
@@ -3,8 +3,7 @@
 module JsonRpc  ( JsonRpcVersion(JsonRpcV1, JsonRpcV2)
                 , JsonRpcRequest
                 , JsonRpcNotification
-                , JsonRpcError
-                , JsonRpcResponse
+                , JsonRpcError(..)
                 , parseJsonRpc
                 ) where
 
@@ -44,11 +43,33 @@ 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 :: ByteString -> Either JsonRpcError JsonRpcResponse
+parseJsonRpc :: (FromJSON a) => ByteString -> Either JsonRpcError a
 parseJsonRpc _ = Left $ JsonRpcError (-1) "someerror" Nothing