From e1403a89f41898377476e7f094d8d497469c6f61 Mon Sep 17 00:00:00 2001
From: Javier Sagredo <javier.sagredo@iohk.io>
Date: Thu, 19 Dec 2024 10:54:06 +0100
Subject: [PATCH] Make `ChainSelStarvation` carry an `Enclosed`

---
 .../Test/Consensus/PeerSimulator/Trace.hs     |  9 +++++----
 .../Consensus/Storage/ChainDB/Impl/Types.hs   | 20 +++++++++----------
 .../Ouroboros/Storage/ChainDB/StateMachine.hs |  4 ++--
 3 files changed, 16 insertions(+), 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
index 2d439c0de7..a3d8faa6bd 100644
--- 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/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
index a58c711098..8e8610614b 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
+++ b/ouroboros-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
index 9d4c870f92..6d4e4cc0f6 100644
--- 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