{- |
Module      :  Data.Conduit.JsonRpc.Internal.Types
Description :  Types used internally to encode requests and responses.
Copyright   :  (c) 2015 Gabriele Sales
-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Conduit.JsonRpc.Internal.Types
  ( Request(..)
  , Response(..) )
where

import           Control.Applicative
import           Control.Monad
import           Data.Aeson          hiding (Error)
import           Data.Aeson.Types    (emptyArray)
import           Data.Monoid         as M (mempty)
import           Data.Text           (Text)


data Request a = Request { Request a -> Text
reqMethod :: Text
                         , Request a -> a
reqParams :: a
                         , Request a -> Value
reqId     :: Value }

instance FromJSON (Request Value) where
  parseJSON :: Value -> Parser (Request Value)
parseJSON (Object Object
v) = do
    Text
version <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
version Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"2.0" :: Text))
    Text -> Value -> Value -> Request Value
forall a. Text -> a -> Value -> Request a
Request (Text -> Value -> Value -> Request Value)
-> Parser Text -> Parser (Value -> Value -> Request Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"method" Parser (Value -> Value -> Request Value)
-> Parser Value -> Parser (Value -> Request Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                (Object
v 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
emptyArray Parser (Value -> Request Value)
-> Parser Value -> Parser (Request Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id"

  parseJSON Value
_ = Parser (Request Value)
forall a. Monoid a => a
M.mempty

instance ToJSON a => ToJSON (Request a) where
  toJSON :: Request a -> Value
toJSON (Request Text
m a
ps Value
id) =
    [Pair] -> Value
object [ Key
"jsonrpc" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
           , Key
"method"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
m
           , Key
"params"  Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
ps
           , Key
"id"      Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
id ]


data Response a = Result { Response a -> a
result   :: a
                         , Response a -> Value
resultId :: Value }
                | Error  { Response a -> Int
errCode  :: Int
                         , Response a -> Text
errMsg   :: Text
                         , Response a -> Maybe Value
errRefId :: Maybe Value }
  deriving (Int -> Response a -> ShowS
[Response a] -> ShowS
Response a -> String
(Int -> Response a -> ShowS)
-> (Response a -> String)
-> ([Response a] -> ShowS)
-> Show (Response a)
forall a. Show a => Int -> Response a -> ShowS
forall a. Show a => [Response a] -> ShowS
forall a. Show a => Response a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response a] -> ShowS
$cshowList :: forall a. Show a => [Response a] -> ShowS
show :: Response a -> String
$cshow :: forall a. Show a => Response a -> String
showsPrec :: Int -> Response a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Response a -> ShowS
Show)

instance FromJSON a => FromJSON (Response a) where
  parseJSON :: Value -> Parser (Response a)
parseJSON (Object Object
v) = do
    Text
version <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
version Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"2.0" :: Text))
    Parser (Response a)
fromResult Parser (Response a) -> Parser (Response a) -> Parser (Response a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Response a)
forall a. Parser (Response a)
fromError

    where
      fromResult :: Parser (Response a)
fromResult = a -> Value -> Response a
forall a. a -> Value -> Response a
Result (a -> Value -> Response a)
-> Parser a -> Parser (Value -> Response a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result" Parser Value -> (Value -> Parser a) -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON)
                          Parser (Value -> Response a) -> Parser Value -> Parser (Response a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"

      fromError :: Parser (Response a)
fromError = do
        Object
err <- Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
        Int -> Text -> Maybe Value -> Response a
forall a. Int -> Text -> Maybe Value -> Response a
Error (Int -> Text -> Maybe Value -> Response a)
-> Parser Int -> Parser (Text -> Maybe Value -> Response a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
err Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
              Parser (Text -> Maybe Value -> Response a)
-> Parser Text -> Parser (Maybe Value -> Response a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
err Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
              Parser (Maybe Value -> Response a)
-> Parser (Maybe Value) -> Parser (Response a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v   Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"

  parseJSON Value
_ = Parser (Response a)
forall a. Monoid a => a
mempty

instance ToJSON (Response Value) where
  toJSON :: Response Value -> Value
toJSON (Result Value
x Value
id) = [Pair] -> Value
object [ Key
"jsonrpc" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
                                , Key
"result"  Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
x
                                , Key
"id"      Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
id ]
  toJSON (Error Int
code Text
msg Maybe Value
id) =
    let err :: Value
err = [Pair] -> Value
object [ Key
"code"    Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
code
                     , Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg ]
    in [Pair] -> Value
object [ Key
"jsonrpc" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
              , Key
"error"   Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
err
              , Key
"id"      Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
id ]