{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}

-- | Intended for qualified import
module Ouroboros.Consensus.Network.NodeToClient (
    -- * Handlers
    Handlers (..)
  , mkHandlers
    -- * Codecs
  , ClientCodecs
  , Codecs
  , Codecs' (..)
  , DefaultCodecs
  , clientCodecs
  , defaultCodecs
  , identityCodecs
    -- * ClientCodecs
    -- * Tracers
  , Tracers
  , Tracers' (..)
  , nullTracers
  , showTracers
    -- * Applications
  , App
  , Apps (..)
  , mkApps
    -- ** Projections
  , responder
  ) where

import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import           Codec.CBOR.Read (DeserialiseFailure)
import           Codec.Serialise (Serialise)

import           Control.Tracer
import           Data.ByteString.Lazy (ByteString)
import           Data.Void (Void)

import           Network.TypedProtocol.Codec

import qualified Ouroboros.Network.AnchoredFragment as AF
import           Ouroboros.Network.Block (Serialised, decodePoint, decodeTip,
                     encodePoint, encodeTip)
import           Ouroboros.Network.BlockFetch
import           Ouroboros.Network.Channel
import           Ouroboros.Network.Driver
import           Ouroboros.Network.Mux
import           Ouroboros.Network.NodeToClient hiding
                     (NodeToClientVersion (..))
import qualified Ouroboros.Network.NodeToClient as N (NodeToClientVersion (..))
import           Ouroboros.Network.Protocol.ChainSync.Codec
import           Ouroboros.Network.Protocol.ChainSync.Server
import           Ouroboros.Network.Protocol.ChainSync.Type
import           Ouroboros.Network.Protocol.LocalStateQuery.Codec
import           Ouroboros.Network.Protocol.LocalStateQuery.Server
import           Ouroboros.Network.Protocol.LocalStateQuery.Type
import           Ouroboros.Network.Protocol.LocalTxMonitor.Codec
import           Ouroboros.Network.Protocol.LocalTxMonitor.Server
import           Ouroboros.Network.Protocol.LocalTxMonitor.Type
import           Ouroboros.Network.Protocol.LocalTxSubmission.Codec
import           Ouroboros.Network.Protocol.LocalTxSubmission.Server
import           Ouroboros.Network.Protocol.LocalTxSubmission.Type

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
import           Ouroboros.Consensus.MiniProtocol.LocalStateQuery.Server
import           Ouroboros.Consensus.MiniProtocol.LocalTxMonitor.Server
import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Serialisation
import qualified Ouroboros.Consensus.Node.Tracers as Node
import           Ouroboros.Consensus.NodeKernel
import           Ouroboros.Consensus.Util (ShowProxy)
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.Orphans ()
import           Ouroboros.Consensus.Util.ResourceRegistry

import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB

{-------------------------------------------------------------------------------
  Handlers
-------------------------------------------------------------------------------}

-- | Protocol handlers for node-to-client (local) communication
data Handlers m peer blk = Handlers {
      Handlers m peer blk
-> Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hChainSyncServer
        :: ChainDB.Follower m blk (ChainDB.WithPoint blk (Serialised blk))
        -> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()

    , Handlers m peer blk
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hTxSubmissionServer
        :: LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()

    , Handlers m peer blk
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
hStateQueryServer
        :: LocalStateQueryServer blk (Point blk) (Query blk) m ()

    , Handlers m peer blk
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hTxMonitorServer
        :: LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
    }

mkHandlers
  :: forall m blk remotePeer localPeer.
     ( IOLike m
     , LedgerSupportsMempool blk
     , LedgerSupportsProtocol blk
     , QueryLedger blk
     , ConfigSupportsNode blk
     )
  => NodeKernelArgs m remotePeer localPeer blk
  -> NodeKernel     m remotePeer localPeer blk
  -> Handlers       m            localPeer blk
mkHandlers :: NodeKernelArgs m remotePeer localPeer blk
-> NodeKernel m remotePeer localPeer blk
-> Handlers m localPeer blk
mkHandlers NodeKernelArgs {TopLevelConfig blk
$sel:cfg:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> TopLevelConfig blk
cfg :: TopLevelConfig blk
cfg, Tracers m remotePeer localPeer blk
$sel:tracers:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk
-> Tracers m remotePeer localPeer blk
tracers :: Tracers m remotePeer localPeer blk
tracers} NodeKernel {ChainDB m blk
$sel:getChainDB:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB :: ChainDB m blk
getChainDB, Mempool m blk TicketNo
$sel:getMempool:NodeKernel :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> Mempool m blk TicketNo
getMempool :: Mempool m blk TicketNo
getMempool} =
    Handlers :: forall (m :: * -> *) peer blk.
(Follower m blk (WithPoint blk (Serialised blk))
 -> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ())
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
-> Handlers m peer blk
Handlers {
        hChainSyncServer :: Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hChainSyncServer =
          Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
forall (m :: * -> *) blk.
(IOLike m, HasHeader (Header blk)) =>
Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
chainSyncBlocksServer
            (Tracers m remotePeer localPeer blk
-> Tracer m (TraceChainSyncServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceChainSyncServerEvent blk)
Node.chainSyncServerBlockTracer Tracers m remotePeer localPeer blk
tracers)
            ChainDB m blk
getChainDB
      , hTxSubmissionServer :: LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hTxSubmissionServer =
          Tracer m (TraceLocalTxSubmissionServerEvent blk)
-> Mempool m blk TicketNo
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
forall (m :: * -> *) blk idx.
MonadSTM m =>
Tracer m (TraceLocalTxSubmissionServerEvent blk)
-> Mempool m blk idx
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
localTxSubmissionServer
            (Tracers m remotePeer localPeer blk
-> Tracer m (TraceLocalTxSubmissionServerEvent blk)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLocalTxSubmissionServerEvent blk)
Node.localTxSubmissionServerTracer Tracers m remotePeer localPeer blk
tracers)
            Mempool m blk TicketNo
