{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Implementation of basic JSON-RPC data types.
module Network.JSONRPC.Data
( -- * Requests
  Request(..)
, BatchRequest(..)
  -- ** Parsing
, FromRequest(..)
, fromRequest
  -- ** Encoding
, ToRequest(..)
, buildRequest

  -- * Responses
, Response(..)
, BatchResponse(..)
  -- ** Parsing
, FromResponse(..)
, fromResponse
  -- ** Encoding
, Respond
, buildResponse
  -- ** Errors
, ErrorObj(..)
, fromError
  -- ** Error messages
, errorParse
, errorInvalid
, errorParams
, errorMethod
, errorId

  -- * Others
, Message(..)
, Method
, Id(..)
, fromId
, Ver(..)

) where

import           Control.Applicative
import           Control.DeepSeq
import           Control.Monad
import           Data.Aeson           (encode)
import           Data.Aeson.Types
import           Data.ByteString      (ByteString)
import qualified Data.ByteString.Lazy as L
import           Data.Hashable        (Hashable)
import           Data.Maybe
import           Data.Text            (Text)
import qualified Data.Text            as T
import           Data.Text.Encoding
import           GHC.Generics         (Generic)


--
-- Requests
--

data Request = Request { Request -> Ver
getReqVer    :: !Ver
                       , Request -> Method
getReqMethod :: !Method
                       , Request -> Value
getReqParams :: !Value
                       , Request -> Id
getReqId     :: !Id
                       }
             | Notif   { getReqVer    :: !Ver
                       , getReqMethod :: !Method
                       , getReqParams :: !Value
                       }
             deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show, (forall x. Request -> Rep Request x)
-> (forall x. Rep Request x -> Request) -> Generic Request
forall x. Rep Request x -> Request
forall x. Request -> Rep Request x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Request x -> Request
$cfrom :: forall x. Request -> Rep Request x
Generic)

instance NFData Request where
    rnf :: Request -> ()
rnf (Request Ver
v Method
m Value
p Id
i) = Ver -> ()
forall a. NFData a => a -> ()
rnf Ver
v () -> () -> ()
`seq` Method -> ()
forall a. NFData a => a -> ()
rnf Method
m () -> () -> ()
`seq` Value -> ()
forall a. NFData a => a -> ()
rnf Value
p () -> () -> ()
`seq` Id -> ()
forall a. NFData a => a -> ()
rnf Id
i
    rnf (Notif Ver
v Method
m Value
p)     = Ver -> ()
forall a. NFData a => a -> ()
rnf Ver
v () -> () -> ()
`seq` Method -> ()
forall a. NFData a => a -> ()
rnf Method
m () -> () -> ()
`seq` Value -> ()
forall a. NFData a => a -> ()
rnf Value
p

instance ToJSON Request where
    toJSON :: Request -> Value
toJSON (Request Ver
V2 Method
m Value
p Id
i) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ case Value
p of
        Value
Null -> [Pair
jr2, Key
"method" Key -> Method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Method
m, Key
"id" Key -> Id -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Id
i]
        Value
_    -> [Pair
jr2, Key
"method" Key -> Method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Method
m, Key
"id" Key -> Id -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Id
i, Key
"params" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
p]
    toJSON (Request Ver
V1 Method
m Value
p Id
i) =
        [Pair] -> Value
object [Key
"method" Key -> Method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Method
m, Key
"params" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
p, Key
"id" Key -> Id -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Id
i]
    toJSON (Notif Ver
V2 Method
m Value
p) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ case Value
p of
        Value
Null -> [Pair
jr2, Key
"method" Key -> Method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Method
m]
        Value
_    -> [Pair
jr2, Key
"method" Key -> Method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Method
m, Key
"params" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
p]
    toJSON (Notif Ver
V1 Method
m Value
p) =
      [Pair] -> Value
object [Key
"method" Key -> Method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Method
m, Key
"params" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
p, Key
"id" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
Null]

class FromRequest q where
    -- | Parser for params Value in JSON-RPC request.
    parseParams :: Method -> Maybe (Value -> Parser q)

fromRequest :: FromRequest q => Request -> Either ErrorObj q
fromRequest :: Request -> Either ErrorObj q
fromRequest Request
req =
    case Maybe (Value -> Parser q)
parserM of
        Maybe (Value -> Parser q)
Nothing -> ErrorObj -> Either ErrorObj q
forall a b. a -> Either a b
Left (ErrorObj -> Either ErrorObj q) -> ErrorObj -> Either ErrorObj q
forall a b. (a -> b) -> a -> b
$ Method -> ErrorObj
errorMethod Method
m
        Just Value -> Parser q
parser ->
            case (Value -> Parser q) -> Value -> Maybe q
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser q
parser Value
p of
                Maybe q
Nothing -> ErrorObj -> Either ErrorObj q
forall a b. a -> Either a b
Left (ErrorObj -> Either ErrorObj q) -> ErrorObj -> Either ErrorObj q
forall a b. (a -> b) -> a -> b
$ Value -> ErrorObj
errorParams Value
p
                Just  q
