{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.Consensus.PeerSimulator.NodeLifecycle (
LiveInterval (..)
, LiveIntervalResult (..)
, LiveNode (..)
, LiveResources (..)
, NodeLifecycle (..)
, lifecycleStart
, lifecycleStop
, restoreNode
) where
import Control.Tracer (Tracer (..), traceWith)
import Data.Functor (void)
import Data.Set (Set)
import qualified Data.Set as Set
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config (TopLevelConfig (..))
import Ouroboros.Consensus.Storage.ChainDB.API
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl as ChainDB
import Ouroboros.Consensus.Storage.ChainDB.Impl.Args (cdbsLoE,
updateTracer)
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.ResourceRegistry
import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
import qualified Ouroboros.Network.AnchoredFragment as AF
import qualified System.FS.Sim.MockFS as MockFS
import System.FS.Sim.MockFS (MockFS)
import Test.Consensus.PeerSimulator.Resources
import Test.Consensus.PeerSimulator.StateView
import Test.Consensus.PeerSimulator.Trace
import Test.Consensus.PointSchedule.Peers (PeerId)
import Test.Util.ChainDB
import Test.Util.Orphans.IOLike ()
import Test.Util.TestBlock (TestBlock, testInitExtLedger)
data LiveNode blk m = LiveNode {
forall blk (m :: * -> *). LiveNode blk m -> ChainDB m blk
lnChainDb :: ChainDB m blk
, forall blk (m :: * -> *). LiveNode blk m -> StateViewTracers blk m
lnStateViewTracers :: StateViewTracers blk m
, forall blk (m :: * -> *). LiveNode blk m -> Tracer m ()
lnStateTracer :: Tracer m ()
, forall blk (m :: * -> *). LiveNode blk m -> m (WithOrigin SlotNo)
lnCopyToImmDb :: m (WithOrigin SlotNo)
, forall blk (m :: * -> *). LiveNode blk m -> Set PeerId
lnPeers :: Set PeerId
}
data LiveIntervalResult blk = LiveIntervalResult {
forall blk. LiveIntervalResult blk -> [PeerSimulatorResult blk]
lirPeerResults :: [PeerSimulatorResult blk]
, forall blk. LiveIntervalResult blk -> Set PeerId
lirActive :: Set PeerId
}
data LiveResources blk m = LiveResources {
forall blk (m :: * -> *). LiveResources blk m -> ResourceRegistry m
lrRegistry :: ResourceRegistry m
, forall blk (m :: * -> *).
LiveResources blk m -> PeerSimulatorResources m blk
lrPeerSim :: PeerSimulatorResources m blk
, forall blk (m :: * -> *).
LiveResources blk m -> Tracer m (TraceEvent blk)
lrTracer :: Tracer m (TraceEvent blk)
, forall blk (m :: * -> *).
LiveResources blk m -> ChainDB m blk -> m (Tracer m ())
lrSTracer :: ChainDB m blk -> m (Tracer m ())
, forall blk (m :: * -> *). LiveResources blk m -> TopLevelConfig blk
lrConfig :: TopLevelConfig blk
, forall blk (m :: * -> *).
LiveResources blk m -> NodeDBs (StrictTMVar m MockFS)
lrCdb :: NodeDBs (StrictTMVar m MockFS)
, forall blk (m :: * -> *).
LiveResources blk m
-> LoE (StrictTVar m (AnchoredFragment (Header blk)))
lrLoEVar :: LoE (StrictTVar m (AnchoredFragment (Header blk)))
}
data LiveInterval blk m = LiveInterval {
forall blk (m :: * -> *). LiveInterval blk m -> LiveResources blk m
liResources :: LiveResources blk m
, forall blk (m :: * -> *).
LiveInterval blk m -> LiveIntervalResult blk
liResult :: LiveIntervalResult blk
, forall blk (m :: * -> *). LiveInterval blk m -> LiveNode blk m
liNode :: LiveNode blk m
}
data NodeLifecycle blk m = NodeLifecycle {
forall blk (m :: * -> *). NodeLifecycle blk m -> Maybe DiffTime
nlMinDuration :: Maybe DiffTime
, forall blk (m :: * -> *).
NodeLifecycle blk m -> LiveIntervalResult blk -> m (LiveNode blk m)
nlStart :: LiveIntervalResult blk -> m (LiveNode blk m)
, forall blk (m :: * -> *).
NodeLifecycle blk m -> LiveNode blk m -> m (LiveIntervalResult blk)
nlShutdown :: LiveNode blk m -> m (LiveIntervalResult blk)
}
mkChainDb ::
IOLike m =>
LiveResources TestBlock m ->
m (ChainDB m TestBlock, m (WithOrigin SlotNo))
mkChainDb :: forall (m :: * -> *).
IOLike m =>
LiveResources TestBlock m
-> m (ChainDB m TestBlock, m (WithOrigin SlotNo))
mkChainDb LiveResources TestBlock m
resources = do
STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
STM m MockFS -> STM m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (STM m MockFS -> STM m ()) -> STM m MockFS -> STM m ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> MockFS -> STM m MockFS
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m a
swapTMVar (NodeDBs (StrictTMVar m MockFS) -> StrictTMVar m MockFS
forall db. NodeDBs db -> db
nodeDBsGsm NodeDBs (StrictTMVar m MockFS)
lrCdb) MockFS
MockFS.empty
STM m MockFS -> STM m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (STM m MockFS -> STM m ()) -> STM m MockFS -> STM m ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> MockFS -> STM m MockFS
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m a
swapTMVar (NodeDBs (StrictTMVar m MockFS) -> StrictTMVar m MockFS
forall db. NodeDBs db -> db
nodeDBsLgr NodeDBs (StrictTMVar m MockFS)
lrCdb) MockFS
MockFS.empty
ChainDbArgs Identity m TestBlock
chainDbArgs <- do
let args :: ChainDbArgs Identity m TestBlock
args = Tracer m (TraceEvent TestBlock)
-> ChainDbArgs Identity m TestBlock
-> ChainDbArgs Identity m TestBlock
forall (m :: * -> *) blk (f :: * -> *).
Tracer m (TraceEvent blk)
-> ChainDbArgs f m blk -> ChainDbArgs f m blk
updateTracer
((TraceEvent TestBlock -> m ()) -> Tracer m (TraceEvent TestBlock)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (Tracer m (TraceEvent TestBlock) -> TraceEvent TestBlock -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent TestBlock)
lrTracer (TraceEvent TestBlock -> m ())
-> (TraceEvent TestBlock -> TraceEvent TestBlock)
-> TraceEvent TestBlock
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceEvent TestBlock -> TraceEvent TestBlock
forall blk. TraceEvent blk -> TraceEvent blk
TraceChainDBEvent))
(MinimalChainDbArgs m TestBlock -> ChainDbArgs Identity m TestBlock
forall (m :: * -> *) blk.
(MonadThrow m, MonadSTM m, ConsensusProtocol (BlockProtocol blk),
PrimMonad m) =>
MinimalChainDbArgs m blk -> Complete ChainDbArgs m blk
fromMinimalChainDbArgs MinimalChainDbArgs {
mcdbTopLevelConfig :: TopLevelConfig TestBlock
mcdbTopLevelConfig = TopLevelConfig TestBlock
lrConfig
, mcdbChunkInfo :: ChunkInfo
mcdbChunkInfo = TopLevelConfig TestBlock -> ChunkInfo
mkTestChunkInfo TopLevelConfig TestBlock
lrConfig
, mcdbInitLedger :: ExtLedgerState TestBlock
mcdbInitLedger = ExtLedgerState TestBlock
testInitExtLedger
, mcdbRegistry :: ResourceRegistry m
mcdbRegistry = ResourceRegistry m
lrRegistry
, mcdbNodeDBs :: NodeDBs (StrictTMVar m MockFS)
mcdbNodeDBs = NodeDBs (StrictTMVar m MockFS)
lrCdb
})
ChainDbArgs Identity m TestBlock
-> m (ChainDbArgs Identity m TestBlock)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainDbArgs Identity m TestBlock
-> m (ChainDbArgs Identity m TestBlock))
-> ChainDbArgs Identity m TestBlock
-> m (ChainDbArgs Identity m TestBlock)
forall a b. (a -> b) -> a -> b
$ ChainDbArgs Identity m TestBlock
args { ChainDB.cdbsArgs = (ChainDB.cdbsArgs args) {
cdbsLoE = traverse readTVarIO lrLoEVar
} }
(ResourceKey m
_, (ChainDB m TestBlock
chainDB, Internal m TestBlock
internal)) <- ResourceRegistry m
-> (ResourceId -> m (ChainDB m TestBlock, Internal m TestBlock))
-> ((ChainDB m TestBlock, Internal m TestBlock) -> m ())
-> m (ResourceKey m, (ChainDB m TestBlock, Internal m TestBlock))
forall (m :: * -> *) a.
(IOLike m, HasCallStack) =>
ResourceRegistry m
-> (ResourceId -> m a) -> (a -> m ()) -> m (ResourceKey m, a)
allocate
ResourceRegistry m
lrRegistry
(\ResourceId
_ -> ChainDbArgs Identity m TestBlock
-> Bool -> m (ChainDB m TestBlock, Internal m TestBlock)
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk,
BlockSupportsDiffusionPipelining blk, InspectLedger blk,
HasHardForkHistory blk, ConvertRawHash blk,
SerialiseDiskConstraints blk) =>
ChainDbArgs Identity m blk
-> Bool -> m (ChainDB m blk, Internal m blk)
ChainDB.openDBInternal ChainDbArgs Identity m TestBlock
chainDbArgs Bool
False)
(ChainDB m TestBlock -> m ()
forall (m :: * -> *) blk. ChainDB m blk -> m ()
ChainDB.closeDB (ChainDB m TestBlock -> m ())
-> ((ChainDB m TestBlock, Internal m TestBlock)
-> ChainDB m TestBlock)
-> (ChainDB m TestBlock, Internal m TestBlock)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainDB m TestBlock, Internal m TestBlock) -> ChainDB m TestBlock
forall a b. (a, b) -> a
fst)
let ChainDB.Internal {m (WithOrigin SlotNo)
intCopyToImmutableDB :: m (WithOrigin SlotNo)
intCopyToImmutableDB :: forall (m :: * -> *) blk. Internal m blk -> m (WithOrigin SlotNo)
intCopyToImmutableDB, m Void
intAddBlockRunner :: m Void
intAddBlockRunner :: forall (m :: * -> *) blk. Internal m blk -> m Void
intAddBlockRunner} = Internal m TestBlock
internal
m (Thread m ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Thread m ()) -> m ()) -> m (Thread m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ ResourceRegistry m -> String -> m () -> m (Thread m ())
forall (m :: * -> *) a.
(IOLike m, HasCallStack) =>
ResourceRegistry m -> String -> m a -> m (Thread m a)
forkLinkedThread ResourceRegistry m
lrRegistry String
"AddBlockRunner" (m Void -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m Void
intAddBlockRunner)
(ChainDB m TestBlock, m (WithOrigin SlotNo))
-> m (ChainDB m TestBlock, m (WithOrigin SlotNo))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainDB m TestBlock
chainDB, m (WithOrigin SlotNo)
intCopyToImmutableDB)
where
LiveResources {ResourceRegistry m
lrRegistry :: forall blk (m :: * -> *). LiveResources blk m -> ResourceRegistry m
lrRegistry :: ResourceRegistry m
lrRegistry, Tracer m (TraceEvent TestBlock)
lrTracer :: forall blk (m :: * -> *).
LiveResources blk m -> Tracer m (TraceEvent blk)
lrTracer :: Tracer m (TraceEvent TestBlock)
lrTracer, TopLevelConfig TestBlock
lrConfig :: forall blk (m :: * -> *). LiveResources blk m -> TopLevelConfig blk
lrConfig :: TopLevelConfig TestBlock
lrConfig, NodeDBs (StrictTMVar m MockFS)
lrCdb :: forall blk (m :: * -> *).
LiveResources blk m -> NodeDBs (StrictTMVar m MockFS)
lrCdb :: NodeDBs (StrictTMVar m MockFS)
lrCdb, LoE (StrictTVar m (AnchoredFragment (Header TestBlock)))
lrLoEVar :: forall blk (m :: * -> *).
LiveResources blk m
-> LoE (StrictTVar m (AnchoredFragment (Header blk)))
lrLoEVar :: LoE (StrictTVar m (AnchoredFragment (Header TestBlock)))
lrLoEVar} = LiveResources TestBlock m
resources
restoreNode ::
IOLike m =>
LiveResources TestBlock m ->
LiveIntervalResult TestBlock ->
m (LiveNode TestBlock m)
restoreNode :: forall (m :: * -> *).
IOLike m =>
LiveResources TestBlock m
-> LiveIntervalResult TestBlock -> m (LiveNode TestBlock m)
restoreNode LiveResources TestBlock m
resources LiveIntervalResult {[PeerSimulatorResult TestBlock]
lirPeerResults :: forall blk. LiveIntervalResult blk -> [PeerSimulatorResult blk]
lirPeerResults :: [PeerSimulatorResult TestBlock]
lirPeerResults, Set PeerId
lirActive :: forall blk. LiveIntervalResult blk -> Set PeerId
lirActive :: Set PeerId
lirActive} = do
StateViewTracers TestBlock m
lnStateViewTracers <- [PeerSimulatorResult TestBlock] -> m (StateViewTracers TestBlock m)
forall (m :: * -> *) blk.
IOLike m =>
[PeerSimulatorResult blk] -> m (StateViewTracers blk m)
stateViewTracersWithInitial [PeerSimulatorResult TestBlock]
lirPeerResults
(ChainDB m TestBlock
lnChainDb, m (WithOrigin SlotNo)
lnCopyToImmDb) <- LiveResources TestBlock m
-> m (ChainDB m TestBlock, m (WithOrigin SlotNo))
forall (m :: * -> *).
IOLike m =>
LiveResources TestBlock m
-> m (ChainDB m TestBlock, m (WithOrigin SlotNo))
mkChainDb LiveResources TestBlock m
resources
Tracer m ()
lnStateTracer <- LiveResources TestBlock m -> ChainDB m TestBlock -> m (Tracer m ())
forall blk (m :: * -> *).
LiveResources blk m -> ChainDB m blk -> m (Tracer m ())
lrSTracer LiveResources TestBlock m
resources ChainDB m TestBlock
lnChainDb
LiveNode TestBlock m -> m (LiveNode TestBlock m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LiveNode {
ChainDB m TestBlock
lnChainDb :: ChainDB m TestBlock
lnChainDb :: ChainDB m TestBlock
lnChainDb
, StateViewTracers TestBlock m
lnStateViewTracers :: StateViewTracers TestBlock m
lnStateViewTracers :: StateViewTracers TestBlock m
lnStateViewTracers
, Tracer m ()
lnStateTracer :: Tracer m ()
lnStateTracer :: Tracer m ()
lnStateTracer
, m (WithOrigin SlotNo)
lnCopyToImmDb :: m (WithOrigin SlotNo)
lnCopyToImmDb :: m (WithOrigin SlotNo)
lnCopyToImmDb
, lnPeers :: Set PeerId
lnPeers = Set PeerId
lirActive
}
lifecycleStart ::
forall m.
IOLike m =>
(LiveInterval TestBlock m -> m ()) ->
LiveResources TestBlock m ->
LiveIntervalResult TestBlock ->
m (LiveNode TestBlock m)
lifecycleStart :: forall (m :: * -> *).
IOLike m =>
(LiveInterval TestBlock m -> m ())
-> LiveResources TestBlock m
-> LiveIntervalResult TestBlock
-> m (LiveNode TestBlock m)
lifecycleStart LiveInterval TestBlock m -> m ()
start LiveResources TestBlock m
liResources LiveIntervalResult TestBlock
liResult = do
TraceEvent TestBlock -> m ()
trace (TraceSchedulerEvent TestBlock -> TraceEvent TestBlock
forall blk. TraceSchedulerEvent blk -> TraceEvent blk
TraceSchedulerEvent TraceSchedulerEvent TestBlock
forall blk. TraceSchedulerEvent blk
TraceNodeStartupStart)
LiveNode TestBlock m
liNode <- LiveResources TestBlock m
-> LiveIntervalResult TestBlock -> m (LiveNode TestBlock m)
forall (m :: * -> *).
IOLike m =>
LiveResources TestBlock m
-> LiveIntervalResult TestBlock -> m (LiveNode TestBlock m)
restoreNode LiveResources TestBlock m
liResources LiveIntervalResult TestBlock
liResult
LiveInterval TestBlock m -> m ()
start LiveInterval {LiveResources TestBlock m
liResources :: LiveResources TestBlock m
liResources :: LiveResources TestBlock m
liResources, LiveIntervalResult TestBlock
liResult :: LiveIntervalResult TestBlock
liResult :: LiveIntervalResult TestBlock
liResult, LiveNode TestBlock m
liNode :: LiveNode TestBlock m
liNode :: LiveNode TestBlock m
liNode}
AnchoredFragment (Header TestBlock)
chain <- STM m (AnchoredFragment (Header TestBlock))
-> m (AnchoredFragment (Header TestBlock))
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (ChainDB m TestBlock -> STM m (AnchoredFragment (Header TestBlock))
forall (m :: * -> *) blk.
ChainDB m blk -> STM m (AnchoredFragment (Header blk))
ChainDB.getCurrentChain (LiveNode TestBlock m -> ChainDB m TestBlock
forall blk (m :: * -> *). LiveNode blk m -> ChainDB m blk
lnChainDb LiveNode TestBlock m
liNode))
TraceEvent TestBlock -> m ()
trace (TraceSchedulerEvent TestBlock -> TraceEvent TestBlock
forall blk. TraceSchedulerEvent blk -> TraceEvent blk
TraceSchedulerEvent (AnchoredFragment (Header TestBlock)
-> TraceSchedulerEvent TestBlock
forall blk.
AnchoredFragment (Header blk) -> TraceSchedulerEvent blk
TraceNodeStartupComplete AnchoredFragment (Header TestBlock)
chain))
LiveNode TestBlock m -> m (LiveNode TestBlock m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LiveNode TestBlock m
liNode
where
trace :: TraceEvent TestBlock -> m ()
trace = Tracer m (TraceEvent TestBlock) -> TraceEvent TestBlock -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith (LiveResources TestBlock m -> Tracer m (TraceEvent TestBlock)
forall blk (m :: * -> *).
LiveResources blk m -> Tracer m (TraceEvent blk)
lrTracer LiveResources TestBlock m
liResources)
lifecycleStop ::
(IOLike m, GetHeader blk) =>
LiveResources blk m ->
LiveNode blk m ->
m (LiveIntervalResult blk)
lifecycleStop :: forall (m :: * -> *) blk.
(IOLike m, GetHeader blk) =>
LiveResources blk m -> LiveNode blk m -> m (LiveIntervalResult blk)
lifecycleStop LiveResources blk m
resources LiveNode {StateViewTracers blk m
lnStateViewTracers :: forall blk (m :: * -> *). LiveNode blk m -> StateViewTracers blk m
lnStateViewTracers :: StateViewTracers blk m
lnStateViewTracers, m (WithOrigin SlotNo)
lnCopyToImmDb :: forall blk (m :: * -> *). LiveNode blk m -> m (WithOrigin SlotNo)
lnCopyToImmDb :: m (WithOrigin SlotNo)
lnCopyToImmDb, Set PeerId
lnPeers :: forall blk (m :: * -> *). LiveNode blk m -> Set PeerId
lnPeers :: Set PeerId
lnPeers} = do
WithOrigin SlotNo
immutableTip <- m (WithOrigin SlotNo)
lnCopyToImmDb
TraceEvent blk -> m ()
trace (TraceSchedulerEvent blk -> TraceEvent blk
forall blk. TraceSchedulerEvent blk -> TraceEvent blk
TraceSchedulerEvent (WithOrigin SlotNo -> TraceSchedulerEvent blk
forall blk. WithOrigin SlotNo -> TraceSchedulerEvent blk
TraceNodeShutdownStart WithOrigin SlotNo
immutableTip))
[PeerSimulatorResult blk]
lirPeerResults <- StateViewTracers blk m -> m [PeerSimulatorResult blk]
forall blk (m :: * -> *).
StateViewTracers blk m -> m [PeerSimulatorResult blk]
svtGetPeerSimulatorResults StateViewTracers blk m
lnStateViewTracers
let disconnectedPeers :: Set PeerId
disconnectedPeers = [PeerId] -> Set PeerId
forall a. Ord a => [a] -> Set a
Set.fromList (PeerSimulatorResult blk -> PeerId
forall blk. PeerSimulatorResult blk -> PeerId
psePeerId (PeerSimulatorResult blk -> PeerId)
-> [PeerSimulatorResult blk] -> [PeerId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PeerSimulatorResult blk]
lirPeerResults)
lirActive :: Set PeerId
lirActive = Set PeerId
lnPeers Set PeerId -> Set PeerId -> Set PeerId
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerId
disconnectedPeers
ResourceRegistry m -> m ()
forall (m :: * -> *).
(IOLike m, HasCallStack) =>
ResourceRegistry m -> m ()
releaseAll ResourceRegistry m
lrRegistry
STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
StrictTVar m (Map PeerId (ChainSyncClientHandle m TestBlock))
-> (Map PeerId (ChainSyncClientHandle m TestBlock)
-> Map PeerId (ChainSyncClientHandle m TestBlock))
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar m (Map PeerId (ChainSyncClientHandle m TestBlock))
psrHandles (Map PeerId (ChainSyncClientHandle m TestBlock)
-> Map PeerId (ChainSyncClientHandle m TestBlock)
-> Map PeerId (ChainSyncClientHandle m TestBlock)
forall a b. a -> b -> a
const Map PeerId (ChainSyncClientHandle m TestBlock)
forall a. Monoid a => a
mempty)
case LoE (StrictTVar m (AnchoredFragment (Header blk)))
lrLoEVar of
LoEEnabled StrictTVar m (AnchoredFragment (Header blk))
var -> StrictTVar m (AnchoredFragment (Header blk))
-> (AnchoredFragment (Header blk) -> AnchoredFragment (Header blk))
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar m (AnchoredFragment (Header blk))
var (AnchoredFragment (Header blk)
-> AnchoredFragment (Header blk) -> AnchoredFragment (Header blk)
forall a b. a -> b -> a
const (Anchor (Header blk) -> AnchoredFragment (Header blk)
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
AF.Empty Anchor (Header blk)
forall block. Anchor block
AF.AnchorGenesis))
LoE (StrictTVar m (AnchoredFragment (Header blk)))
LoEDisabled -> () -> STM m ()
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
TraceEvent blk -> m ()
trace (TraceSchedulerEvent blk -> TraceEvent blk
forall blk. TraceSchedulerEvent blk -> TraceEvent blk
TraceSchedulerEvent TraceSchedulerEvent blk
forall blk. TraceSchedulerEvent blk
TraceNodeShutdownComplete)
LiveIntervalResult blk -> m (LiveIntervalResult blk)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LiveIntervalResult {Set PeerId
lirActive :: Set PeerId
lirActive :: Set PeerId
lirActive, [PeerSimulatorResult blk]
lirPeerResults :: [PeerSimulatorResult blk]
lirPeerResults :: [PeerSimulatorResult blk]
lirPeerResults}
where
trace :: TraceEvent blk -> m ()
trace = Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
lrTracer
LiveResources {
ResourceRegistry m
lrRegistry :: forall blk (m :: * -> *). LiveResources blk m -> ResourceRegistry m
lrRegistry :: ResourceRegistry m
lrRegistry
, Tracer m (TraceEvent blk)
lrTracer :: forall blk (m :: * -> *).
LiveResources blk m -> Tracer m (TraceEvent blk)
lrTracer :: Tracer m (TraceEvent blk)
lrTracer
, lrPeerSim :: forall blk (m :: * -> *).
LiveResources blk m -> PeerSimulatorResources m blk
lrPeerSim = PeerSimulatorResources {StrictTVar m (Map PeerId (ChainSyncClientHandle m TestBlock))
psrHandles :: StrictTVar m (Map PeerId (ChainSyncClientHandle m TestBlock))
psrHandles :: forall (m :: * -> *) blk.
PeerSimulatorResources m blk
-> StrictTVar m (Map PeerId (ChainSyncClientHandle m TestBlock))
psrHandles}
, LoE (StrictTVar m (AnchoredFragment (Header blk)))
lrLoEVar :: forall blk (m :: * -> *).
LiveResources blk m
-> LoE (StrictTVar m (AnchoredFragment (Header blk)))
lrLoEVar :: LoE (StrictTVar m (AnchoredFragment (Header blk)))
lrLoEVar
} = LiveResources blk m
resources