{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Module: Servant.JsonRpc

Work with JSON-RPC protocol messages at both type and value level.

> type Mul = JsonRpc "mul" (Int, Int) String Int
>
> req :: Request (Int, Int)
> req = Request "mul" (3, 5) (Just 0)
>
> rsp :: JsonRpcResponse String Int
> rsp = Result 0 15
-}
module Servant.JsonRpc (
  -- * API specification types
  RawJsonRpc,
  JsonRpc,
  JsonRpcNotification,
  JSONRPC,

  -- * JSON-RPC messages
  Request (..),
  JsonRpcResponse (..),
  JsonRpcErr (..),

  -- ** Standard error codes
  parseErrorCode,
  invalidRequestCode,
  methodNotFoundCode,
  invalidParamsCode,
  internalErrorCode,

  -- * Type rewriting
  JsonRpcEndpoint,
) where

import Control.Applicative (liftA3, (<|>))
import Data.Aeson (
  FromJSON (..),
  ToJSON (..),
  Value (Null),
  object,
  withObject,
  (.:),
  (.:?),
  (.=),
 )
import Data.Aeson.Types (Parser)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isNothing)
import Data.Proxy (Proxy (..))
import Data.Text.Read (decimal)
import Data.Word (Word64)
import GHC.TypeLits (Symbol)
import Network.HTTP.Media ((//))
import Servant.API (
  Accept (..),
  JSON,
  MimeRender (..),
  MimeUnrender (..),
  NoContent,
  Post,
  ReqBody,
  (:>),
 )

-- | Client messages
data Request p
  = Request
  { forall p. Request p -> String
method :: String
  , forall p. Request p -> p
params :: p
  , forall p. Request p -> Maybe Word64
requestId :: Maybe Word64
  -- ^ should be omitted only if the message is a notification, with no response content
  }
  deriving (Request p -> Request p -> Bool
(Request p -> Request p -> Bool)
-> (Request p -> Request p -> Bool) -> Eq (Request p)
forall p. Eq p => Request p -> Request p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. Eq p => Request p -> Request p -> Bool
== :: Request p -> Request p -> Bool
$c/= :: forall p. Eq p => Request p -> Request p -> Bool
/= :: Request p -> Request p -> Bool
Eq, Int -> Request p -> ShowS
[Request p] -> ShowS
Request p -> String
(Int -> Request p -> ShowS)
-> (Request p -> String)
-> ([Request p] -> ShowS)
-> Show (Request p)
forall p. Show p => Int -> Request p -> ShowS
forall p. Show p => [Request p] -> ShowS
forall p. Show p => Request p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Show p => Int -> Request p -> ShowS
showsPrec :: Int -> Request p -> ShowS
$cshow :: forall p. Show p => Request p -> String
show :: Request p -> String
$cshowList :: forall p. Show p => [Request p] -> ShowS
showList :: [Request p] -> ShowS
Show)

instance (ToJSON p) => ToJSON (Request p) where
  toJSON :: Request p -> Value
toJSON (Request String
m p
p Maybe Word64
ix) =
    [Pair] -> Value
object
      ([Pair] -> Value) -> ([Pair] -> [Pair]) -> [Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Pair] -> [Pair])
-> (Word64 -> [Pair] -> [Pair]) -> Maybe Word64 -> [Pair] -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Pair] -> [Pair]
forall a. a -> a
id (Key -> Word64 -> [Pair] -> [Pair]
forall {e} {a} {v}.
(KeyValue e a, ToJSON v) =>
Key -> v -> [a] -> [a]
onValue Key
"id") Maybe Word64
ix
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"jsonrpc" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"2.0" :: String)
        , Key
"method" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
m
        , Key
"params" Key -> p -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= p
p
        ]
   where
    onValue :: Key -> v -> [a] -> [a]
