{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module MCP.Server.JsonRpc
  ( -- * JSON-RPC Types
    JsonRpcRequest(..)
  , JsonRpcResponse(..)
  , JsonRpcError(..)
  , JsonRpcNotification(..)
  , JsonRpcMessage(..)
  , RequestId(..)
  
    -- * JSON-RPC Functions
  , makeSuccessResponse
  , makeErrorResponse
  , makeNotification
  , parseJsonRpcMessage
  , encodeJsonRpcMessage
  ) where

import Data.Text (Text)
import Data.Aeson
import Data.Aeson.Types (parseEither)
import GHC.Generics (Generic)
import Control.Applicative ((<|>))

-- | JSON-RPC request ID
data RequestId
  = RequestIdText Text
  | RequestIdNumber Int
  | RequestIdNull
  deriving (Int -> RequestId -> ShowS
[RequestId] -> ShowS
RequestId -> String
(Int -> RequestId -> ShowS)
-> (RequestId -> String)
-> ([RequestId] -> ShowS)
-> Show RequestId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestId -> ShowS
showsPrec :: Int -> RequestId -> ShowS
$cshow :: RequestId -> String
show :: RequestId -> String
$cshowList :: [RequestId] -> ShowS
showList :: [RequestId] -> ShowS
Show, RequestId -> RequestId -> Bool
(RequestId -> RequestId -> Bool)
-> (RequestId -> RequestId -> Bool) -> Eq RequestId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestId -> RequestId -> Bool
== :: RequestId -> RequestId -> Bool
$c/= :: RequestId -> RequestId -> Bool
/= :: RequestId -> RequestId -> Bool
Eq, (forall x. RequestId -> Rep RequestId x)
-> (forall x. Rep RequestId x -> RequestId) -> Generic RequestId
forall x. Rep RequestId x -> RequestId
forall x. RequestId -> Rep RequestId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestId -> Rep RequestId x
from :: forall x. RequestId -> Rep RequestId x
$cto :: forall x. Rep RequestId x -> RequestId
to :: forall x. Rep RequestId x -> RequestId
Generic)

instance ToJSON RequestId where
  toJSON :: RequestId -> Value
toJSON (RequestIdText Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
  toJSON (RequestIdNumber Int
n) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
n
  toJSON RequestId
RequestIdNull = Value
Null

instance FromJSON RequestId where
  parseJSON :: Value -> Parser RequestId
parseJSON (String Text
t) = RequestId -> Parser RequestId
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestId -> Parser RequestId) -> RequestId -> Parser RequestId
forall a b. (a -> b) -> a -> b
$ Text -> RequestId
RequestIdText Text
t
  parseJSON (Number Scientific
n) = RequestId -> Parser RequestId
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestId -> Parser RequestId) -> RequestId -> Parser RequestId
forall a b. (a -> b) -> a -> b
$ Int -> RequestId
RequestIdNumber (Scientific -> Int
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n)
  parseJSON Value
Null = RequestId -> Parser RequestId
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return RequestId
RequestIdNull
  parseJSON Value
_ = String -> Parser RequestId
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid request ID"

-- | JSON-RPC request
data JsonRpcRequest = JsonRpcRequest
  { JsonRpcRequest -> Text
requestJsonrpc :: Text
  , JsonRpcRequest -> RequestId
requestId :: RequestId
  , JsonRpcRequest -> Text
requestMethod :: Text
  , JsonRpcRequest -> Maybe Value
requestParams :: Maybe Value
  } deriving (Int -> JsonRpcRequest -> ShowS
[JsonRpcRequest] -> ShowS
JsonRpcRequest -> String
(Int -> JsonRpcRequest -> ShowS)
-> (JsonRpcRequest -> String)
-> ([JsonRpcRequest] -> ShowS)
-> Show JsonRpcRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonRpcRequest -> ShowS
showsPrec :: Int -> JsonRpcRequest -> ShowS
$cshow :: JsonRpcRequest -> String
show :: JsonRpcRequest -> String
$cshowList :: [JsonRpcRequest] -> ShowS
showList :: [JsonRpcRequest] -> ShowS
Show, JsonRpcRequest -> JsonRpcRequest -> Bool
(JsonRpcRequest -> JsonRpcRequest -> Bool)
-> (JsonRpcRequest -> JsonRpcRequest -> Bool) -> Eq JsonRpcRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonRpcRequest -> JsonRpcRequest -> Bool
== :: JsonRpcRequest -> JsonRpcRequest -> Bool
$c/= :: JsonRpcRequest -> JsonRpcRequest -> Bool
/= :: JsonRpcRequest -> JsonRpcRequest -> Bool
Eq, (forall x. JsonRpcRequest -> Rep JsonRpcRequest x)
-> (forall x. Rep JsonRpcRequest x -> JsonRpcRequest)
-> Generic JsonRpcRequest
forall x. Rep JsonRpcRequest x -> JsonRpcRequest
forall x. JsonRpcRequest -> Rep JsonRpcRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonRpcRequest -> Rep JsonRpcRequest x
from :: forall x. JsonRpcRequest -> Rep JsonRpcRequest x
$cto :: forall x. Rep JsonRpcRequest x -> JsonRpcRequest
to :: forall x. Rep JsonRpcRequest x -> JsonRpcRequest
Generic)