q -> q -> Either ErrorObj q
forall a b. b -> Either a b
Right q
q
  where
    m :: Method
m = Request -> Method
getReqMethod Request
req
    p :: Value
p = Request -> Value
getReqParams Request
req
    parserM :: Maybe (Value -> Parser q)
parserM = Method -> Maybe (Value -> Parser q)
forall q. FromRequest q => Method -> Maybe (Value -> Parser q)
parseParams Method
m

instance FromRequest Value where
    parseParams :: Method -> Maybe (Value -> Parser Value)
parseParams = Maybe (Value -> Parser Value)
-> Method -> Maybe (Value -> Parser Value)
forall a b. a -> b -> a
const (Maybe (Value -> Parser Value)
 -> Method -> Maybe (Value -> Parser Value))
-> Maybe (Value -> Parser Value)
-> Method
-> Maybe (Value -> Parser Value)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser Value) -> Maybe (Value -> Parser Value)
forall a. a -> Maybe a
Just Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return

instance FromRequest () where
    parseParams :: Method -> Maybe (Value -> Parser ())
parseParams = Maybe (Value -> Parser ()) -> Method -> Maybe (Value -> Parser ())
forall a b. a -> b -> a
const (Maybe (Value -> Parser ())
 -> Method -> Maybe (Value -> Parser ()))
-> (Parser () -> Maybe (Value -> Parser ()))
-> Parser ()
-> Method
-> Maybe (Value -> Parser ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser ()) -> Maybe (Value -> Parser ())
forall a. a -> Maybe a
Just ((Value -> Parser ()) -> Maybe (Value -> Parser ()))
-> (Parser () -> Value -> Parser ())
-> Parser ()
-> Maybe (Value -> Parser ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Value -> Parser ()
forall a b. a -> b -> a
const (Parser () -> Method -> Maybe (Value -> Parser ()))
-> Parser () -> Method -> Maybe (Value -> Parser ())
forall a b. (a -> b) -> a -> b
$ () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance FromJSON Request where
    parseJSON :: Value -> Parser Request
parseJSON = String -> (Object -> Parser Request) -> Value -> Parser Request
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"request" ((Object -> Parser Request) -> Value -> Parser Request)
-> (Object -> Parser Request) -> Value -> Parser Request
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        (Ver
v, Maybe Id
n, Method
m, Value
p) <- Object -> Parser (Ver, Maybe Id, Method, Value)
parseVerIdMethParams Object
o
        case Maybe Id
n of Maybe Id
Nothing -> Request -> Parser Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> Parser Request) -> Request -> Parser Request
forall a b. (a -> b) -> a -> b
$ Ver -> Method -> Value -> Request
Notif   Ver
v Method
m Value
p
                  Just Id
i  -> Request -> Parser Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> Parser Request) -> Request -> Parser Request
forall a b. (a -> b) -> a -> b
$ Ver -> Method -> Value -> Id -> Request
Request Ver
v Method
m Value
p Id
i

parseVerIdMethParams :: Object -> Parser (Ver, Maybe Id, Method, Value)
parseVerIdMethParams :: Object -> Parser (Ver, Maybe Id, Method, Value)
parseVerIdMethParams Object
o = do
    Ver
v <- Object -> Parser Ver
parseVer Object
o
    Maybe Id
i <- Object
o Object -> Key -> Parser (Maybe Id)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
    Method
m <- Object
o Object -> Key -> Parser Method
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
    Value
p <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params" Parser (Maybe Value) -> Value -> Parser Value
forall a. Parser (Maybe a) -> a -> Parser a
.!= Value
Null
    (Ver, Maybe Id, Method, Value)
-> Parser (Ver, Maybe Id, Method, Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ver
v, Maybe Id
i, Method
m, Value
p)

class ToRequest q where
    -- | Method associated with request data to build a request object.
    requestMethod :: q -> Method

    -- | Is this request to be sent as a notification (no id, no response)?
    requestIsNotif :: q -> Bool

instance ToRequest Value where
    requestMethod :: Value -> Method
requestMethod = Method -> Value -> Method
forall a b. a -> b -> a
const Method
"json"
    requestIsNotif :: Value -> Bool
requestIsNotif = Bool -> Value -> Bool
forall a b. a -> b -> a
const Bool
False

instance ToRequest () where
    requestMethod :: () -> Method
requestMethod = Method -> () -> Method
forall a b. a -> b -> a
const Method
"json"
    requestIsNotif :: () -> Bool
requestIsNotif = Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
False

buildRequest :: (ToJSON q, ToRequest q)
             => Ver             -- ^ JSON-RPC version
             -> q               -- ^ Request data
             -> Id
             -> Request
buildRequest :: Ver -> q -> Id -> Request
buildRequest Ver
ver q
q = if q -> Bool
forall q. ToRequest q => q -> Bool
requestIsNotif q
q
                         then Request -> Id -> Request
