{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Rpc.Server
  ( runRpcServer
  , NodeKernelAccess
  , mkNodeKernelAccess
  , registeredServiceNames

    -- * Traces
  , TraceRpc (..)
  , TraceRpcSubmit (..)
  , TraceRpcQuery (..)
  , TraceRpcSync (..)
  , TraceRpcNodeKernelAccess (..)
  , TraceSpanEvent (..)
  )
where

import Cardano.Api
import Cardano.Rpc.Proto.Api.Node qualified as Rpc
import Cardano.Rpc.Proto.Api.Reflection.V1 qualified as ReflectionV1
import Cardano.Rpc.Proto.Api.Reflection.V1alpha qualified as ReflectionV1alpha
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
import Cardano.Rpc.Proto.Api.UtxoRpc.Submit qualified as UtxoRpc
import Cardano.Rpc.Proto.Api.UtxoRpc.Sync qualified as UtxoRpc
import Cardano.Rpc.Server.Config
import Cardano.Rpc.Server.Internal.Env
import Cardano.Rpc.Server.Internal.Error (renderRpcExceptionForClient)
import Cardano.Rpc.Server.Internal.Monad
import Cardano.Rpc.Server.Internal.Node
import Cardano.Rpc.Server.Internal.Orphans ()
import Cardano.Rpc.Server.Internal.Reflection
  ( qualifiedServiceName
  , serverReflectionInfoMethodV1
  , serverReflectionInfoMethodV1alpha
  )
import Cardano.Rpc.Server.Internal.Tracing
import Cardano.Rpc.Server.Internal.UtxoRpc.Eval
import Cardano.Rpc.Server.Internal.UtxoRpc.Query
import Cardano.Rpc.Server.Internal.UtxoRpc.Submit
import Cardano.Rpc.Server.Internal.UtxoRpc.Sync
import Cardano.Rpc.Server.NodeKernelAccess
  ( NodeKernelAccess
  , mkNodeKernelAccess
  )

import RIO

import Control.Tracer
import Network.GRPC.Common
import Network.GRPC.Server
import Network.GRPC.Server.Protobuf
import Network.GRPC.Server.Run
import Network.GRPC.Server.StreamType

-- | gRPC method table for the @Node@ service.
methodsNodeRpc
  :: MonadRpc e m
  => Methods m (ProtobufMethodsOf Rpc.Node)
methodsNodeRpc :: forall e (m :: * -> *).
MonadRpc e m =>
Methods m (ProtobufMethodsOf Node)
methodsNodeRpc =
  ServerHandler' 'NonStreaming m (Protobuf Node "getEra")
-> Methods m '[Protobuf Node "getProtocolParamsJson"]
-> Methods
     m '[Protobuf Node "getEra", Protobuf Node "getProtocolParamsJson"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf Node "getEra")
 -> m (Output (Protobuf Node "getEra")))
-> ServerHandler' 'NonStreaming m (Protobuf Node "getEra")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming Input (Protobuf Node "getEra")
-> m (Output (Protobuf Node "getEra"))
Proto Empty -> m (Proto CurrentEra)
forall e (m :: * -> *).
MonadRpc e m =>
Proto Empty -> m (Proto CurrentEra)
getEraMethod)
    (Methods m '[Protobuf Node "getProtocolParamsJson"]
 -> Methods m (ProtobufMethodsOf Node))
-> (Methods m '[]
    -> Methods m '[Protobuf Node "getProtocolParamsJson"])
-> Methods m '[]
-> Methods m (ProtobufMethodsOf Node)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler'
  'NonStreaming m (Protobuf Node "getProtocolParamsJson")
-> Methods m '[]
-> Methods m '[Protobuf Node "getProtocolParamsJson"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf Node "getProtocolParamsJson")
 -> m (Output (Protobuf Node "getProtocolParamsJson")))
-> ServerHandler'
     'NonStreaming m (Protobuf Node "getProtocolParamsJson")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming Input (Protobuf Node "getProtocolParamsJson")
-> m (Output (Protobuf Node "getProtocolParamsJson"))
Proto Empty -> m (Proto ProtocolParamsJson)
forall e (m :: * -> *).
MonadRpc e m =>
Proto Empty -> m (Proto ProtocolParamsJson)
getProtocolParamsJsonMethod)
    (Methods m '[] -> Methods m (ProtobufMethodsOf Node))
-> Methods m '[] -> Methods m (ProtobufMethodsOf Node)
forall a b. (a -> b) -> a -> b
$ Methods m '[]
forall {k} (m :: * -> *). Methods m '[]
NoMoreMethods

-- | gRPC method table for the UTxO RPC @QueryService@.
-- Method order must match 'ServiceMethods': readData, readEraSummary, readGenesis, readParams,
-- readState, readTx, readUtxos, searchUtxos.
-- 'UnsupportedMethod' makes the server respond with the @UNIMPLEMENTED@ gRPC status.
methodsUtxoRpc
  :: MonadRpc e m
  => Methods m (ProtobufMethodsOf UtxoRpc.QueryService)
methodsUtxoRpc :: forall e (m :: * -> *).
MonadRpc e m =>
Methods m (ProtobufMethodsOf QueryService)
methodsUtxoRpc =
  Methods
  m
  '[Protobuf QueryService "readEraSummary",
    Protobuf QueryService "readGenesis",
    Protobuf QueryService "readParams",
    Protobuf QueryService "readState", Protobuf QueryService "readTx",
    Protobuf QueryService "readUtxos",
    Protobuf QueryService "searchUtxos"]
-> Methods
     m
     '[Protobuf QueryService "readData",
       Protobuf QueryService "readEraSummary",
       Protobuf QueryService "readGenesis",
       Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
Methods
  m
  '[Protobuf QueryService "readEraSummary",
    Protobuf QueryService "readGenesis",
    Protobuf QueryService "readParams",
    Protobuf QueryService "readState", Protobuf QueryService "readTx",
    Protobuf QueryService "readUtxos",
    Protobuf QueryService "searchUtxos"]
-> Methods m (ProtobufMethodsOf QueryService)
forall {k} (m :: * -> *) (rpcs1 :: [k]) (rpc :: k).
Methods m rpcs1 -> Methods m (rpc : rpcs1)
UnsupportedMethod -- readData
    (Methods
   m
   '[Protobuf QueryService "readEraSummary",
     Protobuf QueryService "readGenesis",
     Protobuf QueryService "readParams",
     Protobuf QueryService "readState", Protobuf QueryService "readTx",
     Protobuf QueryService "readUtxos",
     Protobuf QueryService "searchUtxos"]
 -> Methods m (ProtobufMethodsOf QueryService))
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf QueryService "readEraSummary",
           Protobuf QueryService "readGenesis",
           Protobuf QueryService "readParams",
           Protobuf QueryService "readState", Protobuf QueryService "readTx",
           Protobuf QueryService "readUtxos",
           Protobuf QueryService "searchUtxos"])
-> Methods m '[]
-> Methods m (ProtobufMethodsOf QueryService)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler'
  'NonStreaming m (Protobuf QueryService "readEraSummary")
-> Methods
     m
     '[Protobuf QueryService "readGenesis",
       Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
