{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

module Test.Ouroboros.Network.Diffusion.Node
  ( -- * run a node
    Interfaces (..)
  , Arguments (..)
  , run
    -- * node types
  , NtNAddr
  , NtNFD
  , NtNVersion
  , NtNVersionData
  , NtCAddr
  , NtCFD
  , NtCVersion
  , NtCVersionData
  , Node.NtNAddr_ (..)
    -- * extra types used by the node
  , AcceptedConnectionsLimit (..)
  , DiffusionMode (..)
  , PeerAdvertise (..)
  , PeerSelectionTargets (..)
    -- * configuration constants
  , config_REPROMOTE_DELAY
    -- * re-exports
  , Node.BlockGeneratorArgs (..)
  , Node.LimitsAndTimeouts (..)
  , Node.randomBlockGenerationArgs
  , Node.ntnAddrToRelayAccessPoint
  ) where

import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadMVar (MonadMVar)
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad ((>=>))
import Control.Monad.Class.MonadAsync (MonadAsync (wait, withAsync))
import Control.Monad.Class.MonadFork (MonadFork)
import Control.Monad.Class.MonadSay
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadEvaluate, MonadMask, MonadThrow,
           SomeException)
import Control.Monad.Class.MonadTime.SI (DiffTime, MonadTime, Time (..))
import Control.Monad.Class.MonadTimer.SI (MonadDelay, MonadTimer)
import Control.Monad.Fix (MonadFix)
import Control.Tracer (Tracer (..), nullTracer)

import Codec.CBOR.Term qualified as CBOR
import Data.Foldable as Foldable (foldl')
import Data.IP (IP (..))
import Data.Map (Map)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Void (Void)
import GHC.Exception (Exception)
import System.Random (StdGen, split)

import Network.DNS (Domain, TTL)

import Ouroboros.Network.Mux (noBindForkPolicy)
import Ouroboros.Network.Protocol.Handshake (HandshakeArguments (..))
import Ouroboros.Network.Protocol.Handshake.Codec (VersionDataCodec (..),
           noTimeLimitsHandshake, timeLimitsHandshake)
import Ouroboros.Network.Protocol.Handshake.Unversioned
           (unversionedHandshakeCodec, unversionedProtocolDataCodec)
import Ouroboros.Network.Protocol.Handshake.Version (Accept (Accept))

import Ouroboros.Network.AnchoredFragment qualified as AF
import Ouroboros.Network.Block (MaxSlotNo (..), maxSlotNoFromWithOrigin,
           pointSlot)
import Ouroboros.Network.BlockFetch
import Ouroboros.Network.BlockFetch.ConsensusInterface
           (ChainSelStarvation (ChainSelStarvationEndedAt))
import Ouroboros.Network.ConnectionManager.State (ConnStateIdSupply)
import Ouroboros.Network.ConnectionManager.Types (DataFlow (..))
import Ouroboros.Network.Diffusion qualified as Diff
import Ouroboros.Network.ExitPolicy (RepromoteDelay (..))
import Ouroboros.Network.Mock.Chain (Chain, toAnchoredFragment, toOldestFirst)
import Ouroboros.Network.Mock.ConcreteBlock (Block (..), BlockHeader (..),
           convertSlotToTimeForTestsAssumingNoHardFork)
import Ouroboros.Network.Mock.ProducerState (ChainProducerState (..))
import Ouroboros.Network.NodeToNode.Version (DiffusionMode (..))
import Ouroboros.Network.PeerSelection.Churn (PeerChurnArgs)
import Ouroboros.Network.PeerSelection.Governor (PeerSelectionState (..),
           PeerSelectionTargets (..), PublicPeerSelectionState (..))
import Ouroboros.Network.PeerSelection.Governor.Types
           (PeerSelectionGovernorArgs)
import Ouroboros.Network.PeerSelection.LedgerPeers (NumberOfPeers)
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
           (LedgerPeersConsensusInterface, LedgerPeersKind, UseLedgerPeers)
import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
import Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics,
           PeerMetricsConfiguration (..), newPeerMetric)
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Ouroboros.Network.PeerSelection.PeerStateActions (PeerConnectionHandle)
import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers)
import Ouroboros.Network.PeerSelection.RelayAccessPoint (DomainAccessPoint,
           RelayAccessPoint)
import Ouroboros.Network.PeerSelection.RootPeersDNS (PeerActionsDNS)
import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSLookupType)
import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSSemaphore (DNSSemaphore)
import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency,
           LocalRootConfig, WarmValency)
import Ouroboros.Network.PeerSelection.Types (PublicExtraPeersAPI (..))
import Ouroboros.Network.Server.RateLimiting (AcceptedConnectionsLimit (..))
import Ouroboros.Network.Snocket (MakeBearer, Snocket, TestAddress (..),
           invalidFileDescriptor)

import Simulation.Network.Snocket (AddressType (..), FD)

import Test.Ouroboros.Network.Data.Script (Script)
import Test.Ouroboros.Network.Diffusion.Node.ChainDB (addBlock,
           getBlockPointSet)
import Test.Ouroboros.Network.Diffusion.Node.Kernel (NodeKernel (..), NtCAddr,
           NtCVersion, NtCVersionData, NtNAddr, NtNVersion, NtNVersionData (..))
import Test.Ouroboros.Network.Diffusion.Node.Kernel qualified as Node
import Test.Ouroboros.Network.Diffusion.Node.MiniProtocols qualified as Node
import Test.Ouroboros.Network.PeerSelection.RootPeersDNS (DNSLookupDelay,
           DNSTimeout, mockDNSActions)


data Interfaces extraAPI m = Interfaces
    { forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> Snocket m (NtNFD m) NtNAddr
iNtnSnocket        :: Snocket m (NtNFD m) NtNAddr
    , forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> MakeBearer m (NtNFD m)
iNtnBearer         :: MakeBearer m (NtNFD m)
    , forall extraAPI (m :: * -> *).
Interfaces extraAPI m
-> NtNVersionData -> NtNVersionData -> Accept NtNVersionData
iAcceptVersion     :: NtNVersionData -> NtNVersionData -> Accept NtNVersionData
    , forall extraAPI (m :: * -> *).
Interfaces extraAPI m
-> DNSLookupType
-> [DomainAccessPoint]
-> m (Map DomainAccessPoint (Set NtNAddr))
iNtnDomainResolver :: DNSLookupType -> [DomainAccessPoint] -> m (Map DomainAccessPoint (Set NtNAddr))
    , forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> Snocket m (NtCFD m) NtCAddr
iNtcSnocket        :: Snocket m (NtCFD m) NtCAddr
    , forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> MakeBearer m (NtCFD m)
iNtcBearer         :: MakeBearer m (NtCFD m)
    , forall extraAPI (m :: * -> *). Interfaces extraAPI m -> StdGen
iRng               :: StdGen
    , forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> StrictTVar m (Map Domain [(IP, TTL)])
iDomainMap         :: StrictTVar m (Map Domain [(IP, TTL)])
    , forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> LedgerPeersConsensusInterface extraAPI m
iLedgerPeersConsensusInterface
                         :: LedgerPeersConsensusInterface extraAPI m
    , forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> ConnStateIdSupply m
iConnStateIdSupply :: ConnStateIdSupply m
    }

type NtNFD m = FD m NtNAddr
type NtCFD m = FD m NtCAddr

data Arguments extraChurnArgs extraFlags m = Arguments
    { forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> NtNAddr
aIPAddress            :: NtNAddr
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> AcceptedConnectionsLimit
aAcceptedLimits       :: AcceptedConnectionsLimit
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffusionMode
aDiffusionMode        :: DiffusionMode
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffTime
aKeepAliveInterval    :: DiffTime
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffTime
aPingPongInterval     :: DiffTime
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> BlockHeader -> m Bool
aShouldChainSyncExit  :: BlockHeader -> m Bool
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> Bool
aChainSyncEarlyExit   :: Bool

    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> PeerSelectionTargets
aPeerTargets          :: PeerSelectionTargets
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m
-> STM
     m
     [(HotValency, WarmValency,
       Map RelayAccessPoint (LocalRootConfig extraFlags))]
aReadLocalRootPeers   :: STM m [( HotValency
                                      , WarmValency
                                      , Map RelayAccessPoint (LocalRootConfig extraFlags))]
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m
-> STM m (Map RelayAccessPoint PeerAdvertise)
aReadPublicRootPeers  :: STM m (Map RelayAccessPoint PeerAdvertise)
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> PeerSharing
aOwnPeerSharing       :: PeerSharing
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> STM m UseLedgerPeers
aReadUseLedgerPeers   :: STM m UseLedgerPeers
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffTime
aProtocolIdleTimeout  :: DiffTime
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffTime
aTimeWaitTimeout      :: DiffTime
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> Script DNSTimeout
aDNSTimeoutScript     :: Script DNSTimeout
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> Script DNSLookupDelay
aDNSLookupDelayScript :: Script DNSLookupDelay
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> Tracer m String
aDebugTracer          :: Tracer m String
    , forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> extraChurnArgs
aExtraChurnArgs       :: extraChurnArgs
    }