forall a b. a -> b -> a
const (Request -> Id -> Request) -> Request -> Id -> Request
forall a b. (a -> b) -> a -> b
$ Ver -> Method -> Value -> Request
Notif Ver
ver (q -> Method
forall q. ToRequest q => q -> Method
requestMethod q
q) (q -> Value
forall a. ToJSON a => a -> Value
toJSON q
q)
                         else Ver -> Method -> Value -> Id -> Request
Request Ver
ver (q -> Method
forall q. ToRequest q => q -> Method
requestMethod q
q) (q -> Value
forall a. ToJSON a => a -> Value
toJSON q
q)

--
-- Responses
--

data Response = Response      { Response -> Ver
getResVer :: !Ver
                              , Response -> Value
getResult :: !Value
                              , Response -> Id
getResId  :: !Id
                              }
              | ResponseError { getResVer :: !Ver
                              , Response -> ErrorObj
getError  :: !ErrorObj
                              , getResId  :: !Id
                              }
              | OrphanError   { getResVer :: !Ver
                              , getError  :: !ErrorObj
                              }
              deriving (Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq, Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show, (forall x. Response -> Rep Response x)
-> (forall x. Rep Response x -> Response) -> Generic Response
forall x. Rep Response x -> Response
forall x. Response -> Rep Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Response x -> Response
$cfrom :: forall x. Response -> Rep Response x
Generic)


instance NFData Response where
    rnf :: Response -> ()
rnf (Response Ver
v Value
r Id
i)      = Ver -> ()
forall a. NFData a => a -> ()
rnf Ver
v () -> () -> ()
`seq` Value -> ()
forall a. NFData a => a -> ()
rnf Value
r () -> () -> ()
`seq` Id -> ()
forall a. NFData a => a -> ()
rnf Id
i
    rnf (ResponseError Ver
v ErrorObj
o Id
i) = Ver -> ()
forall a. NFData a => a -> ()
rnf Ver
v () -> () -> ()
`seq` ErrorObj -> ()
forall a. NFData a => a -> ()
rnf ErrorObj
o () -> () -> ()
`seq` Id -> ()
forall a. NFData a => a -> ()
rnf Id
i
    rnf (OrphanError Ver
v ErrorObj
o)     = Ver -> ()
forall a. NFData a => a -> ()
rnf Ver
v () -> () -> ()
`seq` ErrorObj -> ()
forall a. NFData a => a -> ()
rnf ErrorObj
o

instance ToJSON Response where
    toJSON :: Response -> Value
toJSON (Response Ver
V1 Value
r Id
i) = [Pair] -> Value
object
        [Key
"id" Key -> Id -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Id
i, Key
"result" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
r, Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
Null]
    toJSON (Response Ver
V2 Value
r Id
i) = [Pair] -> Value
object
        [Pair
jr2, Key
"id" Key -> Id -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Id
i, Key
"result" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
r]
    toJSON (ResponseError Ver
V1 ErrorObj
e Id
i) = [Pair] -> Value
object
        [Key
"id" Key -> Id -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Id
i, Key
"error" Key -> ErrorObj -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ErrorObj
e, Key
"result" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
Null]
    toJSON (ResponseError Ver
V2 ErrorObj
e Id
i) = [Pair] -> Value
object
        [Pair
jr2, Key
"id" Key -> Id -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Id
i, Key
"error" Key -> ErrorObj -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ErrorObj
e]
    toJSON (OrphanError Ver
V1 ErrorObj
e) = [Pair] -> Value
object
        [Key
"id" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
Null, Key
"error" Key -> ErrorObj -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ErrorObj
e, Key
"result" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
Null]
    toJSON (OrphanError Ver
V2 ErrorObj
e) = [Pair] -> Value
object
        [Pair
jr2, Key
"id" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
Null, Key
"error" Key -> ErrorObj -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ErrorObj
e]

class FromResponse r where
    -- | Parser for result Value in JSON-RPC response.
    -- Method corresponds to request to which this response answers.
    parseResult :: Method -> Maybe (Value -> Parser r)

-- | Parse a response knowing the method of the corresponding request.
fromResponse :: FromResponse r => Method -> Response -> Maybe r
fromResponse :: Method -> Response -> Maybe r
fromResponse Method
m (Response Ver
_ Value
r Id
_) = Method -> Maybe (Value -> Parser r)
forall r. FromResponse r => Method -> Maybe (Value -> Parser r)
parseResult Method
m Maybe (Value -> Parser r)
-> ((Value -> Parser r) -> Maybe r) -> Maybe r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Value -> Parser r) -> Value -> Maybe r)
-> Value -> (Value -> Parser r) -> Maybe r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Value -> Parser r) -> Value -> Maybe r
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value
r
fromResponse Method
_ Response
_                = Maybe r
forall a. Maybe a
Nothing

instance FromResponse Value where
    parseResult :: Method -> Maybe (Value -> Parser Value)
parseResult = Maybe (Value -> Parser Value)
-> Method -> Maybe (Value -> Parser Value)
forall a b. a -> b -> a
const (Maybe (Value -> Parser Value)
 -> Method -> Maybe (Value -> Parser Value))