-> Methods
     m
     '[Protobuf QueryService "readEraSummary",
       Protobuf QueryService "readGenesis",
       Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf QueryService "readEraSummary")
 -> m (Output (Protobuf QueryService "readEraSummary")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "readEraSummary")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf QueryService "readEraSummary")
  -> m (Output (Protobuf QueryService "readEraSummary")))
 -> ServerHandler'
      'NonStreaming m (Protobuf QueryService "readEraSummary"))
-> (Input (Protobuf QueryService "readEraSummary")
    -> m (Output (Protobuf QueryService "readEraSummary")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "readEraSummary")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcQuery)
-> m (Proto ReadEraSummaryResponse)
-> m (Proto ReadEraSummaryResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcQuery
TraceRpcQueryReadEraSummarySpan (m (Proto ReadEraSummaryResponse)
 -> m (Output (Protobuf QueryService "readEraSummary")))
-> (Input (Protobuf QueryService "readEraSummary")
    -> m (Proto ReadEraSummaryResponse))
-> Input (Protobuf QueryService "readEraSummary")
-> m (Output (Protobuf QueryService "readEraSummary"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf QueryService "readEraSummary")
-> m (Proto ReadEraSummaryResponse)
Proto ReadEraSummaryRequest -> m (Proto ReadEraSummaryResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto ReadEraSummaryRequest -> m (Proto ReadEraSummaryResponse)
readEraSummaryMethod)
    (Methods
   m
   '[Protobuf QueryService "readGenesis",
     Protobuf QueryService "readParams",
     Protobuf QueryService "readState", Protobuf QueryService "readTx",
     Protobuf QueryService "readUtxos",
     Protobuf QueryService "searchUtxos"]
 -> Methods
      m
      '[Protobuf QueryService "readEraSummary",
        Protobuf QueryService "readGenesis",
        Protobuf QueryService "readParams",
        Protobuf QueryService "readState", Protobuf QueryService "readTx",
        Protobuf QueryService "readUtxos",
        Protobuf QueryService "searchUtxos"])
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf QueryService "readGenesis",
           Protobuf QueryService "readParams",
           Protobuf QueryService "readState", Protobuf QueryService "readTx",
           Protobuf QueryService "readUtxos",
           Protobuf QueryService "searchUtxos"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf QueryService "readEraSummary",
       Protobuf QueryService "readGenesis",
       Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler'
  'NonStreaming m (Protobuf QueryService "readGenesis")
-> Methods
     m
     '[Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
-> Methods
     m
     '[Protobuf QueryService "readGenesis",
       Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf QueryService "readGenesis")
 -> m (Output (Protobuf QueryService "readGenesis")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "readGenesis")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf QueryService "readGenesis")
  -> m (Output (Protobuf QueryService "readGenesis")))
 -> ServerHandler'
      'NonStreaming m (Protobuf QueryService "readGenesis"))
-> (Input (Protobuf QueryService "readGenesis")
    -> m (Output (Protobuf QueryService "readGenesis")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "readGenesis")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcQuery)
-> m (Proto ReadGenesisResponse) -> m (Proto ReadGenesisResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcQuery
TraceRpcQueryReadGenesisSpan (m (Proto ReadGenesisResponse)
 -> m (Output (Protobuf QueryService "readGenesis")))
-> (Input (Protobuf QueryService "readGenesis")
    -> m (Proto ReadGenesisResponse))
-> Input (Protobuf QueryService "readGenesis")
-> m (Output (Protobuf QueryService "readGenesis"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf QueryService "readGenesis")
-> m (Proto ReadGenesisResponse)
Proto ReadGenesisRequest -> m (Proto ReadGenesisResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto ReadGenesisRequest -> m (Proto ReadGenesisResponse)
readGenesisMethod)
    (Methods
   m
   '[Protobuf QueryService "readParams",
     Protobuf QueryService "readState", Protobuf QueryService "readTx",
     Protobuf QueryService "readUtxos",
     Protobuf QueryService "searchUtxos"]
 -> Methods
      m
      '[Protobuf QueryService "readGenesis",
        Protobuf QueryService "readParams",
        Protobuf QueryService "readState", Protobuf QueryService "readTx",
        Protobuf QueryService "readUtxos",
        Protobuf QueryService "searchUtxos"])
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf QueryService "readParams",
           Protobuf QueryService "readState", Protobuf QueryService "readTx",
           Protobuf QueryService "readUtxos",
           Protobuf QueryService "searchUtxos"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf QueryService "readGenesis",
       Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' 'NonStreaming m (Protobuf QueryService "readParams")
-> Methods
     m
     '[Protobuf QueryService "readState",
       Protobuf QueryService "readTx", Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
-> Methods
     m
     '[Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf QueryService "readParams")
 -> m (Output (Protobuf QueryService "readParams")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "readParams")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf QueryService "readParams")
  -> m (Output (Protobuf QueryService "readParams")))
 -> ServerHandler'
      'NonStreaming m (Protobuf QueryService "readParams"))
-> (Input (Protobuf QueryService "readParams")
    -> m (Output (Protobuf QueryService "readParams")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "readParams")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcQuery)
-> m (Proto ReadParamsResponse) -> m (Proto ReadParamsResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcQuery
TraceRpcQueryParamsSpan (m (Proto ReadParamsResponse)
 -> m (Output (Protobuf QueryService "readParams")))
-> (Input (Protobuf QueryService "readParams")
    -> m (Proto ReadParamsResponse))
-> Input (Protobuf QueryService "readParams")
-> m (Output (Protobuf QueryService "readParams"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf QueryService "readParams")
-> m (Proto ReadParamsResponse)
Proto ReadParamsRequest -> m (Proto ReadParamsResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto ReadParamsRequest -> m (Proto ReadParamsResponse)
readParamsMethod)
    (Methods
   m
   '[Protobuf QueryService "readState",
     Protobuf QueryService "readTx", Protobuf QueryService "readUtxos",
     Protobuf QueryService "searchUtxos"]
 -> Methods
      m
      '[Protobuf QueryService "readParams",
        Protobuf QueryService "readState", Protobuf QueryService "readTx",
        Protobuf QueryService "readUtxos",
        Protobuf QueryService "searchUtxos"])
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf QueryService "readState",
           Protobuf QueryService "readTx", Protobuf QueryService "readUtxos",
           Protobuf QueryService "searchUtxos"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf QueryService "readParams",
       Protobuf QueryService "readState", Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods
  m
  '[Protobuf QueryService "readTx",
    Protobuf QueryService "readUtxos",
    Protobuf QueryService "searchUtxos"]
-> Methods
     m
     '[Protobuf QueryService "readState",
       Protobuf QueryService "readTx", Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall {k} (m :: * -> *) (rpcs1 :: [k]) (rpc :: k).
Methods m rpcs1 -> Methods m (rpc : rpcs1)
UnsupportedMethod -- readState
    (Methods
   m
   '[Protobuf QueryService "readTx",
     Protobuf QueryService "readUtxos",
     Protobuf QueryService "searchUtxos"]
 -> Methods
      m
      '[Protobuf QueryService "readState",
        Protobuf QueryService "readTx", Protobuf QueryService "readUtxos",
        Protobuf QueryService "searchUtxos"])
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf QueryService "readTx",
           Protobuf QueryService "readUtxos",
           Protobuf QueryService "searchUtxos"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf QueryService "readState",
       Protobuf QueryService "readTx", Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods
  m
  '[Protobuf QueryService "readUtxos",
    Protobuf QueryService "searchUtxos"]
