{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{- |
Module: Servant.Client.JsonRpc

This module provides support for generating JSON-RPC clients in the Servant framework.

> type Mul = JsonRpc "mul" (Int, Int) String Int
> mul :: (Int, Int) -> ClientM (JsonRpcResponse String Int)
> mul = client $ Proxy @Mul

Note: This client implementation runs over HTTP and the semantics of HTTP
remove the need for the message id.
-}
module Servant.Client.JsonRpc (
  module Servant.JsonRpc,
) where

import Data.Proxy (Proxy (..))
import GHC.TypeLits (KnownSymbol, symbolVal)
import Servant.API (MimeRender, MimeUnrender, NoContent, (:<|>))
import Servant.Client.Core (HasClient (..), RunClient)

import Servant.JsonRpc

-- | The 'RawJsonRpc' construct is completely transparent to clients
instance
  (RunClient m, HasClient m (RawJsonRpc ctype apiL), HasClient m (RawJsonRpc ctype apiR)) =>
  HasClient m (RawJsonRpc ctype (apiL :<|> apiR))
  where
  type Client m (RawJsonRpc ctype (apiL :<|> apiR)) = Client m (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
  clientWithRoute :: Proxy m
-> Proxy (RawJsonRpc ctype (apiL :<|> apiR))
-> Request
-> Client m (RawJsonRpc ctype (apiL :<|> apiR))
clientWithRoute Proxy m
pxm Proxy (RawJsonRpc ctype (apiL :<|> apiR))
_ = Proxy m
-> Proxy (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
-> Request
-> Client m (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pxm (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR))
  hoistClientMonad :: forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy (RawJsonRpc ctype (apiL :<|> apiR))
-> (forall x. mon x -> mon' x)
-> Client mon (RawJsonRpc ctype (apiL :<|> apiR))
-> Client mon' (RawJsonRpc ctype (apiL :<|> apiR))
hoistClientMonad Proxy m
pxm Proxy (RawJsonRpc ctype (apiL :<|> apiR))
_ = Proxy m
-> Proxy (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
-> (forall x. mon x -> mon' x)
-> Client mon (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
-> Client mon' (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
-> (forall x. mon x -> mon' x)
-> Client mon (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
-> Client mon' (RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR)
hoistClientMonad Proxy m
pxm (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(RawJsonRpc ctype apiL :<|> RawJsonRpc ctype apiR))

instance
  ( RunClient m
  , KnownSymbol method
  , MimeRender ctype (Request p)
  , MimeUnrender ctype (JsonRpcResponse e r)
  ) =>
  HasClient m (RawJsonRpc ctype (JsonRpc method p e r))
  where
  type
    Client m (RawJsonRpc ctype (JsonRpc method p e r)) =
      p -> m (JsonRpcResponse e r)

  clientWithRoute :: Proxy m
-> Proxy (RawJsonRpc ctype (JsonRpc method p e r))
-> Request
-> Client m (RawJsonRpc ctype (JsonRpc method p e r))
clientWithRoute Proxy m
_ Proxy (RawJsonRpc ctype (JsonRpc method p e r))
_ Request
req p
p =
    Request
-> Client
     m
     (ReqBody '[ctype] (Request p)
      :> Post '[ctype] (JsonRpcResponse e r))
client Request
req Request p
jsonRpcRequest
   where
    client :: Request
-> Client
     m
     (ReqBody '[ctype] (Request p)
      :> Post '[ctype] (JsonRpcResponse e r))
client = Proxy m
-> Proxy
     (ReqBody '[ctype] (Request p)
      :> Post '[ctype] (JsonRpcResponse e r))
-> Request
-> Client
     m
     (ReqBody '[ctype] (Request p)
      :> Post '[ctype] (JsonRpcResponse e r))
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @m) Proxy
  (ReqBody '[ctype] (Request p)
   :> Post '[ctype] (JsonRpcResponse e r))
Proxy (JsonRpcEndpoint ctype (JsonRpc method p e r))
endpoint
    jsonRpcRequest :: Request p
jsonRpcRequest = String -> p -> Maybe Word64 -> Request p
forall p. String -> p -> Maybe Word64 -> Request p
Request (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
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @method) p
p (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0)

    endpoint :: Proxy (JsonRpcEndpoint ctype (JsonRpc method p e r))
endpoint = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(JsonRpcEndpoint ctype (JsonRpc method p e r))

  hoistClientMonad :: forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy (RawJsonRpc ctype (JsonRpc method p e r))
-> (forall x. mon x -> mon' x)
-> Client mon (RawJsonRpc ctype (JsonRpc method p e r))
-> Client mon' (RawJsonRpc ctype (JsonRpc method p e r))
hoistClientMonad Proxy m
_ Proxy (RawJsonRpc ctype (JsonRpc method p e r))
_ forall x. mon x -> mon' x
f Client mon (RawJsonRpc ctype (JsonRpc method p e r))
x p
p = mon (JsonRpcResponse e r) -> mon' (JsonRpcResponse e r)
forall x. mon x -> mon' x
f (mon (JsonRpcResponse e r) -> mon' (JsonRpcResponse e r))
-> mon (JsonRpcResponse e r) -> mon' (JsonRpcResponse e r)
forall a b. (a -> b) -> a -> b
$ Client mon (RawJsonRpc ctype (JsonRpc method p e r))
p -> mon (JsonRpcResponse e r)
x p
p

instance
  ( RunClient m
  , KnownSymbol method
  , MimeRender ctype (Request p)
  ) =>
  HasClient m (RawJsonRpc ctype (JsonRpcNotification method p))
  where
  type
    Client m (RawJsonRpc ctype (JsonRpcNotification method p)) =
      p -> m NoContent

  clientWithRoute :: Proxy m
-> Proxy (RawJsonRpc ctype (JsonRpcNotification method p))
-> Request
-> Client m (RawJsonRpc ctype (JsonRpcNotification method p))
clientWithRoute Proxy m
_ Proxy (RawJsonRpc ctype (JsonRpcNotification method p))
_ Request
req p
p =
    Request
-> Client
     m (ReqBody '[ctype] (Request p) :> Post '[ctype] NoContent)
client Request
req Request p
jsonRpcRequest
   where
    client :: Request
-> Client
     m (ReqBody '[ctype] (Request p) :> Post '[ctype] NoContent)
client = Proxy m
-> Proxy (ReqBody '[ctype] (Request p) :> Post '[ctype] NoContent)
-> Request
-> Client
     m (ReqBody '[ctype] (Request p) :> Post '[ctype] NoContent)
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @m) Proxy (ReqBody '[ctype] (Request p) :> Post '[ctype] NoContent)
Proxy (JsonRpcEndpoint ctype (JsonRpcNotification method p))
endpoint
    jsonRpcRequest :: Request p
jsonRpcRequest = String -> p -> Maybe Word64 -> Request p
forall p. String -> p -> Maybe Word64 -> Request p
Request (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
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @method) p
p Maybe Word64
forall a. Maybe a
Nothing

    endpoint :: Proxy (JsonRpcEndpoint ctype (JsonRpcNotification method p))
endpoint = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(JsonRpcEndpoint ctype (JsonRpcNotification method p))

  hoistClientMonad :: forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy (RawJsonRpc ctype (JsonRpcNotification method p))
-> (forall x. mon x -> mon' x)
-> Client mon (RawJsonRpc ctype (JsonRpcNotification method p))
-> Client mon' (RawJsonRpc ctype (JsonRpcNotification method p))
hoistClientMonad Proxy m
_ Proxy (RawJsonRpc ctype (JsonRpcNotification method p))
_ forall x. mon x -> mon' x
f Client mon (RawJsonRpc ctype (JsonRpcNotification method p))
x p
p = mon NoContent -> mon' NoContent
forall x. mon x -> mon' x
f (mon NoContent -> mon' NoContent)
-> mon NoContent -> mon' NoContent
forall a b. (a -> b) -> a -> b
$ Client mon (RawJsonRpc ctype (JsonRpcNotification method p))
p -> mon NoContent
x p
p