-> Maybe (Value -> Parser Value)
-> Method
-> Maybe (Value -> Parser Value)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser Value) -> Maybe (Value -> Parser Value)
forall a. a -> Maybe a
Just Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return

instance FromResponse () where
    parseResult :: Method -> Maybe (Value -> Parser ())
parseResult = Maybe (Value -> Parser ()) -> Method -> Maybe (Value -> Parser ())
forall a b. a -> b -> a
const Maybe (Value -> Parser ())
forall a. Maybe a
Nothing

instance FromJSON Response where
    parseJSON :: Value -> Parser Response
parseJSON = String -> (Object -> Parser Response) -> Value -> Parser Response
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"response" ((Object -> Parser Response) -> Value -> Parser Response)
-> (Object -> Parser Response) -> Value -> Parser Response
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        (Ver
v, Maybe Id
d, Either ErrorObj Value
s) <- Object -> Parser (Ver, Maybe Id, Either ErrorObj Value)
parseVerIdResultError Object
o
        case Either ErrorObj Value
s of
            Right Value
r -> do
                Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Maybe Id -> Bool
forall a. Maybe a -> Bool
isJust Maybe Id
d
                Response -> Parser Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> Parser Response) -> Response -> Parser Response
forall a b. (a -> b) -> a -> b
$ Ver -> Value -> Id -> Response
Response Ver
v Value
r (Maybe Id -> Id
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Id
d)
            Left ErrorObj
e ->
                case Maybe Id
d of
                    Just  Id
i -> Response -> Parser Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> Parser Response) -> Response -> Parser Response
forall a b. (a -> b) -> a -> b
$ Ver -> ErrorObj -> Id -> Response
ResponseError Ver
v ErrorObj
e Id
i
                    Maybe Id
Nothing -> Response -> Parser Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> Parser Response) -> Response -> Parser Response
forall a b. (a -> b) -> a -> b
$ Ver -> ErrorObj -> Response
OrphanError Ver
v ErrorObj
e

parseVerIdResultError :: Object
                      -> Parser (Ver, Maybe Id, Either ErrorObj Value)
parseVerIdResultError :: Object -> Parser (Ver, Maybe Id, Either ErrorObj Value)
parseVerIdResultError Object
o = do
    Ver
v <- Object -> Parser Ver
parseVer Object
o
    Maybe Id
i <- Object
o Object -> Key -> Parser (Maybe Id)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
    Value
r <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"result" Parser (Maybe Value) -> Value -> Parser Value
forall a. Parser (Maybe a) -> a -> Parser a
.!= Value
Null
    Either ErrorObj Value
p <- case Ver
v of
          Ver
