Make ChainSelStarvation carry an Enclosed

IntersectMBO · Dec 19, 2024 · e1403a8 · e1403a8
1 parent 7d82cf1
commit e1403a8
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 17 deletions.
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Trace.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Trace.hs
@@ -41,6 +41,7 @@ import           Ouroboros.Consensus.Storage.ChainDB.API (LoE (..))
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl as ChainDB
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.Types
                      (TraceAddBlockEvent (..))
+import           Ouroboros.Consensus.Util.Enclose
 import           Ouroboros.Consensus.Util.Condense (condense)
 import           Ouroboros.Consensus.Util.IOLike (IOLike, MonadMonotonicTime,
                      Time (Time), atomically, getMonotonicTime, readTVarIO,
@@ -370,10 +371,10 @@ traceChainDBEventTestBlockWith tracer = \case
         AddedReprocessLoEBlocksToQueue ->
           trace $ "Requested ChainSel run"
         _ -> pure ()
-    ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvationStarted time) ->
-      trace $ "ChainSel starvation started at " ++ prettyTime time
-    ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvationEnded time pt) ->
-      trace $ "ChainSel starvation ended at " ++ prettyTime time ++ " thanks to " ++ terseRealPoint pt
+    ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation RisingEdge) ->
+      trace "ChainSel starvation started"
+    ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation (FallingEdgeWith pt)) ->
+      trace $ "ChainSel starvation ended thanks to " ++ terseRealPoint pt
     _ -> pure ()
   where
     trace = traceUnitWith tracer "ChainDB"

diff --git a/...boros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs b/...boros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
@@ -541,15 +541,14 @@ getChainSelMessage starvationTracer starvationVar chainSelQueue =
     startStarvationMeasure = do
       prevStarvation <- atomically $ swapTVar starvationVar ChainSelStarvationOngoing
       when (prevStarvation /= ChainSelStarvationOngoing) $
-        traceWith starvationTracer . ChainSelStarvationStarted =<< getMonotonicTime
+        traceWith starvationTracer $ ChainSelStarvation RisingEdge
 
     terminateStarvationMeasure :: ChainSelMessage m blk -> m ()
     terminateStarvationMeasure = \case
       ChainSelAddBlock BlockToAdd{blockToAdd=block} -> do
-        tf <- getMonotonicTime
         let pt = blockRealPoint block
-        traceWith starvationTracer $ ChainSelStarvationEnded tf pt
-        atomically $ writeTVar starvationVar (ChainSelStarvationEndedAt tf)
+        traceWith starvationTracer $ ChainSelStarvation (FallingEdgeWith pt)
+        atomically . writeTVar starvationVar . ChainSelStarvationEndedAt =<< getMonotonicTime
       ChainSelReprocessLoEBlocks{} -> pure ()
 
 -- TODO Can't use tryReadTBQueue from io-classes because it is broken for IOSim
@@ -938,11 +937,10 @@ data TraceIteratorEvent blk
 -- This is the usual case and innocent while caught-up; but while syncing, it
 -- means that we are downloading blocks at a smaller rate than we can validate
 -- them, even though we generally expect to be CPU-bound.
-data TraceChainSelStarvationEvent blk
-    -- | A ChainSel starvation started at the given time.
-  = ChainSelStarvationStarted Time
-
-    -- | The last ChainSel starvation ended at the given time as a block wth the
-    -- given point has been received.
-  | ChainSelStarvationEnded Time (RealPoint blk)
+--
+-- Somehow it happens regularly during syncing for very short times.
+--
+-- The point in the trace is the block that finished the starvation.
+newtype TraceChainSelStarvationEvent blk =
+  ChainSelStarvation (Enclosing' (RealPoint blk))
   deriving (Generic, Eq, Show)
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
@@ -1241,8 +1241,8 @@ deriving instance SOP.Generic         (ImmutableDB.TraceEvent blk)
 deriving instance SOP.HasDatatypeInfo (ImmutableDB.TraceEvent blk)
 deriving instance SOP.Generic         (VolatileDB.TraceEvent blk)
 deriving instance SOP.HasDatatypeInfo (VolatileDB.TraceEvent blk)
-deriving instance SOP.Generic         (TraceChainSelStarvationEvent blk)
-deriving instance SOP.HasDatatypeInfo (TraceChainSelStarvationEvent blk)
+deriving anyclass instance SOP.Generic         (TraceChainSelStarvationEvent blk)
+deriving anyclass instance SOP.HasDatatypeInfo (TraceChainSelStarvationEvent blk)
 
 data Tag =
     TagGetIsValidJust