{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

-- | Run the whole Node
--
-- Intended for qualified import.
--
module Ouroboros.Consensus.Node (
    run
  , runWith
    -- * Standard arguments
  , StdRunNodeArgs (..)
  , stdBfcSaltIO
  , stdGsmAntiThunderingHerdIO
  , stdKeepAliveRngIO
  , stdLowLevelRunNodeArgsIO
  , stdMkChainDbHasFS
  , stdRunDataDiffusion
  , stdVersionDataNTC
  , stdVersionDataNTN
  , stdWithCheckedDB
    -- ** P2P Switch
  , NetworkP2PMode (..)
    -- * Exposed by 'run' et al
  , ChainDB.RelativeMountPoint (..)
  , ChainDB.TraceEvent (..)
  , ChainDbArgs (..)
  , HardForkBlockchainTimeArgs (..)
  , LastShutDownWasClean (..)
  , LowLevelRunNodeArgs (..)
  , MempoolCapacityBytesOverride (..)
  , NodeDatabasePaths (..)
  , NodeKernel (..)
  , NodeKernelArgs (..)
  , ProtocolInfo (..)
  , RunNode
  , RunNodeArgs (..)
  , SnapshotPolicyArgs (..)
  , Tracers
  , Tracers' (..)
  , pattern DoDiskSnapshotChecksum
  , pattern NoDoDiskSnapshotChecksum
    -- * Internal helpers
  , mkNodeKernelArgs
  , nodeKernelArgsEnforceInvariants
  , openChainDB
  ) where

import           Cardano.Network.PeerSelection.Bootstrap
                     (UseBootstrapPeers (..))
import           Cardano.Network.Types (LedgerStateJudgement (..))
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.Serialise (DeserialiseFailure)
import qualified Control.Concurrent.Class.MonadSTM.Strict as StrictSTM
import           Control.DeepSeq (NFData)
import           Control.Exception (IOException)
import           Control.Monad (forM_, when)
import           Control.Monad.Class.MonadTime.SI (MonadTime)
import           Control.Monad.Class.MonadTimer.SI (MonadTimer)
import           Control.ResourceRegistry
import           Control.Tracer (Tracer, contramap, traceWith)
import           Data.ByteString.Lazy (ByteString)
import           Data.Functor.Contravariant (Predicate (..))
import           Data.Hashable (Hashable)
import           Data.Kind (Type)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromMaybe, isNothing)
import           Data.Time (NominalDiffTime)
import           Data.Typeable (Typeable)
import           Network.DNS.Resolver (Resolver)
import           Network.Mux.Types
import qualified Ouroboros.Cardano.Network.ArgumentsExtra as Cardano
import qualified Ouroboros.Cardano.Network.LedgerPeerConsensusInterface as Cardano
import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime hiding (getSystemStart)
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Config.SupportsNode
import           Ouroboros.Consensus.Ledger.Basics (ValuesMK)
import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck
                     (HistoricityCheck)
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck as HistoricityCheck
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck as InFutureCheck
import qualified Ouroboros.Consensus.Network.NodeToClient as NTC
import qualified Ouroboros.Consensus.Network.NodeToNode as NTN
import           Ouroboros.Consensus.Node.DbLock
import           Ouroboros.Consensus.Node.DbMarker
import           Ouroboros.Consensus.Node.ErrorPolicy
import           Ouroboros.Consensus.Node.ExitPolicy
import           Ouroboros.Consensus.Node.Genesis (GenesisConfig (..),
                     GenesisNodeKernelArgs, mkGenesisNodeKernelArgs)
import           Ouroboros.Consensus.Node.GSM (GsmNodeKernelArgs (..))
import qualified Ouroboros.Consensus.Node.GSM as GSM
import           Ouroboros.Consensus.Node.InitStorage
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.Node.Recovery
import           Ouroboros.Consensus.Node.RethrowPolicy
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Tracers
import           Ouroboros.Consensus.NodeKernel
import           Ouroboros.Consensus.Storage.ChainDB (ChainDB, ChainDbArgs,
                     TraceEvent)
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.Args as ChainDB
import           Ouroboros.Consensus.Storage.LedgerDB.Args
import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots
import           Ouroboros.Consensus.Util.Args
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.Orphans ()
import           Ouroboros.Consensus.Util.Time (secondsToNominalDiffTime)
import           Ouroboros.Network.BlockFetch (BlockFetchConfiguration (..),
                     FetchMode)
import qualified Ouroboros.Network.Diffusion as Diffusion
import qualified Ouroboros.Network.Diffusion.Common as Diffusion
import qualified Ouroboros.Network.Diffusion.Configuration as Diffusion
import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P
import qualified Ouroboros.Network.Diffusion.P2P as Diffusion.P2P
import           Ouroboros.Network.Magic
import           Ouroboros.Network.NodeToClient (ConnectionId, LocalAddress,
                     LocalSocket, NodeToClientVersionData (..), combineVersions,
                     simpleSingletonVersions)
import           Ouroboros.Network.NodeToNode (DiffusionMode (..),
                     ExceptionInHandler (..), MiniProtocolParameters,
                     NodeToNodeVersionData (..), RemoteAddress, Socket,
                     blockFetchPipeliningMax, defaultMiniProtocolParameters)
import           Ouroboros.Network.PeerSelection.Governor.Types
                     (PeerSelectionState, PublicPeerSelectionState)
import           Ouroboros.Network.PeerSelection.LedgerPeers
                     (LedgerPeersConsensusInterface (..), UseLedgerPeers (..))
import           Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics,
                     newPeerMetric, reportMetric)
import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
import           Ouroboros.Network.PeerSelection.PeerSharing.Codec
                     (decodeRemoteAddress, encodeRemoteAddress)
import           Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers
                     (TracePublicRootPeers)
import           Ouroboros.Network.RethrowPolicy
import qualified SafeWildCards
import           System.Exit (ExitCode (..))
import           System.FilePath ((</>))
import           System.FS.API (SomeHasFS (..))
import           System.FS.API.Types (MountPoint (..))
import           System.FS.IO (ioHasFS)
import           System.Random (StdGen, newStdGen, randomIO, split)

{-------------------------------------------------------------------------------
  The arguments to the Consensus Layer node functionality
-------------------------------------------------------------------------------}

-- How to add a new argument
--
-- 1) As a Consensus Layer maintainer, use your judgement to determine whether
-- the new argument belongs in 'RunNodeArgs' or 'LowLevelArgs'. Give it the type
-- that seems most " natural ", future-proof, and useful for the whole range of
-- invocations: our tests, our own benchmarks, deployment on @mainnet@, etc. The
-- major litmus test is: it only belongs in 'RunNodeArgs' if /every/ invocation
-- of our node code must specify it.
--
-- 2) If you add it to 'LowLevelArgs', you'll have type errors in
-- 'stdLowLevelRunNodeArgsIO'. To fix them, you'll need to either hard-code a
-- default value or else extend 'StdRunNodeArgs' with a new sufficient field.
--
-- 3) When extending either 'RunNodeArgs' or 'StdRunNodeArgs', the
-- @cardano-node@ will have to be updated, so consider the Node Team's
-- preferences when choosing the new field's type. As an oversimplification,
-- Consensus /owns/ 'RunNodeArgs' while Node /owns/ 'StdRunNodeArgs', but it's
-- always worth spending some effort to try to find a type that satisfies both
-- teams.

-- | Arguments expected from any invocation of 'runWith', whether by deployed
-- code, tests, etc.
type RunNodeArgs ::
     (Type -> Type)
  -> Type
  -> Type
  -> Type
  -> Diffusion.P2P
  -> Type
data RunNodeArgs m addrNTN addrNTC blk p2p = RunNodeArgs {
      -- | Consensus tracers
      forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceConsensus :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk

      -- | Protocol tracers for node-to-node communication
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m addrNTN blk DeserialiseFailure
rnTraceNTN :: NTN.Tracers m addrNTN blk DeserialiseFailure

      -- | Protocol tracers for node-to-client communication
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
rnTraceNTC :: NTC.Tracers m (ConnectionId addrNTC) blk DeserialiseFailure

      -- | Protocol info
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> ProtocolInfo blk
rnProtocolInfo :: ProtocolInfo blk

      -- | Hook called after the initialisation of the 'NodeKernel'
      --
      -- Called on the 'NodeKernel' after creating it, but before the network
      -- layer is initialised.
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> ResourceRegistry m
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> m ()
rnNodeKernelHook :: ResourceRegistry m
                       -> NodeKernel m addrNTN (ConnectionId addrNTC) blk
                       -> m ()

      -- | Network P2P Mode switch
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> NetworkP2PMode p2p
rnEnableP2P :: NetworkP2PMode p2p

      -- | Network PeerSharing miniprotocol willingness flag
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> PeerSharing
rnPeerSharing :: PeerSharing

    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> STM m UseBootstrapPeers
rnGetUseBootstrapPeers :: STM m UseBootstrapPeers

    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> GenesisConfig
rnGenesisConfig :: GenesisConfig
    }


-- | Arguments that usually only tests /directly/ specify.
--
-- A non-testing invocation probably wouldn't explicitly provide these values to
-- 'runWith'. The @cardano-node@, for example, instead calls the 'run'
-- abbreviation, which uses 'stdLowLevelRunNodeArgsIO' to indirectly specify
-- these low-level values from the higher-level 'StdRunNodeArgs'.
type LowLevelRunNodeArgs ::
     (Type -> Type)
  -> Type
  -> Type
  -> Type
  -> Diffusion.P2P
  -> Type
  -> Type
data LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI =
   LowLevelRunNodeArgs {

      -- | An action that will receive a marker indicating whether the previous
      -- shutdown was considered clean and a wrapper for installing a handler to
      -- create a clean file on exit if needed. See
      -- 'Ouroboros.Consensus.Node.Recovery.runWithCheckedDB'.
      forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> forall a.
   (LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
   -> m a
llrnWithCheckedDB :: forall a. (  LastShutDownWasClean
                                     -> (ChainDB m blk -> m a -> m a)
                                     -> m a)
                        -> m a

      -- | The " static " ChainDB arguments
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Incomplete ChainDbArgs m blk
llrnChainDbArgsDefaults :: Incomplete ChainDbArgs m blk

      -- | File-system on which the directory for the ImmutableDB will
      -- be created.
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> RelativeMountPoint -> SomeHasFS m
llrnMkImmutableHasFS :: ChainDB.RelativeMountPoint -> SomeHasFS m

      -- | File-system on which the directories for databases other than the ImmutableDB will
      -- be created.
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> RelativeMountPoint -> SomeHasFS m
llrnMkVolatileHasFS :: ChainDB.RelativeMountPoint -> SomeHasFS m

      -- | Customise the 'ChainDbArgs'. 'StdRunNodeArgs' will use this field to
      -- set various options that are exposed in @cardano-node@ configuration
      -- files.
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
llrnCustomiseChainDbArgs ::
           Complete ChainDbArgs m blk
        -> Complete ChainDbArgs m blk

      -- | Customise the 'NodeArgs'
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs ::
           NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
        -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk

      -- | Ie 'bfcSalt'
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> Int
llrnBfcSalt :: Int

      -- | Ie 'gsmAntiThunderingHerd'
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> StdGen
llrnGsmAntiThunderingHerd :: StdGen

      -- | Ie 'keepAliveRng'
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> StdGen
llrnKeepAliveRng :: StdGen

      -- | Customise the 'HardForkBlockchainTimeArgs'
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
llrnCustomiseHardForkBlockchainTimeArgs ::
           HardForkBlockchainTimeArgs m blk
        -> HardForkBlockchainTimeArgs m blk

      -- | See 'NTN.ChainSyncTimeout'
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> m ChainSyncTimeout
llrnChainSyncTimeout :: m NTN.ChainSyncTimeout

    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> GenesisConfig
llrnGenesisConfig :: GenesisConfig

      -- | How to run the data diffusion applications
      --
      -- 'run' will not return before this does.
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> Applications
     addrNTN
     NodeToNodeVersion
     NodeToNodeVersionData
     addrNTC
     NodeToClientVersion
     NodeToClientVersionData
     extraAPI
     m
     NodeToNodeInitiatorResult
-> ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult
-> m ()
llrnRunDataDiffusion ::
           NodeKernel m addrNTN (ConnectionId addrNTC) blk
        -> Diffusion.Applications
             addrNTN NodeToNodeVersion   NodeToNodeVersionData
             addrNTC NodeToClientVersion NodeToClientVersionData
             extraAPI m NodeToNodeInitiatorResult
        -> Diffusion.ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult
        -> m ()

    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeToClientVersionData
llrnVersionDataNTC :: NodeToClientVersionData

    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeToNodeVersionData
llrnVersionDataNTN :: NodeToNodeVersionData

      -- | node-to-node protocol versions to run.
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnNodeToNodeVersions :: Map NodeToNodeVersion (BlockNodeToNodeVersion blk)

      -- | node-to-client protocol versions to run.
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
llrnNodeToClientVersions :: Map NodeToClientVersion (BlockNodeToClientVersion blk)

      -- | If the volatile tip is older than this, then the node will exit the
      -- @CaughtUp@ state.
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NominalDiffTime
llrnMaxCaughtUpAge :: NominalDiffTime

      -- | Maximum clock skew
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> ClockSkew
llrnMaxClockSkew :: InFutureCheck.ClockSkew

    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> StrictTVar m (PublicPeerSelectionState addrNTN)
llrnPublicPeerSelectionStateVar :: StrictSTM.StrictTVar m (PublicPeerSelectionState addrNTN)

      -- | The flavor arguments
    , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Complete LedgerDbFlavorArgs m
llrnLdbFlavorArgs :: Complete LedgerDbFlavorArgs m
    }

data NodeDatabasePaths =
    OnePathForAllDbs
      FilePath -- ^ Databases will be stored under this path, such that given a
               -- path @/foo@, databases will be in @/foo/{immutable,volatile,...}@.
  | MultipleDbPaths
      FilePath -- ^ Immutable path, usually pointing to a non-necessarily
               -- performant volume. ImmutableDB will be stored under this path,
               -- so given @/foo@, the ImmutableDB will be in @/foo/immutable@.
      FilePath -- ^ Non-immutable (volatile data) path, usually pointing to a
               -- performant volume. Databases other than the ImmutableDB will
               -- be stored under this path, so given @/bar@, it will contain
               -- @/bar/{volatile,ledger,...}@.

immutableDbPath :: NodeDatabasePaths -> FilePath
immutableDbPath :: NodeDatabasePaths -> FilePath
immutableDbPath (OnePathForAllDbs FilePath
f)    = FilePath
f
immutableDbPath (MultipleDbPaths FilePath
imm FilePath
_) = FilePath
imm

nonImmutableDbPath :: NodeDatabasePaths -> FilePath
nonImmutableDbPath :: NodeDatabasePaths -> FilePath
nonImmutableDbPath (OnePathForAllDbs FilePath
f)    = FilePath
f
nonImmutableDbPath (MultipleDbPaths FilePath
_ FilePath
vol) = FilePath
vol

-- | Higher-level arguments that can determine the 'LowLevelRunNodeArgs' under
-- some usual assumptions for realistic use cases such as in @cardano-node@.
--
-- See 'stdLowLevelRunNodeArgsIO'.
data StdRunNodeArgs m blk (p2p :: Diffusion.P2P) extraArgs extraState extraDebugState extraActions extraAPI extraPeers extraFlags extraChurnArgs extraCounters exception = StdRunNodeArgs
  { forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Maybe Word
srnBfcMaxConcurrencyBulkSync    :: Maybe Word
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Maybe Word
srnBfcMaxConcurrencyDeadline    :: Maybe Word
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Bool
srnChainDbValidateOverride      :: Bool
    -- ^ If @True@, validate the ChainDB on init no matter what
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> NodeDatabasePaths
srnDatabasePath                 :: NodeDatabasePaths
    -- ^ Location of the DBs
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments           :: Diffusion.Arguments
                                         IO
                                         Socket      RemoteAddress
                                         LocalSocket LocalAddress
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> P2PDecision p2p (Tracer IO TracePublicRootPeers) ()
-> P2PDecision p2p (STM IO FetchMode) ()
-> P2PDecision p2p extraAPI ()
-> ArgumentsExtra
     p2p
     extraArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
srnDiffusionArgumentsExtra      :: Diffusion.P2PDecision p2p (Tracer IO TracePublicRootPeers) ()
                                    -> Diffusion.P2PDecision p2p (STM IO FetchMode) ()
                                    -> Diffusion.P2PDecision p2p extraAPI ()
                                    -> Diffusion.ArgumentsExtra p2p
                                         extraArgs extraState extraDebugState
                                         extraFlags extraPeers extraAPI
                                         extraChurnArgs extraCounters
                                         exception RemoteAddress LocalAddress
                                         Resolver IOException IO
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionTracers             :: Diffusion.Tracers
                                         RemoteAddress  NodeToNodeVersion
                                         LocalAddress   NodeToClientVersion
                                         IO
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> ExtraTracers
     p2p
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     IO
srnDiffusionTracersExtra        :: Diffusion.ExtraTracers p2p extraState extraDebugState extraFlags extraPeers extraCounters IO
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> forall (mode :: Mode) x y.
   ExtraTracers
     p2p
     extraState
     DebugPeerSelectionState
     extraFlags
     extraPeers
     extraCounters
     IO
   -> STM IO UseLedgerPeers
   -> PeerSharing
   -> STM IO UseBootstrapPeers
   -> STM IO LedgerStateJudgement
   -> NodeToNodeConnectionManager
        mode
        Socket
        RemoteAddress
        NodeToNodeVersionData
        NodeToNodeVersion
        IO
        x
        y
   -> StrictTVar
        IO
        (PeerSelectionState
           extraState
           extraFlags
           extraPeers
           RemoteAddress
           (NodeToNodePeerConnectionHandle
              mode RemoteAddress NodeToNodeVersionData IO x y))
   -> PeerMetrics IO RemoteAddress
   -> IO ()
srnSigUSR1SignalHandler         :: ( forall (mode :: Mode) x y.
                                          Diffusion.ExtraTracers p2p
                                                                 extraState
                                                                 Cardano.DebugPeerSelectionState
                                                                 extraFlags extraPeers extraCounters
                                                                 IO
                                       -> STM IO UseLedgerPeers
                                       -> PeerSharing
                                       -> STM IO UseBootstrapPeers
                                       -> STM IO LedgerStateJudgement
                                       -> Diffusion.P2P.NodeToNodeConnectionManager mode Socket
                                            RemoteAddress NodeToNodeVersionData
                                            NodeToNodeVersion IO x y
                                       -> StrictSTM.StrictTVar IO
                                            (PeerSelectionState extraState extraFlags extraPeers
                                                                RemoteAddress
                                                                (Diffusion.P2P.NodeToNodePeerConnectionHandle
                                                                    mode RemoteAddress
                                                                    NodeToNodeVersionData IO x y))
                                       -> PeerMetrics IO RemoteAddress
                                       -> IO ())
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Bool
srnEnableInDevelopmentVersions  :: Bool
    -- ^ If @False@, then the node will limit the negotiated NTN and NTC
    -- versions to the latest " official " release (as chosen by Network and
    -- Consensus Team, with input from Node Team)
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Tracer m (TraceEvent blk)
srnTraceChainDB                 :: Tracer m (ChainDB.TraceEvent blk)
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Maybe MempoolCapacityBytesOverride
srnMaybeMempoolCapacityOverride :: Maybe MempoolCapacityBytesOverride
    -- ^ Determine whether to use the system default mempool capacity or explicitly set
    -- capacity of the mempool.
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Maybe (m ChainSyncTimeout)
srnChainSyncTimeout             :: Maybe (m NTN.ChainSyncTimeout)
    -- ^ A custom timeout for ChainSync.

    -- Ad hoc values to replace default ChainDB configurations
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> SnapshotPolicyArgs
srnSnapshotPolicyArgs           :: SnapshotPolicyArgs
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> QueryBatchSize
srnQueryBatchSize               :: QueryBatchSize
  , forall (m :: * -> *) blk (p2p :: P2P) extraArgs extraState
       extraDebugState extraActions extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception.
StdRunNodeArgs
  m
  blk
  p2p
  extraArgs
  extraState
  extraDebugState
  extraActions
  extraAPI
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
-> Complete LedgerDbFlavorArgs m
srnLdbFlavorArgs                :: Complete LedgerDbFlavorArgs m
  }

{-------------------------------------------------------------------------------
  Entrypoints to the Consensus Layer node functionality
-------------------------------------------------------------------------------}

-- | P2P Switch
--
data NetworkP2PMode (p2p :: Diffusion.P2P) where
    EnabledP2PMode  :: NetworkP2PMode 'Diffusion.P2P
    DisabledP2PMode :: NetworkP2PMode 'Diffusion.NonP2P

deriving instance Eq   (NetworkP2PMode p2p)
deriving instance Show (NetworkP2PMode p2p)

pure []

-- | Combination of 'runWith' and 'stdLowLevelRunArgsIO'
run :: forall blk p2p extraState extraActions extraPeers extraFlags extraChurnArgs extraCounters exception.
    ( RunNode blk
     , Monoid extraPeers
     , Eq extraCounters
     , Eq extraFlags
     , Exception exception
     )
  => RunNodeArgs IO RemoteAddress LocalAddress blk p2p
  -> StdRunNodeArgs IO blk p2p (Cardano.ExtraArguments IO) extraState Cardano.DebugPeerSelectionState extraActions (Cardano.LedgerPeersConsensusInterface IO) extraPeers extraFlags extraChurnArgs extraCounters exception
  -> IO ()
run :: forall blk (p2p :: P2P) extraState extraActions extraPeers
       extraFlags extraChurnArgs extraCounters exception.
(RunNode blk, Monoid extraPeers, Eq extraCounters, Eq extraFlags,
 Exception exception) =>
RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> StdRunNodeArgs
     IO
     blk
     p2p
     (ExtraArguments IO)
     extraState
     DebugPeerSelectionState
     extraActions
     (LedgerPeersConsensusInterface IO)
     extraPeers
     extraFlags
     extraChurnArgs
     extraCounters
     exception
-> IO ()
run RunNodeArgs IO RemoteAddress LocalAddress blk p2p
args StdRunNodeArgs
  IO
  blk
  p2p
  (ExtraArguments IO)
  extraState
  DebugPeerSelectionState
  extraActions
  (LedgerPeersConsensusInterface IO)
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
stdArgs =
      RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> StdRunNodeArgs
     IO
     blk
     p2p
     (ExtraArguments IO)
     extraState
     DebugPeerSelectionState
     extraActions
     (LedgerPeersConsensusInterface IO)
     extraPeers
     extraFlags
     extraChurnArgs
     extraCounters
     exception
-> IO
     (LowLevelRunNodeArgs
        IO
        RemoteAddress
        LocalAddress
        blk
        p2p
        (LedgerPeersConsensusInterface IO))
forall blk (p2p :: P2P) extraState extraActions extraPeers
       extraFlags extraChurnArgs extraCounters exception.
(RunNode blk, Monoid extraPeers, Eq extraCounters, Eq extraFlags,
 Exception exception) =>
RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> StdRunNodeArgs
     IO
     blk
     p2p
     (ExtraArguments IO)
     extraState
     DebugPeerSelectionState
     extraActions
     (LedgerPeersConsensusInterface IO)
     extraPeers
     extraFlags
     extraChurnArgs
     extraCounters
     exception
-> IO
     (LowLevelRunNodeArgs
        IO
        RemoteAddress
        LocalAddress
        blk
        p2p
        (LedgerPeersConsensusInterface IO))
stdLowLevelRunNodeArgsIO RunNodeArgs IO RemoteAddress LocalAddress blk p2p
args StdRunNodeArgs
  IO
  blk
  p2p
  (ExtraArguments IO)
  extraState
  DebugPeerSelectionState
  extraActions
  (LedgerPeersConsensusInterface IO)
  extraPeers
  extraFlags
  extraChurnArgs
  extraCounters
  exception
stdArgs
  IO
  (LowLevelRunNodeArgs
     IO
     RemoteAddress
     LocalAddress
     blk
     p2p
     (LedgerPeersConsensusInterface IO))
-> (LowLevelRunNodeArgs
      IO
      RemoteAddress
      LocalAddress
      blk
      p2p
      (LedgerPeersConsensusInterface IO)
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> (NodeToNodeVersion -> RemoteAddress -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s RemoteAddress)
-> LowLevelRunNodeArgs
     IO
     RemoteAddress
     LocalAddress
     blk
     p2p
     (LedgerPeersConsensusInterface IO)
-> IO ()
forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
(RunNode blk, IOLike m, Hashable addrNTN, NetworkIO m,
 NetworkAddr addrNTN) =>
RunNodeArgs m addrNTN addrNTC blk p2p
-> (NodeToNodeVersion -> addrNTN -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addrNTN)
-> LowLevelRunNodeArgs
     m addrNTN addrNTC blk p2p (LedgerPeersConsensusInterface m)
-> m ()
runWith RunNodeArgs IO RemoteAddress LocalAddress blk p2p
args NodeToNodeVersion -> RemoteAddress -> Encoding
encodeRemoteAddress NodeToNodeVersion -> Decoder s RemoteAddress
NodeToNodeVersion -> forall s. Decoder s RemoteAddress
forall s. NodeToNodeVersion -> Decoder s RemoteAddress
decodeRemoteAddress

-- | Extra constraints used by `ouroboros-network`.
--
type NetworkIO m = (
        MonadTime m,
        MonadTimer m,
        MonadLabelledSTM m
      )

-- | Extra constraints used by `ouroboros-network`.
type NetworkAddr addr = (
      Ord addr,
      Typeable addr,
      NoThunks addr,
      NFData addr
    )

-- | Start a node.
--
-- This opens the 'ChainDB', sets up the 'NodeKernel' and initialises the
-- network layer.
--
-- This function runs forever unless an exception is thrown.
runWith :: forall m addrNTN addrNTC blk p2p.
     ( RunNode blk
     , IOLike m
     , Hashable addrNTN -- the constraint comes from `initNodeKernel`
     , NetworkIO m
     , NetworkAddr addrNTN
     )
  => RunNodeArgs m addrNTN addrNTC blk p2p
  -> (NodeToNodeVersion -> addrNTN -> CBOR.Encoding)
  -> (NodeToNodeVersion -> forall s . CBOR.Decoder s addrNTN)
  -> LowLevelRunNodeArgs m addrNTN addrNTC blk p2p (Cardano.LedgerPeersConsensusInterface m)
  -> m ()
runWith :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
(RunNode blk, IOLike m, Hashable addrNTN, NetworkIO m,
 NetworkAddr addrNTN) =>
RunNodeArgs m addrNTN addrNTC blk p2p
-> (NodeToNodeVersion -> addrNTN -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addrNTN)
-> LowLevelRunNodeArgs
     m addrNTN addrNTC blk p2p (LedgerPeersConsensusInterface m)
-> m ()
runWith RunNodeArgs{STM m UseBootstrapPeers
ProtocolInfo blk
PeerSharing
GenesisConfig
Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
Tracers m addrNTN blk DeserialiseFailure
Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
NetworkP2PMode p2p
ResourceRegistry m
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk -> m ()
rnTraceConsensus :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceNTN :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m addrNTN blk DeserialiseFailure
rnTraceNTC :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
rnProtocolInfo :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> ProtocolInfo blk
rnNodeKernelHook :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> ResourceRegistry m
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> m ()
rnEnableP2P :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> NetworkP2PMode p2p
rnPeerSharing :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> PeerSharing
rnGetUseBootstrapPeers :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> STM m UseBootstrapPeers
rnGenesisConfig :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> GenesisConfig
rnTraceConsensus :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceNTN :: Tracers m addrNTN blk DeserialiseFailure
rnTraceNTC :: Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
rnProtocolInfo :: ProtocolInfo blk
rnNodeKernelHook :: ResourceRegistry m
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk -> m ()
rnEnableP2P :: NetworkP2PMode p2p
rnPeerSharing :: PeerSharing
rnGetUseBootstrapPeers :: STM m UseBootstrapPeers
rnGenesisConfig :: GenesisConfig
..} NodeToNodeVersion -> addrNTN -> Encoding
encAddrNtN NodeToNodeVersion -> forall s. Decoder s addrNTN
decAddrNtN LowLevelRunNodeArgs{m ChainSyncTimeout
Int
Map NodeToClientVersion (BlockNodeToClientVersion blk)
Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
StdGen
NominalDiffTime
ClockSkew
Complete LedgerDbFlavorArgs m
Incomplete ChainDbArgs m blk
NodeToClientVersionData
NodeToNodeVersionData
StrictTVar m (PublicPeerSelectionState addrNTN)
GenesisConfig
HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
RelativeMountPoint -> SomeHasFS m
Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> Applications
     addrNTN
     NodeToNodeVersion
     NodeToNodeVersionData
     addrNTC
     NodeToClientVersion
     NodeToClientVersionData
     (LedgerPeersConsensusInterface m)
     m
     NodeToNodeInitiatorResult
-> ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult
-> m ()
forall a.
(LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
-> m a
llrnWithCheckedDB :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> forall a.
   (LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
   -> m a
llrnChainDbArgsDefaults :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Incomplete ChainDbArgs m blk
llrnMkImmutableHasFS :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> RelativeMountPoint -> SomeHasFS m
llrnMkVolatileHasFS :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> RelativeMountPoint -> SomeHasFS m
llrnCustomiseChainDbArgs :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
llrnCustomiseNodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
llrnBfcSalt :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> Int
llrnGsmAntiThunderingHerd :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> StdGen
llrnKeepAliveRng :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> StdGen
llrnCustomiseHardForkBlockchainTimeArgs :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
llrnChainSyncTimeout :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> m ChainSyncTimeout
llrnGenesisConfig :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> GenesisConfig
llrnRunDataDiffusion :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> Applications
     addrNTN
     NodeToNodeVersion
     NodeToNodeVersionData
     addrNTC
     NodeToClientVersion
     NodeToClientVersionData
     extraAPI
     m
     NodeToNodeInitiatorResult
-> ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult
-> m ()
llrnVersionDataNTC :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeToClientVersionData
llrnVersionDataNTN :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeToNodeVersionData
llrnNodeToNodeVersions :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnNodeToClientVersions :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
llrnMaxCaughtUpAge :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NominalDiffTime
llrnMaxClockSkew :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> ClockSkew
llrnPublicPeerSelectionStateVar :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> StrictTVar m (PublicPeerSelectionState addrNTN)
llrnLdbFlavorArgs :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Complete LedgerDbFlavorArgs m
llrnWithCheckedDB :: forall a.
(LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
-> m a
llrnChainDbArgsDefaults :: Incomplete ChainDbArgs m blk
llrnMkImmutableHasFS :: RelativeMountPoint -> SomeHasFS m
llrnMkVolatileHasFS :: RelativeMountPoint -> SomeHasFS m
llrnCustomiseChainDbArgs :: Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
llrnCustomiseNodeKernelArgs :: NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
llrnBfcSalt :: Int
llrnGsmAntiThunderingHerd :: StdGen
llrnKeepAliveRng :: StdGen
llrnCustomiseHardForkBlockchainTimeArgs :: HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
llrnChainSyncTimeout :: m ChainSyncTimeout
llrnGenesisConfig :: GenesisConfig
llrnRunDataDiffusion :: NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> Applications
     addrNTN
     NodeToNodeVersion
     NodeToNodeVersionData
     addrNTC
     NodeToClientVersion
     NodeToClientVersionData
     (LedgerPeersConsensusInterface m)
     m
     NodeToNodeInitiatorResult
-> ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult
-> m ()
llrnVersionDataNTC :: NodeToClientVersionData
llrnVersionDataNTN :: NodeToNodeVersionData
llrnNodeToNodeVersions :: Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnNodeToClientVersions :: Map NodeToClientVersion (BlockNodeToClientVersion blk)
llrnMaxCaughtUpAge :: NominalDiffTime
llrnMaxClockSkew :: ClockSkew
llrnPublicPeerSelectionStateVar :: StrictTVar m (PublicPeerSelectionState addrNTN)
llrnLdbFlavorArgs :: Complete LedgerDbFlavorArgs m
..} =

    (LastShutDownWasClean -> (ChainDB m blk -> m () -> m ()) -> m ())
-> m ()
forall a.
(LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
-> m a
llrnWithCheckedDB ((LastShutDownWasClean -> (ChainDB m blk -> m () -> m ()) -> m ())
 -> m ())
-> (LastShutDownWasClean
    -> (ChainDB m blk -> m () -> m ()) -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \(LastShutDownWasClean Bool
lastShutDownWasClean) ChainDB m blk -> m () -> m ()
continueWithCleanChainDB ->
    (ResourceRegistry m -> m ()) -> m ()
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
(ResourceRegistry m -> m a) -> m a
withRegistry ((ResourceRegistry m -> m ()) -> m ())
-> (ResourceRegistry m -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ResourceRegistry m
registry ->
      (SomeException -> Maybe SomeException)
-> (SomeException -> m ()) -> m () -> m ()
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust
             -- Ignore exception thrown in connection handlers and diffusion.
             -- Also ignore 'ExitSuccess'.
             (Predicate SomeException -> SomeException -> Maybe SomeException
forall a. Predicate a -> a -> Maybe a
runPredicate (Predicate SomeException -> SomeException -> Maybe SomeException)
-> Predicate SomeException -> SomeException -> Maybe SomeException
forall a b. (a -> b) -> a -> b
$
                   (SomeException -> Bool) -> Predicate SomeException
forall a. (a -> Bool) -> Predicate a
Predicate ( \SomeException
err ->
                     case forall e. Exception e => SomeException -> Maybe e
fromException @ExceptionInLinkedThread SomeException
err of
                       Just (ExceptionInLinkedThread FilePath
_ SomeException
err')
                         -> (Maybe ExitCode -> Maybe ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
ExitSuccess) (Maybe ExitCode -> Bool) -> Maybe ExitCode -> Bool
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err'
                       Maybe ExceptionInLinkedThread
Nothing -> Bool
False)
                Predicate SomeException
-> Predicate SomeException -> Predicate SomeException
forall a. Semigroup a => a -> a -> a
<> (SomeException -> Bool) -> Predicate SomeException
forall a. (a -> Bool) -> Predicate a
Predicate (Maybe ExceptionInHandler -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe ExceptionInHandler -> Bool)
-> (SomeException -> Maybe ExceptionInHandler)
-> SomeException
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => SomeException -> Maybe e
fromException @ExceptionInHandler)
                Predicate SomeException
-> Predicate SomeException -> Predicate SomeException
forall a. Semigroup a => a -> a -> a
<> (SomeException -> Bool) -> Predicate SomeException
forall a. (a -> Bool) -> Predicate a
Predicate (Maybe Failure -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Failure -> Bool)
-> (SomeException -> Maybe Failure) -> SomeException -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => SomeException -> Maybe e
fromException @Diffusion.Failure)
              )
              (\SomeException
err -> Tracer m SomeException -> SomeException -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> Tracer m SomeException
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f SomeException
consensusErrorTracer Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceConsensus) SomeException
err
                    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
err
              ) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        let systemStart :: SystemStart
            systemStart :: SystemStart
systemStart = BlockConfig blk -> SystemStart
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> SystemStart
getSystemStart (TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock TopLevelConfig blk
cfg)

            systemTime :: SystemTime m
            systemTime :: SystemTime m
systemTime = SystemStart
-> Tracer m (TraceBlockchainTimeEvent UTCTime) -> SystemTime m
forall (m :: * -> *).
(MonadTime m, MonadDelay m) =>
SystemStart
-> Tracer m (TraceBlockchainTimeEvent UTCTime) -> SystemTime m
defaultSystemTime
                           SystemStart
systemStart
                           (Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> Tracer m (TraceBlockchainTimeEvent UTCTime)
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f
-> f (TraceBlockchainTimeEvent UTCTime)
blockchainTimeTracer Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceConsensus)

        (genesisArgs, setLoEinChainDbArgs) <-
          GenesisConfig
-> m (GenesisNodeKernelArgs m blk,
      Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
forall (m :: * -> *) blk.
(IOLike m, GetHeader blk) =>
GenesisConfig
-> m (GenesisNodeKernelArgs m blk,
      Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
mkGenesisNodeKernelArgs GenesisConfig
llrnGenesisConfig

        let maybeValidateAll
              | Bool
lastShutDownWasClean
              = Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
forall a. a -> a
id
              | Bool
otherwise
                -- When the last shutdown was not clean, validate the complete
                -- ChainDB to detect and recover from any disk corruption.
              = Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.ensureValidateAll

        forM_ (sanityCheckConfig cfg) $ \SanityCheckIssue
issue ->
          Tracer m SanityCheckIssue -> SanityCheckIssue -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> Tracer m SanityCheckIssue
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f SanityCheckIssue
consensusSanityCheckTracer Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceConsensus) SanityCheckIssue
issue

        (chainDB, finalArgs) <- openChainDB
                     registry
                     cfg
                     initLedger
                     llrnMkImmutableHasFS
                     llrnMkVolatileHasFS
                     llrnLdbFlavorArgs
                     llrnChainDbArgsDefaults
                     (  setLoEinChainDbArgs
                      . maybeValidateAll
                      . llrnCustomiseChainDbArgs
                     )

        continueWithCleanChainDB chainDB $ do
          btime <-
            hardForkBlockchainTime $
            llrnCustomiseHardForkBlockchainTimeArgs $
            HardForkBlockchainTimeArgs
              { hfbtBackoffDelay   = pure $ BackoffDelay 60
              , hfbtGetLedgerState =
                  ledgerState <$> ChainDB.getCurrentLedger chainDB
              , hfbtLedgerConfig   = configLedger cfg
              , hfbtRegistry       = registry
              , hfbtSystemTime     = systemTime
              , hfbtTracer         =
                  contramap (fmap (fromRelativeTime systemStart))
                    (blockchainTimeTracer rnTraceConsensus)
              , hfbtMaxClockRewind = secondsToNominalDiffTime 20
              }

          nodeKernelArgs <- do
              durationUntilTooOld <- GSM.realDurationUntilTooOld
                (configLedger cfg)
                (ledgerState <$> ChainDB.getCurrentLedger chainDB)
                llrnMaxCaughtUpAge
                systemTime
              let gsmMarkerFileView =
                    case ChainDbSpecificArgs Identity m blk -> HKD Identity (SomeHasFS m)
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbSpecificArgs f m blk -> HKD f (SomeHasFS m)
ChainDB.cdbsHasFSGsmDB (ChainDbSpecificArgs Identity m blk -> HKD Identity (SomeHasFS m))
-> ChainDbSpecificArgs Identity m blk -> HKD Identity (SomeHasFS m)
forall a b. (a -> b) -> a -> b
$ Complete ChainDbArgs m blk -> ChainDbSpecificArgs Identity m blk
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbArgs f m blk -> ChainDbSpecificArgs f m blk
ChainDB.cdbsArgs Complete ChainDbArgs m blk
finalArgs of
                        SomeHasFS HasFS m h
x -> ChainDB m blk -> HasFS m h -> MarkerFileView m
forall (m :: * -> *) blk h.
MonadThrow m =>
ChainDB m blk -> HasFS m h -> MarkerFileView m
GSM.realMarkerFileView ChainDB m blk
chainDB HasFS m h
x
                  historicityCheck m GsmState
getGsmState =
                    case GenesisConfig -> Maybe HistoricityCutoff
gcHistoricityCutoff GenesisConfig
llrnGenesisConfig of
                      Maybe HistoricityCutoff
Nothing                -> HistoricityCheck m blk
forall (m :: * -> *) blk. Applicative m => HistoricityCheck m blk
HistoricityCheck.noCheck
                      Just HistoricityCutoff
historicityCutoff ->
                        SystemTime m
-> m GsmState -> HistoricityCutoff -> HistoricityCheck m blk
forall (m :: * -> *) blk.
(Monad m, HasHeader blk, HasAnnTip blk) =>
SystemTime m
-> m GsmState -> HistoricityCutoff -> HistoricityCheck m blk
HistoricityCheck.mkCheck SystemTime m
systemTime m GsmState
getGsmState HistoricityCutoff
historicityCutoff
              fmap (nodeKernelArgsEnforceInvariants . llrnCustomiseNodeKernelArgs)
                $ mkNodeKernelArgs
                    registry
                    llrnBfcSalt
                    llrnGsmAntiThunderingHerd
                    llrnKeepAliveRng
                    cfg
                    rnTraceConsensus
                    btime
                    (InFutureCheck.realHeaderInFutureCheck llrnMaxClockSkew systemTime)
                    historicityCheck
                    chainDB
                    llrnMaxCaughtUpAge
                    (Just durationUntilTooOld)
                    gsmMarkerFileView
                    rnGetUseBootstrapPeers
                    llrnPublicPeerSelectionStateVar
                    genesisArgs
                    DiffusionPipeliningOn
          nodeKernel <- initNodeKernel nodeKernelArgs
          rnNodeKernelHook registry nodeKernel

          peerMetrics <- newPeerMetric Diffusion.peerMetricsConfiguration
          let ntnApps = NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> PeerMetrics m addrNTN
-> (NodeToNodeVersion -> addrNTN -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addrNTN)
-> BlockNodeToNodeVersion blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
mkNodeToNodeApps   NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel PeerMetrics m addrNTN
peerMetrics NodeToNodeVersion -> addrNTN -> Encoding
encAddrNtN NodeToNodeVersion -> Decoder s addrNTN
NodeToNodeVersion -> forall s. Decoder s addrNTN
decAddrNtN
              ntcApps = NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
mkNodeToClientApps NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel
              (apps, appsExtra) =
                mkDiffusionApplications rnEnableP2P
                                        (miniProtocolParameters nodeKernelArgs)
                                        ntnApps
                                        ntcApps
                                        nodeKernel
                                        peerMetrics

          llrnRunDataDiffusion nodeKernel apps appsExtra
  where
    ProtocolInfo
      { pInfoConfig :: forall b. ProtocolInfo b -> TopLevelConfig b
pInfoConfig       = TopLevelConfig blk
cfg
      , pInfoInitLedger :: forall b. ProtocolInfo b -> ExtLedgerState b ValuesMK
pInfoInitLedger   = ExtLedgerState blk ValuesMK
initLedger
      } = ProtocolInfo blk
rnProtocolInfo

    codecConfig :: CodecConfig blk
    codecConfig :: CodecConfig blk
codecConfig = TopLevelConfig blk -> CodecConfig blk
forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec TopLevelConfig blk
cfg

    mkNodeToNodeApps
      :: NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
      -> NodeKernel     m addrNTN (ConnectionId addrNTC) blk
      -> PeerMetrics m addrNTN
      -> (NodeToNodeVersion -> addrNTN -> CBOR.Encoding)
      -> (NodeToNodeVersion -> forall s . CBOR.Decoder s addrNTN)
      -> BlockNodeToNodeVersion blk
      -> NTN.Apps m
          addrNTN
          ByteString
          ByteString
          ByteString
          ByteString
          ByteString
          NodeToNodeInitiatorResult
          ()
    mkNodeToNodeApps :: NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> PeerMetrics m addrNTN
-> (NodeToNodeVersion -> addrNTN -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addrNTN)
-> BlockNodeToNodeVersion blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
mkNodeToNodeApps NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel PeerMetrics m addrNTN
peerMetrics NodeToNodeVersion -> addrNTN -> Encoding
encAddrNTN NodeToNodeVersion -> forall s. Decoder s addrNTN
decAddrNTN BlockNodeToNodeVersion blk
version =
        NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> Tracers m addrNTN blk DeserialiseFailure
-> (NodeToNodeVersion
    -> Codecs
         blk
         addrNTN
         DeserialiseFailure
         m
         ByteString
         ByteString
         ByteString
         ByteString
         ByteString
         ByteString
         ByteString)
-> ByteLimits ByteString ByteString ByteString ByteString
-> m ChainSyncTimeout
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> ReportPeerMetrics m (ConnectionId addrNTN)
-> Handlers m addrNTN blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
forall (m :: * -> *) addrNTN addrNTC blk e bCS bBF bTX bKA bPS.
(IOLike m, MonadTimer m, Ord addrNTN, Exception e,
 LedgerSupportsProtocol blk, ShowProxy blk, ShowProxy (Header blk),
 ShowProxy (TxId (GenTx blk)), ShowProxy (GenTx blk)) =>
NodeKernel m addrNTN addrNTC blk
-> Tracers m addrNTN blk e
-> (NodeToNodeVersion
    -> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS)
-> ByteLimits bCS bBF bTX bKA
-> m ChainSyncTimeout
-> ChainSyncLoPBucketConfig
-> CSJConfig
-> ReportPeerMetrics m (ConnectionId addrNTN)
-> Handlers m addrNTN blk
-> Apps m addrNTN bCS bBF bTX bKA bPS NodeToNodeInitiatorResult ()
NTN.mkApps
          NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel
          Tracers m addrNTN blk DeserialiseFailure
rnTraceNTN
          (CodecConfig blk
-> BlockNodeToNodeVersion blk
-> (NodeToNodeVersion -> addrNTN -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addrNTN)
-> NodeToNodeVersion
-> Codecs
     blk
     addrNTN
     DeserialiseFailure
     m
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
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
NTN.defaultCodecs CodecConfig blk
codecConfig BlockNodeToNodeVersion blk
version NodeToNodeVersion -> addrNTN -> Encoding
encAddrNTN NodeToNodeVersion -> Decoder s addrNTN
NodeToNodeVersion -> forall s. Decoder s addrNTN
decAddrNTN)
          ByteLimits ByteString ByteString ByteString ByteString
NTN.byteLimits
          m ChainSyncTimeout
llrnChainSyncTimeout
          (GenesisConfig -> ChainSyncLoPBucketConfig
gcChainSyncLoPBucketConfig GenesisConfig
llrnGenesisConfig)
          (GenesisConfig -> CSJConfig
gcCSJConfig GenesisConfig
llrnGenesisConfig)
          (PeerMetricsConfiguration
-> PeerMetrics m addrNTN
-> ReportPeerMetrics m (ConnectionId addrNTN)
forall (m :: * -> *) p.
(MonadSTM m, Ord p) =>
PeerMetricsConfiguration
-> PeerMetrics m p -> ReportPeerMetrics m (ConnectionId p)
reportMetric PeerMetricsConfiguration
Diffusion.peerMetricsConfiguration PeerMetrics m addrNTN
peerMetrics)
          (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> Handlers m addrNTN blk
forall (m :: * -> *) blk addrNTN addrNTC.
(IOLike m, MonadTime m, MonadTimer m, LedgerSupportsMempool blk,
 HasTxId (GenTx blk), LedgerSupportsProtocol blk, Ord addrNTN,
 Hashable addrNTN) =>
NodeKernelArgs m addrNTN addrNTC blk
-> NodeKernel m addrNTN addrNTC blk -> Handlers m addrNTN blk
NTN.mkHandlers NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel)

    mkNodeToClientApps
      :: NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
      -> NodeKernel     m addrNTN (ConnectionId addrNTC) blk
      -> BlockNodeToClientVersion blk
      -> NodeToClientVersion
      -> NTC.Apps m (ConnectionId addrNTC) ByteString ByteString ByteString ByteString ()
    mkNodeToClientApps :: NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
mkNodeToClientApps NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel BlockNodeToClientVersion blk
blockVersion NodeToClientVersion
networkVersion =
        NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
-> Codecs
     blk
     DeserialiseFailure
     m
     ByteString
     ByteString
     ByteString
     ByteString
-> Handlers m (ConnectionId addrNTC) blk
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
forall (m :: * -> *) addrNTN addrNTC blk e bCS bTX bSQ bTM.
(IOLike m, Exception e, ShowProxy blk, ShowProxy (ApplyTxErr blk),
 ShowProxy (GenTx blk), ShowProxy (GenTxId blk),
 ShowProxy (Query blk),
 forall (fp :: QueryFootprint). ShowQuery (BlockQuery blk fp)) =>
NodeKernel m addrNTN addrNTC blk
-> Tracers m addrNTC blk e
-> Codecs blk e m bCS bTX bSQ bTM
-> Handlers m addrNTC blk
-> Apps m addrNTC bCS bTX bSQ bTM ()
NTC.mkApps
          NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel
          Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
rnTraceNTC
          (CodecConfig blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Codecs
     blk
     DeserialiseFailure
     m
     ByteString
     ByteString
     ByteString
     ByteString
forall (m :: * -> *) blk.
(MonadST m, SerialiseNodeToClientConstraints blk,
 BlockSupportsLedgerQuery blk, Show (BlockNodeToClientVersion blk),
 StandardHash blk, Serialise (HeaderHash blk)) =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> DefaultCodecs blk m
NTC.defaultCodecs CodecConfig blk
codecConfig BlockNodeToClientVersion blk
blockVersion NodeToClientVersion
networkVersion)
          (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> Handlers m (ConnectionId addrNTC) blk
forall (m :: * -> *) blk addrNTN addrNTC.
(IOLike m, LedgerSupportsMempool blk, LedgerSupportsProtocol blk,
 BlockSupportsLedgerQuery blk, ConfigSupportsNode blk) =>
NodeKernelArgs m addrNTN addrNTC blk
-> NodeKernel m addrNTN addrNTC blk -> Handlers m addrNTC blk
NTC.mkHandlers NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel)

    mkDiffusionApplications
      :: NetworkP2PMode p2p
      -> MiniProtocolParameters
      -> (   BlockNodeToNodeVersion blk
          -> NTN.Apps
               m
               addrNTN
               ByteString
               ByteString
               ByteString
               ByteString
               ByteString
               NodeToNodeInitiatorResult
               ()
        )
      -> (   BlockNodeToClientVersion blk
          -> NodeToClientVersion
          -> NTC.Apps
               m (ConnectionId addrNTC) ByteString ByteString ByteString ByteString ()
        )
      -> NodeKernel m addrNTN (ConnectionId addrNTC) blk
      -> PeerMetrics m addrNTN
      -> ( Diffusion.Applications
             addrNTN NodeToNodeVersion   NodeToNodeVersionData
             addrNTC NodeToClientVersion NodeToClientVersionData
             (Cardano.LedgerPeersConsensusInterface m)
             m NodeToNodeInitiatorResult
         , Diffusion.ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult
         )
    mkDiffusionApplications :: NetworkP2PMode p2p
-> MiniProtocolParameters
-> (BlockNodeToNodeVersion blk
    -> Apps
         m
         addrNTN
         ByteString
         ByteString
         ByteString
         ByteString
         ByteString
         NodeToNodeInitiatorResult
         ())
-> (BlockNodeToClientVersion blk
    -> NodeToClientVersion
    -> Apps
         m
         (ConnectionId addrNTC)
         ByteString
         ByteString
         ByteString
         ByteString
         ())
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> PeerMetrics m addrNTN
-> (Applications
      addrNTN
      NodeToNodeVersion
      NodeToNodeVersionData
      addrNTC
      NodeToClientVersion
      NodeToClientVersionData
      (LedgerPeersConsensusInterface m)
      m
      NodeToNodeInitiatorResult,
    ApplicationsExtra p2p addrNTN m NodeToNodeInitiatorResult)
mkDiffusionApplications
      NetworkP2PMode p2p
enP2P
      MiniProtocolParameters
miniProtocolParams
      BlockNodeToNodeVersion blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
ntnApps
      BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntcApps
      NodeKernel m addrNTN (ConnectionId addrNTC) blk
kernel
      PeerMetrics m addrNTN
peerMetrics =
      case NetworkP2PMode p2p
enP2P of
        NetworkP2PMode p2p
EnabledP2PMode ->
          ( Applications
  addrNTN
  NodeToNodeVersion
  NodeToNodeVersionData
  addrNTC
  NodeToClientVersion
  NodeToClientVersionData
  (LedgerPeersConsensusInterface m)
  m
  NodeToNodeInitiatorResult
apps
          , ApplicationsExtra addrNTN m NodeToNodeInitiatorResult
-> ApplicationsExtra 'P2P addrNTN m NodeToNodeInitiatorResult
forall ntnAddr (m :: * -> *) a.
ApplicationsExtra ntnAddr m a -> ApplicationsExtra 'P2P ntnAddr m a
Diffusion.P2PApplicationsExtra
              Diffusion.P2P.ApplicationsExtra {
                daRethrowPolicy :: RethrowPolicy
Diffusion.P2P.daRethrowPolicy       = Proxy blk -> RethrowPolicy
forall blk.
(Typeable blk, StandardHash blk) =>
Proxy blk -> RethrowPolicy
consensusRethrowPolicy (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk),
                daReturnPolicy :: ReturnPolicy NodeToNodeInitiatorResult
Diffusion.P2P.daReturnPolicy        = ReturnPolicy NodeToNodeInitiatorResult
returnPolicy,
                daLocalRethrowPolicy :: RethrowPolicy
Diffusion.P2P.daLocalRethrowPolicy  = RethrowPolicy
localRethrowPolicy,
                daPeerMetrics :: PeerMetrics m addrNTN
Diffusion.P2P.daPeerMetrics         = PeerMetrics m addrNTN
peerMetrics,
                daPeerSharingRegistry :: PeerSharingRegistry addrNTN m
Diffusion.P2P.daPeerSharingRegistry = NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> PeerSharingRegistry addrNTN m
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> PeerSharingRegistry addrNTN m
getPeerSharingRegistry NodeKernel m addrNTN (ConnectionId addrNTC) blk
kernel
              }
          )
        NetworkP2PMode p2p
DisabledP2PMode ->
          ( Applications
  addrNTN
  NodeToNodeVersion
  NodeToNodeVersionData
  addrNTC
  NodeToClientVersion
  NodeToClientVersionData
  (LedgerPeersConsensusInterface m)
  m
  NodeToNodeInitiatorResult
apps
          , ApplicationsExtra
-> ApplicationsExtra 'NonP2P addrNTN m NodeToNodeInitiatorResult
forall ntnAddr (m :: * -> *) a.
ApplicationsExtra -> ApplicationsExtra 'NonP2P ntnAddr m a
Diffusion.NonP2PApplicationsExtra
              NonP2P.ApplicationsExtra {
                daErrorPolicies :: ErrorPolicies
NonP2P.daErrorPolicies = Proxy blk -> ErrorPolicies
forall blk.
(Typeable blk, StandardHash blk) =>
Proxy blk -> ErrorPolicies
consensusErrorPolicy (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
              }
          )
      where
        apps :: Applications
  addrNTN
  NodeToNodeVersion
  NodeToNodeVersionData
  addrNTC
  NodeToClientVersion
  NodeToClientVersionData
  (LedgerPeersConsensusInterface m)
  m
  NodeToNodeInitiatorResult
apps = Diffusion.Applications {
            daApplicationInitiatorMode :: Versions
  NodeToNodeVersion
  NodeToNodeVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorMode addrNTN ByteString m NodeToNodeInitiatorResult Void)
Diffusion.daApplicationInitiatorMode =
              [Versions
   NodeToNodeVersion
   NodeToNodeVersionData
   (OuroborosBundleWithExpandedCtx
      'InitiatorMode
      addrNTN
      ByteString
      m
      NodeToNodeInitiatorResult
      Void)]
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorMode addrNTN ByteString m NodeToNodeInitiatorResult Void)
forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions
                [ NodeToNodeVersion
-> NodeToNodeVersionData
-> (NodeToNodeVersionData
    -> OuroborosBundleWithExpandedCtx
         'InitiatorMode addrNTN ByteString m NodeToNodeInitiatorResult Void)
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorMode addrNTN ByteString m NodeToNodeInitiatorResult Void)
forall vNum vData r.
vNum -> vData -> (vData -> r) -> Versions vNum vData r
simpleSingletonVersions
                    NodeToNodeVersion
version
                    NodeToNodeVersionData
llrnVersionDataNTN
                    (\NodeToNodeVersionData
versionData ->
                      MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode addrNTN ByteString m NodeToNodeInitiatorResult Void
forall (m :: * -> *) addr b a c.
MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps m addr b b b b b a c
-> OuroborosBundleWithExpandedCtx 'InitiatorMode addr b m a Void
NTN.initiator MiniProtocolParameters
miniProtocolParams NodeToNodeVersion
version NodeToNodeVersionData
versionData
                      -- Initiator side won't start responder side of Peer
                      -- Sharing protocol so we give a dummy implementation
                      -- here.
                      (Apps
   m
   addrNTN
   ByteString
   ByteString
   ByteString
   ByteString
   ByteString
   NodeToNodeInitiatorResult
   ()
 -> OuroborosBundleWithExpandedCtx
      'InitiatorMode addrNTN ByteString m NodeToNodeInitiatorResult Void)
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode addrNTN ByteString m NodeToNodeInitiatorResult Void
forall a b. (a -> b) -> a -> b
$ BlockNodeToNodeVersion blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
ntnApps BlockNodeToNodeVersion blk
blockVersion)
                | (NodeToNodeVersion
version, BlockNodeToNodeVersion blk
blockVersion) <- Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> [(NodeToNodeVersion, BlockNodeToNodeVersion blk)]
forall k a. Map k a -> [(k, a)]
Map.toList Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnNodeToNodeVersions
                ],
            daApplicationInitiatorResponderMode :: Versions
  NodeToNodeVersion
  NodeToNodeVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode
     addrNTN
     ByteString
     m
     NodeToNodeInitiatorResult
     ())
Diffusion.daApplicationInitiatorResponderMode =
              [Versions
   NodeToNodeVersion
   NodeToNodeVersionData
   (OuroborosBundleWithExpandedCtx
      'InitiatorResponderMode
      addrNTN
      ByteString
      m
      NodeToNodeInitiatorResult
      ())]
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorResponderMode
        addrNTN
        ByteString
        m
        NodeToNodeInitiatorResult
        ())
forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions
                [ NodeToNodeVersion
-> NodeToNodeVersionData
-> (NodeToNodeVersionData
    -> OuroborosBundleWithExpandedCtx
         'InitiatorResponderMode
         addrNTN
         ByteString
         m
         NodeToNodeInitiatorResult
         ())
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorResponderMode
        addrNTN
        ByteString
        m
        NodeToNodeInitiatorResult
        ())
forall vNum vData r.
vNum -> vData -> (vData -> r) -> Versions vNum vData r
simpleSingletonVersions
                    NodeToNodeVersion
version
                    NodeToNodeVersionData
llrnVersionDataNTN
                    (\NodeToNodeVersionData
versionData ->
                        MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode
     addrNTN
     ByteString
     m
     NodeToNodeInitiatorResult
     ()
forall (m :: * -> *) addr b a c.
MiniProtocolParameters
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> Apps m addr b b b b b a c
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode addr b m a c
NTN.initiatorAndResponder MiniProtocolParameters
miniProtocolParams NodeToNodeVersion
version NodeToNodeVersionData
versionData
                      (Apps
   m
   addrNTN
   ByteString
   ByteString
   ByteString
   ByteString
   ByteString
   NodeToNodeInitiatorResult
   ()
 -> OuroborosBundleWithExpandedCtx
      'InitiatorResponderMode
      addrNTN
      ByteString
      m
      NodeToNodeInitiatorResult
      ())
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode
     addrNTN
     ByteString
     m
     NodeToNodeInitiatorResult
     ()
forall a b. (a -> b) -> a -> b
$ BlockNodeToNodeVersion blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
ntnApps BlockNodeToNodeVersion blk
blockVersion)
                | (NodeToNodeVersion
version, BlockNodeToNodeVersion blk
blockVersion) <- Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> [(NodeToNodeVersion, BlockNodeToNodeVersion blk)]
forall k a. Map k a -> [(k, a)]
Map.toList Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnNodeToNodeVersions
                ],
            daLocalResponderApplication :: Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplicationWithMinimalCtx
     'ResponderMode addrNTC ByteString m Void ())
Diffusion.daLocalResponderApplication =
              [Versions
   NodeToClientVersion
   NodeToClientVersionData
   (OuroborosApplicationWithMinimalCtx
      'ResponderMode addrNTC ByteString m Void ())]
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplicationWithMinimalCtx
        'ResponderMode addrNTC ByteString m Void ())
forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions
                [ NodeToClientVersion
-> NodeToClientVersionData
-> (NodeToClientVersionData
    -> OuroborosApplicationWithMinimalCtx
         'ResponderMode addrNTC ByteString m Void ())
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplicationWithMinimalCtx
        'ResponderMode addrNTC ByteString m Void ())
forall vNum vData r.
vNum -> vData -> (vData -> r) -> Versions vNum vData r
simpleSingletonVersions
                    NodeToClientVersion
version
                    NodeToClientVersionData
llrnVersionDataNTC
                    (\NodeToClientVersionData
versionData -> NodeToClientVersion
-> NodeToClientVersionData
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
-> OuroborosApplicationWithMinimalCtx
     'ResponderMode addrNTC ByteString m Void ()
forall (m :: * -> *) peer b a.
NodeToClientVersion
-> NodeToClientVersionData
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosApplicationWithMinimalCtx
     'ResponderMode peer b m Void a
NTC.responder NodeToClientVersion
version NodeToClientVersionData
versionData (Apps
   m
   (ConnectionId addrNTC)
   ByteString
   ByteString
   ByteString
   ByteString
   ()
 -> OuroborosApplicationWithMinimalCtx
      'ResponderMode addrNTC ByteString m Void ())
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
-> OuroborosApplicationWithMinimalCtx
     'ResponderMode addrNTC ByteString m Void ()
forall a b. (a -> b) -> a -> b
$ BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntcApps BlockNodeToClientVersion blk
blockVersion NodeToClientVersion
version)
                | (NodeToClientVersion
version, BlockNodeToClientVersion blk
blockVersion) <- Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> [(NodeToClientVersion, BlockNodeToClientVersion blk)]
forall k a. Map k a -> [(k, a)]
Map.toList Map NodeToClientVersion (BlockNodeToClientVersion blk)
llrnNodeToClientVersions
                ],
            daLedgerPeersCtx :: LedgerPeersConsensusInterface (LedgerPeersConsensusInterface m) m
Diffusion.daLedgerPeersCtx =
              LedgerPeersConsensusInterface {
                  lpGetLatestSlot :: STM m (WithOrigin SlotNo)
lpGetLatestSlot = NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> STM m (WithOrigin SlotNo)
forall (m :: * -> *) blk addrNTN addrNTC.
(IOLike m, UpdateLedger blk) =>
NodeKernel m addrNTN addrNTC blk -> STM m (WithOrigin SlotNo)
getImmTipSlot NodeKernel m addrNTN (ConnectionId addrNTC) blk
kernel,
                  lpGetLedgerPeers :: STM m [(PoolStake, NonEmpty RelayAccessPoint)]
lpGetLedgerPeers = [(PoolStake, NonEmpty RelayAccessPoint)]
-> Maybe [(PoolStake, NonEmpty RelayAccessPoint)]
-> [(PoolStake, NonEmpty RelayAccessPoint)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(PoolStake, NonEmpty RelayAccessPoint)]
 -> [(PoolStake, NonEmpty RelayAccessPoint)])
-> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)])
-> STM m [(PoolStake, NonEmpty RelayAccessPoint)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> (LedgerState blk EmptyMK -> Bool)
-> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)])
forall (m :: * -> *) blk addrNTN addrNTC.
(IOLike m, LedgerSupportsPeerSelection blk) =>
NodeKernel m addrNTN addrNTC blk
-> (LedgerState blk EmptyMK -> Bool)
-> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)])
getPeersFromCurrentLedger NodeKernel m addrNTN (ConnectionId addrNTC) blk
kernel (Bool -> LedgerState blk EmptyMK -> Bool
forall a b. a -> b -> a
const Bool
True),
                  lpExtraAPI :: LedgerPeersConsensusInterface m
lpExtraAPI =
                    Cardano.LedgerPeersConsensusInterface {
                      getLedgerStateJudgement :: STM m LedgerStateJudgement
Cardano.getLedgerStateJudgement = GsmState -> LedgerStateJudgement
GSM.gsmStateToLedgerJudgement (GsmState -> LedgerStateJudgement)
-> STM m GsmState -> STM m LedgerStateJudgement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeKernel m addrNTN (ConnectionId addrNTC) blk -> STM m GsmState
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m GsmState
getGsmState NodeKernel m addrNTN (ConnectionId addrNTC) blk
kernel
                    , updateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()
Cardano.updateOutboundConnectionsState =
                        let varOcs :: StrictTVar m OutboundConnectionsState
varOcs = NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> StrictTVar m OutboundConnectionsState
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk
-> StrictTVar m OutboundConnectionsState
getOutboundConnectionsState NodeKernel m addrNTN (ConnectionId addrNTC) blk
kernel in \OutboundConnectionsState
newOcs -> do
                          oldOcs <- StrictTVar m OutboundConnectionsState
-> STM m OutboundConnectionsState
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m OutboundConnectionsState
varOcs
                          when (newOcs /= oldOcs) $ writeTVar varOcs newOcs
                    }
                }
          }

        localRethrowPolicy :: RethrowPolicy
        localRethrowPolicy :: RethrowPolicy