V1 -> if Value
r Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
Null then ErrorObj -> Either ErrorObj Value
forall a b. a -> Either a b
Left (ErrorObj -> Either ErrorObj Value)
-> Parser ErrorObj -> Parser (Either ErrorObj Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ErrorObj
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error" else Either ErrorObj Value -> Parser (Either ErrorObj Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorObj Value -> Parser (Either ErrorObj Value))
-> Either ErrorObj Value -> Parser (Either ErrorObj Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either ErrorObj Value
forall a b. b -> Either a b
Right Value
r
          Ver
V2 -> Either ErrorObj Value
-> (ErrorObj -> Either ErrorObj Value)
-> Maybe ErrorObj
-> Either ErrorObj Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value -> Either ErrorObj Value
forall a b. b -> Either a b
Right Value
r) ErrorObj -> Either ErrorObj Value
forall a b. a -> Either a b
Left (Maybe ErrorObj -> Either ErrorObj Value)
-> Parser (Maybe ErrorObj) -> Parser (Either ErrorObj Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe ErrorObj)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error"
    (Ver, Maybe Id, Either ErrorObj Value)
-> Parser (Ver, Maybe Id, Either ErrorObj Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ver
v, Maybe Id
i, Either ErrorObj Value
p)

-- | Create a response from a request. Use in servers.
buildResponse :: (Monad m, FromRequest q, ToJSON r)
              => Respond q m r
              -> Request
              -> m (Maybe Response)
buildResponse :: Respond q m r -> Request -> m (Maybe Response)
buildResponse Respond q m r
f req :: Request
req@(Request Ver
v Method
_ Value
_ Id
i) =
    case Request -> Either ErrorObj q
forall q. FromRequest q => Request -> Either ErrorObj q
fromRequest Request
req of
        Left ErrorObj
e -> Maybe Response -> m (Maybe Response)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Response -> m (Maybe Response))
-> (Response -> Maybe Response) -> Response -> m (Maybe Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Maybe Response
forall a. a -> Maybe a
Just (Response -> m (Maybe Response)) -> Response -> m (Maybe Response)
forall a b. (a -> b) -> a -> b
$ Ver -> ErrorObj -> Id -> Response
ResponseError Ver
v ErrorObj
e Id
i
        Right q
q -> do
            Either ErrorObj r
rE <- Respond q m r
f q
q
            case Either ErrorObj r
rE of
                Left  ErrorObj
e -> Maybe Response -> m (Maybe Response)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Response -> m (Maybe Response))
-> (Response -> Maybe Response) -> Response -> m (Maybe Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Maybe Response
forall a. a -> Maybe a
Just (Response -> m (Maybe Response)) -> Response -> m (Maybe Response)
forall a b. (a -> b) -> a -> b
$ Ver -> ErrorObj -> Id -> Response
ResponseError Ver
v ErrorObj
e Id
i
                Right r
r -> Maybe Response -> m (Maybe Response)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Response -> m (Maybe Response))
-> (Response -> Maybe Response) -> Response -> m (Maybe Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Maybe Response
forall a. a -> Maybe a
Just (Response -> m (Maybe Response)) -> Response -> m (Maybe Response)
forall a b. (a -> b) -> a -> b
$ Ver -> Value -> Id -> Response
Response Ver
v (r -> Value
forall a. ToJSON a => a -> Value
toJSON r
r) Id
i
buildResponse Respond q m r
_ Request
_ = Maybe Response -> m (Maybe Response)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Response
forall a. Maybe a
Nothing

-- | Type of function to make it easy to create a response from a request.
-- Meant to be used in servers.
type Respond q m r = q -> m (Either ErrorObj r)

-- | Error object from JSON-RPC 2.0. ErrorVal for backwards compatibility.
data ErrorObj = ErrorObj  { ErrorObj -> String
getErrMsg  :: !String
                          , ErrorObj -> Int
getErrCode :: !Int
                          , ErrorObj -> Value
getErrData :: !Value
                          }
              | ErrorVal  { getErrData :: !Value }
              deriving (Int -> ErrorObj -> ShowS
[ErrorObj] -> ShowS
ErrorObj -> String
(Int -> ErrorObj -> ShowS)
-> (ErrorObj -> String) -> ([ErrorObj] -> ShowS) -> Show ErrorObj
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorObj] -> ShowS
$cshowList :: [ErrorObj] -> ShowS
show :: ErrorObj -> String
$cshow :: ErrorObj -> String
showsPrec :: Int -> ErrorObj -> ShowS
$cshowsPrec :: Int -> ErrorObj -> ShowS
Show, ErrorObj -> ErrorObj -> Bool
(ErrorObj -> ErrorObj -> Bool)
-> (ErrorObj -> ErrorObj -> Bool) -> Eq ErrorObj
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorObj -> ErrorObj -> Bool
$c/= :: ErrorObj -> ErrorObj -> Bool
== :: ErrorObj -> ErrorObj -> Bool
$c== :: ErrorObj -> ErrorObj -> Bool
Eq, (forall x. ErrorObj -> Rep ErrorObj x)
-> (forall x. Rep ErrorObj x -> ErrorObj) -> Generic ErrorObj
forall x. Rep ErrorObj x -> ErrorObj
forall x. ErrorObj -> Rep ErrorObj x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorObj x -> ErrorObj
$cfrom :: forall x. ErrorObj -> Rep ErrorObj x
Generic)

instance NFData ErrorObj where
    rnf :: ErrorObj -> ()
rnf (ErrorObj String
m Int
c Value
d) = String -> ()
forall a. NFData a => a -> ()
rnf String
m () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
c () -> () -> ()
`seq` Value -> ()
forall a. NFData a => a -> ()
rnf Value
d
    rnf (ErrorVal Value
v)     = Value -> ()
forall a. NFData a => a -> ()
rnf Value
v

instance FromJSON ErrorObj where
    parseJSON :: Value -> Parser ErrorObj
parseJSON Value
Null = Parser ErrorObj
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    parseJSON v :: Value
v@(Object Object
o) = Parser ErrorObj
p1 Parser ErrorObj -> Parser ErrorObj -> Parser ErrorObj
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ErrorObj
p2 where
        p1 :: Parser ErrorObj
p1 = do
            String
m <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
            Int
c <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
            Value
d <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data" Parser (Maybe Value) -> Value -> Parser Value
forall a. Parser (Maybe a) -> a -> Parser a
.!= Value
Null
            ErrorObj -> Parser ErrorObj
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrorObj -> Parser ErrorObj) -> ErrorObj -> Parser ErrorObj
forall a b. (a -> b) -> a -> b
$ String -> Int -> Value -> ErrorObj
ErrorObj String
m Int
c Value
d
        p2 :: Parser ErrorObj
p2 = ErrorObj -> Parser ErrorObj
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrorObj -> Parser ErrorObj) -> ErrorObj -> Parser ErrorObj
forall a b. (a -> b) -> a -> b
$ Value -> ErrorObj
ErrorVal Value
v
    parseJSON Value
v = ErrorObj -> Parser ErrorObj
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrorObj -> Parser ErrorObj) -> ErrorObj -> Parser ErrorObj
forall a b. (a -> b) -> a -> b
$ Value -> ErrorObj
ErrorVal Value
v

instance ToJSON ErrorObj where
    toJSON :: ErrorObj -> Value
