{-# 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.GSM (GsmNodeKernelArgs (..))
import qualified Ouroboros.Consensus.Node.GSM as GSM
import Ouroboros.Consensus.Node.Genesis
  ( GenesisConfig (..)
  , GenesisNodeKernelArgs
  , mkGenesisNodeKernelArgs
  )
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.FS.API (SomeHasFS (..))
import System.FS.API.Types (MountPoint (..))
import System.FS.IO (ioHasFS)
import System.FilePath ((</>))
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
  { 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
  -- ^ Consensus tracers
  , 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-node 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 tracers for node-to-client communication
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> ProtocolInfo blk
rnProtocolInfo :: ProtocolInfo blk
  -- ^ Protocol info
  , 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 ()
  -- ^ 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 -> NetworkP2PMode p2p
rnEnableP2P :: NetworkP2PMode p2p
  -- ^ Network P2P Mode switch
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> PeerSharing
rnPeerSharing :: PeerSharing
  -- ^ Network PeerSharing miniprotocol willingness flag
  , 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
  { 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
  -- ^ 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
-> Incomplete ChainDbArgs m blk
llrnChainDbArgsDefaults :: Incomplete ChainDbArgs m blk
  -- ^ The " static " ChainDB arguments
  , 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 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
llrnMkVolatileHasFS :: 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
-> Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
llrnCustomiseChainDbArgs ::
      Complete ChainDbArgs m blk ->
      Complete ChainDbArgs m blk
  -- ^ 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
-> 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
  -- ^ Customise the 'NodeArgs'
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> Int
llrnBfcSalt :: Int
  -- ^ Ie 'bfcSalt'
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> StdGen
llrnGsmAntiThunderingHerd :: StdGen
  -- ^ Ie 'gsmAntiThunderingHerd'
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI -> StdGen
llrnKeepAliveRng :: StdGen
  -- ^ Ie 'keepAliveRng'
  , 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
  -- ^ Customise the 'HardForkBlockchainTimeArgs'
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> m ChainSyncTimeout
llrnChainSyncTimeout :: m NTN.ChainSyncTimeout
  -- ^ See 'NTN.ChainSyncTimeout'
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> GenesisConfig
llrnGenesisConfig :: GenesisConfig
  , 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 ()
  -- ^ 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
-> NodeToClientVersionData
llrnVersionDataNTC :: NodeToClientVersionData
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NodeToNodeVersionData
llrnVersionDataNTN :: NodeToNodeVersionData
  , 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-node 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)
  -- ^ node-to-client protocol versions to run.
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> NominalDiffTime
llrnMaxCaughtUpAge :: NominalDiffTime
  -- ^ 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 -> ClockSkew
llrnMaxClockSkew :: InFutureCheck.ClockSkew
  -- ^ Maximum clock skew
  , 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)
  , forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P) extraAPI.
LowLevelRunNodeArgs m addrNTN addrNTC blk p2p extraAPI
-> Complete LedgerDbFlavorArgs m
llrnLdbFlavorArgs :: Complete LedgerDbFlavorArgs m
  -- ^ The flavor arguments
  }

data NodeDatabasePaths
  = -- | Databases will be stored under this path, such that given a
    -- path @/foo@, databases will be in @/foo/{immutable,volatile,...}@.
    OnePathForAllDbs
      FilePath
  | MultipleDbPaths
      -- | 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,...}@.
      FilePath

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
StdGen
Map NodeToClientVersion (BlockNodeToClientVersion blk)
Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
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, Typeable 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 ->
  -- | Body action with last shutdown was clean.
  (LastShutDownWasClean -> (ChainDB IO blk -> IO a -> IO a) -> IO a) ->
  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 ->
  -- | Initial ledger
  ExtLedgerState blk ValuesMK ->
  -- | Immutable FS, see 'NodeDatabasePaths'
  (ChainDB.RelativeMountPoint -> SomeHasFS m) ->
  -- | Volatile FS, see 'NodeDatabasePaths'
  (ChainDB.RelativeMountPoint -> SomeHasFS m) ->
  Complete LedgerDbFlavorArgs m ->
  -- | A set of default arguments (possibly modified from 'defaultArgs')
  Incomplete ChainDbArgs m blk ->
  -- | Customise the 'ChainDbArgs'
  (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk) ->
  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