{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE Rank2Types          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TypeApplications    #-}
-- | Run the whole Node
--
-- Intended for qualified import.
--
module Ouroboros.Consensus.Node (
    run
  , runWith
    -- * Standard arguments
  , StdRunNodeArgs (..)
  , stdBfcSaltIO
  , stdChainSyncTimeout
  , stdKeepAliveRngIO
  , stdLowLevelRunNodeArgsIO
  , stdMkChainDbHasFS
  , stdRunDataDiffusion
  , stdVersionDataNTC
  , stdVersionDataNTN
  , stdWithCheckedDB
    -- ** P2P Switch
  , NetworkP2PMode (..)
    -- * Exposed by 'run' et al
  , ChainDB.RelativeMountPoint (..)
  , ChainDB.TraceEvent (..)
  , ChainDbArgs (..)
  , HardForkBlockchainTimeArgs (..)
  , LastShutDownWasClean (..)
  , LowLevelRunNodeArgs (..)
  , MempoolCapacityBytesOverride (..)
  , NodeKernel (..)
  , NodeKernelArgs (..)
  , ProtocolInfo (..)
  , RunNode
  , RunNodeArgs (..)
  , Tracers
  , Tracers' (..)
    -- * Internal helpers
  , mkChainDbArgs
  , mkNodeKernelArgs
  , nodeKernelArgsEnforceInvariants
  , openChainDB
  ) where

import           Codec.Serialise (DeserialiseFailure)
import           Control.Tracer (Tracer, contramap)
import           Data.ByteString.Lazy (ByteString)
import           Data.Hashable (Hashable)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Typeable (Typeable)
import           System.FilePath ((</>))
import           System.Random (StdGen, newStdGen, randomIO, randomRIO)

import           Control.Monad.Class.MonadTime (MonadTime)
import           Control.Monad.Class.MonadTimer (MonadTimer)
import           Ouroboros.Network.BlockFetch (BlockFetchConfiguration (..))
import qualified Ouroboros.Network.Diffusion as Diffusion
import qualified Ouroboros.Network.Diffusion.NonP2P as NonP2P
import qualified Ouroboros.Network.Diffusion.P2P as P2P
import           Ouroboros.Network.Magic
import           Ouroboros.Network.NodeToClient (ConnectionId, LocalAddress,
                     LocalSocket, NodeToClientVersionData (..), combineVersions,
                     simpleSingletonVersions)
import           Ouroboros.Network.NodeToNode (DiffusionMode (..),
                     MiniProtocolParameters, NodeToNodeVersionData (..),
                     RemoteAddress, Socket, blockFetchPipeliningMax,
                     defaultMiniProtocolParameters)
import           Ouroboros.Network.PeerSelection.LedgerPeers
                     (LedgerPeersConsensusInterface (..))
import           Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics (..),
                     newPeerMetric, reportMetric)
import           Ouroboros.Network.Protocol.Limits (shortWait)
import           Ouroboros.Network.RethrowPolicy

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime hiding (getSystemStart)
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Config.SupportsNode
import           Ouroboros.Consensus.Fragment.InFuture (CheckInFuture,
                     ClockSkew)
import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))
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.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.Util.Args
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.Orphans ()
import           Ouroboros.Consensus.Util.ResourceRegistry
import           Ouroboros.Consensus.Util.Time (secondsToNominalDiffTime)

import           Ouroboros.Consensus.Storage.ChainDB (ChainDB, ChainDbArgs)
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import           Ouroboros.Consensus.Storage.FS.API (SomeHasFS (..))
import           Ouroboros.Consensus.Storage.FS.API.Types
import           Ouroboros.Consensus.Storage.FS.IO (ioHasFS)
import           Ouroboros.Consensus.Storage.ImmutableDB (ChunkInfo,
                     ValidationPolicy (..))
import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
                     (SnapshotInterval (..), defaultDiskPolicy)
import           Ouroboros.Consensus.Storage.VolatileDB
                     (BlockValidationPolicy (..))