toJSON (ErrorObj String
s Int
i Value
d) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Key
"message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
s, Key
"code" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
i]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ if Value
d Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
Null then [] else [Key
"data" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
d]
    toJSON (ErrorVal Value
v) = Value
v

-- | Get a user-friendly string with the error information.
fromError :: ErrorObj -> String
fromError :: ErrorObj -> String
fromError (ErrorObj String
m Int
c Value
v) = Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
valueAsString Value
v
fromError (ErrorVal (String Method
t)) = Method -> String
T.unpack Method
t
fromError (ErrorVal Value
v) = Value -> String
valueAsString Value
v

valueAsString :: Value -> String
valueAsString :: Value -> String
valueAsString = Method -> String
T.unpack (Method -> String) -> (Value -> Method) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Method
decodeUtf8 (ByteString -> Method) -> (Value -> ByteString) -> Value -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode

-- | Parse error.
errorParse :: ByteString -> ErrorObj
errorParse :: ByteString -> ErrorObj
errorParse = String -> Int -> Value -> ErrorObj
ErrorObj String
"Parse error" (-Int
32700) (Value -> ErrorObj)
-> (ByteString -> Value) -> ByteString -> ErrorObj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Value
String (Method -> Value) -> (ByteString -> Method) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Method
decodeUtf8

-- | Invalid request.
errorInvalid :: Value -> ErrorObj
errorInvalid :: Value -> ErrorObj
errorInvalid = String -> Int -> Value -> ErrorObj
ErrorObj String
"Invalid request" (-Int
32600)

-- | Invalid params.
errorParams :: Value -> ErrorObj
errorParams :: Value -> ErrorObj
errorParams = String -> Int -> Value -> ErrorObj
ErrorObj String
"Invalid params" (-Int
32602)

-- | Method not found.
errorMethod :: Method -> ErrorObj
errorMethod :: Method -> ErrorObj
errorMethod = String -> Int -> Value -> ErrorObj
ErrorObj String
"Method not found" (-Int
32601) (Value -> ErrorObj) -> (Method -> Value) -> Method -> ErrorObj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Value
forall a. ToJSON a => a -> Value
toJSON

-- | Id not recognized.
errorId :: Id -> ErrorObj
errorId :: Id -> ErrorObj
errorId = String -> Int -> Value -> ErrorObj
ErrorObj String
"Id not recognized" (-Int
32000) (Value -> ErrorObj) -> (Id -> Value) -> Id -> ErrorObj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Value
forall a. ToJSON a => a -> Value
toJSON


--
-- Messages
--

data BatchRequest
    = BatchRequest     { BatchRequest -> [Request]
getBatchRequest  :: ![Request] }
    | SingleRequest    { BatchRequest -> Request
getSingleRequest ::  !Request  }
    deriving (BatchRequest -> BatchRequest -> Bool
(BatchRequest -> BatchRequest -> Bool)
-> (BatchRequest -> BatchRequest -> Bool) -> Eq BatchRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchRequest -> BatchRequest -> Bool
$c/= :: BatchRequest -> BatchRequest -> Bool
== :: BatchRequest -> BatchRequest -> Bool
$c== :: BatchRequest -> BatchRequest -> Bool
Eq, Int -> BatchRequest -> ShowS
[BatchRequest] -> ShowS
BatchRequest -> String
(Int -> BatchRequest -> ShowS)
-> (BatchRequest -> String)
-> ([BatchRequest] -> ShowS)
-> Show BatchRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchRequest] -> ShowS
$cshowList :: [BatchRequest] -> ShowS
show :: BatchRequest -> String
$cshow :: BatchRequest -> String
showsPrec :: Int -> BatchRequest -> ShowS
$cshowsPrec :: Int -> BatchRequest -> ShowS
Show, (forall x. BatchRequest -> Rep BatchRequest x)
-> (forall x. Rep BatchRequest x -> BatchRequest)
-> Generic BatchRequest
forall x. Rep BatchRequest x -> BatchRequest
forall x. BatchRequest -> Rep BatchRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchRequest x -> BatchRequest
$cfrom :: forall x. BatchRequest -> Rep BatchRequest x
Generic)

instance NFData BatchRequest where
    rnf :: BatchRequest -> ()
rnf (BatchRequest [Request]
qs) = [Request] -> ()
forall a. NFData a => a -> ()
rnf [Request]
qs
    rnf (SingleRequest Request
q) = Request -> ()
forall a. NFData a => a -> ()
rnf Request
q

instance FromJSON BatchRequest where
    parseJSON :: Value -> Parser BatchRequest
parseJSON qs :: Value
qs@Array{} = [Request] -> BatchRequest
BatchRequest  ([Request] -> BatchRequest)
-> Parser [Request] -> Parser BatchRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Request]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
qs
    parseJSON q :: Value
q@Object{} = Request -> BatchRequest
SingleRequest (Request -> BatchRequest) -> Parser Request -> Parser BatchRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Request
forall a. FromJSON a => Value -> Parser a
parseJSON Value
q
    parseJSON Value