-> Methods
     m
     '[Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall {k} (m :: * -> *) (rpcs1 :: [k]) (rpc :: k).
Methods m rpcs1 -> Methods m (rpc : rpcs1)
UnsupportedMethod -- readTx
    (Methods
   m
   '[Protobuf QueryService "readUtxos",
     Protobuf QueryService "searchUtxos"]
 -> Methods
      m
      '[Protobuf QueryService "readTx",
        Protobuf QueryService "readUtxos",
        Protobuf QueryService "searchUtxos"])
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf QueryService "readUtxos",
           Protobuf QueryService "searchUtxos"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf QueryService "readTx",
       Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' 'NonStreaming m (Protobuf QueryService "readUtxos")
-> Methods m '[Protobuf QueryService "searchUtxos"]
-> Methods
     m
     '[Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf QueryService "readUtxos")
 -> m (Output (Protobuf QueryService "readUtxos")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "readUtxos")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf QueryService "readUtxos")
  -> m (Output (Protobuf QueryService "readUtxos")))
 -> ServerHandler'
      'NonStreaming m (Protobuf QueryService "readUtxos"))
-> (Input (Protobuf QueryService "readUtxos")
    -> m (Output (Protobuf QueryService "readUtxos")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "readUtxos")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcQuery)
-> m (Proto ReadUtxosResponse) -> m (Proto ReadUtxosResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcQuery
TraceRpcQueryReadUtxosSpan (m (Proto ReadUtxosResponse)
 -> m (Output (Protobuf QueryService "readUtxos")))
-> (Input (Protobuf QueryService "readUtxos")
    -> m (Proto ReadUtxosResponse))
-> Input (Protobuf QueryService "readUtxos")
-> m (Output (Protobuf QueryService "readUtxos"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf QueryService "readUtxos")
-> m (Proto ReadUtxosResponse)
Proto ReadUtxosRequest -> m (Proto ReadUtxosResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto ReadUtxosRequest -> m (Proto ReadUtxosResponse)
readUtxosMethod)
    (Methods m '[Protobuf QueryService "searchUtxos"]
 -> Methods
      m
      '[Protobuf QueryService "readUtxos",
        Protobuf QueryService "searchUtxos"])
-> (Methods m '[]
    -> Methods m '[Protobuf QueryService "searchUtxos"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf QueryService "readUtxos",
       Protobuf QueryService "searchUtxos"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler'
  'NonStreaming m (Protobuf QueryService "searchUtxos")
-> Methods m '[]
-> Methods m '[Protobuf QueryService "searchUtxos"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf QueryService "searchUtxos")
 -> m (Output (Protobuf QueryService "searchUtxos")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "searchUtxos")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf QueryService "searchUtxos")
  -> m (Output (Protobuf QueryService "searchUtxos")))
 -> ServerHandler'
      'NonStreaming m (Protobuf QueryService "searchUtxos"))
-> (Input (Protobuf QueryService "searchUtxos")
    -> m (Output (Protobuf QueryService "searchUtxos")))
-> ServerHandler'
     'NonStreaming m (Protobuf QueryService "searchUtxos")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcQuery)
-> m (Proto SearchUtxosResponse) -> m (Proto SearchUtxosResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcQuery
TraceRpcQuerySearchUtxosSpan (m (Proto SearchUtxosResponse)
 -> m (Output (Protobuf QueryService "searchUtxos")))
-> (Input (Protobuf QueryService "searchUtxos")
    -> m (Proto SearchUtxosResponse))
-> Input (Protobuf QueryService "searchUtxos")
-> m (Output (Protobuf QueryService "searchUtxos"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf QueryService "searchUtxos")
-> m (Proto SearchUtxosResponse)
Proto SearchUtxosRequest -> m (Proto SearchUtxosResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto SearchUtxosRequest -> m (Proto SearchUtxosResponse)
searchUtxosMethod)
    (Methods m '[] -> Methods m (ProtobufMethodsOf QueryService))
-> Methods m '[] -> Methods m (ProtobufMethodsOf QueryService)
forall a b. (a -> b) -> a -> b
$ Methods m '[]
forall {k} (m :: * -> *). Methods m '[]
NoMoreMethods

-- | gRPC method table for the UTxO RPC @SubmitService@.
-- Method order must match 'ServiceMethods': evalTx, readMempool, submitTx, waitForTx, watchMempool.
-- 'UnsupportedMethod' makes the server respond with the @UNIMPLEMENTED@ gRPC status.
methodsUtxoRpcSubmit
  :: MonadRpc e m
  => Methods m (ProtobufMethodsOf UtxoRpc.SubmitService)
methodsUtxoRpcSubmit :: forall e (m :: * -> *).
MonadRpc e m =>
Methods m (ProtobufMethodsOf SubmitService)
methodsUtxoRpcSubmit =
  ServerHandler' 'NonStreaming m (Protobuf SubmitService "evalTx")
-> Methods
     m
     '[Protobuf SubmitService "readMempool",
       Protobuf SubmitService "submitTx",
       Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
-> Methods
     m
     '[Protobuf SubmitService "evalTx",
       Protobuf SubmitService "readMempool",
       Protobuf SubmitService "submitTx",
       Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf SubmitService "evalTx")
 -> m (Output (Protobuf SubmitService "evalTx")))
-> ServerHandler' 'NonStreaming m (Protobuf SubmitService "evalTx")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf SubmitService "evalTx")
  -> m (Output (Protobuf SubmitService "evalTx")))
 -> ServerHandler'
      'NonStreaming m (Protobuf SubmitService "evalTx"))
-> (Input (Protobuf SubmitService "evalTx")
    -> m (Output (Protobuf SubmitService "evalTx")))
-> ServerHandler' 'NonStreaming m (Protobuf SubmitService "evalTx")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcSubmit)
-> m (Proto EvalTxResponse) -> m (Proto EvalTxResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcSubmit
TraceRpcEvalTxSpan (m (Proto EvalTxResponse)
 -> m (Output (Protobuf SubmitService "evalTx")))
-> (Input (Protobuf SubmitService "evalTx")
    -> m (Proto EvalTxResponse))
-> Input (Protobuf SubmitService "evalTx")
-> m (Output (Protobuf SubmitService "evalTx"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf SubmitService "evalTx") -> m (Proto EvalTxResponse)
Proto EvalTxRequest -> m (Proto EvalTxResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto EvalTxRequest -> m (Proto EvalTxResponse)
evalTxMethod)
    (Methods
   m
   '[Protobuf SubmitService "readMempool",
     Protobuf SubmitService "submitTx",
     Protobuf SubmitService "waitForTx",
     Protobuf SubmitService "watchMempool"]
 -> Methods m (ProtobufMethodsOf SubmitService))
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf SubmitService "readMempool",
           Protobuf SubmitService "submitTx",
           Protobuf SubmitService "waitForTx",
           Protobuf SubmitService "watchMempool"])
