simulation: implemented --conformance-events

* emits Slot and No${LeiosBlockId}Generated events.

Author: Saizan

data/simulation/example.haskell.jsonl

@@ -1,135 +1,7 @@
 /** Haskell simulation trace format */
-export interface HaskellTraceEvent {
-    time_s: number;
-    message: HaskellEvent;
-}
 
-type LeiosBlockKind = "IB" | "EB" | "VTBundle"
-type BlockKind = LeiosBlockKind | "RB";
-type BlockAction = "Generated" | "EnteredState";
+import * as shared from "./trace.shared";
 
-type HaskellEvent =
-    | HaskellCpuEvent
-    | HaskellBlockEvent
-    | HaskellNetworkEvent
-    | HaskellSlotEvent
-    | HaskellNoBlockEvent;
-
-type HaskellEventType =
-    | CpuEventType
-    | BlockEventType
-    | NetworkEventType
-    | SlotEventType
-    | NoBlockEventType;
-
-type SlotEventType = "Slot"
-interface HaskellSlotEvent {
-    type: SlotEventType;
-    node: string;
-    slot: number;
-}
-
-type NoBlockEventType = `No${LeiosBlockKind}Generated`
-interface HaskellNoBlockEvent {
-    type: NoBlockEventType;
-    node: string;
-    slot: number;
-}
-
-
-type CpuEventType = "Cpu"
-interface HaskellCpuEvent {
-    type: CpuEventType;
-    node: string;
-    cpu_time_s: number;
-    // CPU task types: Block validation (ValIB, ValEB, ValRB), Header validation (ValIH, ValRH), Vote validation (ValVote). Format: "<task_type>: <id>"
-    task_label: string; // e.g., "ValIB: 6-29" or "ValRH: 6253064077348247640"
-}
-
-type BlockEventType = `${BlockKind}${BlockAction}`
-// Base block event interface with just identification info
-interface BaseBlockEvent {
-    type: BlockEventType;
-    slot: number;
-}
-
-// Additional fields for Generated events
-interface GeneratedBlockEvent extends BaseBlockEvent {
-    size_bytes: number;
-    producer: string;
-}
-
-interface GeneratedInputBlock extends GeneratedBlockEvent {
-    id: string;
-    payload_bytes?: number|null;
-    rb_ref?: string|null;
-}
-interface BlockRef {
-  id : string;
-}
-interface Endorsement {
-  eb : BlockRef;
-}
-
-interface GeneratedEndorserBlock extends GeneratedBlockEvent {
-    id: string;
-    input_blocks: BlockRef[];
-}
-
-interface GeneratedRankingBlock extends GeneratedBlockEvent {
-    endorsement?: Endorsement|null;
-    endorsements?: Endorsement[]|null;
-    vrf? : number;
-    id? : string;
-    payload_bytes? : number|null;
-    parent?: {
-        id: string;
-    }|null;
-}
-
-interface GeneratedVote extends GeneratedBlockEvent {
-    id: string;
-    votes: Record<string, number>;
-}
-
-// EnteredState events only need the base identification info
-interface EnteredStateBlock extends BaseBlockEvent {
-    id: string;
-  node: string;
-}
-
-type HaskellBlockEvent =
-    | GeneratedInputBlock
-    | GeneratedEndorserBlock
-    | GeneratedRankingBlock
-    | GeneratedVote
-    | EnteredStateBlock;
-
-
-type NetworkAction = "Sent" | "Received"
-type NetworkEventType = `${BlockKind}${NetworkAction}`
-
-interface HaskellNetworkEvent {
-    type: NetworkEventType;
-    sender?: string|null;
-    recipient: string;
-    msg_size_bytes?: number|null;
-    sending_s?: number|null;
-    id: string;
-    ids?: string[]|null;
-}
-
-export interface UnknownEvent {
-    time_s: number;
-    message: UnknownMessage;
-}
-
-export interface UnknownMessage {
-  /** @$ref "#/definitions/UnknownType" */
-  type;
-}
-
-// Type to validate `jq '.' -cs` of a log.
-type TraceEvents = (HaskellTraceEvent|UnknownEvent)[]
-
-type KnownType = HaskellEventType
+type HaskellTraceEvent = shared.TraceEvent;
+type KnownType = shared.KnownType;
+type TraceEvents = shared.TraceEvents;

