{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

#if MIN_VERSION_servant_server(0,18,0)
{-# LANGUAGE UndecidableInstances  #-}
#endif

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module: Servant.Server.JsonRpc
--
-- This module provides support for writing handlers for JSON-RPC endpoints
--
-- > type Mul = JsonRpc "mul" (Int, Int) String Int
-- > mulHandler :: (Int, Int) -> Handler (Either (JsonRpcErr String) Int)
-- > mulHandler = _
--
-- > type Add = JsonRpc "add" (Int, Int) String Int
-- > addHandler :: (Int, Int) -> Handler (Either (JsonRpcErr String) Int)
-- > addHandler = _
--
-- > type API = Add :<|> Mul
-- > server :: Application
-- > server = serve (Proxy @(RawJsonRpc API)) $ addHandler :<|> mulHandler
module Servant.Server.JsonRpc
    ( serveJsonRpc
    , RouteJsonRpc (..)
    , module Servant.JsonRpc
    , PossibleContent
    , PossibleJsonRpcResponse
    ) where

import           Data.Aeson               (FromJSON (..), ToJSON (..), Value)
import           Data.Aeson.Types         (parseEither)
import           Data.Bifunctor           (bimap)
import           Data.Map.Strict          (Map)
import qualified Data.Map.Strict          as Map
import           Data.Proxy               (Proxy (..))
import           GHC.TypeLits             (KnownSymbol, symbolVal)
import           Servant.API              (NoContent (..), Post, ReqBody,
                                           (:<|>) (..), (:>))
import           Servant.API.ContentTypes (AllCTRender (..))

#if MIN_VERSION_servant_server(0,18,0)
import           Servant.Server           (DefaultErrorFormatters,
                                           ErrorFormatters, Handler,
                                           HasContextEntry, HasServer (..),
                                           type (.++))
#elif MIN_VERSION_servant_server(0,14,0)
import           Servant.Server           (Handler, HasServer (..))
#endif

import           Servant.JsonRpc


-- | Since we collapse an entire JSON RPC api down to a single Servant
--   endpoint, we need a type that /can/ return content but might not.
data PossibleContent a = SomeContent a | EmptyContent


instance ToJSON a => AllCTRender '[JSONRPC] (PossibleContent a) where
    handleAcceptH :: Proxy '[JSONRPC]
-> AcceptHeader
-> PossibleContent a
-> Maybe (ByteString, ByteString)
handleAcceptH Proxy '[JSONRPC]
px AcceptHeader
h = \case
        SomeContent a
x -> Proxy '[JSONRPC]
-> AcceptHeader -> a -> Maybe (ByteString, ByteString)
forall (list :: [*]) a.
AllCTRender list a =>
Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)
handleAcceptH Proxy '[JSONRPC]
px AcceptHeader
h a
x
        PossibleContent a
EmptyContent  -> Proxy '[JSONRPC]
-> AcceptHeader -> NoContent -> Maybe (ByteString, ByteString)
forall (list :: [*]) a.
AllCTRender list a =>
Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)
handleAcceptH Proxy '[JSONRPC]
px AcceptHeader
h NoContent
NoContent


type PossibleJsonRpcResponse = PossibleContent (JsonRpcResponse Value Value)


type RawJsonRpcEndpoint
    = ReqBody '[JSONRPC] (Request Value)
   :> Post '[JSONRPC] PossibleJsonRpcResponse


#if MIN_VERSION_servant_server(0,18,0)
instance (RouteJsonRpc api, HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters) => HasServer (RawJsonRpc api) context where
#elif MIN_VERSION_servant_server(0,14,0)
instance RouteJsonRpc api => HasServer (RawJsonRpc api) context where
#endif
    type ServerT (RawJsonRpc api) m = RpcHandler api m
    route :: Proxy (RawJsonRpc api)
-> Context context
-> Delayed env (Server (RawJsonRpc api))
-> Router env
route Proxy (RawJsonRpc api)
_ Context context
cx = Proxy RawJsonRpcEndpoint
-> Context context
-> Delayed env (Server RawJsonRpcEndpoint)
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route Proxy RawJsonRpcEndpoint
endpoint Context context
cx (Delayed
   env
   (Request Value
    -> Handler (PossibleContent (JsonRpcResponse Value Value)))
 -> Router env)
-> (Delayed env (RpcHandler api Handler)
    -> Delayed
         env
         (Request Value
          -> Handler (PossibleContent (JsonRpcResponse Value Value))))