-> Methods m '[]
-> Methods m (ProtobufMethodsOf SubmitService)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods
  m
  '[Protobuf SubmitService "submitTx",
    Protobuf SubmitService "waitForTx",
    Protobuf SubmitService "watchMempool"]
-> Methods
     m
     '[Protobuf SubmitService "readMempool",
       Protobuf SubmitService "submitTx",
       Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
forall {k} (m :: * -> *) (rpcs1 :: [k]) (rpc :: k).
Methods m rpcs1 -> Methods m (rpc : rpcs1)
UnsupportedMethod -- readMempool
    (Methods
   m
   '[Protobuf SubmitService "submitTx",
     Protobuf SubmitService "waitForTx",
     Protobuf SubmitService "watchMempool"]
 -> Methods
      m
      '[Protobuf SubmitService "readMempool",
        Protobuf SubmitService "submitTx",
        Protobuf SubmitService "waitForTx",
        Protobuf SubmitService "watchMempool"])
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf SubmitService "submitTx",
           Protobuf SubmitService "waitForTx",
           Protobuf SubmitService "watchMempool"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf SubmitService "readMempool",
       Protobuf SubmitService "submitTx",
       Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' 'NonStreaming m (Protobuf SubmitService "submitTx")
-> Methods
     m
     '[Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
-> Methods
     m
     '[Protobuf SubmitService "submitTx",
       Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf SubmitService "submitTx")
 -> m (Output (Protobuf SubmitService "submitTx")))
-> ServerHandler'
     'NonStreaming m (Protobuf SubmitService "submitTx")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf SubmitService "submitTx")
  -> m (Output (Protobuf SubmitService "submitTx")))
 -> ServerHandler'
      'NonStreaming m (Protobuf SubmitService "submitTx"))
-> (Input (Protobuf SubmitService "submitTx")
    -> m (Output (Protobuf SubmitService "submitTx")))
-> ServerHandler'
     'NonStreaming m (Protobuf SubmitService "submitTx")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcSubmit)
-> m (Proto SubmitTxResponse) -> m (Proto SubmitTxResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcSubmit
TraceRpcSubmitSpan (m (Proto SubmitTxResponse)
 -> m (Output (Protobuf SubmitService "submitTx")))
-> (Input (Protobuf SubmitService "submitTx")
    -> m (Proto SubmitTxResponse))
-> Input (Protobuf SubmitService "submitTx")
-> m (Output (Protobuf SubmitService "submitTx"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf SubmitService "submitTx")
-> m (Proto SubmitTxResponse)
Proto SubmitTxRequest -> m (Proto SubmitTxResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto SubmitTxRequest -> m (Proto SubmitTxResponse)
submitTxMethod)
    (Methods
   m
   '[Protobuf SubmitService "waitForTx",
     Protobuf SubmitService "watchMempool"]
 -> Methods
      m
      '[Protobuf SubmitService "submitTx",
        Protobuf SubmitService "waitForTx",
        Protobuf SubmitService "watchMempool"])
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf SubmitService "waitForTx",
           Protobuf SubmitService "watchMempool"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf SubmitService "submitTx",
       Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods m '[Protobuf SubmitService "watchMempool"]
-> Methods
     m
     '[Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
forall {k} (m :: * -> *) (rpcs1 :: [k]) (rpc :: k).
Methods m rpcs1 -> Methods m (rpc : rpcs1)
UnsupportedMethod -- waitForTx
    (Methods m '[Protobuf SubmitService "watchMempool"]
 -> Methods
      m
      '[Protobuf SubmitService "waitForTx",
        Protobuf SubmitService "watchMempool"])
-> (Methods m '[]
    -> Methods m '[Protobuf SubmitService "watchMempool"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf SubmitService "waitForTx",
       Protobuf SubmitService "watchMempool"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Methods m '[] -> Methods m '[Protobuf SubmitService "watchMempool"]
forall {k} (m :: * -> *) (rpcs1 :: [k]) (rpc :: k).
Methods m rpcs1 -> Methods m (rpc : rpcs1)
UnsupportedMethod -- watchMempool
    (Methods m '[] -> Methods m (ProtobufMethodsOf SubmitService))
-> Methods m '[] -> Methods m (ProtobufMethodsOf SubmitService)
forall a b. (a -> b) -> a -> b
$ Methods m '[]
forall {k} (m :: * -> *). Methods m '[]
NoMoreMethods

-- | gRPC method table for the UTxO RPC @SyncService@.
-- Method order must match 'ServiceMethods': dumpHistory, fetchBlock, followTip, readTip.
-- 'UnsupportedMethod' makes the server respond with the @UNIMPLEMENTED@ gRPC status.
methodsSyncRpc
  :: MonadRpc e m
  => Methods m (ProtobufMethodsOf UtxoRpc.SyncService)
methodsSyncRpc :: forall e (m :: * -> *).
MonadRpc e m =>
Methods m (ProtobufMethodsOf SyncService)
methodsSyncRpc =
  Methods
  m
  '[Protobuf SyncService "fetchBlock",
    Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
-> Methods
     m
     '[Protobuf SyncService "dumpHistory",
       Protobuf SyncService "fetchBlock",
       Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
Methods
  m
  '[Protobuf SyncService "fetchBlock",
    Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
-> Methods m (ProtobufMethodsOf SyncService)
forall {k} (m :: * -> *) (rpcs1 :: [k]) (rpc :: k).
Methods m rpcs1 -> Methods m (rpc : rpcs1)
UnsupportedMethod -- dumpHistory
    (Methods
   m
   '[Protobuf SyncService "fetchBlock",
     Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
 -> Methods m (ProtobufMethodsOf SyncService))
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf SyncService "fetchBlock",
           Protobuf SyncService "followTip", Protobuf SyncService "readTip"])
-> Methods m '[]
-> Methods m (ProtobufMethodsOf SyncService)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' 'NonStreaming m (Protobuf SyncService "fetchBlock")
-> Methods
     m
     '[Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
-> Methods
     m
     '[Protobuf SyncService "fetchBlock",
       Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf SyncService "fetchBlock")
 -> m (Output (Protobuf SyncService "fetchBlock")))
-> ServerHandler'
     'NonStreaming m (Protobuf SyncService "fetchBlock")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf SyncService "fetchBlock")
  -> m (Output (Protobuf SyncService "fetchBlock")))
 -> ServerHandler'
      'NonStreaming m (Protobuf SyncService "fetchBlock"))
-> (Input (Protobuf SyncService "fetchBlock")
    -> m (Output (Protobuf SyncService "fetchBlock")))
-> ServerHandler'
     'NonStreaming m (Protobuf SyncService "fetchBlock")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcSync)