localRethrowPolicy = RethrowPolicy
forall a. Monoid a => a
mempty

    runPredicate :: Predicate a -> a -> Maybe a
    runPredicate :: forall a. Predicate a -> a -> Maybe a
runPredicate (Predicate a -> Bool
p) a
err = if a -> Bool
p a
err then a -> Maybe a
forall a. a -> Maybe a
Just a
err else Maybe a
forall a. Maybe a
Nothing


-- | Check the DB marker, lock the DB and look for the clean shutdown marker.
--
-- Run the body action with the DB locked.
--
stdWithCheckedDB ::
     forall blk a. (StandardHash blk, Typeable blk)
  => Proxy blk
  -> Tracer IO (TraceEvent blk)
  -> FilePath
  -> NetworkMagic
  -> (LastShutDownWasClean -> (ChainDB IO blk -> IO a -> IO a) -> IO a)  -- ^ Body action with last shutdown was clean.
  -> IO a
stdWithCheckedDB :: forall blk a.
(StandardHash blk, Typeable blk) =>
Proxy blk
-> Tracer IO (TraceEvent blk)
-> FilePath
-> NetworkMagic
-> (LastShutDownWasClean
    -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
stdWithCheckedDB Proxy blk
pb Tracer IO (TraceEvent blk)
tracer FilePath
databasePath NetworkMagic
networkMagic LastShutDownWasClean -> (ChainDB IO blk -> IO a -> IO a) -> IO a
body = do

    -- Check the DB marker first, before doing the lock file, since if the
    -- marker is not present, it expects an empty DB dir.
    (DbMarkerError -> IO ())
-> (() -> IO ()) -> Either DbMarkerError () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either DbMarkerError -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DbMarkerError () -> IO ())
-> IO (Either DbMarkerError ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasFS IO HandleIO
-> MountPoint -> NetworkMagic -> IO (Either DbMarkerError ())
forall (m :: * -> *) h.
MonadThrow m =>
HasFS m h
-> MountPoint -> NetworkMagic -> m (Either DbMarkerError ())
checkDbMarker
      HasFS IO HandleIO
hasFS
      MountPoint
mountPoint
      NetworkMagic
networkMagic

    -- Then create the lock file.
    MountPoint -> IO a -> IO a
forall a. MountPoint -> IO a -> IO a
withLockDB MountPoint
mountPoint (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ Proxy blk
-> Tracer IO (TraceEvent blk)
-> HasFS IO HandleIO
-> (LastShutDownWasClean
    -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
forall a (m :: * -> *) h blk.
(IOLike m, StandardHash blk, Typeable blk) =>
Proxy blk
-> Tracer m (TraceEvent blk)
-> HasFS m h
-> (LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
-> m a
runWithCheckedDB Proxy blk
pb Tracer IO (TraceEvent blk)
tracer HasFS IO HandleIO
hasFS LastShutDownWasClean -> (ChainDB IO blk -> IO a -> IO a) -> IO a
body
  where
    mountPoint :: MountPoint
mountPoint = FilePath -> MountPoint
MountPoint FilePath
databasePath
    hasFS :: HasFS IO HandleIO
hasFS      = MountPoint -> HasFS IO HandleIO
forall (m :: * -> *).
(MonadIO m, PrimState IO ~ PrimState m) =>
MountPoint -> HasFS m HandleIO
ioHasFS MountPoint
mountPoint

openChainDB ::
     forall m blk. (RunNode blk, IOLike m)
  => ResourceRegistry m
  -> TopLevelConfig blk
  -> ExtLedgerState blk ValuesMK
     -- ^ Initial ledger
  -> (ChainDB.RelativeMountPoint -> SomeHasFS m)
     -- ^ Immutable FS, see 'NodeDatabasePaths'
  -> (ChainDB.RelativeMountPoint -> SomeHasFS m)
     -- ^ Volatile FS, see 'NodeDatabasePaths'
  -> Complete LedgerDbFlavorArgs m
  -> Incomplete ChainDbArgs m blk
     -- ^ A set of default arguments (possibly modified from 'defaultArgs')
  -> (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
      -- ^ Customise the 'ChainDbArgs'
  -> m (ChainDB m blk, Complete ChainDbArgs m blk)
openChainDB :: forall (m :: * -> *) blk.
(RunNode blk, IOLike m) =>
ResourceRegistry m
-> TopLevelConfig blk
-> ExtLedgerState blk ValuesMK
-> (RelativeMountPoint -> SomeHasFS m)
-> (RelativeMountPoint -> SomeHasFS m)
-> Complete LedgerDbFlavorArgs m
-> Incomplete ChainDbArgs m blk
-> (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> m (ChainDB m blk, Complete ChainDbArgs m blk)
openChainDB ResourceRegistry m
registry TopLevelConfig blk
cfg ExtLedgerState blk ValuesMK
initLedger RelativeMountPoint -> SomeHasFS m
fsImm RelativeMountPoint -> SomeHasFS m
fsVol Complete LedgerDbFlavorArgs m
flavorArgs Incomplete ChainDbArgs m blk
defArgs Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
customiseArgs =
   let args :: Complete ChainDbArgs m blk
args = Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
customiseArgs (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
forall a b. (a -> b) -> a -> b
$ ResourceRegistry m
-> TopLevelConfig blk
-> ExtLedgerState blk ValuesMK
-> ChunkInfo
-> (blk -> Bool)
-> (RelativeMountPoint -> SomeHasFS m)
-> (RelativeMountPoint -> SomeHasFS m)
-> Complete LedgerDbFlavorArgs m
-> Incomplete ChainDbArgs m blk
-> Complete ChainDbArgs m blk
forall (m :: * -> *) blk.
(ConsensusProtocol (BlockProtocol blk), IOLike m) =>
ResourceRegistry m
-> TopLevelConfig blk
-> ExtLedgerState blk ValuesMK
-> ChunkInfo
-> (blk -> Bool)
-> (RelativeMountPoint -> SomeHasFS m)
-> (RelativeMountPoint -> SomeHasFS m)
-> Complete LedgerDbFlavorArgs m
-> Incomplete ChainDbArgs m blk
-> Complete ChainDbArgs m blk
ChainDB.completeChainDbArgs
               ResourceRegistry m
registry
               TopLevelConfig blk
cfg
               ExtLedgerState blk ValuesMK
initLedger
               (StorageConfig blk -> ChunkInfo
forall blk. NodeInitStorage blk => StorageConfig blk -> ChunkInfo
nodeImmutableDbChunkInfo (TopLevelConfig blk -> StorageConfig blk
forall blk. TopLevelConfig blk -> StorageConfig blk
configStorage TopLevelConfig blk
cfg))
               (StorageConfig blk -> blk -> Bool
forall blk. NodeInitStorage blk => StorageConfig blk -> blk -> Bool
nodeCheckIntegrity (TopLevelConfig blk -> StorageConfig blk
forall blk. TopLevelConfig blk -> StorageConfig blk
configStorage TopLevelConfig blk
cfg))
               RelativeMountPoint -> SomeHasFS m
fsImm
               RelativeMountPoint -> SomeHasFS m
fsVol
               Complete LedgerDbFlavorArgs m
flavorArgs
               Incomplete ChainDbArgs m blk
defArgs
      in (,Complete ChainDbArgs m blk
args) (ChainDB m blk -> (ChainDB m blk, Complete ChainDbArgs m blk))
-> m (ChainDB m blk)
-> m (ChainDB m blk, Complete ChainDbArgs m blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Complete ChainDbArgs m blk -> m (ChainDB m blk)
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk,
 BlockSupportsDiffusionPipelining blk, InspectLedger blk,
 HasHardForkHistory blk, ConvertRawHash blk,
 SerialiseDiskConstraints blk, LedgerSupportsLedgerDB blk) =>
Complete ChainDbArgs m blk -> m (ChainDB m blk)
ChainDB.openDB Complete ChainDbArgs m blk
args

mkNodeKernelArgs ::
     forall m addrNTN addrNTC blk. (RunNode blk, IOLike m)
  => ResourceRegistry m
  -> Int
  -> StdGen
  -> StdGen
  -> TopLevelConfig blk
  -> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
  -> BlockchainTime m
  -> InFutureCheck.SomeHeaderInFutureCheck m blk
  -> (m GSM.GsmState -> HistoricityCheck m blk)
  -> ChainDB m blk
  -> NominalDiffTime
  -> Maybe (GSM.WrapDurationUntilTooOld m blk)
  -> GSM.MarkerFileView m
  -> STM m UseBootstrapPeers
  -> StrictSTM.StrictTVar m (PublicPeerSelectionState addrNTN)
  -> GenesisNodeKernelArgs m blk
  -> DiffusionPipeliningSupport
  -> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
mkNodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
(RunNode blk, IOLike m) =>
ResourceRegistry m
-> Int
-> StdGen
-> StdGen
-> TopLevelConfig blk
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockchainTime m
-> SomeHeaderInFutureCheck m blk
-> (m GsmState -> HistoricityCheck m blk)
-> ChainDB m blk
-> NominalDiffTime
-> Maybe (WrapDurationUntilTooOld m blk)
-> MarkerFileView m
-> STM m UseBootstrapPeers
-> StrictTVar m (PublicPeerSelectionState addrNTN)
-> GenesisNodeKernelArgs m blk
-> DiffusionPipeliningSupport
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
mkNodeKernelArgs
  ResourceRegistry m
registry
  Int
bfcSalt
  StdGen
gsmAntiThunderingHerd
  StdGen
rng
  TopLevelConfig blk
cfg
  Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers
  BlockchainTime m
btime
  SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
  m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck
  ChainDB m blk
chainDB
  NominalDiffTime
maxCaughtUpAge
  Maybe (WrapDurationUntilTooOld m blk)
gsmDurationUntilTooOld
  MarkerFileView m
gsmMarkerFileView
  STM m UseBootstrapPeers
getUseBootstrapPeers
  StrictTVar m (PublicPeerSelectionState addrNTN)
publicPeerSelectionStateVar
  GenesisNodeKernelArgs m blk
genesisArgs
  DiffusionPipeliningSupport
getDiffusionPipeliningSupport
  = do
    let (StdGen
kaRng, StdGen
psRng) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng
    NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeKernelArgs
      { Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers
      , ResourceRegistry m
registry :: ResourceRegistry m
registry :: ResourceRegistry m
registry
      , TopLevelConfig blk
cfg :: TopLevelConfig blk
cfg :: TopLevelConfig blk
cfg
      , BlockchainTime m
btime :: BlockchainTime m
btime :: BlockchainTime m
btime
      , ChainDB m blk
chainDB :: ChainDB m blk
chainDB :: ChainDB m blk
chainDB
      , initChainDB :: StorageConfig blk -> InitChainDB m blk -> m ()
initChainDB             = StorageConfig blk -> InitChainDB m blk -> m ()
forall blk (m :: * -> *).
(NodeInitStorage blk, IOLike m) =>
StorageConfig blk -> InitChainDB m blk -> m ()
forall (m :: * -> *).
IOLike m =>
StorageConfig blk -> InitChainDB m blk -> m ()
nodeInitChainDB
      , SomeHeaderInFutureCheck m blk
chainSyncFutureCheck :: SomeHeaderInFutureCheck m blk
chainSyncFutureCheck :: SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
      , m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck :: m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck :: m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck
      , blockFetchSize :: Header blk -> SizeInBytes
blockFetchSize          = Header blk -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize
      , mempoolCapacityOverride :: MempoolCapacityBytesOverride
mempoolCapacityOverride = MempoolCapacityBytesOverride
NoMempoolCapacityBytesOverride
      , miniProtocolParameters :: MiniProtocolParameters
miniProtocolParameters  = MiniProtocolParameters
defaultMiniProtocolParameters
      , blockFetchConfiguration :: BlockFetchConfiguration
blockFetchConfiguration = Int -> BlockFetchConfiguration
Diffusion.defaultBlockFetchConfiguration Int
bfcSalt
      , gsmArgs :: GsmNodeKernelArgs m blk
gsmArgs = GsmNodeKernelArgs {
          StdGen
gsmAntiThunderingHerd :: StdGen
gsmAntiThunderingHerd :: StdGen
gsmAntiThunderingHerd
        , Maybe (WrapDurationUntilTooOld m blk)
gsmDurationUntilTooOld :: Maybe (WrapDurationUntilTooOld m blk)
gsmDurationUntilTooOld :: Maybe (WrapDurationUntilTooOld m blk)
gsmDurationUntilTooOld
        , MarkerFileView m
gsmMarkerFileView :: MarkerFileView m
gsmMarkerFileView :: MarkerFileView m
gsmMarkerFileView
        , gsmMinCaughtUpDuration :: NominalDiffTime
gsmMinCaughtUpDuration = NominalDiffTime
maxCaughtUpAge
        }
      , STM m UseBootstrapPeers
getUseBootstrapPeers :: STM m UseBootstrapPeers
getUseBootstrapPeers :: STM m UseBootstrapPeers
getUseBootstrapPeers
      , keepAliveRng :: StdGen
keepAliveRng = StdGen
kaRng
      , peerSharingRng :: StdGen
peerSharingRng = StdGen
psRng
      , StrictTVar m (PublicPeerSelectionState addrNTN)
publicPeerSelectionStateVar :: StrictTVar m (PublicPeerSelectionState addrNTN)
publicPeerSelectionStateVar :: StrictTVar m (PublicPeerSelectionState addrNTN)
publicPeerSelectionStateVar
      , GenesisNodeKernelArgs m blk
genesisArgs :: GenesisNodeKernelArgs m blk
genesisArgs :: GenesisNodeKernelArgs m blk
genesisArgs
      , DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
getDiffusionPipeliningSupport
      }

-- | We allow the user running the node to customise the 'NodeKernelArgs'
-- through 'llrnCustomiseNodeKernelArgs', but there are some limits to some
-- values. This function makes sure we don't exceed those limits and that the
-- values are consistent.
nodeKernelArgsEnforceInvariants ::
     NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
  -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgsEnforceInvariants :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgsEnforceInvariants NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs = NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs
    { miniProtocolParameters = miniProtocolParameters
        -- If 'blockFetchPipeliningMax' exceeds the configured default, it
        -- would be a protocol violation.
        { blockFetchPipeliningMax =
            min (blockFetchPipeliningMax miniProtocolParameters)
                (blockFetchPipeliningMax defaultMiniProtocolParameters)
        }
    , blockFetchConfiguration = blockFetchConfiguration
        -- 'bfcMaxRequestsInflight' must be <= 'blockFetchPipeliningMax'
        { bfcMaxRequestsInflight =
            min (bfcMaxRequestsInflight blockFetchConfiguration)
                (fromIntegral $ blockFetchPipeliningMax miniProtocolParameters)
        }
    }
  where
    NodeKernelArgs{StdGen
STM m UseBootstrapPeers
MempoolCapacityBytesOverride
DiffusionPipeliningSupport
TopLevelConfig blk
BlockchainTime m
SomeHeaderInFutureCheck m blk
ChainDB m blk
ResourceRegistry m
MiniProtocolParameters
BlockFetchConfiguration
StrictTVar m (PublicPeerSelectionState addrNTN)
GsmNodeKernelArgs m blk
GenesisNodeKernelArgs m blk
Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
m GsmState -> HistoricityCheck m blk
Header blk -> SizeInBytes
StorageConfig blk -> InitChainDB m blk -> m ()
keepAliveRng :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> StdGen
miniProtocolParameters :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> MiniProtocolParameters
tracers :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> Tracers m (ConnectionId addrNTN) addrNTC blk
registry :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> ResourceRegistry m
cfg :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> TopLevelConfig blk
btime :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> BlockchainTime m
chainDB :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> ChainDB m blk
initChainDB :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> StorageConfig blk -> InitChainDB m blk -> m ()
chainSyncFutureCheck :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> SomeHeaderInFutureCheck m blk
chainSyncHistoricityCheck :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> m GsmState -> HistoricityCheck m blk
blockFetchSize :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> Header blk -> SizeInBytes
mempoolCapacityOverride :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> MempoolCapacityBytesOverride
blockFetchConfiguration :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> BlockFetchConfiguration
gsmArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> GsmNodeKernelArgs m blk
getUseBootstrapPeers :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> STM m UseBootstrapPeers
peerSharingRng :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> StdGen
publicPeerSelectionStateVar :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk
-> StrictTVar m (PublicPeerSelectionState addrNTN)
genesisArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> GenesisNodeKernelArgs m blk
getDiffusionPipeliningSupport :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> DiffusionPipeliningSupport
miniProtocolParameters :: MiniProtocolParameters
blockFetchConfiguration :: BlockFetchConfiguration
tracers :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
registry :: ResourceRegistry m
cfg :: TopLevelConfig blk
btime :: BlockchainTime m
chainDB :: ChainDB m blk
initChainDB :: StorageConfig blk -> InitChainDB m blk -> m ()
chainSyncFutureCheck :: SomeHeaderInFutureCheck m blk
chainSyncHistoricityCheck :: m GsmState -> HistoricityCheck m blk
blockFetchSize :: Header blk -> SizeInBytes
mempoolCapacityOverride :: MempoolCapacityBytesOverride
keepAliveRng :: StdGen
gsmArgs :: GsmNodeKernelArgs m blk
getUseBootstrapPeers :: STM m UseBootstrapPeers
peerSharingRng :: StdGen
publicPeerSelectionStateVar :: StrictTVar m (PublicPeerSelectionState addrNTN)
genesisArgs :: GenesisNodeKernelArgs m blk
getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
..} = NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs

{-------------------------------------------------------------------------------
  Arguments for use in the real node
-------------------------------------------------------------------------------}

-- | How to locate the ChainDB on disk
stdMkChainDbHasFS ::
     FilePath
  -> ChainDB.RelativeMountPoint
  -> SomeHasFS IO
stdMkChainDbHasFS :: FilePath -> RelativeMountPoint -> SomeHasFS IO
stdMkChainDbHasFS FilePath
rootPath (ChainDB.RelativeMountPoint FilePath
relPath) =
    HasFS IO HandleIO -> SomeHasFS IO
forall h (m :: * -> *). Eq h => HasFS m h -> SomeHasFS m
SomeHasFS (HasFS IO HandleIO -> SomeHasFS IO)
-> HasFS IO HandleIO -> SomeHasFS IO
forall a b. (a -> b) -> a -> b
$ MountPoint -> HasFS IO HandleIO
forall (m :: * -> *).
(MonadIO m, PrimState IO ~ PrimState m) =>
MountPoint -> HasFS m HandleIO
ioHasFS (MountPoint -> HasFS IO HandleIO)
-> MountPoint -> HasFS IO HandleIO
forall a b. (a -> b) -> a -> b
$ FilePath -> MountPoint
MountPoint (FilePath -> MountPoint) -> FilePath -> MountPoint
forall a b. (a -> b) -> a -> b
$ FilePath
rootPath FilePath -> ShowS
</> FilePath
relPath

stdBfcSaltIO :: IO Int
stdBfcSaltIO :: IO Int
stdBfcSaltIO = IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO

stdGsmAntiThunderingHerdIO :: IO StdGen
stdGsmAntiThunderingHerdIO :: IO StdGen
stdGsmAntiThunderingHerdIO = IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen

stdKeepAliveRngIO :: IO StdGen
stdKeepAliveRngIO :: IO StdGen
stdKeepAliveRngIO = IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen

stdVersionDataNTN :: NetworkMagic
                  -> DiffusionMode
                  -> PeerSharing
                  -> NodeToNodeVersionData
stdVersionDataNTN :: NetworkMagic
-> DiffusionMode -> PeerSharing -> NodeToNodeVersionData
stdVersionDataNTN NetworkMagic
networkMagic DiffusionMode
diffusionMode PeerSharing
peerSharing = NodeToNodeVersionData
    { NetworkMagic
networkMagic :: NetworkMagic
networkMagic :: NetworkMagic
networkMagic
    , DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode
    , PeerSharing
peerSharing :: PeerSharing
peerSharing :: PeerSharing
peerSharing
    , query :: Bool
query         = Bool
False
    }

stdVersionDataNTC :: NetworkMagic -> NodeToClientVersionData
stdVersionDataNTC :: NetworkMagic -> NodeToClientVersionData
stdVersionDataNTC NetworkMagic
networkMagic = NodeToClientVersionData
    { NetworkMagic
networkMagic :: NetworkMagic
networkMagic :: NetworkMagic
networkMagic
    , query :: Bool
query        = Bool
False
    }

stdRunDataDiffusion
  :: ( Monoid extraPeers
     , Eq extraCounters
     , Eq extraFlags
     , Exception exception
     )
  => ( forall (mode :: Mode) x y.
       Diffusion.P2P.NodeToNodeConnectionManager
         mode
         Socket
         RemoteAddress
         NodeToNodeVersionData
         NodeToNodeVersion
         IO
         x
         y
     -> StrictSTM.StrictTVar
         IO
         (PeerSelectionState
           extraState
           extraFlags
           extraPeers
           RemoteAddress
           (Diffusion.P2P.NodeToNodePeerConnectionHandle
             mode
             RemoteAddress
             NodeToNodeVersionData
             IO
             x
             y)
         )
     -> PeerMetrics IO RemoteAddress
     -> IO ()
  ) -> Diffusion.Tracers
      RemoteAddress
      NodeToNodeVersion
      LocalAddress
      NodeToClientVersion
      IO
  -> Diffusion.ExtraTracers
      p2p
      extraState
      extraDebugState
      extraFlags
      extraPeers
      extraCounters
      IO
  -> Diffusion.Arguments
      IO
      Socket
      RemoteAddress
      LocalSocket
      LocalAddress
  -> Diffusion.ArgumentsExtra
      p2p
      extraArgs
      extraState
      extraDebugState
      extraFlags
      extraPeers
      extraAPI
      extraChurnArgs
      extraCounters
      exception
      RemoteAddress
      LocalAddress
      Resolver
      IOException
      IO
  -> Diffusion.Applications
      RemoteAddress NodeToNodeVersion   NodeToNodeVersionData
      LocalAddress  NodeToClientVersion NodeToClientVersionData
      extraAPI IO a
  -> Diffusion.ApplicationsExtra p2p RemoteAddress IO a
  -> IO ()
stdRunDataDiffusion :: forall extraPeers extraCounters extraFlags exception extraState
       (p2p :: P2P) extraDebugState extraArgs extraAPI extraChurnArgs a.
(Monoid extraPeers, Eq extraCounters, Eq extraFlags,
 Exception exception) =>
(forall (mode :: Mode) x y.
 NodeToNodeConnectionManager
   mode
   Socket
   RemoteAddress
   NodeToNodeVersionData
   NodeToNodeVersion
   IO
   x
   y
 -> StrictTVar
      IO
      (PeerSelectionState
         extraState
         extraFlags
         extraPeers
         RemoteAddress
         (NodeToNodePeerConnectionHandle
            mode RemoteAddress NodeToNodeVersionData IO x y))
 -> PeerMetrics IO RemoteAddress
 -> IO ())
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers
     p2p
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     IO
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ArgumentsExtra
     p2p
     extraArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     extraAPI
     IO
     a
-> ApplicationsExtra p2p RemoteAddress IO a
-> IO ()
stdRunDataDiffusion = (forall (mode :: Mode) x y.
 NodeToNodeConnectionManager
   mode
   Socket
   RemoteAddress
   NodeToNodeVersionData
   NodeToNodeVersion
   IO
   x
   y
 -> StrictTVar
      IO
      (PeerSelectionState
         extraState
         extraFlags
         extraPeers
         RemoteAddress
         (NodeToNodePeerConnectionHandle
            mode RemoteAddress NodeToNodeVersionData IO x y))
 -> PeerMetrics IO RemoteAddress
 -> IO ())
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers
     p2p
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     IO
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ArgumentsExtra
     p2p
     extraArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     extraAPI
     IO
     a
-> ApplicationsExtra p2p RemoteAddress IO a
-> IO ()
forall (p2p :: P2P) extraArgs extraState extraDebugState extraFlags
       extraPeers extraAPI extraChurnArgs extraCounters exception a.
(Monoid extraPeers, Eq extraCounters, Eq extraFlags,
 Exception exception) =>
(forall (mode :: Mode) x y.
 NodeToNodeConnectionManager
   mode
   Socket
   RemoteAddress
   NodeToNodeVersionData
   NodeToNodeVersion
   IO
   x
   y
 -> StrictTVar
      IO
      (PeerSelectionState
         extraState
         extraFlags
         extraPeers
         RemoteAddress
         (NodeToNodePeerConnectionHandle
            mode RemoteAddress NodeToNodeVersionData IO x y))
 -> PeerMetrics IO RemoteAddress
 -> IO ())
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers
     p2p
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     IO
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ArgumentsExtra
     p2p
     extraArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     extraAPI
     IO
     a
-> ApplicationsExtra p2p RemoteAddress IO a
-> IO ()
Diffusion.run

-- | Conveniently packaged 'LowLevelRunNodeArgs' arguments from a standard
-- non-testing invocation.
stdLowLevelRunNodeArgsIO
  :: forall blk p2p extraState extraActions extraPeers extraFlags extraChurnArgs extraCounters exception .
  ( RunNode blk
  , Monoid extraPeers
  , Eq extraCounters
  , Eq extraFlags
  , Exception exception
  )
  => RunNodeArgs IO RemoteAddress LocalAddress blk p2p
  -> StdRunNodeArgs IO blk p2p (Cardano.ExtraArguments IO) extraState Cardano.DebugPeerSelectionState extraActions (Cardano.LedgerPeersConsensusInterface IO) extraPeers extraFlags extraChurnArgs extraCounters exception
  -> IO (LowLevelRunNodeArgs
          IO
          RemoteAddress
          LocalAddress
          blk
          p2p
          (Cardano.LedgerPeersConsensusInterface IO))
stdLowLevelRunNodeArgsIO :: forall blk (p2p :: P2P) extraState extraActions extraPeers
       extraFlags extraChurnArgs extraCounters exception.
(RunNode blk, Monoid extraPeers, Eq extraCounters, Eq extraFlags,
 Exception exception) =>
RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> StdRunNodeArgs
     IO
     blk
     p2p
     (ExtraArguments IO)
     extraState
     DebugPeerSelectionState
     extraActions
     (LedgerPeersConsensusInterface IO)
     extraPeers
     extraFlags
     extraChurnArgs
     extraCounters
     exception
-> IO
     (LowLevelRunNodeArgs
        IO
        RemoteAddress
        LocalAddress
        blk
        p2p
        (LedgerPeersConsensusInterface IO))
stdLowLevelRunNodeArgsIO RunNodeArgs{ ProtocolInfo blk
rnProtocolInfo :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> ProtocolInfo blk
rnProtocolInfo :: ProtocolInfo blk
rnProtocolInfo
                                    , NetworkP2PMode p2p
rnEnableP2P :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> NetworkP2PMode p2p
rnEnableP2P :: NetworkP2PMode p2p
rnEnableP2P
                                    , PeerSharing
rnPeerSharing :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> PeerSharing
rnPeerSharing :: PeerSharing
rnPeerSharing
                                    , GenesisConfig
rnGenesisConfig :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> GenesisConfig
rnGenesisConfig :: GenesisConfig
rnGenesisConfig
                                    , STM IO UseBootstrapPeers
rnGetUseBootstrapPeers :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> STM m UseBootstrapPeers
rnGetUseBootstrapPeers :: STM IO UseBootstrapPeers
rnGetUseBootstrapPeers
                                    }
                         $(SafeWildCards.fields 'StdRunNodeArgs) = do
    llrnBfcSalt               <- IO Int
stdBfcSaltIO
    llrnGsmAntiThunderingHerd <- stdGsmAntiThunderingHerdIO
    llrnKeepAliveRng          <- stdKeepAliveRngIO
    pure LowLevelRunNodeArgs
      { llrnBfcSalt
      , llrnChainSyncTimeout = fromMaybe Diffusion.defaultChainSyncTimeout srnChainSyncTimeout
      , llrnGenesisConfig = rnGenesisConfig
      , llrnCustomiseHardForkBlockchainTimeArgs = id
      , llrnGsmAntiThunderingHerd
      , llrnKeepAliveRng
      , llrnMkImmutableHasFS = stdMkChainDbHasFS $ immutableDbPath srnDatabasePath
      , llrnMkVolatileHasFS = stdMkChainDbHasFS $ nonImmutableDbPath srnDatabasePath
      , llrnChainDbArgsDefaults = updateChainDbDefaults ChainDB.defaultArgs
      , llrnCustomiseChainDbArgs = id
      , llrnCustomiseNodeKernelArgs
      , llrnRunDataDiffusion =
          \NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk
kernel Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  (LedgerPeersConsensusInterface IO)
  IO
  NodeToNodeInitiatorResult
apps ApplicationsExtra p2p RemoteAddress IO NodeToNodeInitiatorResult
extraApps -> do
            case NetworkP2PMode p2p
rnEnableP2P of
              NetworkP2PMode p2p
EnabledP2PMode ->
                case ExtraTracers
  p2p
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
srnDiffusionTracersExtra of
                   Diffusion.P2PTracers TracersExtra
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
extraTracers -> do
                     let srnDiffusionArgumentsExtra' :: ArgumentsExtra
  p2p
  (ExtraArguments IO)
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  (LedgerPeersConsensusInterface IO)
  extraChurnArgs
  extraCounters
  exception
  RemoteAddress
  LocalAddress
  Resolver
  IOException
  IO
srnDiffusionArgumentsExtra' =
                           P2PDecision p2p (Tracer IO TracePublicRootPeers) ()
-> P2PDecision p2p (STM IO FetchMode) ()
-> P2PDecision p2p (LedgerPeersConsensusInterface IO) ()
-> ArgumentsExtra
     p2p
     (ExtraArguments IO)
     extraState
     DebugPeerSelectionState
     extraFlags
     extraPeers
     (LedgerPeersConsensusInterface IO)
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
srnDiffusionArgumentsExtra (Tracer IO TracePublicRootPeers
-> P2PDecision 'P2P (Tracer IO TracePublicRootPeers) ()
forall a b. a -> P2PDecision 'P2P a b
Diffusion.P2PDecision (TracersExtra
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
-> Tracer IO TracePublicRootPeers
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraDebugState extraFlags
       extraPeers extraCounters (m :: * -> *).
TracersExtra
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
-> Tracer m TracePublicRootPeers
Diffusion.P2P.dtTracePublicRootPeersTracer TracersExtra
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IOException
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
extraTracers))
                                                      (STM FetchMode -> P2PDecision 'P2P (STM FetchMode) ()
forall a b. a -> P2PDecision 'P2P a b
Diffusion.P2PDecision (NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk
-> STM IO FetchMode
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m FetchMode
getFetchMode NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk
kernel))
                                                      (LedgerPeersConsensusInterface IO
-> P2PDecision 'P2P (LedgerPeersConsensusInterface IO) ()
forall a b. a -> P2PDecision 'P2P a b
Diffusion.P2PDecision (LedgerPeersConsensusInterface (LedgerPeersConsensusInterface IO) IO
-> LedgerPeersConsensusInterface IO
forall extraAPI (m :: * -> *).
LedgerPeersConsensusInterface extraAPI m -> extraAPI
lpExtraAPI (Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  (LedgerPeersConsensusInterface IO)
  IO
  NodeToNodeInitiatorResult
-> LedgerPeersConsensusInterface
     (LedgerPeersConsensusInterface IO) IO
forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraAPI (m :: * -> *) a.
Applications
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraAPI
  m
  a
-> LedgerPeersConsensusInterface extraAPI m
Diffusion.daLedgerPeersCtx Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  (LedgerPeersConsensusInterface IO)
  IO
  NodeToNodeInitiatorResult
apps)))
                     case ArgumentsExtra
  p2p
  (ExtraArguments IO)
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  (LedgerPeersConsensusInterface IO)
  extraChurnArgs
  extraCounters
  exception
  RemoteAddress
  LocalAddress
  Resolver
  IOException
  IO
srnDiffusionArgumentsExtra' of
                       Diffusion.P2PArguments ArgumentsExtra
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  (LedgerPeersConsensusInterface IO)
  extraChurnArgs
  extraCounters
  exception
  RemoteAddress
  LocalAddress
  Resolver
  IOException
  IO
extraArgs ->
                         (forall (mode :: Mode) x y.
 NodeToNodeConnectionManager
   mode
   Socket
   RemoteAddress
   NodeToNodeVersionData
   NodeToNodeVersion
   IO
   x
   y
 -> StrictTVar
      IO
      (PeerSelectionState
         extraState
         extraFlags
         extraPeers
         RemoteAddress
         (NodeToNodePeerConnectionHandle
            mode RemoteAddress NodeToNodeVersionData IO x y))
 -> PeerMetrics IO RemoteAddress
 -> IO ())
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers
     p2p
     extraState
     DebugPeerSelectionState
     extraFlags
     extraPeers
     extraCounters
     IO
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ArgumentsExtra
     p2p
     (ExtraArguments IO)
     extraState
     DebugPeerSelectionState
     extraFlags
     extraPeers
     (LedgerPeersConsensusInterface IO)
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     (LedgerPeersConsensusInterface IO)
     IO
     NodeToNodeInitiatorResult
-> ApplicationsExtra p2p RemoteAddress IO NodeToNodeInitiatorResult
-> IO ()
forall extraPeers extraCounters extraFlags exception extraState
       (p2p :: P2P) extraDebugState extraArgs extraAPI extraChurnArgs a.
(Monoid extraPeers, Eq extraCounters, Eq extraFlags,
 Exception exception) =>
(forall (mode :: Mode) x y.
 NodeToNodeConnectionManager
   mode
   Socket
   RemoteAddress
   NodeToNodeVersionData
   NodeToNodeVersion
   IO
   x
   y
 -> StrictTVar
      IO
      (PeerSelectionState
         extraState
         extraFlags
         extraPeers
         RemoteAddress
         (NodeToNodePeerConnectionHandle
            mode RemoteAddress NodeToNodeVersionData IO x y))
 -> PeerMetrics IO RemoteAddress
 -> IO ())
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers
     p2p
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     IO
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ArgumentsExtra
     p2p
     extraArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     extraAPI
     IO
     a
-> ApplicationsExtra p2p RemoteAddress IO a
-> IO ()
stdRunDataDiffusion
                             (ExtraTracers
  p2p
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
-> STM IO UseLedgerPeers
-> PeerSharing
-> STM IO UseBootstrapPeers
-> STM IO LedgerStateJudgement
-> ConnectionManager
     mode
     Socket
     RemoteAddress
     (Handle
        mode
        (ExpandedInitiatorContext RemoteAddress IO)
        (ResponderContext RemoteAddress)
        NodeToNodeVersionData
        ByteString
        IO
        x
        y)
     (HandleError mode NodeToNodeVersion)
     IO
-> StrictTVar
     IO
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        RemoteAddress
        (PeerConnectionHandle
           mode
           (ResponderContext RemoteAddress)
           RemoteAddress
           NodeToNodeVersionData
           ByteString
           IO
           x
           y))
-> PeerMetrics IO RemoteAddress
-> IO ()
forall (mode :: Mode) x y.
ExtraTracers
  p2p
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
-> STM IO UseLedgerPeers
-> PeerSharing
-> STM IO UseBootstrapPeers
-> STM IO LedgerStateJudgement
-> NodeToNodeConnectionManager
     mode
     Socket
     RemoteAddress
     NodeToNodeVersionData
     NodeToNodeVersion
     IO
     x
     y
-> StrictTVar
     IO
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        RemoteAddress
        (NodeToNodePeerConnectionHandle
           mode RemoteAddress NodeToNodeVersionData IO x y))
-> PeerMetrics IO RemoteAddress
-> IO ()
srnSigUSR1SignalHandler
                                ExtraTracers
  p2p
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
srnDiffusionTracersExtra
                                (ArgumentsExtra
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  (LedgerPeersConsensusInterface IO)
  extraChurnArgs
  extraCounters
  exception
  RemoteAddress
  LocalAddress
  Resolver
  IOException
  IO
-> STM IO UseLedgerPeers
forall extraState extraDebugState extraFlags extraPeers extraAPI
       extraChurnArgs extraCounters exception ntnAddr ntcAddr resolver
       resolverError (m :: * -> *).
ArgumentsExtra
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraChurnArgs
  extraCounters
  exception
  ntnAddr
  ntcAddr
  resolver
  resolverError
  m
-> STM m UseLedgerPeers
Diffusion.P2P.daReadUseLedgerPeers ArgumentsExtra
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  (LedgerPeersConsensusInterface IO)
  extraChurnArgs
  extraCounters
  exception
  RemoteAddress
  LocalAddress
  Resolver
  IOException
  IO
extraArgs)
                                PeerSharing
rnPeerSharing
                                STM IO UseBootstrapPeers
rnGetUseBootstrapPeers
                                (GsmState -> LedgerStateJudgement
GSM.gsmStateToLedgerJudgement (GsmState -> LedgerStateJudgement)
-> STM GsmState -> STM LedgerStateJudgement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk
-> STM IO GsmState
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernel m addrNTN addrNTC blk -> STM m GsmState
getGsmState NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk
kernel))
                             Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionTracers
                             ExtraTracers
  p2p
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
srnDiffusionTracersExtra
                             Arguments IO Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments
                             ArgumentsExtra
  p2p
  (ExtraArguments IO)
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  (LedgerPeersConsensusInterface IO)
  extraChurnArgs
  extraCounters
  exception
  RemoteAddress
  LocalAddress
  Resolver
  IOException
  IO
srnDiffusionArgumentsExtra'
                             Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  (LedgerPeersConsensusInterface IO)
  IO
  NodeToNodeInitiatorResult
apps ApplicationsExtra p2p RemoteAddress IO NodeToNodeInitiatorResult
extraApps

              NetworkP2PMode p2p
DisabledP2PMode ->
                (forall (mode :: Mode) x y.
 NodeToNodeConnectionManager
   mode
   Socket
   RemoteAddress
   NodeToNodeVersionData
   NodeToNodeVersion
   IO
   x
   y
 -> StrictTVar
      IO
      (PeerSelectionState
         extraState
         extraFlags
         extraPeers
         RemoteAddress
         (NodeToNodePeerConnectionHandle
            mode RemoteAddress NodeToNodeVersionData IO x y))
 -> PeerMetrics IO RemoteAddress
 -> IO ())
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers
     p2p
     extraState
     DebugPeerSelectionState
     extraFlags
     extraPeers
     extraCounters
     IO
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ArgumentsExtra
     p2p
     (ExtraArguments IO)
     extraState
     DebugPeerSelectionState
     extraFlags
     extraPeers
     (LedgerPeersConsensusInterface IO)
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     (LedgerPeersConsensusInterface IO)
     IO
     NodeToNodeInitiatorResult
-> ApplicationsExtra p2p RemoteAddress IO NodeToNodeInitiatorResult
-> IO ()
forall extraPeers extraCounters extraFlags exception extraState
       (p2p :: P2P) extraDebugState extraArgs extraAPI extraChurnArgs a.
(Monoid extraPeers, Eq extraCounters, Eq extraFlags,
 Exception exception) =>
(forall (mode :: Mode) x y.
 NodeToNodeConnectionManager
   mode
   Socket
   RemoteAddress
   NodeToNodeVersionData
   NodeToNodeVersion
   IO
   x
   y
 -> StrictTVar
      IO
      (PeerSelectionState
         extraState
         extraFlags
         extraPeers
         RemoteAddress
         (NodeToNodePeerConnectionHandle
            mode RemoteAddress NodeToNodeVersionData IO x y))
 -> PeerMetrics IO RemoteAddress
 -> IO ())
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers
     p2p
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     IO
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ArgumentsExtra
     p2p
     extraArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     extraAPI
     IO
     a
-> ApplicationsExtra p2p RemoteAddress IO a
-> IO ()
stdRunDataDiffusion
                 (ExtraTracers
  p2p
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
-> STM IO UseLedgerPeers
-> PeerSharing
-> STM IO UseBootstrapPeers
-> STM IO LedgerStateJudgement
-> ConnectionManager
     mode
     Socket
     RemoteAddress
     (Handle
        mode
        (ExpandedInitiatorContext RemoteAddress IO)
        (ResponderContext RemoteAddress)
        NodeToNodeVersionData
        ByteString
        IO
        x
        y)
     (HandleError mode NodeToNodeVersion)
     IO
-> StrictTVar
     IO
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        RemoteAddress
        (PeerConnectionHandle
           mode
           (ResponderContext RemoteAddress)
           RemoteAddress
           NodeToNodeVersionData
           ByteString
           IO
           x
           y))
-> PeerMetrics IO RemoteAddress
-> IO ()
forall (mode :: Mode) x y.
ExtraTracers
  p2p
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
-> STM IO UseLedgerPeers
-> PeerSharing
-> STM IO UseBootstrapPeers
-> STM IO LedgerStateJudgement
-> NodeToNodeConnectionManager
     mode
     Socket
     RemoteAddress
     NodeToNodeVersionData
     NodeToNodeVersion
     IO
     x
     y
-> StrictTVar
     IO
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        RemoteAddress
        (NodeToNodePeerConnectionHandle
           mode RemoteAddress NodeToNodeVersionData IO x y))
-> PeerMetrics IO RemoteAddress
-> IO ()
srnSigUSR1SignalHandler
                    (TracersExtra
-> ExtraTracers
     'NonP2P
     extraState
     DebugPeerSelectionState
     extraFlags
     extraPeers
     extraCounters
     IO
forall extraState extraDebugState extraFlags extraPeers
       extraCounters (m :: * -> *).
TracersExtra
-> ExtraTracers
     'NonP2P
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     m
Diffusion.NonP2PTracers TracersExtra
NonP2P.nullTracers)
                    (UseLedgerPeers -> STM UseLedgerPeers
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseLedgerPeers
DontUseLedgerPeers)
                    PeerSharing
rnPeerSharing
                    (UseBootstrapPeers -> STM UseBootstrapPeers
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseBootstrapPeers
DontUseBootstrapPeers)
                    (LedgerStateJudgement -> STM LedgerStateJudgement
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LedgerStateJudgement
TooOld))
                 Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionTracers
                 ExtraTracers
  p2p
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
srnDiffusionTracersExtra
                 Arguments IO Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments
                 (P2PDecision p2p (Tracer IO TracePublicRootPeers) ()
-> P2PDecision p2p (STM IO FetchMode) ()
-> P2PDecision p2p (LedgerPeersConsensusInterface IO) ()
-> ArgumentsExtra
     p2p
     (ExtraArguments IO)
     extraState
     DebugPeerSelectionState
     extraFlags
     extraPeers
     (LedgerPeersConsensusInterface IO)
     extraChurnArgs
     extraCounters
     exception
     RemoteAddress
     LocalAddress
     Resolver
     IOException
     IO
srnDiffusionArgumentsExtra
                    (() -> P2PDecision 'NonP2P (Tracer IO TracePublicRootPeers) ()
forall b a. b -> P2PDecision 'NonP2P a b
Diffusion.NonP2PDecision ())
                    (() -> P2PDecision 'NonP2P (STM FetchMode) ()
forall b a. b -> P2PDecision 'NonP2P a b
Diffusion.NonP2PDecision ())
                    (() -> P2PDecision 'NonP2P (LedgerPeersConsensusInterface IO) ()
forall b a. b -> P2PDecision 'NonP2P a b
Diffusion.NonP2PDecision ()))
                 Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  (LedgerPeersConsensusInterface IO)
  IO
  NodeToNodeInitiatorResult
apps ApplicationsExtra p2p RemoteAddress IO NodeToNodeInitiatorResult
extraApps
      , llrnVersionDataNTC =
          stdVersionDataNTC networkMagic
      , llrnVersionDataNTN =
          stdVersionDataNTN
            networkMagic
            (case rnEnableP2P of
               NetworkP2PMode p2p
EnabledP2PMode  -> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> DiffusionMode
forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr -> DiffusionMode
Diffusion.daMode Arguments IO Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments
               -- Every connection in non-p2p mode is unidirectional; We connect
               -- from an ephemeral port.  We still pass `srnDiffusionArguments`
               -- to the diffusion layer, so the server side will be run also in
               -- `InitiatorAndResponderDiffusionMode`.
               NetworkP2PMode p2p
DisabledP2PMode -> DiffusionMode
InitiatorOnlyDiffusionMode
            )
            rnPeerSharing
      , llrnNodeToNodeVersions =
          limitToLatestReleasedVersion
            fst
            (supportedNodeToNodeVersions (Proxy @blk))
      , llrnNodeToClientVersions =
          limitToLatestReleasedVersion
            snd
            (supportedNodeToClientVersions (Proxy @blk))
      , llrnWithCheckedDB =
          -- 'stdWithCheckedDB' uses the FS just to check for the clean file.
          -- We put that one in the immutable path.
          stdWithCheckedDB (Proxy @blk) srnTraceChainDB (immutableDbPath srnDatabasePath) networkMagic
      , llrnMaxCaughtUpAge = secondsToNominalDiffTime $ 20 * 60   -- 20 min
      , llrnMaxClockSkew =
          InFutureCheck.defaultClockSkew
      , llrnPublicPeerSelectionStateVar =
          Diffusion.daPublicPeerSelectionVar srnDiffusionArguments
      , llrnLdbFlavorArgs =
          srnLdbFlavorArgs
      }
  where
    networkMagic :: NetworkMagic
    networkMagic :: NetworkMagic
networkMagic = BlockConfig blk -> NetworkMagic
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> NetworkMagic
getNetworkMagic (BlockConfig blk -> NetworkMagic)
-> BlockConfig blk -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock (TopLevelConfig blk -> BlockConfig blk)
-> TopLevelConfig blk -> BlockConfig blk
forall a b. (a -> b) -> a -> b
$ ProtocolInfo blk -> TopLevelConfig blk
forall b. ProtocolInfo b -> TopLevelConfig b
pInfoConfig ProtocolInfo blk
rnProtocolInfo

    updateChainDbDefaults ::
         Incomplete ChainDbArgs IO blk
      -> Incomplete ChainDbArgs IO blk
    updateChainDbDefaults :: Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
updateChainDbDefaults =
          SnapshotPolicyArgs
-> Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall (f :: * -> *) (m :: * -> *) blk.
SnapshotPolicyArgs -> ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.updateSnapshotPolicyArgs SnapshotPolicyArgs
srnSnapshotPolicyArgs
        (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> Incomplete ChainDbArgs IO blk
-> Incomplete ChainDbArgs IO blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryBatchSize
-> Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall (f :: * -> *) (m :: * -> *) blk.
QueryBatchSize -> ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.updateQueryBatchSize QueryBatchSize
srnQueryBatchSize
        (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> Incomplete ChainDbArgs IO blk
-> Incomplete ChainDbArgs IO blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tracer IO (TraceEvent blk)
-> Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall (m :: * -> *) blk (f :: * -> *).
Tracer m (TraceEvent blk)
-> ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.updateTracer Tracer IO (TraceEvent blk)
srnTraceChainDB
        (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> Incomplete ChainDbArgs IO blk
-> Incomplete ChainDbArgs IO blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if   Bool -> Bool
not Bool
srnChainDbValidateOverride
           then Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall a. a -> a
id
           else Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.ensureValidateAll)

    llrnCustomiseNodeKernelArgs ::
         NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
      -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
    llrnCustomiseNodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC.
NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs =
        (BlockFetchConfiguration -> BlockFetchConfiguration)
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
forall (m :: * -> *) addrNTN addrNTC blk.
(BlockFetchConfiguration -> BlockFetchConfiguration)
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
overBlockFetchConfiguration BlockFetchConfiguration -> BlockFetchConfiguration
modifyBlockFetchConfiguration
      (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
 -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
    -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
modifyMempoolCapacityOverride
      where
        modifyBlockFetchConfiguration :: BlockFetchConfiguration -> BlockFetchConfiguration
modifyBlockFetchConfiguration =
            (BlockFetchConfiguration -> BlockFetchConfiguration)
-> (Word -> BlockFetchConfiguration -> BlockFetchConfiguration)
-> Maybe Word
-> BlockFetchConfiguration
-> BlockFetchConfiguration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BlockFetchConfiguration -> BlockFetchConfiguration
forall a. a -> a
id
              (\Word
mc BlockFetchConfiguration
bfc -> BlockFetchConfiguration
bfc { bfcMaxConcurrencyDeadline = mc })
              Maybe Word
srnBfcMaxConcurrencyDeadline
          (BlockFetchConfiguration -> BlockFetchConfiguration)
-> (BlockFetchConfiguration -> BlockFetchConfiguration)
-> BlockFetchConfiguration
-> BlockFetchConfiguration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockFetchConfiguration -> BlockFetchConfiguration)
-> (Word -> BlockFetchConfiguration -> BlockFetchConfiguration)
-> Maybe Word
-> BlockFetchConfiguration
-> BlockFetchConfiguration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BlockFetchConfiguration -> BlockFetchConfiguration
forall a. a -> a
id
              (\Word
mc BlockFetchConfiguration
bfc -> BlockFetchConfiguration
bfc { bfcMaxConcurrencyBulkSync = mc })
              Maybe Word
srnBfcMaxConcurrencyBulkSync
        modifyMempoolCapacityOverride :: NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
modifyMempoolCapacityOverride =
            (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
 -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> (MempoolCapacityBytesOverride
    -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
    -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> Maybe MempoolCapacityBytesOverride
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
forall a. a -> a
id
              (\MempoolCapacityBytesOverride
mc NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nka -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nka { mempoolCapacityOverride = mc })
              Maybe MempoolCapacityBytesOverride
srnMaybeMempoolCapacityOverride

    -- Limit the node version unless srnEnableInDevelopmentVersions is set
    limitToLatestReleasedVersion :: forall k v.
         Ord k
      => ((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe k)
      -> Map k v
      -> Map k v
    limitToLatestReleasedVersion :: forall k v.
Ord k =>
((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe k)
-> Map k v -> Map k v
limitToLatestReleasedVersion (Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe k
prj =
        if Bool
srnEnableInDevelopmentVersions then Map k v -> Map k v
forall a. a -> a
id
        else
        case (Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe k
prj ((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe k)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe k
forall a b. (a -> b) -> a -> b
$ Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) of
          Maybe k
Nothing      -> Map k v -> Map k v
forall a. a -> a
id
          Just k
version -> (k -> Bool) -> Map k v -> Map k v
forall k a. (k -> Bool) -> Map k a -> Map k a
Map.takeWhileAntitone (k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
version)

{-------------------------------------------------------------------------------
  Miscellany
-------------------------------------------------------------------------------}

overBlockFetchConfiguration ::
     (BlockFetchConfiguration -> BlockFetchConfiguration)
  -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
  -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
overBlockFetchConfiguration :: forall (m :: * -> *) addrNTN addrNTC blk.
(BlockFetchConfiguration -> BlockFetchConfiguration)
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
overBlockFetchConfiguration BlockFetchConfiguration -> BlockFetchConfiguration
f NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
args = NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
args {
      blockFetchConfiguration = f blockFetchConfiguration
    }
  where
    NodeKernelArgs { BlockFetchConfiguration
blockFetchConfiguration :: forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> BlockFetchConfiguration
blockFetchConfiguration :: BlockFetchConfiguration
blockFetchConfiguration } = NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
args