-- The 'mockDNSActions' is not using \/ specifying 'resolverException', thus we
-- set it to 'SomeException'.
--
type ResolverException = SomeException

run :: forall extraState extraDebugState extraAPI
             extraPeers extraFlags extraChurnArgs extraCounters
             exception resolver resolverError m.
       ( Alternative (STM m)
       , MonadAsync       m
       , MonadDelay       m
       , MonadEvaluate    m
       , MonadFix         m
       , MonadFork        m
       , MonadLabelledSTM m
       , MonadTraceSTM    m
       , MonadMask        m
       , MonadSay         m
       , MonadST          m
       , MonadTime        m
       , MonadTimer       m
       , MonadThrow       (STM m)
       , MonadMVar        m

       , Eq extraFlags
       , Eq extraCounters
       , Monoid extraPeers
       , Exception exception

       , resolver ~ ()
       , resolverError ~ ResolverException
       , forall a. Semigroup a => Semigroup (m a)
       )
    => Node.BlockGeneratorArgs Block StdGen
    -> Node.LimitsAndTimeouts BlockHeader Block
    -> Interfaces extraAPI m
    -> Arguments extraChurnArgs extraFlags m
    -> extraState
    -> extraCounters
    -> PublicExtraPeersAPI extraPeers NtNAddr
    -> (forall muxMode responderCtx ntnVersionData bytes a b .
        PeerSelectionGovernorArgs
          extraState
          extraDebugState
          extraFlags
          extraPeers
          extraAPI
          extraCounters
          NtNAddr
          (PeerConnectionHandle
             muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
          exception
          m)
    -> (forall muxMode responderCtx ntnVersionData bytes a b.
        PeerSelectionState
          extraState
          extraFlags
          extraPeers
          NtNAddr
          (PeerConnectionHandle
             muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
        -> extraCounters)
    -> (Map NtNAddr PeerAdvertise -> extraPeers)
    -> (   PeerActionsDNS NtNAddr resolver resolverError m
        -> DNSSemaphore m
        -> (Map NtNAddr PeerAdvertise -> extraPeers)
        -> (NumberOfPeers -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
        -> LedgerPeersKind
        -> Int
        -> m (PublicRootPeers extraPeers NtNAddr, DiffTime))
    -> (PeerChurnArgs
             m
             extraChurnArgs
             extraDebugState
             extraFlags
             extraPeers
             extraAPI
             extraCounters
             NtNAddr
        -> m Void)
    -> Diff.Tracers NtNAddr NtNVersion NtNVersionData
                    NtCAddr NtCVersion NtCVersionData
                    ResolverException extraState extraDebugState extraFlags
                    extraPeers extraCounters m
    -> Tracer m (TraceLabelPeer NtNAddr (TraceFetchClientState BlockHeader))
    -> m Void
run :: forall extraState extraDebugState extraAPI extraPeers extraFlags
       extraChurnArgs extraCounters exception resolver resolverError
       (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadEvaluate m,
 MonadFix m, MonadFork m, MonadLabelledSTM m, MonadTraceSTM m,
 MonadMask m, MonadSay m, MonadST m, MonadTime m, MonadTimer m,
 MonadThrow (STM m), MonadMVar m, Eq extraFlags, Eq extraCounters,
 Monoid extraPeers, Exception exception, resolver ~ (),
 resolverError ~ ResolverException,
 forall a. Semigroup a => Semigroup (m a)) =>
BlockGeneratorArgs Block StdGen
-> LimitsAndTimeouts BlockHeader Block
-> Interfaces extraAPI m
-> Arguments extraChurnArgs extraFlags m
-> extraState
-> extraCounters
-> PublicExtraPeersAPI extraPeers NtNAddr
-> (forall (muxMode :: Mode) responderCtx ntnVersionData bytes a b.
    PeerSelectionGovernorArgs
      extraState
      extraDebugState
      extraFlags
      extraPeers
      extraAPI
      extraCounters
      NtNAddr
      (PeerConnectionHandle
         muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
      exception
      m)
-> (forall (muxMode :: Mode) responderCtx ntnVersionData bytes a b.
    PeerSelectionState
      extraState
      extraFlags
      extraPeers
      NtNAddr
      (PeerConnectionHandle
         muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
    -> extraCounters)
-> (Map NtNAddr PeerAdvertise -> extraPeers)
-> (PeerActionsDNS NtNAddr resolver resolverError m
    -> DNSSemaphore m
    -> (Map NtNAddr PeerAdvertise -> extraPeers)
    -> (NumberOfPeers
        -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
    -> LedgerPeersKind
    -> Int
    -> m (PublicRootPeers extraPeers NtNAddr, DiffTime))
-> (PeerChurnArgs
      m
      extraChurnArgs
      extraDebugState
      extraFlags
      extraPeers
      extraAPI
      extraCounters
      NtNAddr
    -> m Void)
-> Tracers
     NtNAddr
     NtNVersion
     NtNVersionData
     NtCAddr
     NtNVersion
     NtCVersionData
     ResolverException
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraCounters
     m
-> Tracer
     m (TraceLabelPeer NtNAddr (TraceFetchClientState BlockHeader))
-> m Void
run BlockGeneratorArgs Block StdGen
blockGeneratorArgs LimitsAndTimeouts BlockHeader Block
limits Interfaces extraAPI m
ni Arguments extraChurnArgs extraFlags m
na
    extraState
emptyExtraState extraCounters
emptyExtraCounters
    PublicExtraPeersAPI extraPeers NtNAddr
extraPeersAPI forall (muxMode :: Mode) responderCtx ntnVersionData bytes a b.
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  NtNAddr
  (PeerConnectionHandle
     muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
  exception
  m
psArgs forall (muxMode :: Mode) responderCtx ntnVersionData bytes a b.
PeerSelectionState
  extraState
  extraFlags
  extraPeers
  NtNAddr
  (PeerConnectionHandle
     muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
-> extraCounters
psToExtraCounters
    Map NtNAddr PeerAdvertise -> extraPeers
toExtraPeers PeerActionsDNS NtNAddr resolver resolverError m
-> DNSSemaphore m
-> (Map NtNAddr PeerAdvertise -> extraPeers)
-> (NumberOfPeers
    -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
-> LedgerPeersKind
-> Int
-> m (PublicRootPeers extraPeers NtNAddr, DiffTime)
requestPublicRootPeers PeerChurnArgs
  m
  extraChurnArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  NtNAddr
-> m Void
peerChurnGovernor
    Tracers
  NtNAddr
  NtNVersion
  NtNVersionData
  NtCAddr
  NtNVersion
  NtCVersionData
  ResolverException
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraCounters
  m
tracers Tracer
  m (TraceLabelPeer NtNAddr (TraceFetchClientState BlockHeader))
tracerBlockFetch =
    BlockGeneratorArgs Block StdGen
-> (NodeKernel BlockHeader Block StdGen m
    -> Async m Void -> m Void)
-> m Void
forall block header (m :: * -> *) seed a.
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadThrow m,
 MonadThrow (STM m), HasFullHeader block, RandomGen seed) =>
BlockGeneratorArgs block seed
-> (NodeKernel header block seed m -> Async m Void -> m a) -> m a
Node.withNodeKernelThread BlockGeneratorArgs Block StdGen
blockGeneratorArgs
      ((NodeKernel BlockHeader Block StdGen m -> Async m Void -> m Void)
 -> m Void)
-> (NodeKernel BlockHeader Block StdGen m
    -> Async m Void -> m Void)
-> m Void
forall a b. (a -> b) -> a -> b
$ \ NodeKernel BlockHeader Block StdGen m
nodeKernel Async m Void
nodeKernelThread -> do
        dnsTimeoutScriptVar <- Script DNSTimeout -> m (StrictTVar m (Script DNSTimeout))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (Arguments extraChurnArgs extraFlags m -> Script DNSTimeout
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> Script DNSTimeout
aDNSTimeoutScript Arguments extraChurnArgs extraFlags m
na)
        dnsLookupDelayScriptVar <- newTVarIO (aDNSLookupDelayScript na)
        peerMetrics <- newPeerMetric PeerMetricsConfiguration { maxEntriesToTrack = 180 }

        let -- diffusion interfaces
            interfaces :: Diff.Interfaces (NtNFD m) NtNAddr NtNVersion NtNVersionData
                                          (NtCFD m) NtCAddr NtCVersion NtCVersionData
                                          resolver ResolverException extraState extraFlags extraPeers extraAPI m
            interfaces = Diff.Interfaces
              { diNtnSnocket :: Snocket m (NtNFD m) NtNAddr
Diff.diNtnSnocket            = Interfaces extraAPI m -> Snocket m (NtNFD m) NtNAddr
forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> Snocket m (NtNFD m) NtNAddr
iNtnSnocket Interfaces extraAPI m
ni
              , diNtnBearer :: MakeBearer m (NtNFD m)
Diff.diNtnBearer             = Interfaces extraAPI m -> MakeBearer m (NtNFD m)
forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> MakeBearer m (NtNFD m)
iNtnBearer Interfaces extraAPI m
ni
              , diNtnConfigureSocket :: NtNFD m -> Maybe NtNAddr -> m ()
Diff.diNtnConfigureSocket    = \NtNFD m
_ Maybe NtNAddr
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              , diNtnConfigureSystemdSocket :: NtNFD m -> NtNAddr -> m ()
Diff.diNtnConfigureSystemdSocket
                                               = \NtNFD m
_ NtNAddr
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              , diNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId NtNAddr) NtNVersion NtNVersionData m
Diff.diNtnHandshakeArguments =
                  HandshakeArguments
                    { haHandshakeTracer :: Tracer
  m
  (WithBearer
     (ConnectionId NtNAddr) (TraceSendRecv (Handshake NtNVersion Term)))
haHandshakeTracer  = Tracer
  m
  (WithBearer
     (ConnectionId NtNAddr) (TraceSendRecv (Handshake NtNVersion Term)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                    , haHandshakeCodec :: Codec (Handshake NtNVersion Term) DeserialiseFailure m ByteString
haHandshakeCodec   = Codec (Handshake NtNVersion Term) DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec (Handshake NtNVersion Term) DeserialiseFailure m ByteString
unversionedHandshakeCodec
                    , haVersionDataCodec :: VersionDataCodec Term NtNVersion NtNVersionData
haVersionDataCodec = VersionDataCodec Term NtNVersion NtNVersionData
ntnUnversionedDataCodec
                    , haAcceptVersion :: NtNVersionData -> NtNVersionData -> Accept NtNVersionData
haAcceptVersion    = Interfaces extraAPI m
-> NtNVersionData -> NtNVersionData -> Accept NtNVersionData
forall extraAPI (m :: * -> *).
Interfaces extraAPI m
-> NtNVersionData -> NtNVersionData -> Accept NtNVersionData
iAcceptVersion Interfaces extraAPI m
ni
                    , haQueryVersion :: NtNVersionData -> Bool
haQueryVersion     = Bool -> NtNVersionData -> Bool
forall a b. a -> b -> a
const Bool
False
                    , haTimeLimits :: ProtocolTimeLimits (Handshake NtNVersion Term)
haTimeLimits       = ProtocolTimeLimits (Handshake NtNVersion Term)
forall {k} (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
timeLimitsHandshake
                    }
              , diNtnAddressType :: NtNAddr -> Maybe AddressType
Diff.diNtnAddressType = NtNAddr -> Maybe AddressType
ntnAddressType
              , diNtnDataFlow :: NtNVersionData -> DataFlow
Diff.diNtnDataFlow    = \NtNVersionData { DiffusionMode
ntnDiffusionMode :: DiffusionMode
ntnDiffusionMode :: NtNVersionData -> DiffusionMode
ntnDiffusionMode } ->
                  case DiffusionMode
ntnDiffusionMode of
                    DiffusionMode
InitiatorOnlyDiffusionMode         -> DataFlow
Unidirectional
                    DiffusionMode
InitiatorAndResponderDiffusionMode -> DataFlow
Duplex
              , diNtnPeerSharing :: NtNVersionData -> PeerSharing
Diff.diNtnPeerSharing        = NtNVersionData -> PeerSharing
ntnPeerSharing
              , diNtnToPeerAddr :: IP -> PortNumber -> NtNAddr
Diff.diNtnToPeerAddr         = \IP
a PortNumber
b -> NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
Node.IPAddr IP
a PortNumber
b)
              , diNtcSnocket :: Snocket m (NtCFD m) NtCAddr
Diff.diNtcSnocket            = Interfaces extraAPI m -> Snocket m (NtCFD m) NtCAddr
forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> Snocket m (NtCFD m) NtCAddr
iNtcSnocket Interfaces extraAPI m
ni
              , diNtcBearer :: MakeBearer m (NtCFD m)
Diff.diNtcBearer             = Interfaces extraAPI m -> MakeBearer m (NtCFD m)
forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> MakeBearer m (NtCFD m)
iNtcBearer Interfaces extraAPI m
ni
              , diNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId NtCAddr) NtNVersion NtCVersionData m
Diff.diNtcHandshakeArguments =
                  HandshakeArguments
                    { haHandshakeTracer :: Tracer
  m
  (WithBearer
     (ConnectionId NtCAddr) (TraceSendRecv (Handshake NtNVersion Term)))
haHandshakeTracer  = Tracer
  m
  (WithBearer
     (ConnectionId NtCAddr) (TraceSendRecv (Handshake NtNVersion Term)))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                    , haHandshakeCodec :: Codec (Handshake NtNVersion Term) DeserialiseFailure m ByteString
haHandshakeCodec   = Codec (Handshake NtNVersion Term) DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec (Handshake NtNVersion Term) DeserialiseFailure m ByteString
unversionedHandshakeCodec
                    , haVersionDataCodec :: VersionDataCodec Term NtNVersion NtCVersionData
haVersionDataCodec = VersionDataCodec Term NtNVersion NtCVersionData
unversionedProtocolDataCodec
                    , haAcceptVersion :: NtCVersionData -> NtCVersionData -> Accept NtCVersionData
haAcceptVersion    = \NtCVersionData
_ NtCVersionData
v -> NtCVersionData -> Accept NtCVersionData
forall vData. vData -> Accept vData
Accept NtCVersionData
v
                    , haQueryVersion :: NtCVersionData -> Bool
haQueryVersion     = Bool -> NtCVersionData -> Bool
forall a b. a -> b -> a
const Bool
False
                    , haTimeLimits :: ProtocolTimeLimits (Handshake NtNVersion Term)
haTimeLimits       = ProtocolTimeLimits (Handshake NtNVersion Term)
forall {k} (vNumber :: k).
ProtocolTimeLimits (Handshake vNumber Term)
noTimeLimitsHandshake
                    }
              , diNtcGetFileDescriptor :: NtCFD m -> m FileDescriptor
Diff.diNtcGetFileDescriptor  = \NtCFD m
_ -> FileDescriptor -> m FileDescriptor
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileDescriptor
invalidFileDescriptor
              , diRng :: StdGen
Diff.diRng                   = StdGen
diffStgGen
              , diInstallSigUSR1Handler :: forall (mode :: Mode) x y.
NodeToNodeConnectionManager
  mode (NtNFD m) NtNAddr NtNVersionData NtNVersion m x y
-> StrictTVar
     m
     (PeerSelectionState
        extraState
        extraFlags
        extraPeers
        NtNAddr
        (NodeToNodePeerConnectionHandle mode NtNAddr NtNVersionData m x y))
-> PeerMetrics m NtNAddr
-> m ()
Diff.diInstallSigUSR1Handler = \NodeToNodeConnectionManager
  mode (NtNFD m) NtNAddr NtNVersionData NtNVersion m x y
_ StrictTVar
  m
  (PeerSelectionState
     extraState
     extraFlags
     extraPeers
     NtNAddr
     (NodeToNodePeerConnectionHandle mode NtNAddr NtNVersionData m x y))
_ PeerMetrics m NtNAddr
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              , diDnsActions :: DNSLookupType -> DNSActions () ResolverException m
Diff.diDnsActions            = DNSActions () ResolverException m
-> DNSLookupType -> DNSActions () ResolverException m
forall a b. a -> b -> a
const (StrictTVar m (Map Domain [(IP, TTL)])
-> StrictTVar m (Script DNSTimeout)
-> StrictTVar m (Script DNSLookupDelay)
-> DNSActions () ResolverException m
forall exception (m :: * -> *).
(MonadDelay m, MonadTimer m) =>
StrictTVar m (Map Domain [(IP, TTL)])
-> StrictTVar m (Script DNSTimeout)
-> StrictTVar m (Script DNSLookupDelay)
-> DNSActions () exception m
mockDNSActions
                                                       (Interfaces extraAPI m -> StrictTVar m (Map Domain [(IP, TTL)])
forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> StrictTVar m (Map Domain [(IP, TTL)])
iDomainMap Interfaces extraAPI m
ni)
                                                       StrictTVar m (Script DNSTimeout)
dnsTimeoutScriptVar
                                                       StrictTVar m (Script DNSLookupDelay)
dnsLookupDelayScriptVar)
              , diUpdateVersionData :: NtNVersionData -> DiffusionMode -> NtNVersionData
Diff.diUpdateVersionData     = \NtNVersionData
versionData DiffusionMode
diffusionMode ->
                                                    NtNVersionData
versionData { ntnDiffusionMode = diffusionMode }
              , diConnStateIdSupply :: ConnStateIdSupply m
Diff.diConnStateIdSupply     = Interfaces extraAPI m -> ConnStateIdSupply m
forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> ConnStateIdSupply m
iConnStateIdSupply Interfaces extraAPI m
ni
              }

            apps = Tracer m String
-> NodeKernel BlockHeader Block StdGen m
-> Codecs NtNAddr BlockHeader Block m
-> LimitsAndTimeouts BlockHeader Block
-> AppArgs extraAPI BlockHeader Block m
-> (Block -> BlockHeader)
-> Applications
     NtNAddr
     NtNVersion
     NtNVersionData
     NtCAddr
     NtNVersion
     NtCVersionData
     extraAPI
     m
     ()
forall extraAPI block header s (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadFork m, MonadMask m,
 MonadMVar m, MonadSay m, MonadThrow m, MonadTime m, MonadTimer m,
 MonadThrow (STM m), HasHeader header, HasHeader block,
 HeaderHash header ~ HeaderHash block, Show block, ShowProxy block,
 ShowProxy header, RandomGen s) =>
Tracer m String
-> NodeKernel header block s m
-> Codecs NtNAddr header block m
-> LimitsAndTimeouts header block
-> AppArgs extraAPI header block m
-> (block -> header)
-> Applications
     NtNAddr
     NtNVersion
     NtNVersionData
     NtCAddr
     NtNVersion
     NtCVersionData
     extraAPI
     m
     ()
Node.applications
                     (Arguments extraChurnArgs extraFlags m -> Tracer m String
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> Tracer m String
aDebugTracer Arguments extraChurnArgs extraFlags m
na)
                     NodeKernel BlockHeader Block StdGen m
nodeKernel
                     Codecs NtNAddr BlockHeader Block m
forall (m :: * -> *).
MonadST m =>
Codecs NtNAddr BlockHeader Block m
Node.cborCodecs
                     LimitsAndTimeouts BlockHeader Block
limits
                     (PeerMetrics m NtNAddr -> AppArgs extraAPI BlockHeader Block m
appArgs PeerMetrics m NtNAddr
peerMetrics)
                     Block -> BlockHeader
blockHeader

        withAsync
           (Diff.runM interfaces
                      tracers
                      (mkArgs (nkPublicPeerSelectionVar nodeKernel))
                      apps)
           $ \ Async m Void
diffusionThread ->
               m Void -> (Async m Void -> m Void) -> m Void
forall a b. m a -> (Async m a -> m b) -> m b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync (NodeKernel BlockHeader Block StdGen m -> m Void
forall s. NodeKernel BlockHeader Block s m -> m Void
blockFetch NodeKernel BlockHeader Block StdGen m
nodeKernel) ((Async m Void -> m Void) -> m Void)
-> (Async m Void -> m Void) -> m Void
forall a b. (a -> b) -> a -> b
$ \Async m Void
blockFetchLogicThread ->
                 Async m Void -> m Void
forall a. Async m a -> m a
forall (m :: * -> *) a. MonadAsync m => Async m a -> m a
wait Async m Void
diffusionThread
              m Void -> m Void -> m Void
forall a. Semigroup a => a -> a -> a
<> Async m Void -> m Void
forall a. Async m a -> m a
forall (m :: * -> *) a. MonadAsync m => Async m a -> m a
wait Async m Void
blockFetchLogicThread
              m Void -> m Void -> m Void
forall a. Semigroup a => a -> a -> a
<> Async m Void -> m Void
forall a. Async m a -> m a
forall (m :: * -> *) a. MonadAsync m => Async m a -> m a
wait Async m Void
nodeKernelThread
  where
    blockFetch :: NodeKernel BlockHeader Block s m
               -> m Void
    blockFetch :: forall s. NodeKernel BlockHeader Block s m -> m Void
blockFetch NodeKernel BlockHeader Block s m
nodeKernel = do
      Tracer m (TraceDecisionEvent NtNAddr BlockHeader)
-> Tracer
     m (TraceLabelPeer NtNAddr (TraceFetchClientState BlockHeader))
-> BlockFetchConsensusInterface NtNAddr BlockHeader Block m
-> FetchClientRegistry NtNAddr BlockHeader Block m
-> BlockFetchConfiguration
-> m Void
forall addr header block (m :: * -> *).
(HasHeader header, HasHeader block,
 HeaderHash header ~ HeaderHash block, MonadDelay m, MonadTimer m,
 Ord addr, Hashable addr) =>
Tracer m (TraceDecisionEvent addr header)
-> Tracer m (TraceLabelPeer addr (TraceFetchClientState header))
-> BlockFetchConsensusInterface addr header block m
-> FetchClientRegistry addr header block m
-> BlockFetchConfiguration
-> m Void
blockFetchLogic
        Tracer m (TraceDecisionEvent NtNAddr BlockHeader)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        Tracer
  m (TraceLabelPeer NtNAddr (TraceFetchClientState BlockHeader))
tracerBlockFetch
        (NodeKernel BlockHeader Block s m
-> BlockFetchConsensusInterface NtNAddr BlockHeader Block m
forall s.
NodeKernel BlockHeader Block s m
-> BlockFetchConsensusInterface NtNAddr BlockHeader Block m
blockFetchPolicy NodeKernel BlockHeader Block s m
nodeKernel)
        (NodeKernel BlockHeader Block s m
-> FetchClientRegistry NtNAddr BlockHeader Block m
forall header block s (m :: * -> *).
NodeKernel header block s m
-> FetchClientRegistry NtNAddr header block m
nkFetchClientRegistry NodeKernel BlockHeader Block s m
nodeKernel)
        (BlockFetchConfiguration {
          bfcMaxConcurrencyBulkSync :: Word
bfcMaxConcurrencyBulkSync = Word
1,
          bfcMaxConcurrencyDeadline :: Word
bfcMaxConcurrencyDeadline = Word
2,
          bfcMaxRequestsInflight :: Word
bfcMaxRequestsInflight    = Word
10,
          bfcDecisionLoopIntervalGenesis :: DiffTime
bfcDecisionLoopIntervalGenesis = DiffTime
0.04,
          bfcDecisionLoopIntervalPraos :: DiffTime
bfcDecisionLoopIntervalPraos = DiffTime
0.01,
          bfcGenesisBFConfig :: GenesisBlockFetchConfiguration
bfcGenesisBFConfig        = GenesisBlockFetchConfiguration
            { gbfcGracePeriod :: DiffTime
gbfcGracePeriod = DiffTime
10 },  -- second
          bfcSalt :: Int
bfcSalt                   = Int
0
        })

    blockFetchPolicy :: NodeKernel BlockHeader Block s m
                     -> BlockFetchConsensusInterface NtNAddr BlockHeader Block m
    blockFetchPolicy :: forall s.
NodeKernel BlockHeader Block s m
-> BlockFetchConsensusInterface NtNAddr BlockHeader Block m
blockFetchPolicy NodeKernel BlockHeader Block s m
nodeKernel =
        BlockFetchConsensusInterface {
          readCandidateChains :: STM m (Map NtNAddr (AnchoredFragment BlockHeader))
readCandidateChains    = StrictTVar m (Map NtNAddr (StrictTVar m (Chain BlockHeader)))
-> STM m (Map NtNAddr (StrictTVar m (Chain BlockHeader)))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar (NodeKernel BlockHeader Block s m
-> StrictTVar m (Map NtNAddr (StrictTVar m (Chain BlockHeader)))
forall header block s (m :: * -> *).
NodeKernel header block s m
-> StrictTVar m (Map NtNAddr (StrictTVar m (Chain header)))
nkClientChains NodeKernel BlockHeader Block s m
nodeKernel)
                                   STM m (Map NtNAddr (StrictTVar m (Chain BlockHeader)))
-> (Map NtNAddr (StrictTVar m (Chain BlockHeader))
    -> STM m (Map NtNAddr (AnchoredFragment BlockHeader)))
-> STM m (Map NtNAddr (AnchoredFragment BlockHeader))
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StrictTVar m (Chain BlockHeader)
 -> STM m (AnchoredFragment BlockHeader))
-> Map NtNAddr (StrictTVar m (Chain BlockHeader))
-> STM m (Map NtNAddr (AnchoredFragment BlockHeader))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map NtNAddr a -> f (Map NtNAddr b)
traverse (StrictTVar m (Chain BlockHeader) -> STM m (Chain BlockHeader)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar
                                       (StrictTVar m (Chain BlockHeader) -> STM m (Chain BlockHeader))
-> (Chain BlockHeader -> STM m (AnchoredFragment BlockHeader))
-> StrictTVar m (Chain BlockHeader)
-> STM m (AnchoredFragment BlockHeader)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (AnchoredFragment BlockHeader
-> STM m (AnchoredFragment BlockHeader)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnchoredFragment BlockHeader
 -> STM m (AnchoredFragment BlockHeader))
-> (Chain BlockHeader -> AnchoredFragment BlockHeader)
-> Chain BlockHeader
-> STM m (AnchoredFragment BlockHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chain BlockHeader -> AnchoredFragment BlockHeader
forall block.
HasHeader block =>
Chain block -> AnchoredFragment block
toAnchoredFragment)),
          readCurrentChain :: STM m (AnchoredFragment BlockHeader)
readCurrentChain       = StrictTVar m (ChainProducerState Block)
-> STM m (ChainProducerState Block)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar (NodeKernel BlockHeader Block s m
-> StrictTVar m (ChainProducerState Block)
forall header block s (m :: * -> *).
NodeKernel header block s m
-> StrictTVar m (ChainProducerState block)
nkChainProducerState NodeKernel BlockHeader Block s m
nodeKernel)
                                   STM m (ChainProducerState Block)
-> (ChainProducerState Block
    -> STM m (AnchoredFragment BlockHeader))
-> STM m (AnchoredFragment BlockHeader)
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnchoredFragment BlockHeader
-> STM m (AnchoredFragment BlockHeader)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnchoredFragment BlockHeader
 -> STM m (AnchoredFragment BlockHeader))
-> (ChainProducerState Block -> AnchoredFragment BlockHeader)
-> ChainProducerState Block
-> STM m (AnchoredFragment BlockHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chain Block -> AnchoredFragment BlockHeader
toAnchoredFragmentHeader (Chain Block -> AnchoredFragment BlockHeader)
-> (ChainProducerState Block -> Chain Block)
-> ChainProducerState Block
-> AnchoredFragment BlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainProducerState Block -> Chain Block
forall block. ChainProducerState block -> Chain block
chainState),
          readFetchMode :: STM m FetchMode
readFetchMode          = FetchMode -> STM m FetchMode
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FetchMode -> STM m FetchMode) -> FetchMode -> STM m FetchMode
forall a b. (a -> b) -> a -> b
$ PraosFetchMode -> FetchMode
PraosFetchMode PraosFetchMode
FetchModeBulkSync,
          readFetchedBlocks :: STM m (Point Block -> Bool)
readFetchedBlocks      = (Point Block -> Set (Point Block) -> Bool)
-> Set (Point Block) -> Point Block -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point Block -> Set (Point Block) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Set (Point Block) -> Point Block -> Bool)
-> STM m (Set (Point Block)) -> STM m (Point Block -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB Block m -> STM m (Set (Point Block))
forall (m :: * -> *) block.
(MonadSTM m, HasHeader block) =>
ChainDB block m -> STM m (Set (Point block))
getBlockPointSet (NodeKernel BlockHeader Block s m -> ChainDB Block m
forall header block s (m :: * -> *).
NodeKernel header block s m -> ChainDB block m
nkChainDB NodeKernel BlockHeader Block s m
nodeKernel),
          readFetchedMaxSlotNo :: STM m MaxSlotNo
readFetchedMaxSlotNo   = (MaxSlotNo -> MaxSlotNo -> MaxSlotNo)
-> MaxSlotNo -> [MaxSlotNo] -> MaxSlotNo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' MaxSlotNo -> MaxSlotNo -> MaxSlotNo
forall a. Ord a => a -> a -> a
max MaxSlotNo
NoMaxSlotNo ([MaxSlotNo] -> MaxSlotNo)
-> (Set (Point Block) -> [MaxSlotNo])
-> Set (Point Block)
-> MaxSlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   (Point Block -> MaxSlotNo) -> [Point Block] -> [MaxSlotNo]
forall a b. (a -> b) -> [a] -> [b]
map (WithOrigin SlotNo -> MaxSlotNo
maxSlotNoFromWithOrigin (WithOrigin SlotNo -> MaxSlotNo)
-> (Point Block -> WithOrigin SlotNo) -> Point Block -> MaxSlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Block -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot) ([Point Block] -> [MaxSlotNo])
-> (Set (Point Block) -> [Point Block])
-> Set (Point Block)
-> [MaxSlotNo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Set (Point Block) -> [Point Block]
forall a. Set a -> [a]
Set.elems (Set (Point Block) -> MaxSlotNo)
-> STM m (Set (Point Block)) -> STM m MaxSlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   ChainDB Block m -> STM m (Set (Point Block))
forall (m :: * -> *) block.
(MonadSTM m, HasHeader block) =>
ChainDB block m -> STM m (Set (Point block))
getBlockPointSet (NodeKernel BlockHeader Block s m -> ChainDB Block m
forall header block s (m :: * -> *).
NodeKernel header block s m -> ChainDB block m
nkChainDB NodeKernel BlockHeader Block s m
nodeKernel),
          mkAddFetchedBlock :: STM m (Point Block -> Block -> m ())
mkAddFetchedBlock        =
              (Point Block -> Block -> m ())
-> STM m (Point Block -> Block -> m ())
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Point Block -> Block -> m ())
 -> STM m (Point Block -> Block -> m ()))
-> (Point Block -> Block -> m ())
-> STM m (Point Block -> Block -> m ())
forall a b. (a -> b) -> a -> b
$ \Point Block
_p Block
b ->
                STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (Block -> ChainDB Block m -> STM m ()
forall (m :: * -> *) block.
(MonadSTM m, HasFullHeader block) =>
block -> ChainDB block m -> STM m ()
addBlock Block
b (NodeKernel BlockHeader Block s m -> ChainDB Block m
forall header block s (m :: * -> *).
NodeKernel header block s m -> ChainDB block m
nkChainDB NodeKernel BlockHeader Block s m
nodeKernel)),

          HasCallStack =>
AnchoredFragment BlockHeader
-> AnchoredFragment BlockHeader -> Bool
AnchoredFragment BlockHeader
-> AnchoredFragment BlockHeader -> Bool
forall {block} {block}.
(HasHeader block, HasHeader block) =>
AnchoredFragment block -> AnchoredFragment block -> Bool
plausibleCandidateChain :: forall {block} {block}.
(HasHeader block, HasHeader block) =>
AnchoredFragment block -> AnchoredFragment block -> Bool
plausibleCandidateChain :: HasCallStack =>
AnchoredFragment BlockHeader
-> AnchoredFragment BlockHeader -> Bool
plausibleCandidateChain,
          HasCallStack =>
AnchoredFragment BlockHeader
-> AnchoredFragment BlockHeader -> Ordering
AnchoredFragment BlockHeader
-> AnchoredFragment BlockHeader -> Ordering
forall {block} {block}.
(HasHeader block, HasHeader block) =>
AnchoredFragment block -> AnchoredFragment block -> Ordering
compareCandidateChains :: forall {block} {block}.
(HasHeader block, HasHeader block) =>
AnchoredFragment block -> AnchoredFragment block -> Ordering
compareCandidateChains :: HasCallStack =>
AnchoredFragment BlockHeader
-> AnchoredFragment BlockHeader -> Ordering
compareCandidateChains,

          blockFetchSize :: BlockHeader -> SizeInBytes
blockFetchSize         = \BlockHeader
_ -> SizeInBytes
1000,
          blockMatchesHeader :: BlockHeader -> Block -> Bool
blockMatchesHeader     = \BlockHeader
_ Block
_ -> Bool
True,

          FromConsensus BlockHeader -> STM m UTCTime
forall {f :: * -> *}.
Applicative f =>
FromConsensus BlockHeader -> f UTCTime
headerForgeUTCTime :: forall {f :: * -> *}.
Applicative f =>
FromConsensus BlockHeader -> f UTCTime
headerForgeUTCTime :: FromConsensus BlockHeader -> STM m UTCTime
headerForgeUTCTime,

          readChainSelStarvation :: STM m ChainSelStarvation
readChainSelStarvation       = ChainSelStarvation -> STM m ChainSelStarvation
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> ChainSelStarvation
ChainSelStarvationEndedAt (DiffTime -> Time
Time DiffTime
0)),
          demoteChainSyncJumpingDynamo :: NtNAddr -> m ()
demoteChainSyncJumpingDynamo = \NtNAddr
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        }
      where
        plausibleCandidateChain :: AnchoredFragment block -> AnchoredFragment block -> Bool
plausibleCandidateChain AnchoredFragment block
cur AnchoredFragment block
candidate =
            AnchoredFragment block -> WithOrigin BlockNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin BlockNo
AF.headBlockNo AnchoredFragment block
candidate WithOrigin BlockNo -> WithOrigin BlockNo -> Bool
forall a. Ord a => a -> a -> Bool
> AnchoredFragment block -> WithOrigin BlockNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin BlockNo
AF.headBlockNo AnchoredFragment block
cur

        headerForgeUTCTime :: FromConsensus BlockHeader -> f UTCTime
headerForgeUTCTime (FromConsensus BlockHeader
hdr) =
            UTCTime -> f UTCTime
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> f UTCTime) -> UTCTime -> f UTCTime
forall a b. (a -> b) -> a -> b
$
            SlotNo -> UTCTime
convertSlotToTimeForTestsAssumingNoHardFork (BlockHeader -> SlotNo
headerSlot BlockHeader
hdr)

        compareCandidateChains :: AnchoredFragment block -> AnchoredFragment block -> Ordering
compareCandidateChains AnchoredFragment block
c1 AnchoredFragment block
c2 =
          AnchoredFragment block -> WithOrigin BlockNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin BlockNo
AF.headBlockNo AnchoredFragment block
c1 WithOrigin BlockNo -> WithOrigin BlockNo -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` AnchoredFragment block -> WithOrigin BlockNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin BlockNo
AF.headBlockNo AnchoredFragment block
c2

        -- | Convert a 'Chain' to an 'AnchoredFragment' with an header.
        --
        -- The anchor of the fragment will be 'Chain.genesisPoint'.
        toAnchoredFragmentHeader :: Chain Block -> AF.AnchoredFragment BlockHeader
        toAnchoredFragmentHeader :: Chain Block -> AnchoredFragment BlockHeader
toAnchoredFragmentHeader = Anchor BlockHeader -> [BlockHeader] -> AnchoredFragment BlockHeader
forall v a b. Anchorable v a b => a -> [b] -> AnchoredSeq v a b
AF.fromOldestFirst Anchor BlockHeader
forall block. Anchor block
AF.AnchorGenesis
                                 ([BlockHeader] -> AnchoredFragment BlockHeader)
-> (Chain Block -> [BlockHeader])
-> Chain Block
-> AnchoredFragment BlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> BlockHeader) -> [Block] -> [BlockHeader]
forall a b. (a -> b) -> [a] -> [b]
map Block -> BlockHeader
blockHeader
                                 ([Block] -> [BlockHeader])
-> (Chain Block -> [Block]) -> Chain Block -> [BlockHeader]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chain Block -> [Block]
forall block. Chain block -> [block]
toOldestFirst

    ntnAddressType :: NtNAddr -> Maybe AddressType
    ntnAddressType :: NtNAddr -> Maybe AddressType
ntnAddressType (TestAddress (Node.EphemeralIPv4Addr Natural
_)) = AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
IPv4Address
    ntnAddressType (TestAddress (Node.EphemeralIPv6Addr Natural
_)) = AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
IPv6Address
    ntnAddressType (TestAddress (Node.IPAddr (IPv4 IPv4
_) PortNumber
_))   = AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
IPv4Address
    ntnAddressType (TestAddress (Node.IPAddr (IPv6 IPv6
_) PortNumber
_))   = AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
IPv6Address

    -- various pseudo random generators
    (StdGen
diffStgGen, StdGen
keepAliveStdGen) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split (Interfaces extraAPI m -> StdGen
forall extraAPI (m :: * -> *). Interfaces extraAPI m -> StdGen
iRng Interfaces extraAPI m
ni)

    ntnUnversionedDataCodec :: VersionDataCodec CBOR.Term NtNVersion NtNVersionData
    ntnUnversionedDataCodec :: VersionDataCodec Term NtNVersion NtNVersionData
ntnUnversionedDataCodec = VersionDataCodec { NtNVersion -> NtNVersionData -> Term
forall {p}. p -> NtNVersionData -> Term
encodeData :: forall {p}. p -> NtNVersionData -> Term
encodeData :: NtNVersion -> NtNVersionData -> Term
encodeData, NtNVersion -> Term -> Either Text NtNVersionData
forall {p}. p -> Term -> Either Text NtNVersionData
decodeData :: forall {p}. p -> Term -> Either Text NtNVersionData
decodeData :: NtNVersion -> Term -> Either Text NtNVersionData
decodeData }
      where
        encodeData :: p -> NtNVersionData -> Term
encodeData p
_ NtNVersionData { DiffusionMode
ntnDiffusionMode :: NtNVersionData -> DiffusionMode
ntnDiffusionMode :: DiffusionMode
ntnDiffusionMode, PeerSharing
ntnPeerSharing :: NtNVersionData -> PeerSharing
ntnPeerSharing :: PeerSharing
ntnPeerSharing } =
          let peerSharing :: Int
peerSharing = case PeerSharing
ntnPeerSharing of
                PeerSharing
PeerSharingDisabled -> Int
0
                PeerSharing
PeerSharingEnabled  -> Int
1
           in case DiffusionMode
ntnDiffusionMode of
             DiffusionMode
InitiatorOnlyDiffusionMode         ->
               [Term] -> Term
CBOR.TList [Bool -> Term
CBOR.TBool Bool
False, Int -> Term
CBOR.TInt Int
peerSharing]
             DiffusionMode
InitiatorAndResponderDiffusionMode ->
               [Term] -> Term
CBOR.TList [Bool -> Term
CBOR.TBool Bool
True, Int -> Term
CBOR.TInt Int
peerSharing]

        toPeerSharing :: Int -> Either Text PeerSharing
        toPeerSharing :: Int -> Either Text PeerSharing
toPeerSharing Int
0 = PeerSharing -> Either Text PeerSharing
forall a b. b -> Either a b
Right PeerSharing
PeerSharingDisabled
        toPeerSharing Int
1 = PeerSharing -> Either Text PeerSharing
forall a b. b -> Either a b
Right PeerSharing
PeerSharingEnabled
        toPeerSharing Int
_ = Text -> Either Text PeerSharing
forall a b. a -> Either a b
Left Text
"toPeerSharing: out of bounds"

        decodeData :: p -> Term -> Either Text NtNVersionData
decodeData p
_ (CBOR.TList [CBOR.TBool Bool
False, CBOR.TInt Int
a]) = DiffusionMode -> PeerSharing -> NtNVersionData
NtNVersionData DiffusionMode
InitiatorOnlyDiffusionMode (PeerSharing -> NtNVersionData)
-> Either Text PeerSharing -> Either Text NtNVersionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Either Text PeerSharing
toPeerSharing Int
a)
        decodeData p
_ (CBOR.TList [CBOR.TBool Bool
True, CBOR.TInt Int
a])  = DiffusionMode -> PeerSharing -> NtNVersionData
NtNVersionData DiffusionMode
InitiatorAndResponderDiffusionMode (PeerSharing -> NtNVersionData)
-> Either Text PeerSharing -> Either Text NtNVersionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Either Text PeerSharing
toPeerSharing Int
a)
        decodeData p
_ Term
_                                            = Text -> Either Text NtNVersionData
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"unversionedDataCodec: unexpected term")

    mkArgs :: StrictTVar m (PublicPeerSelectionState NtNAddr)
           -> Diff.Arguments
                   extraState extraDebugState
                   extraFlags extraPeers extraAPI
                   extraChurnArgs extraCounters exception
                   resolver resolverError
                   m (NtNFD m) NtNAddr (NtCFD m) NtCAddr
    mkArgs :: StrictTVar m (PublicPeerSelectionState NtNAddr)
-> Arguments
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraChurnArgs
     extraCounters
     exception
     resolver
     resolverError
     m
     (NtNFD m)
     NtNAddr
     (NtCFD m)
     NtCAddr
mkArgs StrictTVar m (PublicPeerSelectionState NtNAddr)
daPublicPeerSelectionVar = Diff.Arguments
      { daIPv4Address :: Maybe (Either (NtNFD m) NtNAddr)
Diff.daIPv4Address   = NtNAddr -> Either (NtNFD m) NtNAddr
forall a b. b -> Either a b
Right (NtNAddr -> Either (NtNFD m) NtNAddr)
-> Maybe NtNAddr -> Maybe (Either (NtNFD m) NtNAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NtNAddr -> Maybe NtNAddr
ntnToIPv4 (NtNAddr -> Maybe NtNAddr)
-> (Arguments extraChurnArgs extraFlags m -> NtNAddr)
-> Arguments extraChurnArgs extraFlags m
-> Maybe NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments extraChurnArgs extraFlags m -> NtNAddr
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> NtNAddr
aIPAddress) Arguments extraChurnArgs extraFlags m
na
      , daIPv6Address :: Maybe (Either (NtNFD m) NtNAddr)
Diff.daIPv6Address   = NtNAddr -> Either (NtNFD m) NtNAddr
forall a b. b -> Either a b
Right (NtNAddr -> Either (NtNFD m) NtNAddr)
-> Maybe NtNAddr -> Maybe (Either (NtNFD m) NtNAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NtNAddr -> Maybe NtNAddr
ntnToIPv6 (NtNAddr -> Maybe NtNAddr)
-> (Arguments extraChurnArgs extraFlags m -> NtNAddr)
-> Arguments extraChurnArgs extraFlags m
-> Maybe NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments extraChurnArgs extraFlags m -> NtNAddr
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> NtNAddr
aIPAddress) Arguments extraChurnArgs extraFlags m
na
      , daLocalAddress :: Maybe (Either (NtCFD m) NtCAddr)
Diff.daLocalAddress  = Maybe (Either (NtCFD m) NtCAddr)
forall a. Maybe a
Nothing
      , daAcceptedConnectionsLimit :: AcceptedConnectionsLimit
Diff.daAcceptedConnectionsLimit
                             = Arguments extraChurnArgs extraFlags m -> AcceptedConnectionsLimit
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> AcceptedConnectionsLimit
aAcceptedLimits Arguments extraChurnArgs extraFlags m
na
      , daMode :: DiffusionMode
Diff.daMode          = Arguments extraChurnArgs extraFlags m -> DiffusionMode
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffusionMode
aDiffusionMode Arguments extraChurnArgs extraFlags m
na
      , StrictTVar m (PublicPeerSelectionState NtNAddr)
daPublicPeerSelectionVar :: StrictTVar m (PublicPeerSelectionState NtNAddr)
daPublicPeerSelectionVar :: StrictTVar m (PublicPeerSelectionState NtNAddr)
Diff.daPublicPeerSelectionVar
      , daPeerSelectionTargets :: PeerSelectionTargets
Diff.daPeerSelectionTargets   = Arguments extraChurnArgs extraFlags m -> PeerSelectionTargets
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> PeerSelectionTargets
aPeerTargets Arguments extraChurnArgs extraFlags m
na
      , daReadLocalRootPeers :: STM m (Config extraFlags RelayAccessPoint)
Diff.daReadLocalRootPeers     = Arguments extraChurnArgs extraFlags m
-> STM m (Config extraFlags RelayAccessPoint)
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m
-> STM
     m
     [(HotValency, WarmValency,
       Map RelayAccessPoint (LocalRootConfig extraFlags))]
aReadLocalRootPeers Arguments extraChurnArgs extraFlags m
na
      , daReadPublicRootPeers :: STM m (Map RelayAccessPoint PeerAdvertise)
Diff.daReadPublicRootPeers    = Arguments extraChurnArgs extraFlags m
-> STM m (Map RelayAccessPoint PeerAdvertise)
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m
-> STM m (Map RelayAccessPoint PeerAdvertise)
aReadPublicRootPeers Arguments extraChurnArgs extraFlags m
na
      , daOwnPeerSharing :: PeerSharing
Diff.daOwnPeerSharing         = Arguments extraChurnArgs extraFlags m -> PeerSharing
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> PeerSharing
aOwnPeerSharing Arguments extraChurnArgs extraFlags m
na
      , daReadUseLedgerPeers :: STM m UseLedgerPeers
Diff.daReadUseLedgerPeers     = Arguments extraChurnArgs extraFlags m -> STM m UseLedgerPeers
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> STM m UseLedgerPeers
aReadUseLedgerPeers Arguments extraChurnArgs extraFlags m
na
      , daProtocolIdleTimeout :: DiffTime
Diff.daProtocolIdleTimeout    = Arguments extraChurnArgs extraFlags m -> DiffTime
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffTime
aProtocolIdleTimeout Arguments extraChurnArgs extraFlags m
na
      , daTimeWaitTimeout :: DiffTime
Diff.daTimeWaitTimeout        = Arguments extraChurnArgs extraFlags m -> DiffTime
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffTime
aTimeWaitTimeout Arguments extraChurnArgs extraFlags m
na
      , daDeadlineChurnInterval :: DiffTime
Diff.daDeadlineChurnInterval  = DiffTime
3300
      , daBulkChurnInterval :: DiffTime
Diff.daBulkChurnInterval      = DiffTime
300
      , daReadLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
Diff.daReadLedgerPeerSnapshot = Maybe LedgerPeerSnapshot -> STM m (Maybe LedgerPeerSnapshot)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LedgerPeerSnapshot
forall a. Maybe a
Nothing -- ^ tested independently
      , daEmptyExtraState :: extraState
Diff.daEmptyExtraState        = extraState
emptyExtraState
      , daEmptyExtraCounters :: extraCounters
Diff.daEmptyExtraCounters     = extraCounters
emptyExtraCounters
      , daExtraPeersAPI :: PublicExtraPeersAPI extraPeers NtNAddr
Diff.daExtraPeersAPI          = PublicExtraPeersAPI extraPeers NtNAddr
extraPeersAPI
      , daExtraChurnArgs :: extraChurnArgs
Diff.daExtraChurnArgs         = Arguments extraChurnArgs extraFlags m -> extraChurnArgs
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> extraChurnArgs
aExtraChurnArgs Arguments extraChurnArgs extraFlags m
na
      , daToExtraPeers :: Map NtNAddr PeerAdvertise -> extraPeers
Diff.daToExtraPeers           = Map NtNAddr PeerAdvertise -> extraPeers
toExtraPeers
      , daRequestPublicRootPeers :: Maybe
  (PeerActionsDNS NtNAddr resolver resolverError m
   -> DNSSemaphore m
   -> (Map NtNAddr PeerAdvertise -> extraPeers)
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
   -> LedgerPeersKind
   -> Int
   -> m (PublicRootPeers extraPeers NtNAddr, DiffTime))
Diff.daRequestPublicRootPeers = (PeerActionsDNS NtNAddr resolver resolverError m
 -> DNSSemaphore m
 -> (Map NtNAddr PeerAdvertise -> extraPeers)
 -> (NumberOfPeers
     -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
 -> LedgerPeersKind
 -> Int
 -> m (PublicRootPeers extraPeers NtNAddr, DiffTime))
-> Maybe
     (PeerActionsDNS NtNAddr resolver resolverError m
      -> DNSSemaphore m
      -> (Map NtNAddr PeerAdvertise -> extraPeers)
      -> (NumberOfPeers
          -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
      -> LedgerPeersKind
      -> Int
      -> m (PublicRootPeers extraPeers NtNAddr, DiffTime))
forall a. a -> Maybe a
Just PeerActionsDNS NtNAddr resolver resolverError m
-> DNSSemaphore m
-> (Map NtNAddr PeerAdvertise -> extraPeers)
-> (NumberOfPeers
    -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
-> LedgerPeersKind
-> Int
-> m (PublicRootPeers extraPeers NtNAddr, DiffTime)
requestPublicRootPeers
      , daPeerChurnGovernor :: PeerChurnArgs
  m
  extraChurnArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  NtNAddr
-> m Void
Diff.daPeerChurnGovernor      = PeerChurnArgs
  m
  extraChurnArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  NtNAddr
-> m Void
peerChurnGovernor
      , daPeerSelectionGovernorArgs :: forall (muxMode :: Mode) responderCtx ntnVersionData bytes a b.
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  NtNAddr
  (PeerConnectionHandle
     muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
  exception
  m
Diff.daPeerSelectionGovernorArgs         = PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  NtNAddr
  (PeerConnectionHandle
     muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
  exception
  m
forall (muxMode :: Mode) responderCtx ntnVersionData bytes a b.
PeerSelectionGovernorArgs
  extraState
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  NtNAddr
  (PeerConnectionHandle
     muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
  exception
  m
psArgs
      , daPeerSelectionStateToExtraCounters :: forall (muxMode :: Mode) responderCtx ntnVersionData bytes a b.
PeerSelectionState
  extraState
  extraFlags
  extraPeers
  NtNAddr
  (PeerConnectionHandle
     muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
-> extraCounters
Diff.daPeerSelectionStateToExtraCounters = PeerSelectionState
  extraState
  extraFlags
  extraPeers
  NtNAddr
  (PeerConnectionHandle
     muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
-> extraCounters
forall (muxMode :: Mode) responderCtx ntnVersionData bytes a b.
PeerSelectionState
  extraState
  extraFlags
  extraPeers
  NtNAddr
  (PeerConnectionHandle
     muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
-> extraCounters
psToExtraCounters
      , daMuxForkPolicy :: ForkPolicy NtNAddr
Diff.daMuxForkPolicy          = ForkPolicy NtNAddr
forall peerAddr. ForkPolicy peerAddr
noBindForkPolicy
      , daLocalMuxForkPolicy :: ForkPolicy NtCAddr
Diff.daLocalMuxForkPolicy     = ForkPolicy NtCAddr
forall peerAddr. ForkPolicy peerAddr
noBindForkPolicy
      }

    appArgs :: PeerMetrics m NtNAddr
            -> Node.AppArgs extraAPI BlockHeader Block m
    appArgs :: PeerMetrics m NtNAddr -> AppArgs extraAPI BlockHeader Block m
appArgs PeerMetrics m NtNAddr
peerMetrics = Node.AppArgs
      { aaLedgerPeersConsensusInterface :: LedgerPeersConsensusInterface extraAPI m
Node.aaLedgerPeersConsensusInterface
                                   = Interfaces extraAPI m -> LedgerPeersConsensusInterface extraAPI m
forall extraAPI (m :: * -> *).
Interfaces extraAPI m -> LedgerPeersConsensusInterface extraAPI m
iLedgerPeersConsensusInterface Interfaces extraAPI m
ni
      , aaKeepAliveStdGen :: StdGen
Node.aaKeepAliveStdGen     = StdGen
keepAliveStdGen
      , aaDiffusionMode :: DiffusionMode
Node.aaDiffusionMode       = Arguments extraChurnArgs extraFlags m -> DiffusionMode
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffusionMode
aDiffusionMode Arguments extraChurnArgs extraFlags m
na
      , aaKeepAliveInterval :: DiffTime
Node.aaKeepAliveInterval   = Arguments extraChurnArgs extraFlags m -> DiffTime
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffTime
aKeepAliveInterval Arguments extraChurnArgs extraFlags m
na
      , aaPingPongInterval :: DiffTime
Node.aaPingPongInterval    = Arguments extraChurnArgs extraFlags m -> DiffTime
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> DiffTime
aPingPongInterval Arguments extraChurnArgs extraFlags m
na
      , aaShouldChainSyncExit :: BlockHeader -> m Bool
Node.aaShouldChainSyncExit = Arguments extraChurnArgs extraFlags m -> BlockHeader -> m Bool
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> BlockHeader -> m Bool
aShouldChainSyncExit Arguments extraChurnArgs extraFlags m
na
      , aaChainSyncEarlyExit :: Bool
Node.aaChainSyncEarlyExit  = Arguments extraChurnArgs extraFlags m -> Bool
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> Bool
aChainSyncEarlyExit Arguments extraChurnArgs extraFlags m
na
      , aaOwnPeerSharing :: PeerSharing
Node.aaOwnPeerSharing      = Arguments extraChurnArgs extraFlags m -> PeerSharing
forall extraChurnArgs extraFlags (m :: * -> *).
Arguments extraChurnArgs extraFlags m -> PeerSharing
aOwnPeerSharing Arguments extraChurnArgs extraFlags m
na
      , aaPeerMetrics :: PeerMetrics m NtNAddr
Node.aaPeerMetrics         = PeerMetrics m NtNAddr
peerMetrics
      }

--- Utils

ntnToIPv4 :: NtNAddr -> Maybe NtNAddr
ntnToIPv4 :: NtNAddr -> Maybe NtNAddr
ntnToIPv4 ntnAddr :: NtNAddr
ntnAddr@(TestAddress (Node.EphemeralIPv4Addr Natural
_)) = NtNAddr -> Maybe NtNAddr
forall a. a -> Maybe a
Just NtNAddr
ntnAddr
ntnToIPv4 ntnAddr :: NtNAddr
ntnAddr@(TestAddress (Node.IPAddr (IPv4 IPv4
_) PortNumber
_))   = NtNAddr -> Maybe NtNAddr
forall a. a -> Maybe a
Just NtNAddr
ntnAddr
ntnToIPv4 (TestAddress NtNAddr_
_)                                  = Maybe NtNAddr
forall a. Maybe a
Nothing

ntnToIPv6 :: NtNAddr -> Maybe NtNAddr
ntnToIPv6 :: NtNAddr -> Maybe NtNAddr
ntnToIPv6 ntnAddr :: NtNAddr
ntnAddr@(TestAddress (Node.EphemeralIPv6Addr Natural
_)) = NtNAddr -> Maybe NtNAddr
forall a. a -> Maybe a
Just NtNAddr
ntnAddr
ntnToIPv6 ntnAddr :: NtNAddr
ntnAddr@(TestAddress (Node.IPAddr (IPv6 IPv6
_) PortNumber
_))   = NtNAddr -> Maybe NtNAddr
forall a. a -> Maybe a
Just NtNAddr
ntnAddr
ntnToIPv6 (TestAddress NtNAddr_
_)                                  = Maybe NtNAddr
forall a. Maybe a
Nothing

--
-- Constants
--

config_REPROMOTE_DELAY :: RepromoteDelay
config_REPROMOTE_DELAY :: RepromoteDelay
config_REPROMOTE_DELAY = RepromoteDelay
10