_          = Parser BatchRequest
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON BatchRequest where
    toJSON :: BatchRequest -> Value
toJSON (BatchRequest [Request]
qs) = [Request] -> Value
forall a. ToJSON a => a -> Value
toJSON [Request]
qs
    toJSON (SingleRequest Request
q) = Request -> Value
forall a. ToJSON a => a -> Value
toJSON Request
q

data BatchResponse
    = BatchResponse    { BatchResponse -> [Response]
getBatchResponse :: ![Response] }
    | SingleResponse   { BatchResponse -> Response
getSingleResponse :: !Response  }
    deriving (BatchResponse -> BatchResponse -> Bool
(BatchResponse -> BatchResponse -> Bool)
-> (BatchResponse -> BatchResponse -> Bool) -> Eq BatchResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchResponse -> BatchResponse -> Bool
$c/= :: BatchResponse -> BatchResponse -> Bool
== :: BatchResponse -> BatchResponse -> Bool
$c== :: BatchResponse -> BatchResponse -> Bool
Eq, Int -> BatchResponse -> ShowS
[BatchResponse] -> ShowS
BatchResponse -> String
(Int -> BatchResponse -> ShowS)
-> (BatchResponse -> String)
-> ([BatchResponse] -> ShowS)
-> Show BatchResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchResponse] -> ShowS
$cshowList :: [BatchResponse] -> ShowS
show :: BatchResponse -> String
$cshow :: BatchResponse -> String
showsPrec :: Int -> BatchResponse -> ShowS
$cshowsPrec :: Int -> BatchResponse -> ShowS
Show, (forall x. BatchResponse -> Rep BatchResponse x)
-> (forall x. Rep BatchResponse x -> BatchResponse)
-> Generic BatchResponse
forall x. Rep BatchResponse x -> BatchResponse
forall x. BatchResponse -> Rep BatchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchResponse x -> BatchResponse
$cfrom :: forall x. BatchResponse -> Rep BatchResponse x
Generic)

instance NFData BatchResponse where
    rnf :: BatchResponse -> ()
rnf (BatchResponse [Response]
qs) = [Response] -> ()
forall a. NFData a => a -> ()
rnf [Response]
qs
    rnf (SingleResponse Response
q) = Response -> ()
forall a. NFData a => a -> ()
rnf Response
q

instance FromJSON BatchResponse where
    parseJSON :: Value -> Parser BatchResponse
parseJSON qs :: Value
qs@Array{} = [Response] -> BatchResponse
BatchResponse  ([Response] -> BatchResponse)
-> Parser [Response] -> Parser BatchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Response]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
qs
    parseJSON q :: Value
q@Object{} = Response -> BatchResponse
SingleResponse (Response -> BatchResponse)
-> Parser Response -> Parser BatchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Response
forall a. FromJSON a => Value -> Parser a
parseJSON Value
q
    parseJSON Value
_          = Parser BatchResponse
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON BatchResponse where
    toJSON :: BatchResponse -> Value
toJSON (BatchResponse [Response]
qs) = [Response] -> Value
forall a. ToJSON a => a -> Value
toJSON [Response]
qs
    toJSON (SingleResponse Response
q) = Response -> Value
forall a. ToJSON a => a -> Value
toJSON Response
q

data Message
    = MsgRequest  { Message -> Request
getMsgRequest  :: !Request   }
    | MsgResponse { Message -> Response
getMsgResponse :: !Response  }
    | MsgBatch    { Message -> [Message]
getBatch       :: ![Message] }
    deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, (forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic)

instance NFData Message where
    rnf :: Message -> ()
rnf (MsgRequest  Request
q) = Request -> ()
forall a. NFData a => a -> ()
rnf Request
q
    rnf (MsgResponse Response
r) = Response -> ()
forall a. NFData a => a -> ()
rnf Response
r
    rnf (MsgBatch    [Message]
b) = [Message] -> ()
forall a. NFData a => a -> ()
rnf [Message]
b

instance ToJSON Message where
    toJSON :: Message -> Value
toJSON (MsgRequest  Request
q) = Request -> Value
forall a. ToJSON a => a -> Value
toJSON Request
q
    toJSON (MsgResponse Response
r) = Response -> Value
forall a. ToJSON a => a -> Value
toJSON Response
r
    toJSON (MsgBatch    [Message]
b) = [Message] -> Value
forall a. ToJSON a => a -> Value
toJSON [Message]
b

instance FromJSON Message where
    parseJSON :: Value -> Parser Message
parseJSON Value
v = (Request -> Message
MsgRequest   (Request -> Message) -> Parser Request -> Parser Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Request
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
              Parser Message -> Parser Message -> Parser Message
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Response -> Message
MsgResponse  (Response -> Message) -> Parser Response -> Parser Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Response
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
              Parser Message -> Parser Message -> Parser Message
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Message] -> Message
MsgBatch     ([Message] -> Message) -> Parser [Message] -> Parser Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Message]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

--
-- Types
--

type Method = Text

