GDD: add separate trace event for disconnections

Author: amesgen

ouroboros-consensus-diffusion/changelog.d/20240912_105915_alexander.esgen_gdd_disconnect_trace.md

@@ -23,11 +23,12 @@ module Test.Consensus.PeerSimulator.Trace (
 import           Control.Tracer (Tracer (Tracer), contramap, traceWith)
 import           Data.Bifunctor (second)
 import           Data.List (intersperse)
+import qualified Data.List.NonEmpty as NE
 import           Data.Time.Clock (DiffTime, diffTimeToPicoseconds)
 import           Ouroboros.Consensus.Block (GenesisWindow (..), Header, Point,
                      WithOrigin (NotOrigin, Origin), succWithOrigin)
 import           Ouroboros.Consensus.Genesis.Governor (DensityBounds (..),
-                     TraceGDDEvent (..))
+                     GDDDebugInfo (..), TraceGDDEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                      (TraceChainSyncClientEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping
@@ -490,7 +491,15 @@ showPeers = map (\ (peer, v) -> "        " ++ condense peer ++ ": " ++ v)
 -- * Other utilities
 terseGDDEvent :: TraceGDDEvent PeerId TestBlock -> String
 terseGDDEvent = \case
-  TraceGDDEvent {sgen = GenesisWindow sgen, curChain, bounds, candidates, candidateSuffixes, losingPeers, loeHead} ->
+  TraceGDDDisconnected peers -> "GDD | Disconnected " <> show (NE.toList peers)
+  TraceGDDDebug GDDDebugInfo {
+      sgen = GenesisWindow sgen
+    , curChain, bounds
+    , candidates
+    , candidateSuffixes
+    , losingPeers
+    , loeHead
+    } ->
     unlines $ [
       "GDD | Window: " ++ window sgen loeHead,
       "      Selection: " ++ terseHFragment curChain,

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Trace.hs

@@ -0,0 +1,5 @@
+### Breaking
+
+- Made `TraceGDDEvent` into a sum type, added a new terse constructor for when
+  we disconnect from peers (this is supposed to get a high severity in the
+  tracing system).

ouroboros-consensus/changelog.d/20240912_105038_alexander.esgen_gdd_disconnect_trace.md

@@ -25,6 +25,7 @@
 --
 module Ouroboros.Consensus.Genesis.Governor (
     DensityBounds (..)
+  , GDDDebugInfo (..)
   , GDDStateView (..)
   , TraceGDDEvent (..)
   , densityDisconnect
@@ -38,6 +39,8 @@ import           Data.Bifunctor (second)
 import           Data.Containers.ListUtils (nubOrd)
 import           Data.Foldable (for_, toList)
 import           Data.Functor.Compose (Compose (..))
+import           Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NE
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (mapMaybe, maybeToList)
@@ -215,9 +218,12 @@ evaluateGDD cfg tracer stateView = do
           densityDisconnect sgen (configSecurityParam cfg) states candidateSuffixes loeFrag
         loeHead = AF.headAnchor loeFrag
 
-      traceWith tracer TraceGDDEvent {sgen, curChain, bounds, candidates, candidateSuffixes, losingPeers, loeHead}
+      traceWith tracer $ TraceGDDDebug
+        GDDDebugInfo {sgen, curChain, bounds, candidates, candidateSuffixes, losingPeers, loeHead}
 
-      for_ losingPeers $ \peer -> killActions Map.! peer
+      whenJust (NE.nonEmpty losingPeers) $ \losingPeersNE -> do
+        for_ losingPeersNE $ \peer -> killActions Map.! peer
+        traceWith tracer $ TraceGDDDisconnected losingPeersNE
 
     pure loeFrag
 
@@ -424,8 +430,8 @@ densityDisconnect (GenesisWindow sgen) (SecurityParam k) states candidateSuffixe
 -- after the intersection. If both chains agree on the next header after
 -- the intersection, we don't disconnect peer1 either.
 
-data TraceGDDEvent peer blk =
-  TraceGDDEvent {
+data GDDDebugInfo peer blk =
+  GDDDebugInfo {
     bounds            :: [(peer, DensityBounds blk)],
     curChain          :: AnchoredFragment (Header blk),
     candidates        :: [(peer, AnchoredFragment (Header blk))],
@@ -435,6 +441,16 @@ data TraceGDDEvent peer blk =
     sgen              :: GenesisWindow
   }
 
+deriving stock instance
+  ( GetHeader blk, Show (Header blk), Show peer
+  ) => Show (GDDDebugInfo peer blk)
+
+data TraceGDDEvent peer blk =
+    -- | The GDD disconnected from the given peers due to insufficient density.
+    TraceGDDDisconnected (NonEmpty peer)
+  |
+    TraceGDDDebug (GDDDebugInfo peer blk)
+
 deriving stock instance
   ( GetHeader blk, Show (Header blk), Show peer
   ) => Show (TraceGDDEvent peer blk)