getMempool
      , hStateQueryServer :: LocalStateQueryServer blk (Point blk) (Query blk) m ()
hStateQueryServer =
          ExtLedgerCfg blk
-> STM m (Point blk)
-> (Point blk -> STM m (Maybe (ExtLedgerState blk)))
-> STM m (Point blk)
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
forall (m :: * -> *) blk.
(IOLike m, QueryLedger blk, ConfigSupportsNode blk,
 HasAnnTip blk) =>
ExtLedgerCfg blk
-> STM m (Point blk)
-> (Point blk -> STM m (Maybe (ExtLedgerState blk)))
-> STM m (Point blk)
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
localStateQueryServer
            (TopLevelConfig blk -> ExtLedgerCfg blk
forall blk. TopLevelConfig blk -> ExtLedgerCfg blk
ExtLedgerCfg TopLevelConfig blk
cfg)
            (ChainDB m blk -> STM m (Point blk)
forall (m :: * -> *) blk. ChainDB m blk -> STM m (Point blk)
ChainDB.getTipPoint ChainDB m blk
getChainDB)
            (ChainDB m blk -> Point blk -> STM m (Maybe (ExtLedgerState blk))
forall (m :: * -> *) blk.
(Monad (STM m), LedgerSupportsProtocol blk) =>
ChainDB m blk -> Point blk -> STM m (Maybe (ExtLedgerState blk))
ChainDB.getPastLedger ChainDB m blk
getChainDB)
            (Point (Header blk) -> Point blk
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Header blk) -> Point blk)
-> (AnchoredFragment (Header blk) -> Point (Header blk))
-> AnchoredFragment (Header blk)
-> Point blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment (Header blk) -> Point (Header blk)
forall block. AnchoredFragment block -> Point block
AF.anchorPoint (AnchoredFragment (Header blk) -> Point blk)
-> STM m (AnchoredFragment (Header blk)) -> STM m (Point blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB m blk -> STM m (AnchoredFragment (Header blk))
forall (m :: * -> *) blk.
ChainDB m blk -> STM m (AnchoredFragment (Header blk))
ChainDB.getCurrentChain ChainDB m blk
getChainDB)

      , hTxMonitorServer :: LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hTxMonitorServer =
          Mempool m blk TicketNo
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
forall blk idx (m :: * -> *).
(MonadSTM m, LedgerSupportsMempool blk, Eq idx) =>
Mempool m blk idx
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
localTxMonitorServer
            Mempool m blk TicketNo
getMempool
      }

{-------------------------------------------------------------------------------
  Codecs
-------------------------------------------------------------------------------}

-- | Node-to-client protocol codecs needed to run 'Handlers'.
data Codecs' blk serialisedBlk e m bCS bTX bSQ bTM = Codecs {
      Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
cChainSyncCodec    :: Codec (ChainSync serialisedBlk (Point blk) (Tip blk))   e m bCS
    , Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cTxSubmissionCodec :: Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))  e m bTX
    , Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cStateQueryCodec   :: Codec (LocalStateQuery blk (Point blk) (Query blk))     e m bSQ
    , Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
cTxMonitorCodec    :: Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
    }

type Codecs blk e m bCS bTX bSQ bTM =
    Codecs' blk (Serialised blk) e m bCS bTX bSQ bTM
type DefaultCodecs blk m =
    Codecs' blk (Serialised blk) DeserialiseFailure m ByteString ByteString ByteString ByteString
type ClientCodecs blk  m =
    Codecs' blk blk DeserialiseFailure m ByteString ByteString ByteString ByteString

-- | Protocol codecs for the node-to-client protocols
--
-- We pass the 'BlockConfig' here, even though it is currently unused. If at any
-- point we want to introduce local protocols that for example send Byron blocks
-- or headers across, we will need to have the epoch size, which comes from the
-- Byron config. Unlike the full 'TopLevelConfig', it should not be difficult
-- for a wallet to construct the 'BlockConfig'.
--
-- NOTE: Somewhat confusingly, 'pcChainSyncCodec' currently /does/ send Byron
-- blocks across, but it does not deserialize them (the user of the codec is
-- itself responsible for doing that), which is why it currently does not need
-- the config.
--
-- Implementation mode: currently none of the consensus encoders/decoders do
-- anything different based on the version, so @_version@ is unused; it's just
-- that not all codecs are used, depending on the version number.
defaultCodecs :: forall m blk.
                 ( MonadST m
                 , SerialiseNodeToClientConstraints blk
                 , ShowQuery (BlockQuery blk)
                 , StandardHash blk
                 , Serialise (HeaderHash blk)
                 )
              => CodecConfig blk
              -> BlockNodeToClientVersion blk
              -> N.NodeToClientVersion
              -> DefaultCodecs blk m
