{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Intended for qualified import
module Ouroboros.Consensus.Network.NodeToNode
  ( -- * Handlers
    Handlers (..)
  , mkHandlers

    -- * Codecs
  , Codecs (..)
  , defaultCodecs
  , identityCodecs

    -- * Byte Limits
  , ByteLimits
  , byteLimits
  , noByteLimits

    -- * Tracers
  , Tracers
  , Tracers' (..)
  , nullTracers
  , showTracers

    -- * Applications
  , Apps (..)
  , ClientApp
  , ServerApp
  , mkApps

    -- ** Projections
  , initiator
  , initiatorAndResponder
  ) where

import Cardano.Base.FeatureFlags (CardanoFeatureFlag)
import Cardano.Network.NodeToNode
import Cardano.Network.PeerSelection (PeerTrustable (..))
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import Codec.CBOR.Read (DeserialiseFailure)
import qualified Control.Concurrent.Class.MonadSTM.Strict.TVar as TVar.Unchecked
import Control.DeepSeq (NFData)
import Control.Monad.Class.MonadTime.SI (MonadTime)
import Control.Monad.Class.MonadTimer.SI (MonadTimer)
import Control.ResourceRegistry
import Control.Tracer
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Hashable (Hashable)
import Data.Int (Int64)
import Data.Map.Strict (Map)
import Data.Set (Set)
import Data.Void (Void)
import qualified Network.Mux as Mux
import Network.TypedProtocol.Codec
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config (DiffusionPipeliningSupport (..))
import Ouroboros.Consensus.HardFork.Abstract (HasHardForkHistory)
import Ouroboros.Consensus.HeaderValidation (HeaderWithTime)
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Leios.Protocol (LeiosProtocol)
import Ouroboros.Consensus.Leios.Types
  ( LeiosPoint
  , LeiosVote
  , decodeLeiosPoint
  , decodeLeiosVote
  , encodeLeiosPoint
  , encodeLeiosVote
  )
import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
  ( ChainSyncStateView (..)
  )
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CsClient
import Ouroboros.Consensus.MiniProtocol.ChainSync.Server
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Client (LeiosNotifyClientPeerPipelined)
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Client.State
  ( LeiosNotifyPeerState (..)
  )
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Server
  ( LeiosNotifyServerPeerLookahead
  )
import Ouroboros.Consensus.MiniProtocol.LeiosNotify.Type
  ( LeiosNotify
  , byteLimitsLeiosNotify
  , codecLeiosNotify
  , codecLeiosNotifyId
  , timeLimitsLeiosNotify
  )
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound (objectDiffusionInbound)
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasCert
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasVote
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Outbound (objectDiffusionOutbound)
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasCert
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasVote
import Ouroboros.Consensus.Network.LeiosNotify (runLookaheadFixedSenderPeerWithLimits)
import Ouroboros.Consensus.Network.NodeToNode.LeiosNotify
  ( leiosNotifyClient
  , leiosNotifyProtocols
  , leiosNotifyServer
  , withLeiosNotifyClientState
  )
import Ouroboros.Consensus.Node.ExitPolicy
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 qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import Ouroboros.Consensus.Storage.Serialisation (SerialisedHeader)
import Ouroboros.Consensus.Util (ShowProxy)
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.Orphans ()
import Ouroboros.Network.Block
  ( Serialised (..)
  )
import Ouroboros.Network.BlockFetch
import Ouroboros.Network.BlockFetch.Client
  ( BlockFetchClient
  , blockFetchClient
  )
import Ouroboros.Network.Channel
import Ouroboros.Network.DeltaQ
import Ouroboros.Network.Driver
import Ouroboros.Network.Driver.Limits
import Ouroboros.Network.KeepAlive
import Ouroboros.Network.Mux
import Ouroboros.Network.PeerSelection.PeerMetric.Type
  ( FetchedMetricsTracer
  , ReportPeerMetrics (..)
  )
import Ouroboros.Network.PeerSharing
  ( PeerSharingController
  , bracketPeerSharingClient
  , peerSharingClient
  , peerSharingServer
  )
import Ouroboros.Network.Protocol.BlockFetch.Codec
import Ouroboros.Network.Protocol.BlockFetch.Server
  ( BlockFetchServer
  , blockFetchServerPeer
  )
import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch (..))
import Ouroboros.Network.Protocol.ChainSync.ClientPipelined
import Ouroboros.Network.Protocol.ChainSync.Codec
import Ouroboros.Network.Protocol.ChainSync.PipelineDecision
import Ouroboros.Network.Protocol.ChainSync.Server
import Ouroboros.Network.Protocol.ChainSync.Type
import Ouroboros.Network.Protocol.KeepAlive.Client
import Ouroboros.Network.Protocol.KeepAlive.Codec
import Ouroboros.Network.Protocol.KeepAlive.Server
import Ouroboros.Network.Protocol.KeepAlive.Type
import Ouroboros.Network.Protocol.ObjectDiffusion.Codec
  ( byteLimitsObjectDiffusion
  , codecObjectDiffusion
  , codecObjectDiffusionId
  , timeLimitsObjectDiffusion
  )
import Ouroboros.Network.Protocol.ObjectDiffusion.Inbound
  ( objectDiffusionInboundPeerPipelined
  )
import Ouroboros.Network.Protocol.ObjectDiffusion.Outbound
  ( objectDiffusionOutboundPeer
  )
import Ouroboros.Network.Protocol.PeerSharing.Client
  ( PeerSharingClient
  , peerSharingClientPeer
  )
import Ouroboros.Network.Protocol.PeerSharing.Codec
  ( byteLimitsPeerSharing
  , codecPeerSharing
  , codecPeerSharingId
  , timeLimitsPeerSharing
  )
import Ouroboros.Network.Protocol.PeerSharing.Server
  ( PeerSharingServer
  , peerSharingServerPeer
  )
import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharing)
import Ouroboros.Network.Protocol.TxSubmission2.Client
import Ouroboros.Network.Protocol.TxSubmission2.Codec
import Ouroboros.Network.Protocol.TxSubmission2.Server
import Ouroboros.Network.Protocol.TxSubmission2.Type
import Ouroboros.Network.Tx (HasRawTxId)
import Ouroboros.Network.TxSubmission.Inbound.V1
import Ouroboros.Network.TxSubmission.Inbound.V2
  ( PeerTxAPI
  , TxDecisionPolicy (..)
  , TxSubmissionLogicVersion (..)
  , txSubmissionInboundV2
  , withPeer
  )
import Ouroboros.Network.TxSubmission.Mempool.Reader
  ( mapTxSubmissionMempoolReader
  )
import Ouroboros.Network.TxSubmission.Outbound
import System.Random (StdGen, splitGen)

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