-> m (Proto FetchBlockResponse) -> m (Proto FetchBlockResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcSync
TraceRpcFetchBlockSpan (m (Proto FetchBlockResponse)
 -> m (Output (Protobuf SyncService "fetchBlock")))
-> (Input (Protobuf SyncService "fetchBlock")
    -> m (Proto FetchBlockResponse))
-> Input (Protobuf SyncService "fetchBlock")
-> m (Output (Protobuf SyncService "fetchBlock"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf SyncService "fetchBlock")
-> m (Proto FetchBlockResponse)
Proto FetchBlockRequest -> m (Proto FetchBlockResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto FetchBlockRequest -> m (Proto FetchBlockResponse)
fetchBlockMethod)
    (Methods
   m
   '[Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
 -> Methods
      m
      '[Protobuf SyncService "fetchBlock",
        Protobuf SyncService "followTip", Protobuf SyncService "readTip"])
-> (Methods m '[]
    -> Methods
         m
         '[Protobuf SyncService "followTip",
           Protobuf SyncService "readTip"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf SyncService "fetchBlock",
       Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler'
  'ServerStreaming m (Protobuf SyncService "followTip")
-> Methods m '[Protobuf SyncService "readTip"]
-> Methods
     m
     '[Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf SyncService "followTip")
 -> (NextElem (Output (Protobuf SyncService "followTip")) -> IO ())
 -> m ())
-> ServerHandler'
     'ServerStreaming m (Protobuf SyncService "followTip")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'ServerStreaming =>
(Input rpc -> (NextElem (Output rpc) -> IO ()) -> m ())
-> ServerHandler' 'ServerStreaming m rpc
mkServerStreaming ((Input (Protobuf SyncService "followTip")
  -> (NextElem (Output (Protobuf SyncService "followTip")) -> IO ())
  -> m ())
 -> ServerHandler'
      'ServerStreaming m (Protobuf SyncService "followTip"))
-> (Input (Protobuf SyncService "followTip")
    -> (NextElem (Output (Protobuf SyncService "followTip")) -> IO ())
    -> m ())
-> ServerHandler'
     'ServerStreaming m (Protobuf SyncService "followTip")
forall a b. (a -> b) -> a -> b
$ \Input (Protobuf SyncService "followTip")
req -> (TraceSpanEvent -> TraceRpcSync) -> m () -> m ()
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcSync
TraceRpcFollowTipSpan (m () -> m ())
-> ((NextElem (Proto FollowTipResponse) -> IO ()) -> m ())
-> (NextElem (Proto FollowTipResponse) -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proto FollowTipRequest
-> (NextElem (Proto FollowTipResponse) -> IO ()) -> m ()
forall e (m :: * -> *).
MonadRpc e m =>
Proto FollowTipRequest
-> (NextElem (Proto FollowTipResponse) -> IO ()) -> m ()
followTipMethod Input (Protobuf SyncService "followTip")
Proto FollowTipRequest
req)
    (Methods m '[Protobuf SyncService "readTip"]
 -> Methods
      m
      '[Protobuf SyncService "followTip",
        Protobuf SyncService "readTip"])
-> (Methods m '[] -> Methods m '[Protobuf SyncService "readTip"])
-> Methods m '[]
-> Methods
     m
     '[Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' 'NonStreaming m (Protobuf SyncService "readTip")
-> Methods m '[] -> Methods m '[Protobuf SyncService "readTip"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((Input (Protobuf SyncService "readTip")
 -> m (Output (Protobuf SyncService "readTip")))
-> ServerHandler' 'NonStreaming m (Protobuf SyncService "readTip")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming ((Input (Protobuf SyncService "readTip")
  -> m (Output (Protobuf SyncService "readTip")))
 -> ServerHandler' 'NonStreaming m (Protobuf SyncService "readTip"))
-> (Input (Protobuf SyncService "readTip")
    -> m (Output (Protobuf SyncService "readTip")))
-> ServerHandler' 'NonStreaming m (Protobuf SyncService "readTip")
forall a b. (a -> b) -> a -> b
$ (TraceSpanEvent -> TraceRpcSync)
-> m (Proto ReadTipResponse) -> m (Proto ReadTipResponse)
forall t' t e (m :: * -> *) a.
(t ~ TraceRpc, Inject t' t, NFData a, Has (Tracer m t) e,
 MonadReader e m, MonadUnliftIO m) =>
(TraceSpanEvent -> t') -> m a -> m a
wrapInSpan TraceSpanEvent -> TraceRpcSync
TraceRpcReadTipSpan (m (Proto ReadTipResponse)
 -> m (Output (Protobuf SyncService "readTip")))
-> (Input (Protobuf SyncService "readTip")
    -> m (Proto ReadTipResponse))
-> Input (Protobuf SyncService "readTip")
-> m (Output (Protobuf SyncService "readTip"))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input (Protobuf SyncService "readTip") -> m (Proto ReadTipResponse)
Proto ReadTipRequest -> m (Proto ReadTipResponse)
forall e (m :: * -> *).
MonadRpc e m =>
Proto ReadTipRequest -> m (Proto ReadTipResponse)
readTipMethod)
    (Methods m '[] -> Methods m (ProtobufMethodsOf SyncService))
-> Methods m '[] -> Methods m (ProtobufMethodsOf SyncService)
forall a b. (a -> b) -> a -> b
$ Methods m '[]
forall {k} (m :: * -> *). Methods m '[]
NoMoreMethods

-- | gRPC method table for the Server Reflection API's @v1@ service.
methodsReflectionV1
  :: MonadIO m
  => Methods m (ProtobufMethodsOf ReflectionV1.ServerReflection)
methodsReflectionV1 :: forall (m :: * -> *).
MonadIO m =>
Methods m (ProtobufMethodsOf ServerReflection)
methodsReflectionV1 =
  ServerHandler'
  'BiDiStreaming m (Protobuf ServerReflection "serverReflectionInfo")
-> Methods m '[]
-> Methods m '[Protobuf ServerReflection "serverReflectionInfo"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((IO
   (NextElem
      (Input (Protobuf ServerReflection "serverReflectionInfo")))
 -> (NextElem
       (Output (Protobuf ServerReflection "serverReflectionInfo"))
     -> IO ())
 -> m ())
-> ServerHandler'
     'BiDiStreaming m (Protobuf ServerReflection "serverReflectionInfo")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'BiDiStreaming =>
(IO (NextElem (Input rpc))
 -> (NextElem (Output rpc) -> IO ()) -> m ())
-> ServerHandler' 'BiDiStreaming m rpc
mkBiDiStreaming ((IO
    (NextElem
       (Input (Protobuf ServerReflection "serverReflectionInfo")))
  -> (NextElem
        (Output (Protobuf ServerReflection "serverReflectionInfo"))
      -> IO ())
  -> m ())
 -> ServerHandler'
      'BiDiStreaming
      m
      (Protobuf ServerReflection "serverReflectionInfo"))
-> (IO
      (NextElem
         (Input (Protobuf ServerReflection "serverReflectionInfo")))
    -> (NextElem
          (Output (Protobuf ServerReflection "serverReflectionInfo"))
        -> IO ())
    -> m ())
-> ServerHandler'
     'BiDiStreaming m (Protobuf ServerReflection "serverReflectionInfo")
forall a b. (a -> b) -> a -> b
$ [Text]
-> IO (NextElem (Proto ServerReflectionRequest))
-> (NextElem (Proto ServerReflectionResponse) -> IO ())
-> m ()
forall (m :: * -> *).
MonadIO m =>
[Text]
-> IO (NextElem (Proto ServerReflectionRequest))
-> (NextElem (Proto ServerReflectionResponse) -> IO ())
-> m ()
serverReflectionInfoMethodV1 [Text]
registeredServiceNames) (Methods m '[]
 -> Methods m '[Protobuf ServerReflection "serverReflectionInfo"])
-> Methods m '[]
-> Methods m '[Protobuf ServerReflection "serverReflectionInfo"]
forall a b. (a -> b) -> a -> b
$
    Methods m '[]
forall {k} (m :: * -> *). Methods m '[]
NoMoreMethods

-- | gRPC method table for the Server Reflection API's legacy @v1alpha@ service.
methodsReflectionV1alpha
  :: MonadIO m
  => Methods m (ProtobufMethodsOf ReflectionV1alpha.ServerReflection)
methodsReflectionV1alpha :: forall (m :: * -> *).
MonadIO m =>
Methods m (ProtobufMethodsOf ServerReflection)
methodsReflectionV1alpha =
  ServerHandler'
  'BiDiStreaming m (Protobuf ServerReflection "serverReflectionInfo")
-> Methods m '[]
-> Methods m '[Protobuf ServerReflection "serverReflectionInfo"]
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *)
       (rpcs1 :: [k]).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc),
 SupportsStreamingType rpc styp) =>
