Trace connection durations

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/LedgerPeers/Type.hs

@@ -253,7 +253,7 @@ data IsLedgerPeer = IsLedgerPeer
 data IsBigLedgerPeer
    = IsBigLedgerPeer
    | IsNotBigLedgerPeer
-  deriving Eq
+  deriving (Eq, Show)
 
 -- | Return ledger state information and ledger peers.
 --

ouroboros-network/CHANGELOG.md

@@ -39,6 +39,9 @@
 - Renamed `Applications` to `DiffusionApplications`
 - `runM` function now receives `ExtraParameters` as an argument
 - Configurable Mux Egress Poll Interval
+- Added `pchPromotedHotVar` to `PeerConnectionHandle` to track when a peer has been promoted to hot
+- Added tag `PeerHotDuration` to `PeerSelectionActionsTrace` to indicate how long a remote
+  peer has been in hot mode until it was either demoted or closed.
 
 ## 0.21.2.0 -- 2025-06-02
 

ouroboros-network/cardano-diffusion/Cardano/Network/Diffusion.hs

@@ -41,6 +41,7 @@ import Ouroboros.Network.NodeToNode (NodeToNodeVersionData (..), RemoteAddress,
 import Ouroboros.Network.NodeToNode qualified as NodeToNode
 import Ouroboros.Network.PeerSelection.LedgerPeers.Type
            (LedgerPeersConsensusInterface (..))
+import Ouroboros.Network.PeerSelection.PeerStateActions
 import Ouroboros.Network.Protocol.Handshake
 
 -- | Main entry point for Cardano data diffusion service.  It allows to:
@@ -136,7 +137,8 @@ run CardanoNodeArguments {
                       (Diffusion.dcPeerSharing config)
                       readUseBootstrapPeers
                       (Cardano.getLedgerStateJudgement (lpExtraAPI ledgerPeersAPI))
-                      churnMetrics,
+                      churnMetrics
+                      getPromotedHotTime,
                   daPeerSelectionGovernorArgs         =
                     Cardano.Types.cardanoPeerSelectionGovernorArgs
                       Cardano.ExtraPeerSelectionActions {

ouroboros-network/cardano-diffusion/Cardano/Network/Diffusion/Handlers.hs

@@ -8,6 +8,8 @@
 
 module Cardano.Network.Diffusion.Handlers where
 
+import Control.Monad.Class.MonadTime.SI
+
 import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers)
 import Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Cardano
 import Cardano.Network.Types (LedgerStateJudgement)
@@ -19,7 +21,6 @@ import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers)
 import Ouroboros.Network.PeerSelection.PeerMetric
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
 #ifdef POSIX
-import Control.Monad.Class.MonadTime.SI
 import Control.Tracer (traceWith)
 import Ouroboros.Network.ConnectionManager.Core (Trace (..))
 import Ouroboros.Network.PeerSelection.Governor.Types
@@ -40,6 +41,7 @@ sigUSR1Handler
   -> STM IO UseBootstrapPeers
   -> STM IO LedgerStateJudgement
   -> PeerMetrics IO ntnAddr
+  -> (peerconn -> STM IO (Maybe Time))
   -> ConnectionManager muxMode socket ntnAddr
                        handle handleError IO
   -> StrictTVar IO (PeerSelectionState
@@ -49,7 +51,7 @@ sigUSR1Handler
   -> IO ()
 #ifdef POSIX
 sigUSR1Handler tracersExtra getUseLedgerPeers ownPeerSharing getBootstrapPeers
-               getLedgerStateJudgement metrics connectionManager dbgStateVar = do
+               getLedgerStateJudgement metrics getPromotedHotTime connectionManager dbgStateVar = do
   _ <- Signals.installHandler
          Signals.sigUSR1
          (Signals.Catch
@@ -66,7 +68,7 @@ sigUSR1Handler tracersExtra getUseLedgerPeers ownPeerSharing getBootstrapPeers
                                 useBootstrapPeers
                           <*> readTVar dbgStateVar
 
-               let dbgState = makeDebugPeerSelectionState ps up bp lsj am
+               dbgState <- makeDebugPeerSelectionState ps up bp lsj am getPromotedHotTime now
 
                traceWith (dtConnectionManagerTracer tracersExtra)
                          (TrState state)
@@ -77,5 +79,5 @@ sigUSR1Handler tracersExtra getUseLedgerPeers ownPeerSharing getBootstrapPeers
          Nothing
   return ()
 #else
-sigUSR1Handler _ _ _ _ _ _ _ _ = pure ()
+sigUSR1Handler _ _ _ _ _ _ _ _ _ = pure ()
 #endif

ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs

@@ -769,18 +769,24 @@ data DebugPeerSelectionState extraState extraFlags extraPeers peeraddr =
     dpssUpstreamyness               :: !(Map peeraddr Int),
     dpssFetchynessBlocks            :: !(Map peeraddr Int),
     dpssAssociationMode             :: !AssociationMode,
+    dpssHotDurations                :: !(Map peeraddr (IsBigLedgerPeer, DiffTime)),
     dpssExtraState                  :: !extraState
   } deriving Show
 
 makeDebugPeerSelectionState
-  :: PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
+  :: (Ord peeraddr, MonadSTM m)
+  => PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
   -> Map peeraddr Int
   -> Map peeraddr Int
   -> extraDebugState
   -> AssociationMode
-  -> DebugPeerSelectionState extraDebugState extraFlags extraPeers peeraddr
-makeDebugPeerSelectionState PeerSelectionState {..} up bp es am =
-  DebugPeerSelectionState {
+  -> (peerconn -> STM m (Maybe Time))
+  -> Time
+  -> m (DebugPeerSelectionState extraDebugState extraFlags extraPeers peeraddr)
+makeDebugPeerSelectionState PeerSelectionState {..} up bp es am getPromotedHotTime now = do
+  let activeMap = EstablishedPeers.toMap establishedPeers `Map.restrictKeys` activePeers
+  dpssHotDurations <- Map.traverseMaybeWithKey getDiffTimes activeMap
+  return DebugPeerSelectionState {
       dpssTargets                     = targets
     , dpssLocalRootPeers              = localRootPeers
     , dpssPublicRootPeers             = publicRootPeers
@@ -802,8 +808,19 @@ makeDebugPeerSelectionState PeerSelectionState {..} up bp es am =
     , dpssUpstreamyness               = up
     , dpssFetchynessBlocks            = bp
     , dpssAssociationMode             = am
+    , dpssHotDurations
     , dpssExtraState                  = es
   }
+  where
+    getDiffTimes peeraddr peerconn = do
+      t1 <- atomically $ getPromotedHotTime peerconn
+      case t1 of
+        Nothing -> return Nothing
+        Just t1' ->
+          let !dt = now `diffTime` t1'
+          in if Set.member peeraddr (PublicRootPeers.getBigLedgerPeers publicRootPeers)
+               then return . Just $ (IsBigLedgerPeer, dt)
+               else return . Just $ (IsNotBigLedgerPeer, dt)
 
 -- | Public 'PeerSelectionState' that can be accessed by Peer Sharing
 -- mechanisms without any problem.