instance ToJSON JsonRpcRequest where
  toJSON :: JsonRpcRequest -> Value
toJSON JsonRpcRequest
req = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"jsonrpc" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcRequest -> Text
requestJsonrpc JsonRpcRequest
req
    , Key
"id" Key -> RequestId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcRequest -> RequestId
requestId JsonRpcRequest
req
    , Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcRequest -> Text
requestMethod JsonRpcRequest
req
    ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Value -> [Pair]) -> Maybe Value -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Value
p -> [Key
"params" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
p]) (JsonRpcRequest -> Maybe Value
requestParams JsonRpcRequest
req)

instance FromJSON JsonRpcRequest where
  parseJSON :: Value -> Parser JsonRpcRequest
parseJSON = String
-> (Object -> Parser JsonRpcRequest)
-> Value
-> Parser JsonRpcRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JsonRpcRequest" ((Object -> Parser JsonRpcRequest)
 -> Value -> Parser JsonRpcRequest)
-> (Object -> Parser JsonRpcRequest)
-> Value
-> Parser JsonRpcRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> RequestId -> Text -> Maybe Value -> JsonRpcRequest
JsonRpcRequest
    (Text -> RequestId -> Text -> Maybe Value -> JsonRpcRequest)
-> Parser Text
-> Parser (RequestId -> Text -> Maybe Value -> JsonRpcRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
    Parser (RequestId -> Text -> Maybe Value -> JsonRpcRequest)
-> Parser RequestId
-> Parser (Text -> Maybe Value -> JsonRpcRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser RequestId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser (Text -> Maybe Value -> JsonRpcRequest)
-> Parser Text -> Parser (Maybe Value -> JsonRpcRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
    Parser (Maybe Value -> JsonRpcRequest)
-> Parser (Maybe Value) -> Parser JsonRpcRequest
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"

-- | JSON-RPC error
data JsonRpcError = JsonRpcError
  { JsonRpcError -> Int
errorCode :: Int
  , JsonRpcError -> Text
errorMessage :: Text
  , JsonRpcError -> Maybe Value
errorData :: Maybe Value
  } deriving (Int -> JsonRpcError -> ShowS
[JsonRpcError] -> ShowS
JsonRpcError -> String
(Int -> JsonRpcError -> ShowS)
-> (JsonRpcError -> String)
-> ([JsonRpcError] -> ShowS)
-> Show JsonRpcError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonRpcError -> ShowS
showsPrec :: Int -> JsonRpcError -> ShowS
$cshow :: JsonRpcError -> String
show :: JsonRpcError -> String
$cshowList :: [JsonRpcError] -> ShowS
showList :: [JsonRpcError] -> ShowS
Show, JsonRpcError -> JsonRpcError -> Bool
(JsonRpcError -> JsonRpcError -> Bool)
-> (JsonRpcError -> JsonRpcError -> Bool) -> Eq JsonRpcError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonRpcError -> JsonRpcError -> Bool
== :: JsonRpcError -> JsonRpcError -> Bool
$c/= :: JsonRpcError -> JsonRpcError -> Bool
/= :: JsonRpcError -> JsonRpcError -> Bool
Eq, (forall x. JsonRpcError -> Rep JsonRpcError x)
-> (forall x. Rep JsonRpcError x -> JsonRpcError)
-> Generic JsonRpcError
forall x. Rep JsonRpcError x -> JsonRpcError
forall x. JsonRpcError -> Rep JsonRpcError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonRpcError -> Rep JsonRpcError x
from :: forall x. JsonRpcError -> Rep JsonRpcError x
$cto :: forall x. Rep JsonRpcError x -> JsonRpcError
to :: forall x. Rep JsonRpcError x -> JsonRpcError
Generic)

instance ToJSON JsonRpcError where
  toJSON :: JsonRpcError -> Value
toJSON JsonRpcError
err = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"code" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcError -> Int
errorCode JsonRpcError
err
    , Key
"message" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcError -> Text
errorMessage JsonRpcError
err
    ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Value -> [Pair]) -> Maybe Value -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Value
d -> [Key
"data" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
d]) (JsonRpcError -> Maybe Value
errorData JsonRpcError
err)

instance FromJSON JsonRpcError where
  parseJSON :: Value -> Parser JsonRpcError
parseJSON = String
-> (Object -> Parser JsonRpcError) -> Value -> Parser JsonRpcError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JsonRpcError" ((Object -> Parser JsonRpcError) -> Value -> Parser JsonRpcError)
-> (Object -> Parser JsonRpcError) -> Value -> Parser JsonRpcError
forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Text -> Maybe Value -> JsonRpcError
JsonRpcError
    (Int -> Text -> Maybe Value -> JsonRpcError)
-> Parser Int -> Parser (Text -> Maybe Value -> JsonRpcError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
    Parser (Text -> Maybe Value -> JsonRpcError)
-> Parser Text -> Parser (Maybe Value -> JsonRpcError)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
    Parser (Maybe Value -> JsonRpcError)
-> Parser (Maybe Value) -> Parser JsonRpcError
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data"

-- | JSON-RPC response
data JsonRpcResponse = JsonRpcResponse
  { JsonRpcResponse -> Text
responseJsonrpc :: Text
  , JsonRpcResponse -> RequestId
responseId :: RequestId
  , JsonRpcResponse -> Maybe Value
responseResult :: Maybe Value
  , JsonRpcResponse -> Maybe JsonRpcError
responseError :: Maybe JsonRpcError
  } deriving (Int -> JsonRpcResponse -> ShowS
[JsonRpcResponse] -> ShowS
JsonRpcResponse -> String
(Int -> JsonRpcResponse -> ShowS)
-> (JsonRpcResponse -> String)
-> ([JsonRpcResponse] -> ShowS)
-> Show JsonRpcResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonRpcResponse -> ShowS
showsPrec :: Int -> JsonRpcResponse -> ShowS
$cshow :: JsonRpcResponse -> String
show :: JsonRpcResponse -> String
$cshowList :: [JsonRpcResponse] -> ShowS
showList :: [JsonRpcResponse] -> ShowS
Show, JsonRpcResponse -> JsonRpcResponse -> Bool
(JsonRpcResponse -> JsonRpcResponse -> Bool)
-> (JsonRpcResponse -> JsonRpcResponse -> Bool)
-> Eq JsonRpcResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonRpcResponse -> JsonRpcResponse -> Bool
== :: JsonRpcResponse -> JsonRpcResponse -> Bool
$c/= :: JsonRpcResponse -> JsonRpcResponse -> Bool
/= :: JsonRpcResponse -> JsonRpcResponse -> Bool
Eq, (forall x. JsonRpcResponse -> Rep JsonRpcResponse x)
-> (forall x. Rep JsonRpcResponse x -> JsonRpcResponse)
-> Generic JsonRpcResponse
forall x. Rep JsonRpcResponse x -> JsonRpcResponse
forall x. JsonRpcResponse -> Rep JsonRpcResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonRpcResponse -> Rep JsonRpcResponse x
from :: forall x. JsonRpcResponse -> Rep JsonRpcResponse x
$cto :: forall x. Rep JsonRpcResponse x -> JsonRpcResponse
to :: forall x. Rep JsonRpcResponse x -> JsonRpcResponse
Generic)

instance ToJSON JsonRpcResponse where
  toJSON :: JsonRpcResponse -> Value
toJSON JsonRpcResponse
resp = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"jsonrpc" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcResponse -> Text
responseJsonrpc JsonRpcResponse
resp
    , Key
"id" Key -> RequestId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcResponse -> RequestId
responseId JsonRpcResponse
resp
    ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ 
    [Pair] -> (Value -> [Pair]) -> Maybe Value -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Value
r -> [Key
"result" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
r]) (JsonRpcResponse -> Maybe Value
responseResult JsonRpcResponse
resp) [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
    [Pair] -> (JsonRpcError -> [Pair]) -> Maybe JsonRpcError -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\JsonRpcError
e -> [Key
"error" Key -> JsonRpcError -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcError
e]) (JsonRpcResponse -> Maybe JsonRpcError
responseError JsonRpcResponse
resp)

instance FromJSON JsonRpcResponse where
  parseJSON :: Value -> Parser JsonRpcResponse
parseJSON = String
-> (Object -> Parser JsonRpcResponse)
-> Value
-> Parser JsonRpcResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JsonRpcResponse" ((Object -> Parser JsonRpcResponse)
 -> Value -> Parser JsonRpcResponse)
