{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}

module Utxorpc.Build (BuildHandlers (..), serviceHandlers) where

import Control.Monad.IO.Class (MonadIO)
import Network.GRPC.HTTP2.ProtoLens (RPC (RPC))
import Network.GRPC.Server (ServerStreamHandler, ServiceHandler, UnaryHandler)
import Proto.Utxorpc.V1alpha.Build.Build
import Utxorpc.Logged (UtxorpcServiceLogger, loggedSStream, loggedUnary)

data BuildHandlers m a = BuildHandlers
  { forall (m :: * -> *) a.
BuildHandlers m a
-> UnaryHandler m GetChainTipRequest GetChainTipResponse
getChainTip :: UnaryHandler m GetChainTipRequest GetChainTipResponse,
    forall (m :: * -> *) a.
BuildHandlers m a
-> UnaryHandler m GetChainParamRequest GetChainParamResponse
getChainParam :: UnaryHandler m GetChainParamRequest GetChainParamResponse,
    forall (m :: * -> *) a.
BuildHandlers m a
-> UnaryHandler m GetUtxoByAddressRequest GetUtxoByAddressResponse
getUtxoByAddress :: UnaryHandler m GetUtxoByAddressRequest GetUtxoByAddressResponse,
    forall (m :: * -> *) a.
BuildHandlers m a
-> UnaryHandler m GetUtxoByRefRequest GetUtxoByRefResponse
getUtxoByRef :: UnaryHandler m GetUtxoByRefRequest GetUtxoByRefResponse,
    forall (m :: * -> *) a.
BuildHandlers m a
-> ServerStreamHandler m HoldUtxoRequest HoldUtxoResponse a
holdUtxo :: ServerStreamHandler m HoldUtxoRequest HoldUtxoResponse a
  }

serviceHandlers ::
  (MonadIO m) =>
  Maybe (UtxorpcServiceLogger m) ->
  (forall x. m x -> IO x) ->
  BuildHandlers m b ->
  [ServiceHandler]
serviceHandlers :: forall (m :: * -> *) b.
MonadIO m =>
Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x) -> BuildHandlers m b -> [ServiceHandler]
serviceHandlers Maybe (UtxorpcServiceLogger m)
logger forall x. m x -> IO x
f BuildHandlers {UnaryHandler m GetChainTipRequest GetChainTipResponse
getChainTip :: forall (m :: * -> *) a.
BuildHandlers m a
-> UnaryHandler m GetChainTipRequest GetChainTipResponse
getChainTip :: UnaryHandler m GetChainTipRequest GetChainTipResponse
getChainTip, UnaryHandler m GetChainParamRequest GetChainParamResponse
getChainParam :: forall (m :: * -> *) a.
BuildHandlers m a
-> UnaryHandler m GetChainParamRequest GetChainParamResponse
getChainParam :: UnaryHandler m GetChainParamRequest GetChainParamResponse
getChainParam, UnaryHandler m GetUtxoByAddressRequest GetUtxoByAddressResponse
getUtxoByAddress :: forall (m :: * -> *) a.
BuildHandlers m a
-> UnaryHandler m GetUtxoByAddressRequest GetUtxoByAddressResponse
getUtxoByAddress :: UnaryHandler m GetUtxoByAddressRequest GetUtxoByAddressResponse
getUtxoByAddress, UnaryHandler m GetUtxoByRefRequest GetUtxoByRefResponse
getUtxoByRef :: forall (m :: * -> *) a.
BuildHandlers m a
-> UnaryHandler m GetUtxoByRefRequest GetUtxoByRefResponse
getUtxoByRef :: UnaryHandler m GetUtxoByRefRequest GetUtxoByRefResponse
getUtxoByRef, ServerStreamHandler m HoldUtxoRequest HoldUtxoResponse b
holdUtxo :: forall (m :: * -> *) a.
BuildHandlers m a
-> ServerStreamHandler m HoldUtxoRequest HoldUtxoResponse a
holdUtxo :: ServerStreamHandler m HoldUtxoRequest HoldUtxoResponse b
holdUtxo} =
  [ServiceHandler
chainTipSH, ServiceHandler
chainParamSH, ServiceHandler
byAddressSH, ServiceHandler
byRefSH, ServiceHandler
holdSH]
  where
    chainTipSH :: ServiceHandler
