{-# LANGUAGE NamedFieldPuns #-}

-- | Data types and resource allocating constructors for the concurrency
-- primitives used by ChainSync and BlockFetch in the handlers that implement
-- the block tree analysis specific to our peer simulator.
module Test.Consensus.PeerSimulator.Resources
  ( BlockFetchResources (..)
  , ChainSyncResources (..)
  , PeerResources (..)
  , PeerSimulatorResources (..)
  , SharedResources (..)
  , makeChainSyncResources
  , makePeerResources
  , makePeerSimulatorResources
  ) where

import Control.Concurrent.Class.MonadSTM.Strict
  ( atomically
  , dupTChan
  , newBroadcastTChan
  , readTChan
  , writeTChan
  )
import Control.Tracer (Tracer)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Traversable (for)
import Ouroboros.Consensus.Block (WithOrigin (Origin))
import Ouroboros.Consensus.Block.Abstract (Header, Point (..))
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
  ( ChainSyncClientHandleCollection
  , newChainSyncClientHandleCollection
  )
import Ouroboros.Consensus.Util.IOLike
  ( IOLike
  , MonadSTM (STM)
  , StrictTVar
  , readTVar
  , uncheckedNewTVarM
  , writeTVar
  )
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block (Tip (..))
import Ouroboros.Network.Protocol.BlockFetch.Server (BlockFetchServer)
import Ouroboros.Network.Protocol.ChainSync.Server
  ( ChainSyncServer (..)
  )
import Test.Consensus.BlockTree (BlockTree)
import Test.Consensus.PeerSimulator.Handlers
import Test.Consensus.PeerSimulator.ScheduledBlockFetchServer
  ( BlockFetchServerHandlers (..)
  , runScheduledBlockFetchServer
  )
import Test.Consensus.PeerSimulator.ScheduledChainSyncServer
import Test.Consensus.PeerSimulator.Trace (TraceEvent)
import Test.Consensus.PointSchedule.NodeState
import Test.Consensus.PointSchedule.Peers (PeerId)
import Test.Util.Orphans.IOLike ()
import Test.Util.TestBlock (TestBlock)

-- | Resources used by both ChainSync and BlockFetch for a single peer.
data SharedResources m blk
  = SharedResources
  { forall (m :: * -> *) blk. SharedResources m blk -> PeerId
srPeerId :: PeerId
  -- ^ The name of the peer.
  , forall (m :: * -> *) blk. SharedResources m blk -> BlockTree blk
srBlockTree :: BlockTree blk
  -- ^ The block tree in which the test is taking place. In combination to
  -- 'csssCurrentIntersection' and the current point schedule tick, it allows
  -- to define which blocks to serve to the client.
  , forall (m :: * -> *) blk.
SharedResources m blk -> StrictTVar m (Maybe (NodeState blk))
srCurrentState :: StrictTVar m (Maybe (NodeState blk))
  -- ^ The currently active schedule point.
  --
  -- This is 'Maybe' because we cannot wait for the initial state otherwise.
  , forall (m :: * -> *) blk.
SharedResources m blk -> Tracer m (TraceEvent blk)
srTracer :: Tracer m (TraceEvent blk)
  }

-- | The data used by the point scheduler to interact with the mocked protocol handler in
-- "Test.Consensus.PeerSimulator.ScheduledChainSyncServer".
data ChainSyncResources m blk
  = ChainSyncResources
  { forall (m :: * -> *) blk.
ChainSyncResources m blk -> StrictTVar m (Point blk)
csrCurrentIntersection :: StrictTVar m (Point blk)
  -- ^ The current known intersection with the chain of the client.
  , forall (m :: * -> *) blk.
ChainSyncResources m blk
-> ChainSyncServer (Header blk) (Point blk) (Tip blk) m ()
csrServer :: ChainSyncServer (Header blk) (Point blk) (Tip blk) m ()
  -- ^ The final server passed to typed-protocols.
  , forall (m :: * -> *) blk. ChainSyncResources m blk -> STM m ()
csrTickStarted :: STM m ()
  -- ^ This action blocks while this peer is inactive in the point schedule.
  }

-- | The data used by the point scheduler to interact with the mocked protocol handler in
-- "Test.Consensus.PeerSimulator.BlockFetch".
data BlockFetchResources m blk
  = BlockFetchResources
  { forall (m :: * -> *) blk.
BlockFetchResources m blk -> BlockFetchServer blk (Point blk) m ()
bfrServer :: BlockFetchServer blk (Point blk) m ()
  -- ^ The final server passed to typed-protocols.
  , forall (m :: * -> *) blk. BlockFetchResources m blk -> STM m ()
bfrTickStarted :: STM m ()
  -- ^ This action blocks while this peer is inactive in the point schedule.
  }

-- | The totality of resources used by a single peer in ChainSync and BlockFetch and by
-- the scheduler to interact with it.
data PeerResources m blk
  = PeerResources
  { forall (m :: * -> *) blk.
PeerResources m blk -> SharedResources m blk
prShared :: SharedResources m blk
  -- ^ Resources used by ChainSync and BlockFetch.
  , forall (m :: * -> *) blk.
PeerResources m blk -> ChainSyncResources m blk
prChainSync :: ChainSyncResources m blk
  -- ^ Resources used by ChainSync only.
  , forall (m :: * -> *) blk.
PeerResources m blk -> BlockFetchResources m blk
prBlockFetch :: BlockFetchResources m blk
  -- ^ Resources used by BlockFetch only.
  , forall (m :: * -> *) blk.
PeerResources m blk -> NodeState blk -> STM m ()
prUpdateState :: NodeState blk -> STM m ()
  -- ^ An action used by the scheduler to update the peer's advertised points and
  -- resume processing for the ChainSync and BlockFetch servers.
  }

-- | Resources for the peer simulator.
data PeerSimulatorResources m blk
  = PeerSimulatorResources
  { forall (m :: * -> *) blk.
PeerSimulatorResources m blk -> Map PeerId (PeerResources m blk)
psrPeers :: Map PeerId (PeerResources m blk)
  -- ^ Resources for individual peers.
  , forall (m :: * -> *) blk.
PeerSimulatorResources m blk
-> ChainSyncClientHandleCollection PeerId m TestBlock
psrHandles :: ChainSyncClientHandleCollection PeerId m TestBlock
  -- ^ Handles to interact with the ChainSync client of each peer.
  -- See 'ChainSyncClientHandle' for more details.
  }

-- | Create 'ChainSyncServerHandlers' for our default implementation using 'NodeState'.
makeChainSyncServerHandlers ::
  IOLike m =>
  StrictTVar m (Point TestBlock) ->
  BlockTree TestBlock ->
  ChainSyncServerHandlers m (NodeState TestBlock) TestBlock
makeChainSyncServerHandlers :: forall (m :: * -> *).
IOLike m =>
StrictTVar m (Point TestBlock)
-> BlockTree TestBlock
-> ChainSyncServerHandlers m (NodeState TestBlock) TestBlock
makeChainSyncServerHandlers StrictTVar m (Point TestBlock)
currentIntersection BlockTree TestBlock
blockTree =
  ChainSyncServerHandlers
    { csshFindIntersection :: [Point TestBlock]
-> NodeState TestBlock
-> STM
     m
     (Maybe (FindIntersect TestBlock),
      [TraceScheduledChainSyncServerEvent
         (NodeState TestBlock) TestBlock])
csshFindIntersection = StrictTVar m (Point TestBlock)
-> BlockTree TestBlock
-> [Point TestBlock]
-> NodeState TestBlock
-> STM
     m
     (Maybe (FindIntersect TestBlock),
      [TraceScheduledChainSyncServerEvent
         (NodeState TestBlock) TestBlock])
forall (m :: * -> *) blk.
(IOLike m, HasHeader blk) =>
StrictTVar m (Point blk)
-> BlockTree blk
-> [Point blk]
-> NodeState blk
-> STM
     m
     (Maybe (FindIntersect blk),
      [TraceScheduledChainSyncServerEvent (NodeState blk) blk])
handlerFindIntersection StrictTVar m (Point TestBlock)
currentIntersection BlockTree TestBlock
blockTree
    , csshRequestNext :: NodeState TestBlock
-> STM
     m
     (Maybe (RequestNext TestBlock),
      [TraceScheduledChainSyncServerEvent
         (NodeState TestBlock) TestBlock])
csshRequestNext = StrictTVar m (Point TestBlock)
-> BlockTree TestBlock
-> NodeState TestBlock
-> STM
     m
     (Maybe (RequestNext TestBlock),
      [TraceScheduledChainSyncServerEvent
         (NodeState TestBlock) TestBlock])
forall (m :: * -> *).
IOLike m =>
StrictTVar m (Point TestBlock)
-> BlockTree TestBlock
-> NodeState TestBlock
-> STM
     m
     (Maybe (RequestNext TestBlock),
      [TraceScheduledChainSyncServerEvent
         (NodeState TestBlock) TestBlock])
handlerRequestNext StrictTVar m (Point TestBlock)
currentIntersection BlockTree TestBlock
blockTree
    }

-- | Create all the resources used exclusively by the ChainSync handlers, and
-- the ChainSync protocol server that uses the handlers to interface with the
-- typed-protocols engine.
--
-- TODO move server construction to Run?
makeChainSyncResources ::
  IOLike m =>
  STM m () ->
  SharedResources m TestBlock ->
  m (ChainSyncResources m TestBlock)
makeChainSyncResources :: forall (m :: * -> *).
IOLike m =>
STM m ()
-> SharedResources m TestBlock
-> m (ChainSyncResources m TestBlock)
makeChainSyncResources STM m ()
csrTickStarted SharedResources{PeerId
srPeerId :: forall (m :: * -> *) blk. SharedResources m blk -> PeerId
srPeerId :: PeerId
srPeerId, Tracer m (TraceEvent TestBlock)
srTracer :: forall (m :: * -> *) blk.
SharedResources m blk -> Tracer m (TraceEvent blk)
srTracer :: Tracer m (TraceEvent TestBlock)
srTracer, BlockTree TestBlock
srBlockTree :: forall (m :: * -> *) blk. SharedResources m blk -> BlockTree blk
srBlockTree :: BlockTree TestBlock
srBlockTree, StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState :: forall (m :: * -> *) blk.
SharedResources m blk -> StrictTVar m (Maybe (NodeState blk))
srCurrentState :: StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState} = do
  csrCurrentIntersection <- Point TestBlock -> m (StrictTVar m (Point TestBlock))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM (Point TestBlock -> m (StrictTVar m (Point TestBlock)))
-> Point TestBlock -> m (StrictTVar m (Point TestBlock))
forall a b. (a -> b) -> a -> b
$ WithOrigin (Block SlotNo (HeaderHash TestBlock)) -> Point TestBlock
forall {k} (block :: k).
WithOrigin (Block SlotNo (HeaderHash block)) -> Point block
AF.Point WithOrigin (Block SlotNo (HeaderHash TestBlock))
WithOrigin (Block SlotNo TestHash)
forall t. WithOrigin t
Origin
  let
    handlers = StrictTVar m (Point TestBlock)
-> BlockTree TestBlock
-> ChainSyncServerHandlers m (NodeState TestBlock) TestBlock
forall (m :: * -> *).
IOLike m =>
StrictTVar m (Point TestBlock)
-> BlockTree TestBlock
-> ChainSyncServerHandlers m (NodeState TestBlock) TestBlock
makeChainSyncServerHandlers StrictTVar m (Point TestBlock)
csrCurrentIntersection BlockTree TestBlock
srBlockTree
    csrServer = PeerId
-> STM m ()
-> STM m (Maybe (NodeState TestBlock))
-> Tracer m (TraceEvent TestBlock)
-> ChainSyncServerHandlers m (NodeState TestBlock) TestBlock
-> ChainSyncServer
     (Header TestBlock) (Point TestBlock) (Tip TestBlock) m ()
forall (m :: * -> *) blk.
IOLike m =>
PeerId
-> STM m ()
-> STM m (Maybe (NodeState blk))
-> Tracer m (TraceEvent blk)
-> ChainSyncServerHandlers m (NodeState blk) blk
-> ChainSyncServer (Header blk) (Point blk) (Tip blk) m ()
runScheduledChainSyncServer PeerId
srPeerId STM m ()
csrTickStarted (StrictTVar m (Maybe (NodeState TestBlock))
-> STM m (Maybe (NodeState TestBlock))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState) Tracer m (TraceEvent TestBlock)
srTracer ChainSyncServerHandlers m (NodeState TestBlock) TestBlock
handlers
  pure ChainSyncResources{csrTickStarted, csrServer, csrCurrentIntersection}

makeBlockFetchResources ::
  IOLike m =>
  STM m () ->
  SharedResources m TestBlock ->
  BlockFetchResources m TestBlock
makeBlockFetchResources :: forall (m :: * -> *).
IOLike m =>
STM m ()
-> SharedResources m TestBlock -> BlockFetchResources m TestBlock
makeBlockFetchResources STM m ()
bfrTickStarted SharedResources{PeerId
srPeerId :: forall (m :: * -> *) blk. SharedResources m blk -> PeerId
srPeerId :: PeerId
srPeerId, Tracer m (TraceEvent TestBlock)
srTracer :: forall (m :: * -> *) blk.
SharedResources m blk -> Tracer m (TraceEvent blk)
srTracer :: Tracer m (TraceEvent TestBlock)
srTracer, BlockTree TestBlock
srBlockTree :: forall (m :: * -> *) blk. SharedResources m blk -> BlockTree blk
srBlockTree :: BlockTree TestBlock
srBlockTree, StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState :: forall (m :: * -> *) blk.
SharedResources m blk -> StrictTVar m (Maybe (NodeState blk))
srCurrentState :: StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState} =
  BlockFetchResources
    { STM m ()
bfrTickStarted :: STM m ()
bfrTickStarted :: STM m ()
bfrTickStarted
    , BlockFetchServer TestBlock (Point TestBlock) m ()
bfrServer :: BlockFetchServer TestBlock (Point TestBlock) m ()
bfrServer :: BlockFetchServer TestBlock (Point TestBlock) m ()
bfrServer
    }
 where
  handlers :: BlockFetchServerHandlers m (NodeState TestBlock) TestBlock
handlers =
    BlockFetchServerHandlers
      { bfshBlockFetch :: ChainRange (Point TestBlock)
-> NodeState TestBlock
-> STM
     m
     (Maybe (BlockFetch TestBlock),
      [TraceScheduledBlockFetchServerEvent
         (NodeState TestBlock) TestBlock])
bfshBlockFetch = BlockTree TestBlock
-> ChainRange (Point TestBlock)
-> NodeState TestBlock
-> STM
     m
     (Maybe (BlockFetch TestBlock),
      [TraceScheduledBlockFetchServerEvent
         (NodeState TestBlock) TestBlock])
forall (m :: * -> *) blk.
(IOLike m, HasHeader blk) =>
BlockTree blk
-> ChainRange (Point blk)
-> NodeState blk
-> STM
     m
     (Maybe (BlockFetch blk),
      [TraceScheduledBlockFetchServerEvent (NodeState blk) blk])
handlerBlockFetch BlockTree TestBlock
srBlockTree
      , bfshSendBlocks :: [TestBlock]
-> NodeState TestBlock
-> STM
     m
     (Maybe (SendBlocks TestBlock),
      [TraceScheduledBlockFetchServerEvent
         (NodeState TestBlock) TestBlock])
bfshSendBlocks = [TestBlock]
-> NodeState TestBlock
-> STM
     m
     (Maybe (SendBlocks TestBlock),
      [TraceScheduledBlockFetchServerEvent
         (NodeState TestBlock) TestBlock])
forall (m :: * -> *).
IOLike m =>
[TestBlock]
-> NodeState TestBlock
-> STM
     m
     (Maybe (SendBlocks TestBlock),
      [TraceScheduledBlockFetchServerEvent
         (NodeState TestBlock) TestBlock])
handlerSendBlocks
      }
  bfrServer :: BlockFetchServer TestBlock (Point TestBlock) m ()
bfrServer =
    PeerId
-> STM m ()
-> STM m (Maybe (NodeState TestBlock))
-> Tracer m (TraceEvent TestBlock)
-> BlockFetchServerHandlers m (NodeState TestBlock) TestBlock
-> BlockFetchServer TestBlock (Point TestBlock) m ()
forall (m :: * -> *) blk.
IOLike m =>
PeerId
-> STM m ()
-> STM m (Maybe (NodeState blk))
-> Tracer m (TraceEvent blk)
-> BlockFetchServerHandlers m (NodeState blk) blk
-> BlockFetchServer blk (Point blk) m ()
runScheduledBlockFetchServer
      PeerId
srPeerId
      STM m ()
bfrTickStarted
      (StrictTVar m (Maybe (NodeState TestBlock))
-> STM m (Maybe (NodeState TestBlock))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState)
      Tracer m (TraceEvent TestBlock)
srTracer
      BlockFetchServerHandlers m (NodeState TestBlock) TestBlock
handlers

-- | Create the concurrency transactions for communicating the begin of a peer's
-- tick and its new state to the ChainSync and BlockFetch servers.
--
-- We use a 'TChan' with two consumers and return only an action that takes a
-- 'NodeState', which should be called by the scheduler in each of this peer's
-- ticks.
--
-- The action writes the new state (converted to 'Maybe') to the shared TVar,
-- and publishes an item to the channel _only if_ the state is 'NodeOnline'.
--
-- If the peer's servers block on the channel whenever they have exhausted the
-- possible actions for a tick, the scheduler will be resumed.
-- When the scheduler then calls the update action in this peer's next tick,
-- both consumers will be unblocked and able to fetch the new state from the
-- TVar.
updateState ::
  IOLike m =>
  StrictTVar m (Maybe (NodeState TestBlock)) ->
  m (NodeState TestBlock -> STM m (), STM m (), STM m ())
updateState :: forall (m :: * -> *).
IOLike m =>
StrictTVar m (Maybe (NodeState TestBlock))
-> m (NodeState TestBlock -> STM m (), STM m (), STM m ())
updateState StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState =
  STM m (NodeState TestBlock -> STM m (), STM m (), STM m ())
-> m (NodeState TestBlock -> STM m (), STM m (), STM m ())
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (NodeState TestBlock -> STM m (), STM m (), STM m ())
 -> m (NodeState TestBlock -> STM m (), STM m (), STM m ()))