-> (Object -> Parser JsonRpcResponse)
-> Value
-> Parser JsonRpcResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> RequestId
-> Maybe Value
-> Maybe JsonRpcError
-> JsonRpcResponse
JsonRpcResponse
    (Text
 -> RequestId
 -> Maybe Value
 -> Maybe JsonRpcError
 -> JsonRpcResponse)
-> Parser Text
-> Parser
     (RequestId -> Maybe Value -> Maybe JsonRpcError -> JsonRpcResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
    Parser
  (RequestId -> Maybe Value -> Maybe JsonRpcError -> JsonRpcResponse)
-> Parser RequestId
-> Parser (Maybe Value -> Maybe JsonRpcError -> JsonRpcResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser RequestId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    Parser (Maybe Value -> Maybe JsonRpcError -> JsonRpcResponse)
-> Parser (Maybe Value)
-> Parser (Maybe JsonRpcError -> JsonRpcResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"result"
    Parser (Maybe JsonRpcError -> JsonRpcResponse)
-> Parser (Maybe JsonRpcError) -> Parser JsonRpcResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe JsonRpcError)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error"

-- | JSON-RPC notification
data JsonRpcNotification = JsonRpcNotification
  { JsonRpcNotification -> Text
notificationJsonrpc :: Text
  , JsonRpcNotification -> Text
notificationMethod :: Text
  , JsonRpcNotification -> Maybe Value
notificationParams :: Maybe Value
  } deriving (Int -> JsonRpcNotification -> ShowS
[JsonRpcNotification] -> ShowS
JsonRpcNotification -> String
(Int -> JsonRpcNotification -> ShowS)
-> (JsonRpcNotification -> String)
-> ([JsonRpcNotification] -> ShowS)
-> Show JsonRpcNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonRpcNotification -> ShowS
showsPrec :: Int -> JsonRpcNotification -> ShowS
$cshow :: JsonRpcNotification -> String
show :: JsonRpcNotification -> String
$cshowList :: [JsonRpcNotification] -> ShowS
showList :: [JsonRpcNotification] -> ShowS
Show, JsonRpcNotification -> JsonRpcNotification -> Bool
(JsonRpcNotification -> JsonRpcNotification -> Bool)
-> (JsonRpcNotification -> JsonRpcNotification -> Bool)
-> Eq JsonRpcNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonRpcNotification -> JsonRpcNotification -> Bool
== :: JsonRpcNotification -> JsonRpcNotification -> Bool
$c/= :: JsonRpcNotification -> JsonRpcNotification -> Bool
/= :: JsonRpcNotification -> JsonRpcNotification -> Bool
Eq, (forall x. JsonRpcNotification -> Rep JsonRpcNotification x)
-> (forall x. Rep JsonRpcNotification x -> JsonRpcNotification)
-> Generic JsonRpcNotification
forall x. Rep JsonRpcNotification x -> JsonRpcNotification
forall x. JsonRpcNotification -> Rep JsonRpcNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonRpcNotification -> Rep JsonRpcNotification x
from :: forall x. JsonRpcNotification -> Rep JsonRpcNotification x
$cto :: forall x. Rep JsonRpcNotification x -> JsonRpcNotification
to :: forall x. Rep JsonRpcNotification x -> JsonRpcNotification
Generic)

instance ToJSON JsonRpcNotification where
  toJSON :: JsonRpcNotification -> Value
toJSON JsonRpcNotification
notif = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"jsonrpc" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcNotification -> Text
notificationJsonrpc JsonRpcNotification
notif
    , Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= JsonRpcNotification -> Text
notificationMethod JsonRpcNotification
notif
    ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (Value -> [Pair]) -> Maybe Value -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Value
p -> [Key
"params" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
p]) (JsonRpcNotification -> Maybe Value
notificationParams JsonRpcNotification
notif)

instance FromJSON JsonRpcNotification where
  parseJSON :: Value -> Parser JsonRpcNotification
parseJSON = String
-> (Object -> Parser JsonRpcNotification)
-> Value
-> Parser JsonRpcNotification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JsonRpcNotification" ((Object -> Parser JsonRpcNotification)
 -> Value -> Parser JsonRpcNotification)