defaultCodecs :: CodecConfig blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> DefaultCodecs blk m
defaultCodecs CodecConfig blk
ccfg BlockNodeToClientVersion blk
version NodeToClientVersion
networkVersion = Codecs :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
-> Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
Codecs {
      cChainSyncCodec :: Codec
  (ChainSync (Serialised blk) (Point blk) (Tip blk))
  DeserialiseFailure
  m
  ByteString
cChainSyncCodec =
        (Serialised blk -> Encoding)
-> (forall s. Decoder s (Serialised blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
     (ChainSync (Serialised blk) (Point blk) (Tip blk))
     DeserialiseFailure
     m
     ByteString
forall header point tip (m :: * -> *).
MonadST m =>
(header -> Encoding)
-> (forall s. Decoder s header)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (tip -> Encoding)
-> (forall s. Decoder s tip)
-> Codec
     (ChainSync header point tip) DeserialiseFailure m ByteString
codecChainSync
          Serialised blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
          forall s. Decoder s (Serialised blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall block.
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall block.
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
          ((HeaderHash blk -> Encoding) -> Tip blk -> Encoding
forall blk. (HeaderHash blk -> Encoding) -> Tip blk -> Encoding
encodeTip   (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
forall blk.
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
decodeTip   (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))

    , cTxSubmissionCodec :: Codec
  (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
  DeserialiseFailure
  m
  ByteString
cTxSubmissionCodec =
        (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> (ApplyTxErr blk -> Encoding)
-> (forall s. Decoder s (ApplyTxErr blk))
-> Codec
     (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
     DeserialiseFailure
     m
     ByteString
forall tx reject (m :: * -> *).
MonadST m =>
(tx -> Encoding)
-> (forall s. Decoder s tx)
-> (reject -> Encoding)
-> (forall s. Decoder s reject)
-> Codec
     (LocalTxSubmission tx reject) DeserialiseFailure m ByteString
codecLocalTxSubmission
          GenTx blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
          forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
          ApplyTxErr blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
          forall s. Decoder s (ApplyTxErr blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec

    , cStateQueryCodec :: Codec
  (LocalStateQuery blk (Point blk) (Query blk))
  DeserialiseFailure
  m
  ByteString
cStateQueryCodec =
        (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (forall result. Query blk result -> Encoding)
-> (forall s. Decoder s (Some (Query blk)))
-> (forall result. Query blk result -> result -> Encoding)
-> (forall result. Query blk result -> forall s. Decoder s result)
-> Codec
     (LocalStateQuery blk (Point blk) (Query blk))
     DeserialiseFailure
     m
     ByteString
forall k (block :: k) point (query :: * -> *) (m :: * -> *).
(MonadST m, ShowQuery query) =>
(point -> Encoding)
-> (forall s. Decoder s point)
-> (forall result. query result -> Encoding)
-> (forall s. Decoder s (Some query))
-> (forall result. query result -> result -> Encoding)
-> (forall result. query result -> forall s. Decoder s result)
-> Codec
     (LocalStateQuery block point query) DeserialiseFailure m ByteString
codecLocalStateQuery
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall block.
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall block.
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
          (CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
forall blk.
(Typeable blk, Show (SomeSecond BlockQuery blk),
 SerialiseNodeToClient blk (SomeSecond BlockQuery blk)) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
queryEncodeNodeToClient CodecConfig blk
ccfg QueryVersion
queryVersion BlockNodeToClientVersion blk
version (SomeSecond Query blk -> Encoding)
-> (Query blk result -> SomeSecond Query blk)
-> Query blk result
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query blk result -> SomeSecond Query blk
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond)
          ((\(SomeSecond Query blk b
qry) -> Query blk b -> Some (Query blk)
forall k (f :: k -> *) (a :: k). f a -> Some f
Some Query blk b
qry) (SomeSecond Query blk -> Some (Query blk))
-> Decoder s (SomeSecond Query blk) -> Decoder s (Some (Query blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
forall blk.
SerialiseNodeToClient blk (SomeSecond BlockQuery blk) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
queryDecodeNodeToClient CodecConfig blk
ccfg QueryVersion
queryVersion BlockNodeToClientVersion blk
version)
          (CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> result
-> Encoding
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> result
-> Encoding
encodeResult CodecConfig blk
ccfg BlockNodeToClientVersion blk
version)
          (CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> forall s. Decoder s result
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> forall s. Decoder s result
decodeResult CodecConfig blk
ccfg BlockNodeToClientVersion blk
version)

    , cTxMonitorCodec :: Codec
  (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
  DeserialiseFailure
  m
  ByteString
cTxMonitorCodec =
        (GenTxId blk -> Encoding)
-> (forall s. Decoder s (GenTxId blk))
-> (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> (SlotNo -> Encoding)
-> (forall s. Decoder s SlotNo)
-> Codec
     (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
     DeserialiseFailure
     m
     ByteString
forall txid tx slot (m :: * -> *) ptcl.
(MonadST m, ptcl ~ LocalTxMonitor txid tx slot) =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> (slot -> Encoding)
-> (forall s. Decoder s slot)
-> Codec
     (LocalTxMonitor txid tx slot) DeserialiseFailure m ByteString
codecLocalTxMonitor
          GenTxId blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc forall s. Decoder s (GenTxId blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
          GenTx blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
          SlotNo -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc forall s. Decoder s SlotNo
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
    }
  where
    queryVersion :: QueryVersion
    queryVersion :: QueryVersion
queryVersion = NodeToClientVersion -> QueryVersion
nodeToClientVersionToQueryVersion NodeToClientVersion
networkVersion

    p :: Proxy blk
    p :: Proxy blk
p = Proxy blk
forall k (t :: k). Proxy t
Proxy

    enc :: SerialiseNodeToClient blk a => a -> Encoding
    enc :: a -> Encoding
enc = CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
ccfg BlockNodeToClientVersion blk
version

    dec :: SerialiseNodeToClient blk a => forall s. Decoder s a
    dec :: forall s. Decoder s a
dec = CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig blk
ccfg BlockNodeToClientVersion blk
version

-- | Protocol codecs for the node-to-client protocols which serialise
-- / deserialise blocks in /chain-sync/ protocol.
--
clientCodecs :: forall m blk.
                ( MonadST m
                , SerialiseNodeToClientConstraints blk
                , ShowQuery (BlockQuery blk)
                , StandardHash blk
                , Serialise (HeaderHash blk)
                )
             => CodecConfig blk
             -> BlockNodeToClientVersion blk
             -> N.NodeToClientVersion
             -> ClientCodecs blk m
clientCodecs :: CodecConfig blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> ClientCodecs blk m
clientCodecs CodecConfig blk
ccfg BlockNodeToClientVersion blk
version NodeToClientVersion
networkVersion = Codecs :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
-> Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
Codecs {
      cChainSyncCodec :: Codec
  (ChainSync blk (Point blk) (Tip blk))
  DeserialiseFailure
  m
  ByteString
cChainSyncCodec =
        (blk -> Encoding)
-> (forall s. Decoder s blk)
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
     (ChainSync blk (Point blk) (Tip blk))
     DeserialiseFailure
     m
     ByteString
forall header point tip (m :: * -> *).
MonadST m =>
(header -> Encoding)
-> (forall s. Decoder s header)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (tip -> Encoding)
-> (forall s. Decoder s tip)
-> Codec
     (ChainSync header point tip) DeserialiseFailure m ByteString
codecChainSync
          blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
          forall s. Decoder s blk
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall block.
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall block.
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
          ((HeaderHash blk -> Encoding) -> Tip blk -> Encoding
forall blk. (HeaderHash blk -> Encoding) -> Tip blk -> Encoding
encodeTip   (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
forall blk.
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Tip blk)
decodeTip   (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))

    , cTxSubmissionCodec :: Codec
  (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
  DeserialiseFailure
  m
  ByteString
cTxSubmissionCodec =
        (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> (ApplyTxErr blk -> Encoding)
-> (forall s. Decoder s (ApplyTxErr blk))
-> Codec
     (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
     DeserialiseFailure
     m
     ByteString
forall tx reject (m :: * -> *).
MonadST m =>
(tx -> Encoding)
-> (forall s. Decoder s tx)
-> (reject -> Encoding)
-> (forall s. Decoder s reject)
-> Codec
     (LocalTxSubmission tx reject) DeserialiseFailure m ByteString
codecLocalTxSubmission
          GenTx blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
          forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
          ApplyTxErr blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc
          forall s. Decoder s (ApplyTxErr blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec

    , cStateQueryCodec :: Codec
  (LocalStateQuery blk (Point blk) (Query blk))
  DeserialiseFailure
  m
  ByteString
cStateQueryCodec =
        (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (forall result. Query blk result -> Encoding)
-> (forall s. Decoder s (Some (Query blk)))
-> (forall result. Query blk result -> result -> Encoding)
-> (forall result. Query blk result -> forall s. Decoder s result)
-> Codec
     (LocalStateQuery blk (Point blk) (Query blk))
     DeserialiseFailure
     m
     ByteString
forall k (block :: k) point (query :: * -> *) (m :: * -> *).
(MonadST m, ShowQuery query) =>
(point -> Encoding)
-> (forall s. Decoder s point)
-> (forall result. query result -> Encoding)
-> (forall s. Decoder s (Some query))
-> (forall result. query result -> result -> Encoding)
-> (forall result. query result -> forall s. Decoder s result)
-> Codec
     (LocalStateQuery block point query) DeserialiseFailure m ByteString
codecLocalStateQuery
          ((HeaderHash blk -> Encoding) -> Point blk -> Encoding
forall block.
(HeaderHash block -> Encoding) -> Point block -> Encoding
encodePoint (Proxy blk -> HeaderHash blk -> Encoding
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Encoding
encodeRawHash Proxy blk
p))
          ((forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (Point blk)
forall block.
(forall s. Decoder s (HeaderHash block))
-> forall s. Decoder s (Point block)
decodePoint (Proxy blk -> forall s. Decoder s (HeaderHash blk)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash Proxy blk
p))
          (CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
forall blk.
(Typeable blk, Show (SomeSecond BlockQuery blk),
 SerialiseNodeToClient blk (SomeSecond BlockQuery blk)) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> SomeSecond Query blk
-> Encoding
queryEncodeNodeToClient CodecConfig blk
ccfg QueryVersion
queryVersion BlockNodeToClientVersion blk
version (SomeSecond Query blk -> Encoding)
-> (Query blk result -> SomeSecond Query blk)
-> Query blk result
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query blk result -> SomeSecond Query blk
forall (f :: * -> * -> *) a b. f a b -> SomeSecond f a
SomeSecond)
          ((\(SomeSecond Query blk b
qry) -> Query blk b -> Some (Query blk)
forall k (f :: k -> *) (a :: k). f a -> Some f
Some Query blk b
qry) (SomeSecond Query blk -> Some (Query blk))
-> Decoder s (SomeSecond Query blk) -> Decoder s (Some (Query blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
forall blk.
SerialiseNodeToClient blk (SomeSecond BlockQuery blk) =>
CodecConfig blk
-> QueryVersion
-> BlockNodeToClientVersion blk
-> forall s. Decoder s (SomeSecond Query blk)
queryDecodeNodeToClient CodecConfig blk
ccfg QueryVersion
queryVersion BlockNodeToClientVersion blk
version)
          (CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> result
-> Encoding
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> result
-> Encoding
encodeResult CodecConfig blk
ccfg BlockNodeToClientVersion blk
version)
          (CodecConfig blk
-> BlockNodeToClientVersion blk
-> Query blk result
-> forall s. Decoder s result
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> forall s. Decoder s result
decodeResult CodecConfig blk
ccfg BlockNodeToClientVersion blk
version)

    , cTxMonitorCodec :: Codec
  (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
  DeserialiseFailure
  m
  ByteString
cTxMonitorCodec =
        (GenTxId blk -> Encoding)
-> (forall s. Decoder s (GenTxId blk))
-> (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> (SlotNo -> Encoding)
-> (forall s. Decoder s SlotNo)
-> Codec
     (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
     DeserialiseFailure
     m
     ByteString
forall txid tx slot (m :: * -> *) ptcl.
(MonadST m, ptcl ~ LocalTxMonitor txid tx slot) =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> (slot -> Encoding)
-> (forall s. Decoder s slot)
-> Codec
     (LocalTxMonitor txid tx slot) DeserialiseFailure m ByteString
codecLocalTxMonitor
          GenTxId blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc forall s. Decoder s (GenTxId blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
          GenTx blk -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
          SlotNo -> Encoding
forall a. SerialiseNodeToClient blk a => a -> Encoding
enc forall s. Decoder s SlotNo
forall a s. SerialiseNodeToClient blk a => Decoder s a
dec
    }
  where
    queryVersion :: QueryVersion
    queryVersion :: QueryVersion
queryVersion = NodeToClientVersion -> QueryVersion
nodeToClientVersionToQueryVersion NodeToClientVersion
networkVersion

    p :: Proxy blk
    p :: Proxy blk
p = Proxy blk
forall k (t :: k). Proxy t
Proxy

    enc :: SerialiseNodeToClient blk a => a -> Encoding
    enc :: a -> Encoding
enc = CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient CodecConfig blk
ccfg BlockNodeToClientVersion blk
version

    dec :: SerialiseNodeToClient blk a => forall s. Decoder s a
    dec :: forall s. Decoder s a
dec = CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig blk
ccfg BlockNodeToClientVersion blk
version

-- | Identity codecs used in tests.
identityCodecs :: (Monad m, QueryLedger blk)
               => Codecs blk CodecFailure m
                    (AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk)))
                    (AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
                    (AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
                    (AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
identityCodecs :: Codecs
  blk
  CodecFailure
  m
  (AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk)))
  (AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
  (AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
  (AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
identityCodecs = Codecs :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
-> Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
Codecs {
      cChainSyncCodec :: Codec
  (ChainSync (Serialised blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk)))
cChainSyncCodec    = Codec
  (ChainSync (Serialised blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage (ChainSync (Serialised blk) (Point blk) (Tip blk)))
forall k1 k2 k3 (header :: k1) (point :: k2) (tip :: k3)
       (m :: * -> *).
Monad m =>
Codec
  (ChainSync header point tip)
  CodecFailure
  m
  (AnyMessage (ChainSync header point tip))
codecChainSyncId
    , cTxSubmissionCodec :: Codec
  (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
  CodecFailure
  m
  (AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
cTxSubmissionCodec = Codec
  (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
  CodecFailure
  m
  (AnyMessage (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
forall k1 k2 (tx :: k1) (reject :: k2) (m :: * -> *).
Monad m =>
Codec
  (LocalTxSubmission tx reject)
  CodecFailure
  m
  (AnyMessage (LocalTxSubmission tx reject))
codecLocalTxSubmissionId
    , cStateQueryCodec :: Codec
  (LocalStateQuery blk (Point blk) (Query blk))
  CodecFailure
  m
  (AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
cStateQueryCodec   = (forall result1 result2.
 Query blk result1
 -> Query blk result2 -> Maybe (result1 :~: result2))
-> Codec
     (LocalStateQuery blk (Point blk) (Query blk))
     CodecFailure
     m
     (AnyMessage (LocalStateQuery blk (Point blk) (Query blk)))
forall k1 k2 (block :: k1) (point :: k2) (query :: * -> *)
       (m :: * -> *).
Monad m =>
(forall result1 result2.
 query result1 -> query result2 -> Maybe (result1 :~: result2))
-> Codec
     (LocalStateQuery block point query)
     CodecFailure
     m
     (AnyMessage (LocalStateQuery block point query))
codecLocalStateQueryId forall result1 result2.
Query blk result1
-> Query blk result2 -> Maybe (result1 :~: result2)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex
    , cTxMonitorCodec :: Codec
  (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
  CodecFailure
  m
  (AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
cTxMonitorCodec    = Codec
  (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
  CodecFailure
  m
  (AnyMessage (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
forall k1 k2 k3 (txid :: k1) (tx :: k2) (slot :: k3) (m :: * -> *)
       ptcl.
(Monad m, ptcl ~ LocalTxMonitor txid tx slot) =>
Codec ptcl CodecFailure m (AnyMessage ptcl)
codecLocalTxMonitorId
    }

{-------------------------------------------------------------------------------
  Tracers
-------------------------------------------------------------------------------}

-- | A record of 'Tracer's for the different protocols.
type Tracers m peer blk e =
     Tracers'  peer blk e (Tracer m)

data Tracers' peer blk e f = Tracers {
      Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer    :: f (TraceLabelPeer peer (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
    , Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer :: f (TraceLabelPeer peer (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
    , Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer   :: f (TraceLabelPeer peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
    , Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer    :: f (TraceLabelPeer peer (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
    }

instance (forall a. Semigroup (f a)) => Semigroup (Tracers' peer blk e f) where
  Tracers' peer blk e f
l <> :: Tracers' peer blk e f
-> Tracers' peer blk e f -> Tracers' peer blk e f
<> Tracers' peer blk e f
r = Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracers' peer blk e f
Tracers {
        tChainSyncTracer :: f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer    = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv
            (ChainSync (Serialised blk) (Point blk) (Tip blk)))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer
      , tTxSubmissionTracer :: f (TraceLabelPeer
     peer
     (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer
      , tStateQueryTracer :: f (TraceLabelPeer
     peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer   = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer
      , tTxMonitorTracer :: f (TraceLabelPeer
     peer
     (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer    = (Tracers' peer blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall a. Semigroup a => (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer
      }
    where
      f :: forall a. Semigroup a
        => (Tracers' peer blk e f -> a)
        -> a
      f :: (Tracers' peer blk e f -> a) -> a
f Tracers' peer blk e f -> a
prj = Tracers' peer blk e f -> a
prj Tracers' peer blk e f
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Tracers' peer blk e f -> a
prj Tracers' peer blk e f
r

-- | Use a 'nullTracer' for each protocol.
nullTracers :: Monad m => Tracers m peer blk e
nullTracers :: Tracers m peer blk e
nullTracers = Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracers' peer blk e f
Tracers {
      tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer    = Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , tTxSubmissionTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer = Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , tStateQueryTracer :: Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer   = Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    , tTxMonitorTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer    = Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
    }

showTracers :: ( Show peer
               , Show (GenTx blk)
               , Show (GenTxId blk)
               , Show (ApplyTxErr blk)
               , ShowQuery (BlockQuery blk)
               , HasHeader blk
               )
            => Tracer m String -> Tracers m peer blk e
showTracers :: Tracer m String -> Tracers m peer blk e
showTracers Tracer m String
tr = Tracers :: forall peer blk e (f :: * -> *).
f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracers' peer blk e f
Tracers {
      tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer    = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , tTxSubmissionTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , tStateQueryTracer :: Tracer
  m
  (TraceLabelPeer
     peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer   = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    , tTxMonitorTracer :: Tracer
  m
  (TraceLabelPeer
     peer
     (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer    = Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
forall a (m :: * -> *). Show a => Tracer m String -> Tracer m a
showTracing Tracer m String
tr
    }

{-------------------------------------------------------------------------------
  Applications
-------------------------------------------------------------------------------}

-- | A node-to-client application
type App m peer bytes a = peer -> Channel m bytes -> m (a, Maybe bytes)

-- | Applications for the node-to-client (i.e., local) protocols
--
-- See 'Network.Mux.Types.MuxApplication'
data Apps m peer bCS bTX bSQ bTM a = Apps {
      -- | Start a local chain sync server.
      Apps m peer bCS bTX bSQ bTM a -> App m peer bCS a
aChainSyncServer    :: App m peer bCS a

      -- | Start a local transaction submission server.
    , Apps m peer bCS bTX bSQ bTM a -> App m peer bTX a
aTxSubmissionServer :: App m peer bTX a

      -- | Start a local state query server.
    , Apps m peer bCS bTX bSQ bTM a -> App m peer bSQ a
aStateQueryServer   :: App m peer bSQ a

      -- | Start a local transaction monitor server
    , Apps m peer bCS bTX bSQ bTM a -> App m peer bTM a
aTxMonitorServer    :: App m peer bTM a
    }

-- | Construct the 'NetworkApplication' for the node-to-client protocols
mkApps
  :: forall m remotePeer localPeer blk e bCS bTX bSQ bTM.
     ( IOLike m
     , Exception e
     , ShowProxy blk
     , ShowProxy (ApplyTxErr blk)
     , ShowProxy (BlockQuery blk)
     , ShowProxy (GenTx blk)
     , ShowProxy (GenTxId blk)
     , ShowQuery (BlockQuery blk)
     )
  => NodeKernel m remotePeer localPeer blk
  -> Tracers m localPeer blk e
  -> Codecs blk e m bCS bTX bSQ bTM
  -> Handlers m localPeer blk
  -> Apps m localPeer bCS bTX bSQ bTM ()
mkApps :: NodeKernel m remotePeer localPeer blk
-> Tracers m localPeer blk e
-> Codecs blk e m bCS bTX bSQ bTM
-> Handlers m localPeer blk
-> Apps m localPeer bCS bTX bSQ bTM ()
mkApps NodeKernel m remotePeer localPeer blk
kernel Tracers {Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tTxMonitorTracer :: Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tStateQueryTracer :: Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tTxSubmissionTracer :: Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tTxMonitorTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tStateQueryTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tTxSubmissionTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tChainSyncTracer :: forall peer blk e (f :: * -> *).
Tracers' peer blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
..} Codecs {Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
Codec (ChainSync (Serialised blk) (Point blk) (Tip blk)) e m bCS
cTxMonitorCodec :: Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
cStateQueryCodec :: Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cTxSubmissionCodec :: Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cChainSyncCodec :: Codec (ChainSync (Serialised blk) (Point blk) (Tip blk)) e m bCS
cTxMonitorCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
cStateQueryCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cTxSubmissionCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cChainSyncCodec :: forall blk serialisedBlk e (m :: * -> *) bCS bTX bSQ bTM.
Codecs' blk serialisedBlk e m bCS bTX bSQ bTM
-> Codec (ChainSync serialisedBlk (Point blk) (Tip blk)) e m bCS
..} Handlers {LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
LocalStateQueryServer blk (Point blk) (Query blk) m ()
Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hTxMonitorServer :: LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hStateQueryServer :: LocalStateQueryServer blk (Point blk) (Query blk) m ()
hTxSubmissionServer :: LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hChainSyncServer :: Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hTxMonitorServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hStateQueryServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalStateQueryServer blk (Point blk) (Query blk) m ()
hTxSubmissionServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hChainSyncServer :: forall (m :: * -> *) peer blk.
Handlers m peer blk
-> Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
..} =
    Apps :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
App m peer bCS a
-> App m peer bTX a
-> App m peer bSQ a
-> App m peer bTM a
-> Apps m peer bCS bTX bSQ bTM a
Apps {localPeer -> Channel m bCS -> m ((), Maybe bCS)
localPeer -> Channel m bTX -> m ((), Maybe bTX)
localPeer -> Channel m bSQ -> m ((), Maybe bSQ)
localPeer -> Channel m bTM -> m ((), Maybe bTM)
aTxMonitorServer :: localPeer -> Channel m bTM -> m ((), Maybe bTM)
aStateQueryServer :: localPeer -> Channel m bSQ -> m ((), Maybe bSQ)
aTxSubmissionServer :: localPeer -> Channel m bTX -> m ((), Maybe bTX)
aChainSyncServer :: localPeer -> Channel m bCS -> m ((), Maybe bCS)
aTxMonitorServer :: localPeer -> Channel m bTM -> m ((), Maybe bTM)
aStateQueryServer :: localPeer -> Channel m bSQ -> m ((), Maybe bSQ)
aTxSubmissionServer :: localPeer -> Channel m bTX -> m ((), Maybe bTX)
aChainSyncServer :: localPeer -> Channel m bCS -> m ((), Maybe bCS)
..}
  where
    aChainSyncServer
      :: localPeer
      -> Channel m bCS
      -> m ((), Maybe bCS)
    aChainSyncServer :: localPeer -> Channel m bCS -> m ((), Maybe bCS)
aChainSyncServer localPeer
them Channel m bCS
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LocalChainSyncServer"
      (ResourceRegistry m
 -> m (Follower m blk (WithPoint blk (Serialised blk))))
-> (Follower m blk (WithPoint blk (Serialised blk)) -> m ())
-> (Follower m blk (WithPoint blk (Serialised blk))
    -> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall (m :: * -> *) a r.
(IOLike m, HasCallStack) =>
(ResourceRegistry m -> m a) -> (a -> m ()) -> (a -> m r) -> m r
bracketWithPrivateRegistry
        (ChainDB m blk
-> ResourceRegistry m
-> m (Follower m blk (WithPoint blk (Serialised blk)))
forall (m :: * -> *) blk.
ChainDB m blk
-> ResourceRegistry m
-> m (Follower m blk (WithPoint blk (Serialised blk)))
chainSyncBlockServerFollower (NodeKernel m remotePeer localPeer blk -> ChainDB m blk
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> ChainDB m blk
getChainDB NodeKernel m remotePeer localPeer blk
kernel))
        Follower m blk (WithPoint blk (Serialised blk)) -> m ()
forall (m :: * -> *) blk a. Follower m blk a -> m ()
ChainDB.followerClose
        ((Follower m blk (WithPoint blk (Serialised blk))
  -> m ((), Maybe bCS))
 -> m ((), Maybe bCS))
-> (Follower m blk (WithPoint blk (Serialised blk))
    -> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ \Follower m blk (WithPoint blk (Serialised blk))
flr ->
          Tracer
  m
  (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk)))
-> Codec (ChainSync (Serialised blk) (Point blk) (Tip blk)) e m bCS
-> Channel m bCS
-> Peer
     (ChainSync (Serialised blk) (Point blk) (Tip blk))
     'AsServer
     'StIdle
     m
     ()
-> m ((), Maybe bCS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadThrow m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer
            ((TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))
 -> TraceLabelPeer
      localPeer
      (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceLabelPeer
        localPeer
        (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (localPeer
-> TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))
-> TraceLabelPeer
     localPeer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer localPeer
them) Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
tChainSyncTracer)
            Codec (ChainSync (Serialised blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec
            Channel m bCS
channel
            (Peer
   (ChainSync (Serialised blk) (Point blk) (Tip blk))
   'AsServer
   'StIdle
   m
   ()
 -> m ((), Maybe bCS))
-> Peer
     (ChainSync (Serialised blk) (Point blk) (Tip blk))
     'AsServer
     'StIdle
     m
     ()
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
-> Peer
     (ChainSync (Serialised blk) (Point blk) (Tip blk))
     'AsServer
     'StIdle
     m
     ()
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncServer header point tip m a
-> Peer (ChainSync header point tip) 'AsServer 'StIdle m a
chainSyncServerPeer
            (ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
 -> Peer
      (ChainSync (Serialised blk) (Point blk) (Tip blk))
      'AsServer
      'StIdle
      m
      ())
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
-> Peer
     (ChainSync (Serialised blk) (Point blk) (Tip blk))
     'AsServer
     'StIdle
     m
     ()
forall a b. (a -> b) -> a -> b
$ Follower m blk (WithPoint blk (Serialised blk))
-> ChainSyncServer (Serialised blk) (Point blk) (Tip blk) m ()
hChainSyncServer Follower m blk (WithPoint blk (Serialised blk))
flr

    aTxSubmissionServer
      :: localPeer
      -> Channel m bTX
      -> m ((), Maybe bTX)
    aTxSubmissionServer :: localPeer -> Channel m bTX -> m ((), Maybe bTX)
aTxSubmissionServer localPeer
them Channel m bTX
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LocalTxSubmissionServer"
      Tracer
  m (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
-> Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
-> Channel m bTX
-> Peer
     (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
     'AsServer
     'StIdle
     m
     ()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadThrow m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer
        ((TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
 -> TraceLabelPeer
      localPeer
      (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> Tracer
     m
     (TraceLabelPeer
        localPeer
        (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
-> Tracer
     m (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (localPeer
-> TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
-> TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer localPeer
them) Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))))
tTxSubmissionTracer)
        Codec (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) e m bTX
cTxSubmissionCodec
        Channel m bTX
channel
        (m (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ())
-> Peer
     (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
     'AsServer
     'StIdle
     m
     ()
forall tx reject (m :: * -> *) a.
Monad m =>
m (LocalTxSubmissionServer tx reject m a)
-> Peer (LocalTxSubmission tx reject) 'AsServer 'StIdle m a
localTxSubmissionServerPeer (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
-> m (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
hTxSubmissionServer))

    aStateQueryServer
      :: localPeer
      -> Channel m bSQ
      -> m ((), Maybe bSQ)
    aStateQueryServer :: localPeer -> Channel m bSQ -> m ((), Maybe bSQ)
aStateQueryServer localPeer
them Channel m bSQ
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LocalStateQueryServer"
      Tracer
  m (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))
-> Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
-> Channel m bSQ
-> Peer
     (LocalStateQuery blk (Point blk) (Query blk))
     'AsServer
     'StIdle
     m
     ()
-> m ((), Maybe bSQ)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadThrow m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer
        ((TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))
 -> TraceLabelPeer
      localPeer
      (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> Tracer
     m
     (TraceLabelPeer
        localPeer
        (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
-> Tracer
     m (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (localPeer
-> TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))
-> TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer localPeer
them) Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalStateQuery blk (Point blk) (Query blk))))
tStateQueryTracer)
        Codec (LocalStateQuery blk (Point blk) (Query blk)) e m bSQ
cStateQueryCodec
        Channel m bSQ
channel
        (LocalStateQueryServer blk (Point blk) (Query blk) m ()
-> Peer
     (LocalStateQuery blk (Point blk) (Query blk))
     'AsServer
     'StIdle
     m
     ()
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryServer block point query m a
-> Peer (LocalStateQuery block point query) 'AsServer 'StIdle m a
localStateQueryServerPeer LocalStateQueryServer blk (Point blk) (Query blk) m ()
hStateQueryServer)

    aTxMonitorServer
      :: localPeer
      -> Channel m bTM
      -> m ((), Maybe bTM)
    aTxMonitorServer :: localPeer -> Channel m bTM -> m ((), Maybe bTM)
aTxMonitorServer localPeer
them Channel m bTM
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LocalTxMonitorServer"
      Tracer
  m (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
-> Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
-> Channel m bTM
-> Peer
     (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
     'AsServer
     'StIdle
     m
     ()
-> m ((), Maybe bTM)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadThrow m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> Channel m bytes
-> Peer ps pr st m a
-> m (a, Maybe bytes)
runPeer
        ((TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
 -> TraceLabelPeer
      localPeer
      (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracer
     m
     (TraceLabelPeer
        localPeer
        (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
-> Tracer
     m (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (localPeer
-> TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
-> TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer localPeer
them) Tracer
  m
  (TraceLabelPeer
     localPeer
     (TraceSendRecv (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)))
tTxMonitorTracer)
        Codec (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo) e m bTM
cTxMonitorCodec
        Channel m bTM
channel
        (LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
-> Peer
     (LocalTxMonitor (GenTxId blk) (GenTx blk) SlotNo)
     'AsServer
     'StIdle
     m
     ()
forall txid tx slot (m :: * -> *) a.
Monad m =>
LocalTxMonitorServer txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
localTxMonitorServerPeer LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
hTxMonitorServer)

{-------------------------------------------------------------------------------
  Projections from 'Apps'
-------------------------------------------------------------------------------}

-- | A projection from 'NetworkApplication' to a server-side
-- 'OuroborosApplication' for the node-to-client protocols.
responder
  :: N.NodeToClientVersion
  -> Apps m (ConnectionId peer) b b b b a
  -> OuroborosApplication 'ResponderMode peer b m Void a
responder :: NodeToClientVersion
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosApplication 'ResponderMode peer b m Void a
responder NodeToClientVersion
version Apps {App m (ConnectionId peer) b a
aTxMonitorServer :: App m (ConnectionId peer) b a
aStateQueryServer :: App m (ConnectionId peer) b a
aTxSubmissionServer :: App m (ConnectionId peer) b a
aChainSyncServer :: App m (ConnectionId peer) b a
aTxMonitorServer :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bTM a
aStateQueryServer :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bSQ a
aTxSubmissionServer :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bTX a
aChainSyncServer :: forall (m :: * -> *) peer bCS bTX bSQ bTM a.
Apps m peer bCS bTX bSQ bTM a -> App m peer bCS a
..} =
    (ConnectionId peer
 -> STM m ControlMessage
 -> NodeToClientProtocols 'ResponderMode b m Void a)
-> NodeToClientVersion
-> OuroborosApplication 'ResponderMode peer b m Void a
forall addr (m :: * -> *) (appType :: MuxMode) bytes a b.
(ConnectionId addr
 -> STM m ControlMessage
 -> NodeToClientProtocols appType bytes m a b)
-> NodeToClientVersion
-> OuroborosApplication appType addr bytes m a b
nodeToClientProtocols
      (\ConnectionId peer
peer STM m ControlMessage
_shouldStopSTM -> NodeToClientProtocols :: forall (appType :: MuxMode) bytes (m :: * -> *) a b.
RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> RunMiniProtocol appType bytes m a b
-> NodeToClientProtocols appType bytes m a b
NodeToClientProtocols {
          localChainSyncProtocol :: RunMiniProtocol 'ResponderMode b m Void a
localChainSyncProtocol =
            (MuxPeer b m a -> RunMiniProtocol 'ResponderMode b m Void a
forall bytes (m :: * -> *) b.
MuxPeer bytes m b -> RunMiniProtocol 'ResponderMode bytes m Void b
ResponderProtocolOnly ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (App m (ConnectionId peer) b a
aChainSyncServer ConnectionId peer
peer))),
          localTxSubmissionProtocol :: RunMiniProtocol 'ResponderMode b m Void a
localTxSubmissionProtocol =
            (MuxPeer b m a -> RunMiniProtocol 'ResponderMode b m Void a
forall bytes (m :: * -> *) b.
MuxPeer bytes m b -> RunMiniProtocol 'ResponderMode bytes m Void b
ResponderProtocolOnly ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (App m (ConnectionId peer) b a
aTxSubmissionServer ConnectionId peer
peer))),
          localStateQueryProtocol :: RunMiniProtocol 'ResponderMode b m Void a
localStateQueryProtocol =
            (MuxPeer b m a -> RunMiniProtocol 'ResponderMode b m Void a
forall bytes (m :: * -> *) b.
MuxPeer bytes m b -> RunMiniProtocol 'ResponderMode bytes m Void b
ResponderProtocolOnly ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (App m (ConnectionId peer) b a
aStateQueryServer ConnectionId peer
peer))),
          localTxMonitorProtocol :: RunMiniProtocol 'ResponderMode b m Void a
localTxMonitorProtocol =
            (MuxPeer b m a -> RunMiniProtocol 'ResponderMode b m Void a
forall bytes (m :: * -> *) b.
MuxPeer bytes m b -> RunMiniProtocol 'ResponderMode bytes m Void b
ResponderProtocolOnly ((Channel m b -> m (a, Maybe b)) -> MuxPeer b m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw (App m (ConnectionId peer) b a
aTxMonitorServer ConnectionId peer
peer)))
        })
      NodeToClientVersion
version