data Id = IdInt { Id -> Int
getIdInt :: !Int  }
        | IdTxt { Id -> Method
getIdTxt :: !Text }
    deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show, ReadPrec [Id]
ReadPrec Id
Int -> ReadS Id
ReadS [Id]
(Int -> ReadS Id)
-> ReadS [Id] -> ReadPrec Id -> ReadPrec [Id] -> Read Id
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Id]
$creadListPrec :: ReadPrec [Id]
readPrec :: ReadPrec Id
$creadPrec :: ReadPrec Id
readList :: ReadS [Id]
$creadList :: ReadS [Id]
readsPrec :: Int -> ReadS Id
$creadsPrec :: Int -> ReadS Id
Read, (forall x. Id -> Rep Id x)
-> (forall x. Rep Id x -> Id) -> Generic Id
forall x. Rep Id x -> Id
forall x. Id -> Rep Id x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Id x -> Id
$cfrom :: forall x. Id -> Rep Id x
Generic)

instance Hashable Id

instance NFData Id where
    rnf :: Id -> ()
rnf (IdInt Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
    rnf (IdTxt Method
t) = Method -> ()
forall a. NFData a => a -> ()
rnf Method
t

instance Enum Id where
    toEnum :: Int -> Id
toEnum = Int -> Id
IdInt
    fromEnum :: Id -> Int
fromEnum (IdInt Int
i) = Int
i
    fromEnum Id
_         = String -> Int
forall a. HasCallStack => String -> a
error String
"Can't enumerate non-integral ids"

instance FromJSON Id where
    parseJSON :: Value -> Parser Id
parseJSON s :: Value
s@(String Method
_) = Method -> Id
IdTxt (Method -> Id) -> Parser Method -> Parser Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Method
forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
    parseJSON n :: Value
n@(Number Scientific
_) = Int -> Id
IdInt (Int -> Id) -> Parser Int -> Parser Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
n
    parseJSON Value
_            = Parser Id
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON Id where
    toJSON :: Id -> Value
toJSON (IdTxt Method
s) = Method -> Value
forall a. ToJSON a => a -> Value
toJSON Method
s
    toJSON (IdInt Int
n) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
n

-- | Pretty display a message id. Meant for logs.
fromId :: Id -> String
fromId :: Id -> String
fromId (IdInt Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
fromId (IdTxt Method
t) = Method -> String
T.unpack Method
t

-- | JSON-RPC version.
data Ver = V1 -- ^ JSON-RPC 1.0
         | V2 -- ^ JSON-RPC 2.0
         deriving (Ver -> Ver -> Bool
(Ver -> Ver -> Bool) -> (Ver -> Ver -> Bool) -> Eq Ver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ver -> Ver -> Bool
$c/= :: Ver -> Ver -> Bool
== :: Ver -> Ver -> Bool
$c== :: Ver -> Ver -> Bool
Eq, Int -> Ver -> ShowS
[Ver] -> ShowS
Ver -> String
(Int -> Ver -> ShowS)
-> (Ver -> String) -> ([Ver] -> ShowS) -> Show Ver
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ver] -> ShowS
$cshowList :: [Ver] -> ShowS
show :: Ver -> String
$cshow :: Ver -> String
showsPrec :: Int -> Ver -> ShowS
$cshowsPrec :: Int -> Ver -> ShowS
Show, ReadPrec [Ver]
ReadPrec Ver
Int -> ReadS Ver
ReadS [Ver]
(Int -> ReadS Ver)
-> ReadS [Ver] -> ReadPrec Ver -> ReadPrec [Ver] -> Read Ver
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ver]
$creadListPrec :: ReadPrec [Ver]
readPrec :: ReadPrec Ver
$creadPrec :: ReadPrec Ver
readList :: ReadS [Ver]
$creadList :: ReadS [Ver]
readsPrec :: Int -> ReadS Ver
$creadsPrec :: Int -> ReadS Ver
Read, (forall x. Ver -> Rep Ver x)
-> (forall x. Rep Ver x -> Ver) -> Generic Ver
forall x. Rep Ver x -> Ver
forall x. Ver -> Rep Ver x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ver x -> Ver
$cfrom :: forall x. Ver -> Rep Ver x
Generic)

instance NFData Ver where
    rnf :: Ver -> ()
rnf Ver
v = Ver
v Ver -> () -> ()
`seq` ()

jr2 :: Pair
jr2 :: Pair
jr2 = Key
"jsonrpc" Key -> Method -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Method
"2.0" :: Text)

parseVer :: Object -> Parser Ver
parseVer :: Object -> Parser Ver
parseVer Object
o = do
    Maybe Method
j <- Object
o Object -> Key -> Parser (Maybe Method)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jsonrpc"
    Ver -> Parser Ver
forall (m :: * -> *) a. Monad m => a -> m a
return (Ver -> Parser Ver) -> Ver -> Parser Ver
forall a b. (a -> b) -> a -> b
$ if Maybe Method
j Maybe Method -> Maybe Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method -> Maybe Method
forall a. a -> Maybe a
Just (Method
"2.0" :: Text) then Ver
V2 else Ver
V1