-- | Protocol handlers for node-to-node (remote) communication
data Handlers m addr blk = Handlers
  { forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient ::
      ConnectionId addr ->
      IsBigLedgerPeer ->
      CsClient.DynamicEnv m blk ->
      ChainSyncClientPipelined
        (Header blk)
        (Point blk)
        (Tip blk)
        m
        CsClient.ChainSyncClientResult
  , -- TODO: we should reconsider bundling these context parameters into a
    -- record, perhaps instead extending the protocol handler
    -- representation to support bracket-style initialisation so that we
    -- could have the closure include these and not need to be explicit
    -- about them here.

    forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer ::
      ConnectionId addr ->
      NodeToNodeVersion ->
      ChainDB.Follower m blk (ChainDB.WithPoint blk (SerialisedHeader blk)) ->
      ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()
  , -- TODO block fetch client does not have GADT view of the handlers.
    forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (HeaderWithTime blk) blk blk m ()
hBlockFetchClient ::
      NodeToNodeVersion ->
      ControlMessageSTM m ->
      FetchedMetricsTracer m ->
      BlockFetchClient (HeaderWithTime blk) blk blk m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer ::
      ConnectionId addr ->
      NodeToNodeVersion ->
      ResourceRegistry m ->
      BlockFetchServer (Serialised blk) (Point blk) m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient ::
      NodeToNodeVersion ->
      ControlMessageSTM m ->
      ConnectionId addr ->
      TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> Either
     (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
     (PeerTxAPI m (GenTxId blk) (GenTx blk)
      -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
hTxSubmissionServer ::
      NodeToNodeVersion ->
      ConnectionId addr ->
      Either
        (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
        ( PeerTxAPI m (GenTxId blk) (GenTx blk) ->
          TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
        )
  -- ^ Either we use the legacy tx submission protocol or the newest one
  -- which require PeerTxAPI. This is decided by
  -- 'EnableNewTxSubmissionProtocol' flag.
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PerasCertDiffusionInboundPipelined blk m ()
hPerasCertDiffusionClient ::
      NodeToNodeVersion ->
      ControlMessageSTM m ->
      ConnectionId addr ->
      PerasCertDiffusionInboundPipelined blk m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PerasCertDiffusionOutbound blk m ()
hPerasCertDiffusionServer ::
      NodeToNodeVersion ->
      ConnectionId addr ->
      PerasCertDiffusionOutbound blk m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PerasVoteDiffusionInboundPipelined blk m ()
hPerasVoteDiffusionClient ::
      NodeToNodeVersion ->
      ControlMessageSTM m ->
      ConnectionId addr ->
      PerasVoteDiffusionInboundPipelined blk m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PerasVoteDiffusionOutbound blk m ()
hPerasVoteDiffusionServer ::
      NodeToNodeVersion ->
      ConnectionId addr ->
      PerasVoteDiffusionOutbound blk m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient ::
      NodeToNodeVersion ->
      ControlMessageSTM m ->
      ConnectionId addr ->
      TVar.Unchecked.StrictTVar m (Map (ConnectionId addr) PeerGSV) ->
      KeepAliveInterval ->
      KeepAliveClient m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion -> ConnectionId addr -> KeepAliveServer m ()
hKeepAliveServer ::
      NodeToNodeVersion ->
      ConnectionId addr ->
      KeepAliveServer m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PeerSharingController addr m
-> m (PeerSharingClient addr m ())
hPeerSharingClient ::
      NodeToNodeVersion ->
      ControlMessageSTM m ->
      ConnectionId addr ->
      PeerSharingController addr m ->
      m (PeerSharingClient addr m ())
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PeerSharingServer addr m
hPeerSharingServer ::
      NodeToNodeVersion ->
      ConnectionId addr ->
      PeerSharingServer addr m
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (LeiosNotifyPeerState blk)
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
hLeiosNotifyClient ::
      NodeToNodeVersion ->
      ControlMessageSTM m ->
      ConnectionId addr ->
      StrictTVar m (LeiosNotifyPeerState blk) ->
      LeiosNotifyClientPeerPipelined LeiosPoint (Header blk) LeiosVote m ()
  , forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> m (LeiosNotifyServerPeerLookahead
        LeiosPoint (Header blk) LeiosVote m)
hLeiosNotifyServer ::
      NodeToNodeVersion ->
      ConnectionId addr ->
      m (LeiosNotifyServerPeerLookahead LeiosPoint (Header blk) LeiosVote m)
  }

mkHandlers ::
  forall m blk addrNTN addrNTC.
  ( IOLike m
  , MonadTime m
  , MonadTimer m
  , HasTxId (GenTx blk)
  , BlockSupportsPeras blk
  , LedgerSupportsMempool blk
  , LedgerSupportsProtocol blk
  , LeiosProtocol (BlockProtocol blk)
  , ConvertRawHash blk
  , HasHardForkHistory blk
  , Ord addrNTN
  , Hashable addrNTN
  ) =>
  NodeKernelArgs m addrNTN addrNTC blk ->
  NodeKernel m addrNTN addrNTC blk ->
  TxSubmissionLogicVersion ->
  Handlers m addrNTN blk
mkHandlers :: forall (m :: * -> *) blk addrNTN addrNTC.
(IOLike m, MonadTime m, MonadTimer m, HasTxId (GenTx blk),
 BlockSupportsPeras blk, LedgerSupportsMempool blk,
 LedgerSupportsProtocol blk, LeiosProtocol (BlockProtocol blk),
 ConvertRawHash blk, HasHardForkHistory blk, Ord addrNTN,
 Hashable addrNTN) =>
NodeKernelArgs m addrNTN addrNTC blk
-> NodeKernel m addrNTN addrNTC blk
-> TxSubmissionLogicVersion
-> Handlers m addrNTN blk
mkHandlers
  NodeKernelArgs
    { SomeHeaderInFutureCheck m blk
chainSyncFutureCheck :: SomeHeaderInFutureCheck m blk
chainSyncFutureCheck :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
    , ClockSkew
maxClockSkew :: ClockSkew
maxClockSkew :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> ClockSkew
maxClockSkew
    , m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck :: m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck
    , StdGen
keepAliveRng :: StdGen
keepAliveRng :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> StdGen
keepAliveRng
    , MiniProtocolParameters
miniProtocolParameters :: MiniProtocolParameters
miniProtocolParameters :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> MiniProtocolParameters
miniProtocolParameters
    , DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> DiffusionPipeliningSupport
getDiffusionPipeliningSupport
    , TxSubmissionInitDelay
txSubmissionInitDelay :: TxSubmissionInitDelay
txSubmissionInitDelay :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> TxSubmissionInitDelay
txSubmissionInitDelay
    , SystemTime m
systemTime :: SystemTime m
systemTime :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> SystemTime m
systemTime
    }
  NodeKernel
    { ChainDB m blk
getChainDB :: ChainDB m blk
getChainDB :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB
    , Mempool m blk
getMempool :: Mempool m blk
getMempool :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> Mempool m blk
getMempool
    , TopLevelConfig blk
getTopLevelConfig :: TopLevelConfig blk
getTopLevelConfig :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> TopLevelConfig blk
getTopLevelConfig
    , getTracers :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
getTracers = Tracers m (ConnectionId addrNTN) addrNTC blk
tracers
    , PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI :: PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI
    , STM m GsmState
getGsmState :: STM m GsmState
getGsmState :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m GsmState
getGsmState
    , BlockchainTime m
getBlockchainTime :: BlockchainTime m
getBlockchainTime :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> BlockchainTime m
getBlockchainTime
    }
  TxSubmissionLogicVersion
txSubmissionLogicVersion =
    Handlers
      { hChainSyncClient :: ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient = \ConnectionId addrNTN
peer IsBigLedgerPeer
_isBigLedgerpeer DynamicEnv m blk
dynEnv ->
          ConfigEnv m blk
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk, BlockSupportsPeras blk) =>
ConfigEnv m blk
-> DynamicEnv m blk -> Consensus ChainSyncClientPipelined blk m
CsClient.chainSyncClient
            CsClient.ConfigEnv
              { cfg :: TopLevelConfig blk
CsClient.cfg = TopLevelConfig blk
getTopLevelConfig
              , someHeaderInFutureCheck :: SomeHeaderInFutureCheck m blk
CsClient.someHeaderInFutureCheck = SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
              , historicityCheck :: HistoricityCheck m blk
CsClient.historicityCheck = m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck (STM m GsmState -> m GsmState
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m GsmState
getGsmState)
              , chainDbView :: ChainDbView m blk
CsClient.chainDbView =
                  ChainDB m blk -> ChainDbView m blk
forall (m :: * -> *) blk. ChainDB m blk -> ChainDbView m blk
CsClient.defaultChainDbView ChainDB m blk
getChainDB
              , mkPipelineDecision0 :: MkPipelineDecision
CsClient.mkPipelineDecision0 =
                  Word16 -> Word16 -> MkPipelineDecision
pipelineDecisionLowHighMark
                    (MiniProtocolParameters -> Word16
chainSyncPipeliningLowMark MiniProtocolParameters
miniProtocolParameters)
                    (MiniProtocolParameters -> Word16
chainSyncPipeliningHighMark MiniProtocolParameters
miniProtocolParameters)
              , tracer :: Tracer m (TraceChainSyncClientEvent blk)
CsClient.tracer =
                  (TraceChainSyncClientEvent blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer m (TraceChainSyncClientEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncClientEvent blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceChainSyncClientEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
Node.chainSyncClientTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers)
              , getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
CsClient.getDiffusionPipeliningSupport = DiffusionPipeliningSupport
getDiffusionPipeliningSupport
              }
            DynamicEnv m blk
dynEnv
      , hChainSyncServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer = \ConnectionId addrNTN
peer NodeToNodeVersion
_version ->
          Tracer m (TraceChainSyncServerEvent blk)
-> ChainDB m blk
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader 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 (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
chainSyncHeadersServer
            ((TraceChainSyncServerEvent blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
-> Tracer m (TraceChainSyncServerEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncServerEvent blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceChainSyncServerEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncServerEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncServerEvent blk))
Node.chainSyncServerHeaderTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            ChainDB m blk
getChainDB
      , hBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (HeaderWithTime blk) blk blk m ()
hBlockFetchClient =
          NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (HeaderWithTime blk) blk blk m ()
forall header block matchedBlock versionNumber (m :: * -> *).
(MonadSTM m, MonadThrow m, MonadTime m, MonadMonotonicTime m,
 HasHeader header, HasHeader block,
 HeaderHash header ~ HeaderHash block) =>
versionNumber
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> FetchClientContext header block matchedBlock m
-> ClientPipelined (BlockFetch block (Point block)) 'BFIdle m ()
blockFetchClient
      , hBlockFetchServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer = \ConnectionId addrNTN
peer NodeToNodeVersion
version ->
          Tracer m (TraceBlockFetchServerEvent blk)
-> ChainDB m blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
forall (m :: * -> *) blk.
(IOLike m, StandardHash blk, Typeable blk) =>
Tracer m (TraceBlockFetchServerEvent blk)
-> ChainDB m blk
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
blockFetchServer
            ((TraceBlockFetchServerEvent blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
-> Tracer m (TraceBlockFetchServerEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceBlockFetchServerEvent blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceBlockFetchServerEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceBlockFetchServerEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceBlockFetchServerEvent blk))
Node.blockFetchServerTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            ChainDB m blk
getChainDB
            NodeToNodeVersion
version
      , hTxSubmissionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionClient = \NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
peer ->
          Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
-> NumTxIdsToAck
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
forall version txid tx idx (m :: * -> *).
(Ord txid, Show txid, Ord idx, MonadSTM m, MonadThrow m) =>
Tracer m (TraceTxSubmissionOutbound txid tx)
-> NumTxIdsToAck
-> TxSubmissionMempoolReader txid tx idx m
-> version
-> ControlMessageSTM m
-> TxSubmissionClient txid tx m ()
txSubmissionOutbound
            ((TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionOutbound (GenTxId blk) (GenTx blk)))
Node.txOutboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            ( Word16 -> NumTxIdsToAck
NumTxIdsToAck (Word16 -> NumTxIdsToAck) -> Word16 -> NumTxIdsToAck
forall a b. (a -> b) -> a -> b
$
                NumTxIdsToReq -> Word16
getNumTxIdsToReq (NumTxIdsToReq -> Word16) -> NumTxIdsToReq -> Word16
forall a b. (a -> b) -> a -> b
$
                  TxDecisionPolicy -> NumTxIdsToReq
maxUnacknowledgedTxIds (TxDecisionPolicy -> NumTxIdsToReq)
-> TxDecisionPolicy -> NumTxIdsToReq
forall a b. (a -> b) -> a -> b
$
                    MiniProtocolParameters -> TxDecisionPolicy
txDecisionPolicy (MiniProtocolParameters -> TxDecisionPolicy)
-> MiniProtocolParameters -> TxDecisionPolicy
forall a b. (a -> b) -> a -> b
$
                      MiniProtocolParameters
miniProtocolParameters
            )
            ((Validated (GenTx blk) -> GenTx blk)
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
forall (m :: * -> *) tx tx' txid idx.
MonadSTM m =>
(tx -> tx')
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolReader txid tx' idx m
mapTxSubmissionMempoolReader Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (TxSubmissionMempoolReader
   (GenTxId blk) (Validated (GenTx blk)) TicketNo m
 -> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m)
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
forall a b. (a -> b) -> a -> b
$ Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader Mempool m blk
getMempool)
            NodeToNodeVersion
version
            ControlMessageSTM m
controlMessageSTM
      , hTxSubmissionServer :: NodeToNodeVersion
-> ConnectionId addrNTN
-> Either
     (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
     (PeerTxAPI m (GenTxId blk) (GenTx blk)
      -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
hTxSubmissionServer = \NodeToNodeVersion
version ConnectionId addrNTN
peer ->
          case TxSubmissionLogicVersion
txSubmissionLogicVersion of
            TxSubmissionLogicVersion
TxSubmissionLogicV2 ->
              (PeerTxAPI m (GenTxId blk) (GenTx blk)
 -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
-> Either
     (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
     (PeerTxAPI m (GenTxId blk) (GenTx blk)
      -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
forall a b. b -> Either a b
Right ((PeerTxAPI m (GenTxId blk) (GenTx blk)
  -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
 -> Either
      (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
      (PeerTxAPI m (GenTxId blk) (GenTx blk)
       -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()))
-> (PeerTxAPI m (GenTxId blk) (GenTx blk)
    -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
-> Either
     (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
     (PeerTxAPI m (GenTxId blk) (GenTx blk)
      -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
forall a b. (a -> b) -> a -> b
$ \PeerTxAPI m (GenTxId blk) (GenTx blk)
api ->
                Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> TxSubmissionInitDelay
-> TxDecisionPolicy
-> TxSubmissionMempoolWriter
     (GenTxId blk) (GenTx blk) TicketNo m ()
-> (GenTx blk -> SizeInBytes)
-> PeerTxAPI m (GenTxId blk) (GenTx blk)
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
forall txid tx idx (m :: * -> *) err.
(MonadDelay m, MonadTimer m, MonadThrow m, Ord txid, Show txid,
 Typeable txid) =>
Tracer m (TraceTxSubmissionInbound txid tx)
-> TxSubmissionInitDelay
-> TxDecisionPolicy
-> TxSubmissionMempoolWriter txid tx idx m err
-> (tx -> SizeInBytes)
-> PeerTxAPI m txid tx
-> TxSubmissionServerPipelined txid tx m ()
txSubmissionInboundV2
                  ( (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap
                      (ConnectionId addrNTN
-> TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer)
                      (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
Node.txInboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers)
                  )
                  TxSubmissionInitDelay
txSubmissionInitDelay
                  (MiniProtocolParameters -> TxDecisionPolicy
txDecisionPolicy MiniProtocolParameters
miniProtocolParameters)
                  (Mempool m blk
-> TxSubmissionMempoolWriter
     (GenTxId blk) (GenTx blk) TicketNo m ()
forall blk (m :: * -> *).
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolWriter
     (GenTxId blk) (GenTx blk) TicketNo m ()
getMempoolWriter Mempool m blk
getMempool)
                  GenTx blk -> SizeInBytes
forall blk. TxLimits blk => GenTx blk -> SizeInBytes
txWireSize
                  PeerTxAPI m (GenTxId blk) (GenTx blk)
api
            TxSubmissionLogicVersion
TxSubmissionLogicV1 ->
              TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
-> Either
     (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
     (PeerTxAPI m (GenTxId blk) (GenTx blk)
      -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
forall a b. a -> Either a b
Left (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
 -> Either
      (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
      (PeerTxAPI m (GenTxId blk) (GenTx blk)
       -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()))
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
-> Either
     (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
     (PeerTxAPI m (GenTxId blk) (GenTx blk)
      -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
forall a b. (a -> b) -> a -> b
$
                Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
-> TxSubmissionInitDelay
-> NumTxIdsToAck
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
-> TxSubmissionMempoolWriter
     (GenTxId blk) (GenTx blk) TicketNo m ()
-> NodeToNodeVersion
-> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ()
forall txid tx idx (m :: * -> *) err version.
(Ord txid, NoThunks txid, NoThunks tx, MonadSTM m, MonadThrow m,
 MonadDelay m) =>
Tracer m (TraceTxSubmissionInbound txid tx)
-> TxSubmissionInitDelay
-> NumTxIdsToAck
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolWriter txid tx idx m err
-> version
-> TxSubmissionServerPipelined txid tx m ()
txSubmissionInbound
                  ((TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
-> Tracer m (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TraceTxSubmissionInbound (GenTxId blk) (GenTx blk)))
Node.txInboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
                  TxSubmissionInitDelay
txSubmissionInitDelay
                  ( Word16 -> NumTxIdsToAck
NumTxIdsToAck (Word16 -> NumTxIdsToAck) -> Word16 -> NumTxIdsToAck
forall a b. (a -> b) -> a -> b
$
                      NumTxIdsToReq -> Word16
getNumTxIdsToReq (NumTxIdsToReq -> Word16) -> NumTxIdsToReq -> Word16
forall a b. (a -> b) -> a -> b
$
                        TxDecisionPolicy -> NumTxIdsToReq
maxUnacknowledgedTxIds (TxDecisionPolicy -> NumTxIdsToReq)
-> TxDecisionPolicy -> NumTxIdsToReq
forall a b. (a -> b) -> a -> b
$
                          MiniProtocolParameters -> TxDecisionPolicy
txDecisionPolicy (MiniProtocolParameters -> TxDecisionPolicy)
-> MiniProtocolParameters -> TxDecisionPolicy
forall a b. (a -> b) -> a -> b
$
                            MiniProtocolParameters
miniProtocolParameters
                  )
                  ((Validated (GenTx blk) -> GenTx blk)
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
forall (m :: * -> *) tx tx' txid idx.
MonadSTM m =>
(tx -> tx')
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolReader txid tx' idx m
mapTxSubmissionMempoolReader Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (TxSubmissionMempoolReader
   (GenTxId blk) (Validated (GenTx blk)) TicketNo m
 -> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m)
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader (GenTxId blk) (GenTx blk) TicketNo m
forall a b. (a -> b) -> a -> b
$ Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader Mempool m blk
getMempool)
                  (Mempool m blk
-> TxSubmissionMempoolWriter
     (GenTxId blk) (GenTx blk) TicketNo m ()
forall blk (m :: * -> *).
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolWriter
     (GenTxId blk) (GenTx blk) TicketNo m ()
getMempoolWriter Mempool m blk
getMempool)
                  NodeToNodeVersion
version
      , hPerasCertDiffusionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PerasCertDiffusionInboundPipelined blk m ()
hPerasCertDiffusionClient = \NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
peer ->
          Tracer m (TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk))
-> (NumObjectsUnacknowledged, NumObjectIdsReq, NumObjectsReq)
-> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> PerasCertDiffusionInboundPipelined blk m ()
forall objectId object (m :: * -> *).
(Ord objectId, Show objectId, Typeable objectId, Typeable object,
 NoThunks objectId, NoThunks object, MonadSTM m, MonadThrow m) =>
Tracer m (TraceObjectDiffusionInbound objectId object)
-> (NumObjectsUnacknowledged, NumObjectIdsReq, NumObjectsReq)
-> ObjectPoolWriter objectId object m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ObjectDiffusionInboundPipelined objectId object m ()
objectDiffusionInbound
            ((TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk)))
-> Tracer
     m (TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TracePerasCertDiffusionInbound blk))
Node.perasCertDiffusionInboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            ( MiniProtocolParameters -> NumObjectsUnacknowledged
perasCertDiffusionMaxObjectsUnacknowledged MiniProtocolParameters
miniProtocolParameters
            , NumObjectIdsReq
10 -- TODO: see https://github.com/tweag/cardano-peras/issues/97
            , NumObjectsReq
10 -- TODO: see https://github.com/tweag/cardano-peras/issues/97
            )
            (SystemTime m
-> ChainDB m blk -> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
forall (m :: * -> *) blk.
(IOLike m, BlockSupportsPeras blk) =>
SystemTime m
-> ChainDB m blk -> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
makePerasCertPoolWriterFromChainDB SystemTime m
systemTime ChainDB m blk
getChainDB)
            NodeToNodeVersion
version
            ControlMessageSTM m
controlMessageSTM
      , hPerasCertDiffusionServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PerasCertDiffusionOutbound blk m ()
hPerasCertDiffusionServer = \NodeToNodeVersion
version ConnectionId addrNTN
peer ->
          Tracer
  m (TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk))
-> NumObjectsUnacknowledged
-> ObjectPoolReader
     PerasRoundNo (PerasCert blk) PerasCertTicketNo m
-> NodeToNodeVersion
-> PerasCertDiffusionOutbound blk m ()
forall objectId object ticketNo (m :: * -> *).
(Ord objectId, MonadSTM m, MonadThrow m) =>
Tracer m (TraceObjectDiffusionOutbound objectId object)
-> NumObjectsUnacknowledged
-> ObjectPoolReader objectId object ticketNo m
-> NodeToNodeVersion
-> ObjectDiffusionOutbound objectId object m ()
objectDiffusionOutbound
            ((TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk)))
-> Tracer
     m (TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TracePerasCertDiffusionOutbound blk))
Node.perasCertDiffusionOutboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            (MiniProtocolParameters -> NumObjectsUnacknowledged
perasCertDiffusionMaxObjectsUnacknowledged MiniProtocolParameters
miniProtocolParameters)
            (ChainDB m blk
-> ObjectPoolReader
     PerasRoundNo (PerasCert blk) PerasCertTicketNo m
forall (m :: * -> *) blk.
(IOLike m, IsPerasCert (PerasCert blk) blk) =>
ChainDB m blk
-> ObjectPoolReader
     PerasRoundNo (PerasCert blk) PerasCertTicketNo m
makePerasCertPoolReaderFromChainDB (ChainDB m blk
 -> ObjectPoolReader
      PerasRoundNo (PerasCert blk) PerasCertTicketNo m)
-> ChainDB m blk
-> ObjectPoolReader
     PerasRoundNo (PerasCert blk) PerasCertTicketNo m
forall a b. (a -> b) -> a -> b
$ ChainDB m blk
getChainDB)
            NodeToNodeVersion
version
      , hPerasVoteDiffusionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PerasVoteDiffusionInboundPipelined blk m ()
hPerasVoteDiffusionClient = \NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
peer ->
          Tracer m (TraceObjectDiffusionInbound PerasVoteId (PerasVote blk))
-> (NumObjectsUnacknowledged, NumObjectIdsReq, NumObjectsReq)
-> ObjectPoolWriter PerasVoteId (PerasVote blk) m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> PerasVoteDiffusionInboundPipelined blk m ()
forall objectId object (m :: * -> *).
(Ord objectId, Show objectId, Typeable objectId, Typeable object,
 NoThunks objectId, NoThunks object, MonadSTM m, MonadThrow m) =>
Tracer m (TraceObjectDiffusionInbound objectId object)
-> (NumObjectsUnacknowledged, NumObjectIdsReq, NumObjectsReq)
-> ObjectPoolWriter objectId object m
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ObjectDiffusionInboundPipelined objectId object m ()
objectDiffusionInbound
            ((TraceObjectDiffusionInbound PerasVoteId (PerasVote blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceObjectDiffusionInbound PerasVoteId (PerasVote blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceObjectDiffusionInbound PerasVoteId (PerasVote blk)))
-> Tracer
     m (TraceObjectDiffusionInbound PerasVoteId (PerasVote blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceObjectDiffusionInbound PerasVoteId (PerasVote blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceObjectDiffusionInbound PerasVoteId (PerasVote blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceObjectDiffusionInbound PerasVoteId (PerasVote blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TracePerasVoteDiffusionInbound blk))
Node.perasVoteDiffusionInboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            ( MiniProtocolParameters -> NumObjectsUnacknowledged
perasVoteDiffusionMaxObjectsUnacknowledged MiniProtocolParameters
miniProtocolParameters
            , NumObjectIdsReq
50 -- TODO: see https://github.com/tweag/cardano-peras/issues/97
            , NumObjectsReq
50 -- TODO: see https://github.com/tweag/cardano-peras/issues/97
            )
            (SystemTime m
-> ChainDB m blk -> ObjectPoolWriter PerasVoteId (PerasVote blk) m
forall (m :: * -> *) blk.
(IOLike m, BlockSupportsPeras blk) =>
SystemTime m
-> ChainDB m blk -> ObjectPoolWriter PerasVoteId (PerasVote blk) m
makePerasVotePoolWriterFromChainDB SystemTime m
systemTime ChainDB m blk
getChainDB)
            NodeToNodeVersion
version
            ControlMessageSTM m
controlMessageSTM
      , hPerasVoteDiffusionServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PerasVoteDiffusionOutbound blk m ()
hPerasVoteDiffusionServer = \NodeToNodeVersion
version ConnectionId addrNTN
peer ->
          Tracer m (TraceObjectDiffusionOutbound PerasVoteId (PerasVote blk))
-> NumObjectsUnacknowledged
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
-> NodeToNodeVersion
-> PerasVoteDiffusionOutbound blk m ()
forall objectId object ticketNo (m :: * -> *).
(Ord objectId, MonadSTM m, MonadThrow m) =>
Tracer m (TraceObjectDiffusionOutbound objectId object)
-> NumObjectsUnacknowledged
-> ObjectPoolReader objectId object ticketNo m
-> NodeToNodeVersion
-> ObjectDiffusionOutbound objectId object m ()
objectDiffusionOutbound
            ((TraceObjectDiffusionOutbound PerasVoteId (PerasVote blk)
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceObjectDiffusionOutbound PerasVoteId (PerasVote blk)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceObjectDiffusionOutbound PerasVoteId (PerasVote blk)))
-> Tracer
     m (TraceObjectDiffusionOutbound PerasVoteId (PerasVote blk))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceObjectDiffusionOutbound PerasVoteId (PerasVote blk)
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceObjectDiffusionOutbound PerasVoteId (PerasVote blk))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
peer) (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceObjectDiffusionOutbound PerasVoteId (PerasVote blk)))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer
        remotePeer (TracePerasVoteDiffusionOutbound blk))
Node.perasVoteDiffusionOutboundTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers))
            (MiniProtocolParameters -> NumObjectsUnacknowledged
perasVoteDiffusionMaxObjectsUnacknowledged MiniProtocolParameters
miniProtocolParameters)
            (ChainDB m blk
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
forall (m :: * -> *) blk.
(IOLike m, IsPerasVote (PerasVote blk) blk) =>
ChainDB m blk
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
makePerasVotePoolReaderFromChainDB (ChainDB m blk
 -> ObjectPoolReader
      PerasVoteId (PerasVote blk) PerasVoteTicketNo m)
-> ChainDB m blk
-> ObjectPoolReader PerasVoteId (PerasVote blk) PerasVoteTicketNo m
forall a b. (a -> b) -> a -> b
$ ChainDB m blk
getChainDB)
            NodeToNodeVersion
version
      , hKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient = \NodeToNodeVersion
_version -> Tracer m (TraceKeepAliveClient (ConnectionId addrNTN))
-> StdGen
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
forall (m :: * -> *) peer.
(MonadTimer m, Ord peer) =>
Tracer m (TraceKeepAliveClient peer)
-> StdGen
-> ControlMessageSTM m
-> peer
-> StrictTVar m (Map peer PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
keepAliveClient (Tracers m (ConnectionId addrNTN) addrNTC blk
-> Tracer m (TraceKeepAliveClient (ConnectionId addrNTN))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceKeepAliveClient remotePeer)
Node.keepAliveClientTracer Tracers m (ConnectionId addrNTN) addrNTC blk
tracers) StdGen
keepAliveRng
      , hKeepAliveServer :: NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
hKeepAliveServer = \NodeToNodeVersion
_version ConnectionId addrNTN
_peer -> KeepAliveServer m ()
forall (m :: * -> *). Applicative m => KeepAliveServer m ()
keepAliveServer
      , hPeerSharingClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingClient = \NodeToNodeVersion
_version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
_peer -> ControlMessageSTM m
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
forall (m :: * -> *) peer.
(Alternative (STM m), MonadMVar m, MonadSTM m, MonadThrow m) =>
ControlMessageSTM m
-> PeerSharingController peer m -> m (PeerSharingClient peer m ())
peerSharingClient ControlMessageSTM m
controlMessageSTM
      , hPeerSharingServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
hPeerSharingServer = \NodeToNodeVersion
_version ConnectionId addrNTN
_peer -> PeerSharingAPI addrNTN StdGen m -> PeerSharingServer addrNTN m
forall (m :: * -> *) peer s.
(MonadSTM m, MonadMonotonicTime m, Hashable peer, RandomGen s) =>
PeerSharingAPI peer s m -> PeerSharingServer peer m
peerSharingServer PeerSharingAPI addrNTN StdGen m
getPeerSharingAPI
      , hLeiosNotifyClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (LeiosNotifyPeerState blk)
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
hLeiosNotifyClient = \NodeToNodeVersion
_version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
_peer ->
          TopLevelConfig blk
-> ChainDB m blk
-> BlockchainTime m
-> SystemTime m
-> SomeHeaderInFutureCheck m blk
-> ClockSkew
-> ControlMessageSTM m
-> StrictTVar m (LeiosNotifyPeerState blk)
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk,
 LeiosProtocol (BlockProtocol blk), ConvertRawHash blk,
 HasHardForkHistory blk) =>
TopLevelConfig blk
-> ChainDB m blk
-> BlockchainTime m
-> SystemTime m
-> SomeHeaderInFutureCheck m blk
-> ClockSkew
-> ControlMessageSTM m
-> StrictTVar m (LeiosNotifyPeerState blk)
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
leiosNotifyClient
            TopLevelConfig blk
getTopLevelConfig
            ChainDB m blk
getChainDB
            BlockchainTime m
getBlockchainTime
            SystemTime m
systemTime
            SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
            ClockSkew
maxClockSkew
            ControlMessageSTM m
controlMessageSTM
      , hLeiosNotifyServer :: NodeToNodeVersion
-> ConnectionId addrNTN
-> m (LeiosNotifyServerPeerLookahead
        LeiosPoint (Header blk) LeiosVote m)
hLeiosNotifyServer = \NodeToNodeVersion
_version ConnectionId addrNTN
_peer -> m (LeiosNotifyServerPeerLookahead
     LeiosPoint (Header blk) LeiosVote m)
forall (m :: * -> *) blk.
IOLike m =>
m (LeiosNotifyServerPeerLookahead
     LeiosPoint (Header blk) LeiosVote m)
leiosNotifyServer
      }

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

-- | Node-to-node protocol codecs needed to run 'Handlers'.
data Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN = Codecs
  { forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec :: Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
cChainSyncCodecSerialised ::
      Codec (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (BlockFetch blk (Point blk)) e m bBF
cBlockFetchCodec :: Codec (BlockFetch blk (Point blk)) e m bBF
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
cBlockFetchCodecSerialised ::
      Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec :: Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PerasCertDiffusion blk) e m bPCD
cPerasCertDiffusionCodec :: Codec (PerasCertDiffusion blk) e m bPCD
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PerasVoteDiffusion blk) e m bPVD
cPerasVoteDiffusionCodec :: Codec (PerasVoteDiffusion blk) e m bPVD
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec KeepAlive e m bKA
cKeepAliveCodec :: Codec KeepAlive e m bKA
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PeerSharing addr) e m bPS
cPeerSharingCodec :: Codec (PeerSharing addr) e m bPS
  , forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (LeiosNotify LeiosPoint (Header blk) LeiosVote) e m bLN
cLeiosNotifyCodec :: Codec (LeiosNotify LeiosPoint (Header blk) LeiosVote) e m bLN
  }

-- | Protocol codecs for the node-to-node protocols
defaultCodecs ::
  forall m blk addr.
  ( IOLike m
  , SerialiseNodeToNodeConstraints blk
  ) =>
  CodecConfig blk ->
  BlockNodeToNodeVersion blk ->
  (NodeToNodeVersion -> addr -> CBOR.Encoding) ->
  (NodeToNodeVersion -> forall s. CBOR.Decoder s addr) ->
  NodeToNodeVersion ->
  Codecs
    blk
    addr
    DeserialiseFailure
    m
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
defaultCodecs :: forall (m :: * -> *) blk addr.
(IOLike m, SerialiseNodeToNodeConstraints blk) =>
CodecConfig blk
-> BlockNodeToNodeVersion blk
-> (NodeToNodeVersion -> addr -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addr)
-> NodeToNodeVersion
-> Codecs
     blk
     addr
     DeserialiseFailure
     m
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
defaultCodecs CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version NodeToNodeVersion -> addr -> Encoding
encAddr NodeToNodeVersion -> forall s. Decoder s addr
decAddr NodeToNodeVersion
nodeToNodeVersion =
  Codecs
    { cChainSyncCodec :: Codec
  (ChainSync (Header blk) (Point blk) (Tip blk))
  DeserialiseFailure
  m
  ByteString
cChainSyncCodec =
        (Header blk -> Encoding)
-> (forall s. Decoder s (Header blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
     (ChainSync (Header 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
          Header blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Header blk)
forall s. Decoder s (Header blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          Point blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Point blk)
forall s. Decoder s (Point blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          Tip blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Tip blk)
forall s. Decoder s (Tip blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
    , cChainSyncCodecSerialised :: Codec
  (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
  DeserialiseFailure
  m
  ByteString
cChainSyncCodecSerialised =
        (SerialisedHeader blk -> Encoding)
-> (forall s. Decoder s (SerialisedHeader blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> (Tip blk -> Encoding)
-> (forall s. Decoder s (Tip blk))
-> Codec
     (ChainSync (SerialisedHeader 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
          SerialisedHeader blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (SerialisedHeader blk)
forall s. Decoder s (SerialisedHeader blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          Point blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Point blk)
forall s. Decoder s (Point blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          Tip blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Tip blk)
forall s. Decoder s (Tip blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
    , cBlockFetchCodec :: Codec (BlockFetch blk (Point blk)) DeserialiseFailure m ByteString
cBlockFetchCodec =
        (blk -> Encoding)
-> (forall s. Decoder s blk)
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> Codec
     (BlockFetch blk (Point blk)) DeserialiseFailure m ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch
          blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s blk
forall s. Decoder s blk
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          Point blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Point blk)
forall s. Decoder s (Point blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
    , cBlockFetchCodecSerialised :: Codec
  (BlockFetch (Serialised blk) (Point blk))
  DeserialiseFailure
  m
  ByteString
cBlockFetchCodecSerialised =
        (Serialised blk -> Encoding)
-> (forall s. Decoder s (Serialised blk))
-> (Point blk -> Encoding)
-> (forall s. Decoder s (Point blk))
-> Codec
     (BlockFetch (Serialised blk) (Point blk))
     DeserialiseFailure
     m
     ByteString
forall block point (m :: * -> *).
MonadST m =>
(block -> Encoding)
-> (forall s. Decoder s block)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> Codec (BlockFetch block point) DeserialiseFailure m ByteString
codecBlockFetch
          Serialised blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Serialised blk)
forall s. Decoder s (Serialised blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          Point blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Point blk)
forall s. Decoder s (Point blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
    , cTxSubmission2Codec :: Codec
  (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
  DeserialiseFailure
  m
  ByteString
cTxSubmission2Codec =
        (TxId (GenTx blk) -> Encoding)
-> (forall s. Decoder s (TxId (GenTx blk)))
-> (GenTx blk -> Encoding)
-> (forall s. Decoder s (GenTx blk))
-> Codec
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     DeserialiseFailure
     m
     ByteString
forall txid tx (m :: * -> *).
MonadST m =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> Codec (TxSubmission2 txid tx) DeserialiseFailure m ByteString
codecTxSubmission2
          TxId (GenTx blk) -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (TxId (GenTx blk))
forall s. Decoder s (TxId (GenTx blk))
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          GenTx blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (GenTx blk)
forall s. Decoder s (GenTx blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
    , cPerasCertDiffusionCodec :: Codec (PerasCertDiffusion blk) DeserialiseFailure m ByteString
cPerasCertDiffusionCodec =
        (PerasRoundNo -> Encoding)
-> (forall s. Decoder s PerasRoundNo)
-> (PerasCert blk -> Encoding)
-> (forall s. Decoder s (PerasCert blk))
-> Codec (PerasCertDiffusion blk) DeserialiseFailure m ByteString
forall objectId object (m :: * -> *).
MonadST m =>
(objectId -> Encoding)
-> (forall s. Decoder s objectId)
-> (object -> Encoding)
-> (forall s. Decoder s object)
-> Codec
     (ObjectDiffusion objectId object) DeserialiseFailure m ByteString
codecObjectDiffusion
          PerasRoundNo -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s PerasRoundNo
forall s. Decoder s PerasRoundNo
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          PerasCert blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (PerasCert blk)
forall s. Decoder s (PerasCert blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
    , cPerasVoteDiffusionCodec :: Codec (PerasVoteDiffusion blk) DeserialiseFailure m ByteString
cPerasVoteDiffusionCodec =
        (PerasVoteId -> Encoding)
-> (forall s. Decoder s PerasVoteId)
-> (PerasVote blk -> Encoding)
-> (forall s. Decoder s (PerasVote blk))
-> Codec (PerasVoteDiffusion blk) DeserialiseFailure m ByteString
forall objectId object (m :: * -> *).
MonadST m =>
(objectId -> Encoding)
-> (forall s. Decoder s objectId)
-> (object -> Encoding)
-> (forall s. Decoder s object)
-> Codec
     (ObjectDiffusion objectId object) DeserialiseFailure m ByteString
codecObjectDiffusion
          PerasVoteId -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s PerasVoteId
forall s. Decoder s PerasVoteId
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          PerasVote blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (PerasVote blk)
forall s. Decoder s (PerasVote blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
    , cKeepAliveCodec :: Codec KeepAlive DeserialiseFailure m ByteString
cKeepAliveCodec = Codec KeepAlive DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec KeepAlive DeserialiseFailure m ByteString
codecKeepAlive_v2
    , cPeerSharingCodec :: Codec (PeerSharing addr) DeserialiseFailure m ByteString
cPeerSharingCodec = (addr -> Encoding)
-> (forall s. Decoder s addr)
-> Codec (PeerSharing addr) DeserialiseFailure m ByteString
forall (m :: * -> *) peerAddress.
MonadST m =>
(peerAddress -> Encoding)
-> (forall s. Decoder s peerAddress)
-> Codec (PeerSharing peerAddress) DeserialiseFailure m ByteString
codecPeerSharing (NodeToNodeVersion -> addr -> Encoding
encAddr NodeToNodeVersion
nodeToNodeVersion) (NodeToNodeVersion -> forall s. Decoder s addr
decAddr NodeToNodeVersion
nodeToNodeVersion)
    , cLeiosNotifyCodec :: Codec
  (LeiosNotify LeiosPoint (Header blk) LeiosVote)
  DeserialiseFailure
  m
  ByteString
cLeiosNotifyCodec =
        (LeiosPoint -> Encoding)
-> (forall s. Decoder s LeiosPoint)
-> (Header blk -> Encoding)
-> (forall s. Decoder s (Header blk))
-> (LeiosVote -> Encoding)
-> (forall s. Decoder s LeiosVote)
-> Codec
     (LeiosNotify LeiosPoint (Header blk) LeiosVote)
     DeserialiseFailure
     m
     ByteString
forall point announcement vote (m :: * -> *).
MonadST m =>
(point -> Encoding)
-> (forall s. Decoder s point)
-> (announcement -> Encoding)
-> (forall s. Decoder s announcement)
-> (vote -> Encoding)
-> (forall s. Decoder s vote)
-> Codec
     (LeiosNotify point announcement vote)
     DeserialiseFailure
     m
     ByteString
codecLeiosNotify
          LeiosPoint -> Encoding
encodeLeiosPoint
          Decoder s LeiosPoint
forall s. Decoder s LeiosPoint
decodeLeiosPoint
          Header blk -> Encoding
forall a. SerialiseNodeToNode blk a => a -> Encoding
enc
          Decoder s (Header blk)
forall s. Decoder s (Header blk)
forall a s. SerialiseNodeToNode blk a => Decoder s a
dec
          LeiosVote -> Encoding
encodeLeiosVote
          Decoder s LeiosVote
forall s. Decoder s LeiosVote
decodeLeiosVote
    }
 where
  enc :: SerialiseNodeToNode blk a => a -> Encoding
  enc :: forall a. SerialiseNodeToNode blk a => a -> Encoding
enc = CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version

  dec :: SerialiseNodeToNode blk a => forall s. Decoder s a
  dec :: forall a s. SerialiseNodeToNode blk a => Decoder s a
dec = CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version

-- | Identity codecs used in tests.
identityCodecs ::
  Monad m =>
  Codecs
    blk
    addr
    CodecFailure
    m
    (AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
    (AnyMessage (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
    (AnyMessage (BlockFetch blk (Point blk)))
    (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
    (AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
    (AnyMessage (PerasCertDiffusion blk))
    (AnyMessage (PerasVoteDiffusion blk))
    (AnyMessage KeepAlive)
    (AnyMessage (PeerSharing addr))
    (AnyMessage (LeiosNotify LeiosPoint (Header blk) LeiosVote))
identityCodecs :: forall (m :: * -> *) blk addr.
Monad m =>
Codecs
  blk
  addr
  CodecFailure
  m
  (AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
  (AnyMessage
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
  (AnyMessage (BlockFetch blk (Point blk)))
  (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
  (AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
  (AnyMessage (PerasCertDiffusion blk))
  (AnyMessage (PerasVoteDiffusion blk))
  (AnyMessage KeepAlive)
  (AnyMessage (PeerSharing addr))
  (AnyMessage (LeiosNotify LeiosPoint (Header blk) LeiosVote))
identityCodecs =
  Codecs
    { cChainSyncCodec :: Codec
  (ChainSync (Header blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
cChainSyncCodec = Codec
  (ChainSync (Header blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage (ChainSync (Header blk) (Point blk) (Tip blk)))
forall header point tip (m :: * -> *).
Monad m =>
Codec
  (ChainSync header point tip)
  CodecFailure
  m
  (AnyMessage (ChainSync header point tip))
codecChainSyncId
    , cChainSyncCodecSerialised :: Codec
  (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
cChainSyncCodecSerialised = Codec
  (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
  CodecFailure
  m
  (AnyMessage
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall header point tip (m :: * -> *).
Monad m =>
Codec
  (ChainSync header point tip)
  CodecFailure
  m
  (AnyMessage (ChainSync header point tip))
codecChainSyncId
    , cBlockFetchCodec :: Codec
  (BlockFetch blk (Point blk))
  CodecFailure
  m
  (AnyMessage (BlockFetch blk (Point blk)))
cBlockFetchCodec = Codec
  (BlockFetch blk (Point blk))
  CodecFailure
  m
  (AnyMessage (BlockFetch blk (Point blk)))
forall block point (m :: * -> *).
Monad m =>
Codec
  (BlockFetch block point)
  CodecFailure
  m
  (AnyMessage (BlockFetch block point))
codecBlockFetchId
    , cBlockFetchCodecSerialised :: Codec
  (BlockFetch (Serialised blk) (Point blk))
  CodecFailure
  m
  (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
cBlockFetchCodecSerialised = Codec
  (BlockFetch (Serialised blk) (Point blk))
  CodecFailure
  m
  (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
forall block point (m :: * -> *).
Monad m =>
Codec
  (BlockFetch block point)
  CodecFailure
  m
  (AnyMessage (BlockFetch block point))
codecBlockFetchId
    , cTxSubmission2Codec :: Codec
  (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
  CodecFailure
  m
  (AnyMessage (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
cTxSubmission2Codec = Codec
  (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
  CodecFailure
  m
  (AnyMessage (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall txid tx (m :: * -> *).
Monad m =>
Codec
  (TxSubmission2 txid tx)
  CodecFailure
  m
  (AnyMessage (TxSubmission2 txid tx))
codecTxSubmission2Id
    , cPerasCertDiffusionCodec :: Codec
  (ObjectDiffusion PerasRoundNo (PerasCert blk))
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion PerasRoundNo (PerasCert blk)))
cPerasCertDiffusionCodec = Codec
  (ObjectDiffusion PerasRoundNo (PerasCert blk))
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion PerasRoundNo (PerasCert blk)))
forall objectId object (m :: * -> *).
Monad m =>
Codec
  (ObjectDiffusion objectId object)
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion objectId object))
codecObjectDiffusionId
    , cPerasVoteDiffusionCodec :: Codec
  (ObjectDiffusion PerasVoteId (PerasVote blk))
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion PerasVoteId (PerasVote blk)))
cPerasVoteDiffusionCodec = Codec
  (ObjectDiffusion PerasVoteId (PerasVote blk))
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion PerasVoteId (PerasVote blk)))
forall objectId object (m :: * -> *).
Monad m =>
Codec
  (ObjectDiffusion objectId object)
  CodecFailure
  m
  (AnyMessage (ObjectDiffusion objectId object))
codecObjectDiffusionId
    , cKeepAliveCodec :: Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
cKeepAliveCodec = Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
forall (m :: * -> *).
Monad m =>
Codec KeepAlive CodecFailure m (AnyMessage KeepAlive)
codecKeepAliveId
    , cPeerSharingCodec :: Codec
  (PeerSharing addr) CodecFailure m (AnyMessage (PeerSharing addr))
cPeerSharingCodec = Codec
  (PeerSharing addr) CodecFailure m (AnyMessage (PeerSharing addr))
forall peerAddress (m :: * -> *).
Monad m =>
Codec
  (PeerSharing peerAddress)
  CodecFailure
  m
  (AnyMessage (PeerSharing peerAddress))
codecPeerSharingId
    , cLeiosNotifyCodec :: Codec
  (LeiosNotify LeiosPoint (Header blk) LeiosVote)
  CodecFailure
  m
  (AnyMessage (LeiosNotify LeiosPoint (Header blk) LeiosVote))
cLeiosNotifyCodec = Codec
  (LeiosNotify LeiosPoint (Header blk) LeiosVote)
  CodecFailure
  m
  (AnyMessage (LeiosNotify LeiosPoint (Header blk) LeiosVote))
forall point announcement vote (m :: * -> *).
Monad m =>
Codec
  (LeiosNotify point announcement vote)
  CodecFailure
  m
  (AnyMessage (LeiosNotify point announcement vote))
codecLeiosNotifyId
    }

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

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

data Tracers' peer ntnAddr blk e f = Tracers
  { forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer ::
      f (TraceLabelPeer peer (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
  , forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer ::
      f (TraceLabelPeer peer (TraceSendRecv (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
  , forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer :: f (TraceLabelPeer peer (TraceSendRecv (BlockFetch blk (Point blk))))
  , forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer ::
      f (TraceLabelPeer peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
  , forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer ::
      f (TraceLabelPeer peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
  , forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PerasCertDiffusion blk)))
tPerasCertDiffusionTracer :: f (TraceLabelPeer peer (TraceSendRecv (PerasCertDiffusion blk)))
  , forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PerasVoteDiffusion blk)))
tPerasVoteDiffusionTracer :: f (TraceLabelPeer peer (TraceSendRecv (PerasVoteDiffusion blk)))
  , forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tKeepAliveTracer :: f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
  , forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PeerSharing ntnAddr)))
tPeerSharingTracer :: f (TraceLabelPeer peer (TraceSendRecv (PeerSharing ntnAddr)))
  }

instance (forall a. Semigroup (f a)) => Semigroup (Tracers' peer ntnAddr blk e f) where
  Tracers' peer ntnAddr blk e f
l <> :: Tracers' peer ntnAddr blk e f
-> Tracers' peer ntnAddr blk e f -> Tracers' peer ntnAddr blk e f
<> Tracers' peer ntnAddr blk e f
r =
    Tracers
      { tChainSyncTracer :: f (TraceLabelPeer
     peer
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer
      , tChainSyncSerialisedTracer :: f (TraceLabelPeer
     peer
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv
            (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer
      , tBlockFetchTracer :: f (TraceLabelPeer
     peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer
         peer (TraceSendRecv (BlockFetch blk (Point blk)))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer
      , tBlockFetchSerialisedTracer :: f (TraceLabelPeer
     peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer
         peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer
      , tTxSubmission2Tracer :: f (TraceLabelPeer
     peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer
         peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer
      , tPerasCertDiffusionTracer :: f (TraceLabelPeer
     peer
     (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
tPerasCertDiffusionTracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))))
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PerasCertDiffusion blk)))
tPerasCertDiffusionTracer
      , tPerasVoteDiffusionTracer :: f (TraceLabelPeer
     peer (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
tPerasVoteDiffusionTracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer
         peer
         (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))))
-> f (TraceLabelPeer
        peer (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PerasVoteDiffusion blk)))
tPerasVoteDiffusionTracer
      , tKeepAliveTracer :: f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tKeepAliveTracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer peer (TraceSendRecv KeepAlive)))
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tKeepAliveTracer
      , tPeerSharingTracer :: f (TraceLabelPeer peer (TraceSendRecv (PeerSharing ntnAddr)))
tPeerSharingTracer = (Tracers' peer ntnAddr blk e f
 -> f (TraceLabelPeer peer (TraceSendRecv (PeerSharing ntnAddr))))
-> f (TraceLabelPeer peer (TraceSendRecv (PeerSharing ntnAddr)))
forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PeerSharing ntnAddr)))
forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PeerSharing ntnAddr)))
tPeerSharingTracer
      }
   where
    f ::
      forall a.
      Semigroup a =>
      (Tracers' peer ntnAddr blk e f -> a) ->
      a
    f :: forall a. Semigroup a => (Tracers' peer ntnAddr blk e f -> a) -> a
f Tracers' peer ntnAddr blk e f -> a
prj = Tracers' peer ntnAddr blk e f -> a
prj Tracers' peer ntnAddr blk e f
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Tracers' peer ntnAddr blk e f -> a
prj Tracers' peer ntnAddr blk e f
r

-- | Use a 'nullTracer' for each protocol.
nullTracers :: Monad m => Tracers m ntnAddr blk e
nullTracers :: forall (m :: * -> *) ntnAddr blk e.
Monad m =>
Tracers m ntnAddr blk e
nullTracers =
  Tracers
    { tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer = Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    , tChainSyncSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer = Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    , tBlockFetchTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer = Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (BlockFetch blk (Point blk))))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    , tBlockFetchSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    , tTxSubmission2Tracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer = Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    , tPerasCertDiffusionTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr) (TraceSendRecv (PerasCertDiffusion blk)))
tPerasCertDiffusionTracer = Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr) (TraceSendRecv (PerasCertDiffusion blk)))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    , tPerasVoteDiffusionTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr) (TraceSendRecv (PerasVoteDiffusion blk)))
tPerasVoteDiffusionTracer = Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr) (TraceSendRecv (PerasVoteDiffusion blk)))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    , tKeepAliveTracer :: Tracer
  m (TraceLabelPeer (ConnectionId ntnAddr) (TraceSendRecv KeepAlive))
tKeepAliveTracer = Tracer
  m (TraceLabelPeer (ConnectionId ntnAddr) (TraceSendRecv KeepAlive))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    , tPeerSharingTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr) (TraceSendRecv (PeerSharing ntnAddr)))
tPeerSharingTracer = Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr) (TraceSendRecv (PeerSharing ntnAddr)))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
    }

showTracers ::
  ( Monad m
  , Show blk
  , Show ntnAddr
  , Show (Header blk)
  , Show (GenTx blk)
  , Show (GenTxId blk)
  , Show (PerasVote blk)
  , Show (PerasCert blk)
  , HasHeader blk
  , HasNestedContent Header blk
  ) =>
  Tracer m String -> Tracers m ntnAddr blk e
showTracers :: forall (m :: * -> *) blk ntnAddr e.
(Monad m, Show blk, Show ntnAddr, Show (Header blk),
 Show (GenTx blk), Show (GenTxId blk), Show (PerasVote blk),
 Show (PerasCert blk), HasHeader blk,
 HasNestedContent Header blk) =>
Tracer m String -> Tracers m ntnAddr blk e
showTracers Tracer m String
tr =
  Tracers
    { tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer = TraceLabelPeer
  (ConnectionId ntnAddr)
  (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
-> String
forall a. Show a => a -> String
show (TraceLabelPeer
   (ConnectionId ntnAddr)
   (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
 -> String)
-> Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId ntnAddr)
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    , tChainSyncSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer = TraceLabelPeer
  (ConnectionId ntnAddr)
  (TraceSendRecv
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
-> String
forall a. Show a => a -> String
show (TraceLabelPeer
   (ConnectionId ntnAddr)
   (TraceSendRecv
      (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
 -> String)
-> Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId ntnAddr)
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    , tBlockFetchTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer = TraceLabelPeer
  (ConnectionId ntnAddr) (TraceSendRecv (BlockFetch blk (Point blk)))
-> String
forall a. Show a => a -> String
show (TraceLabelPeer
   (ConnectionId ntnAddr) (TraceSendRecv (BlockFetch blk (Point blk)))
 -> String)
-> Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId ntnAddr)
        (TraceSendRecv (BlockFetch blk (Point blk))))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    , tBlockFetchSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer = TraceLabelPeer
  (ConnectionId ntnAddr)
  (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
-> String
forall a. Show a => a -> String
show (TraceLabelPeer
   (ConnectionId ntnAddr)
   (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
 -> String)
-> Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId ntnAddr)
        (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    , tTxSubmission2Tracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tTxSubmission2Tracer = TraceLabelPeer
  (ConnectionId ntnAddr)
  (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))
-> String
forall a. Show a => a -> String
show (TraceLabelPeer
   (ConnectionId ntnAddr)
   (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk)))
 -> String)
-> Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId ntnAddr)
        (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    , tPerasCertDiffusionTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
tPerasCertDiffusionTracer = TraceLabelPeer
  (ConnectionId ntnAddr)
  (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))
-> String
forall a. Show a => a -> String
show (TraceLabelPeer
   (ConnectionId ntnAddr)
   (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))
 -> String)
-> Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId ntnAddr)
        (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    , tPerasVoteDiffusionTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr)
     (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
tPerasVoteDiffusionTracer = TraceLabelPeer
  (ConnectionId ntnAddr)
  (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))
-> String
forall a. Show a => a -> String
show (TraceLabelPeer
   (ConnectionId ntnAddr)
   (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))
 -> String)
-> Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId ntnAddr)
        (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    , tKeepAliveTracer :: Tracer
  m (TraceLabelPeer (ConnectionId ntnAddr) (TraceSendRecv KeepAlive))
tKeepAliveTracer = TraceLabelPeer (ConnectionId ntnAddr) (TraceSendRecv KeepAlive)
-> String
forall a. Show a => a -> String
show (TraceLabelPeer (ConnectionId ntnAddr) (TraceSendRecv KeepAlive)
 -> String)
-> Tracer m String
-> Tracer
     m (TraceLabelPeer (ConnectionId ntnAddr) (TraceSendRecv KeepAlive))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    , tPeerSharingTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId ntnAddr) (TraceSendRecv (PeerSharing ntnAddr)))
tPeerSharingTracer = TraceLabelPeer
  (ConnectionId ntnAddr) (TraceSendRecv (PeerSharing ntnAddr))
-> String
forall a. Show a => a -> String
show (TraceLabelPeer
   (ConnectionId ntnAddr) (TraceSendRecv (PeerSharing ntnAddr))
 -> String)
-> Tracer m String
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId ntnAddr) (TraceSendRecv (PeerSharing ntnAddr)))
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer m String
tr
    }

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

-- | A node-to-node application
type ClientApp m addr bytes a =
  NodeToNodeVersion ->
  ExpandedInitiatorContext addr PeerTrustable m ->
  Channel m bytes ->
  m (a, Maybe bytes)

type ServerApp m addr bytes a =
  NodeToNodeVersion ->
  ResponderContext addr ->
  Channel m bytes ->
  m (a, Maybe bytes)

-- | Applications for the node-to-node protocols
--
-- See 'Network.Mux.Types.MuxApplication'
data Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b = Apps
  { forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bCS a
aChainSyncClient :: ClientApp m addr bCS a
  -- ^ Start a chain sync client that communicates with the given upstream
  -- node.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bCS b
aChainSyncServer :: ServerApp m addr bCS b
  -- ^ Start a chain sync server.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bBF a
aBlockFetchClient :: ClientApp m addr bBF a
  -- ^ Start a block fetch client that communicates with the given
  -- upstream node.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bBF b
aBlockFetchServer :: ServerApp m addr bBF b
  -- ^ Start a block fetch server.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bTX a
aTxSubmission2Client :: ClientApp m addr bTX a
  -- ^ Start a transaction submission v2 client that communicates with the
  -- given upstream node.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bTX b
aTxSubmission2Server :: ServerApp m addr bTX b
  -- ^ Start a transaction submission v2 server.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPCD a
aPerasCertDiffusionClient :: ClientApp m addr bPCD a
  -- ^ Start a Peras cert diffusion client.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPCD b
aPerasCertDiffusionServer :: ServerApp m addr bPCD b
  -- ^ Start a Peras cert diffusion server.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPVD a
aPerasVoteDiffusionClient :: ClientApp m addr bPVD a
  -- ^ Start a Peras vote diffusion client.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPVD b
aPerasVoteDiffusionServer :: ServerApp m addr bPVD b
  -- ^ Start a Peras vote diffusion server.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bKA a
aKeepAliveClient :: ClientApp m addr bKA a
  -- ^ Start a keep-alive client.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bKA b
aKeepAliveServer :: ServerApp m addr bKA b
  -- ^ Start a keep-alive server.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPS a
aPeerSharingClient :: ClientApp m addr bPS a
  -- ^ Start a peer-sharing client.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPS b
aPeerSharingServer :: ServerApp m addr bPS b
  -- ^ Start a peer-sharing server.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bLN a
aLeiosNotifyClient :: ClientApp m addr bLN a
  -- ^ Start a LeiosNotify client.
  , forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bLN b
aLeiosNotifyServer :: ServerApp m addr bLN b
  -- ^ Start a LeiosNotify server.
  }

-- | Per mini-protocol byte limits;  For each mini-protocol they provide
-- per-state byte size limits, i.e. how much data can arrive from the network.
--
-- They don't depend on the instantiation of the protocol parameters (which
-- block type is used, etc.), hence the use of 'RankNTypes'.
data ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN = ByteLimits
  { forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall header point tip.
   ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync ::
      forall header point tip.
      ProtocolSizeLimits
        (ChainSync header point tip)
        bCS
  , forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall block point.
   ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch ::
      forall block point.
      ProtocolSizeLimits
        (BlockFetch block point)
        bBF
  , forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2 ::
      forall txid tx.
      ProtocolSizeLimits
        (TxSubmission2 txid tx)
        bTX
  , forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall blk. ProtocolSizeLimits (PerasCertDiffusion blk) bPCD
blPerasCertDiffusion ::
      forall blk.
      ProtocolSizeLimits
        (PerasCertDiffusion blk)
        bPCD
  , forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall blk. ProtocolSizeLimits (PerasVoteDiffusion blk) bPVD
blPerasVoteDiffusion ::
      forall blk.
      ProtocolSizeLimits
        (PerasVoteDiffusion blk)
        bPVD
  , forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> ProtocolSizeLimits KeepAlive bKA
blKeepAlive ::
      ProtocolSizeLimits
        KeepAlive
        bKA
  , forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall addr. ProtocolSizeLimits (PeerSharing addr) bPS
blPeerSharing ::
      forall addr.
      ProtocolSizeLimits
        (PeerSharing addr)
        bPS
  , forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall point announcement vote.
   ProtocolSizeLimits (LeiosNotify point announcement vote) bLN
blLeiosNotify ::
      forall point announcement vote.
      ProtocolSizeLimits
        (LeiosNotify point announcement vote)
        bLN
  }

noByteLimits :: ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
noByteLimits :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
noByteLimits =
  ByteLimits
    { blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync = (bCS -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bCS
forall bytes header point tip.
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync (Word -> bCS -> Word
forall a b. a -> b -> a
const Word
0)
    , blBlockFetch :: forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch = (bBF -> Word) -> ProtocolSizeLimits (BlockFetch block point) bBF
forall bytes block point.
(bytes -> Word)
-> ProtocolSizeLimits (BlockFetch block point) bytes
byteLimitsBlockFetch (Word -> bBF -> Word
forall a b. a -> b -> a
const Word
0)
    , blTxSubmission2 :: forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2 = (bTX -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bTX
forall bytes txid tx.
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 (Word -> bTX -> Word
forall a b. a -> b -> a
const Word
0)
    , blPerasCertDiffusion :: forall blk. ProtocolSizeLimits (PerasCertDiffusion blk) bPCD
blPerasCertDiffusion = (bPCD -> Word)
-> ProtocolSizeLimits
     (ObjectDiffusion PerasRoundNo (PerasCert blk)) bPCD
forall bytes objectId object.
(bytes -> Word)
-> ProtocolSizeLimits (ObjectDiffusion objectId object) bytes
byteLimitsObjectDiffusion (Word -> bPCD -> Word
forall a b. a -> b -> a
const Word
0)
    , blPerasVoteDiffusion :: forall blk. ProtocolSizeLimits (PerasVoteDiffusion blk) bPVD
blPerasVoteDiffusion = (bPVD -> Word)
-> ProtocolSizeLimits
     (ObjectDiffusion PerasVoteId (PerasVote blk)) bPVD
forall bytes objectId object.
(bytes -> Word)
-> ProtocolSizeLimits (ObjectDiffusion objectId object) bytes
byteLimitsObjectDiffusion (Word -> bPVD -> Word
forall a b. a -> b -> a
const Word
0)
    , blKeepAlive :: ProtocolSizeLimits KeepAlive bKA
blKeepAlive = (bKA -> Word) -> ProtocolSizeLimits KeepAlive bKA
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive (Word -> bKA -> Word
forall a b. a -> b -> a
const Word
0)
    , blPeerSharing :: forall addr. ProtocolSizeLimits (PeerSharing addr) bPS
blPeerSharing = (bPS -> Word) -> ProtocolSizeLimits (PeerSharing addr) bPS
forall peerAddress bytes.
(bytes -> Word)
-> ProtocolSizeLimits (PeerSharing peerAddress) bytes
byteLimitsPeerSharing (Word -> bPS -> Word
forall a b. a -> b -> a
const Word
0)
    , blLeiosNotify :: forall point announcement vote.
ProtocolSizeLimits (LeiosNotify point announcement vote) bLN
blLeiosNotify = (bLN -> Word)
-> ProtocolSizeLimits (LeiosNotify point announcement vote) bLN
forall bytes point announcement vote.
(bytes -> Word)
-> ProtocolSizeLimits (LeiosNotify point announcement vote) bytes
byteLimitsLeiosNotify (Word -> bLN -> Word
forall a b. a -> b -> a
const Word
0)
    }

byteLimits ::
  ByteLimits
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
    ByteString
byteLimits :: ByteLimits
  ByteString
  ByteString
  ByteString
  ByteString
  ByteString
  ByteString
  ByteString
  ByteString
byteLimits =
  ByteLimits
    { blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) ByteString
blChainSync = (ByteString -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) ByteString
forall bytes header point tip.
(bytes -> Word)
-> ProtocolSizeLimits (ChainSync header point tip) bytes
byteLimitsChainSync ByteString -> Word
size
    , blBlockFetch :: forall block point.
ProtocolSizeLimits (BlockFetch block point) ByteString
blBlockFetch = (ByteString -> Word)
-> ProtocolSizeLimits (BlockFetch block point) ByteString
forall bytes block point.
(bytes -> Word)
-> ProtocolSizeLimits (BlockFetch block point) bytes
byteLimitsBlockFetch ByteString -> Word
size
    , blTxSubmission2 :: forall txid tx.
ProtocolSizeLimits (TxSubmission2 txid tx) ByteString
blTxSubmission2 = (ByteString -> Word)
-> ProtocolSizeLimits (TxSubmission2 txid tx) ByteString
forall bytes txid tx.
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 ByteString -> Word
size
    , blPerasCertDiffusion :: forall blk. ProtocolSizeLimits (PerasCertDiffusion blk) ByteString
blPerasCertDiffusion = (ByteString -> Word)
-> ProtocolSizeLimits
     (ObjectDiffusion PerasRoundNo (PerasCert blk)) ByteString
forall bytes objectId object.
(bytes -> Word)
-> ProtocolSizeLimits (ObjectDiffusion objectId object) bytes
byteLimitsObjectDiffusion ByteString -> Word
size
    , blPerasVoteDiffusion :: forall blk. ProtocolSizeLimits (PerasVoteDiffusion blk) ByteString
blPerasVoteDiffusion = (ByteString -> Word)
-> ProtocolSizeLimits
     (ObjectDiffusion PerasVoteId (PerasVote blk)) ByteString
forall bytes objectId object.
(bytes -> Word)
-> ProtocolSizeLimits (ObjectDiffusion objectId object) bytes
byteLimitsObjectDiffusion ByteString -> Word
size
    , blKeepAlive :: ProtocolSizeLimits KeepAlive ByteString
blKeepAlive = (ByteString -> Word) -> ProtocolSizeLimits KeepAlive ByteString
forall bytes. (bytes -> Word) -> ProtocolSizeLimits KeepAlive bytes
byteLimitsKeepAlive ByteString -> Word
size
    , blPeerSharing :: forall addr. ProtocolSizeLimits (PeerSharing addr) ByteString
blPeerSharing = (ByteString -> Word)
-> ProtocolSizeLimits (PeerSharing addr) ByteString
forall peerAddress bytes.
(bytes -> Word)
-> ProtocolSizeLimits (PeerSharing peerAddress) bytes
byteLimitsPeerSharing ByteString -> Word
size
    , blLeiosNotify :: forall point announcement vote.
ProtocolSizeLimits (LeiosNotify point announcement vote) ByteString
blLeiosNotify = (ByteString -> Word)
-> ProtocolSizeLimits
     (LeiosNotify point announcement vote) ByteString
forall bytes point announcement vote.
(bytes -> Word)
-> ProtocolSizeLimits (LeiosNotify point announcement vote) bytes
byteLimitsLeiosNotify ByteString -> Word
size
    }
 where
  size :: ByteString -> Word
  size :: ByteString -> Word
size =
    (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Word)
      (Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length

-- | Construct the 'NetworkApplication' for the node-to-node protocols
mkApps ::
  forall m addrNTN addrNTC blk e bCS bBF bTX bPCD bPVD bKA bPS bLN.
  ( IOLike m
  , MonadTimer m
  , Ord addrNTN
  , Exception e
  , NFData e
  , LedgerSupportsProtocol blk
  , BlockSupportsPeras blk
  , ShowProxy blk
  , ShowProxy (Header blk)
  , ShowProxy (TxId (GenTx blk))
  , ShowProxy (GenTx blk)
  , ShowProxy (PerasVote blk)
  , ShowProxy (PerasCert blk)
  , Show addrNTN
  , LedgerSupportsMempool blk
  , HasTxId (GenTx blk)
  , HasRawTxId (GenTxId blk)
  ) =>
  -- | Needed for bracketing only
  NodeKernel m addrNTN addrNTC blk ->
  StdGen ->
  Tracers m addrNTN blk e ->
  (NodeToNodeVersion -> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN) ->
  ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN ->
  -- Chain-Sync timeouts for chain-sync client (using `Header blk`) as well as
  -- the server (`SerialisedHeader blk`).
  (forall header. PeerTrustable -> ProtocolTimeLimitsWithRnd (ChainSync header (Point blk) (Tip blk))) ->
  CsClient.ChainSyncLoPBucketConfig ->
  CsClient.CSJConfig ->
  ReportPeerMetrics m (ConnectionId addrNTN) ->
  Handlers m addrNTN blk ->
  Apps m addrNTN bCS bBF bTX bPCD bPVD bKA bPS bLN NodeToNodeInitiatorResult ()
mkApps :: forall (m :: * -> *) addrNTN addrNTC blk e bCS bBF bTX bPCD bPVD
       bKA bPS bLN.
(IOLike m, MonadTimer m, Ord addrNTN, Exception e, NFData e,
 LedgerSupportsProtocol blk, BlockSupportsPeras blk, ShowProxy blk,
 ShowProxy (Header blk), ShowProxy (TxId (GenTx blk)),
 ShowProxy (GenTx blk), ShowProxy (PerasVote blk),
 ShowProxy (PerasCert blk), Show addrNTN, LedgerSupportsMempool blk,
 HasTxId (GenTx blk), HasRawTxId (TxId (GenTx blk))) =>
NodeKernel m addrNTN addrNTC blk
-> StdGen
-> Tracers m addrNTN blk e
-> (NodeToNodeVersion
    -> Codecs
         blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN)
-> ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> (forall header.
    PeerTrustable
    -> ProtocolTimeLimitsWithRnd
         (ChainSync header (Point blk) (Tip blk)))
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> ReportPeerMetrics m (ConnectionId addrNTN)
-> Handlers m addrNTN blk
-> Apps
     m
     addrNTN
     bCS
     bBF
     bTX
     bPCD
     bPVD
     bKA
     bPS
     bLN
     NodeToNodeInitiatorResult
     ()
mkApps NodeKernel m addrNTN addrNTC blk
kernel StdGen
rng Tracers{Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch blk (Point blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN) (TraceSendRecv (PeerSharing addrNTN)))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
Tracer
  m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
tChainSyncTracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tBlockFetchTracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchSerialisedTracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tTxSubmission2Tracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer
        peer (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))
tPerasCertDiffusionTracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PerasCertDiffusion blk)))
tPerasVoteDiffusionTracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PerasVoteDiffusion blk)))
tKeepAliveTracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv KeepAlive))
tPeerSharingTracer :: forall peer ntnAddr blk e (f :: * -> *).
Tracers' peer ntnAddr blk e f
-> f (TraceLabelPeer peer (TraceSendRecv (PeerSharing ntnAddr)))
tChainSyncTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tBlockFetchTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchSerialisedTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tTxSubmission2Tracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tPerasCertDiffusionTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
tPerasVoteDiffusionTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
tKeepAliveTracer :: Tracer
  m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
tPeerSharingTracer :: Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN) (TraceSendRecv (PeerSharing addrNTN)))
..} NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs ByteLimits{ProtocolSizeLimits KeepAlive bKA
forall addr. ProtocolSizeLimits (PeerSharing addr) bPS
forall blk. ProtocolSizeLimits (PerasCertDiffusion blk) bPCD
forall blk. ProtocolSizeLimits (PerasVoteDiffusion blk) bPVD
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
forall point announcement vote.
ProtocolSizeLimits (LeiosNotify point announcement vote) bLN
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall header point tip.
   ProtocolSizeLimits (ChainSync header point tip) bCS
blBlockFetch :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall block point.
   ProtocolSizeLimits (BlockFetch block point) bBF
blTxSubmission2 :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blPerasCertDiffusion :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall blk. ProtocolSizeLimits (PerasCertDiffusion blk) bPCD
blPerasVoteDiffusion :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall blk. ProtocolSizeLimits (PerasVoteDiffusion blk) bPVD
blKeepAlive :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> ProtocolSizeLimits KeepAlive bKA
blPeerSharing :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall addr. ProtocolSizeLimits (PeerSharing addr) bPS
blLeiosNotify :: forall bCS bBF bTX bPCD bPVD bKA bPS bLN.
ByteLimits bCS bBF bTX bPCD bPVD bKA bPS bLN
-> forall point announcement vote.
   ProtocolSizeLimits (LeiosNotify point announcement vote) bLN
blChainSync :: forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blBlockFetch :: forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blTxSubmission2 :: forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blPerasCertDiffusion :: forall blk. ProtocolSizeLimits (PerasCertDiffusion blk) bPCD
blPerasVoteDiffusion :: forall blk. ProtocolSizeLimits (PerasVoteDiffusion blk) bPVD
blKeepAlive :: ProtocolSizeLimits KeepAlive bKA
blPeerSharing :: forall addr. ProtocolSizeLimits (PeerSharing addr) bPS
blLeiosNotify :: forall point announcement vote.
ProtocolSizeLimits (LeiosNotify point announcement vote) bLN
..} forall header.
PeerTrustable
-> ProtocolTimeLimitsWithRnd
     (ChainSync header (Point blk) (Tip blk))
chainSyncTimeouts ChainSyncLoPBucketConfig
lopBucketConfig CSJConfig
csjConfig ReportPeerMetrics{Tracer
  (STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
Tracer
  (STM m)
  (TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportHeader :: Tracer
  (STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
reportFetch :: Tracer
  (STM m)
  (TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportFetch :: forall (m :: * -> *) peerAddr.
ReportPeerMetrics m peerAddr
-> Tracer
     (STM m) (TraceLabelPeer peerAddr (SizeInBytes, SlotNo, Time))
reportHeader :: forall (m :: * -> *) peerAddr.
ReportPeerMetrics m peerAddr
-> Tracer (STM m) (TraceLabelPeer peerAddr (SlotNo, Time))
..} Handlers{ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
NodeToNodeVersion
-> ConnectionId addrNTN
-> m (LeiosNotifyServerPeerLookahead
        LeiosPoint (Header blk) LeiosVote m)
NodeToNodeVersion
-> ConnectionId addrNTN
-> Either
     (TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ())
     (PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
      -> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ())
NodeToNodeVersion
-> ConnectionId addrNTN -> PerasCertDiffusionOutbound blk m ()
NodeToNodeVersion
-> ConnectionId addrNTN -> PerasVoteDiffusionOutbound blk m ()
NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PerasCertDiffusionInboundPipelined blk m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PerasVoteDiffusionInboundPipelined blk m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (LeiosNotifyPeerState blk)
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (HeaderWithTime blk) blk blk m ()
hChainSyncClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hBlockFetchClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (HeaderWithTime blk) blk blk m ()
hBlockFetchServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> ConnectionId addr
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hTxSubmissionClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> TxSubmissionClient (GenTxId blk) (GenTx blk) m ()
hTxSubmissionServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> Either
     (TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
     (PeerTxAPI m (GenTxId blk) (GenTx blk)
      -> TxSubmissionServerPipelined (GenTxId blk) (GenTx blk) m ())
hPerasCertDiffusionClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PerasCertDiffusionInboundPipelined blk m ()
hPerasCertDiffusionServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PerasCertDiffusionOutbound blk m ()
hPerasVoteDiffusionClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PerasVoteDiffusionInboundPipelined blk m ()
hPerasVoteDiffusionServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PerasVoteDiffusionOutbound blk m ()
hKeepAliveClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (Map (ConnectionId addr) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion -> ConnectionId addr -> KeepAliveServer m ()
hPeerSharingClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> PeerSharingController addr m
-> m (PeerSharingClient addr m ())
hPeerSharingServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> PeerSharingServer addr m
hLeiosNotifyClient :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addr
-> StrictTVar m (LeiosNotifyPeerState blk)
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
hLeiosNotifyServer :: forall (m :: * -> *) addr blk.
Handlers m addr blk
-> NodeToNodeVersion
-> ConnectionId addr
-> m (LeiosNotifyServerPeerLookahead
        LeiosPoint (Header blk) LeiosVote m)
hChainSyncClient :: ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hBlockFetchClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (HeaderWithTime blk) blk blk m ()
hBlockFetchServer :: ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hTxSubmissionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
hTxSubmissionServer :: NodeToNodeVersion
-> ConnectionId addrNTN
-> Either
     (TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ())
     (PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
      -> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ())
hPerasCertDiffusionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PerasCertDiffusionInboundPipelined blk m ()
hPerasCertDiffusionServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PerasCertDiffusionOutbound blk m ()
hPerasVoteDiffusionClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PerasVoteDiffusionInboundPipelined blk m ()
hPerasVoteDiffusionServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PerasVoteDiffusionOutbound blk m ()
hKeepAliveClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveServer :: NodeToNodeVersion -> ConnectionId addrNTN -> KeepAliveServer m ()
hPeerSharingClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingServer :: NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
hLeiosNotifyClient :: NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (LeiosNotifyPeerState blk)
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
hLeiosNotifyServer :: NodeToNodeVersion
-> ConnectionId addrNTN
-> m (LeiosNotifyServerPeerLookahead
        LeiosPoint (Header blk) LeiosVote m)
..} =
  Apps{ServerApp m addrNTN bCS ()
ServerApp m addrNTN bBF ()
ServerApp m addrNTN bTX ()
ServerApp m addrNTN bPCD ()
ServerApp m addrNTN bPVD ()
ServerApp m addrNTN bKA ()
ServerApp m addrNTN bPS ()
ServerApp m addrNTN bLN ()
ClientApp m addrNTN bCS NodeToNodeInitiatorResult
ClientApp m addrNTN bBF NodeToNodeInitiatorResult
ClientApp m addrNTN bTX NodeToNodeInitiatorResult
ClientApp m addrNTN bPCD NodeToNodeInitiatorResult
ClientApp m addrNTN bPVD NodeToNodeInitiatorResult
ClientApp m addrNTN bKA NodeToNodeInitiatorResult
ClientApp m addrNTN bPS NodeToNodeInitiatorResult
ClientApp m addrNTN bLN NodeToNodeInitiatorResult
aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncServer :: ServerApp m addrNTN bCS ()
aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchServer :: ServerApp m addrNTN bBF ()
aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aPerasCertDiffusionClient :: ClientApp m addrNTN bPCD NodeToNodeInitiatorResult
aPerasCertDiffusionServer :: ServerApp m addrNTN bPCD ()
aPerasVoteDiffusionClient :: ClientApp m addrNTN bPVD NodeToNodeInitiatorResult
aPerasVoteDiffusionServer :: ServerApp m addrNTN bPVD ()
aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveServer :: ServerApp m addrNTN bKA ()
aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingServer :: ServerApp m addrNTN bPS ()
aLeiosNotifyClient :: ClientApp m addrNTN bLN NodeToNodeInitiatorResult
aLeiosNotifyServer :: ServerApp m addrNTN bLN ()
aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncServer :: ServerApp m addrNTN bCS ()
aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchServer :: ServerApp m addrNTN bBF ()
aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aPerasCertDiffusionClient :: ClientApp m addrNTN bPCD NodeToNodeInitiatorResult
aPerasCertDiffusionServer :: ServerApp m addrNTN bPCD ()
aPerasVoteDiffusionClient :: ClientApp m addrNTN bPVD NodeToNodeInitiatorResult
aPerasVoteDiffusionServer :: ServerApp m addrNTN bPVD ()
aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveServer :: ServerApp m addrNTN bKA ()
aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingServer :: ServerApp m addrNTN bPS ()
aLeiosNotifyClient :: ClientApp m addrNTN bLN NodeToNodeInitiatorResult
aLeiosNotifyServer :: ServerApp m addrNTN bLN ()
..}
 where
  (StdGen
chainSyncRng, StdGen
chainSyncRng') = StdGen -> (StdGen, StdGen)
forall g. SplitGen g => g -> (g, g)
splitGen StdGen
rng
  NodeKernel{DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> DiffusionPipeliningSupport
getDiffusionPipeliningSupport} = NodeKernel m addrNTN addrNTC blk
kernel

  aChainSyncClient ::
    NodeToNodeVersion ->
    ExpandedInitiatorContext addrNTN PeerTrustable m ->
    Channel m bCS ->
    m (NodeToNodeInitiatorResult, Maybe bCS)
  aChainSyncClient :: ClientApp m addrNTN bCS NodeToNodeInitiatorResult
aChainSyncClient
    NodeToNodeVersion
version
    ExpandedInitiatorContext
      { eicConnectionId :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them
      , eicControlMessage :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
      , eicIsBigLedgerPeer :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> IsBigLedgerPeer
eicIsBigLedgerPeer = IsBigLedgerPeer
isBigLedgerPeer
      , eicExtraFlags :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> extraFlags
eicExtraFlags = PeerTrustable
peerTrustable
      }
    Channel m bCS
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"ChainSyncClient"
      -- Note that it is crucial that we sync with the fetch client "outside"
      -- of registering the state for the sync client. This is needed to
      -- maintain a state invariant required by the block fetch logic: that for
      -- each candidate chain there is a corresponding block fetch client that
      -- can be used to fetch blocks for that chain.
      FetchClientRegistry
  (ConnectionId addrNTN) (HeaderWithTime blk) blk blk m
-> ConnectionId addrNTN
-> m (NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall (m :: * -> *) a peer header block matchedBlock.
(MonadSTM m, MonadFork m, MonadCatch m, Ord peer) =>
FetchClientRegistry peer header block matchedBlock m
-> peer -> m a -> m a
bracketSyncWithFetchClient
        (NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry
     (ConnectionId addrNTN) (HeaderWithTime blk) blk blk m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry
     (ConnectionId addrNTN) (HeaderWithTime blk) blk blk m
getFetchClientRegistry NodeKernel m addrNTN addrNTC blk
kernel)
        ConnectionId addrNTN
them
        (m (NodeToNodeInitiatorResult, Maybe bCS)
 -> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceChainSyncClientEvent blk)
-> Tracer m (TraceEventCsj (ConnectionId addrNTN) blk)
-> ChainDbView m blk
-> ChainSyncClientHandleCollection (ConnectionId addrNTN) m blk
-> STM m GsmState
-> ConnectionId addrNTN
-> NodeToNodeVersion
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> DiffusionPipeliningSupport
-> (ChainSyncStateView m blk
    -> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall (m :: * -> *) peer blk a.
(IOLike m, Ord peer, LedgerSupportsProtocol blk,
 BlockSupportsPeras blk, MonadTimer m) =>
Tracer m (TraceChainSyncClientEvent blk)
-> Tracer m (TraceEventCsj peer blk)
-> ChainDbView m blk
-> ChainSyncClientHandleCollection peer m blk
-> STM m GsmState
-> peer
-> NodeToNodeVersion
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> DiffusionPipeliningSupport
-> (ChainSyncStateView m blk -> m a)
-> m a
CsClient.bracketChainSyncClient
          ((TraceChainSyncClientEvent blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
-> Tracer m (TraceChainSyncClientEvent blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceChainSyncClientEvent blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceChainSyncClientEvent blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) (Tracers' (ConnectionId addrNTN) addrNTC blk (Tracer m)
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceChainSyncClientEvent blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceChainSyncClientEvent blk))
Node.chainSyncClientTracer (NodeKernel m addrNTN addrNTC blk
-> Tracers' (ConnectionId addrNTN) addrNTC blk (Tracer m)
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
getTracers NodeKernel m addrNTN addrNTC blk
kernel)))
          ((TraceEventCsj (ConnectionId addrNTN) blk
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceEventCsj (ConnectionId addrNTN) blk))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceEventCsj (ConnectionId addrNTN) blk))
-> Tracer m (TraceEventCsj (ConnectionId addrNTN) blk)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceEventCsj (ConnectionId addrNTN) blk
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceEventCsj (ConnectionId addrNTN) blk)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) (Tracers' (ConnectionId addrNTN) addrNTC blk (Tracer m)
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceEventCsj (ConnectionId addrNTN) blk))
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceLabelPeer remotePeer (TraceEventCsj remotePeer blk))
Node.csjTracer (NodeKernel m addrNTN addrNTC blk
-> Tracers' (ConnectionId addrNTN) addrNTC blk (Tracer m)
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
getTracers NodeKernel m addrNTN addrNTC blk
kernel)))
          (ChainDB m blk -> ChainDbView m blk
forall (m :: * -> *) blk. ChainDB m blk -> ChainDbView m blk
CsClient.defaultChainDbView (NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB NodeKernel m addrNTN addrNTC blk
kernel))
          (NodeKernel m addrNTN addrNTC blk
-> ChainSyncClientHandleCollection (ConnectionId addrNTN) m blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> ChainSyncClientHandleCollection (ConnectionId addrNTN) m blk
getChainSyncHandles NodeKernel m addrNTN addrNTC blk
kernel)
          (NodeKernel m addrNTN addrNTC blk -> STM m GsmState
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m GsmState
getGsmState NodeKernel m addrNTN addrNTC blk
kernel)
          ConnectionId addrNTN
them
          NodeToNodeVersion
version
          ChainSyncLoPBucketConfig
lopBucketConfig
          CSJConfig
csjConfig
          DiffusionPipeliningSupport
getDiffusionPipeliningSupport
        ((ChainSyncStateView m blk
  -> m (NodeToNodeInitiatorResult, Maybe bCS))
 -> m (NodeToNodeInitiatorResult, Maybe bCS))
-> (ChainSyncStateView m blk
    -> m (NodeToNodeInitiatorResult, Maybe bCS))
-> m (NodeToNodeInitiatorResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$ \ChainSyncStateView m blk
csState -> do
          (r, trailing) <-
            Tracer
  m (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
-> StdGen
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
-> ProtocolSizeLimits
     (ChainSync (Header blk) (Point blk) (Tip blk)) bCS
-> ProtocolTimeLimitsWithRnd
     (ChainSync (Header blk) (Point blk) (Tip blk))
-> Channel m bCS
-> PeerPipelined
     (ChainSync (Header blk) (Point blk) (Tip blk))
     'AsClient
     'StIdle
     m
     ChainSyncClientResult
-> m (ChainSyncClientResult, Maybe bCS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> StdGen
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimitsWithRnd ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimitsRnd
              ((TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
-> Tracer
     m (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))
tChainSyncTracer)
              StdGen
chainSyncRng
              (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
cChainSyncCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
              ProtocolSizeLimits
  (ChainSync (Header blk) (Point blk) (Tip blk)) bCS
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync
              (PeerTrustable
-> ProtocolTimeLimitsWithRnd
     (ChainSync (Header blk) (Point blk) (Tip blk))
forall header.
PeerTrustable
-> ProtocolTimeLimitsWithRnd
     (ChainSync header (Point blk) (Tip blk))
chainSyncTimeouts PeerTrustable
peerTrustable)
              Channel m bCS
channel
              (PeerPipelined
   (ChainSync (Header blk) (Point blk) (Tip blk))
   'AsClient
   'StIdle
   m
   ChainSyncClientResult
 -> m (ChainSyncClientResult, Maybe bCS))
-> PeerPipelined
     (ChainSync (Header blk) (Point blk) (Tip blk))
     'AsClient
     'StIdle
     m
     ChainSyncClientResult
-> m (ChainSyncClientResult, Maybe bCS)
forall a b. (a -> b) -> a -> b
$ ChainSyncClientPipelined
  (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
-> PeerPipelined
     (ChainSync (Header blk) (Point blk) (Tip blk))
     'AsClient
     'StIdle
     m
     ChainSyncClientResult
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncClientPipelined header point tip m a
-> ClientPipelined (ChainSync header point tip) 'StIdle m a
chainSyncClientPeerPipelined
              (ChainSyncClientPipelined
   (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
 -> PeerPipelined
      (ChainSync (Header blk) (Point blk) (Tip blk))
      'AsClient
      'StIdle
      m
      ChainSyncClientResult)
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
-> PeerPipelined
     (ChainSync (Header blk) (Point blk) (Tip blk))
     'AsClient
     'StIdle
     m
     ChainSyncClientResult
forall a b. (a -> b) -> a -> b
$ ConnectionId addrNTN
-> IsBigLedgerPeer
-> DynamicEnv m blk
-> ChainSyncClientPipelined
     (Header blk) (Point blk) (Tip blk) m ChainSyncClientResult
hChainSyncClient
                ConnectionId addrNTN
them
                IsBigLedgerPeer
isBigLedgerPeer
                CsClient.DynamicEnv
                  { NodeToNodeVersion
version :: NodeToNodeVersion
version :: NodeToNodeVersion
CsClient.version
                  , ControlMessageSTM m
controlMessageSTM :: ControlMessageSTM m
controlMessageSTM :: ControlMessageSTM m
CsClient.controlMessageSTM
                  , headerMetricsTracer :: HeaderMetricsTracer m
CsClient.headerMetricsTracer = ConnectionId addrNTN
-> (SlotNo, Time)
-> TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them ((SlotNo, Time)
 -> TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
-> Tracer
     (STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
-> HeaderMetricsTracer m
forall a' a. (a' -> a) -> Tracer (STM m) a -> Tracer (STM m) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  (STM m) (TraceLabelPeer (ConnectionId addrNTN) (SlotNo, Time))
reportHeader
                  , setCandidate :: AnchoredFragment (HeaderWithTime blk) -> STM m ()
CsClient.setCandidate = ChainSyncStateView m blk
-> AnchoredFragment (HeaderWithTime blk) -> STM m ()
forall (m :: * -> *) blk.
ChainSyncStateView m blk
-> AnchoredFragment (HeaderWithTime blk) -> STM m ()
csvSetCandidate ChainSyncStateView m blk
csState
                  , idling :: Idling m
CsClient.idling = ChainSyncStateView m blk -> Idling m
forall (m :: * -> *) blk. ChainSyncStateView m blk -> Idling m
csvIdling ChainSyncStateView m blk
csState
                  , loPBucket :: LoPBucket m
CsClient.loPBucket = ChainSyncStateView m blk -> LoPBucket m
forall (m :: * -> *) blk. ChainSyncStateView m blk -> LoPBucket m
csvLoPBucket ChainSyncStateView m blk
csState
                  , setLatestSlot :: WithOrigin SlotNo -> STM m ()
CsClient.setLatestSlot = ChainSyncStateView m blk -> WithOrigin SlotNo -> STM m ()
forall (m :: * -> *) blk.
ChainSyncStateView m blk -> WithOrigin SlotNo -> STM m ()
csvSetLatestSlot ChainSyncStateView m blk
csState
                  , jumping :: Jumping m blk
CsClient.jumping = ChainSyncStateView m blk -> Jumping m blk
forall (m :: * -> *) blk. ChainSyncStateView m blk -> Jumping m blk
csvJumping ChainSyncStateView m blk
csState
                  }
          return (ChainSyncInitiatorResult r, trailing)

  aChainSyncServer ::
    NodeToNodeVersion ->
    ResponderContext addrNTN ->
    Channel m bCS ->
    m ((), Maybe bCS)
  aChainSyncServer :: ServerApp m addrNTN bCS ()
aChainSyncServer NodeToNodeVersion
version ResponderContext{rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them} Channel m bCS
channel = do
    String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"ChainSyncServer"
    (ResourceRegistry m
 -> m (Follower m blk (WithPoint blk (SerialisedHeader blk))))
-> (Follower m blk (WithPoint blk (SerialisedHeader blk)) -> m ())
-> (Follower m blk (WithPoint blk (SerialisedHeader blk))
    -> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall (m :: * -> *) a r.
(MonadSTM m, MonadMask m, MonadThread m, MonadEvaluate m,
 HasCallStack) =>
(ResourceRegistry m -> m a) -> (a -> m ()) -> (a -> m r) -> m r
bracketWithPrivateRegistry
      ( ChainDB m blk
-> ChainType
-> ResourceRegistry m
-> m (Follower m blk (WithPoint blk (SerialisedHeader blk)))
forall (m :: * -> *) blk.
ChainDB m blk
-> ChainType
-> ResourceRegistry m
-> m (Follower m blk (WithPoint blk (SerialisedHeader blk)))
chainSyncHeaderServerFollower
          (NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> ChainDB m blk
getChainDB NodeKernel m addrNTN addrNTC blk
kernel)
          ( case DiffusionPipeliningSupport
getDiffusionPipeliningSupport of
              DiffusionPipeliningSupport
DiffusionPipeliningOn -> ChainType
ChainDB.TentativeChain
              DiffusionPipeliningSupport
DiffusionPipeliningOff -> ChainType
ChainDB.SelectedChain
          )
      )
      Follower m blk (WithPoint blk (SerialisedHeader blk)) -> m ()
forall (m :: * -> *) blk a. Follower m blk a -> m ()
ChainDB.followerClose
      ((Follower m blk (WithPoint blk (SerialisedHeader blk))
  -> m ((), Maybe bCS))
 -> m ((), Maybe bCS))
-> (Follower m blk (WithPoint blk (SerialisedHeader blk))
    -> m ((), Maybe bCS))
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ \Follower m blk (WithPoint blk (SerialisedHeader blk))
flr ->
        Tracer
  m
  (TraceSendRecv
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
-> StdGen
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bCS
-> ProtocolSizeLimits
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) bCS
-> ProtocolTimeLimitsWithRnd
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
-> Channel m bCS
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'NonPipelined
     'StIdle
     m
     ()
-> m ((), Maybe bCS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure, HasCallStack) =>
Tracer m (TraceSendRecv ps)
-> StdGen
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimitsWithRnd ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimitsRnd
          ((TraceSendRecv
   (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv
         (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv
           (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
-> Tracer
     m
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv
        (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))))
tChainSyncSerialisedTracer)
          StdGen
chainSyncRng'
          (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bCS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
cChainSyncCodecSerialised (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
          ProtocolSizeLimits
  (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) bCS
forall header point tip.
ProtocolSizeLimits (ChainSync header point tip) bCS
blChainSync
          (PeerTrustable
-> ProtocolTimeLimitsWithRnd
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
forall header.
PeerTrustable
-> ProtocolTimeLimitsWithRnd
     (ChainSync header (Point blk) (Tip blk))
chainSyncTimeouts PeerTrustable
IsNotTrustable)
          Channel m bCS
channel
          (Peer
   (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
   'AsServer
   'NonPipelined
   'StIdle
   m
   ()
 -> m ((), Maybe bCS))
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'NonPipelined
     'StIdle
     m
     ()
-> m ((), Maybe bCS)
forall a b. (a -> b) -> a -> b
$ ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'NonPipelined
     'StIdle
     m
     ()
forall header point tip (m :: * -> *) a.
Monad m =>
ChainSyncServer header point tip m a
-> Server (ChainSync header point tip) 'NonPipelined 'StIdle m a
chainSyncServerPeer
          (ChainSyncServer (SerialisedHeader blk) (Point blk) (Tip blk) m ()
 -> Peer
      (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
      'AsServer
      'NonPipelined
      'StIdle
      m
      ())
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
-> Peer
     (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk))
     'AsServer
     'NonPipelined
     'StIdle
     m
     ()
forall a b. (a -> b) -> a -> b
$ ConnectionId addrNTN
-> NodeToNodeVersion
-> Follower m blk (WithPoint blk (SerialisedHeader blk))
-> ChainSyncServer
     (SerialisedHeader blk) (Point blk) (Tip blk) m ()
hChainSyncServer ConnectionId addrNTN
them NodeToNodeVersion
version Follower m blk (WithPoint blk (SerialisedHeader blk))
flr

  aBlockFetchClient ::
    NodeToNodeVersion ->
    ExpandedInitiatorContext addrNTN PeerTrustable m ->
    Channel m bBF ->
    m (NodeToNodeInitiatorResult, Maybe bBF)
  aBlockFetchClient :: ClientApp m addrNTN bBF NodeToNodeInitiatorResult
aBlockFetchClient
    NodeToNodeVersion
version
    ExpandedInitiatorContext
      { eicConnectionId :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them
      , eicControlMessage :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
      }
    Channel m bBF
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"BlockFetchClient"
      FetchClientRegistry
  (ConnectionId addrNTN) (HeaderWithTime blk) blk blk m
-> KeepAliveRegistry (ConnectionId addrNTN) m
-> NodeToNodeVersion
-> ConnectionId addrNTN
-> (FetchClientContext (HeaderWithTime blk) blk blk m
    -> m (NodeToNodeInitiatorResult, Maybe bBF))
-> m (NodeToNodeInitiatorResult, Maybe bBF)
forall (m :: * -> *) a peer header block matchedBlock version.
(MonadFork m, MonadMask m, MonadTimer m, Ord peer) =>
FetchClientRegistry peer header block matchedBlock m
-> KeepAliveRegistry peer m
-> version
-> peer
-> (FetchClientContext header block matchedBlock m -> m a)
-> m a
bracketFetchClient
        (NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry
     (ConnectionId addrNTN) (HeaderWithTime blk) blk blk m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> FetchClientRegistry
     (ConnectionId addrNTN) (HeaderWithTime blk) blk blk m
getFetchClientRegistry NodeKernel m addrNTN addrNTC blk
kernel)
        (NodeKernel m addrNTN addrNTC blk
-> KeepAliveRegistry (ConnectionId addrNTN) m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> KeepAliveRegistry (ConnectionId addrNTN) m
getKeepAliveRegistry NodeKernel m addrNTN addrNTC blk
kernel)
        NodeToNodeVersion
version
        ConnectionId addrNTN
them
        ((FetchClientContext (HeaderWithTime blk) blk blk m
  -> m (NodeToNodeInitiatorResult, Maybe bBF))
 -> m (NodeToNodeInitiatorResult, Maybe bBF))
-> (FetchClientContext (HeaderWithTime blk) blk blk m
    -> m (NodeToNodeInitiatorResult, Maybe bBF))
-> m (NodeToNodeInitiatorResult, Maybe bBF)
forall a b. (a -> b) -> a -> b
$ \FetchClientContext (HeaderWithTime blk) blk blk m
clientCtx -> do
          ((), trailing) <-
            Tracer m (TraceSendRecv (BlockFetch blk (Point blk)))
-> Codec (BlockFetch blk (Point blk)) e m bBF
-> ProtocolSizeLimits (BlockFetch blk (Point blk)) bBF
-> ProtocolTimeLimits (BlockFetch blk (Point blk))
-> Channel m bBF
-> PeerPipelined
     (BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
-> m ((), Maybe bBF)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
              ((TraceSendRecv (BlockFetch blk (Point blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (BlockFetch blk (Point blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (BlockFetch blk (Point blk))))
-> Tracer m (TraceSendRecv (BlockFetch blk (Point blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (BlockFetch blk (Point blk))
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceSendRecv (BlockFetch blk (Point blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch blk (Point blk))))
tBlockFetchTracer)
              (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (BlockFetch blk (Point blk)) e m bBF
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (BlockFetch blk (Point blk)) e m bBF
cBlockFetchCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
              ProtocolSizeLimits (BlockFetch blk (Point blk)) bBF
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch
              ProtocolTimeLimits (BlockFetch blk (Point blk))
forall block point. ProtocolTimeLimits (BlockFetch block point)
timeLimitsBlockFetch
              Channel m bBF
channel
              (PeerPipelined (BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
 -> m ((), Maybe bBF))
-> PeerPipelined
     (BlockFetch blk (Point blk)) 'AsClient 'BFIdle m ()
-> m ((), Maybe bBF)
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ControlMessageSTM m
-> FetchedMetricsTracer m
-> BlockFetchClient (HeaderWithTime blk) blk blk m ()
hBlockFetchClient
                NodeToNodeVersion
version
                ControlMessageSTM m
controlMessageSTM
                (ConnectionId addrNTN
-> (SizeInBytes, SlotNo, Time)
-> TraceLabelPeer
     (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them ((SizeInBytes, SlotNo, Time)
 -> TraceLabelPeer
      (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
-> Tracer
     (STM m)
     (TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
-> FetchedMetricsTracer m
forall a' a. (a' -> a) -> Tracer (STM m) a -> Tracer (STM m) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  (STM m)
  (TraceLabelPeer (ConnectionId addrNTN) (SizeInBytes, SlotNo, Time))
reportFetch)
                FetchClientContext (HeaderWithTime blk) blk blk m
clientCtx
          return (NoInitiatorResult, trailing)

  aBlockFetchServer ::
    NodeToNodeVersion ->
    ResponderContext addrNTN ->
    Channel m bBF ->
    m ((), Maybe bBF)
  aBlockFetchServer :: ServerApp m addrNTN bBF ()
aBlockFetchServer NodeToNodeVersion
version ResponderContext{rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them} Channel m bBF
channel = do
    String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"BlockFetchServer"
    (ResourceRegistry m -> m ((), Maybe bBF)) -> m ((), Maybe bBF)
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, MonadEvaluate m,
 HasCallStack) =>
(ResourceRegistry m -> m a) -> m a
withRegistry ((ResourceRegistry m -> m ((), Maybe bBF)) -> m ((), Maybe bBF))
-> (ResourceRegistry m -> m ((), Maybe bBF)) -> m ((), Maybe bBF)
forall a b. (a -> b) -> a -> b
$ \ResourceRegistry m
registry ->
      Tracer m (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bBF
-> ProtocolSizeLimits (BlockFetch (Serialised blk) (Point blk)) bBF
-> ProtocolTimeLimits (BlockFetch (Serialised blk) (Point blk))
-> Channel m bBF
-> Peer
     (BlockFetch (Serialised blk) (Point blk))
     'AsServer
     'NonPipelined
     'BFIdle
     m
     ()
-> m ((), Maybe bBF)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        ((TraceSendRecv (BlockFetch (Serialised blk) (Point blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
-> Tracer
     m (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (BlockFetch (Serialised blk) (Point blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (BlockFetch (Serialised blk) (Point blk))))
tBlockFetchSerialisedTracer)
        (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bBF
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
cBlockFetchCodecSerialised (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
        ProtocolSizeLimits (BlockFetch (Serialised blk) (Point blk)) bBF
forall block point. ProtocolSizeLimits (BlockFetch block point) bBF
blBlockFetch
        ProtocolTimeLimits (BlockFetch (Serialised blk) (Point blk))
forall block point. ProtocolTimeLimits (BlockFetch block point)
timeLimitsBlockFetch
        Channel m bBF
channel
        (Peer
   (BlockFetch (Serialised blk) (Point blk))
   'AsServer
   'NonPipelined
   'BFIdle
   m
   ()
 -> m ((), Maybe bBF))
-> Peer
     (BlockFetch (Serialised blk) (Point blk))
     'AsServer
     'NonPipelined
     'BFIdle
     m
     ()
-> m ((), Maybe bBF)
forall a b. (a -> b) -> a -> b
$ BlockFetchServer (Serialised blk) (Point blk) m ()
-> Peer
     (BlockFetch (Serialised blk) (Point blk))
     'AsServer
     'NonPipelined
     'BFIdle
     m
     ()
forall block point (m :: * -> *) a.
Functor m =>
BlockFetchServer block point m a
-> Server (BlockFetch block point) 'NonPipelined 'BFIdle m a
blockFetchServerPeer
        (BlockFetchServer (Serialised blk) (Point blk) m ()
 -> Peer
      (BlockFetch (Serialised blk) (Point blk))
      'AsServer
      'NonPipelined
      'BFIdle
      m
      ())
-> BlockFetchServer (Serialised blk) (Point blk) m ()
-> Peer
     (BlockFetch (Serialised blk) (Point blk))
     'AsServer
     'NonPipelined
     'BFIdle
     m
     ()
forall a b. (a -> b) -> a -> b
$ ConnectionId addrNTN
-> NodeToNodeVersion
-> ResourceRegistry m
-> BlockFetchServer (Serialised blk) (Point blk) m ()
hBlockFetchServer ConnectionId addrNTN
them NodeToNodeVersion
version ResourceRegistry m
registry

  aTxSubmission2Client ::
    NodeToNodeVersion ->
    ExpandedInitiatorContext addrNTN PeerTrustable m ->
    Channel m bTX ->
    m (NodeToNodeInitiatorResult, Maybe bTX)
  aTxSubmission2Client :: ClientApp m addrNTN bTX NodeToNodeInitiatorResult
aTxSubmission2Client
    NodeToNodeVersion
version
    ExpandedInitiatorContext
      { eicConnectionId :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them
      , eicControlMessage :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
      }
    Channel m bTX
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"TxSubmissionClient"
      ((), trailing) <-
        Tracer
  m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
-> ProtocolSizeLimits
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
-> ProtocolTimeLimits
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> Channel m bTX
-> Peer
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     'AsClient
     'NonPipelined
     'StInit
     m
     ()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
          ((TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
     m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tTxSubmission2Tracer)
          (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
          ProtocolSizeLimits
  (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2
          ProtocolTimeLimits (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
forall txid tx. ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
          Channel m bTX
channel
          (TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
-> Peer
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     'AsClient
     'NonPipelined
     'StInit
     m
     ()
forall txid tx (m :: * -> *) a.
Monad m =>
TxSubmissionClient txid tx m a
-> Client (TxSubmission2 txid tx) 'NonPipelined 'StInit m a
txSubmissionClientPeer (NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> TxSubmissionClient (TxId (GenTx blk)) (GenTx blk) m ()
hTxSubmissionClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them))
      return (NoInitiatorResult, trailing)

  aTxSubmission2Server ::
    NodeToNodeVersion ->
    ResponderContext addrNTN ->
    Channel m bTX ->
    m ((), Maybe bTX)
  aTxSubmission2Server :: ServerApp m addrNTN bTX ()
aTxSubmission2Server NodeToNodeVersion
version ResponderContext{rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them} Channel m bTX
channel = do
    String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"TxSubmissionServer"

    let runServer :: TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
-> m ((), Maybe bTX)
runServer TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
serverApi =
          Tracer
  m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
-> ProtocolSizeLimits
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
-> ProtocolTimeLimits
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> Channel m bTX
-> PeerPipelined
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     'AsServer
     'StInit
     m
     ()
-> m ((), Maybe bTX)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
            ((TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
-> Tracer
     m (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (ConnectionId addrNTN
-> TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them) Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))))
tTxSubmission2Tracer)
            (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) e m bTX
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
cTxSubmission2Codec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
            ProtocolSizeLimits
  (TxSubmission2 (TxId (GenTx blk)) (GenTx blk)) bTX
forall txid tx. ProtocolSizeLimits (TxSubmission2 txid tx) bTX
blTxSubmission2
            ProtocolTimeLimits (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
forall txid tx. ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
            Channel m bTX
channel
            (TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
-> PeerPipelined
     (TxSubmission2 (TxId (GenTx blk)) (GenTx blk))
     'AsServer
     'StInit
     m
     ()
forall txid tx (m :: * -> *) a.
Functor m =>
TxSubmissionServerPipelined txid tx m a
-> ServerPipelined (TxSubmission2 txid tx) 'StInit m a
txSubmissionServerPeerPipelined TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
serverApi)

    case NodeToNodeVersion
-> ConnectionId addrNTN
-> Either
     (TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ())
     (PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
      -> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ())
hTxSubmissionServer NodeToNodeVersion
version ConnectionId addrNTN
them of
      Left TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
legacyTxSubmissionServer ->
        TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
-> m ((), Maybe bTX)
runServer TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
legacyTxSubmissionServer
      Right PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
-> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
newTxSubmissionServer ->
        TxDecisionPolicy
-> TxSubmissionMempoolReader
     (TxId (GenTx blk)) (GenTx blk) TicketNo m
-> SharedTxStateVar m (ConnectionId addrNTN) (TxId (GenTx blk))
-> PeerTxRegistry m (ConnectionId addrNTN)
-> TxSubmissionCountersVar m
-> ConnectionId addrNTN
-> (PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
    -> m ((), Maybe bTX))
-> m ((), Maybe bTX)
forall peeraddr txid tx idx (m :: * -> *) a.
(MonadMask m, MonadTimer m, Ord peeraddr, Show peeraddr, Ord txid,
 HasRawTxId txid) =>
TxDecisionPolicy
-> TxSubmissionMempoolReader txid tx idx m
-> SharedTxStateVar m peeraddr txid
-> PeerTxRegistry m peeraddr
-> TxSubmissionCountersVar m
-> peeraddr
-> (PeerTxAPI m txid tx -> m a)
-> m a
withPeer
          (NodeKernel m addrNTN addrNTC blk -> TxDecisionPolicy
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> TxDecisionPolicy
getTxDecisionPolicy NodeKernel m addrNTN addrNTC blk
kernel)
          ( (Validated (GenTx blk) -> GenTx blk)
-> TxSubmissionMempoolReader
     (TxId (GenTx blk)) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader
     (TxId (GenTx blk)) (GenTx blk) TicketNo m
forall (m :: * -> *) tx tx' txid idx.
MonadSTM m =>
(tx -> tx')
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolReader txid tx' idx m
mapTxSubmissionMempoolReader Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (TxSubmissionMempoolReader
   (TxId (GenTx blk)) (Validated (GenTx blk)) TicketNo m
 -> TxSubmissionMempoolReader
      (TxId (GenTx blk)) (GenTx blk) TicketNo m)
-> TxSubmissionMempoolReader
     (TxId (GenTx blk)) (Validated (GenTx blk)) TicketNo m
-> TxSubmissionMempoolReader
     (TxId (GenTx blk)) (GenTx blk) TicketNo m
forall a b. (a -> b) -> a -> b
$
              Mempool m blk
-> TxSubmissionMempoolReader
     (TxId (GenTx blk)) (Validated (GenTx blk)) TicketNo m
forall (m :: * -> *) blk.
(LedgerSupportsMempool blk, IOLike m, HasTxId (GenTx blk)) =>
Mempool m blk
-> TxSubmissionMempoolReader
     (GenTxId blk) (Validated (GenTx blk)) TicketNo m
getMempoolReader (NodeKernel m addrNTN addrNTC blk -> Mempool m blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> Mempool m blk
getMempool NodeKernel m addrNTN addrNTC blk
kernel)
          )
          (NodeKernel m addrNTN addrNTC blk
-> SharedTxStateVar m (ConnectionId addrNTN) (TxId (GenTx blk))
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> SharedTxStateVar m (ConnectionId addrNTN) (GenTxId blk)
getSharedTxStateVar NodeKernel m addrNTN addrNTC blk
kernel)
          (NodeKernel m addrNTN addrNTC blk
-> PeerTxRegistry m (ConnectionId addrNTN)
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> PeerTxRegistry m (ConnectionId addrNTN)
getPeerTxRegistry NodeKernel m addrNTN addrNTC blk
kernel)
          (NodeKernel m addrNTN addrNTC blk -> TxSubmissionCountersVar m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> TxSubmissionCountersVar m
getTxCountersVar NodeKernel m addrNTN addrNTC blk
kernel)
          ConnectionId addrNTN
them
          ((PeerTxAPI m (TxId (GenTx blk)) (GenTx blk) -> m ((), Maybe bTX))
 -> m ((), Maybe bTX))
-> (PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
    -> m ((), Maybe bTX))
-> m ((), Maybe bTX)
forall a b. (a -> b) -> a -> b
$ \PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
api ->
            TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
-> m ((), Maybe bTX)
runServer (PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
-> TxSubmissionServerPipelined (TxId (GenTx blk)) (GenTx blk) m ()
newTxSubmissionServer PeerTxAPI m (TxId (GenTx blk)) (GenTx blk)
api)

  aPerasCertDiffusionClient ::
    NodeToNodeVersion ->
    ExpandedInitiatorContext addrNTN PeerTrustable m ->
    Channel m bPCD ->
    m (NodeToNodeInitiatorResult, Maybe bPCD)
  aPerasCertDiffusionClient :: ClientApp m addrNTN bPCD NodeToNodeInitiatorResult
aPerasCertDiffusionClient
    NodeToNodeVersion
version
    ExpandedInitiatorContext
      { eicConnectionId :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them
      , eicControlMessage :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
      }
    Channel m bPCD
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PerasCertDiffusionClient"
      ((), trailing) <-
        Tracer
  m (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))
-> Codec (ObjectDiffusion PerasRoundNo (PerasCert blk)) e m bPCD
-> ProtocolSizeLimits
     (ObjectDiffusion PerasRoundNo (PerasCert blk)) bPCD
-> ProtocolTimeLimits
     (ObjectDiffusion PerasRoundNo (PerasCert blk))
-> Channel m bPCD
-> PeerPipelined
     (ObjectDiffusion PerasRoundNo (PerasCert blk))
     'AsClient
     'StInit
     m
     ()
-> m ((), Maybe bPCD)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
          (ConnectionId addrNTN
-> TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
-> Tracer
     m (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
tPerasCertDiffusionTracer)
          (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (ObjectDiffusion PerasRoundNo (PerasCert blk)) e m bPCD
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PerasCertDiffusion blk) e m bPCD
cPerasCertDiffusionCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
          ProtocolSizeLimits
  (ObjectDiffusion PerasRoundNo (PerasCert blk)) bPCD
forall blk. ProtocolSizeLimits (PerasCertDiffusion blk) bPCD
blPerasCertDiffusion
          ProtocolTimeLimits (ObjectDiffusion PerasRoundNo (PerasCert blk))
forall objectId object.
ProtocolTimeLimits (ObjectDiffusion objectId object)
timeLimitsObjectDiffusion
          Channel m bPCD
channel
          ( PerasCertDiffusionInboundPipelined blk m ()
-> PeerPipelined
     (ObjectDiffusion PerasRoundNo (PerasCert blk))
     'AsClient
     'StInit
     m
     ()
forall objectId object (m :: * -> *) a.
Functor m =>
ObjectDiffusionInboundPipelined objectId object m a
-> PeerPipelined
     (ObjectDiffusion objectId object) 'AsClient 'StInit m a
objectDiffusionInboundPeerPipelined
              (NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PerasCertDiffusionInboundPipelined blk m ()
hPerasCertDiffusionClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them)
          )
      return (NoInitiatorResult, trailing)

  aPerasCertDiffusionServer ::
    NodeToNodeVersion ->
    ResponderContext addrNTN ->
    Channel m bPCD ->
    m ((), Maybe bPCD)
  aPerasCertDiffusionServer :: ServerApp m addrNTN bPCD ()
aPerasCertDiffusionServer
    NodeToNodeVersion
version
    ResponderContext{rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them}
    Channel m bPCD
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PerasCertDiffusionServer"
      Tracer
  m (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))
-> Codec (ObjectDiffusion PerasRoundNo (PerasCert blk)) e m bPCD
-> ProtocolSizeLimits
     (ObjectDiffusion PerasRoundNo (PerasCert blk)) bPCD
-> ProtocolTimeLimits
     (ObjectDiffusion PerasRoundNo (PerasCert blk))
-> Channel m bPCD
-> Peer
     (ObjectDiffusion PerasRoundNo (PerasCert blk))
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
-> m ((), Maybe bPCD)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        (ConnectionId addrNTN
-> TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
-> Tracer
     m (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasRoundNo (PerasCert blk))))
tPerasCertDiffusionTracer)
        (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (ObjectDiffusion PerasRoundNo (PerasCert blk)) e m bPCD
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PerasCertDiffusion blk) e m bPCD
cPerasCertDiffusionCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
        ProtocolSizeLimits
  (ObjectDiffusion PerasRoundNo (PerasCert blk)) bPCD
forall blk. ProtocolSizeLimits (PerasCertDiffusion blk) bPCD
blPerasCertDiffusion
        ProtocolTimeLimits (ObjectDiffusion PerasRoundNo (PerasCert blk))
forall objectId object.
ProtocolTimeLimits (ObjectDiffusion objectId object)
timeLimitsObjectDiffusion
        Channel m bPCD
channel
        ( PerasCertDiffusionOutbound blk m ()
-> Peer
     (ObjectDiffusion PerasRoundNo (PerasCert blk))
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
forall objectId object (m :: * -> *) a.
Monad m =>
ObjectDiffusionOutbound objectId object m a
-> Peer
     (ObjectDiffusion objectId object)
     'AsServer
     'NonPipelined
     'StInit
     m
     a
objectDiffusionOutboundPeer
            (NodeToNodeVersion
-> ConnectionId addrNTN -> PerasCertDiffusionOutbound blk m ()
hPerasCertDiffusionServer NodeToNodeVersion
version ConnectionId addrNTN
them)
        )

  aPerasVoteDiffusionClient ::
    NodeToNodeVersion ->
    ExpandedInitiatorContext addrNTN PeerTrustable m ->
    Channel m bPVD ->
    m (NodeToNodeInitiatorResult, Maybe bPVD)
  aPerasVoteDiffusionClient :: ClientApp m addrNTN bPVD NodeToNodeInitiatorResult
aPerasVoteDiffusionClient
    NodeToNodeVersion
version
    ExpandedInitiatorContext
      { eicConnectionId :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them
      , eicControlMessage :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
      }
    Channel m bPVD
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PerasVoteDiffusionClient"
      ((), trailing) <-
        Tracer
  m (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))
-> Codec (ObjectDiffusion PerasVoteId (PerasVote blk)) e m bPVD
-> ProtocolSizeLimits
     (ObjectDiffusion PerasVoteId (PerasVote blk)) bPVD
-> ProtocolTimeLimits (ObjectDiffusion PerasVoteId (PerasVote blk))
-> Channel m bPVD
-> PeerPipelined
     (ObjectDiffusion PerasVoteId (PerasVote blk))
     'AsClient
     'StInit
     m
     ()
-> m ((), Maybe bPVD)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
          (ConnectionId addrNTN
-> TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
-> Tracer
     m (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
tPerasVoteDiffusionTracer)
          (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (ObjectDiffusion PerasVoteId (PerasVote blk)) e m bPVD
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PerasVoteDiffusion blk) e m bPVD
cPerasVoteDiffusionCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
          ProtocolSizeLimits
  (ObjectDiffusion PerasVoteId (PerasVote blk)) bPVD
forall blk. ProtocolSizeLimits (PerasVoteDiffusion blk) bPVD
blPerasVoteDiffusion
          ProtocolTimeLimits (ObjectDiffusion PerasVoteId (PerasVote blk))
forall objectId object.
ProtocolTimeLimits (ObjectDiffusion objectId object)
timeLimitsObjectDiffusion
          Channel m bPVD
channel
          ( PerasVoteDiffusionInboundPipelined blk m ()
-> PeerPipelined
     (ObjectDiffusion PerasVoteId (PerasVote blk))
     'AsClient
     'StInit
     m
     ()
forall objectId object (m :: * -> *) a.
Functor m =>
ObjectDiffusionInboundPipelined objectId object m a
-> PeerPipelined
     (ObjectDiffusion objectId object) 'AsClient 'StInit m a
objectDiffusionInboundPeerPipelined
              (NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PerasVoteDiffusionInboundPipelined blk m ()
hPerasVoteDiffusionClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them)
          )
      return (NoInitiatorResult, trailing)

  aPerasVoteDiffusionServer ::
    NodeToNodeVersion ->
    ResponderContext addrNTN ->
    Channel m bPVD ->
    m ((), Maybe bPVD)
  aPerasVoteDiffusionServer :: ServerApp m addrNTN bPVD ()
aPerasVoteDiffusionServer
    NodeToNodeVersion
version
    ResponderContext{rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them}
    Channel m bPVD
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PerasVoteDiffusionServer"
      Tracer
  m (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))
-> Codec (ObjectDiffusion PerasVoteId (PerasVote blk)) e m bPVD
-> ProtocolSizeLimits
     (ObjectDiffusion PerasVoteId (PerasVote blk)) bPVD
-> ProtocolTimeLimits (ObjectDiffusion PerasVoteId (PerasVote blk))
-> Channel m bPVD
-> Peer
     (ObjectDiffusion PerasVoteId (PerasVote blk))
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
-> m ((), Maybe bPVD)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
        (ConnectionId addrNTN
-> TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))
-> TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))
 -> TraceLabelPeer
      (ConnectionId addrNTN)
      (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN)
        (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
-> Tracer
     m (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN)
     (TraceSendRecv (ObjectDiffusion PerasVoteId (PerasVote blk))))
tPerasVoteDiffusionTracer)
        (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (ObjectDiffusion PerasVoteId (PerasVote blk)) e m bPVD
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PerasVoteDiffusion blk) e m bPVD
cPerasVoteDiffusionCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
        ProtocolSizeLimits
  (ObjectDiffusion PerasVoteId (PerasVote blk)) bPVD
forall blk. ProtocolSizeLimits (PerasVoteDiffusion blk) bPVD
blPerasVoteDiffusion
        ProtocolTimeLimits (ObjectDiffusion PerasVoteId (PerasVote blk))
forall objectId object.
ProtocolTimeLimits (ObjectDiffusion objectId object)
timeLimitsObjectDiffusion
        Channel m bPVD
channel
        ( PerasVoteDiffusionOutbound blk m ()
-> Peer
     (ObjectDiffusion PerasVoteId (PerasVote blk))
     'AsServer
     'NonPipelined
     'StInit
     m
     ()
forall objectId object (m :: * -> *) a.
Monad m =>
ObjectDiffusionOutbound objectId object m a
-> Peer
     (ObjectDiffusion objectId object)
     'AsServer
     'NonPipelined
     'StInit
     m
     a
objectDiffusionOutboundPeer
            (NodeToNodeVersion
-> ConnectionId addrNTN -> PerasVoteDiffusionOutbound blk m ()
hPerasVoteDiffusionServer NodeToNodeVersion
version ConnectionId addrNTN
them)
        )

  aKeepAliveClient ::
    NodeToNodeVersion ->
    ExpandedInitiatorContext addrNTN PeerTrustable m ->
    Channel m bKA ->
    m (NodeToNodeInitiatorResult, Maybe bKA)
  aKeepAliveClient :: ClientApp m addrNTN bKA NodeToNodeInitiatorResult
aKeepAliveClient
    NodeToNodeVersion
version
    ExpandedInitiatorContext
      { eicConnectionId :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them
      , eicControlMessage :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
      }
    Channel m bKA
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"KeepAliveClient"
      let kacApp :: StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> m ((), Maybe bKA)
kacApp = \StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
dqCtx ->
            Tracer m (TraceSendRecv KeepAlive)
-> Codec KeepAlive e m bKA
-> ProtocolSizeLimits KeepAlive bKA
-> ProtocolTimeLimits KeepAlive
-> Channel m bKA
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
-> m ((), Maybe bKA)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
              (ConnectionId addrNTN
-> TraceSendRecv KeepAlive
-> TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv KeepAlive
 -> TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
-> Tracer
     m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
-> Tracer m (TraceSendRecv KeepAlive)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
tKeepAliveTracer)
              (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec KeepAlive e m bKA
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec KeepAlive e m bKA
cKeepAliveCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
              ProtocolSizeLimits KeepAlive bKA
blKeepAlive
              ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive
              Channel m bKA
channel
              (Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
 -> m ((), Maybe bKA))
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
-> m ((), Maybe bKA)
forall a b. (a -> b) -> a -> b
$ KeepAliveClient m ()
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
forall (m :: * -> *) a.
MonadThrow m =>
KeepAliveClient m a -> Client KeepAlive 'NonPipelined 'StClient m a
keepAliveClientPeer
              (KeepAliveClient m ()
 -> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ())
-> KeepAliveClient m ()
-> Peer KeepAlive 'AsClient 'NonPipelined 'StClient m ()
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> KeepAliveInterval
-> KeepAliveClient m ()
hKeepAliveClient
                NodeToNodeVersion
version
                ControlMessageSTM m
controlMessageSTM
                ConnectionId addrNTN
them
                StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
dqCtx
                (DiffTime -> KeepAliveInterval
KeepAliveInterval DiffTime
10)

      ((), trailing) <-
        KeepAliveRegistry (ConnectionId addrNTN) m
-> ConnectionId addrNTN
-> (StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
    -> m ((), Maybe bKA))
-> m ((), Maybe bKA)
forall (m :: * -> *) a peer.
(MonadSTM m, MonadFork m, MonadMask m, Ord peer) =>
KeepAliveRegistry peer m
-> peer -> (StrictTVar m (Map peer PeerGSV) -> m a) -> m a
bracketKeepAliveClient (NodeKernel m addrNTN addrNTC blk
-> KeepAliveRegistry (ConnectionId addrNTN) m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> KeepAliveRegistry (ConnectionId addrNTN) m
getKeepAliveRegistry NodeKernel m addrNTN addrNTC blk
kernel) ConnectionId addrNTN
them StrictTVar m (Map (ConnectionId addrNTN) PeerGSV)
-> m ((), Maybe bKA)
kacApp
      return (NoInitiatorResult, trailing)

  aKeepAliveServer ::
    NodeToNodeVersion ->
    ResponderContext addrNTN ->
    Channel m bKA ->
    m ((), Maybe bKA)
  aKeepAliveServer :: ServerApp m addrNTN bKA ()
aKeepAliveServer NodeToNodeVersion
version ResponderContext{rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them} Channel m bKA
channel = do
    String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"KeepAliveServer"
    Tracer m (TraceSendRecv KeepAlive)
-> Codec KeepAlive e m bKA
-> ProtocolSizeLimits KeepAlive bKA
-> ProtocolTimeLimits KeepAlive
-> Channel m bKA
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
-> m ((), Maybe bKA)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
      (ConnectionId addrNTN
-> TraceSendRecv KeepAlive
-> TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive)
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv KeepAlive
 -> TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
-> Tracer
     m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
-> Tracer m (TraceSendRecv KeepAlive)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m (TraceLabelPeer (ConnectionId addrNTN) (TraceSendRecv KeepAlive))
tKeepAliveTracer)
      (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec KeepAlive e m bKA
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec KeepAlive e m bKA
cKeepAliveCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
      ProtocolSizeLimits KeepAlive bKA
blKeepAlive
      ProtocolTimeLimits KeepAlive
timeLimitsKeepAlive
      Channel m bKA
channel
      (Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
 -> m ((), Maybe bKA))
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
-> m ((), Maybe bKA)
forall a b. (a -> b) -> a -> b
$ KeepAliveServer m ()
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
forall (m :: * -> *) a.
Functor m =>
KeepAliveServer m a -> Server KeepAlive 'NonPipelined 'StClient m a
keepAliveServerPeer
      (KeepAliveServer m ()
 -> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ())
-> KeepAliveServer m ()
-> Peer KeepAlive 'AsServer 'NonPipelined 'StClient m ()
forall a b. (a -> b) -> a -> b
$ KeepAliveServer m ()
forall (m :: * -> *). Applicative m => KeepAliveServer m ()
keepAliveServer

  aPeerSharingClient ::
    NodeToNodeVersion ->
    ExpandedInitiatorContext addrNTN PeerTrustable m ->
    Channel m bPS ->
    m (NodeToNodeInitiatorResult, Maybe bPS)
  aPeerSharingClient :: ClientApp m addrNTN bPS NodeToNodeInitiatorResult
aPeerSharingClient
    NodeToNodeVersion
version
    ExpandedInitiatorContext
      { eicConnectionId :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them
      , eicControlMessage :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
      }
    Channel m bPS
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PeerSharingClient"
      PeerSharingRegistry addrNTN m
-> addrNTN
-> (PeerSharingController addrNTN m
    -> m (NodeToNodeInitiatorResult, Maybe bPS))
-> m (NodeToNodeInitiatorResult, Maybe bPS)
forall peer (m :: * -> *) a.
(Ord peer, MonadSTM m, MonadThrow m) =>
PeerSharingRegistry peer m
-> peer -> (PeerSharingController peer m -> m a) -> m a
bracketPeerSharingClient (NodeKernel m addrNTN addrNTC blk -> PeerSharingRegistry addrNTN m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> PeerSharingRegistry addrNTN m
getPeerSharingRegistry NodeKernel m addrNTN addrNTC blk
kernel) (ConnectionId addrNTN -> addrNTN
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId addrNTN
them) ((PeerSharingController addrNTN m
  -> m (NodeToNodeInitiatorResult, Maybe bPS))
 -> m (NodeToNodeInitiatorResult, Maybe bPS))
-> (PeerSharingController addrNTN m
    -> m (NodeToNodeInitiatorResult, Maybe bPS))
-> m (NodeToNodeInitiatorResult, Maybe bPS)
forall a b. (a -> b) -> a -> b
$
        \PeerSharingController addrNTN m
controller -> do
          psClient <- NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> PeerSharingController addrNTN m
-> m (PeerSharingClient addrNTN m ())
hPeerSharingClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them PeerSharingController addrNTN m
controller
          ((), trailing) <-
            runPeerWithLimits
              (TraceLabelPeer them `contramap` tPeerSharingTracer)
              (cPeerSharingCodec (mkCodecs version))
              blPeerSharing
              timeLimitsPeerSharing
              channel
              (peerSharingClientPeer psClient)
          return (NoInitiatorResult, trailing)

  aPeerSharingServer ::
    NodeToNodeVersion ->
    ResponderContext addrNTN ->
    Channel m bPS ->
    m ((), Maybe bPS)
  aPeerSharingServer :: ServerApp m addrNTN bPS ()
aPeerSharingServer NodeToNodeVersion
version ResponderContext{rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them} Channel m bPS
channel = do
    String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"PeerSharingServer"
    Tracer m (TraceSendRecv (PeerSharing addrNTN))
-> Codec (PeerSharing addrNTN) e m bPS
-> ProtocolSizeLimits (PeerSharing addrNTN) bPS
-> ProtocolTimeLimits (PeerSharing addrNTN)
-> Channel m bPS
-> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
-> m ((), Maybe bPS)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits
      (ConnectionId addrNTN
-> TraceSendRecv (PeerSharing addrNTN)
-> TraceLabelPeer
     (ConnectionId addrNTN) (TraceSendRecv (PeerSharing addrNTN))
forall peerid a. peerid -> a -> TraceLabelPeer peerid a
TraceLabelPeer ConnectionId addrNTN
them (TraceSendRecv (PeerSharing addrNTN)
 -> TraceLabelPeer
      (ConnectionId addrNTN) (TraceSendRecv (PeerSharing addrNTN)))
-> Tracer
     m
     (TraceLabelPeer
        (ConnectionId addrNTN) (TraceSendRecv (PeerSharing addrNTN)))
-> Tracer m (TraceSendRecv (PeerSharing addrNTN))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  m
  (TraceLabelPeer
     (ConnectionId addrNTN) (TraceSendRecv (PeerSharing addrNTN)))
tPeerSharingTracer)
      (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PeerSharing addrNTN) e m bPS
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (PeerSharing addr) e m bPS
cPeerSharingCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
      ProtocolSizeLimits (PeerSharing addrNTN) bPS
forall addr. ProtocolSizeLimits (PeerSharing addr) bPS
blPeerSharing
      ProtocolTimeLimits (PeerSharing addrNTN)
forall peerAddress. ProtocolTimeLimits (PeerSharing peerAddress)
timeLimitsPeerSharing
      Channel m bPS
channel
      (Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
 -> m ((), Maybe bPS))
-> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
-> m ((), Maybe bPS)
forall a b. (a -> b) -> a -> b
$ PeerSharingServer addrNTN m
-> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
forall (m :: * -> *) peerAddress.
Monad m =>
PeerSharingServer peerAddress m
-> Server (PeerSharing peerAddress) 'NonPipelined 'StIdle m ()
peerSharingServerPeer
      (PeerSharingServer addrNTN m
 -> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ())
-> PeerSharingServer addrNTN m
-> Peer (PeerSharing addrNTN) 'AsServer 'NonPipelined 'StIdle m ()
forall a b. (a -> b) -> a -> b
$ NodeToNodeVersion
-> ConnectionId addrNTN -> PeerSharingServer addrNTN m
hPeerSharingServer NodeToNodeVersion
version ConnectionId addrNTN
them

  aLeiosNotifyClient ::
    NodeToNodeVersion ->
    ExpandedInitiatorContext addrNTN PeerTrustable m ->
    Channel m bLN ->
    m (NodeToNodeInitiatorResult, Maybe bLN)
  aLeiosNotifyClient :: ClientApp m addrNTN bLN NodeToNodeInitiatorResult
aLeiosNotifyClient
    NodeToNodeVersion
version
    ExpandedInitiatorContext
      { eicConnectionId :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ConnectionId addr
eicConnectionId = ConnectionId addrNTN
them
      , eicControlMessage :: forall addr extraFlags (m :: * -> *).
ExpandedInitiatorContext addr extraFlags m -> ControlMessageSTM m
eicControlMessage = ControlMessageSTM m
controlMessageSTM
      }
    Channel m bLN
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LeiosNotifyClient"
      ((), trailing) <-
        StrictTVar
  m
  (Map
     (ConnectionId addrNTN) (StrictTVar m (LeiosNotifyPeerState blk)))
-> ConnectionId addrNTN
-> (StrictTVar m (LeiosNotifyPeerState blk) -> m ((), Maybe bLN))
-> m ((), Maybe bLN)
forall (m :: * -> *) peer blk a.
(IOLike m, Ord peer, NoThunks (Header blk)) =>
StrictTVar m (Map peer (StrictTVar m (LeiosNotifyPeerState blk)))
-> peer -> (StrictTVar m (LeiosNotifyPeerState blk) -> m a) -> m a
withLeiosNotifyClientState (NodeKernel m addrNTN addrNTC blk
-> StrictTVar
     m
     (Map
        (ConnectionId addrNTN) (StrictTVar m (LeiosNotifyPeerState blk)))
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> StrictTVar
     m
     (Map
        (ConnectionId addrNTN) (StrictTVar m (LeiosNotifyPeerState blk)))
getLeiosNotifyClientStates NodeKernel m addrNTN addrNTC blk
kernel) ConnectionId addrNTN
them ((StrictTVar m (LeiosNotifyPeerState blk) -> m ((), Maybe bLN))
 -> m ((), Maybe bLN))
-> (StrictTVar m (LeiosNotifyPeerState blk) -> m ((), Maybe bLN))
-> m ((), Maybe bLN)
forall a b. (a -> b) -> a -> b
$ \StrictTVar m (LeiosNotifyPeerState blk)
stateVar ->
          Tracer
  m (TraceSendRecv (LeiosNotify LeiosPoint (Header blk) LeiosVote))
-> Codec (LeiosNotify LeiosPoint (Header blk) LeiosVote) e m bLN
-> ProtocolSizeLimits
     (LeiosNotify LeiosPoint (Header blk) LeiosVote) bLN
-> ProtocolTimeLimits
     (LeiosNotify LeiosPoint (Header blk) LeiosVote)
-> Channel m bLN
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
-> m ((), Maybe bLN)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits
            Tracer
  m (TraceSendRecv (LeiosNotify LeiosPoint (Header blk) LeiosVote))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
            (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (LeiosNotify LeiosPoint (Header blk) LeiosVote) e m bLN
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (LeiosNotify LeiosPoint (Header blk) LeiosVote) e m bLN
cLeiosNotifyCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
            ProtocolSizeLimits
  (LeiosNotify LeiosPoint (Header blk) LeiosVote) bLN
forall point announcement vote.
ProtocolSizeLimits (LeiosNotify point announcement vote) bLN
blLeiosNotify
            ProtocolTimeLimits (LeiosNotify LeiosPoint (Header blk) LeiosVote)
forall point announcement vote.
ProtocolTimeLimits (LeiosNotify point announcement vote)
timeLimitsLeiosNotify
            Channel m bLN
channel
            (NodeToNodeVersion
-> ControlMessageSTM m
-> ConnectionId addrNTN
-> StrictTVar m (LeiosNotifyPeerState blk)
-> LeiosNotifyClientPeerPipelined
     LeiosPoint (Header blk) LeiosVote m ()
hLeiosNotifyClient NodeToNodeVersion
version ControlMessageSTM m
controlMessageSTM ConnectionId addrNTN
them StrictTVar m (LeiosNotifyPeerState blk)
stateVar)
      return (NoInitiatorResult, trailing)

  aLeiosNotifyServer ::
    NodeToNodeVersion ->
    ResponderContext addrNTN ->
    Channel m bLN ->
    m ((), Maybe bLN)
  aLeiosNotifyServer :: ServerApp m addrNTN bLN ()
aLeiosNotifyServer
    NodeToNodeVersion
version
    ResponderContext{rcConnectionId :: forall addr. ResponderContext addr -> ConnectionId addr
rcConnectionId = ConnectionId addrNTN
them}
    Channel m bLN
channel = do
      String -> m ()
forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
"LeiosNotifyServer"
      Tracer
  m (TraceSendRecv (LeiosNotify LeiosPoint (Header blk) LeiosVote))
-> Codec (LeiosNotify LeiosPoint (Header blk) LeiosVote) e m bLN
-> ProtocolSizeLimits
     (LeiosNotify LeiosPoint (Header blk) LeiosVote) bLN
-> ProtocolTimeLimits
     (LeiosNotify LeiosPoint (Header blk) LeiosVote)
-> Channel m bLN
-> LeiosNotifyServerPeerLookahead
     LeiosPoint (Header blk) LeiosVote m
-> m ((), Maybe bLN)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerLookaheadFixedSender ps pr st m a
-> m (a, Maybe bytes)
runLookaheadFixedSenderPeerWithLimits
        Tracer
  m (TraceSendRecv (LeiosNotify LeiosPoint (Header blk) LeiosVote))
forall (m :: * -> *) a. Monad m => Tracer m a
nullTracer
        (Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
-> Codec (LeiosNotify LeiosPoint (Header blk) LeiosVote) e m bLN
forall blk addr e (m :: * -> *) bCS bSCS bBF bSBF bTX bPCD bPVD bKA
       bPS bLN.
Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bPVD bKA bPS bLN
-> Codec (LeiosNotify LeiosPoint (Header blk) LeiosVote) e m bLN
cLeiosNotifyCodec (NodeToNodeVersion
-> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bPVD bKA bPS bLN
mkCodecs NodeToNodeVersion
version))
        ProtocolSizeLimits
  (LeiosNotify LeiosPoint (Header blk) LeiosVote) bLN
forall point announcement vote.
ProtocolSizeLimits (LeiosNotify point announcement vote) bLN
blLeiosNotify
        ProtocolTimeLimits (LeiosNotify LeiosPoint (Header blk) LeiosVote)
forall point announcement vote.
ProtocolTimeLimits (LeiosNotify point announcement vote)
timeLimitsLeiosNotify
        Channel m bLN
channel
        (LeiosNotifyServerPeerLookahead LeiosPoint (Header blk) LeiosVote m
 -> m ((), Maybe bLN))
-> m (LeiosNotifyServerPeerLookahead
        LeiosPoint (Header blk) LeiosVote m)
-> m ((), Maybe bLN)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NodeToNodeVersion
-> ConnectionId addrNTN
-> m (LeiosNotifyServerPeerLookahead
        LeiosPoint (Header blk) LeiosVote m)
hLeiosNotifyServer NodeToNodeVersion
version ConnectionId addrNTN
them

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

-- | A projection from 'NetworkApplication' to a client-side
-- 'OuroborosApplication' for the node-to-node protocols.
--
-- Implementation note: network currently doesn't enable protocols conditional
-- on the protocol version, but it eventually may; this is why @_version@ is
-- currently unused.
initiator ::
  Set CardanoFeatureFlag ->
  MiniProtocolParameters ->
  NodeToNodeVersion ->
  NodeToNodeVersionData ->
  Apps m addr b b b b b b b b a c ->
  OuroborosBundleWithExpandedCtx 'Mux.InitiatorMode addr PeerTrustable b m a Void
initiator :: forall (m :: * -> *) addr b a c.
Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps m addr b b b b b b b b a c
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode addr PeerTrustable b m a Void
initiator Set CardanoFeatureFlag
featureFlags MiniProtocolParameters
miniProtocolParameters NodeToNodeVersion
version NodeToNodeVersionData
versionData Apps{ServerApp m addr b c
ClientApp m addr b a
aChainSyncClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bCS a
aChainSyncServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bCS b
aBlockFetchClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bBF a
aBlockFetchServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bBF b
aTxSubmission2Client :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bTX a
aTxSubmission2Server :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bTX b
aPerasCertDiffusionClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPCD a
aPerasCertDiffusionServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPCD b
aPerasVoteDiffusionClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPVD a
aPerasVoteDiffusionServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPVD b
aKeepAliveClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bKA a
aKeepAliveServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bKA b
aPeerSharingClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPS a
aPeerSharingServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPS b
aLeiosNotifyClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bLN a
aLeiosNotifyServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bLN b
aChainSyncClient :: ClientApp m addr b a
aChainSyncServer :: ServerApp m addr b c
aBlockFetchClient :: ClientApp m addr b a
aBlockFetchServer :: ServerApp m addr b c
aTxSubmission2Client :: ClientApp m addr b a
aTxSubmission2Server :: ServerApp m addr b c
aPerasCertDiffusionClient :: ClientApp m addr b a
aPerasCertDiffusionServer :: ServerApp m addr b c
aPerasVoteDiffusionClient :: ClientApp m addr b a
aPerasVoteDiffusionServer :: ServerApp m addr b c
aKeepAliveClient :: ClientApp m addr b a
aKeepAliveServer :: ServerApp m addr b c
aPeerSharingClient :: ClientApp m addr b a
aPeerSharingServer :: ServerApp m addr b c
aLeiosNotifyClient :: ClientApp m addr b a
aLeiosNotifyServer :: ServerApp m addr b c
..} =
  Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeProtocols
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> TemperatureBundle
     [MiniProtocol
        'InitiatorMode
        (ExpandedInitiatorContext addr PeerTrustable m)
        (ResponderContext addr)
        b
        m
        a
        Void]
forall (muxMode :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeProtocols
     muxMode initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundle muxMode initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols
    Set CardanoFeatureFlag
featureFlags
    MiniProtocolParameters
miniProtocolParameters
    -- TODO: currently consensus is using 'ConnectionId' for its 'peer' type.
    -- This is currently ok, as we might accept multiple connections from the
    -- same ip address, however this will change when we will switch to
    -- p2p-governor & connection-manager.  Then consensus can use peer's ip
    -- address & port number, rather than 'ConnectionId' (which is
    -- a quadruple uniquely determining a connection).
    ( NodeToNodeProtocols
        { chainSyncProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  Void
chainSyncProtocol =
            (MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
ctx -> ClientApp m addr b a
aChainSyncClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
ctx)))
        , blockFetchProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  Void
blockFetchProtocol =
            (MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
ctx -> ClientApp m addr b a
aBlockFetchClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
ctx)))
        , txSubmissionProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  Void
txSubmissionProtocol =
            (MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
ctx -> ClientApp m addr b a
aTxSubmission2Client NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
ctx)))
        , perasCertDiffusionProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  Void
perasCertDiffusionProtocol =
            (MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
ctx -> ClientApp m addr b a
aPerasCertDiffusionClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
ctx)))
        , perasVoteDiffusionProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  Void
perasVoteDiffusionProtocol =
            (MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
ctx -> ClientApp m addr b a
aPerasVoteDiffusionClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
ctx)))
        , keepAliveProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  Void
keepAliveProtocol =
            (MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
ctx -> ClientApp m addr b a
aKeepAliveClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
ctx)))
        , peerSharingProtocol :: RunMiniProtocol
  'InitiatorMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  Void
peerSharingProtocol =
            (MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
ctx -> ClientApp m addr b a
aPeerSharingClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
ctx)))
        }
    )
    NodeToNodeVersion
version
    NodeToNodeVersionData
versionData
    TemperatureBundle
  [MiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void]
-> TemperatureBundle
     [MiniProtocol
        'InitiatorMode
        (ExpandedInitiatorContext addr PeerTrustable m)
        (ResponderContext addr)
        b
        m
        a
        Void]
-> TemperatureBundle
     [MiniProtocol
        'InitiatorMode
        (ExpandedInitiatorContext addr PeerTrustable m)
        (ResponderContext addr)
        b
        m
        a
        Void]
forall a. Semigroup a => a -> a -> a
<> NodeToNodeVersion
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
-> TemperatureBundle
     [MiniProtocol
        'InitiatorMode
        (ExpandedInitiatorContext addr PeerTrustable m)
        (ResponderContext addr)
        b
        m
        a
        Void]
forall (mode :: Mode) addr b (m :: * -> *) a c.
NodeToNodeVersion
-> RunMiniProtocolWithExpandedCtx mode addr PeerTrustable b m a c
-> OuroborosBundleWithExpandedCtx mode addr PeerTrustable b m a c
leiosNotifyProtocols
      NodeToNodeVersion
version
      (MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> RunMiniProtocol
     'InitiatorMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     Void
forall initiatorCtx bytes (m :: * -> *) a responderCtx.
MiniProtocolCb initiatorCtx bytes m a
-> RunMiniProtocol
     'InitiatorMode initiatorCtx responderCtx bytes m a Void
InitiatorProtocolOnly ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
ctx -> ClientApp m addr b a
aLeiosNotifyClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
ctx)))

-- | A bi-directional network application.
--
-- Implementation note: network currently doesn't enable protocols conditional
-- on the protocol version, but it eventually may; this is why @_version@ is
-- currently unused.
initiatorAndResponder ::
  Set CardanoFeatureFlag ->
  MiniProtocolParameters ->
  NodeToNodeVersion ->
  NodeToNodeVersionData ->
  Apps m addr b b b b b b b b a c ->
  OuroborosBundleWithExpandedCtx 'Mux.InitiatorResponderMode addr PeerTrustable b m a c
initiatorAndResponder :: forall (m :: * -> *) addr b a c.
Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps m addr b b b b b b b b a c
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode addr PeerTrustable b m a c
initiatorAndResponder Set CardanoFeatureFlag
featureFlags MiniProtocolParameters
miniProtocolParameters NodeToNodeVersion
version NodeToNodeVersionData
versionData Apps{ServerApp m addr b c
ClientApp m addr b a
aChainSyncClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bCS a
aChainSyncServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bCS b
aBlockFetchClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bBF a
aBlockFetchServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bBF b
aTxSubmission2Client :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bTX a
aTxSubmission2Server :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bTX b
aPerasCertDiffusionClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPCD a
aPerasCertDiffusionServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPCD b
aPerasVoteDiffusionClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPVD a
aPerasVoteDiffusionServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPVD b
aKeepAliveClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bKA a
aKeepAliveServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bKA b
aPeerSharingClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bPS a
aPeerSharingServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bPS b
aLeiosNotifyClient :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ClientApp m addr bLN a
aLeiosNotifyServer :: forall (m :: * -> *) addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b.
Apps m addr bCS bBF bTX bPCD bPVD bKA bPS bLN a b
-> ServerApp m addr bLN b
aChainSyncClient :: ClientApp m addr b a
aChainSyncServer :: ServerApp m addr b c
aBlockFetchClient :: ClientApp m addr b a
aBlockFetchServer :: ServerApp m addr b c
aTxSubmission2Client :: ClientApp m addr b a
aTxSubmission2Server :: ServerApp m addr b c
aPerasCertDiffusionClient :: ClientApp m addr b a
aPerasCertDiffusionServer :: ServerApp m addr b c
aPerasVoteDiffusionClient :: ClientApp m addr b a
aPerasVoteDiffusionServer :: ServerApp m addr b c
aKeepAliveClient :: ClientApp m addr b a
aKeepAliveServer :: ServerApp m addr b c
aPeerSharingClient :: ClientApp m addr b a
aPeerSharingServer :: ServerApp m addr b c
aLeiosNotifyClient :: ClientApp m addr b a
aLeiosNotifyServer :: ServerApp m addr b c
..} =
  Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeProtocols
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> TemperatureBundle
     [MiniProtocol
        'InitiatorResponderMode
        (ExpandedInitiatorContext addr PeerTrustable m)
        (ResponderContext addr)
        b
        m
        a
        c]
forall (muxMode :: Mode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
Set CardanoFeatureFlag
-> MiniProtocolParameters
-> NodeToNodeProtocols
     muxMode initiatorCtx responderCtx bytes m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundle muxMode initiatorCtx responderCtx bytes m a b
nodeToNodeProtocols
    Set CardanoFeatureFlag
featureFlags
    MiniProtocolParameters
miniProtocolParameters
    ( NodeToNodeProtocols
        { chainSyncProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  c
chainSyncProtocol =
            ( MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
                ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx -> ClientApp m addr b a
aChainSyncClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx))
                ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aChainSyncServer NodeToNodeVersion
version ResponderContext addr
responderCtx))
            )
        , blockFetchProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  c
blockFetchProtocol =
            ( MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
                ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx -> ClientApp m addr b a
aBlockFetchClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx))
                ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aBlockFetchServer NodeToNodeVersion
version ResponderContext addr
responderCtx))
            )
        , txSubmissionProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  c
txSubmissionProtocol =
            ( MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
                ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx -> ClientApp m addr b a
aTxSubmission2Client NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx))
                ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aTxSubmission2Server NodeToNodeVersion
version ResponderContext addr
responderCtx))
            )
        , perasCertDiffusionProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  c
perasCertDiffusionProtocol =
            ( MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
                ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx -> ClientApp m addr b a
aPerasCertDiffusionClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx))
                ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aPerasCertDiffusionServer NodeToNodeVersion
version ResponderContext addr
responderCtx))
            )
        , perasVoteDiffusionProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  c