data/simulation/trace.haskell.d.ts

@@ -239,6 +239,7 @@ data SimOutputConfig = SimOutputConfig
   , analize :: Bool
   , stop :: Time
   , logFormat :: LogFormat
+  , conformanceEvents :: Bool
   }
 
 rawDataFromState :: OnDisk.Config -> P2PNetwork -> LeiosSimState -> Time -> RawLeiosData
@@ -338,7 +339,7 @@ exampleSim seed cfg p2pNetwork@P2PNetwork{..} SimOutputConfig{..} = do
   runModel :: SampleModel LeiosEvent state -> IO ()
   runModel model =
     runSampleModel' logFile logEvent model stop $
-      exampleTrace2 seed cfg p2pNetwork
+      exampleTrace2 seed cfg p2pNetwork conformanceEvents
   logEvent = case logFormat of
     Legacy{..} -> jsonlLog $ logLeiosTraceEvent p2pNodeNames verbosity
     Shared{cbor}

simulation/src/LeiosProtocol/Short/DataSimP2P.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NondecreasingIndentation #-}
@@ -73,11 +74,18 @@ data BlockEvent
   | Pruned
   deriving (Show)
 
+data ConformanceEvent
+  = Slot {slot :: !SlotNo}
+  | NoIBGenerated {slot :: !SlotNo}
+  | NoEBGenerated {slot :: !SlotNo}
+  | NoVTGenerated {slot :: !SlotNo}
+  deriving (Show)
 data LeiosNodeEvent
   = PraosNodeEvent !(PraosNode.PraosNodeEvent RankingBlockBody)
   | LeiosNodeEventCPU !CPUTask
   | LeiosNodeEvent !BlockEvent !LeiosEventBlock
   | LeiosNodeEventLedgerState !RankingBlockId
+  | LeiosNodeEventConformance !ConformanceEvent
   deriving (Show)
 
 --------------------------------------------------------------
@@ -103,6 +111,7 @@ data LeiosNodeConfig = LeiosNodeConfig
   , processingQueueBound :: !Natural
   , processingCores :: !NumCores
   , blockGeneration :: !BlockGeneration
+  , conformanceEvents :: !Bool
   }
 
 --------------------------------------------------------------
@@ -801,7 +810,7 @@ generator ::
   LeiosNodeState m ->
   m ()
 generator tracer cfg st = do
-  schedule <- mkSchedule cfg
+  schedule <- mkSchedule tracer cfg
   let buffers = mkBuffersView cfg st
   let
     withDelay d (lbl, m) = do
@@ -926,13 +935,14 @@ mkBuffersView cfg st = BuffersView{..}
               ]
     return EndorseBlocksSnapshot{..}
 
-mkSchedule :: MonadSTM m => LeiosNodeConfig -> m (SlotNo -> m [(SomeRole, Word64)])
-mkSchedule cfg = do
+mkSchedule :: MonadSTM m => Tracer m LeiosNodeEvent -> LeiosNodeConfig -> m (SlotNo -> m [(SomeRole, Word64)])
+mkSchedule tracer cfg = do
   -- For each pipeline, we want to deploy all our votes in a single
   -- message to cut down on traffic, so we pick one slot out of each
   -- active voting range (they are assumed not to overlap).
   votingSlots <- newTVarIO $ pickFromRanges rng1 $ votingRanges cfg.leios
-  mkScheduler rng2 (rates votingSlots)
+  sched <- mkScheduler' rng2 (rates votingSlots)
+  pure $! if cfg.conformanceEvents then logMissedBlocks sched else fmap filterWins . sched
  where
   (rng1, rng2) = split cfg.rng
   calcWins rate = Just $ \sample ->
@@ -949,6 +959,7 @@ mkSchedule cfg = do
     , (SomeRole Generate.Base, const $ calcWins (NetworkRate cfg.leios.praos.blockFrequencyPerSlot))
     ]
   rates votingSlots slot = do