-> STM m (NodeState TestBlock -> STM m (), STM m (), STM m ())
-> m (NodeState TestBlock -> STM m (), STM m (), STM m ())
forall a b. (a -> b) -> a -> b
$ do
    publisher <- STM m (StrictTChan m ())
forall (m :: * -> *) a. MonadSTM m => STM m (StrictTChan m a)
newBroadcastTChan
    consumer1 <- dupTChan publisher
    consumer2 <- dupTChan publisher
    let
      newState NodeState TestBlock
points = do
        StrictTVar m (Maybe (NodeState TestBlock))
-> Maybe (NodeState TestBlock) -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState (Maybe (NodeState TestBlock) -> STM m ())
-> STM m (Maybe (NodeState TestBlock)) -> STM m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
          -- REVIEW: Is it ok to only unblock the peer when it is online?
          -- So far we've handled Nothing in the ChainSync server by skipping the tick.
          StrictTChan m () -> () -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTChan m a -> a -> STM m ()
writeTChan StrictTChan m ()
publisher ()
          Maybe (NodeState TestBlock) -> STM m (Maybe (NodeState TestBlock))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeState TestBlock -> Maybe (NodeState TestBlock)
forall a. a -> Maybe a
Just NodeState TestBlock
points)
    pure (newState, readTChan consumer1, readTChan consumer2)