ServerHandler' styp m rpc
-> Methods m rpcs1 -> Methods m (rpc : rpcs1)
Method ((IO
   (NextElem
      (Input (Protobuf ServerReflection "serverReflectionInfo")))
 -> (NextElem
       (Output (Protobuf ServerReflection "serverReflectionInfo"))
     -> IO ())
 -> m ())
-> ServerHandler'
     'BiDiStreaming m (Protobuf ServerReflection "serverReflectionInfo")
forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'BiDiStreaming =>
(IO (NextElem (Input rpc))
 -> (NextElem (Output rpc) -> IO ()) -> m ())
-> ServerHandler' 'BiDiStreaming m rpc
mkBiDiStreaming ((IO
    (NextElem
       (Input (Protobuf ServerReflection "serverReflectionInfo")))
  -> (NextElem
        (Output (Protobuf ServerReflection "serverReflectionInfo"))
      -> IO ())
  -> m ())
 -> ServerHandler'
      'BiDiStreaming
      m
      (Protobuf ServerReflection "serverReflectionInfo"))
-> (IO
      (NextElem
         (Input (Protobuf ServerReflection "serverReflectionInfo")))
    -> (NextElem
          (Output (Protobuf ServerReflection "serverReflectionInfo"))
        -> IO ())
    -> m ())
-> ServerHandler'
     'BiDiStreaming m (Protobuf ServerReflection "serverReflectionInfo")
forall a b. (a -> b) -> a -> b
$ [Text]
-> IO (NextElem (Proto ServerReflectionRequest))
-> (NextElem (Proto ServerReflectionResponse) -> IO ())
-> m ()
forall (m :: * -> *).
MonadIO m =>
[Text]
-> IO (NextElem (Proto ServerReflectionRequest))
-> (NextElem (Proto ServerReflectionResponse) -> IO ())
-> m ()
serverReflectionInfoMethodV1alpha [Text]
registeredServiceNames) (Methods m '[]
 -> Methods m '[Protobuf ServerReflection "serverReflectionInfo"])
-> Methods m '[]
-> Methods m '[Protobuf ServerReflection "serverReflectionInfo"]
forall a b. (a -> b) -> a -> b
$
    Methods m '[]
forall {k} (m :: * -> *). Methods m '[]
NoMoreMethods

-- | Every service this server registers, paired with its handler methods
-- in one list, so the name registered with grapesy and the name advertised
-- by the Server Reflection API's @list_services@ ('registeredServiceNames')
-- can never drift apart - unlike two hand-maintained lists, this cannot go
-- out of sync by construction.
registeredServices :: [(Text, [SomeRpcHandler (RIO RpcEnv)])]
registeredServices :: [(Text, [SomeRpcHandler (RIO RpcEnv)])]
registeredServices =
  [ (forall s. Service s => Text
qualifiedServiceName @Rpc.Node, Methods
  (RIO RpcEnv)
  '[Protobuf Node "getEra", Protobuf Node "getProtocolParamsJson"]
-> [SomeRpcHandler (RIO RpcEnv)]
forall {k} (m :: * -> *) (rpcs :: [k]).
MonadIO m =>
Methods m rpcs -> [SomeRpcHandler m]
fromMethods Methods
  (RIO RpcEnv)
  '[Protobuf Node "getEra", Protobuf Node "getProtocolParamsJson"]
Methods (RIO RpcEnv) (ProtobufMethodsOf Node)
forall e (m :: * -> *).
MonadRpc e m =>
Methods m (ProtobufMethodsOf Node)
methodsNodeRpc)
  , (forall s. Service s => Text
qualifiedServiceName @UtxoRpc.QueryService, Methods
  (RIO RpcEnv)
  '[Protobuf QueryService "readData",
    Protobuf QueryService "readEraSummary",
    Protobuf QueryService "readGenesis",
    Protobuf QueryService "readParams",
    Protobuf QueryService "readState", Protobuf QueryService "readTx",
    Protobuf QueryService "readUtxos",
    Protobuf QueryService "searchUtxos"]
-> [SomeRpcHandler (RIO RpcEnv)]
forall {k} (m :: * -> *) (rpcs :: [k]).
MonadIO m =>
Methods m rpcs -> [SomeRpcHandler m]
fromMethods Methods
  (RIO RpcEnv)
  '[Protobuf QueryService "readData",
    Protobuf QueryService "readEraSummary",
    Protobuf QueryService "readGenesis",
    Protobuf QueryService "readParams",
    Protobuf QueryService "readState", Protobuf QueryService "readTx",
    Protobuf QueryService "readUtxos",
    Protobuf QueryService "searchUtxos"]
Methods (RIO RpcEnv) (ProtobufMethodsOf QueryService)
forall e (m :: * -> *).
MonadRpc e m =>
Methods m (ProtobufMethodsOf QueryService)
methodsUtxoRpc)
  , (forall s. Service s => Text
qualifiedServiceName @UtxoRpc.SubmitService, Methods
  (RIO RpcEnv)
  '[Protobuf SubmitService "evalTx",
    Protobuf SubmitService "readMempool",
    Protobuf SubmitService "submitTx",
    Protobuf SubmitService "waitForTx",
    Protobuf SubmitService "watchMempool"]
-> [SomeRpcHandler (RIO RpcEnv)]
forall {k} (m :: * -> *) (rpcs :: [k]).
MonadIO m =>
Methods m rpcs -> [SomeRpcHandler m]
fromMethods Methods
  (RIO RpcEnv)
  '[Protobuf SubmitService "evalTx",
    Protobuf SubmitService "readMempool",
    Protobuf SubmitService "submitTx",
    Protobuf SubmitService "waitForTx",
    Protobuf SubmitService "watchMempool"]