+    when cfg.conformanceEvents $ traceWith tracer $ LeiosNodeEventConformance Slot{..}
     vote <- atomically $ do
       vs <- readTVar votingSlots
       case vs of
@@ -966,7 +977,20 @@ mkSchedule cfg = do
   pickFromRanges rng0 rs = snd $ mapAccumL f rng0 rs
    where
     f rng r = coerce $ swap $ uniformR (coerce r :: (Word64, Word64)) rng
-
+  logMissedBlocks sched slot = do
+    xs <- sched slot
+    forM_ xs $ \(SomeRole role, wins) -> do
+      when (wins == 0) $
+        case role of
+          Generate.Propose{} -> do
+            traceWith tracer $ LeiosNodeEventConformance $ NoIBGenerated{..}
+          Generate.Endorse{} -> do
+            traceWith tracer $ LeiosNodeEventConformance $ NoEBGenerated{..}
+          Generate.Vote{} -> do
+            traceWith tracer $ LeiosNodeEventConformance $ NoVTGenerated{..}
+          Generate.Base{} -> return ()
+    return $ filterWins xs
+  filterWins = filter ((>= 1) . snd)
 -- * Utils
 
 partitionRBVar ::

simulation/src/LeiosProtocol/Short/Node.hs

@@ -168,6 +168,7 @@ logLeiosEvent nodeNames loudness e = case e of
       EventIB ib -> mconcat [ibKind, "id" .= ib.stringId]
       EventEB eb -> mconcat [ebKind, "id" .= eb.stringId]
       EventVote vt -> mconcat [vtKind, "id" .= vt.stringId]
+  logNode _nid LeiosNodeEventConformance{} = Nothing
   logPraos nid (PraosNodeEventGenerate blk@(Block h b)) =
     Just $
       mconcat
@@ -312,6 +313,11 @@ sharedEvent leios nodeNames e = case e of
       _ -> Nothing
    where
     rbId blk = T.pack $ show (coerce @_ @Int (blockHash blk))
+  sharedNode node (LeiosNodeEventConformance ev) = Just $ case ev of
+    Slot{..} -> Shared.Slot{slot = coerce slot, ..}
+    NoIBGenerated{..} -> Shared.NoIBGenerated{slot = coerce slot, ..}
+    NoEBGenerated{..} -> Shared.NoEBGenerated{slot = coerce slot, ..}
+    NoVTGenerated{..} -> Shared.NoVTBundleGenerated{slot = coerce slot, ..}
   sharedNode _ _ = Nothing
   headAndTail xs = case xs of
     [] -> (Nothing, Nothing)
@@ -470,6 +476,7 @@ traceRelayLink1 connectionOptions =
                 processingQueueBound = 100
               , processingCores = Infinite
               , blockGeneration = Honest
+              , conformanceEvents = False
               , ..
               }
       (pA, cB) <- newConnectionBundle (leiosTracer nodeA nodeB) (uncurry configureConnection connectionOptions)

simulation/src/LeiosProtocol/Short/Sim.hs

@@ -89,11 +89,11 @@ traceLeiosP2P
     linkTracer nfrom nto =
       contramap (LeiosEventTcp . labelDirToLabelLink nfrom nto) tracer
 
-exampleTrace2 :: StdGen -> OnDisk.Config -> P2PNetwork -> LeiosTrace
+exampleTrace2 :: StdGen -> OnDisk.Config -> P2PNetwork -> Bool -> LeiosTrace
 exampleTrace2 rng = exampleTrace2' rng . convertConfig
 
-exampleTrace2' :: StdGen -> LeiosConfig -> P2PNetwork -> LeiosTrace
-exampleTrace2' rng0 leios@LeiosConfig{praos = PraosConfig{configureConnection}} p2pTopography@P2PNetwork{..} =
+exampleTrace2' :: StdGen -> LeiosConfig -> P2PNetwork -> Bool -> LeiosTrace
+exampleTrace2' rng0 leios@LeiosConfig{praos = PraosConfig{configureConnection}} p2pTopography@P2PNetwork{..} conformanceEvents =
   traceLeiosP2P
     rng0
     p2pTopography
