Refine CSJ happy path property

Headers with jump size of the tip can be downloaded several times
IntersectMBO · Apr 29, 2024 · 791b58d · 791b58d
1 parent 6f8762f
commit 791b58d
Showing 1 changed file with 15 additions and 3 deletions.
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/CSJ.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/CSJ.hs
@@ -7,10 +7,13 @@ import           Control.Monad (replicateM)
 import           Data.Functor (($>))
 import           Data.List (nub)
 import           Data.Maybe (mapMaybe)
+import           Ouroboros.Consensus.Block (blockSlot, succWithOrigin)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                      (TraceChainSyncClientEvent (..))
 import           Ouroboros.Consensus.Util.Condense (PaddingDirection (..),
                      condenseListWithPadding)
+import qualified Ouroboros.Network.AnchoredFragment as AF
+import           Test.Consensus.BlockTree (BlockTree (..))
 import           Test.Consensus.Genesis.Setup
 import           Test.Consensus.Genesis.Tests.Uniform (genUniformSchedulePoints)
 import           Test.Consensus.PeerSimulator.Run (SchedulerConfig (..),
@@ -23,7 +26,7 @@ import           Test.Consensus.PointSchedule.Peers (Peer (..), Peers (..),
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
 import           Test.Util.Orphans.IOLike ()
-import           Test.Util.TestBlock (TestBlock)
+import           Test.Util.TestBlock (Header, TestBlock)
 
 tests :: TestTree
 tests =
@@ -56,12 +59,14 @@ prop_happyPath synchronized =
       -- start serving headers.
       \_ _ -> []
     )
-    ( \_ StateView{svTrace} ->
+    ( \gt StateView{svTrace} ->
         let
           headerDownloadEvents =
             mapMaybe
               (\case
-                TraceChainSyncClientEvent pid (TraceDownloadedHeader hdr) -> Just (pid, hdr)
+                TraceChainSyncClientEvent pid (TraceDownloadedHeader hdr)
+                  | isOlderThanJumpSizeFromTip gt hdr
+                  -> Just (pid, hdr)
                 _                                                         -> Nothing
               )
               svTrace
@@ -86,3 +91,10 @@ prop_happyPath synchronized =
     genHonestSchedule gt = do
       ps <- genUniformSchedulePoints gt
       pure $ value $ honest ps
+
+    isOlderThanJumpSizeFromTip :: GenesisTestFull TestBlock -> Header TestBlock -> Bool
+    isOlderThanJumpSizeFromTip gt hdr =
+      let jumpSize = csjpJumpSize $ gtCSJParams gt
+          tipSlot = AF.headSlot $ btTrunk $ gtBlockTree gt
+          hdrSlot = blockSlot hdr
+       in hdrSlot + jumpSize < succWithOrigin tipSlot