onValue Key
n v
v = ((Key
n Key -> v -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
v) a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

instance (FromJSON p) => FromJSON (Request p) where
  parseJSON :: Value -> Parser (Request p)
parseJSON = String
-> (Object -> Parser (Request p)) -> Value -> Parser (Request p)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JsonRpc Request" ((Object -> Parser (Request p)) -> Value -> Parser (Request p))
-> (Object -> Parser (Request p)) -> Value -> Parser (Request p)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Maybe Word64
ix <- Object
obj Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
    String
m <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
    p
p <- Object
obj Object -> Key -> Parser p
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
    Maybe String
v <- Object
obj Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"

    Maybe String -> Parser (Request p) -> Parser (Request p)
forall a. Maybe String -> Parser a -> Parser a
versionGuard Maybe String
v (Parser (Request p) -> Parser (Request p))
-> (Request p -> Parser (Request p))
-> Request p
-> Parser (Request p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request p -> Parser (Request p)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request p -> Parser (Request p))
-> Request p -> Parser (Request p)
forall a b. (a -> b) -> a -> b
$ String -> p -> Maybe Word64 -> Request p
forall p. String -> p -> Maybe Word64 -> Request p
Request String
m p
p Maybe Word64
ix

versionGuard :: Maybe String -> Parser a -> Parser a
versionGuard :: forall a. Maybe String -> Parser a -> Parser a
versionGuard Maybe String
v Parser a
x
  | Maybe String
v Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"2.0" = Parser a
x
  | Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
v = Parser a
x
  | Bool
otherwise = String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown version"

{- | Server messages.  An 'Ack' is a message which refers to a 'Request' but
both its "errors" and "result" keys are null
-}
data JsonRpcResponse e r
  = Result Word64 r
  | Ack Word64
  | Errors (Maybe Word64) (JsonRpcErr e)
  deriving (JsonRpcResponse e r -> JsonRpcResponse e r -> Bool
(JsonRpcResponse e r -> JsonRpcResponse e r -> Bool)
-> (JsonRpcResponse e r -> JsonRpcResponse e r -> Bool)
-> Eq (JsonRpcResponse e r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e r.
(Eq r, Eq e) =>
JsonRpcResponse e r -> JsonRpcResponse e r -> Bool
$c== :: forall e r.
(Eq r, Eq e) =>
JsonRpcResponse e r -> JsonRpcResponse e r -> Bool
== :: JsonRpcResponse e r -> JsonRpcResponse e r -> Bool
$c/= :: forall e r.
(Eq r, Eq e) =>
JsonRpcResponse e r -> JsonRpcResponse e r -> Bool
/= :: JsonRpcResponse e r -> JsonRpcResponse e r -> Bool
Eq, Int -> JsonRpcResponse e r -> ShowS
[JsonRpcResponse e r] -> ShowS
JsonRpcResponse e r -> String
(Int -> JsonRpcResponse e r -> ShowS)
-> (JsonRpcResponse e r -> String)
-> ([JsonRpcResponse e r] -> ShowS)
-> Show (JsonRpcResponse e r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e r. (Show r, Show e) => Int -> JsonRpcResponse e r -> ShowS
forall e r. (Show r, Show e) => [JsonRpcResponse e r] -> ShowS
forall e r. (Show r, Show e) => JsonRpcResponse e r -> String
$cshowsPrec :: forall e r. (Show r, Show e) => Int -> JsonRpcResponse e r -> ShowS
showsPrec :: Int -> JsonRpcResponse e r -> ShowS
$cshow :: forall e r. (Show r, Show e) => JsonRpcResponse e r -> String
show :: JsonRpcResponse e r -> String
$cshowList :: forall e r. (Show r, Show e) => [JsonRpcResponse e r] -> ShowS
showList :: [JsonRpcResponse e r] -> ShowS
Show)

data JsonRpcErr e = JsonRpcErr
  { forall e. JsonRpcErr e -> Int
errorCode :: Int
  , forall e. JsonRpcErr e -> String
errorMessage :: String
  , forall e. JsonRpcErr e -> Maybe e
errorData :: Maybe e
  }
  deriving (JsonRpcErr e -> JsonRpcErr e -> Bool
(JsonRpcErr e -> JsonRpcErr e -> Bool)
-> (JsonRpcErr e -> JsonRpcErr e -> Bool) -> Eq (JsonRpcErr e)
forall e. Eq e => JsonRpcErr e -> JsonRpcErr e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => JsonRpcErr e -> JsonRpcErr e -> Bool
== :: JsonRpcErr e -> JsonRpcErr e -> Bool
$c/= :: forall e. Eq e => JsonRpcErr e -> JsonRpcErr e -> Bool
/= :: JsonRpcErr e -> JsonRpcErr e -> Bool
Eq, Int -> JsonRpcErr e -> ShowS
[JsonRpcErr e] -> ShowS
JsonRpcErr e -> String
(Int -> JsonRpcErr e -> ShowS)
-> (JsonRpcErr e -> String)
-> ([JsonRpcErr e] -> ShowS)
-> Show (JsonRpcErr e)
forall e. Show e => Int -> JsonRpcErr e -> ShowS
forall e. Show e => [JsonRpcErr e] -> ShowS
forall e. Show e => JsonRpcErr e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> JsonRpcErr e -> ShowS
showsPrec :: Int -> JsonRpcErr e -> ShowS
$cshow :: forall e. Show e => JsonRpcErr e -> String
show :: JsonRpcErr e -> String
$cshowList :: forall e. Show e => [JsonRpcErr e] -> ShowS
showList :: [JsonRpcErr e] -> ShowS
Show)

parseErrorCode :: Int
parseErrorCode :: Int
parseErrorCode = -Int
32700

invalidRequestCode :: Int
invalidRequestCode :: Int
invalidRequestCode = -Int
32600

methodNotFoundCode :: Int
methodNotFoundCode :: Int
methodNotFoundCode = -Int
32601

invalidParamsCode :: Int
invalidParamsCode :: Int
invalidParamsCode = -Int
32602

internalErrorCode :: Int
internalErrorCode :: Int
internalErrorCode = -Int
32603

instance (FromJSON e, FromJSON r) => FromJSON (JsonRpcResponse e r) where
  parseJSON :: Value -> Parser (JsonRpcResponse e r)
parseJSON = String
-> (Object -> Parser (JsonRpcResponse e r))
-> Value
-> Parser (JsonRpcResponse e r)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Response" ((Object -> Parser (JsonRpcResponse e r))
 -> Value -> Parser (JsonRpcResponse e r))
-> (Object -> Parser (JsonRpcResponse e r))
-> Value
-> Parser (JsonRpcResponse e r)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Maybe Word64
ix <- Object
obj Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" Parser (Maybe Word64)
-> Parser (Maybe Word64) -> Parser (Maybe Word64)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" Parser (Maybe Text)
-> (Maybe Text -> Parser (Maybe Word64)) -> Parser (Maybe Word64)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> Parser (Maybe Word64)
parseDecimalString)
    Maybe String
version <- Object
obj Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jsonrpc"
    Maybe r
result <- Object
obj Object -> Key -> Parser (Maybe r)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"result"
    Maybe Value
err <- Object
obj Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error"
    Maybe String
-> Parser (JsonRpcResponse e r) -> Parser (JsonRpcResponse e r)
forall a. Maybe String -> Parser a -> Parser a
versionGuard Maybe String
version (Parser (JsonRpcResponse e r) -> Parser (JsonRpcResponse e r))
-> Parser (JsonRpcResponse e r) -> Parser (JsonRpcResponse e r)
forall a b. (a -> b) -> a -> b
$ Maybe Word64
-> Maybe r -> Maybe Value -> Parser (JsonRpcResponse e r)
pack Maybe Word64
ix Maybe r
result Maybe Value
err
   where
    parseDecimalString :: Maybe Text -> Parser (Maybe Word64)
parseDecimalString = (String -> Parser (Maybe Word64))
-> (Maybe (Word64, Text) -> Parser (Maybe Word64))
-> Either String (Maybe (Word64, Text))
-> Parser (Maybe Word64)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (Maybe Word64)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Maybe Word64 -> Parser (Maybe Word64)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word64 -> Parser (Maybe Word64))
-> (Maybe (Word64, Text) -> Maybe Word64)
-> Maybe (Word64, Text)
-> Parser (Maybe Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, Text) -> Word64) -> Maybe (Word64, Text) -> Maybe Word64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64, Text) -> Word64
forall a b. (a, b) -> a
fst) (Either String (Maybe (Word64, Text)) -> Parser (Maybe Word64))
-> (Maybe Text -> Either String (Maybe (Word64, Text)))
-> Maybe Text
-> Parser (Maybe Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either String (Word64, Text))
-> Maybe Text -> Either String (Maybe (Word64, Text))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Text -> Either String (Word64, Text)
forall a. Integral a => Reader a
decimal

    pack :: Maybe Word64
