Adjust stalling test to have more kills by LoP

Co-authored-by: Nicolas Bacquey <[email protected]>

Author: 2 people

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/GenChains.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Test.Consensus.Genesis.Setup.GenChains (
@@ -132,10 +131,11 @@ genChainsWithExtraHonestPeers genNumExtraHonest genNumForks = do
     gtSlotLength,
     gtChainSyncTimeouts = chainSyncTimeouts gtSlotLength asc,
     gtBlockFetchTimeouts = blockFetchTimeouts,
-    gtLoPBucketParams = LoPBucketParams { lbpCapacity = 100_000, lbpRate = 1_000 },
-    -- ^ REVIEW: Do we want to generate those randomly? For now, the chosen
-    -- values carry no special meaning. Someone needs to think about what values
-    -- would make for interesting tests.
+    gtLoPBucketParams = LoPBucketParams { lbpCapacity = 50, lbpRate = 10 },
+    -- These values give little enough leeway (5s) so that some adversaries get disconnected
+    -- by the LoP during the stalling attack test. Maybe we should design a way to override
+    -- those values for individual tests?
+    -- Also, we might want to generate these randomly.
     gtCSJParams = CSJParams $ fromIntegral scg,
     gtBlockTree = List.foldl' (flip BT.addBranch') (BT.mkTrunk goodChain) $ zipWith (genAdversarialFragment goodBlocks) [1..] alternativeChainSchemas,
     gtExtraHonestPeers,

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

@@ -213,6 +213,7 @@ prop_leashingAttackStalling =
       , scEnableLoE = True
       , scEnableLoP = True
       , scEnableCSJ = True
+      , scEnableBlockFetchTimeouts = False
       }
 
     shrinkPeerSchedules
@@ -234,7 +235,8 @@ prop_leashingAttackStalling =
     dropRandomPoints :: [(Time, SchedulePoint blk)] -> QC.Gen [(Time, SchedulePoint blk)]
     dropRandomPoints ps = do
       let lenps = length ps
-      dropCount <- QC.choose (0, max 1 $ div lenps 5)
+          dropsMax = max 1 $ lenps - 1
+      dropCount <- QC.choose (div dropsMax 2, dropsMax)
       let dedup = map NE.head . NE.group
       is <- fmap (dedup . sort) $ replicateM dropCount $ QC.choose (0, lenps - 1)
       pure $ dropElemsAt ps is