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

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

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

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

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

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

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

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

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

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

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

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

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

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


-- | Arguments that usually only tests /directly/ specify.
--
-- A non-testing invocation probably wouldn't explicitly provide these values to
-- 'runWith'. The @cardano-node@, for example, instead calls the 'run'
-- abbreviation, which uses 'stdLowLevelRunNodeArgsIO' to indirectly specify
-- these low-level values from the higher-level 'StdRunNodeArgs'.
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'.
      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
llrnWithCheckedDB :: forall a. (  LastShutDownWasClean
                                     -> (ChainDB m blk -> m a -> m a)
                                     -> m a)
                        -> m a

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

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

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

      -- | Customise the 'ChainDbArgs'
    , forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
LowLevelRunNodeArgs
  m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
llrnCustomiseChainDbArgs ::
           Complete ChainDbArgs m blk
        -> Complete ChainDbArgs m blk

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Higher-level arguments that can determine the 'LowLevelRunNodeArgs' under
-- some usual assumptions for realistic use cases such as in @cardano-node@.
--
-- See 'stdLowLevelRunNodeArgsIO'.
data StdRunNodeArgs m blk (p2p :: Diffusion.P2P) = StdRunNodeArgs
  { forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Maybe Word
srnBfcMaxConcurrencyBulkSync    :: Maybe Word
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Maybe Word
srnBfcMaxConcurrencyDeadline    :: Maybe Word
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Bool
srnChainDbValidateOverride      :: Bool
    -- ^ If @True@, validate the ChainDB on init no matter what
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> DiskPolicyArgs
srnDiskPolicyArgs               :: DiskPolicyArgs
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> NodeDatabasePaths
srnDatabasePath                 :: NodeDatabasePaths
    -- ^ Location of the DBs
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments           :: Diffusion.Arguments
                                         IO
                                         Socket      RemoteAddress
                                         LocalSocket LocalAddress
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> ExtraArguments p2p m
srnDiffusionArgumentsExtra      :: Diffusion.ExtraArguments p2p m
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p
-> Tracers
     RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionTracers             :: Diffusion.Tracers
                                         RemoteAddress  NodeToNodeVersion
                                         LocalAddress   NodeToClientVersion
                                         IO
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> ExtraTracers p2p
srnDiffusionTracersExtra        :: Diffusion.ExtraTracers p2p
  , forall (m :: * -> *) blk (p2p :: 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)
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Tracer m (TraceEvent blk)
srnTraceChainDB                 :: Tracer m (ChainDB.TraceEvent blk)
  , forall (m :: * -> *) blk (p2p :: P2P).
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.
  , forall (m :: * -> *) blk (p2p :: P2P).
StdRunNodeArgs m blk p2p -> Maybe (m ChainSyncTimeout)
srnChainSyncTimeout             :: Maybe (m NTN.ChainSyncTimeout)
    -- ^ A custom timeout for ChainSync.
  }

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

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

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

pure []

-- | Combination of 'runWith' and 'stdLowLevelRunArgsIO'
run :: forall blk p2p.
     RunNode blk
  => RunNodeArgs IO RemoteAddress LocalAddress blk p2p
  -> StdRunNodeArgs IO blk p2p
  -> IO ()
run :: forall blk (p2p :: P2P).
RunNode blk =>
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RunNodeArgs IO RemoteAddress LocalAddress blk p2p
-> (NodeToNodeVersion -> RemoteAddress -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s RemoteAddress)
-> LowLevelRunNodeArgs
     IO
     RemoteAddress
     LocalAddress
     NodeToNodeVersionData
     NodeToClientVersionData
     blk
     p2p
-> IO ()
forall (m :: * -> *) addrNTN addrNTC versionDataNTN versionDataNTC
       blk (p2p :: P2P).
(RunNode blk, IOLike m, Hashable addrNTN, NetworkIO m,
 NetworkAddr addrNTN) =>
RunNodeArgs m addrNTN addrNTC blk p2p
-> (NodeToNodeVersion -> addrNTN -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addrNTN)
-> LowLevelRunNodeArgs
     m addrNTN addrNTC versionDataNTN versionDataNTC blk p2p
