feat(config,simulation): add eb-max-age-slots parameter

Author: Wen Kokke

conformance-testing/src/Leios/Conformance/Test/External.hs

@@ -47,7 +47,7 @@ import Test.QuickCheck.StateModel (
   runActions,
  )
 
-import Text.PrettyPrint (hang, vcat, (<+>))
+import Text.PrettyPrint ((<+>))
 import Text.PrettyPrint.HughesPJClass (Pretty (pPrint))
 
 import Prelude hiding (round)
@@ -103,7 +103,7 @@ callSUT RunState{hReader, hWriter} req =
 type Runtime = StateT RunState IO
 
 instance Realized IO ([InputBlock], [EndorserBlock], [[Vote]]) ~ ([InputBlock], [EndorserBlock], [[Vote]]) => RunModel NetworkModel Runtime where
-  perform NetworkModel{nodeModel = LeiosState{..}} (Step a) _ = case a of
+  perform NetworkModel{nodeModel = LeiosState{}} (Step a) _ = case a of
     Tick -> do
       rs@RunState{..} <- get
       modify $ \rs' -> rs'{unfetchedIBs = mempty, unfetchedEBs = mempty, unfetchedVotes = mempty}

data/simulation/config.d.ts

@@ -86,6 +86,11 @@ export interface Config {
   "eb-diffusion-max-headers-to-request": bigint;
   /** Only supported by Haskell simulation. */
   "eb-diffusion-max-bodies-to-request": bigint;
+  /**
+   * The maximum age of EBs included in RBs.
+   *
+   * Only supported by Haskell simulation. */
+  "eb-max-age-slots": bigint;
 
   // Vote Configuration
   "vote-generation-probability": number;

data/simulation/config.default.yaml

@@ -131,6 +131,9 @@ eb-diffusion-max-bodies-to-request: 1
 eb-diffusion-max-headers-to-request: 100
 eb-diffusion-max-window-size: 100
 
+# The maximum age of EBs included in RBs.
+eb-max-age-slots: 20 # TODO: sensible default
+
 ################################################################################
 # Vote Configuration
 ################################################################################

data/simulation/config.schema.json

@@ -135,6 +135,12 @@
     "eb-generation-probability": {
       "type": "number"
     },
+    "eb-max-age-slots": {
+      "additionalProperties": false,
+      "description": "The maximum age of EBs included in RBs.\n\nOnly supported by Haskell simulation.",
+      "properties": {},
+      "type": "number"
+    },
     "eb-size-bytes-constant": {
       "additionalProperties": false,
       "properties": {},

leios-trace-verifier/hs-src/app/Main.hs

@@ -1,8 +1,8 @@
 module Main where
 
+import Data.ByteString.Lazy as BSL
 import LeiosEvents
 import Lib
-import Data.ByteString.Lazy as BSL
 
 logFile :: FilePath
 logFile = "leios-trace.log"

simulation/src/LeiosProtocol/Config.hs

@@ -100,6 +100,7 @@ data Config = Config
   , ebDiffusionMaxWindowSize :: Word16
   , ebDiffusionMaxHeadersToRequest :: Word16
   , ebDiffusionMaxBodiesToRequest :: Word16
+  , ebMaxAgeSlots :: Word16
   , voteGenerationProbability :: Double
   , voteGenerationCpuTimeMsConstant :: DurationMs
   , voteGenerationCpuTimeMsPerIb :: DurationMs
@@ -164,6 +165,7 @@ instance Default Config where
       , ebDiffusionMaxWindowSize = 100
       , ebDiffusionMaxHeadersToRequest = 100
       , ebDiffusionMaxBodiesToRequest = 1
+      , ebMaxAgeSlots = 20
       , voteGenerationProbability = 500.0
       , voteGenerationCpuTimeMsConstant = 0.164
       , voteGenerationCpuTimeMsPerIb = 0.0
@@ -232,6 +234,7 @@ configToKVsWith getter cfg =
     , get @"ebDiffusionMaxWindowSize" getter cfg
     , get @"ebDiffusionMaxHeadersToRequest" getter cfg
     , get @"ebDiffusionMaxBodiesToRequest" getter cfg
+    , get @"ebMaxAgeSlots" getter cfg
     , get @"voteGenerationProbability" getter cfg
     , get @"voteGenerationCpuTimeMsConstant" getter cfg
     , get @"voteGenerationCpuTimeMsPerIb" getter cfg
@@ -310,6 +313,7 @@ instance FromJSON Config where
     ebDiffusionMaxWindowSize <- parseFieldOrDefault @Config @"ebDiffusionMaxWindowSize" obj
     ebDiffusionMaxHeadersToRequest <- parseFieldOrDefault @Config @"ebDiffusionMaxHeadersToRequest" obj
     ebDiffusionMaxBodiesToRequest <- parseFieldOrDefault @Config @"ebDiffusionMaxBodiesToRequest" obj
+    ebMaxAgeSlots <- parseFieldOrDefault @Config @"ebMaxAgeSlots" obj
     voteGenerationProbability <- parseFieldOrDefault @Config @"voteGenerationProbability" obj
     voteGenerationCpuTimeMsConstant <- parseFieldOrDefault @Config @"voteGenerationCpuTimeMsConstant" obj
     voteGenerationCpuTimeMsPerIb <- parseFieldOrDefault @Config @"voteGenerationCpuTimeMsPerIb" obj

simulation/src/LeiosProtocol/RelayBuffer.hs

@@ -11,6 +11,7 @@ module LeiosProtocol.RelayBuffer where
 import Data.FingerTree (FingerTree)
 import qualified Data.FingerTree as FingerTree
 import qualified Data.Foldable as Foldable
+import qualified Data.List as List
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
 import Data.Set (Set)
@@ -132,6 +133,13 @@ filter p RelayBuffer{..} =
  where
   filtered = Prelude.filter p $ Foldable.toList entries
 
+partition :: Ord key => (EntryWithTicket key value -> Bool) -> RelayBuffer key value -> (RelayBuffer key value, RelayBuffer key value)
+partition p RelayBuffer{..} = (rebuildRelayBufferFor entryListTrue, rebuildRelayBufferFor entryListFalse)
+ where
+  (entryListTrue, entryListFalse) = List.partition p (Foldable.toList entries)
+  restrictedIndexFor = Map.restrictKeys index . Set.fromList . map (.key)
+  rebuildRelayBufferFor entryList = RelayBuffer{entries = FingerTree.fromList entryList, index = restrictedIndexFor entryList, nextTicket}
+
 values :: Ord key => RelayBuffer key value -> [value]
 values = map value . toList
 

simulation/src/LeiosProtocol/Short.hs

@@ -99,6 +99,8 @@ data LeiosConfig = forall p. IsPipeline p => LeiosConfig
   -- ^ expected EndorseBlock generation rate per stage, at most one per _node_ in each (pipeline, stage).
   , activeVotingStageLength :: Int
   -- ^ prefix of the voting stage where new votes are generated, <= sliceLength.
+  , maxEndorseBlockAgeSlots :: Int
+  -- ^ maximum age of a certified endorsement block before it expires
   , votingFrequencyPerStage :: Double
   , voteSendStage :: Stage p
   , votesForCertificate :: Int
@@ -127,6 +129,7 @@ convertConfig disk =
           , sliceLength = fromIntegral disk.leiosStageLengthSlots
           , inputBlockFrequencyPerSlot = disk.ibGenerationProbability
           , endorseBlockFrequencyPerStage = disk.ebGenerationProbability
+          , maxEndorseBlockAgeSlots = fromIntegral disk.ebMaxAgeSlots
           , activeVotingStageLength = fromIntegral disk.leiosStageActiveVotingSlots
           , votingFrequencyPerStage = disk.voteGenerationProbability
           , votesForCertificate = fromIntegral disk.voteThreshold
@@ -253,6 +256,7 @@ delaysAndSizesAsFull cfg@LeiosConfig{pipeline, voteSendStage} =
     , sliceLength = cfg.sliceLength
     , inputBlockFrequencyPerSlot = cfg.inputBlockFrequencyPerSlot
     , endorseBlockFrequencyPerStage = cfg.endorseBlockFrequencyPerStage
+    , maxEndorseBlockAgeSlots = cfg.maxEndorseBlockAgeSlots
     , activeVotingStageLength = cfg.activeVotingStageLength
     , votingFrequencyPerStage = cfg.votingFrequencyPerStage
     , voteSendStage = voteSendStage
@@ -355,9 +359,13 @@ instance FixSize body => FixSize (Block body) where
 data Pipeline = SingleVote | SplitVote
 
 data Stage :: Pipeline -> Type where
-  Propose, Deliver1, Deliver2, Endorse :: Stage a
+  Propose :: Stage a
+  Deliver1 :: Stage a
+  Deliver2 :: Stage a
+  Endorse :: Stage a
   Vote :: Stage SingleVote
-  VoteSend, VoteRecv :: Stage SplitVote
+  VoteSend :: Stage SplitVote
+  VoteRecv :: Stage SplitVote
 
 deriving instance Eq (Stage a)
 deriving instance Ord (Stage a)
@@ -439,6 +447,24 @@ pipelineOf cfg stage sl =
 forEachPipeline :: (forall p. Stage p) -> (forall p. IsPipeline p => Stage p -> a) -> [a]
 forEachPipeline s k = [k @SingleVote s, k @SplitVote s]
 
+lastVoteSend :: LeiosConfig -> PipelineNo -> SlotNo
+lastVoteSend leios@LeiosConfig{pipeline} pipelineNo = case pipeline of
+  SingSingleVote -> snd (stageRangeOf leios pipelineNo Vote)
+  SingSplitVote -> snd (stageRangeOf leios pipelineNo VoteSend)
+
+lastVoteRecv :: LeiosConfig -> PipelineNo -> SlotNo
+lastVoteRecv leios@LeiosConfig{pipeline} pipelineNo = case pipeline of
+  SingSingleVote -> snd (stageRangeOf leios pipelineNo Vote)
+  SingSplitVote -> snd (stageRangeOf leios pipelineNo VoteRecv)
+
+endorseRange :: LeiosConfig -> PipelineNo -> (SlotNo, SlotNo)
+endorseRange cfg@LeiosConfig{pipeline = (_ :: SingPipeline p)} p =
+  stageRangeOf @p cfg p Endorse
+
+lastUnadoptedEB :: LeiosConfig -> PipelineNo -> SlotNo
+lastUnadoptedEB leios@LeiosConfig{pipeline = (_ :: SingPipeline p), maxEndorseBlockAgeSlots} pipelineNo =
+  lastVoteRecv leios pipelineNo + toEnum maxEndorseBlockAgeSlots
+
 ----------------------------------------------------------------------------------------------
 ---- Smart constructors
 ----------------------------------------------------------------------------------------------