Methods (RIO RpcEnv) (ProtobufMethodsOf SubmitService)
forall e (m :: * -> *).
MonadRpc e m =>
Methods m (ProtobufMethodsOf SubmitService)
methodsUtxoRpcSubmit)
  , (forall s. Service s => Text
qualifiedServiceName @UtxoRpc.SyncService, Methods
  (RIO RpcEnv)
  '[Protobuf SyncService "dumpHistory",
    Protobuf SyncService "fetchBlock",
    Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
-> [SomeRpcHandler (RIO RpcEnv)]
forall {k} (m :: * -> *) (rpcs :: [k]).
MonadIO m =>
Methods m rpcs -> [SomeRpcHandler m]
fromMethods Methods
  (RIO RpcEnv)
  '[Protobuf SyncService "dumpHistory",
    Protobuf SyncService "fetchBlock",
    Protobuf SyncService "followTip", Protobuf SyncService "readTip"]
Methods (RIO RpcEnv) (ProtobufMethodsOf SyncService)
forall e (m :: * -> *).
MonadRpc e m =>
Methods m (ProtobufMethodsOf SyncService)
methodsSyncRpc)
  , (forall s. Service s => Text
qualifiedServiceName @ReflectionV1.ServerReflection, Methods
  (RIO RpcEnv) '[Protobuf ServerReflection "serverReflectionInfo"]
-> [SomeRpcHandler (RIO RpcEnv)]
forall {k} (m :: * -> *) (rpcs :: [k]).
MonadIO m =>
Methods m rpcs -> [SomeRpcHandler m]
fromMethods Methods
  (RIO RpcEnv) '[Protobuf ServerReflection "serverReflectionInfo"]
Methods (RIO RpcEnv) (ProtobufMethodsOf ServerReflection)
forall (m :: * -> *).
MonadIO m =>
Methods m (ProtobufMethodsOf ServerReflection)
methodsReflectionV1)
  , (forall s. Service s => Text
qualifiedServiceName @ReflectionV1alpha.ServerReflection, Methods
  (RIO RpcEnv) '[Protobuf ServerReflection "serverReflectionInfo"]
-> [SomeRpcHandler (RIO RpcEnv)]
forall {k} (m :: * -> *) (rpcs :: [k]).
MonadIO m =>
Methods m rpcs -> [SomeRpcHandler m]
fromMethods Methods
  (RIO RpcEnv) '[Protobuf ServerReflection "serverReflectionInfo"]
Methods (RIO RpcEnv) (ProtobufMethodsOf ServerReflection)
forall (m :: * -> *).
MonadIO m =>
Methods m (ProtobufMethodsOf ServerReflection)
methodsReflectionV1alpha)
  ]

-- | Fully qualified names of every service this server registers, for the
-- Server Reflection API's @list_services@.
registeredServiceNames :: [Text]
registeredServiceNames :: [Text]
registeredServiceNames = ((Text, [SomeRpcHandler (RIO RpcEnv)]) -> Text)
-> [(Text, [SomeRpcHandler (RIO RpcEnv)])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [SomeRpcHandler (RIO RpcEnv)]) -> Text
forall a b. (a, b) -> a
fst [(Text, [SomeRpcHandler (RIO RpcEnv)])]
registeredServices

-- | Start the gRPC server, registering all RPC service handlers.
-- Does nothing when the RPC server is disabled in configuration.
runRpcServer
  :: Tracer IO TraceRpc
  -- ^ Tracer for RPC lifecycle and error events
  -> RpcConfig
  -- ^ Server configuration
  -> NetworkMagic
  -- ^ Network discriminant
  -> IORef (Maybe NodeKernelAccess)
  -- ^ Node kernel access, populated when the kernel is ready
  -> IO ()