-> Maybe r -> Maybe Value -> Parser (JsonRpcResponse e r)
pack (Just Word64
ix) (Just r
r) Maybe Value
Nothing = JsonRpcResponse e r -> Parser (JsonRpcResponse e r)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JsonRpcResponse e r -> Parser (JsonRpcResponse e r))
-> JsonRpcResponse e r -> Parser (JsonRpcResponse e r)
forall a b. (a -> b) -> a -> b
$ Word64 -> r -> JsonRpcResponse e r
forall e r. Word64 -> r -> JsonRpcResponse e r
Result Word64
ix r
r
    pack Maybe Word64
ix Maybe r
Nothing (Just Value
e) = Maybe Word64 -> JsonRpcErr e -> JsonRpcResponse e r
forall e r. Maybe Word64 -> JsonRpcErr e -> JsonRpcResponse e r
Errors Maybe Word64
ix (JsonRpcErr e -> JsonRpcResponse e r)
-> Parser (JsonRpcErr e) -> Parser (JsonRpcResponse e r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (JsonRpcErr e)
parseErr Value
e
    pack (Just Word64
ix) Maybe r
Nothing Maybe Value
Nothing = JsonRpcResponse e r -> Parser (JsonRpcResponse e r)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JsonRpcResponse e r -> Parser (JsonRpcResponse e r))
-> JsonRpcResponse e r -> Parser (JsonRpcResponse e r)
forall a b. (a -> b) -> a -> b
$ Word64 -> JsonRpcResponse e r
forall e r. Word64 -> JsonRpcResponse e r
Ack Word64
ix
    pack Maybe Word64