-> Delayed env (RpcHandler api Handler)
-> Router env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RpcHandler api Handler
 -> Request Value
 -> Handler (PossibleContent (JsonRpcResponse Value Value)))
-> Delayed env (RpcHandler api Handler)
-> Delayed
     env
     (Request Value
      -> Handler (PossibleContent (JsonRpcResponse Value Value)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy api
-> Proxy Handler
-> RpcHandler api Handler
-> Request Value
-> Handler (PossibleContent (JsonRpcResponse Value Value))
forall (m :: * -> *) a.
(Monad m, RouteJsonRpc a) =>
Proxy a
-> Proxy m
-> RpcHandler a m
-> Request Value
-> m (PossibleContent (JsonRpcResponse Value Value))
serveJsonRpc Proxy api
pxa Proxy Handler
pxh)
        where
        endpoint :: Proxy RawJsonRpcEndpoint
endpoint = Proxy RawJsonRpcEndpoint
forall k (t :: k). Proxy t
Proxy @RawJsonRpcEndpoint
        pxa :: Proxy api
pxa      = Proxy api
forall k (t :: k). Proxy t
Proxy @api
        pxh :: Proxy Handler
pxh      = Proxy Handler
forall k (t :: k). Proxy t
Proxy @Handler

    hoistServerWithContext :: Proxy (RawJsonRpc api)
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT (RawJsonRpc api) m
-> ServerT (RawJsonRpc api) n
hoistServerWithContext Proxy (RawJsonRpc api)
_ Proxy context
_ forall x. m x -> n x
f ServerT (RawJsonRpc api) m
x = Proxy api
-> (forall x. m x -> n x) -> RpcHandler api m -> RpcHandler api n
forall a (m :: * -> *) (n :: * -> *).
RouteJsonRpc a =>
Proxy a
-> (forall x. m x -> n x) -> RpcHandler a m -> RpcHandler a n
hoistRpcRouter (Proxy api
forall k (t :: k). Proxy t
Proxy @api) forall x. m x -> n x
f ServerT (RawJsonRpc api) m
RpcHandler api m
x


-- | This internal class is how we accumulate a map of handlers for dispatch
class RouteJsonRpc a where
    type RpcHandler a (m :: * -> *)
    jsonRpcRouter
        :: Monad m => Proxy a -> Proxy m -> RpcHandler a m
        -> Map String (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
    hoistRpcRouter :: Proxy a -> (forall x . m x -> n x) -> RpcHandler a m -> RpcHandler a n


generalizeResponse
    :: (ToJSON e, ToJSON r)
    => Either (JsonRpcErr e) r
    -> Either (JsonRpcErr Value) Value
generalizeResponse :: Either (JsonRpcErr e) r -> Either (JsonRpcErr Value) Value
generalizeResponse = (JsonRpcErr e -> JsonRpcErr Value)
-> (r -> Value)
-> Either (JsonRpcErr e) r
-> Either (JsonRpcErr Value) Value
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap JsonRpcErr e -> JsonRpcErr Value
forall a. ToJSON a => JsonRpcErr a -> JsonRpcErr Value
repack r -> Value
forall a. ToJSON a => a -> Value
toJSON
    where
    repack :: JsonRpcErr a -> JsonRpcErr Value
repack JsonRpcErr a
e = JsonRpcErr a
e { errorData :: Maybe Value
errorData = a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> Maybe a -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsonRpcErr a -> Maybe a
forall e. JsonRpcErr e -> Maybe e
errorData JsonRpcErr a
e }


onDecodeFail :: String -> JsonRpcErr e
onDecodeFail :: String -> JsonRpcErr e
onDecodeFail String
msg = Int -> String -> Maybe e -> JsonRpcErr e
forall e. Int -> String -> Maybe e -> JsonRpcErr e
JsonRpcErr Int
invalidParamsCode String
msg Maybe e
forall a. Maybe a
Nothing


instance (KnownSymbol method, FromJSON p, ToJSON e, ToJSON r) => RouteJsonRpc (JsonRpc method p e r) where
    type RpcHandler (JsonRpc method p e r) m = p -> m (Either (JsonRpcErr e) r)

    jsonRpcRouter :: Proxy (JsonRpc method p e r)
-> Proxy m
-> RpcHandler (JsonRpc method p e r) m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
jsonRpcRouter Proxy (JsonRpc method p e r)
_ Proxy m
_ RpcHandler (JsonRpc method p e r) m
h = [(String,
  Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))]
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (String
methodName, Value -> m (PossibleContent (Either (JsonRpcErr Value) Value))
h') ]
        where
        methodName :: String
methodName = Proxy method -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy method -> String) -> Proxy method -> String
forall a b. (a -> b) -> a -> b
$ Proxy method
forall k (t :: k). Proxy t
Proxy @method
        onDecode :: p -> m (Either (JsonRpcErr Value) Value)
onDecode   = (Either (JsonRpcErr e) r -> Either (JsonRpcErr Value) Value)
-> m (Either (JsonRpcErr e) r)
-> m (Either (JsonRpcErr Value) Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (JsonRpcErr e) r -> Either (JsonRpcErr Value) Value
forall e r.
(ToJSON e, ToJSON r) =>
Either (JsonRpcErr e) r -> Either (JsonRpcErr Value) Value
generalizeResponse (m (Either (JsonRpcErr e) r)
 -> m (Either (JsonRpcErr Value) Value))
-> (p -> m (Either (JsonRpcErr e) r))
-> p
-> m (Either (JsonRpcErr Value) Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RpcHandler (JsonRpc method p e r) m
p -> m (Either (JsonRpcErr e) r)
h

        h' :: Value -> m (PossibleContent (Either (JsonRpcErr Value) Value))
h' = (Either (JsonRpcErr Value) Value
 -> PossibleContent (Either (JsonRpcErr Value) Value))
-> m (Either (JsonRpcErr Value) Value)
-> m (PossibleContent (Either (JsonRpcErr Value) Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (JsonRpcErr Value) Value
-> PossibleContent (Either (JsonRpcErr Value) Value)
forall a. a -> PossibleContent a
SomeContent
           (m (Either (JsonRpcErr Value) Value)
 -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
-> (Value -> m (Either (JsonRpcErr Value) Value))
-> Value
-> m (PossibleContent (Either (JsonRpcErr Value) Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> m (Either (JsonRpcErr Value) Value))
-> (p -> m (Either (JsonRpcErr Value) Value))
-> Either String p
-> m (Either (JsonRpcErr Value) Value)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either (JsonRpcErr Value) Value
-> m (Either (JsonRpcErr Value) Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (JsonRpcErr Value) Value
 -> m (Either (JsonRpcErr Value) Value))
-> (String -> Either (JsonRpcErr Value) Value)
-> String
-> m (Either (JsonRpcErr Value) Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonRpcErr Value -> Either (JsonRpcErr Value) Value
forall a b. a -> Either a b
Left (JsonRpcErr Value -> Either (JsonRpcErr Value) Value)
-> (String -> JsonRpcErr Value)
-> String
-> Either (JsonRpcErr Value) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JsonRpcErr Value
forall e. String -> JsonRpcErr e
onDecodeFail) p -> m (Either (JsonRpcErr Value) Value)
onDecode
           (Either String p -> m (Either (JsonRpcErr Value) Value))
-> (Value -> Either String p)
-> Value
-> m (Either (JsonRpcErr Value) Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser p) -> Value -> Either String p
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser p
forall a. FromJSON a => Value -> Parser a
parseJSON

    hoistRpcRouter :: Proxy (JsonRpc method p e r)
-> (forall x. m x -> n x)
-> RpcHandler (JsonRpc method p e r) m
-> RpcHandler (JsonRpc method p e r) n
hoistRpcRouter Proxy (JsonRpc method p e r)
_ forall x. m x -> n x
f RpcHandler (JsonRpc method p e r) m
x = m (Either (JsonRpcErr e) r) -> n (Either (JsonRpcErr e) r)
forall x. m x -> n x
f (m (Either (JsonRpcErr e) r) -> n (Either (JsonRpcErr e) r))
-> (p -> m (Either (JsonRpcErr e) r))
-> p
-> n (Either (JsonRpcErr e) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RpcHandler (JsonRpc method p e r) m
p -> m (Either (JsonRpcErr e) r)
x


instance (KnownSymbol method, FromJSON p) => RouteJsonRpc (JsonRpcNotification method p) where
    type RpcHandler (JsonRpcNotification method p) m = p -> m NoContent

    jsonRpcRouter :: Proxy (JsonRpcNotification method p)
-> Proxy m
-> RpcHandler (JsonRpcNotification method p) m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
jsonRpcRouter Proxy (JsonRpcNotification method p)
_ Proxy m
_ RpcHandler (JsonRpcNotification method p) m
h = [(String,
  Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))]
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (String
methodName, Value -> m (PossibleContent (Either (JsonRpcErr Value) Value))
h') ]
        where
        methodName :: String
methodName = Proxy method -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy method -> String) -> Proxy method -> String
forall a b. (a -> b) -> a -> b
$ Proxy method
forall k (t :: k). Proxy t
Proxy @method
        onDecode :: p -> m (PossibleContent (Either (JsonRpcErr Value) Value))
onDecode p
x = PossibleContent (Either (JsonRpcErr Value) Value)
forall a. PossibleContent a
EmptyContent PossibleContent (Either (JsonRpcErr Value) Value)
-> m NoContent
-> m (PossibleContent (Either (JsonRpcErr Value) Value))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RpcHandler (JsonRpcNotification method p) m
p -> m NoContent
h p
x

        h' :: Value -> m (PossibleContent (Either (JsonRpcErr Value) Value))
h' = (String -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
-> (p -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
-> Either String p
-> m (PossibleContent (Either (JsonRpcErr Value) Value))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PossibleContent (Either (JsonRpcErr Value) Value)
-> m (PossibleContent (Either (JsonRpcErr Value) Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (PossibleContent (Either (JsonRpcErr Value) Value)
 -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
-> (String -> PossibleContent (Either (JsonRpcErr Value) Value))
-> String
-> m (PossibleContent (Either (JsonRpcErr Value) Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (JsonRpcErr Value) Value
-> PossibleContent (Either (JsonRpcErr Value) Value)
forall a. a -> PossibleContent a
SomeContent (Either (JsonRpcErr Value) Value
 -> PossibleContent (Either (JsonRpcErr Value) Value))
-> (String -> Either (JsonRpcErr Value) Value)
-> String
-> PossibleContent (Either (JsonRpcErr Value) Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonRpcErr Value -> Either (JsonRpcErr Value) Value
forall a b. a -> Either a b
Left (JsonRpcErr Value -> Either (JsonRpcErr Value) Value)
-> (String -> JsonRpcErr Value)
-> String
-> Either (JsonRpcErr Value) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JsonRpcErr Value
forall e. String -> JsonRpcErr e
onDecodeFail) p -> m (PossibleContent (Either (JsonRpcErr Value) Value))
onDecode
           (Either String p
 -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
-> (Value -> Either String p)
-> Value
-> m (PossibleContent (Either (JsonRpcErr Value) Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser p) -> Value -> Either String p
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser p
forall a. FromJSON a => Value -> Parser a
parseJSON

    hoistRpcRouter :: Proxy (JsonRpcNotification method p)
-> (forall x. m x -> n x)
-> RpcHandler (JsonRpcNotification method p) m
-> RpcHandler (JsonRpcNotification method p) n
hoistRpcRouter Proxy (JsonRpcNotification method p)
_ forall x. m x -> n x
f RpcHandler (JsonRpcNotification method p) m
x = m NoContent -> n NoContent
forall x. m x -> n x
f (m NoContent -> n NoContent)
-> (p -> m NoContent) -> p -> n NoContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RpcHandler (JsonRpcNotification method p) m
p -> m NoContent
x


instance (RouteJsonRpc a, RouteJsonRpc b) => RouteJsonRpc (a :<|> b) where
    type RpcHandler (a :<|> b) m = RpcHandler a m :<|> RpcHandler b m

    jsonRpcRouter :: Proxy (a :<|> b)
-> Proxy m
-> RpcHandler (a :<|> b) m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
jsonRpcRouter Proxy (a :<|> b)
_ Proxy m
pxm (ha :<|> hb) = Proxy a
-> Proxy m
-> RpcHandler a m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
forall a (m :: * -> *).
(RouteJsonRpc a, Monad m) =>
Proxy a
-> Proxy m
-> RpcHandler a m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
jsonRpcRouter Proxy a
pxa Proxy m
pxm RpcHandler a m
ha Map
  String
  (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
forall a. Semigroup a => a -> a -> a
<> Proxy b
-> Proxy m
-> RpcHandler b m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
forall a (m :: * -> *).
(RouteJsonRpc a, Monad m) =>
Proxy a
-> Proxy m
-> RpcHandler a m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
jsonRpcRouter Proxy b
pxb Proxy m
pxm RpcHandler b m
hb
        where
        pxa :: Proxy a
pxa = Proxy a
forall k (t :: k). Proxy t
Proxy @a
        pxb :: Proxy b
pxb = Proxy b
forall k (t :: k). Proxy t
Proxy @b

    hoistRpcRouter :: Proxy (a :<|> b)
-> (forall x. m x -> n x)
-> RpcHandler (a :<|> b) m
-> RpcHandler (a :<|> b) n
hoistRpcRouter Proxy (a :<|> b)
_ forall x. m x -> n x
f (x :<|> y) = Proxy a
-> (forall x. m x -> n x) -> RpcHandler a m -> RpcHandler a n
forall a (m :: * -> *) (n :: * -> *).
RouteJsonRpc a =>
Proxy a
-> (forall x. m x -> n x) -> RpcHandler a m -> RpcHandler a n
hoistRpcRouter (Proxy a
forall k (t :: k). Proxy t
Proxy @a) forall x. m x -> n x
f RpcHandler a m
x RpcHandler a n
-> RpcHandler b n -> RpcHandler a n :<|> RpcHandler b n
forall a b. a -> b -> a :<|> b
:<|> Proxy b
-> (forall x. m x -> n x) -> RpcHandler b m -> RpcHandler b n
forall a (m :: * -> *) (n :: * -> *).
RouteJsonRpc a =>
Proxy a
-> (forall x. m x -> n x) -> RpcHandler a m -> RpcHandler a n
hoistRpcRouter (Proxy b
forall k (t :: k). Proxy t
Proxy @b) forall x. m x -> n x
f RpcHandler b m
y


-- | This function is the glue required to convert a collection of
-- handlers in servant standard style to the handler that 'RawJsonRpc'
-- expects.
serveJsonRpc
    :: (Monad m, RouteJsonRpc a)
    => Proxy a
    -> Proxy m
    -> RpcHandler a m
    -> Request Value
    -> m PossibleJsonRpcResponse
serveJsonRpc :: Proxy a
-> Proxy m
-> RpcHandler a m
-> Request Value
-> m (PossibleContent (JsonRpcResponse Value Value))
serveJsonRpc Proxy a
px Proxy m
pxm RpcHandler a m
hs (Request String
m Value
v Maybe Word64
ix')
    | Just Value -> m (PossibleContent (Either (JsonRpcErr Value) Value))
h <- String
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
-> Maybe
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
m Map
  String
  (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
hmap
    = Value -> m (PossibleContent (Either (JsonRpcErr Value) Value))
h Value
v m (PossibleContent (Either (JsonRpcErr Value) Value))
-> (PossibleContent (Either (JsonRpcErr Value) Value)
    -> m (PossibleContent (JsonRpcResponse Value Value)))
-> m (PossibleContent (JsonRpcResponse Value Value))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        SomeContent (Right Value
x) | Just Word64
ix <- Maybe Word64
ix' -> PossibleContent (JsonRpcResponse Value Value)
-> m (PossibleContent (JsonRpcResponse Value Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (PossibleContent (JsonRpcResponse Value Value)
 -> m (PossibleContent (JsonRpcResponse Value Value)))
-> (JsonRpcResponse Value Value
    -> PossibleContent (JsonRpcResponse Value Value))
-> JsonRpcResponse Value Value
-> m (PossibleContent (JsonRpcResponse Value Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonRpcResponse Value Value
-> PossibleContent (JsonRpcResponse Value Value)
forall a. a -> PossibleContent a
SomeContent (JsonRpcResponse Value Value
 -> m (PossibleContent (JsonRpcResponse Value Value)))
-> JsonRpcResponse Value Value
-> m (PossibleContent (JsonRpcResponse Value Value))
forall a b. (a -> b) -> a -> b
$ Word64 -> Value -> JsonRpcResponse Value Value
forall e r. Word64 -> r -> JsonRpcResponse e r
Result Word64
ix Value
x
                              | Bool
otherwise      -> PossibleContent (JsonRpcResponse Value Value)
-> m (PossibleContent (JsonRpcResponse Value Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (PossibleContent (JsonRpcResponse Value Value)
 -> m (PossibleContent (JsonRpcResponse Value Value)))
-> (JsonRpcResponse Value Value
    -> PossibleContent (JsonRpcResponse Value Value))
-> JsonRpcResponse Value Value
-> m (PossibleContent (JsonRpcResponse Value Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonRpcResponse Value Value
-> PossibleContent (JsonRpcResponse Value Value)
forall a. a -> PossibleContent a
SomeContent (JsonRpcResponse Value Value
 -> m (PossibleContent (JsonRpcResponse Value Value)))
-> JsonRpcResponse Value Value
-> m (PossibleContent (JsonRpcResponse Value Value))
forall a b. (a -> b) -> a -> b
$ Maybe Word64 -> JsonRpcErr Value -> JsonRpcResponse Value Value
forall e r. Maybe Word64 -> JsonRpcErr e -> JsonRpcResponse e r
Errors Maybe Word64
ix' JsonRpcErr Value
forall e. JsonRpcErr e
invalidRequest
        SomeContent (Left JsonRpcErr Value
e)                   -> PossibleContent (JsonRpcResponse Value Value)
-> m (PossibleContent (JsonRpcResponse Value Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (PossibleContent (JsonRpcResponse Value Value)
 -> m (PossibleContent (JsonRpcResponse Value Value)))
-> (JsonRpcResponse Value Value
    -> PossibleContent (JsonRpcResponse Value Value))
-> JsonRpcResponse Value Value
-> m (PossibleContent (JsonRpcResponse Value Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonRpcResponse Value Value
-> PossibleContent (JsonRpcResponse Value Value)
forall a. a -> PossibleContent a
SomeContent (JsonRpcResponse Value Value
 -> m (PossibleContent (JsonRpcResponse Value Value)))
-> JsonRpcResponse Value Value
-> m (PossibleContent (JsonRpcResponse Value Value))
forall a b. (a -> b) -> a -> b
$ Maybe Word64 -> JsonRpcErr Value -> JsonRpcResponse Value Value
forall e r. Maybe Word64 -> JsonRpcErr e -> JsonRpcResponse e r
Errors Maybe Word64
ix' JsonRpcErr Value
e
        PossibleContent (Either (JsonRpcErr Value) Value)
EmptyContent                           -> PossibleContent (JsonRpcResponse Value Value)
-> m (PossibleContent (JsonRpcResponse Value Value))
forall (m :: * -> *) a. Monad m => a -> m a
return PossibleContent (JsonRpcResponse Value Value)
forall a. PossibleContent a
EmptyContent
    | Bool
otherwise = PossibleContent (JsonRpcResponse Value Value)
-> m (PossibleContent (JsonRpcResponse Value Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (PossibleContent (JsonRpcResponse Value Value)
 -> m (PossibleContent (JsonRpcResponse Value Value)))
-> (JsonRpcResponse Value Value
    -> PossibleContent (JsonRpcResponse Value Value))
-> JsonRpcResponse Value Value
-> m (PossibleContent (JsonRpcResponse Value Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonRpcResponse Value Value
-> PossibleContent (JsonRpcResponse Value Value)
forall a. a -> PossibleContent a
SomeContent (JsonRpcResponse Value Value
 -> m (PossibleContent (JsonRpcResponse Value Value)))
-> JsonRpcResponse Value Value
-> m (PossibleContent (JsonRpcResponse Value Value))
forall a b. (a -> b) -> a -> b
$ Maybe Word64 -> JsonRpcErr Value -> JsonRpcResponse Value Value
forall e r. Maybe Word64 -> JsonRpcErr e -> JsonRpcResponse e r
Errors Maybe Word64
ix' JsonRpcErr Value
missingMethod
    where
    missingMethod :: JsonRpcErr Value
missingMethod  = Int -> String -> Maybe Value -> JsonRpcErr Value
forall e. Int -> String -> Maybe e -> JsonRpcErr e
JsonRpcErr Int
methodNotFoundCode (String
"Unknown method: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
m) Maybe Value
forall a. Maybe a
Nothing
    hmap :: Map
  String
  (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
hmap           = Proxy a
-> Proxy m
-> RpcHandler a m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
forall a (m :: * -> *).
(RouteJsonRpc a, Monad m) =>
Proxy a
-> Proxy m
-> RpcHandler a m
-> Map
     String
     (Value -> m (PossibleContent (Either (JsonRpcErr Value) Value)))
jsonRpcRouter Proxy a
px Proxy m
pxm RpcHandler a m
hs
    invalidRequest :: JsonRpcErr e
invalidRequest = Int -> String -> Maybe e -> JsonRpcErr e
forall e. Int -> String -> Maybe e -> JsonRpcErr e
JsonRpcErr Int
invalidRequestCode String
"Missing id" Maybe e
forall a. Maybe a
Nothing