Support leios-late-ib-inclusion

Author: nfrisby

data/simulation/config.d.ts

@@ -39,10 +39,10 @@ export interface Config {
    * Only supported by Haskell simulation. */
   "leios-vote-send-recv-stages": boolean;
   /**
-   * Extends Leios so that EB producers include IBs directly from previous pipelines
-   * where no certified EB was observed.
-   * 
-   * Only supported by Rust simulation. */
+   * Extends Leios so that EB producers include IBs directly from previous pipelines.
+   * Due to casuality, the EB must always include them, even if those IBs end up being
+   * certified in their own pipeline.
+   */
   "leios-late-ib-inclusion": boolean;
   /**
    * The expected time it takes a header to fully diffuse across the network.

leios-trace-hs/src/LeiosConfig.hs

@@ -99,6 +99,7 @@ data Config = Config
   , leiosStageActiveVotingSlots :: Word
   , leiosVoteSendRecvStages :: Bool
   , leiosVariant :: LeiosVariant
+  , leiosLateIbInclusion :: Bool
   , leiosHeaderDiffusionTimeMs :: DurationMs
   , praosChainQuality :: Double
   , txGenerationDistribution :: Distribution
@@ -171,6 +172,7 @@ instance Default Config where
       , leiosStageActiveVotingSlots = 1
       , leiosVoteSendRecvStages = False
       , leiosVariant = Short
+      , leiosLateIbInclusion = True
       , leiosHeaderDiffusionTimeMs = 1000
       , praosChainQuality = 40
       , txGenerationDistribution = Exp{lambda = 0.85, scale = Just 1000}
@@ -243,6 +245,7 @@ configToKVsWith getter cfg =
     , get @"treatBlocksAsFull" getter cfg
     , get @"cleanupPolicies" getter cfg
     , get @"leiosVariant" getter cfg
+    , get @"leiosLateIbInclusion" getter cfg
     , get @"leiosHeaderDiffusionTimeMs" getter cfg
     , get @"praosChainQuality" getter cfg
     , get @"simulateTransactions" getter cfg
@@ -329,6 +332,7 @@ instance FromJSON Config where
     treatBlocksAsFull <- parseFieldOrDefault @Config @"treatBlocksAsFull" obj
     cleanupPolicies <- parseFieldOrDefault @Config @"cleanupPolicies" obj
     leiosVariant <- parseFieldOrDefault @Config @"leiosVariant" obj
+    leiosLateIbInclusion <- parseFieldOrDefault @Config @"leiosLateIbInclusion" obj
     leiosHeaderDiffusionTimeMs <- parseFieldOrDefault @Config @"leiosHeaderDiffusionTimeMs" obj
     praosChainQuality <- parseFieldOrDefault @Config @"praosChainQuality" obj
     simulateTransactions <- parseFieldOrDefault @Config @"simulateTransactions" obj

simulation/ouroboros-leios-sim.cabal

@@ -218,6 +218,7 @@ test-suite ols-test
     , bytestring
   other-modules:
     Paths_ouroboros_leios_sim
-    Test.Topology
     Test.Config
+    Test.ShortToFull
+    Test.Topology
   default-language: Haskell2010

simulation/src/LeiosProtocol/Short.hs

@@ -111,6 +111,10 @@ data LeiosConfig = forall p. IsPipeline p => LeiosConfig
   , variant :: LeiosVariant
   , headerDiffusionTime :: NominalDiffTime
   -- ^ Δ_{hdr}.
+  , lateIbInclusion :: Bool
+  -- ^ Whether an EB also includes IBs from the two previous iterations.
+  --
+  -- TODO Merely one previous iteration if 'pipeline' is 'SingleVote'?
   , pipelinesToReferenceFromEB :: Int
   -- ^ how many older pipelines to reference from an EB when `variant = Full`.
   , votingFrequencyPerStage :: Double
@@ -147,6 +151,7 @@ convertConfig disk =
           , cleanupPolicies = disk.cleanupPolicies
           , variant = disk.leiosVariant
           , headerDiffusionTime = realToFrac $ durationMsToDiffTime disk.leiosHeaderDiffusionTimeMs
+          , lateIbInclusion = disk.leiosLateIbInclusion
           , pipelinesToReferenceFromEB =
               if disk.leiosVariant == Full
                 then
@@ -285,6 +290,7 @@ delaysAndSizesAsFull cfg@LeiosConfig{pipeline, voteSendStage} =
     , cleanupPolicies = cfg.cleanupPolicies
     , variant = cfg.variant
     , headerDiffusionTime = cfg.headerDiffusionTime
+    , lateIbInclusion = cfg.lateIbInclusion
     , pipelinesToReferenceFromEB = cfg.pipelinesToReferenceFromEB
     , activeVotingStageLength = cfg.activeVotingStageLength
     , votingFrequencyPerStage = cfg.votingFrequencyPerStage
@@ -664,13 +670,13 @@ data InputBlocksQuery = InputBlocksQuery
   -- ^ This is checked against time the body is downloaded, before validation.
   }
 
-inputBlocksToEndorse ::
+inputBlocksToEndorse1 ::
   LeiosConfig ->
   -- | current slot
   SlotNo ->
   InputBlocksSnapshot ->
   [InputBlockId]
-inputBlocksToEndorse cfg@LeiosConfig{pipeline = _ :: SingPipeline p} current buffer = fromMaybe [] $ do
+inputBlocksToEndorse1 cfg@LeiosConfig{pipeline = _ :: SingPipeline p} current buffer = fromMaybe [] $ do
   generatedBetween <- stageRange @p cfg Endorse current Propose
   receivedBy <- stageEnd @p cfg Endorse current Deliver2
   pure $
@@ -680,6 +686,26 @@ inputBlocksToEndorse cfg@LeiosConfig{pipeline = _ :: SingPipeline p} current buf
         , receivedBy
         }
 
+-- | Invokes 'inputBlocksToEndorse1' as many times as 'lateIbInclusion'
+-- requires
+inputBlocksToEndorse ::
+  LeiosConfig ->
+  -- | current slot
+  SlotNo ->
+  InputBlocksSnapshot ->
+  [InputBlockId]
+inputBlocksToEndorse cfg current buffer =
+  concatMap each iterations
+ where
+  each sl = inputBlocksToEndorse1 cfg sl buffer
+  capL = fromIntegral cfg.sliceLength
+  iterations =
+    if not cfg.lateIbInclusion
+      then [current]
+      else
+        -- discard underflows
+        dropWhile (> current) [current - 2 * capL, current - capL, current]
+
 -- | Returns possible EBs to reference from current pipeline EB.
 endorseBlocksToReference ::
   LeiosConfig ->

simulation/src/LeiosProtocol/Short/Sim.hs

@@ -426,6 +426,7 @@ traceRelayLink1 connectionOptions =
               , cleanupPolicies = def
               , variant = Short
               , headerDiffusionTime = 1
+              , lateIbInclusion = False
               , pipelinesToReferenceFromEB = 0
               , activeVotingStageLength = 1
               , pipeline = SingSingleVote

simulation/test/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import qualified Test.Config
+import qualified Test.ShortToFull
 import Test.Tasty (defaultMain, testGroup)
 import qualified Test.Topology
 
@@ -9,4 +10,5 @@ main =
   defaultMain . testGroup "ouroboros-leios-sim" $
     [ Test.Topology.tests
     , Test.Config.tests
+    , Test.ShortToFull.tests
     ]

simulation/test/Test/ShortToFull.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Test.ShortToFull where
+
+import Data.Default (def)
+import LeiosProtocol.Common (InputBlockId (..), NodeId (..), SlotNo)
+import LeiosProtocol.Config (Config)
+import qualified LeiosProtocol.Short as Short
+import Test.QuickCheck as Q
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.QuickCheck (testProperty)
+
+tests :: TestTree
+tests =
+  testGroup
+    "ShortToFull"
+    [ testProperty "test_leiosLateIbInclusion" test_leiosLateIbInclusion
+    ]
+
+data Test_leiosLateIbInclusion = Test_leiosLateIbInclusion
+  { ibTable :: [(Int, SlotNo, SlotNo)] -- the Int is @zip [0..]@, /before shrinking/
+  , current :: SlotNo
+  }
+  deriving (Show)
+
+instance Q.Arbitrary Test_leiosLateIbInclusion where
+  arbitrary = do
+    let cfg = Short.convertConfig def
+    let arbSlot = Q.choose (0, 10 * cfg.sliceLength)
+    let toSlot :: Int -> SlotNo
+        toSlot = toEnum
+    current <- toSlot <$> arbSlot
+    ibTable <- do
+      n <- Q.choose (0, 1000)
+      flip mapM [0 .. n - 1] $ \i -> do
+        gen <- Q.choose (0, fromEnum current)
+        delay <- Q.choose (0, 3 * cfg.sliceLength)
+        pure (i, toSlot gen, toSlot (gen + delay))
+    pure Test_leiosLateIbInclusion{..}
+
+  shrink testSetup =
+    [ testSetup{ibTable = ibTable'}
+    | ibTable' <- shrinkList (const []) testSetup.ibTable
+    ]
+
+test_leiosLateIbInclusion :: Test_leiosLateIbInclusion -> Property
+test_leiosLateIbInclusion testSetup =
+  Q.counterexample (show (cfg.sliceLength, iterations))
+    $ Q.counterexample ("on " <> show (map (.num) on))
+    $ Q.counterexample
+      (unlines $ ("off" :) $ map (show . map (.num) . off) $ iterations)
+    $ on Q.=== concatMap off iterations
+ where
+  Test_leiosLateIbInclusion{..} = testSetup
+  cfg = Short.convertConfig def
+  ibSnapshot =
+    Short.InputBlocksSnapshot
+      { validInputBlocks = \q ->
+          [ InputBlockId{node = NodeId 0, num = i}
+          | (i, gen, recv) <- ibTable
+          , gen `Short.inRange` q.generatedBetween
+          , recv <= q.receivedBy
+          ]
+      }
+  on =
+    Short.inputBlocksToEndorse
+      cfg{Short.lateIbInclusion = True}
+      current
+      ibSnapshot
+  off sl =
+    Short.inputBlocksToEndorse
+      cfg{Short.lateIbInclusion = False}
+      sl
+      ibSnapshot
+  iterations =
+    let capL = fromIntegral cfg.sliceLength
+     in -- detect underflow
+        dropWhile (> current) [current - 2 * capL, current - capL, current]