{- |
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 { forall a. Request a -> Text
reqMethod :: Text
                         , forall a. Request a -> a
reqParams :: a
                         , forall 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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
version forall a. Eq a => a -> a -> Bool
== (Text
"2.0" :: Text))
    forall a. Text -> a -> Value -> Request a
Request forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"method" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params") forall a. Parser (Maybe a) -> a -> Parser a
.!= Value
emptyArray forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                Object
v forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id"

  parseJSON 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
           , Key
"method"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
m
           , Key
"params"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON a
ps
           , Key
"id"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
id ]


data Response a = Result { forall a. Response a -> a
result   :: a
                         , forall a. Response a -> Value
resultId :: Value }
                | Error  { forall a. Response a -> Int
errCode  :: Int
                         , forall a. Response a -> Text
errMsg   :: Text
                         , forall a. Response a -> Maybe Value
errRefId :: Maybe Value }
  deriving (Int -> Response a -> ShowS
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 forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
version forall a. Eq a => a -> a -> Bool
== (Text
"2.0" :: Text))
    Parser (Response a)
fromResult forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. Parser (Response a)
fromError

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

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

  parseJSON Value
_ = 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
                                , Key
"result"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
x
                                , Key
"id"      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"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
code
                     , Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg ]
    in [Pair] -> Value
object [ Key
"jsonrpc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
              , Key
"error"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
err
              , Key
"id"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
id ]