test-consensus: vary k in RealPBFT tests, 5 or 10

ouroboros-consensus/test-consensus/Test/Dynamic/RealPBFT.hs

@@ -66,7 +66,7 @@ tests = testGroup "Dynamic chain generation" $
       testProperty "addressed by InvalidRollForward exception (PR #773)" $
           let ncn = NumCoreNodes 3
           in
-          prop_simple_real_pbft_convergence TestConfig
+          prop_simple_real_pbft_convergence (SecurityParam 10) TestConfig
             { numCoreNodes = ncn
             , numSlots = NumSlots 24
             , nodeJoinPlan = NodeJoinPlan $ Map.fromList
@@ -85,6 +85,7 @@ tests = testGroup "Dynamic chain generation" $
       -- slot 0 (even though it's already there). That rewind fails if EBBs
       -- don't affect the PBFT chain state, since its chain state is empty.
       prop_simple_real_pbft_convergence
+        (SecurityParam 10)
         TestConfig { numCoreNodes = ncn
                    , numSlots     = NumSlots 2
                    , nodeJoinPlan = NodeJoinPlan (Map.fromList [(CoreNodeId 0,SlotNo 0),(CoreNodeId 1,SlotNo 1)])
@@ -97,16 +98,18 @@ tests = testGroup "Dynamic chain generation" $
       -- Same as above, except node 0 gets to forge an actual block before node
       -- 1 tells it to rewind to the EBB.
       prop_simple_real_pbft_convergence
+        (SecurityParam 10)
         TestConfig { numCoreNodes = ncn
                    , numSlots     = NumSlots 4
                    , nodeJoinPlan = NodeJoinPlan (Map.fromList [(CoreNodeId 0,SlotNo {unSlotNo = 0}),(CoreNodeId 1,SlotNo {unSlotNo = 3})])
                    , nodeTopology = meshNodeTopology ncn
                    }
         Seed {getSeed = (16817746570690588019,3284322327197424879,14951803542883145318,5227823917971823767,14093715642382269482)}
     , testProperty "simple Real PBFT convergence" $
-        forAllShrink genRealPBFTTestConfig shrinkRealPBFTTestConfig $ \testConfig ->
+        forAll (SecurityParam <$> elements [5, 10]) $ \k ->
+        forAllShrink (genRealPBFTTestConfig k) shrinkRealPBFTTestConfig $ \testConfig ->
         forAll arbitrary $ \seed ->
-        prop_simple_real_pbft_convergence testConfig seed
+        prop_simple_real_pbft_convergence k testConfig seed
     ]
 
 prop_deterministicPlan :: NumSlots -> NumCoreNodes -> Property
@@ -119,54 +122,57 @@ prop_setup_coreNodeId ::
   -> CoreNodeId
   -> Property
 prop_setup_coreNodeId numCoreNodes coreNodeId =
-    case mkProtocolRealPBFT numCoreNodes coreNodeId genesisConfig genesisSecrets of
+    case mkProtocolRealPBFT params coreNodeId genesisConfig genesisSecrets of
       ProtocolRealPBFT _cfg _th _pv _swv (Just plc) ->
           coreNodeId === plcCoreNodeId plc
       _ ->
           counterexample "mkProtocolRealPBFT did not use ProtocolRealPBFT" $
           property False
   where
+    params :: PBftParams
+    params = realPBftParams dummyK numCoreNodes
+    dummyK = SecurityParam 10   -- not really used
+
     genesisConfig  :: Genesis.Config
     genesisSecrets :: Genesis.GeneratedSecrets
-    (genesisConfig, genesisSecrets) = generateGenesisConfig numCoreNodes
+    (genesisConfig, genesisSecrets) = generateGenesisConfig params
 
-prop_simple_real_pbft_convergence :: TestConfig
+prop_simple_real_pbft_convergence :: SecurityParam
+                                  -> TestConfig
                                   -> Seed
                                   -> Property
 prop_simple_real_pbft_convergence
-  testConfig@TestConfig{numCoreNodes, numSlots} seed =
+  k testConfig@TestConfig{numCoreNodes, numSlots} seed =
     prop_general k
         testConfig
         (Just $ roundRobinLeaderSchedule numCoreNodes numSlots)
         testOutput
     .&&. not (all Chain.null finalChains)
   where
-    k =
-      (SecurityParam . Common.unBlockCount) $
-      (Genesis.gdK . Genesis.configGenesisData) $
-      genesisConfig
-
     testOutput =
         runTestNetwork
             (\nid -> protocolInfo
-                       (mkProtocolRealPBFT numCoreNodes nid
+                       (mkProtocolRealPBFT params nid
                                            genesisConfig genesisSecrets))
             testConfig (Just forgeEBB) seed
 
     finalChains :: [Chain ByronBlock]
     finalChains = Map.elems $ nodeOutputFinalChain <$> testOutputNodes testOutput
 
+    params :: PBftParams
+    params = realPBftParams k numCoreNodes
+
     genesisConfig  :: Genesis.Config
     genesisSecrets :: Genesis.GeneratedSecrets
-    (genesisConfig, genesisSecrets) = generateGenesisConfig numCoreNodes
+    (genesisConfig, genesisSecrets) = generateGenesisConfig params
 
 
-mkProtocolRealPBFT :: NumCoreNodes
+mkProtocolRealPBFT :: PBftParams
                    -> CoreNodeId
                    -> Genesis.Config
                    -> Genesis.GeneratedSecrets
                    -> Protocol ByronBlock
-mkProtocolRealPBFT numCoreNodes (CoreNodeId i)
+mkProtocolRealPBFT params (CoreNodeId i)
                    genesisConfig genesisSecrets =
     ProtocolRealPBFT
       genesisConfig
@@ -182,7 +188,7 @@ mkProtocolRealPBFT numCoreNodes (CoreNodeId i)
           dlgKey
           dlgCert
 
-    PBftParams{pbftSignatureThreshold} = realPBftParams numCoreNodes
+    PBftParams{pbftSignatureThreshold} = params
 
     dlgKey :: Crypto.SigningKey
     dlgKey = fromJust $
@@ -201,39 +207,40 @@ mkProtocolRealPBFT numCoreNodes (CoreNodeId i)
   Generating the genesis configuration
 -------------------------------------------------------------------------------}
 
-realPBftParams :: NumCoreNodes -> PBftParams
-realPBftParams numCoreNodes = PBftParams
+realPBftParams :: SecurityParam -> NumCoreNodes -> PBftParams
+realPBftParams paramK numCoreNodes = PBftParams
   { pbftNumNodes           = n
-  , pbftSecurityParam      = SecurityParam k
-  , pbftSignatureThreshold = (1 / n) + (1 / k)
+  , pbftSecurityParam      = paramK
+  , pbftSignatureThreshold = (1 / n) + (1 / k) + epsilon
     -- crucially: @floor (k * t) >= ceil (k / n)@
   , pbftSlotLength         = slotLengthFromSec 20
   }
     where
+      epsilon = 1/10000   -- avoid problematic floating point round-off
+
       n :: Num a => a
       n = fromIntegral x where NumCoreNodes x = numCoreNodes
 
       k :: Num a => a
-      k = 10
+      k = fromIntegral x where SecurityParam x = paramK
 
 -- Instead of using 'Dummy.dummyConfig', which hard codes the number of rich
 -- men (= CoreNodes for us) to 4, we generate a dummy config with the given
 -- number of rich men.
-generateGenesisConfig :: NumCoreNodes -> (Genesis.Config, Genesis.GeneratedSecrets)
-generateGenesisConfig numCoreNodes =
+generateGenesisConfig :: PBftParams -> (Genesis.Config, Genesis.GeneratedSecrets)
+generateGenesisConfig params =
     either (error . show) id $ Genesis.generateGenesisConfig startTime spec
   where
     startTime = UTCTime (ModifiedJulianDay 0) 0
-    NumCoreNodes n = numCoreNodes
-    PBftParams{pbftSecurityParam} = realPBftParams numCoreNodes
+    PBftParams{pbftNumNodes, pbftSecurityParam} = params
 
     spec :: Genesis.GenesisSpec
     spec = Dummy.dummyGenesisSpec
       { Genesis.gsInitializer = Dummy.dummyGenesisInitializer
         { Genesis.giTestBalance =
             (Genesis.giTestBalance Dummy.dummyGenesisInitializer)
               -- The nodes are the richmen
-              { Genesis.tboRichmen = fromIntegral n }
+              { Genesis.tboRichmen = fromIntegral pbftNumNodes }
         }
       , Genesis.gsK = Common.BlockCount $ maxRollbacks pbftSecurityParam
       }
@@ -339,12 +346,12 @@ genRealPBFTNodeJoinPlan params numSlots@(NumSlots t)
             Nothing             -> 0
             Just (CoreNodeId h) -> succ h
 
-genRealPBFTTestConfig :: Gen TestConfig
-genRealPBFTTestConfig = do
+genRealPBFTTestConfig :: SecurityParam -> Gen TestConfig
+genRealPBFTTestConfig k = do
     numCoreNodes <- arbitrary
     numSlots     <- arbitrary
 
-    let params = realPBftParams numCoreNodes
+    let params = realPBftParams k numCoreNodes
     nodeJoinPlan <- genRealPBFTNodeJoinPlan params numSlots
     nodeTopology <- genNodeTopology numCoreNodes