-> (Object -> Parser JsonRpcNotification)
-> Value
-> Parser JsonRpcNotification
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Maybe Value -> JsonRpcNotification
JsonRpcNotification
    (Text -> Text -> Maybe Value -> JsonRpcNotification)
-> Parser Text
-> Parser (Text -> Maybe Value -> JsonRpcNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
    Parser (Text -> Maybe Value -> JsonRpcNotification)
-> Parser Text -> Parser (Maybe Value -> JsonRpcNotification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
    Parser (Maybe Value -> JsonRpcNotification)
-> Parser (Maybe Value) -> Parser JsonRpcNotification
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params"

-- | Union type for all JSON-RPC messages
data JsonRpcMessage
  = JsonRpcMessageRequest JsonRpcRequest
  | JsonRpcMessageResponse JsonRpcResponse
  | JsonRpcMessageNotification JsonRpcNotification
  deriving (Int -> JsonRpcMessage -> ShowS
[JsonRpcMessage] -> ShowS
JsonRpcMessage -> String
(Int -> JsonRpcMessage -> ShowS)
-> (JsonRpcMessage -> String)
-> ([JsonRpcMessage] -> ShowS)
-> Show JsonRpcMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonRpcMessage -> ShowS
showsPrec :: Int -> JsonRpcMessage -> ShowS
$cshow :: JsonRpcMessage -> String
show :: JsonRpcMessage -> String
$cshowList :: [JsonRpcMessage] -> ShowS
showList :: [JsonRpcMessage] -> ShowS
Show, JsonRpcMessage -> JsonRpcMessage -> Bool
(JsonRpcMessage -> JsonRpcMessage -> Bool)
-> (JsonRpcMessage -> JsonRpcMessage -> Bool) -> Eq JsonRpcMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonRpcMessage -> JsonRpcMessage -> Bool
== :: JsonRpcMessage -> JsonRpcMessage -> Bool
$c/= :: JsonRpcMessage -> JsonRpcMessage -> Bool
/= :: JsonRpcMessage -> JsonRpcMessage -> Bool
Eq, (forall x. JsonRpcMessage -> Rep JsonRpcMessage x)
-> (forall x. Rep JsonRpcMessage x -> JsonRpcMessage)
-> Generic JsonRpcMessage
forall x. Rep JsonRpcMessage x -> JsonRpcMessage
forall x. JsonRpcMessage -> Rep JsonRpcMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonRpcMessage -> Rep JsonRpcMessage x
from :: forall x. JsonRpcMessage -> Rep JsonRpcMessage x
$cto :: forall x. Rep JsonRpcMessage x -> JsonRpcMessage
to :: forall x. Rep JsonRpcMessage x -> JsonRpcMessage
Generic)

instance ToJSON JsonRpcMessage where
  toJSON :: JsonRpcMessage -> Value
toJSON (JsonRpcMessageRequest JsonRpcRequest
req) = JsonRpcRequest -> Value
forall a. ToJSON a => a -> Value
toJSON JsonRpcRequest
req
  toJSON (JsonRpcMessageResponse JsonRpcResponse
resp) = JsonRpcResponse -> Value
forall a. ToJSON a => a -> Value
toJSON JsonRpcResponse
resp
  toJSON (JsonRpcMessageNotification JsonRpcNotification
notif) = JsonRpcNotification -> Value
forall a. ToJSON a => a -> Value
toJSON JsonRpcNotification
notif

instance FromJSON JsonRpcMessage where
  parseJSON :: Value -> Parser JsonRpcMessage
parseJSON Value
v = Value -> Parser JsonRpcMessage
parseRequest Value
v Parser JsonRpcMessage
-> Parser JsonRpcMessage -> Parser JsonRpcMessage
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser JsonRpcMessage
parseResponse Value
v Parser JsonRpcMessage
-> Parser JsonRpcMessage -> Parser JsonRpcMessage
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser JsonRpcMessage
parseNotification Value
v
    where
      parseRequest :: Value -> Parser JsonRpcMessage
parseRequest = (JsonRpcRequest -> JsonRpcMessage)
-> Parser JsonRpcRequest -> Parser JsonRpcMessage
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonRpcRequest -> JsonRpcMessage
JsonRpcMessageRequest (Parser JsonRpcRequest -> Parser JsonRpcMessage)
-> (Value -> Parser JsonRpcRequest)
-> Value
-> Parser JsonRpcMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser JsonRpcRequest
forall a. FromJSON a => Value -> Parser a
parseJSON
      parseResponse :: Value -> Parser JsonRpcMessage
parseResponse = (JsonRpcResponse -> JsonRpcMessage)
-> Parser JsonRpcResponse -> Parser JsonRpcMessage
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonRpcResponse -> JsonRpcMessage
JsonRpcMessageResponse (Parser JsonRpcResponse -> Parser JsonRpcMessage)
-> (Value -> Parser JsonRpcResponse)
-> Value
-> Parser JsonRpcMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser JsonRpcResponse
forall a. FromJSON a => Value -> Parser a
parseJSON
      parseNotification :: Value -> Parser JsonRpcMessage
parseNotification = (JsonRpcNotification -> JsonRpcMessage)
-> Parser JsonRpcNotification -> Parser JsonRpcMessage
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonRpcNotification -> JsonRpcMessage
JsonRpcMessageNotification (Parser JsonRpcNotification -> Parser JsonRpcMessage)
-> (Value -> Parser JsonRpcNotification)
-> Value
-> Parser JsonRpcMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser JsonRpcNotification
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Create a successful JSON-RPC response
makeSuccessResponse :: RequestId -> Value -> JsonRpcResponse
makeSuccessResponse :: RequestId -> Value -> JsonRpcResponse
makeSuccessResponse RequestId
reqId Value
result = JsonRpcResponse
  { responseJsonrpc :: Text
responseJsonrpc = Text
"2.0"
  , responseId :: RequestId
responseId = RequestId
reqId
  , responseResult :: Maybe Value
responseResult = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
result
  , responseError :: Maybe JsonRpcError
responseError = Maybe JsonRpcError
forall a. Maybe a
Nothing
  }

-- | Create an error JSON-RPC response
makeErrorResponse :: RequestId -> JsonRpcError -> JsonRpcResponse
makeErrorResponse :: RequestId -> JsonRpcError -> JsonRpcResponse
makeErrorResponse RequestId
reqId JsonRpcError
err = JsonRpcResponse
  { responseJsonrpc :: Text
responseJsonrpc = Text
"2.0"
  , responseId :: RequestId
responseId = RequestId
reqId
  , responseResult :: Maybe Value
responseResult = Maybe Value
forall a. Maybe a
Nothing
  , responseError :: Maybe JsonRpcError
responseError = JsonRpcError -> Maybe JsonRpcError
forall a. a -> Maybe a
Just JsonRpcError
err
  }

-- | Create a JSON-RPC notification
makeNotification :: Text -> Maybe Value -> JsonRpcNotification
makeNotification :: Text -> Maybe Value -> JsonRpcNotification
makeNotification Text
method Maybe Value
params = JsonRpcNotification
  { notificationJsonrpc :: Text
notificationJsonrpc = Text
"2.0"
  , notificationMethod :: Text
notificationMethod = Text
method
  , notificationParams :: Maybe Value
notificationParams = Maybe Value
params
  }

-- | Parse a JSON-RPC message from bytes
parseJsonRpcMessage :: Value -> Either String JsonRpcMessage
parseJsonRpcMessage :: Value -> Either String JsonRpcMessage
parseJsonRpcMessage = (Value -> Parser JsonRpcMessage)
-> Value -> Either String JsonRpcMessage
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser JsonRpcMessage
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Encode a JSON-RPC message to bytes
encodeJsonRpcMessage :: JsonRpcMessage -> Value
encodeJsonRpcMessage :: JsonRpcMessage -> Value
encodeJsonRpcMessage = JsonRpcMessage -> Value
forall a. ToJSON a => a -> Value
toJSON