Tweak CaughtUp test to account for PerasCertDiffusion idling

Author: agustinmista

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/LoE/CaughtUp.hs

@@ -54,10 +54,19 @@ import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
   ( ChainSyncJumpingState (..)
   , DisengagedInitState (..)
   )
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
+  ( ObjectDiffusionInboundHandle (..)
+  , ObjectDiffusionInboundHandleCollection
+  , initObjectDiffusionInboundState
+  , newObjectDiffusionInboundHandleCollection
+  , odihcAddHandle
+  )
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasCert (PerasCertDiffusionInboundHandle)
 import qualified Ouroboros.Consensus.Node.GSM as GSM
 import Ouroboros.Consensus.Node.Genesis (setGetLoEFragment)
 import Ouroboros.Consensus.Node.GsmState
 import Ouroboros.Consensus.NodeId
+import Ouroboros.Consensus.NodeKernel (chainSyncState, mkNodeKernelPeerStates, nodeKernelPeerIsIdle)
 import Ouroboros.Consensus.Peras.Weight (emptyPerasWeightSnapshot)
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import Ouroboros.Consensus.Storage.ChainDB.API (ChainDB)
@@ -108,12 +117,14 @@ run = withRegistry \registry -> do
   let addBlk = ChainDB.addBlock_ chainDB Punishment.noPunishment
 
   chainSyncHandles <- atomically newChainSyncClientHandleCollection
+  perasCertDiffusionHandles <- atomically newObjectDiffusionInboundHandleCollection
 
   _ <-
     forkLinkedThread registry "GSM" $
       GSM.enterPreSyncing $
         mkGsmEntryPoints
           chainSyncHandles
+          perasCertDiffusionHandles
           chainDB
           (atomically . writeTVar varGsmState)
 
@@ -132,6 +143,11 @@ run = withRegistry \registry -> do
   -- this would happen via ChainSync and BlockFetch.
 
   _ <- forkLinkedThread registry "Peer1" $ do
+    -- Initialize a PerasCertDiffusion client handle for Peer1 so that the GSM knows it's idling
+    atomically $
+      mkTestPerasCertDiffusionInboundHandle
+        >>= odihcAddHandle perasCertDiffusionHandles peer1
+
     -- First, let Peer1 connect, serving block A (without idling).
     let initialFrag =
           attachSlotTimeToFragment cfg $
@@ -158,6 +174,11 @@ run = withRegistry \registry -> do
         }
 
   _ <- forkLinkedThread registry "Peer2" $ do
+    -- Initialize a PerasCertDiffusion client handle for Peer2 so that the GSM knows it's idling
+    atomically $
+      mkTestPerasCertDiffusionInboundHandle
+        >>= odihcAddHandle perasCertDiffusionHandles peer2
+
     -- Let Peer2 connect and send B.
     hdl <-
       atomically $
@@ -236,6 +257,17 @@ mkTestChainSyncClientHandle frag = do
       , cschJumpInfo = varJumpInfo
       }
 
+mkTestPerasCertDiffusionInboundHandle ::
+  forall m.
+  IOLike m =>
+  STM m (PerasCertDiffusionInboundHandle m TestBlock)
+mkTestPerasCertDiffusionInboundHandle = do
+  varState <- newTVar initObjectDiffusionInboundState
+  pure
+    ObjectDiffusionInboundHandle
+      { odihState = varState
+      }
+
 openChainDB ::
   forall m.
   IOLike m =>
@@ -273,17 +305,18 @@ mkGsmEntryPoints ::
   forall m.
   (IOLike m, SI.MonadTimer m) =>
   ChainSyncClientHandleCollection CoreNodeId m TestBlock ->
+  ObjectDiffusionInboundHandleCollection CoreNodeId m TestBlock ->
   ChainDB m TestBlock ->
   (GsmState -> m ()) ->
   GSM.GsmEntryPoints m
-mkGsmEntryPoints varChainSyncHandles chainDB writeGsmState =
+mkGsmEntryPoints chainSyncHandles perasCertDiffusionHandles chainDB writeGsmState =
   GSM.realGsmEntryPoints
     (id, nullTracer)
     GSM.GsmView
       { GSM.getCandidateOverSelection = pure candidateOverSelection
-      , GSM.peerIsIdle = csIdling
+      , GSM.peerIsIdle = nodeKernelPeerIsIdle
       , GSM.equivalent = (==) `on` AF.headPoint
-      , GSM.getPeerStates = traverse readTVar =<< fmap cschState <$> cschcMap varChainSyncHandles
+      , GSM.getPeerStates = mkNodeKernelPeerStates chainSyncHandles perasCertDiffusionHandles
       , GSM.getCurrentSelection = ChainDB.getCurrentChain chainDB
       , -- Make sure that we stay in CaughtUp for the duration of the test once we
         -- have entered it.
@@ -304,7 +337,7 @@ mkGsmEntryPoints varChainSyncHandles chainDB writeGsmState =
         GSM.WhetherCandidateIsBetter $
           preferAnchoredCandidate (configBlock cfg) weights selection candFrag
    where
-    candFrag = csCandidate candidateState
+    candFrag = csCandidate (chainSyncState candidateState)
 
     -- TODO https://github.com/tweag/cardano-peras/issues/67
     weights = emptyPerasWeightSnapshot