-> m ()
runWith RunNodeArgs IO RemoteAddress LocalAddress blk p2p
args NodeToNodeVersion -> RemoteAddress -> Encoding
encodeRemoteAddress NodeToNodeVersion -> Decoder s RemoteAddress
NodeToNodeVersion -> forall s. Decoder s RemoteAddress
forall s. NodeToNodeVersion -> Decoder s RemoteAddress
decodeRemoteAddress


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

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

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

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

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

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

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

        [SanityCheckIssue] -> (SanityCheckIssue -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (TopLevelConfig blk -> [SanityCheckIssue]
forall blk.
BlockSupportsSanityCheck blk =>
TopLevelConfig blk -> [SanityCheckIssue]
sanityCheckConfig TopLevelConfig blk
cfg) ((SanityCheckIssue -> m ()) -> m ())
-> (SanityCheckIssue -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SanityCheckIssue
issue ->
          Tracer m SanityCheckIssue -> SanityCheckIssue -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> Tracer m SanityCheckIssue
forall remotePeer localPeer blk (f :: * -> *).
Tracers' remotePeer localPeer blk f -> f SanityCheckIssue
consensusSanityCheckTracer Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceConsensus) SanityCheckIssue
issue

        (ChainDB m blk
chainDB, Complete ChainDbArgs m blk
finalArgs) <- ResourceRegistry m
-> TopLevelConfig blk
-> ExtLedgerState blk
-> (RelativeMountPoint -> SomeHasFS m)
-> (RelativeMountPoint -> SomeHasFS m)
-> Incomplete ChainDbArgs m blk
-> (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> m (ChainDB m blk, Complete ChainDbArgs m blk)
forall (m :: * -> *) blk.
(RunNode blk, IOLike m) =>
ResourceRegistry m
-> TopLevelConfig blk
-> ExtLedgerState blk
-> (RelativeMountPoint -> SomeHasFS m)
-> (RelativeMountPoint -> SomeHasFS m)
-> Incomplete ChainDbArgs m blk
-> (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> m (ChainDB m blk, Complete ChainDbArgs m blk)
openChainDB
                     ResourceRegistry m
registry
                     TopLevelConfig blk
cfg
                     ExtLedgerState blk
initLedger
                     RelativeMountPoint -> SomeHasFS m
llrnMkImmutableHasFS
                     RelativeMountPoint -> SomeHasFS m
llrnMkVolatileHasFS
                     Incomplete ChainDbArgs m blk
llrnChainDbArgsDefaults
                     (  Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
setLoEinChainDbArgs
                      (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> Complete ChainDbArgs m blk
-> Complete ChainDbArgs m blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
maybeValidateAll
                      (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
-> Complete ChainDbArgs m blk
-> Complete ChainDbArgs m blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
llrnCustomiseChainDbArgs
                     )

        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
              { hfbtBackoffDelay :: m BackoffDelay
hfbtBackoffDelay   = BackoffDelay -> m BackoffDelay
forall a. a -> m a
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 a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap ((RelativeTime -> UTCTime)
-> TraceBlockchainTimeEvent RelativeTime
-> TraceBlockchainTimeEvent UTCTime
forall a b.
(a -> b)
-> TraceBlockchainTimeEvent a -> TraceBlockchainTimeEvent b
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 addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs <- do
              WrapDurationUntilTooOld m blk
durationUntilTooOld <- LedgerConfig blk
-> STM m (LedgerState blk)
-> NominalDiffTime
-> SystemTime m
-> m (WrapDurationUntilTooOld m blk)
forall blk (m :: * -> *).
(HasHardForkHistory blk, MonadSTM m) =>
LedgerConfig blk
-> STM m (LedgerState blk)
-> NominalDiffTime
-> SystemTime m
-> m (WrapDurationUntilTooOld m blk)
GSM.realDurationUntilTooOld
                (TopLevelConfig blk -> LedgerConfig blk
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig blk
cfg)
                (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)
                NominalDiffTime
llrnMaxCaughtUpAge
                SystemTime m
systemTime
              let gsmMarkerFileView :: MarkerFileView m
gsmMarkerFileView =
                    case ChainDbSpecificArgs Identity m blk -> HKD Identity (SomeHasFS m)
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbSpecificArgs f m blk -> HKD f (SomeHasFS m)
ChainDB.cdbsHasFSGsmDB (ChainDbSpecificArgs Identity m blk -> HKD Identity (SomeHasFS m))
-> ChainDbSpecificArgs Identity m blk -> HKD Identity (SomeHasFS m)
forall a b. (a -> b) -> a -> b
$ Complete ChainDbArgs m blk -> ChainDbSpecificArgs Identity m blk
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbArgs f m blk -> ChainDbSpecificArgs f m blk
ChainDB.cdbsArgs Complete ChainDbArgs m blk
finalArgs of
                        SomeHasFS HasFS m h
x -> ChainDB m blk -> HasFS m h -> MarkerFileView m
forall (m :: * -> *) blk h.
MonadThrow m =>
ChainDB m blk -> HasFS m h -> MarkerFileView m
GSM.realMarkerFileView ChainDB m blk
chainDB HasFS m h
x
                  historicityCheck :: m GsmState -> HistoricityCheck m blk
historicityCheck m GsmState
getGsmState =
                    case GenesisConfig -> Maybe HistoricityCutoff
gcHistoricityCutoff GenesisConfig
llrnGenesisConfig of
                      Maybe HistoricityCutoff
Nothing                -> HistoricityCheck m blk
forall (m :: * -> *) blk. Applicative m => HistoricityCheck m blk
HistoricityCheck.noCheck
                      Just HistoricityCutoff
historicityCutoff ->
                        SystemTime m
-> m GsmState -> HistoricityCutoff -> HistoricityCheck m blk
forall (m :: * -> *) blk.
(Monad m, HasHeader blk, HasAnnTip blk) =>
SystemTime m
-> m GsmState -> HistoricityCutoff -> HistoricityCheck m blk
HistoricityCheck.mkCheck SystemTime m
systemTime m GsmState
getGsmState HistoricityCutoff
historicityCutoff
              (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
 -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgsEnforceInvariants (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
 -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
    -> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs)
                (m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
 -> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk))
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
forall a b. (a -> b) -> a -> b
$ ResourceRegistry m
-> Int
-> StdGen
-> StdGen
-> TopLevelConfig blk
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockchainTime m
-> SomeHeaderInFutureCheck m blk
-> (m GsmState -> HistoricityCheck m blk)
-> ChainDB m blk
-> NominalDiffTime
-> Maybe (WrapDurationUntilTooOld m blk)
-> MarkerFileView m
-> STM m UseBootstrapPeers
-> StrictTVar m (PublicPeerSelectionState addrNTN)
-> GenesisNodeKernelArgs m blk
-> DiffusionPipeliningSupport
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
forall (m :: * -> *) addrNTN addrNTC blk.
(RunNode blk, IOLike m) =>
ResourceRegistry m
-> Int
-> StdGen
-> StdGen
-> TopLevelConfig blk
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockchainTime m
-> SomeHeaderInFutureCheck m blk
-> (m GsmState -> HistoricityCheck m blk)
-> ChainDB m blk
-> NominalDiffTime
-> Maybe (WrapDurationUntilTooOld m blk)
-> MarkerFileView m
-> STM m UseBootstrapPeers
-> StrictTVar m (PublicPeerSelectionState addrNTN)
-> GenesisNodeKernelArgs m blk
-> DiffusionPipeliningSupport
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
mkNodeKernelArgs
                    ResourceRegistry m
registry
                    Int
llrnBfcSalt
                    StdGen
llrnGsmAntiThunderingHerd
                    StdGen
llrnKeepAliveRng
                    TopLevelConfig blk
cfg
                    Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
rnTraceConsensus
                    BlockchainTime m
btime
                    (ClockSkew -> SystemTime m -> SomeHeaderInFutureCheck m blk
forall blk (m :: * -> *).
(HasHeader blk, HasHeader (Header blk), HasHardForkHistory blk,
 MonadDelay m) =>
ClockSkew -> SystemTime m -> SomeHeaderInFutureCheck m blk
InFutureCheck.realHeaderInFutureCheck ClockSkew
llrnMaxClockSkew SystemTime m
systemTime)
                    m GsmState -> HistoricityCheck m blk
historicityCheck
                    ChainDB m blk
chainDB
                    NominalDiffTime
llrnMaxCaughtUpAge
                    (WrapDurationUntilTooOld m blk
-> Maybe (WrapDurationUntilTooOld m blk)
forall a. a -> Maybe a
Just WrapDurationUntilTooOld m blk
durationUntilTooOld)
                    MarkerFileView m
gsmMarkerFileView
                    STM m UseBootstrapPeers
rnGetUseBootstrapPeers
                    StrictTVar m (PublicPeerSelectionState addrNTN)
llrnPublicPeerSelectionStateVar
                    GenesisNodeKernelArgs m blk
genesisArgs
                    DiffusionPipeliningSupport
DiffusionPipeliningOn
          NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel <- NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> m (NodeKernel m addrNTN (ConnectionId addrNTC) blk)
forall (m :: * -> *) addrNTN addrNTC blk.
(IOLike m, MonadTimer m, RunNode blk, Ord addrNTN,
 Hashable addrNTN, Typeable addrNTN) =>
NodeKernelArgs m addrNTN addrNTC blk
-> m (NodeKernel m addrNTN addrNTC blk)
initNodeKernel NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs
          ResourceRegistry m
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk -> m ()
rnNodeKernelHook ResourceRegistry m
registry NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel

          PeerMetrics m addrNTN
peerMetrics <- PeerMetricsConfiguration -> m (PeerMetrics m addrNTN)
forall (m :: * -> *) p.
(MonadLabelledSTM m, NoThunks p, NFData p) =>
PeerMetricsConfiguration -> m (PeerMetrics m p)
newPeerMetric PeerMetricsConfiguration
Diffusion.peerMetricsConfiguration
          let ntnApps :: BlockNodeToNodeVersion blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
ntnApps = NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> PeerMetrics m addrNTN
-> (NodeToNodeVersion -> addrNTN -> Encoding)
-> (NodeToNodeVersion -> forall s. Decoder s addrNTN)
-> BlockNodeToNodeVersion blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
mkNodeToNodeApps   NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel PeerMetrics m addrNTN
peerMetrics NodeToNodeVersion -> addrNTN -> Encoding
encAddrNtN NodeToNodeVersion -> Decoder s addrNTN
NodeToNodeVersion -> forall s. Decoder s addrNTN
decAddrNtN
              ntcApps :: BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntcApps = NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
mkNodeToClientApps NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel
              (Applications
  addrNTN
  NodeToNodeVersion
  versionDataNTN
  addrNTC
  NodeToClientVersion
  versionDataNTC
  m
  NodeToNodeInitiatorResult
apps, ExtraApplications p2p addrNTN m NodeToNodeInitiatorResult
appsExtra) = NetworkP2PMode p2p
-> MiniProtocolParameters
-> (BlockNodeToNodeVersion blk
    -> Apps
         m
         addrNTN
         ByteString
         ByteString
         ByteString
         ByteString
         ByteString
         NodeToNodeInitiatorResult
         ())
-> (BlockNodeToClientVersion blk
    -> NodeToClientVersion
    -> Apps
         m
         (ConnectionId addrNTC)
         ByteString
         ByteString
         ByteString
         ByteString
         ())
-> NodeKernel m addrNTN (ConnectionId addrNTC) blk
-> PeerMetrics m addrNTN
-> (Applications
      addrNTN
      NodeToNodeVersion
      versionDataNTN
      addrNTC
      NodeToClientVersion
      versionDataNTC
      m
      NodeToNodeInitiatorResult,
    ExtraApplications p2p addrNTN m NodeToNodeInitiatorResult)
mkDiffusionApplications
                                        NetworkP2PMode p2p
rnEnableP2P
                                        (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> MiniProtocolParameters
forall (m :: * -> *) addrNTN addrNTC blk.
NodeKernelArgs m addrNTN addrNTC blk -> MiniProtocolParameters
miniProtocolParameters NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
nodeKernelArgs)
                                        BlockNodeToNodeVersion blk
-> Apps
     m
     addrNTN
     ByteString
     ByteString
     ByteString
     ByteString
     ByteString
     NodeToNodeInitiatorResult
     ()
ntnApps
                                        BlockNodeToClientVersion blk
-> NodeToClientVersion
-> Apps
     m
     (ConnectionId addrNTC)
     ByteString
     ByteString
     ByteString
     ByteString
     ()
ntcApps
                                        NodeKernel m addrNTN (ConnectionId addrNTC) blk
nodeKernel
                                        PeerMetrics m addrNTN
peerMetrics

          Applications
  addrNTN
  NodeToNodeVersion
  versionDataNTN
  addrNTC
  NodeToClientVersion
  versionDataNTC
  m
  NodeToNodeInitiatorResult
-> ExtraApplications p2p addrNTN m NodeToNodeInitiatorResult
-> m ()
llrnRunDataDiffusion Applications
  addrNTN
  NodeToNodeVersion
  versionDataNTN
  addrNTC
  NodeToClientVersion
  versionDataNTC
  m
  NodeToNodeInitiatorResult
apps ExtraApplications p2p addrNTN m NodeToNodeInitiatorResult
appsExtra
  where
    ProtocolInfo
      { pInfoConfig :: forall b. ProtocolInfo b -> TopLevelConfig b
pInfoConfig       = TopLevelConfig blk
cfg
      , pInfoInitLedger :: forall b. ProtocolInfo b -> ExtLedgerState b
pInfoInitLedger   = ExtLedgerState blk
initLedger
      } = ProtocolInfo blk
rnProtocolInfo

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

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

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

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

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

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


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

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

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

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

mkNodeKernelArgs ::
     forall m addrNTN addrNTC blk. (RunNode blk, IOLike m)
  => ResourceRegistry m
  -> Int
  -> StdGen
  -> StdGen
  -> TopLevelConfig blk
  -> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
  -> BlockchainTime m
  -> InFutureCheck.SomeHeaderInFutureCheck m blk
  -> (m GSM.GsmState -> HistoricityCheck m blk)
  -> ChainDB m blk
  -> NominalDiffTime
  -> Maybe (GSM.WrapDurationUntilTooOld m blk)
  -> GSM.MarkerFileView m
  -> STM m UseBootstrapPeers
  -> StrictSTM.StrictTVar m (Diffusion.PublicPeerSelectionState addrNTN)
  -> GenesisNodeKernelArgs m blk
  -> DiffusionPipeliningSupport
  -> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
mkNodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC blk.
(RunNode blk, IOLike m) =>
ResourceRegistry m
-> Int
-> StdGen
-> StdGen
-> TopLevelConfig blk
-> Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
-> BlockchainTime m
-> SomeHeaderInFutureCheck m blk
-> (m GsmState -> HistoricityCheck m blk)
-> ChainDB m blk
-> NominalDiffTime
-> Maybe (WrapDurationUntilTooOld m blk)
-> MarkerFileView m
-> STM m UseBootstrapPeers
-> StrictTVar m (PublicPeerSelectionState addrNTN)
-> GenesisNodeKernelArgs m blk
-> DiffusionPipeliningSupport
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
mkNodeKernelArgs
  ResourceRegistry m
registry
  Int
bfcSalt
  StdGen
gsmAntiThunderingHerd
  StdGen
rng
  TopLevelConfig blk
cfg
  Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers
  BlockchainTime m
btime
  SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
  m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck
  ChainDB m blk
chainDB
  NominalDiffTime
maxCaughtUpAge
  Maybe (WrapDurationUntilTooOld m blk)
gsmDurationUntilTooOld
  MarkerFileView m
gsmMarkerFileView
  STM m UseBootstrapPeers
getUseBootstrapPeers
  StrictTVar m (PublicPeerSelectionState addrNTN)
publicPeerSelectionStateVar
  GenesisNodeKernelArgs m blk
genesisArgs
  DiffusionPipeliningSupport
getDiffusionPipeliningSupport
  = do
    let (StdGen
kaRng, StdGen
psRng) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
rng
    NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> m (NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeKernelArgs
      { Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
$sel:tracers:NodeKernelArgs :: Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
tracers
      , ResourceRegistry m
registry :: ResourceRegistry m
$sel:registry:NodeKernelArgs :: ResourceRegistry m
registry
      , TopLevelConfig blk
cfg :: TopLevelConfig blk
$sel:cfg:NodeKernelArgs :: TopLevelConfig blk
cfg
      , BlockchainTime m
btime :: BlockchainTime m
$sel:btime:NodeKernelArgs :: BlockchainTime m
btime
      , ChainDB m blk
chainDB :: ChainDB m blk
$sel:chainDB:NodeKernelArgs :: ChainDB m blk
chainDB
      , $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 ()
forall (m :: * -> *).
IOLike m =>
StorageConfig blk -> InitChainDB m blk -> m ()
nodeInitChainDB
      , SomeHeaderInFutureCheck m blk
chainSyncFutureCheck :: SomeHeaderInFutureCheck m blk
$sel:chainSyncFutureCheck:NodeKernelArgs :: SomeHeaderInFutureCheck m blk
chainSyncFutureCheck
      , m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck :: m GsmState -> HistoricityCheck m blk
$sel:chainSyncHistoricityCheck:NodeKernelArgs :: m GsmState -> HistoricityCheck m blk
chainSyncHistoricityCheck
      , $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 = Int -> BlockFetchConfiguration
Diffusion.defaultBlockFetchConfiguration Int
bfcSalt
      , $sel:gsmArgs:NodeKernelArgs :: GsmNodeKernelArgs m blk
gsmArgs = GsmNodeKernelArgs {
          StdGen
gsmAntiThunderingHerd :: StdGen
gsmAntiThunderingHerd :: StdGen
gsmAntiThunderingHerd
        , Maybe (WrapDurationUntilTooOld m blk)
gsmDurationUntilTooOld :: Maybe (WrapDurationUntilTooOld m blk)
gsmDurationUntilTooOld :: Maybe (WrapDurationUntilTooOld m blk)
gsmDurationUntilTooOld
        , MarkerFileView m
gsmMarkerFileView :: MarkerFileView m
gsmMarkerFileView :: MarkerFileView m
gsmMarkerFileView
        , gsmMinCaughtUpDuration :: NominalDiffTime
gsmMinCaughtUpDuration = NominalDiffTime
maxCaughtUpAge
        }
      , STM m UseBootstrapPeers
getUseBootstrapPeers :: STM m UseBootstrapPeers
$sel:getUseBootstrapPeers:NodeKernelArgs :: STM m UseBootstrapPeers
getUseBootstrapPeers
      , keepAliveRng :: StdGen
keepAliveRng = StdGen
kaRng
      , $sel:peerSharingRng:NodeKernelArgs :: StdGen
peerSharingRng = StdGen
psRng
      , StrictTVar m (PublicPeerSelectionState addrNTN)
publicPeerSelectionStateVar :: StrictTVar m (PublicPeerSelectionState addrNTN)
$sel:publicPeerSelectionStateVar:NodeKernelArgs :: StrictTVar m (PublicPeerSelectionState addrNTN)
publicPeerSelectionStateVar
      , GenesisNodeKernelArgs m blk
genesisArgs :: GenesisNodeKernelArgs m blk
$sel:genesisArgs:NodeKernelArgs :: GenesisNodeKernelArgs m blk
genesisArgs
      , DiffusionPipeliningSupport
getDiffusionPipeliningSupport :: DiffusionPipeliningSupport
$sel:getDiffusionPipeliningSupport:NodeKernelArgs :: DiffusionPipeliningSupport
getDiffusionPipeliningSupport
      }

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

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

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

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

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

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

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

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

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

-- | 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 :: 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{ ProtocolInfo blk
$sel:rnProtocolInfo:RunNodeArgs :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> ProtocolInfo blk
rnProtocolInfo :: ProtocolInfo blk
rnProtocolInfo
                                    , NetworkP2PMode p2p
$sel:rnEnableP2P:RunNodeArgs :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> NetworkP2PMode p2p
rnEnableP2P :: NetworkP2PMode p2p
rnEnableP2P
                                    , PeerSharing
$sel:rnPeerSharing:RunNodeArgs :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> PeerSharing
rnPeerSharing :: PeerSharing
rnPeerSharing
                                    , GenesisConfig
$sel:rnGenesisConfig:RunNodeArgs :: forall (m :: * -> *) addrNTN addrNTC blk (p2p :: P2P).
RunNodeArgs m addrNTN addrNTC blk p2p -> GenesisConfig
rnGenesisConfig :: GenesisConfig
rnGenesisConfig
                                    }
                         $(SafeWildCards.fields 'StdRunNodeArgs) = do
    Int
llrnBfcSalt               <- IO Int
stdBfcSaltIO
    StdGen
llrnGsmAntiThunderingHerd <- IO StdGen
stdGsmAntiThunderingHerdIO
    StdGen
llrnKeepAliveRng          <- IO StdGen
stdKeepAliveRngIO
    LowLevelRunNodeArgs
  IO
  RemoteAddress
  LocalAddress
  NodeToNodeVersionData
  NodeToClientVersionData
  blk
  p2p
-> IO
     (LowLevelRunNodeArgs
        IO
        RemoteAddress
        LocalAddress
        NodeToNodeVersionData
        NodeToClientVersionData
        blk
        p2p)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LowLevelRunNodeArgs
      { Int
$sel:llrnBfcSalt:LowLevelRunNodeArgs :: Int
llrnBfcSalt :: Int
llrnBfcSalt
      , $sel:llrnChainSyncTimeout:LowLevelRunNodeArgs :: IO ChainSyncTimeout
llrnChainSyncTimeout = IO ChainSyncTimeout
-> Maybe (IO ChainSyncTimeout) -> IO ChainSyncTimeout
forall a. a -> Maybe a -> a
fromMaybe IO ChainSyncTimeout
Diffusion.defaultChainSyncTimeout Maybe (IO ChainSyncTimeout)
srnChainSyncTimeout
      , $sel:llrnGenesisConfig:LowLevelRunNodeArgs :: GenesisConfig
llrnGenesisConfig = GenesisConfig
rnGenesisConfig
      , $sel:llrnCustomiseHardForkBlockchainTimeArgs:LowLevelRunNodeArgs :: HardForkBlockchainTimeArgs IO blk
-> HardForkBlockchainTimeArgs IO blk
llrnCustomiseHardForkBlockchainTimeArgs = HardForkBlockchainTimeArgs IO blk
-> HardForkBlockchainTimeArgs IO blk
forall a. a -> a
id
      , StdGen
$sel:llrnGsmAntiThunderingHerd:LowLevelRunNodeArgs :: StdGen
llrnGsmAntiThunderingHerd :: StdGen
llrnGsmAntiThunderingHerd
      , StdGen
$sel:llrnKeepAliveRng:LowLevelRunNodeArgs :: StdGen
llrnKeepAliveRng :: StdGen
llrnKeepAliveRng
      , $sel:llrnMkImmutableHasFS:LowLevelRunNodeArgs :: RelativeMountPoint -> SomeHasFS IO
llrnMkImmutableHasFS = FilePath -> RelativeMountPoint -> SomeHasFS IO
stdMkChainDbHasFS (FilePath -> RelativeMountPoint -> SomeHasFS IO)
-> FilePath -> RelativeMountPoint -> SomeHasFS IO
forall a b. (a -> b) -> a -> b
$ NodeDatabasePaths -> FilePath
immutableDbPath NodeDatabasePaths
srnDatabasePath
      , $sel:llrnMkVolatileHasFS:LowLevelRunNodeArgs :: RelativeMountPoint -> SomeHasFS IO
llrnMkVolatileHasFS = FilePath -> RelativeMountPoint -> SomeHasFS IO
stdMkChainDbHasFS (FilePath -> RelativeMountPoint -> SomeHasFS IO)
-> FilePath -> RelativeMountPoint -> SomeHasFS IO
forall a b. (a -> b) -> a -> b
$ NodeDatabasePaths -> FilePath
nonImmutableDbPath NodeDatabasePaths
srnDatabasePath
      , $sel:llrnChainDbArgsDefaults:LowLevelRunNodeArgs :: Incomplete ChainDbArgs IO blk
llrnChainDbArgsDefaults = Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
updateChainDbDefaults Incomplete ChainDbArgs IO blk
forall (m :: * -> *) blk. Monad m => Incomplete ChainDbArgs m blk
ChainDB.defaultArgs
      , $sel:llrnCustomiseChainDbArgs:LowLevelRunNodeArgs :: Complete ChainDbArgs IO blk -> Complete ChainDbArgs IO blk
llrnCustomiseChainDbArgs = Complete ChainDbArgs IO blk -> Complete ChainDbArgs IO blk
forall a. a -> a
id
      , NodeKernelArgs IO RemoteAddress (ConnectionId LocalAddress) blk
-> NodeKernelArgs IO RemoteAddress (ConnectionId LocalAddress) blk
forall (m :: * -> *) addrNTN addrNTC.
NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
$sel:llrnCustomiseNodeKernelArgs:LowLevelRunNodeArgs :: NodeKernelArgs IO RemoteAddress (ConnectionId LocalAddress) blk
-> NodeKernelArgs IO RemoteAddress (ConnectionId LocalAddress) blk
llrnCustomiseNodeKernelArgs :: forall (m :: * -> *) addrNTN addrNTC.
NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
-> NodeKernelArgs m addrNTN (ConnectionId addrNTC) blk
llrnCustomiseNodeKernelArgs
      , $sel:llrnRunDataDiffusion:LowLevelRunNodeArgs :: Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
  NodeToNodeInitiatorResult
-> ExtraApplications p2p RemoteAddress IO NodeToNodeInitiatorResult
-> IO ()
llrnRunDataDiffusion =
          \Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
  NodeToNodeInitiatorResult
apps ExtraApplications p2p RemoteAddress IO NodeToNodeInitiatorResult
extraApps ->
            Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ExtraArguments p2p IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
     NodeToNodeInitiatorResult
-> ExtraApplications p2p RemoteAddress IO NodeToNodeInitiatorResult
-> IO ()
forall (p2p :: P2P).
Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
-> ExtraTracers p2p
-> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> ExtraArguments p2p IO
-> Applications
     RemoteAddress
     NodeToNodeVersion
     NodeToNodeVersionData
     LocalAddress
     NodeToClientVersion
     NodeToClientVersionData
     IO
     NodeToNodeInitiatorResult
-> ExtraApplications p2p RemoteAddress IO NodeToNodeInitiatorResult
-> IO ()
stdRunDataDiffusion Tracers
  RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO
srnDiffusionTracers
                                ExtraTracers p2p
srnDiffusionTracersExtra
                                Arguments IO Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments
                                ExtraArguments p2p IO
srnDiffusionArgumentsExtra
                                Applications
  RemoteAddress
  NodeToNodeVersion
  NodeToNodeVersionData
  LocalAddress
  NodeToClientVersion
  NodeToClientVersionData
  IO
  NodeToNodeInitiatorResult
apps ExtraApplications p2p RemoteAddress IO NodeToNodeInitiatorResult
extraApps
      , $sel:llrnVersionDataNTC:LowLevelRunNodeArgs :: NodeToClientVersionData
llrnVersionDataNTC =
          NetworkMagic -> NodeToClientVersionData
stdVersionDataNTC NetworkMagic
networkMagic
      , $sel:llrnVersionDataNTN:LowLevelRunNodeArgs :: NodeToNodeVersionData
llrnVersionDataNTN =
          NetworkMagic
-> DiffusionMode -> PeerSharing -> NodeToNodeVersionData
stdVersionDataNTN
            NetworkMagic
networkMagic
            (case NetworkP2PMode p2p
rnEnableP2P of
               NetworkP2PMode p2p
EnabledP2PMode  -> Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> DiffusionMode
forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr -> DiffusionMode
Diffusion.daMode Arguments IO Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments
               -- Every connection in non-p2p mode is unidirectional; We connect
               -- from an ephemeral port.  We still pass `srnDiffusionArguments`
               -- to the diffusion layer, so the server side will be run also in
               -- `InitiatorAndResponderDiffusionMode`.
               NetworkP2PMode p2p
DisabledP2PMode -> DiffusionMode
InitiatorOnlyDiffusionMode
            )
            PeerSharing
rnPeerSharing
      , $sel:llrnNodeToNodeVersions:LowLevelRunNodeArgs :: 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 (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk))
      , $sel:llrnNodeToClientVersions:LowLevelRunNodeArgs :: 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 (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk))
      , $sel:llrnWithCheckedDB:LowLevelRunNodeArgs :: forall a.
(LastShutDownWasClean -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
llrnWithCheckedDB =
          -- 'stdWithCheckedDB' uses the FS just to check for the clean file.
          -- We put that one in the immutable path.
          Proxy blk
-> Tracer IO (TraceEvent blk)
-> FilePath
-> NetworkMagic
-> (LastShutDownWasClean
    -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
forall blk a.
(StandardHash blk, Typeable blk) =>
Proxy blk
-> Tracer IO (TraceEvent blk)
-> FilePath
-> NetworkMagic
-> (LastShutDownWasClean
    -> (ChainDB IO blk -> IO a -> IO a) -> IO a)
-> IO a
stdWithCheckedDB (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) Tracer IO (TraceEvent blk)
srnTraceChainDB (NodeDatabasePaths -> FilePath
immutableDbPath NodeDatabasePaths
srnDatabasePath) NetworkMagic
networkMagic
      , $sel:llrnMaxCaughtUpAge:LowLevelRunNodeArgs :: NominalDiffTime
llrnMaxCaughtUpAge = Double -> NominalDiffTime
secondsToNominalDiffTime (Double -> NominalDiffTime) -> Double -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Double
20 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60   -- 20 min
      , $sel:llrnMaxClockSkew:LowLevelRunNodeArgs :: ClockSkew
llrnMaxClockSkew =
          ClockSkew
InFutureCheck.defaultClockSkew
      , $sel:llrnPublicPeerSelectionStateVar:LowLevelRunNodeArgs :: StrictTVar IO (PublicPeerSelectionState RemoteAddress)
llrnPublicPeerSelectionStateVar =
          Arguments IO Socket RemoteAddress LocalSocket LocalAddress
-> StrictTVar IO (PublicPeerSelectionState RemoteAddress)
forall (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Arguments m ntnFd ntnAddr ntcFd ntcAddr
-> StrictTVar m (PublicPeerSelectionState ntnAddr)
Diffusion.daPublicPeerSelectionVar Arguments IO Socket RemoteAddress LocalSocket LocalAddress
srnDiffusionArguments
      }
  where
    networkMagic :: NetworkMagic
    networkMagic :: NetworkMagic
networkMagic = BlockConfig blk -> NetworkMagic
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> NetworkMagic
getNetworkMagic (BlockConfig blk -> NetworkMagic)
-> BlockConfig blk -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ TopLevelConfig blk -> BlockConfig blk
forall blk. TopLevelConfig blk -> BlockConfig blk
configBlock (TopLevelConfig blk -> BlockConfig blk)
-> TopLevelConfig blk -> BlockConfig blk
forall a b. (a -> b) -> a -> b
$ ProtocolInfo blk -> TopLevelConfig blk
forall b. ProtocolInfo b -> TopLevelConfig b
pInfoConfig ProtocolInfo blk
rnProtocolInfo

    updateChainDbDefaults ::
         Incomplete ChainDbArgs IO blk
      -> Incomplete ChainDbArgs IO blk
    updateChainDbDefaults :: Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
updateChainDbDefaults =
          DiskPolicyArgs
-> Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall (f :: * -> *) (m :: * -> *) blk.
DiskPolicyArgs -> ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.updateDiskPolicyArgs DiskPolicyArgs
srnDiskPolicyArgs
        (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> Incomplete ChainDbArgs IO blk
-> Incomplete ChainDbArgs IO blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tracer IO (TraceEvent blk)
-> Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall (m :: * -> *) blk (f :: * -> *).
Tracer m (TraceEvent blk)
-> ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.updateTracer Tracer IO (TraceEvent blk)
srnTraceChainDB
        (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> (Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk)
-> Incomplete ChainDbArgs IO blk
-> Incomplete ChainDbArgs IO blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if   Bool -> Bool
not Bool
srnChainDbValidateOverride
           then Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall a. a -> a
id
           else Incomplete ChainDbArgs IO blk -> Incomplete ChainDbArgs IO blk
forall (f :: * -> *) (m :: * -> *) blk.
ChainDbArgs f m blk -> ChainDbArgs f m blk
ChainDB.ensureValidateAll)


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

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

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

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