_ Maybe r
_ Maybe Value
_ = String -> Parser (JsonRpcResponse e r)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid response"

    parseErr :: Value -> Parser (JsonRpcErr e)
parseErr =
      String
-> (Object -> Parser (JsonRpcErr e))
-> Value
-> Parser (JsonRpcErr e)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Error" ((Object -> Parser (JsonRpcErr e))
 -> Value -> Parser (JsonRpcErr e))
-> (Object -> Parser (JsonRpcErr e))
-> Value
-> Parser (JsonRpcErr e)
forall a b. (a -> b) -> a -> b
$
        (Int -> String -> Maybe e -> JsonRpcErr e)
-> Parser Int
-> Parser String
-> Parser (Maybe e)
-> Parser (JsonRpcErr e)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Int -> String -> Maybe e -> JsonRpcErr e
forall e. Int -> String -> Maybe e -> JsonRpcErr e
JsonRpcErr (Parser Int
 -> Parser String -> Parser (Maybe e) -> Parser (JsonRpcErr e))
-> (Object -> Parser Int)
-> Object
-> Parser String
-> Parser (Maybe e)
-> Parser (JsonRpcErr e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code") (Object
 -> Parser String -> Parser (Maybe e) -> Parser (JsonRpcErr e))
-> (Object -> Parser String)
-> Object
-> Parser (Maybe e)
-> Parser (JsonRpcErr e)
forall a b. (Object -> a -> b) -> (Object -> a) -> Object -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message") (Object -> Parser (Maybe e) -> Parser (JsonRpcErr e))
-> (Object -> Parser (Maybe e)) -> Object -> Parser (JsonRpcErr e)
forall a b. (Object -> a -> b) -> (Object -> a) -> Object -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object -> Key -> Parser (Maybe e)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data")

instance (ToJSON e, ToJSON r) => ToJSON (JsonRpcResponse e r) where
  toJSON :: JsonRpcResponse e r -> Value
toJSON (Result Word64
ix r
r) =
    [Pair] -> Value
object
      [ Key
"jsonrpc" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"2.0" :: String)
      , Key
"result" Key -> r -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= r
r
      , Key
"id" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
ix
      ]
  toJSON (Ack Word64
ix) =
    [Pair] -> Value
object
      [ Key
"jsonrpc" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"2.0" :: String)
      , Key
"id" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
ix
      , 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
Null
      , Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
Null
      ]
  toJSON (Errors Maybe Word64
ix (JsonRpcErr Int
c String
msg Maybe e
err)) =
    [Pair] -> Value
object
      [ Key
"jsonrpc" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"2.0" :: String)
      , Key
"id" Key -> Maybe Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Word64
ix
      , Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
detail
      ]
   where
    detail :: Value
detail =
      [Pair] -> Value
object
        [ Key
"code" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
c
        , Key
"message" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
msg
        , Key
"data" Key -> Maybe e -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe e
err
        ]

-- | A JSON RPC server handles any number of methods.  Represent this at the type level using this type.
data RawJsonRpc ctype api

-- | JSON-RPC endpoints which respond with a result
data JsonRpc (method :: Symbol) p e r

-- | JSON-RPC endpoints which do not respond
data JsonRpcNotification (method :: Symbol) p

type family JsonRpcEndpoint ctype a where
  JsonRpcEndpoint ctype (JsonRpc m p e r) =
    ReqBody '[ctype] (Request p) :> Post '[ctype] (JsonRpcResponse e r)
  JsonRpcEndpoint ctype (JsonRpcNotification m p) =
    ReqBody '[ctype] (Request p) :> Post '[ctype] NoContent

-- | The JSON-RPC content type
data JSONRPC

instance Accept JSONRPC where
  contentTypes :: Proxy JSONRPC -> NonEmpty MediaType
contentTypes Proxy JSONRPC
_ = ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"json-rpc" MediaType -> [MediaType] -> NonEmpty MediaType
forall a. a -> [a] -> NonEmpty a
:| [ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"json"]

instance (ToJSON a) => MimeRender JSONRPC a where
  mimeRender :: Proxy JSONRPC -> a -> ByteString
mimeRender Proxy JSONRPC
_ = Proxy JSON -> a -> ByteString
forall {k} (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @JSON)

instance (FromJSON a) => MimeUnrender JSONRPC a where
  mimeUnrender :: Proxy JSONRPC -> ByteString -> Either String a
mimeUnrender Proxy JSONRPC
_ = Proxy JSON -> ByteString -> Either String a
forall {k} (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @JSON)