-- | Create all concurrency resources and the ChainSync protocol server used
-- for a single peer.
--
-- A peer performs BlockFetch and ChainSync using a state of
-- type 'NodeState' that is updated by a separate scheduler, waking up
-- the protocol handlers to process messages until the conditions of the new
-- state are satisfied.
--
-- TODO pass BFR and CSR to runScheduled... rather than passing the individual resources in and storing the result
makePeerResources ::
  IOLike m =>
  Tracer m (TraceEvent TestBlock) ->
  BlockTree TestBlock ->
  PeerId ->
  m (PeerResources m TestBlock)
makePeerResources :: forall (m :: * -> *).
IOLike m =>
Tracer m (TraceEvent TestBlock)
-> BlockTree TestBlock -> PeerId -> m (PeerResources m TestBlock)
makePeerResources Tracer m (TraceEvent TestBlock)
srTracer BlockTree TestBlock
srBlockTree PeerId
srPeerId = do
  srCurrentState <- Maybe (NodeState TestBlock)
-> m (StrictTVar m (Maybe (NodeState TestBlock)))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM Maybe (NodeState TestBlock)
forall a. Maybe a
Nothing
  (prUpdateState, csrTickStarted, bfrTickStarted) <- updateState srCurrentState
  let prShared = SharedResources{Tracer m (TraceEvent TestBlock)
srTracer :: Tracer m (TraceEvent TestBlock)
srTracer :: Tracer m (TraceEvent TestBlock)
srTracer, BlockTree TestBlock
srBlockTree :: BlockTree TestBlock
srBlockTree :: BlockTree TestBlock
srBlockTree, PeerId
srPeerId :: PeerId
srPeerId :: PeerId
srPeerId, StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState :: StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState :: StrictTVar m (Maybe (NodeState TestBlock))
srCurrentState}
      prBlockFetch = STM m ()