{-------------------------------------------------------------------------------
  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.
data RunNodeArgs m addrNTN addrNTC blk (p2p :: Diffusion.P2P) = RunNodeArgs {
      -- | Consensus tracers
      RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceConsensus :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk

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

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

      -- | Protocol info
    , RunNodeArgs m addrNTN addrNTC blk p2p -> ProtocolInfo m blk
rnProtocolInfo :: ProtocolInfo m blk

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

      -- | Network P2P Mode switch
    , RunNodeArgs m addrNTN addrNTC blk p2p -> NetworkP2PMode p2p
rnEnableP2P :: NetworkP2PMode p2p
    }

-- | 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'.
data LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk
                         (p2p :: Diffusion.P2P) =
   LowLevelRunNodeArgs {

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

      -- | The " static " ChainDB arguments
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> ChainDbArgs Defaults m blk
llrnChainDbArgsDefaults :: ChainDbArgs Defaults m blk

      -- | Customise the 'ChainDbArgs'
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
llrnCustomiseChainDbArgs ::
           ChainDbArgs Identity m blk
        -> ChainDbArgs Identity m blk

      -- | Customise the 'NodeArgs'
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs ::
           NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
        -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk

      -- | Ie 'bfcSalt'
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> Int
llrnBfcSalt :: Int

      -- | Ie 'keepAliveRng'
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> StdGen
llrnKeepAliveRng :: StdGen

      -- | Customise the 'HardForkBlockchainTimeArgs'
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
llrnCustomiseHardForkBlockchainTimeArgs ::
           HardForkBlockchainTimeArgs m blk
        -> HardForkBlockchainTimeArgs m blk

      -- | See 'NTN.ChainSyncTimeout'
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> m ChainSyncTimeout
llrnChainSyncTimeout :: m NTN.ChainSyncTimeout

      -- | How to run the data diffusion applications
      --
      -- 'run' will not return before this does.
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> ResourceRegistry m
-> Applications
     addrNTN
     NodeToNodeVersion
     versionDataNTN
     addrNTC
     NodeToClientVersion
     versionDataNTC
     m
-> ExtraApplications p2p addrNTN m
-> m ()
llrnRunDataDiffusion ::
           ResourceRegistry m
        -> Diffusion.Applications
             addrNTN NodeToNodeVersion   versionDataNTN
             addrNTC NodeToClientVersion versionDataNTC
             m
        -> Diffusion.ExtraApplications p2p addrNTN m
        -> m ()

    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> versionDataNTC
llrnVersionDataNTC :: versionDataNTC

    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> versionDataNTN
llrnVersionDataNTN :: versionDataNTN

      -- | node-to-node protocol versions to run.
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnNodeToNodeVersions :: Map NodeToNodeVersion (BlockNodeToNodeVersion blk)

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

      -- | Maximum clock skew
    , LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> ClockSkew
llrnMaxClockSkew :: ClockSkew
    }

{-------------------------------------------------------------------------------
  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)


-- | Combination of 'runWith' and 'stdLowLevelRunArgsIO'
run :: forall blk p2p.
     RunNode blk
  => RunNodeArgs IO RemoteAddress LocalAddress blk p2p
  -> StdRunNodeArgs IO blk p2p
  -> IO ()
run :: RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> StdRunNodeArgs IO blk p2p -> IO ()
run RunNodeArgs IO RemoteAddress LocalAddress blk p2p
args StdRunNodeArgs IO blk p2p
stdArgs = RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> StdRunNodeArgs IO blk p2p
-> IO
     (LowLevelRunNodeArgs
        IO
        RemoteAddress
        LocalAddress
        NodeToNodeVersionData
        NodeToClientVersionData
        blk
        p2p)
forall blk (p2p :: P2P).
RunNode blk =>
RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> StdRunNodeArgs IO blk p2p
-> IO
     (LowLevelRunNodeArgs
        IO
        RemoteAddress
        LocalAddress
        NodeToNodeVersionData
        NodeToClientVersionData
        blk
        p2p)
stdLowLevelRunNodeArgsIO RunNodeArgs IO RemoteAddress LocalAddress blk p2p
args StdRunNodeArgs IO blk p2p
stdArgs IO
  (LowLevelRunNodeArgs
     IO
     RemoteAddress
     LocalAddress
     NodeToNodeVersionData
     NodeToClientVersionData
     blk
     p2p)
-> (LowLevelRunNodeArgs
      IO
      RemoteAddress
      LocalAddress
      NodeToNodeVersionData
      NodeToClientVersionData
      blk
      p2p
    -> IO ())
-> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> LowLevelRunNodeArgs
     IO
     RemoteAddress
     LocalAddress
     NodeToNodeVersionData
     NodeToClientVersionData
     blk
     p2p
-> IO ()
forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
(RunNode blk, IOLike m, MonadTime m, MonadTimer m,
 Hashable addrNTN, Ord addrNTN, Typeable addrNTN) =>
RunNodeArgs m addrNTN addrNTC blk p2p
-> LowLevelRunNodeArgs
     m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> m ()
runWith RunNodeArgs IO RemoteAddress LocalAddress blk p2p
args

-- | 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 versionDataNTN versionDataNTC blk p2p.
     ( RunNode blk
     , IOLike m, MonadTime m, MonadTimer m
     , Hashable addrNTN, Ord addrNTN, Typeable addrNTN
     )
  => RunNodeArgs m addrNTN addrNTC blk p2p
  -> LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
  -> m ()
runWith :: RunNodeArgs m addrNTN addrNTC blk p2p
-> LowLevelRunNodeArgs
     m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> m ()
runWith RunNodeArgs{ProtocolInfo m blk
Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
Tracers m (ConnectionId addrNTN) blk DeserialiseFailure
Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
NetworkP2PMode p2p
ResourceRegistry m
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> m ()
rnEnableP2P :: NetworkP2PMode p2p
rnNodeKernelHook :: ResourceRegistry m
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> m ()
rnProtocolInfo :: ProtocolInfo m blk
rnTraceNTC :: Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
rnTraceNTN :: Tracers m (ConnectionId addrNTN) blk DeserialiseFailure
rnTraceConsensus :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnEnableP2P :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> NetworkP2PMode p2p
rnNodeKernelHook :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> ResourceRegistry m
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> m ()
rnProtocolInfo :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> ProtocolInfo m blk
rnTraceNTC :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m (ConnectionId addrNTC) blk DeserialiseFailure
rnTraceNTN :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m (ConnectionId addrNTN) blk DeserialiseFailure
rnTraceConsensus :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
..} LowLevelRunNodeArgs{versionDataNTN
versionDataNTC
m ChainSyncTimeout
Int
StdGen
Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
Map NodeToClientVersion (BlockNodeToClientVersion blk)
ClockSkew
ChainDbArgs Defaults m blk
ResourceRegistry m
-> Applications
     addrNTN
     NodeToNodeVersion
     versionDataNTN
     addrNTC
     NodeToClientVersion
     versionDataNTC
     m
-> ExtraApplications p2p addrNTN m
-> m ()
HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
forall a.
(LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
-> m a
llrnMaxClockSkew :: ClockSkew
llrnNodeToClientVersions :: Map NodeToClientVersion (BlockNodeToClientVersion blk)
llrnNodeToNodeVersions :: Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnVersionDataNTN :: versionDataNTN
llrnVersionDataNTC :: versionDataNTC
llrnRunDataDiffusion :: ResourceRegistry m
-> Applications
     addrNTN
     NodeToNodeVersion
     versionDataNTN
     addrNTC
     NodeToClientVersion
     versionDataNTC
     m
-> ExtraApplications p2p addrNTN m
-> m ()
llrnChainSyncTimeout :: m ChainSyncTimeout
llrnCustomiseHardForkBlockchainTimeArgs :: HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
llrnKeepAliveRng :: StdGen
llrnBfcSalt :: Int
llrnCustomiseNodeKernelArgs :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
llrnCustomiseChainDbArgs :: ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
llrnChainDbArgsDefaults :: ChainDbArgs Defaults m blk
llrnWithCheckedDB :: forall a.
(LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
-> m a
llrnMaxClockSkew :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> ClockSkew
llrnNodeToClientVersions :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
llrnNodeToNodeVersions :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnVersionDataNTN :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> versionDataNTN
llrnVersionDataNTC :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> versionDataNTC
llrnRunDataDiffusion :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> ResourceRegistry m
-> Applications
     addrNTN
     NodeToNodeVersion
     versionDataNTN
     addrNTC
     NodeToClientVersion
     versionDataNTC
     m
-> ExtraApplications p2p addrNTN m
-> m ()
llrnChainSyncTimeout :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> m ChainSyncTimeout
llrnCustomiseHardForkBlockchainTimeArgs :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
llrnKeepAliveRng :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> StdGen
llrnBfcSalt :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> Int
llrnCustomiseNodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
llrnCustomiseChainDbArgs :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
llrnChainDbArgsDefaults :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> ChainDbArgs Defaults m blk
llrnWithCheckedDB :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> forall a.
   (LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
   -> m a
..} =

    (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.
(IOLike 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 -> 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)

          inFuture :: CheckInFuture m blk
          inFuture :: CheckInFuture m blk
inFuture = LedgerConfig blk
-> ClockSkew -> SystemTime m -> CheckInFuture m blk
forall (m :: * -> *) blk.
(Monad m, UpdateLedger blk, HasHardForkHistory blk) =>
LedgerConfig blk
-> ClockSkew -> SystemTime m -> CheckInFuture m blk
InFuture.reference
                       (TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig blk
cfg)
                       ClockSkew
llrnMaxClockSkew
                       SystemTime m
systemTime

      let customiseChainDbArgs' :: ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
customiseChainDbArgs' ChainDbArgs Identity m blk
args
            | Bool
lastShutDownWasClean
            = ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
llrnCustomiseChainDbArgs ChainDbArgs Identity m blk
args
            | Bool
otherwise
              -- When the last shutdown was not clean, validate the complete
              -- ChainDB to detect and recover from any corruptions. This will
              -- override the default value /and/ the user-customised value of
              -- the 'ChainDB.cdbImmValidation' and the
              -- 'ChainDB.cdbVolValidation' fields.
            = (ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
llrnCustomiseChainDbArgs ChainDbArgs Identity m blk
args) {
                  cdbImmutableDbValidation :: ValidationPolicy
ChainDB.cdbImmutableDbValidation = ValidationPolicy
ValidateAllChunks
                , cdbVolatileDbValidation :: BlockValidationPolicy
ChainDB.cdbVolatileDbValidation  = BlockValidationPolicy
ValidateAll
                }

      ChainDB m blk
chainDB <- ResourceRegistry m
-> CheckInFuture m blk
-> TopLevelConfig blk
-> ExtLedgerState blk
-> ChainDbArgs Defaults m blk
-> (ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk)
-> m (ChainDB m blk)
forall (m :: * -> *) blk.
(RunNode blk, IOLike m) =>
ResourceRegistry m
-> CheckInFuture m blk
-> TopLevelConfig blk
-> ExtLedgerState blk
-> ChainDbArgs Defaults m blk
-> (ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk)
-> m (ChainDB m blk)
openChainDB ResourceRegistry m
registry CheckInFuture m blk
inFuture TopLevelConfig blk
cfg ExtLedgerState blk
initLedger
                ChainDbArgs Defaults m blk
llrnChainDbArgsDefaults ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
customiseChainDbArgs'

      ChainDB m blk -> m () -> m ()
continueWithCleanChainDB ChainDB m blk
chainDB (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        BlockchainTime m
btime <-
          HardForkBlockchainTimeArgs m blk -> m (BlockchainTime m)
forall (m :: * -> *) blk.
(IOLike m, HasHardForkHistory blk, HasCallStack) =>
HardForkBlockchainTimeArgs m blk -> m (BlockchainTime m)
hardForkBlockchainTime (HardForkBlockchainTimeArgs m blk -> m (BlockchainTime m))
-> HardForkBlockchainTimeArgs m blk -> m (BlockchainTime m)
forall a b. (a -> b) -> a -> b
$
          HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
llrnCustomiseHardForkBlockchainTimeArgs (HardForkBlockchainTimeArgs m blk
 -> HardForkBlockchainTimeArgs m blk)
-> HardForkBlockchainTimeArgs m blk
-> HardForkBlockchainTimeArgs m blk
forall a b. (a -> b) -> a -> b
$
          HardForkBlockchainTimeArgs :: forall (m :: * -> *) blk.
m BackoffDelay
-> STM m (LedgerState blk)
-> LedgerConfig blk
-> ResourceRegistry m
-> SystemTime m
-> Tracer m (TraceBlockchainTimeEvent RelativeTime)
-> NominalDiffTime
-> HardForkBlockchainTimeArgs m blk
HardForkBlockchainTimeArgs
            { hfbtBackoffDelay :: m BackoffDelay
hfbtBackoffDelay   = BackoffDelay -> m BackoffDelay
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BackoffDelay -> m BackoffDelay) -> BackoffDelay -> m BackoffDelay
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> BackoffDelay
BackoffDelay NominalDiffTime
60
            , hfbtGetLedgerState :: STM m (LedgerState blk)
hfbtGetLedgerState =
                ExtLedgerState blk -> LedgerState blk
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState (ExtLedgerState blk -> LedgerState blk)
-> STM m (ExtLedgerState blk) -> STM m (LedgerState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB m blk -> STM m (ExtLedgerState blk)
forall (m :: * -> *) blk.
(Monad (STM m), IsLedger (LedgerState blk)) =>
ChainDB m blk -> STM m (ExtLedgerState blk)
ChainDB.getCurrentLedger ChainDB m blk
chainDB
            , hfbtLedgerConfig :: LedgerConfig blk
hfbtLedgerConfig   = TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig blk
cfg
            , hfbtRegistry :: ResourceRegistry m
hfbtRegistry       = ResourceRegistry m
registry
            , hfbtSystemTime :: SystemTime m
hfbtSystemTime     = SystemTime m
systemTime
            , hfbtTracer :: Tracer m (TraceBlockchainTimeEvent RelativeTime)
hfbtTracer         =
                (TraceBlockchainTimeEvent RelativeTime
 -> TraceBlockchainTimeEvent UTCTime)
-> Tracer m (TraceBlockchainTimeEvent UTCTime)
-> Tracer m (TraceBlockchainTimeEvent RelativeTime)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((RelativeTime -> UTCTime)
-> TraceBlockchainTimeEvent RelativeTime
-> TraceBlockchainTimeEvent UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SystemStart -> RelativeTime -> UTCTime
fromRelativeTime 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)
            , hfbtMaxClockRewind :: NominalDiffTime
hfbtMaxClockRewind = Double -> NominalDiffTime
secondsToNominalDiffTime Double
20
            }

        NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs <-
            (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
 -> NodeKernelArgs
      m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> m (NodeKernelArgs
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> m (NodeKernelArgs
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgsEnforceInvariants (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
 -> NodeKernelArgs
      m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> (NodeKernelArgs
      m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
    -> NodeKernelArgs
         m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs) (m (NodeKernelArgs
      m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
 -> m (NodeKernelArgs
         m (ConnectionId addrNTN) (ConnectionId addrNTC) blk))
-> m (NodeKernelArgs
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> m (NodeKernelArgs
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
forall a b. (a -> b) -> a -> b
$
            ResourceRegistry m
-> Int
-> StdGen
-> TopLevelConfig blk
-> m [BlockForging m blk]
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockchainTime m
-> ChainDB m blk
-> m (NodeKernelArgs
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
forall (m :: * -> *) addrNTN addrNTC blk.
(RunNode blk, IOLike m) =>
ResourceRegistry m
-> Int
-> StdGen
-> TopLevelConfig blk
-> m [BlockForging m blk]
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockchainTime m
-> ChainDB m blk
-> m (NodeKernelArgs
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
mkNodeKernelArgs
              ResourceRegistry m
registry
              Int
llrnBfcSalt
              StdGen
llrnKeepAliveRng
              TopLevelConfig blk
cfg
              m [BlockForging m blk]
blockForging
              Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceConsensus
              BlockchainTime m
btime
              ChainDB m blk
chainDB
        NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel <- NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> m (NodeKernel
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
forall (m :: * -> *) remotePeer localPeer blk.
(IOLike m, RunNode blk, NoThunks remotePeer, Ord remotePeer,
 Hashable remotePeer) =>
NodeKernelArgs m remotePeer localPeer blk
-> m (NodeKernel m remotePeer localPeer blk)
initNodeKernel NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs
        ResourceRegistry m
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> m ()
rnNodeKernelHook ResourceRegistry m
registry NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel

        PeerMetrics m addrNTN
peerMetrics <- m (PeerMetrics m addrNTN)
forall (m :: * -> *) p. MonadSTM m => m (PeerMetrics m p)
newPeerMetric
        let ntnApps :: BlockNodeToNodeVersion blk
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntnApps = NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> PeerMetrics m addrNTN
-> BlockNodeToNodeVersion blk
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
mkNodeToNodeApps   NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel PeerMetrics m addrNTN
peerMetrics
            ntcApps :: BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntcApps = NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
mkNodeToClientApps NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel
            (Applications
  addrNTN
  NodeToNodeVersion
  versionDataNTN
  addrNTC
  NodeToClientVersion
  versionDataNTC
  m
apps, ExtraApplications p2p addrNTN m
appsExtra) = NetworkP2PMode p2p
-> MiniProtocolParameters
-> (BlockNodeToNodeVersion blk
    -> Apps
         m
         (ConnectionId addrNTN)
         ByteString
         ByteString
         ByteString
         ByteString
         ())
-> (BlockNodeToClientVersion blk
    -> NodeToClientVersion
    -> Apps
         m
         (ConnectionId addrNTC)
         ByteString
         ByteString
         ByteString
         ByteString
         ())
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> PeerMetrics m addrNTN
-> (Applications
      addrNTN
      NodeToNodeVersion
      versionDataNTN
      addrNTC
      NodeToClientVersion
      versionDataNTC
      m,
    ExtraApplications p2p addrNTN m)
forall remotePeer localPeer.
NetworkP2PMode p2p
-> MiniProtocolParameters
-> (BlockNodeToNodeVersion blk
    -> Apps
         m
         (ConnectionId addrNTN)
         ByteString
         ByteString
         ByteString
         ByteString
         ())
-> (BlockNodeToClientVersion blk
    -> NodeToClientVersion
    -> Apps
         m
         (ConnectionId addrNTC)
         ByteString
         ByteString
         ByteString
         ByteString
         ())
-> NodeKernel m remotePeer localPeer blk
-> PeerMetrics m addrNTN
-> (Applications
      addrNTN
      NodeToNodeVersion
      versionDataNTN
      addrNTC
      NodeToClientVersion
      versionDataNTC
      m,
    ExtraApplications p2p addrNTN m)
mkDiffusionApplications
                                      NetworkP2PMode p2p
rnEnableP2P
                                      (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> MiniProtocolParameters
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> MiniProtocolParameters
miniProtocolParameters NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs)
                                      BlockNodeToNodeVersion blk
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntnApps
                                      BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntcApps
                                      NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel
                                      PeerMetrics m addrNTN
peerMetrics

        ResourceRegistry m
-> Applications
     addrNTN
     NodeToNodeVersion
     versionDataNTN
     addrNTC
     NodeToClientVersion
     versionDataNTC
     m
-> ExtraApplications p2p addrNTN m
-> m ()
llrnRunDataDiffusion ResourceRegistry m
registry Applications
  addrNTN
  NodeToNodeVersion
  versionDataNTN
  addrNTC
  NodeToClientVersion
  versionDataNTC
  m
apps ExtraApplications p2p addrNTN m
appsExtra
  where
    ProtocolInfo
      { pInfoConfig :: forall (m :: * -> *) b. ProtocolInfo m b -> TopLevelConfig b
pInfoConfig       = TopLevelConfig blk
cfg
      , pInfoInitLedger :: forall (m :: * -> *) b. ProtocolInfo m b -> ExtLedgerState b
pInfoInitLedger   = ExtLedgerState blk
initLedger
      , pInfoBlockForging :: forall (m :: * -> *) b. ProtocolInfo m b -> m [BlockForging m b]
pInfoBlockForging = m [BlockForging m blk]
blockForging
      } = ProtocolInfo m 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 (ConnectionId addrNTN) (ConnectionId addrNTC) blk
      -> NodeKernel     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
      -> PeerMetrics m addrNTN
      -> BlockNodeToNodeVersion blk
      -> NTN.Apps m
          (ConnectionId addrNTN)
          ByteString
          ByteString
          ByteString
          ByteString
          ()
    mkNodeToNodeApps :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> PeerMetrics m addrNTN
-> BlockNodeToNodeVersion blk
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
mkNodeToNodeApps NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel PeerMetrics m addrNTN
peerMetrics BlockNodeToNodeVersion blk
version =
        NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> Tracers m (ConnectionId addrNTN) blk DeserialiseFailure
-> (NodeToNodeVersion
    -> Codecs
         blk
         DeserialiseFailure
         m
         ByteString
         ByteString
         ByteString
         ByteString
         ByteString
         ByteString)
-> ByteLimits ByteString ByteString ByteString ByteString
-> m ChainSyncTimeout
-> ReportPeerMetrics m (ConnectionId addrNTN)
-> Handlers m (ConnectionId addrNTN) blk
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
forall (m :: * -> *) remotePeer localPeer blk e bCS bBF bTX bKA.
(IOLike m, MonadTimer m, Ord remotePeer, Exception e,
 LedgerSupportsProtocol blk, ShowProxy blk, ShowProxy (Header blk),
 ShowProxy (TxId (GenTx blk)), ShowProxy (GenTx blk)) =>
NodeKernel m remotePeer localPeer blk
-> Tracers m remotePeer blk e
-> (NodeToNodeVersion -> Codecs blk e m bCS bCS bBF bBF bTX bKA)
-> ByteLimits bCS bBF bTX bKA
-> m ChainSyncTimeout
-> ReportPeerMetrics m remotePeer
-> Handlers m remotePeer blk
-> Apps m remotePeer bCS bBF bTX bKA ()
NTN.mkApps
          NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel
          Tracers m (ConnectionId addrNTN) blk DeserialiseFailure
rnTraceNTN
          (CodecConfig blk
-> BlockNodeToNodeVersion blk
-> NodeToNodeVersion
-> Codecs
     blk
     DeserialiseFailure
     m
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
forall (m :: * -> *) blk.
(IOLike m, SerialiseNodeToNodeConstraints blk) =>
CodecConfig blk
-> BlockNodeToNodeVersion blk
-> NodeToNodeVersion
-> Codecs
     blk
     DeserialiseFailure
     m
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
NTN.defaultCodecs CodecConfig blk
codecConfig BlockNodeToNodeVersion blk
version)
          ByteLimits ByteString ByteString ByteString ByteString
NTN.byteLimits
          m ChainSyncTimeout
llrnChainSyncTimeout
          (PeerMetrics m addrNTN -> ReportPeerMetrics m (ConnectionId addrNTN)
forall (m :: * -> *) p.
MonadSTM m =>
PeerMetrics m p -> ReportPeerMetrics m (ConnectionId p)
reportMetric PeerMetrics m addrNTN
peerMetrics)
          (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> Handlers m (ConnectionId addrNTN) blk
forall (m :: * -> *) blk remotePeer localPeer.
(IOLike m, MonadTime m, MonadTimer m, LedgerSupportsMempool blk,
 HasTxId (GenTx blk), LedgerSupportsProtocol blk, Ord remotePeer) =>
NodeKernelArgs m remotePeer localPeer blk
-> NodeKernel m remotePeer localPeer blk
-> Handlers m remotePeer blk
NTN.mkHandlers NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel)

    mkNodeToClientApps
      :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
      -> NodeKernel     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
      -> BlockNodeToClientVersion blk
      -> NodeToClientVersion
      -> NTC.Apps m (ConnectionId addrNTC) ByteString ByteString ByteString ByteString ()
    mkNodeToClientApps :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
mkNodeToClientApps NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel BlockNodeToClientVersion blk
blockVersion NodeToClientVersion
networkVersion =
        NodeKernel m (ConnectionId 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 :: * -> *) remotePeer localPeer blk e bCS bTX bSQ bTM.
(IOLike m, Exception e, ShowProxy blk, ShowProxy (ApplyTxErr blk),
 ShowProxy (BlockQuery blk), ShowProxy (GenTx blk),
 ShowProxy (GenTxId blk), ShowQuery (BlockQuery blk)) =>
NodeKernel m remotePeer localPeer blk
-> Tracers m localPeer blk e
-> Codecs blk e m bCS bTX bSQ bTM
-> Handlers m localPeer blk
-> Apps m localPeer bCS bTX bSQ bTM ()
NTC.mkApps
          NodeKernel m (ConnectionId 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,
 ShowQuery (BlockQuery 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 (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> Handlers m (ConnectionId addrNTC) blk
forall (m :: * -> *) blk remotePeer localPeer.
(IOLike m, LedgerSupportsMempool blk, LedgerSupportsProtocol blk,
 QueryLedger blk, ConfigSupportsNode blk) =>
NodeKernelArgs m remotePeer localPeer blk
-> NodeKernel m remotePeer localPeer blk
-> Handlers m localPeer blk
NTC.mkHandlers NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernel)

    mkDiffusionApplications
      :: NetworkP2PMode p2p
      -> MiniProtocolParameters
      -> (   BlockNodeToNodeVersion blk
          -> NTN.Apps
               m
               (ConnectionId addrNTN)
               ByteString
               ByteString
               ByteString
               ByteString
               ()
        )
      -> (   BlockNodeToClientVersion blk
          -> NodeToClientVersion
          -> NTC.Apps
               m (ConnectionId addrNTC) ByteString ByteString ByteString ByteString ()
        )
      -> NodeKernel m remotePeer localPeer blk
      -> PeerMetrics m addrNTN
      -> ( Diffusion.Applications
             addrNTN NodeToNodeVersion   versionDataNTN
             addrNTC NodeToClientVersion versionDataNTC
             m
         , Diffusion.ExtraApplications p2p addrNTN m
         )
    mkDiffusionApplications :: NetworkP2PMode p2p
-> MiniProtocolParameters
-> (BlockNodeToNodeVersion blk
    -> Apps
         m
         (ConnectionId addrNTN)
         ByteString
         ByteString
         ByteString
         ByteString
         ())
-> (BlockNodeToClientVersion blk
    -> NodeToClientVersion
    -> Apps
         m
         (ConnectionId addrNTC)
         ByteString
         ByteString
         ByteString
         ByteString
         ())
-> NodeKernel m remotePeer localPeer blk
-> PeerMetrics m addrNTN
-> (Applications
      addrNTN
      NodeToNodeVersion
      versionDataNTN
      addrNTC
      NodeToClientVersion
      versionDataNTC
      m,
    ExtraApplications p2p addrNTN m)
mkDiffusionApplications
      NetworkP2PMode p2p
enP2P
      MiniProtocolParameters
miniProtocolParams
      BlockNodeToNodeVersion blk
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntnApps
      BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntcApps
      NodeKernel m remotePeer localPeer blk
kernel
      PeerMetrics m addrNTN
peerMetrics =
      case NetworkP2PMode p2p
enP2P of
        NetworkP2PMode p2p
EnabledP2PMode ->
          ( Applications
  addrNTN
  NodeToNodeVersion
  versionDataNTN
  addrNTC
  NodeToClientVersion
  versionDataNTC
  m
apps
          , ApplicationsExtra addrNTN m -> ExtraApplications 'P2P addrNTN m
forall ntnAddr (m :: * -> *).
ApplicationsExtra ntnAddr m -> ExtraApplications 'P2P ntnAddr m
Diffusion.P2PApplications
              ApplicationsExtra :: forall ntnAddr (m :: * -> *).
RethrowPolicy
-> RethrowPolicy
-> PeerMetrics m ntnAddr
-> STM m FetchMode
-> ApplicationsExtra ntnAddr m
P2P.ApplicationsExtra {
                daRethrowPolicy :: RethrowPolicy
P2P.daRethrowPolicy          = Proxy blk -> RethrowPolicy
forall blk.
(Typeable blk, StandardHash blk) =>
Proxy blk -> RethrowPolicy
consensusRethrowPolicy (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk),
                daLocalRethrowPolicy :: RethrowPolicy
P2P.daLocalRethrowPolicy     = RethrowPolicy
localRethrowPolicy,
                daPeerMetrics :: PeerMetrics m addrNTN
P2P.daPeerMetrics            = PeerMetrics m addrNTN
peerMetrics,
                daBlockFetchMode :: STM m FetchMode
P2P.daBlockFetchMode         = NodeKernel m remotePeer localPeer blk -> STM m FetchMode
forall (m :: * -> *) remotePeer localPeer blk.
NodeKernel m remotePeer localPeer blk -> STM m FetchMode
getFetchMode NodeKernel m remotePeer localPeer blk
kernel
              }
          )
        NetworkP2PMode p2p
DisabledP2PMode ->
          ( Applications
  addrNTN
  NodeToNodeVersion
  versionDataNTN
  addrNTC
  NodeToClientVersion
  versionDataNTC
  m
apps
          , ApplicationsExtra -> ExtraApplications 'NonP2P addrNTN m
forall ntnAddr (m :: * -> *).
ApplicationsExtra -> ExtraApplications 'NonP2P ntnAddr m
Diffusion.NonP2PApplications
              ApplicationsExtra :: ErrorPolicies -> ApplicationsExtra
NonP2P.ApplicationsExtra {
                daErrorPolicies :: ErrorPolicies
NonP2P.daErrorPolicies = Proxy blk -> ErrorPolicies
forall blk.
(Typeable blk, StandardHash blk) =>
Proxy blk -> ErrorPolicies
consensusErrorPolicy (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)
              }
          )
      where
        apps :: Applications
  addrNTN
  NodeToNodeVersion
  versionDataNTN
  addrNTC
  NodeToClientVersion
  versionDataNTC
  m
apps = Applications :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData (m :: * -> *).
Versions
  ntnVersion
  ntnVersionData
  (OuroborosBundle 'InitiatorMode ntnAddr ByteString m () Void)
-> Versions
     ntnVersion
     ntnVersionData
     (OuroborosBundle
        'InitiatorResponderMode ntnAddr ByteString m () ())
-> Versions
     ntcVersion
     ntcVersionData
     (OuroborosApplication 'ResponderMode ntcAddr ByteString m Void ())
-> LedgerPeersConsensusInterface m
-> Applications
     ntnAddr
     ntnVersion
     ntnVersionData
     ntcAddr
     ntcVersion
     ntcVersionData
     m
Diffusion.Applications {
            daApplicationInitiatorMode :: Versions
  NodeToNodeVersion
  versionDataNTN
  (OuroborosBundle 'InitiatorMode addrNTN ByteString m () Void)
Diffusion.daApplicationInitiatorMode =
              [Versions
   NodeToNodeVersion
   versionDataNTN
   (OuroborosBundle 'InitiatorMode addrNTN ByteString m () Void)]
-> Versions
     NodeToNodeVersion
     versionDataNTN
     (OuroborosBundle 'InitiatorMode addrNTN ByteString m () Void)
forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions
                [ NodeToNodeVersion
-> versionDataNTN
-> OuroborosBundle 'InitiatorMode addrNTN ByteString m () Void
-> Versions
     NodeToNodeVersion
     versionDataNTN
     (OuroborosBundle 'InitiatorMode addrNTN ByteString m () Void)
forall vNum vData r. vNum -> vData -> r -> Versions vNum vData r
simpleSingletonVersions
                    NodeToNodeVersion
version
                    versionDataNTN
llrnVersionDataNTN
                    (MiniProtocolParameters
-> NodeToNodeVersion
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
-> OuroborosBundle 'InitiatorMode addrNTN ByteString m () Void
forall (m :: * -> *) peer b a.
MiniProtocolParameters
-> NodeToNodeVersion
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosBundle 'InitiatorMode peer b m a Void
NTN.initiator MiniProtocolParameters
miniProtocolParams NodeToNodeVersion
version
                      (Apps
   m
   (ConnectionId addrNTN)
   ByteString
   ByteString
   ByteString
   ByteString
   ()
 -> OuroborosBundle 'InitiatorMode addrNTN ByteString m () Void)
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
-> OuroborosBundle 'InitiatorMode addrNTN ByteString m () Void
forall a b. (a -> b) -> a -> b
$ BlockNodeToNodeVersion blk
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
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
  versionDataNTN
  (OuroborosBundle
     'InitiatorResponderMode addrNTN ByteString m () ())
Diffusion.daApplicationInitiatorResponderMode =
              [Versions
   NodeToNodeVersion
   versionDataNTN
   (OuroborosBundle
      'InitiatorResponderMode addrNTN ByteString m () ())]
-> Versions
     NodeToNodeVersion
     versionDataNTN
     (OuroborosBundle
        'InitiatorResponderMode addrNTN ByteString m () ())
forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions
                [ NodeToNodeVersion
-> versionDataNTN
-> OuroborosBundle
     'InitiatorResponderMode addrNTN ByteString m () ()
-> Versions
     NodeToNodeVersion
     versionDataNTN
     (OuroborosBundle
        'InitiatorResponderMode addrNTN ByteString m () ())
forall vNum vData r. vNum -> vData -> r -> Versions vNum vData r
simpleSingletonVersions
                    NodeToNodeVersion
version
                    versionDataNTN
llrnVersionDataNTN
                    (MiniProtocolParameters
-> NodeToNodeVersion
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
-> OuroborosBundle
     'InitiatorResponderMode addrNTN ByteString m () ()
forall (m :: * -> *) peer b a.
MiniProtocolParameters
-> NodeToNodeVersion
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosBundle 'InitiatorResponderMode peer b m a a
NTN.initiatorAndResponder MiniProtocolParameters
miniProtocolParams NodeToNodeVersion
version
                      (Apps
   m
   (ConnectionId addrNTN)
   ByteString
   ByteString
   ByteString
   ByteString
   ()
 -> OuroborosBundle
      'InitiatorResponderMode addrNTN ByteString m () ())
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
-> OuroborosBundle
     'InitiatorResponderMode addrNTN ByteString m () ()
forall a b. (a -> b) -> a -> b
$ BlockNodeToNodeVersion blk
-> Apps
     m
     (ConnectionId addrNTN)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
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
  versionDataNTC
  (OuroborosApplication 'ResponderMode addrNTC ByteString m Void ())
Diffusion.daLocalResponderApplication =
              [Versions
   NodeToClientVersion
   versionDataNTC
   (OuroborosApplication 'ResponderMode addrNTC ByteString m Void ())]
-> Versions
     NodeToClientVersion
     versionDataNTC
     (OuroborosApplication '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
-> versionDataNTC
-> OuroborosApplication 'ResponderMode addrNTC ByteString m Void ()
-> Versions
     NodeToClientVersion
     versionDataNTC
     (OuroborosApplication 'ResponderMode addrNTC ByteString m Void ())
forall vNum vData r. vNum -> vData -> r -> Versions vNum vData r
simpleSingletonVersions
                    NodeToClientVersion
version
                    versionDataNTC
llrnVersionDataNTC
                    (NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
-> OuroborosApplication 'ResponderMode addrNTC ByteString m Void ()
forall (m :: * -> *) peer b a.
NodeToClientVersion
-> Apps m (ConnectionId peer) b b b b a
-> OuroborosApplication 'ResponderMode peer b m Void a
NTC.responder NodeToClientVersion
version (Apps
   m
   (ConnectionId addrNTC)
   ByteString
   ByteString
   ByteString
   ByteString
   ()
 -> OuroborosApplication
      'ResponderMode addrNTC ByteString m Void ())
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
-> OuroborosApplication '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 m
Diffusion.daLedgerPeersCtx =
              (SlotNo -> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)]))
-> LedgerPeersConsensusInterface m
forall (m :: * -> *).
(SlotNo -> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)]))
-> LedgerPeersConsensusInterface m
LedgerPeersConsensusInterface
                (NodeKernel m remotePeer localPeer blk
-> SlotNo -> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)])
forall (m :: * -> *) blk localPeer remotePeer.
(IOLike m, LedgerSupportsPeerSelection blk, UpdateLedger blk) =>
NodeKernel m remotePeer localPeer blk
-> SlotNo -> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)])
getPeersFromCurrentLedgerAfterSlot NodeKernel m remotePeer localPeer blk
kernel)
          }

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

-- | 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
  -> FilePath
  -> NetworkMagic
  -> (LastShutDownWasClean -> (ChainDB IO blk -> IO a -> IO a) -> IO a)  -- ^ Body action with last shutdown was clean.
  -> IO a
stdWithCheckedDB :: Proxy blk
-> String
-> NetworkMagic
-> (LastShutDownWasClean
    -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
stdWithCheckedDB Proxy blk
pb String
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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO () -> IO ()
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
-> 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
-> HasFS m h
-> (LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
-> m a
runWithCheckedDB Proxy blk
pb HasFS IO HandleIO
hasFS LastShutDownWasClean -> (ChainDB IO blk -> IO a -> IO a) -> IO a
body
  where
    mountPoint :: MountPoint
mountPoint = String -> MountPoint
MountPoint String
databasePath
    hasFS :: HasFS IO HandleIO
hasFS      = MountPoint -> HasFS IO HandleIO
ioHasFS MountPoint
mountPoint

openChainDB
  :: forall m blk. (RunNode blk, IOLike m)
  => ResourceRegistry m
  -> CheckInFuture m blk
  -> TopLevelConfig blk
  -> ExtLedgerState blk
     -- ^ Initial ledger
  -> ChainDbArgs Defaults m blk
  -> (ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk)
      -- ^ Customise the 'ChainDbArgs'
  -> m (ChainDB m blk)
openChainDB :: ResourceRegistry m
-> CheckInFuture m blk
-> TopLevelConfig blk
-> ExtLedgerState blk
-> ChainDbArgs Defaults m blk
-> (ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk)
-> m (ChainDB m blk)
openChainDB ResourceRegistry m
registry CheckInFuture m blk
inFuture TopLevelConfig blk
cfg ExtLedgerState blk
initLedger ChainDbArgs Defaults m blk
defArgs ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
customiseArgs =
    ChainDbArgs Identity m blk -> m (ChainDB m blk)
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk, InspectLedger blk,
 HasHardForkHistory blk, ConvertRawHash blk,
 SerialiseDiskConstraints blk) =>
ChainDbArgs Identity m blk -> m (ChainDB m blk)
ChainDB.openDB ChainDbArgs Identity m blk
args
  where
    args :: ChainDbArgs Identity m blk
    args :: ChainDbArgs Identity m blk
args = ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
customiseArgs (ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk)
-> ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk
forall a b. (a -> b) -> a -> b
$
             ResourceRegistry m
-> CheckInFuture m blk
-> TopLevelConfig blk
-> ExtLedgerState blk
-> ChunkInfo
-> ChainDbArgs Defaults m blk
-> ChainDbArgs Identity m blk
forall (m :: * -> *) blk.
(RunNode blk, IOLike m) =>
ResourceRegistry m
-> CheckInFuture m blk
-> TopLevelConfig blk
-> ExtLedgerState blk
-> ChunkInfo
-> ChainDbArgs Defaults m blk
-> ChainDbArgs Identity m blk
mkChainDbArgs ResourceRegistry m
registry CheckInFuture m blk
inFuture TopLevelConfig blk
cfg ExtLedgerState blk
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))
             ChainDbArgs Defaults m blk
defArgs

mkChainDbArgs
  :: forall m blk. (RunNode blk, IOLike m)
  => ResourceRegistry m
  -> CheckInFuture m blk
  -> TopLevelConfig blk
  -> ExtLedgerState blk
     -- ^ Initial ledger
  -> ChunkInfo
  -> ChainDbArgs Defaults m blk
  -> ChainDbArgs Identity m blk
mkChainDbArgs :: ResourceRegistry m
-> CheckInFuture m blk
-> TopLevelConfig blk
-> ExtLedgerState blk
-> ChunkInfo
-> ChainDbArgs Defaults m blk
-> ChainDbArgs Identity m blk
mkChainDbArgs
  ResourceRegistry m
registry
  CheckInFuture m blk
inFuture
  TopLevelConfig blk
cfg
  ExtLedgerState blk
initLedger
  ChunkInfo
chunkInfo
  ChainDbArgs Defaults m blk
defArgs
  = ChainDbArgs Defaults m blk
defArgs {
      cdbTopLevelConfig :: HKD Identity (TopLevelConfig blk)
ChainDB.cdbTopLevelConfig = HKD Identity (TopLevelConfig blk)
TopLevelConfig blk
cfg
    , cdbChunkInfo :: HKD Identity ChunkInfo
ChainDB.cdbChunkInfo      = HKD Identity ChunkInfo
ChunkInfo
chunkInfo
    , cdbCheckIntegrity :: HKD Identity (blk -> Bool)
ChainDB.cdbCheckIntegrity = 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)
    , cdbGenesis :: HKD Identity (m (ExtLedgerState blk))
ChainDB.cdbGenesis        = ExtLedgerState blk -> m (ExtLedgerState blk)
forall (m :: * -> *) a. Monad m => a -> m a
return ExtLedgerState blk
initLedger
    , cdbCheckInFuture :: HKD Identity (CheckInFuture m blk)
ChainDB.cdbCheckInFuture  = HKD Identity (CheckInFuture m blk)
CheckInFuture m blk
inFuture

    , cdbRegistry :: HKD Identity (ResourceRegistry m)
ChainDB.cdbRegistry       = HKD Identity (ResourceRegistry m)
ResourceRegistry m
registry
    }

mkNodeKernelArgs
  :: forall m addrNTN addrNTC blk. (RunNode blk, IOLike m)
  => ResourceRegistry m
  -> Int
  -> StdGen
  -> TopLevelConfig blk
  -> m [BlockForging m blk]
  -> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
  -> BlockchainTime m
  -> ChainDB m blk
  -> m (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
mkNodeKernelArgs :: ResourceRegistry m
-> Int
-> StdGen
-> TopLevelConfig blk
-> m [BlockForging m blk]
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockchainTime m
-> ChainDB m blk
-> m (NodeKernelArgs
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
mkNodeKernelArgs
  ResourceRegistry m
registry
  Int
bfcSalt
  StdGen
keepAliveRng
  TopLevelConfig blk
cfg
  m [BlockForging m blk]
initBlockForging
  Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers
  BlockchainTime m
btime
  ChainDB m blk
chainDB
  = do
    [BlockForging m blk]
blockForging <- m [BlockForging m blk]
initBlockForging
    NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> m (NodeKernelArgs
        m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
forall (m :: * -> *) a. Monad m => a -> m a
return NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
Tracers m remotePeer localPeer blk
-> ResourceRegistry m
-> TopLevelConfig blk
-> BlockchainTime m
-> ChainDB m blk
-> (StorageConfig blk -> InitChainDB m blk -> m ())
-> (Header blk -> SizeInBytes)
-> [BlockForging m blk]
-> MempoolCapacityBytesOverride
-> MiniProtocolParameters
-> BlockFetchConfiguration
-> StdGen
-> NodeKernelArgs m remotePeer localPeer blk
NodeKernelArgs
      { Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
$sel:tracers:NodeKernelArgs :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers
      , ResourceRegistry m
$sel:registry:NodeKernelArgs :: ResourceRegistry m
registry :: ResourceRegistry m
registry
      , TopLevelConfig blk
$sel:cfg:NodeKernelArgs :: TopLevelConfig blk
cfg :: TopLevelConfig blk
cfg
      , BlockchainTime m
$sel:btime:NodeKernelArgs :: BlockchainTime m
btime :: BlockchainTime m
btime
      , ChainDB m blk
$sel:chainDB:NodeKernelArgs :: ChainDB m blk
chainDB :: ChainDB m blk
chainDB
      , [BlockForging m blk]
$sel:blockForging:NodeKernelArgs :: [BlockForging m blk]
blockForging :: [BlockForging m blk]
blockForging
      , $sel:initChainDB:NodeKernelArgs :: 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 ()
nodeInitChainDB
      , $sel:blockFetchSize:NodeKernelArgs :: Header blk -> SizeInBytes
blockFetchSize          = Header blk -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize
      , $sel:mempoolCapacityOverride:NodeKernelArgs :: MempoolCapacityBytesOverride
mempoolCapacityOverride = MempoolCapacityBytesOverride
NoMempoolCapacityBytesOverride
      , $sel:miniProtocolParameters:NodeKernelArgs :: MiniProtocolParameters
miniProtocolParameters  = MiniProtocolParameters
defaultMiniProtocolParameters
      , $sel:blockFetchConfiguration:NodeKernelArgs :: BlockFetchConfiguration
blockFetchConfiguration = BlockFetchConfiguration
defaultBlockFetchConfiguration
      , StdGen
$sel:keepAliveRng:NodeKernelArgs :: StdGen
keepAliveRng :: StdGen
keepAliveRng
      }
  where
    defaultBlockFetchConfiguration :: BlockFetchConfiguration
    defaultBlockFetchConfiguration :: BlockFetchConfiguration
defaultBlockFetchConfiguration = BlockFetchConfiguration :: Word -> Word -> Word -> DiffTime -> Int -> BlockFetchConfiguration
BlockFetchConfiguration
      { bfcMaxConcurrencyBulkSync :: Word
bfcMaxConcurrencyBulkSync = Word
1
      , bfcMaxConcurrencyDeadline :: Word
bfcMaxConcurrencyDeadline = Word
1
      , bfcMaxRequestsInflight :: Word
bfcMaxRequestsInflight    = MiniProtocolParameters -> Word
blockFetchPipeliningMax MiniProtocolParameters
defaultMiniProtocolParameters
      , bfcDecisionLoopInterval :: DiffTime
bfcDecisionLoopInterval   = DiffTime
0.01 -- 10ms
      , Int
bfcSalt :: Int
bfcSalt :: Int
bfcSalt
      }

-- | 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 (ConnectionId addrNTN) (ConnectionId addrNTC) blk
  -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgsEnforceInvariants :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgsEnforceInvariants NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs = NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nodeKernelArgs
    { $sel:miniProtocolParameters:NodeKernelArgs :: MiniProtocolParameters
miniProtocolParameters = MiniProtocolParameters
miniProtocolParameters
        -- If 'blockFetchPipeliningMax' exceeds the configured default, it
        -- would be a protocol violation.
        { blockFetchPipeliningMax :: Word
blockFetchPipeliningMax =
            Word -> Word -> Word
forall a. Ord a => a -> a -> a
min (MiniProtocolParameters -> Word
blockFetchPipeliningMax MiniProtocolParameters
miniProtocolParameters)
                (MiniProtocolParameters -> Word
blockFetchPipeliningMax MiniProtocolParameters
defaultMiniProtocolParameters)
        }
    , $sel:blockFetchConfiguration:NodeKernelArgs :: BlockFetchConfiguration
blockFetchConfiguration = BlockFetchConfiguration
blockFetchConfiguration
        -- 'bfcMaxRequestsInflight' must be <= 'blockFetchPipeliningMax'
        { bfcMaxRequestsInflight :: Word
bfcMaxRequestsInflight =
            Word -> Word -> Word
forall a. Ord a => a -> a -> a
min (BlockFetchConfiguration -> Word
bfcMaxRequestsInflight BlockFetchConfiguration
blockFetchConfiguration)
                (MiniProtocolParameters -> Word
blockFetchPipeliningMax MiniProtocolParameters
miniProtocolParameters)
        }
    }
  where
    NodeKernelArgs{[BlockForging m blk]
StdGen
MiniProtocolParameters
BlockFetchConfiguration
TopLevelConfig blk
MempoolCapacityBytesOverride
ResourceRegistry m
BlockchainTime m
ChainDB m blk
Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
Header blk -> SizeInBytes
StorageConfig blk -> InitChainDB m blk -> m ()
keepAliveRng :: StdGen
mempoolCapacityOverride :: MempoolCapacityBytesOverride
blockForging :: [BlockForging m blk]
blockFetchSize :: Header blk -> SizeInBytes
initChainDB :: StorageConfig blk -> InitChainDB m blk -> m ()
chainDB :: ChainDB m blk
btime :: BlockchainTime m
cfg :: TopLevelConfig blk
registry :: ResourceRegistry m
tracers :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
blockFetchConfiguration :: BlockFetchConfiguration
miniProtocolParameters :: MiniProtocolParameters
$sel:keepAliveRng:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> StdGen
$sel:blockFetchConfiguration:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk
-> BlockFetchConfiguration
$sel:mempoolCapacityOverride:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk
-> MempoolCapacityBytesOverride
$sel:blockFetchSize:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk
-> Header blk -> SizeInBytes
$sel:initChainDB:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk
-> StorageConfig blk -> InitChainDB m blk -> m ()
$sel:blockForging:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> [BlockForging m blk]
$sel:chainDB:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> ChainDB m blk
$sel:btime:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> BlockchainTime m
$sel:cfg:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> TopLevelConfig blk
$sel:registry:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> ResourceRegistry m
$sel:tracers:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk
-> Tracers m remotePeer localPeer blk
$sel:miniProtocolParameters:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk -> MiniProtocolParameters
..} = NodeKernelArgs m (ConnectionId 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 :: String -> RelativeMountPoint -> SomeHasFS IO
stdMkChainDbHasFS String
rootPath (ChainDB.RelativeMountPoint String
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
ioHasFS (MountPoint -> HasFS IO HandleIO)
-> MountPoint -> HasFS IO HandleIO
forall a b. (a -> b) -> a -> b
$ String -> MountPoint
MountPoint (String -> MountPoint) -> String -> MountPoint
forall a b. (a -> b) -> a -> b
$ String
rootPath String -> ShowS
</> String
relPath

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

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

stdChainSyncTimeout :: IO NTN.ChainSyncTimeout
stdChainSyncTimeout :: IO ChainSyncTimeout
stdChainSyncTimeout = do
    -- These values approximately correspond to false positive
    -- thresholds for streaks of empty slots with 99% probability,
    -- 99.9% probability up to 99.999% probability.
    -- t = T_s [log (1-Y) / log (1-f)]
    -- Y = [0.99, 0.999...]
    -- T_s = slot length of 1s.
    -- f = 0.05
    -- The timeout is randomly picked per bearer to avoid all bearers
    -- going down at the same time in case of a long streak of empty
    -- slots. TODO: workaround until peer selection governor.
    Maybe DiffTime
mustReplyTimeout <- DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just (DiffTime -> Maybe DiffTime) -> IO DiffTime -> IO (Maybe DiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DiffTime] -> IO DiffTime
forall (m :: * -> *) b. MonadIO m => [b] -> m b
randomElem [DiffTime
90, DiffTime
135, DiffTime
180, DiffTime
224, DiffTime
269]
    ChainSyncTimeout -> IO ChainSyncTimeout
forall (m :: * -> *) a. Monad m => a -> m a
return ChainSyncTimeout :: Maybe DiffTime
-> Maybe DiffTime -> Maybe DiffTime -> ChainSyncTimeout
NTN.ChainSyncTimeout
      { canAwaitTimeout :: Maybe DiffTime
canAwaitTimeout  = Maybe DiffTime
shortWait
      , intersectTimeout :: Maybe DiffTime
intersectTimeout = Maybe DiffTime
shortWait
      , Maybe DiffTime
mustReplyTimeout :: Maybe DiffTime
mustReplyTimeout :: Maybe DiffTime
mustReplyTimeout
      }
  where
    randomElem :: [b] -> m b
randomElem [b]
xs = do
      Int
ix <- (Int, Int) -> m Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ [b]
xs [b] -> Int -> b
forall a. [a] -> Int -> a
!! Int
ix

stdVersionDataNTN :: NetworkMagic -> DiffusionMode -> NodeToNodeVersionData
stdVersionDataNTN :: NetworkMagic -> DiffusionMode -> NodeToNodeVersionData
stdVersionDataNTN NetworkMagic
networkMagic DiffusionMode
diffusionMode = NodeToNodeVersionData :: NetworkMagic -> DiffusionMode -> NodeToNodeVersionData
NodeToNodeVersionData
    { NetworkMagic
networkMagic :: NetworkMagic
networkMagic :: NetworkMagic
networkMagic
    , DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode :: DiffusionMode
diffusionMode
    }

stdVersionDataNTC :: NetworkMagic -> NodeToClientVersionData
stdVersionDataNTC :: NetworkMagic -> NodeToClientVersionData
stdVersionDataNTC NetworkMagic
networkMagic = NodeToClientVersionData :: NetworkMagic -> NodeToClientVersionData
NodeToClientVersionData
    { NetworkMagic
networkMagic :: NetworkMagic
networkMagic :: NetworkMagic
networkMagic
    }

stdRunDataDiffusion ::
     Diffusion.Tracers
       RemoteAddress  NodeToNodeVersion
       LocalAddress   NodeToClientVersion
       IO
  -> Diffusion.ExtraTracers p2p
  -> Diffusion.Arguments
       Socket      RemoteAddress
       LocalSocket LocalAddress
  -> Diffusion.ExtraArguments p2p IO
  -> Diffusion.Applications
       RemoteAddress  NodeToNodeVersion   NodeToNodeVersionData
       LocalAddress   NodeToClientVersion NodeToClientVersionData
       IO
  -> Diffusion.ExtraApplications p2p RemoteAddress IO
  -> IO ()
stdRunDataDiffusion :: Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Arguments Socket RemoteAddress LocalSocket LocalAddress
-> ExtraArguments p2p IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ExtraApplications p2p RemoteAddress IO
-> IO ()
stdRunDataDiffusion = Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Arguments Socket RemoteAddress LocalSocket LocalAddress
-> ExtraArguments p2p IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ExtraApplications p2p RemoteAddress IO
-> IO ()
forall (p2p :: P2P).
Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Arguments Socket RemoteAddress LocalSocket LocalAddress
-> ExtraArguments p2p IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ExtraApplications p2p RemoteAddress IO
-> IO ()
Diffusion.run

-- | 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) = StdRunNodeArgs
  { StdRunNodeArgs m blk p2p -> Maybe Word
srnBfcMaxConcurrencyBulkSync    :: Maybe Word
  , StdRunNodeArgs m blk p2p -> Maybe Word
srnBfcMaxConcurrencyDeadline    :: Maybe Word
  , StdRunNodeArgs m blk p2p -> Bool
srnChainDbValidateOverride      :: Bool
    -- ^ If @True@, validate the ChainDB on init no matter what
  , StdRunNodeArgs m blk p2p -> SnapshotInterval
srnSnapshotInterval             :: SnapshotInterval
  , StdRunNodeArgs m blk p2p -> String
srnDatabasePath                 :: FilePath
    -- ^ Location of the DBs
  , StdRunNodeArgs m blk p2p
-> Arguments Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments           :: Diffusion.Arguments
                                         Socket      RemoteAddress
                                         LocalSocket LocalAddress
  , StdRunNodeArgs m blk p2p -> ExtraArguments p2p m
srnDiffusionArgumentsExtra      :: Diffusion.ExtraArguments p2p m
  , StdRunNodeArgs m blk p2p
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionTracers             :: Diffusion.Tracers
                                         RemoteAddress  NodeToNodeVersion
                                         LocalAddress   NodeToClientVersion
                                         IO
  , StdRunNodeArgs m blk p2p -> ExtraTracers p2p
srnDiffusionTracersExtra        :: Diffusion.ExtraTracers p2p
  , StdRunNodeArgs m blk p2p -> 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)
  , StdRunNodeArgs m blk p2p -> Tracer m (TraceEvent blk)
srnTraceChainDB                 :: Tracer m (ChainDB.TraceEvent blk)
  , StdRunNodeArgs m blk p2p -> Maybe MempoolCapacityBytesOverride
srnMaybeMempoolCapacityOverride :: Maybe MempoolCapacityBytesOverride
    -- ^ Determine whether to use the system default mempool capacity or explicitly set
    -- capacity of the mempool.
  }

-- | Conveniently packaged 'LowLevelRunNodeArgs' arguments from a standard
-- non-testing invocation.
stdLowLevelRunNodeArgsIO ::
     forall blk p2p. RunNode blk
  => RunNodeArgs IO RemoteAddress LocalAddress blk p2p
  -> StdRunNodeArgs IO blk p2p
  -> IO (LowLevelRunNodeArgs
          IO
          RemoteAddress
          LocalAddress
          NodeToNodeVersionData
          NodeToClientVersionData
          blk
          p2p)
stdLowLevelRunNodeArgsIO :: RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> StdRunNodeArgs IO blk p2p
-> IO
     (LowLevelRunNodeArgs
        IO
        RemoteAddress
        LocalAddress
        NodeToNodeVersionData
        NodeToClientVersionData
        blk
        p2p)
stdLowLevelRunNodeArgsIO RunNodeArgs{ ProtocolInfo IO blk
rnProtocolInfo :: ProtocolInfo IO blk
rnProtocolInfo :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> ProtocolInfo m blk
rnProtocolInfo, NetworkP2PMode p2p
rnEnableP2P :: NetworkP2PMode p2p
rnEnableP2P :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> NetworkP2PMode p2p
rnEnableP2P }
                         StdRunNodeArgs{Bool
String
Maybe Word
Maybe MempoolCapacityBytesOverride
Tracer IO (TraceEvent blk)
ExtraTracers p2p
ExtraArguments p2p IO
Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
Arguments Socket RemoteAddress LocalSocket LocalAddress
SnapshotInterval
srnMaybeMempoolCapacityOverride :: Maybe MempoolCapacityBytesOverride
srnTraceChainDB :: Tracer IO (TraceEvent blk)
srnEnableInDevelopmentVersions :: Bool
srnDiffusionTracersExtra :: ExtraTracers p2p
srnDiffusionTracers :: Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionArgumentsExtra :: ExtraArguments p2p IO
srnDiffusionArguments :: Arguments Socket RemoteAddress LocalSocket LocalAddress
srnDatabasePath :: String
srnSnapshotInterval :: SnapshotInterval
srnChainDbValidateOverride :: Bool
srnBfcMaxConcurrencyDeadline :: Maybe Word
srnBfcMaxConcurrencyBulkSync :: Maybe Word
srnMaybeMempoolCapacityOverride :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Maybe MempoolCapacityBytesOverride
srnTraceChainDB :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Tracer m (TraceEvent blk)
srnEnableInDevelopmentVersions :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Bool
srnDiffusionTracersExtra :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> ExtraTracers p2p
srnDiffusionTracers :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionArgumentsExtra :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> ExtraArguments p2p m
srnDiffusionArguments :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p
-> Arguments Socket RemoteAddress LocalSocket LocalAddress
srnDatabasePath :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> String
srnSnapshotInterval :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> SnapshotInterval
srnChainDbValidateOverride :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Bool
srnBfcMaxConcurrencyDeadline :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Maybe Word
srnBfcMaxConcurrencyBulkSync :: forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Maybe Word
..} = do
    Int
llrnBfcSalt      <- IO Int
stdBfcSaltIO
    StdGen
llrnKeepAliveRng <- IO StdGen
stdKeepAliveRngIO
    LowLevelRunNodeArgs
  IO
  RemoteAddress
  LocalAddress
  NodeToNodeVersionData
  NodeToClientVersionData
  blk
  p2p
-> IO
     (LowLevelRunNodeArgs
        IO
        RemoteAddress
        LocalAddress
        NodeToNodeVersionData
        NodeToClientVersionData
        blk
        p2p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LowLevelRunNodeArgs :: forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
(forall a.
 (LastShutDownWasClean -> (ChainDB m blk -> m a -> m a) -> m a)
 -> m a)
-> ChainDbArgs Defaults m blk
-> (ChainDbArgs Identity m blk -> ChainDbArgs Identity m blk)
-> (NodeKernelArgs
      m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
    -> NodeKernelArgs
         m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> Int
-> StdGen
-> (HardForkBlockchainTimeArgs m blk
    -> HardForkBlockchainTimeArgs m blk)
-> m ChainSyncTimeout
-> (ResourceRegistry m
    -> Applications
         addrNTN
         NodeToNodeVersion
         versionDataNTN
         addrNTC
         NodeToClientVersion
         versionDataNTC
         m
    -> ExtraApplications p2p addrNTN m
    -> m ())
-> versionDataNTC
-> versionDataNTN
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> ClockSkew
-> LowLevelRunNodeArgs
     m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
LowLevelRunNodeArgs
      { Int
llrnBfcSalt :: Int
llrnBfcSalt :: Int
llrnBfcSalt
      , llrnChainSyncTimeout :: IO ChainSyncTimeout
llrnChainSyncTimeout = IO ChainSyncTimeout
stdChainSyncTimeout
      , llrnCustomiseHardForkBlockchainTimeArgs :: HardForkBlockchainTimeArgs IO blk
-> HardForkBlockchainTimeArgs IO blk
llrnCustomiseHardForkBlockchainTimeArgs = HardForkBlockchainTimeArgs IO blk
-> HardForkBlockchainTimeArgs IO blk
forall a. a -> a
id
      , StdGen
llrnKeepAliveRng :: StdGen
llrnKeepAliveRng :: StdGen
llrnKeepAliveRng
      , llrnChainDbArgsDefaults :: ChainDbArgs Defaults IO blk
llrnChainDbArgsDefaults =
          ChainDbArgs Defaults IO blk -> ChainDbArgs Defaults IO blk
updateChainDbDefaults (ChainDbArgs Defaults IO blk -> ChainDbArgs Defaults IO blk)
-> ChainDbArgs Defaults IO blk -> ChainDbArgs Defaults IO blk
forall a b. (a -> b) -> a -> b
$ (RelativeMountPoint -> SomeHasFS IO)
-> DiskPolicy -> ChainDbArgs Defaults IO blk
forall (m :: * -> *) blk.
Monad m =>
(RelativeMountPoint -> SomeHasFS m)
-> DiskPolicy -> ChainDbArgs Defaults m blk
ChainDB.defaultArgs RelativeMountPoint -> SomeHasFS IO
mkHasFS DiskPolicy
diskPolicy
      , llrnCustomiseChainDbArgs :: ChainDbArgs Identity IO blk -> ChainDbArgs Identity IO blk
llrnCustomiseChainDbArgs = ChainDbArgs Identity IO blk -> ChainDbArgs Identity IO blk
forall a. a -> a
id
      , NodeKernelArgs
  IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> NodeKernelArgs
     IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
forall (m :: * -> *) addrNTN addrNTC.
NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC.
NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs :: NodeKernelArgs
  IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
-> NodeKernelArgs
     IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk
llrnCustomiseNodeKernelArgs
      , llrnRunDataDiffusion :: ResourceRegistry IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ExtraApplications p2p RemoteAddress IO
-> IO ()
llrnRunDataDiffusion =
          \ResourceRegistry IO
_reg Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
apps ExtraApplications p2p RemoteAddress IO
extraApps ->
            Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Arguments Socket RemoteAddress LocalSocket LocalAddress
-> ExtraArguments p2p IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ExtraApplications p2p RemoteAddress IO
-> IO ()
forall (p2p :: P2P).
Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Arguments Socket RemoteAddress LocalSocket LocalAddress
-> ExtraArguments p2p IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
-> ExtraApplications p2p RemoteAddress IO
-> IO ()
stdRunDataDiffusion Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionTracers
                                ExtraTracers p2p
srnDiffusionTracersExtra
                                Arguments Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments
                                ExtraArguments p2p IO
srnDiffusionArgumentsExtra
                                Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
apps ExtraApplications p2p RemoteAddress IO
extraApps
      , llrnVersionDataNTC :: NodeToClientVersionData
llrnVersionDataNTC =
          NetworkMagic -> NodeToClientVersionData
stdVersionDataNTC NetworkMagic
networkMagic
      , llrnVersionDataNTN :: NodeToNodeVersionData
llrnVersionDataNTN =
          NetworkMagic -> DiffusionMode -> NodeToNodeVersionData
stdVersionDataNTN
            NetworkMagic
networkMagic
            (case NetworkP2PMode p2p
rnEnableP2P of
               NetworkP2PMode p2p
EnabledP2PMode  -> Arguments Socket RemoteAddress LocalSocket LocalAddress
-> DiffusionMode
forall ntnFd ntnAddr ntcFd ntcAddr.
Arguments ntnFd ntnAddr ntcFd ntcAddr -> DiffusionMode
Diffusion.daMode Arguments 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
            )
      , llrnNodeToNodeVersions :: Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
llrnNodeToNodeVersions =
          ((Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
 -> Maybe NodeToNodeVersion)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
forall k v.
Ord k =>
((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe k)
-> Map k v -> Map k v
limitToLatestReleasedVersion
            (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
-> Maybe NodeToNodeVersion
forall a b. (a, b) -> a
fst
            (Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk))
      , llrnNodeToClientVersions :: Map NodeToClientVersion (BlockNodeToClientVersion blk)
llrnNodeToClientVersions =
          ((Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
 -> Maybe NodeToClientVersion)
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
forall k v.
Ord k =>
((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe k)
-> Map k v -> Map k v
limitToLatestReleasedVersion
            (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
-> Maybe NodeToClientVersion
forall a b. (a, b) -> b
snd
            (Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk))
      , llrnWithCheckedDB :: forall a.
(LastShutDownWasClean -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
llrnWithCheckedDB =
          Proxy blk
-> String
-> NetworkMagic
-> (LastShutDownWasClean
    -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
forall blk a.
(StandardHash blk, Typeable blk) =>
Proxy blk
-> String
-> NetworkMagic
-> (LastShutDownWasClean
    -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
stdWithCheckedDB (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) String
srnDatabasePath NetworkMagic
networkMagic
      , llrnMaxClockSkew :: ClockSkew
llrnMaxClockSkew =
          ClockSkew
InFuture.defaultClockSkew
      }
  where
    diskPolicy :: DiskPolicy
diskPolicy =
      let
        cfg :: TopLevelConfig blk
cfg = ProtocolInfo IO blk -> TopLevelConfig blk
forall (m :: * -> *) b. ProtocolInfo m b -> TopLevelConfig b
pInfoConfig ProtocolInfo IO blk
rnProtocolInfo
        k :: SecurityParam
k   = TopLevelConfig blk -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam TopLevelConfig blk
cfg
      in SecurityParam -> SnapshotInterval -> DiskPolicy
defaultDiskPolicy SecurityParam
k SnapshotInterval
srnSnapshotInterval

    mkHasFS :: ChainDB.RelativeMountPoint -> SomeHasFS IO
    mkHasFS :: RelativeMountPoint -> SomeHasFS IO
mkHasFS = String -> RelativeMountPoint -> SomeHasFS IO
stdMkChainDbHasFS String
srnDatabasePath

    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 IO blk -> TopLevelConfig blk
forall (m :: * -> *) b. ProtocolInfo m b -> TopLevelConfig b
pInfoConfig ProtocolInfo IO blk
rnProtocolInfo

    updateChainDbDefaults ::
         ChainDbArgs Defaults IO blk
      -> ChainDbArgs Defaults IO blk
    updateChainDbDefaults :: ChainDbArgs Defaults IO blk -> ChainDbArgs Defaults IO blk
updateChainDbDefaults =
        (\ChainDbArgs Defaults IO blk
x -> ChainDbArgs Defaults IO blk
x { cdbTracer :: Tracer IO (TraceEvent blk)
ChainDB.cdbTracer = Tracer IO (TraceEvent blk)
srnTraceChainDB }) (ChainDbArgs Defaults IO blk -> ChainDbArgs Defaults IO blk)
-> (ChainDbArgs Defaults IO blk -> ChainDbArgs Defaults IO blk)
-> ChainDbArgs Defaults IO blk
-> ChainDbArgs Defaults IO blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (if Bool -> Bool
not Bool
srnChainDbValidateOverride then ChainDbArgs Defaults IO blk -> ChainDbArgs Defaults IO blk
forall a. a -> a
id else \ChainDbArgs Defaults IO blk
x -> ChainDbArgs Defaults IO blk
x
          { cdbImmutableDbValidation :: ValidationPolicy
ChainDB.cdbImmutableDbValidation = ValidationPolicy
ValidateAllChunks
          , cdbVolatileDbValidation :: BlockValidationPolicy
ChainDB.cdbVolatileDbValidation  = BlockValidationPolicy
ValidateAll
          })

    llrnCustomiseNodeKernelArgs ::
         NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
      -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
    llrnCustomiseNodeKernelArgs :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs =
        (BlockFetchConfiguration -> BlockFetchConfiguration)
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
forall (m :: * -> *) addrNTN addrNTC blk.
(BlockFetchConfiguration -> BlockFetchConfiguration)
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
overBlockFetchConfiguration BlockFetchConfiguration -> BlockFetchConfiguration
modifyBlockFetchConfiguration
      (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
 -> NodeKernelArgs
      m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> (NodeKernelArgs
      m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
    -> NodeKernelArgs
         m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId 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 :: Word
bfcMaxConcurrencyDeadline = Word
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 :: Word
bfcMaxConcurrencyBulkSync = Word
mc })
              Maybe Word
srnBfcMaxConcurrencyBulkSync
        modifyMempoolCapacityOverride :: NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
modifyMempoolCapacityOverride =
            (NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
 -> NodeKernelArgs
      m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> (MempoolCapacityBytesOverride
    -> NodeKernelArgs
         m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
    -> NodeKernelArgs
         m (ConnectionId addrNTN) (ConnectionId addrNTC) blk)
-> Maybe MempoolCapacityBytesOverride
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
forall a. a -> a
id
              (\MempoolCapacityBytesOverride
mc NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nka -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
nka { $sel:mempoolCapacityOverride:NodeKernelArgs :: MempoolCapacityBytesOverride
mempoolCapacityOverride = MempoolCapacityBytesOverride
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 :: ((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 (Proxy blk
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 (ConnectionId addrNTN) (ConnectionId addrNTC) blk
  -> NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
overBlockFetchConfiguration :: (BlockFetchConfiguration -> BlockFetchConfiguration)
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> NodeKernelArgs
     m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
overBlockFetchConfiguration BlockFetchConfiguration -> BlockFetchConfiguration
f NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
args = NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
args {
      $sel:blockFetchConfiguration:NodeKernelArgs :: BlockFetchConfiguration
blockFetchConfiguration = BlockFetchConfiguration -> BlockFetchConfiguration
f BlockFetchConfiguration
blockFetchConfiguration
    }
  where
    NodeKernelArgs { BlockFetchConfiguration
blockFetchConfiguration :: BlockFetchConfiguration
$sel:blockFetchConfiguration:NodeKernelArgs :: forall (m :: * -> *) remotePeer localPeer blk.
NodeKernelArgs m remotePeer localPeer blk
-> BlockFetchConfiguration
blockFetchConfiguration } = NodeKernelArgs m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
args