wip JsonRpc version

[pdns-pipe-nmc.git] / Data / JsonRpc.hs

diff --git a/Data/JsonRpc.hs b/Data/JsonRpc.hs
index b1879bccef89f57638ad44a122ad2d93f1c892c1..79c21c349dcde14e791275a53bd5649d196ea07c 100644 (file)
--- a/Data/JsonRpc.hs
+++ b/Data/JsonRpc.hs
@@ -1,17 +1,30 @@
-module JsonRpc  ( JsonRpcRequest(..)
-                , JsonRpcNotification(..)
-                , JsonRpcResponse(..)
+{-# LANGUAGE OverloadedStrings #-}
+
+module JsonRpc  ( JsonRpcVersion(JsonRpcV1 ,JsonRpcV2)
+                , JsonRpcRequest
+                , JsonRpcNotification
+                , JsonRpcResponse
                 ) where
 
-import Data.ByteString (ByteString)
+import Data.ByteString.Lazy (ByteString)
 import Control.Applicative ((<$>), (<*>), empty)
 import Data.Aeson
 
-data JsonRpcRequest = JsonRpcRequest { jrpcReqMethod :: ByteString
-                                     , jrpcReqParams :: [ByteString]
-                                     , jrpcReqId     :: 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 { jrpcNtfMethod :: ByteString
                                                , jrpcNtfParams :: [ByteString]
                                                } deriving (Show)
@@ -25,5 +38,3 @@ data JsonRpcResponse = JsonRpcResponse { jrpcRspResult :: Maybe Value
                                        , jrpcRspError  :: JsonRpcError
                                        , jrpcRspId     :: ByteString
                                        } deriving (Show)
-
-