-> SharedResources m TestBlock -> BlockFetchResources m TestBlock
forall (m :: * -> *).
IOLike m =>
STM m ()
-> SharedResources m TestBlock -> BlockFetchResources m TestBlock
makeBlockFetchResources STM m ()
bfrTickStarted SharedResources m TestBlock
prShared
  prChainSync <- makeChainSyncResources csrTickStarted prShared
  pure PeerResources{prShared, prChainSync, prBlockFetch, prUpdateState}

-- | Create resources for all given peers operating on the given block tree.
makePeerSimulatorResources ::
  IOLike m =>
  Tracer m (TraceEvent TestBlock) ->
  BlockTree TestBlock ->
  NonEmpty PeerId ->
  m (PeerSimulatorResources m TestBlock)
makePeerSimulatorResources :: forall (m :: * -> *).
IOLike m =>
Tracer m (TraceEvent TestBlock)
-> BlockTree TestBlock
-> NonEmpty PeerId
-> m (PeerSimulatorResources m TestBlock)
makePeerSimulatorResources Tracer m (TraceEvent TestBlock)
tracer BlockTree TestBlock
blockTree NonEmpty PeerId
peers = do
  resources <- NonEmpty PeerId
-> (PeerId -> m (PeerId, PeerResources m TestBlock))
-> m (NonEmpty (PeerId, PeerResources m TestBlock))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NonEmpty PeerId
peers ((PeerId -> m (PeerId, PeerResources m TestBlock))
 -> m (NonEmpty (PeerId, PeerResources m TestBlock)))
-> (PeerId -> m (PeerId, PeerResources m TestBlock))
-> m (NonEmpty (PeerId, PeerResources m TestBlock))
forall a b. (a -> b) -> a -> b
$ \PeerId
peerId -> do
    peerResources <- Tracer m (TraceEvent TestBlock)
-> BlockTree TestBlock -> PeerId -> m (PeerResources m TestBlock)
forall (m :: * -> *).
IOLike m =>
Tracer m (TraceEvent TestBlock)
-> BlockTree TestBlock -> PeerId -> m (PeerResources m TestBlock)
makePeerResources Tracer m (TraceEvent TestBlock)
tracer BlockTree TestBlock
blockTree PeerId
peerId
    pure (peerId, peerResources)
  psrHandles <- atomically newChainSyncClientHandleCollection
  pure PeerSimulatorResources{psrPeers = Map.fromList $ toList resources, psrHandles}