runRpcServer :: Tracer IO TraceRpc
-> RpcConfig
-> NetworkMagic
-> IORef (Maybe NodeKernelAccess)
-> IO ()
runRpcServer Tracer IO TraceRpc
tracer RpcConfig
rpcConfig NetworkMagic
networkMagic IORef (Maybe NodeKernelAccess)
nodeKernelAccessRef = (HasCallStack => IO ()) -> IO ()
handleFatalExceptions ((HasCallStack => IO ()) -> IO ())
-> (HasCallStack => IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let RpcConfig
        { isEnabled :: forall (m :: * -> *). RpcConfigF m -> m Bool
isEnabled = Identity Bool
isEnabled
        , rpcEndpoint :: forall (m :: * -> *). RpcConfigF m -> m RpcEndpoint
rpcEndpoint = Identity RpcEndpoint
rpcEndpoint
        , nodeSocketPath :: forall (m :: * -> *). RpcConfigF m -> m SocketPath
nodeSocketPath = Identity SocketPath
nodeSocketPath
        } = RpcConfig
rpcConfig
      config :: ServerConfig
      config :: ServerConfig
config = case RpcEndpoint
rpcEndpoint of
        RpcEndpointUnixSocket (File FilePath
socketPath) ->
          ServerConfig
            { serverInsecure :: Maybe InsecureConfig
serverInsecure = InsecureConfig -> Maybe InsecureConfig
forall a. a -> Maybe a
Just (InsecureConfig -> Maybe InsecureConfig)
-> InsecureConfig -> Maybe InsecureConfig
forall a b. (a -> b) -> a -> b
$ FilePath -> InsecureConfig
InsecureUnix FilePath
socketPath
            , serverSecure :: Maybe SecureConfig
serverSecure = Maybe SecureConfig
forall a. Maybe a
Nothing
            }
        RpcEndpointHttp IP
host PortNumber
port ->
          ServerConfig
            { serverInsecure :: Maybe InsecureConfig
serverInsecure =
                InsecureConfig -> Maybe InsecureConfig
forall a. a -> Maybe a
Just
                  InsecureConfig
                    { insecureHost :: Maybe FilePath
insecureHost = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ IP -> FilePath
forall a. Show a => a -> FilePath
show IP
host
                    , insecurePort :: PortNumber
insecurePort = PortNumber
port
                    }
            , serverSecure :: Maybe SecureConfig
serverSecure = Maybe SecureConfig
forall a. Maybe a
Nothing
            }
        RpcEndpointHttps IP
host PortNumber
port (RpcTlsFiles File TlsCertificate 'In
certificateFile File TlsPrivateKey 'In
privateKeyFile [File TlsCertificate 'In]
chainCertificateFiles) ->
          ServerConfig
            { serverInsecure :: Maybe InsecureConfig
serverInsecure = Maybe InsecureConfig
forall a. Maybe a
Nothing
            , serverSecure :: Maybe SecureConfig
serverSecure =
                SecureConfig -> Maybe SecureConfig
forall a. a -> Maybe a
Just
                  SecureConfig
                    { secureHost :: FilePath
secureHost = IP -> FilePath
forall a. Show a => a -> FilePath
show IP
host
                    , securePort :: PortNumber
securePort = PortNumber
port
                    , securePubCert :: FilePath
securePubCert = File TlsCertificate 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File TlsCertificate 'In
certificateFile
                    , secureChainCerts :: [FilePath]
secureChainCerts = File TlsCertificate 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile (File TlsCertificate 'In -> FilePath)
-> [File TlsCertificate 'In] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [File TlsCertificate 'In]
chainCertificateFiles
                    , securePrivKey :: FilePath
securePrivKey = File TlsPrivateKey 'In -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File TlsPrivateKey 'In
privateKeyFile
                    , secureSslKeyLog :: SslKeyLog
secureSslKeyLog = SslKeyLog
forall a. Default a => a
def
                    }
            }
      rpcEnv :: RpcEnv
rpcEnv =
        RpcEnv
          { config :: RpcConfig
config = RpcConfig
rpcConfig
          , tracer :: forall (m :: * -> *). MonadIO m => Tracer m TraceRpc
tracer = (forall x. IO x -> m x) -> Tracer IO TraceRpc -> Tracer m TraceRpc
forall (m :: * -> *) (n :: * -> *) s.
(forall x. m x -> n x) -> Tracer m s -> Tracer n s
natTracer IO x -> m x
forall x. IO x -> m x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Tracer IO TraceRpc
tracer
          , rpcLocalNodeConnectInfo :: LocalNodeConnectInfo
rpcLocalNodeConnectInfo = SocketPath -> NetworkMagic -> LocalNodeConnectInfo
mkLocalNodeConnectInfo SocketPath
nodeSocketPath NetworkMagic
networkMagic
          , rpcNodeKernelAccess :: IORef (Maybe NodeKernelAccess)
rpcNodeKernelAccess = IORef (Maybe NodeKernelAccess)
nodeKernelAccessRef
          }

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEnabled (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Tracer IO TraceRpc -> TraceRpc -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO TraceRpc
tracer (TraceRpc -> IO ()) -> TraceRpc -> IO ()
forall a b. (a -> b) -> a -> b
$ RpcEndpoint -> TraceRpc
TraceRpcServerListening RpcEndpoint
rpcEndpoint
    RpcEnv -> RIO RpcEnv () -> IO ()
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO RpcEnv
rpcEnv (RIO RpcEnv () -> IO ()) -> RIO RpcEnv () -> IO ()
forall a b. (a -> b) -> a -> b
$
      ((forall a. RIO RpcEnv a -> IO a) -> IO ()) -> RIO RpcEnv ()
forall b.
((forall a. RIO RpcEnv a -> IO a) -> IO b) -> RIO RpcEnv b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. RIO RpcEnv a -> IO a) -> IO ()) -> RIO RpcEnv ())
-> ((forall a. RIO RpcEnv a -> IO a) -> IO ()) -> RIO RpcEnv ()
forall a b. (a -> b) -> a -> b
$ \forall a. RIO RpcEnv a -> IO a
runInIO ->
        HTTP2Settings -> ServerConfig -> Server -> IO ()
runServer HTTP2Settings
http2Settings ServerConfig
config (Server -> IO ())
-> ([SomeRpcHandler (RIO RpcEnv)] -> IO Server)
-> [SomeRpcHandler (RIO RpcEnv)]
-> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ServerParams -> [SomeRpcHandler IO] -> IO Server
mkGrpcServer ServerParams
serverParams ([SomeRpcHandler IO] -> IO Server)
-> ([SomeRpcHandler (RIO RpcEnv)] -> [SomeRpcHandler IO])
-> [SomeRpcHandler (RIO RpcEnv)]
-> IO Server
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeRpcHandler (RIO RpcEnv) -> SomeRpcHandler IO)
-> [SomeRpcHandler (RIO RpcEnv)] -> [SomeRpcHandler IO]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. RIO RpcEnv a -> IO a)
-> SomeRpcHandler (RIO RpcEnv) -> SomeRpcHandler IO
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> SomeRpcHandler m -> SomeRpcHandler n
hoistSomeRpcHandler RIO RpcEnv a -> IO a
forall a. RIO RpcEnv a -> IO a
runInIO) ([SomeRpcHandler (RIO RpcEnv)] -> IO ())
-> [SomeRpcHandler (RIO RpcEnv)] -> IO ()
forall a b. (a -> b) -> a -> b
$
          [[SomeRpcHandler (RIO RpcEnv)]] -> [SomeRpcHandler (RIO RpcEnv)]
forall a. Monoid a => [a] -> a
mconcat (((Text, [SomeRpcHandler (RIO RpcEnv)])
 -> [SomeRpcHandler (RIO RpcEnv)])
-> [(Text, [SomeRpcHandler (RIO RpcEnv)])]
-> [[SomeRpcHandler (RIO RpcEnv)]]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [SomeRpcHandler (RIO RpcEnv)])
-> [SomeRpcHandler (RIO RpcEnv)]
forall a b. (a, b) -> b
snd [(Text, [SomeRpcHandler (RIO RpcEnv)])]
registeredServices)
 where
  serverParams :: ServerParams
  serverParams :: ServerParams
serverParams =
    ServerParams
forall a. Default a => a
def
      { serverTopLevel = topLevelHandler
      , serverExceptionToClient = exceptionToClient
      }

  -- Clients must never see internal error detail or call stacks; full detail is
  -- still traced server-side by 'topLevelHandler'.
  exceptionToClient :: SomeException -> IO (Maybe Text)
  exceptionToClient :: SomeException -> IO (Maybe Text)
exceptionToClient SomeException
e =
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text))
-> (Text -> Maybe Text) -> Text -> IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> IO (Maybe Text)) -> Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> (RpcException -> Text) -> Maybe RpcException -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
genericErrorMessage RpcException -> Text
renderRpcExceptionForClient (Maybe RpcException -> Text) -> Maybe RpcException -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe RpcException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
   where
    genericErrorMessage :: Text
genericErrorMessage = Text
"Internal error while processing the request."

  -- Halve grapesy's default of 128: bounds per-connection RPC parallelism.
  -- Remaining fields keep grapesy defaults, including the HTTP/2 flood-protection
  -- rate limits and the 256 KiB / 2 MiB flow-control windows that cap buffered
  -- inbound request data per stream / connection.
  http2Settings :: HTTP2Settings
  http2Settings :: HTTP2Settings
http2Settings = HTTP2Settings
forall a. Default a => a
def{http2MaxConcurrentStreams = 64}

  -- Top level hook for request handlers, handle exceptions
  topLevelHandler :: RequestHandler () -> RequestHandler ()
  topLevelHandler :: RequestHandler () -> RequestHandler ()
topLevelHandler RequestHandler ()
h forall x. IO x -> IO x
unmask Request
req Response -> IO ()
resp = IO () -> (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
catchAny (RequestHandler ()
h IO x -> IO x
forall x. IO x -> IO x
unmask Request
req Response -> IO ()
resp) ((SomeException -> IO ()) -> IO ())
-> (SomeException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
    Tracer IO TraceRpc -> TraceRpc -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO TraceRpc
tracer (TraceRpc -> IO ()) -> TraceRpc -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> TraceRpc
TraceRpcError SomeException
e

  handleFatalExceptions :: (HasCallStack => IO ()) -> IO ()
  handleFatalExceptions :: (HasCallStack => IO ()) -> IO ()
handleFatalExceptions = (SomeException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny ((SomeException -> IO ()) -> IO () -> IO ())
-> (SomeException -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
    Tracer IO TraceRpc -> TraceRpc -> IO ()
forall (m :: * -> *) a. Monad m => Tracer m a -> a -> m ()
traceWith Tracer IO TraceRpc
tracer (TraceRpc -> IO ()) -> TraceRpc -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> TraceRpc
TraceRpcFatalError SomeException
e