@@ -118,6 +118,7 @@ exampleTrace2' rng0 leios@LeiosConfig{praos = PraosConfig{configureConnection}}
               , slotOfGeneratedIbs = SlotNo $ fromIntegral slotOfGeneratedIbs
               , ibsPerSlot = fromIntegral ibsPerSlot
               }
+      , conformanceEvents
       }
    where
     processingCores = fromMaybe undefined $ Map.lookup nodeId p2pNodeCores

simulation/src/LeiosProtocol/Short/SimP2P.hs

@@ -433,6 +433,8 @@ leiosSimVizModel LeiosModelConfig{recentSpan} =
     vs{nodeCpuUsage = accumNodeCpuUsage now nid task (nodeCpuUsage vs)}
   accumEventVizState _now (LeiosEventNode (LabelNode _nid (LeiosNodeEventLedgerState{}))) vs =
     vs
+  accumEventVizState _now (LeiosEventNode (LabelNode _nid (LeiosNodeEventConformance{}))) vs =
+    vs
   accumEventVizState
     _now
     ( LeiosEventNode

simulation/src/LeiosProtocol/Short/VizSim.hs

@@ -785,4 +785,4 @@ example2
     processingCores = maximum $ Map.elems p2pNodeCores
     config = defaultVizConfig voteSendStage 5 processingCores (10 * kilobytes 1000) -- TODO: calculate from p2pLinks
     modelConfig = config.model
-    model = leiosSimVizModel modelConfig (exampleTrace2' rng leiosConfig p2pNetwork)
+    model = leiosSimVizModel modelConfig (exampleTrace2' rng leiosConfig p2pNetwork False)

simulation/src/LeiosProtocol/Short/VizSimP2P.hs

@@ -385,6 +385,7 @@ runSimOptions SimOptions{..} = case simCommand of
             , logFormat = case sharedFormat of
                 Just x -> DataShortLeiosP2P.Shared (x == CBOR)
                 Nothing -> DataShortLeiosP2P.Legacy logVerbosity
+            , conformanceEvents
             }
     DataShortLeiosP2P.exampleSim rng2 config p2pNetwork outputCfg
 
@@ -421,6 +422,7 @@ data SimCommand
       , logVerbosity :: Int
       , analize :: Bool
       , sharedFormat :: Maybe OutputFormat
+      , conformanceEvents :: Bool
       }
 
 parserSimCommand :: Parser SimCommand
@@ -449,6 +451,7 @@ parserShortLeios =
     <*> logVerbosity
     <*> switch (long "analize" <> help "Calculate metrics and statistics.")
     <*> optional sharedLogFormat
+    <*> switch (long "conformance-events" <> help "Emits `Slot` and `No*Generated` events in the shared log format.")
  where
   logVerbosity =
     option

simulation/src/Main.hs

@@ -40,6 +40,7 @@ module PraosProtocol.Common (
   BlockGeneratorConfig (..),
   waitNextSlot,
   mkScheduler,
+  mkScheduler',
 ) where
 
 import Chan (ConnectionConfig, mkConnectionConfig)
@@ -229,13 +230,22 @@ mkScheduler ::
   (SlotNo -> m [(a, Maybe (Double -> Word64))]) ->
   m (SlotNo -> m [(a, Word64)])
 mkScheduler rng0 rates = do
+  sched <- mkScheduler rng0 rates
+  pure $ \slot -> filter ((>= 1) . snd) <$> sched slot
+
+mkScheduler' ::
+  MonadSTM m =>
+  StdGen ->
+  (SlotNo -> m [(a, Maybe (Double -> Word64))]) ->
+  m (SlotNo -> m [(a, Word64)])
+mkScheduler' rng0 rates = do
   let
     sampleRates (_role, Nothing) = return []
     sampleRates (role, Just f) = do
       (sample, rng') <- gets $ uniformR (0, 1)
       put $! rng'
       let wins = f sample
-      return [(role, wins) | wins >= 1]
+      return [(role, wins)]
   rngVar <- newTVarIO rng0
   let sched slot = do
         rs <- rates slot