perasVoteDiffusionProtocol =
            ( MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
                ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx -> ClientApp m addr b a
aPerasVoteDiffusionClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx))
                ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aPerasVoteDiffusionServer NodeToNodeVersion
version ResponderContext addr
responderCtx))
            )
        , keepAliveProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  c
keepAliveProtocol =
            ( MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
                ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx -> ClientApp m addr b a
aKeepAliveClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx))
                ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aKeepAliveServer NodeToNodeVersion
version ResponderContext addr
responderCtx))
            )
        , peerSharingProtocol :: RunMiniProtocol
  'InitiatorResponderMode
  (ExpandedInitiatorContext addr PeerTrustable m)
  (ResponderContext addr)
  b
  m
  a
  c
peerSharingProtocol =
            ( MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
                ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx -> ClientApp m addr b a
aPeerSharingClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx))
                ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aPeerSharingServer NodeToNodeVersion
version ResponderContext addr
responderCtx))
            )
        }
    )
    NodeToNodeVersion
version
    NodeToNodeVersionData
versionData
    TemperatureBundle
  [MiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c]
-> TemperatureBundle
     [MiniProtocol
        'InitiatorResponderMode
        (ExpandedInitiatorContext addr PeerTrustable m)
        (ResponderContext addr)
        b
        m
        a
        c]