chainTipSH = (forall x. m x -> IO x)
-> RPC LedgerStateService "getChainTip"
-> UnaryHandler m GetChainTipRequest GetChainTipResponse
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
forall (m :: * -> *) r i o.
(MonadIO m, GRPCInput r i, GRPCOutput r o, Show i, Show o) =>
(forall x. m x -> IO x)
-> r
-> UnaryHandler m i o
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
loggedUnary m x -> IO x
forall x. m x -> IO x
f (RPC LedgerStateService "getChainTip"
forall s (m :: Symbol). RPC s m
RPC :: RPC LedgerStateService "getChainTip") UnaryHandler m GetChainTipRequest GetChainTipResponse
getChainTip Maybe (UtxorpcServiceLogger m)
logger
    chainParamSH :: ServiceHandler
chainParamSH = (forall x. m x -> IO x)
-> RPC LedgerStateService "getChainParam"
-> UnaryHandler m GetChainParamRequest GetChainParamResponse
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
forall (m :: * -> *) r i o.
(MonadIO m, GRPCInput r i, GRPCOutput r o, Show i, Show o) =>
(forall x. m x -> IO x)
-> r
-> UnaryHandler m i o
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
loggedUnary m x -> IO x
forall x. m x -> IO x
f (RPC LedgerStateService "getChainParam"
forall s (m :: Symbol). RPC s m
RPC :: RPC LedgerStateService "getChainParam") UnaryHandler m GetChainParamRequest GetChainParamResponse
getChainParam Maybe (UtxorpcServiceLogger m)
logger
    byAddressSH :: ServiceHandler
byAddressSH = (forall x. m x -> IO x)
-> RPC LedgerStateService "getUtxoByAddress"
-> UnaryHandler m GetUtxoByAddressRequest GetUtxoByAddressResponse
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
forall (m :: * -> *) r i o.
(MonadIO m, GRPCInput r i, GRPCOutput r o, Show i, Show o) =>
(forall x. m x -> IO x)
-> r
-> UnaryHandler m i o
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
loggedUnary m x -> IO x
forall x. m x -> IO x
f (RPC LedgerStateService "getUtxoByAddress"
forall s (m :: Symbol). RPC s m
RPC :: RPC LedgerStateService "getUtxoByAddress") UnaryHandler m GetUtxoByAddressRequest GetUtxoByAddressResponse
getUtxoByAddress Maybe (UtxorpcServiceLogger m)
logger
    byRefSH :: ServiceHandler
byRefSH = (forall x. m x -> IO x)
-> RPC LedgerStateService "getUtxoByRef"
-> UnaryHandler m GetUtxoByRefRequest GetUtxoByRefResponse
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
forall (m :: * -> *) r i o.
(MonadIO m, GRPCInput r i, GRPCOutput r o, Show i, Show o) =>
(forall x. m x -> IO x)
-> r
-> UnaryHandler m i o
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
loggedUnary m x -> IO x
forall x. m x -> IO x
f (RPC LedgerStateService "getUtxoByRef"
forall s (m :: Symbol). RPC s m
RPC :: RPC LedgerStateService "getUtxoByRef") UnaryHandler m GetUtxoByRefRequest GetUtxoByRefResponse
getUtxoByRef Maybe (UtxorpcServiceLogger m)
logger
    holdSH :: ServiceHandler
holdSH = (forall x. m x -> IO x)
-> RPC LedgerStateService "holdUtxo"
-> ServerStreamHandler m HoldUtxoRequest HoldUtxoResponse b
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
forall (m :: * -> *) r i o a.
(MonadIO m, GRPCInput r i, GRPCOutput r o, Show i, Show o) =>
(forall x. m x -> IO x)
-> r
-> ServerStreamHandler m i o a
-> Maybe (UtxorpcServiceLogger m)
-> ServiceHandler
loggedSStream m x -> IO x
forall x. m x -> IO x
f (RPC LedgerStateService "holdUtxo"
forall s (m :: Symbol). RPC s m
RPC :: RPC LedgerStateService "holdUtxo") ServerStreamHandler m HoldUtxoRequest HoldUtxoResponse b
holdUtxo Maybe (UtxorpcServiceLogger m)
logger