-> TemperatureBundle
     [MiniProtocol
        'InitiatorResponderMode
        (ExpandedInitiatorContext addr PeerTrustable m)
        (ResponderContext addr)
        b
        m
        a
        c]
forall a. Semigroup a => a -> a -> a
<> NodeToNodeVersion
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
-> TemperatureBundle
     [MiniProtocol
        'InitiatorResponderMode
        (ExpandedInitiatorContext addr PeerTrustable m)
        (ResponderContext addr)
        b
        m
        a
        c]
forall (mode :: Mode) addr b (m :: * -> *) a c.
NodeToNodeVersion
-> RunMiniProtocolWithExpandedCtx mode addr PeerTrustable b m a c
-> OuroborosBundleWithExpandedCtx mode addr PeerTrustable b m a c
leiosNotifyProtocols
      NodeToNodeVersion
version
      ( MiniProtocolCb
  (ExpandedInitiatorContext addr PeerTrustable m) b m a
-> MiniProtocolCb (ResponderContext addr) b m c
-> RunMiniProtocol
     'InitiatorResponderMode
     (ExpandedInitiatorContext addr PeerTrustable m)
     (ResponderContext addr)
     b
     m
     a
     c
forall initiatorCtx bytes (m :: * -> *) a responderCtx b.
MiniProtocolCb initiatorCtx bytes m a
-> MiniProtocolCb responderCtx bytes m b
-> RunMiniProtocol
     'InitiatorResponderMode initiatorCtx responderCtx bytes m a b
InitiatorAndResponderProtocol
          ((ExpandedInitiatorContext addr PeerTrustable m
 -> Channel m b -> m (a, Maybe b))
-> MiniProtocolCb
     (ExpandedInitiatorContext addr PeerTrustable m) b m a
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx -> ClientApp m addr b a
aLeiosNotifyClient NodeToNodeVersion
version ExpandedInitiatorContext addr PeerTrustable m
initiatorCtx))
          ((ResponderContext addr -> Channel m b -> m (c, Maybe b))
-> MiniProtocolCb (ResponderContext addr) b m c
forall ctx bytes (m :: * -> *) a.
(ctx -> Channel m bytes -> m (a, Maybe bytes))
-> MiniProtocolCb ctx bytes m a
MiniProtocolCb (\ResponderContext addr
responderCtx -> ServerApp m addr b c
aLeiosNotifyServer NodeToNodeVersion
version ResponderContext addr
responderCtx))
      )