p2p-governor: added PeerSelectionCounters and respective tracers.

IntersectMBO · Sep 28, 2021 · 8da0d7f · 8da0d7f
1 parent ca433d1
commit 8da0d7f
Show file tree

Hide file tree

Showing 4 changed files with 33 additions and 7 deletions.
diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs
@@ -31,6 +31,7 @@ module Ouroboros.Network.PeerSelection.Governor (
     sanePeerSelectionTargets,
     establishedPeersStatus,
     PeerSelectionState(..),
+    PeerSelectionCounters(..)
 ) where
 
 import           Data.Void (Void)
@@ -44,7 +45,7 @@ import           Control.Monad.Class.MonadThrow
 import           Control.Monad.Class.MonadSTM.Strict
 import           Control.Monad.Class.MonadTime
 import           Control.Monad.Class.MonadTimer
-import           Control.Tracer (Tracer(..), traceWith)
+import           Control.Tracer (Tracer(..), traceWith, contramap)
 import           System.Random
 
 import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as EstablishedPeers
@@ -439,16 +440,20 @@ peerSelectionGovernor :: (MonadAsync m, MonadMask m, MonadTime m, MonadTimer m,
                           Ord peeraddr)
                       => Tracer m (TracePeerSelection peeraddr)
                       -> Tracer m (DebugPeerSelection peeraddr peerconn)
+                      -> Tracer m PeerSelectionCounters
                       -> PeerSelectionActions peeraddr peerconn m
                       -> PeerSelectionPolicy  peeraddr m
                       -> m Void
-peerSelectionGovernor tracer debugTracer actions policy =
+peerSelectionGovernor tracer debugTracer countersTracer actions policy =
     JobPool.withJobPool $ \jobPool ->
       peerSelectionGovernorLoop
-        tracer debugTracer
+        tracer (debugTracer <> contramap transform countersTracer)
         actions policy
         jobPool
         emptyPeerSelectionState
+  where
+    transform :: Ord peeraddr => DebugPeerSelection peeraddr peerconn -> PeerSelectionCounters
+    transform (TraceGovernorState _ _ st) = peerStateToCounters st
 
 
 -- | Our pattern here is a loop with two sets of guarded actions:

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs
@@ -30,6 +30,8 @@ module Ouroboros.Network.PeerSelection.Governor.Types
   , TimedDecision
   , MkGuardedDecision
   , Completion (..)
+  , PeerSelectionCounters (..)
+  , peerStateToCounters
 
   -- * Traces
   , TracePeerSelection (..)
@@ -298,6 +300,20 @@ data PeerSelectionState peeraddr peerconn = PeerSelectionState {
      }
   deriving (Show, Functor)
 
+data PeerSelectionCounters = PeerSelectionCounters {
+      coldPeers :: !Int,
+      warmPeers :: !Int,
+      hotPeers  :: !Int
+    } deriving Show
+
+peerStateToCounters :: Ord peeraddr => PeerSelectionState peeraddr peerconn -> PeerSelectionCounters
+peerStateToCounters st = PeerSelectionCounters { coldPeers, warmPeers, hotPeers }
+  where
+    knownPeersSet = KnownPeers.toSet (knownPeers st)
+    establishedPeersSet = EstablishedPeers.toSet (establishedPeers st)
+    coldPeers = Set.size $ knownPeersSet Set.\\ establishedPeersSet
+    warmPeers = Set.size $ establishedPeersSet Set.\\ activePeers st
+    hotPeers  = Set.size $ activePeers st
 
 emptyPeerSelectionState :: PeerSelectionState peeraddr peerconn
 emptyPeerSelectionState =

diff --git a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs
@@ -297,7 +297,7 @@ _governorFindingPublicRoots targetNumberOfRootPeers domains =
       domains $ \requestPublicRootPeers ->
 
         peerSelectionGovernor
-          tracer tracer
+          tracer tracer tracer
           actions { requestPublicRootPeers }
           policy
   where

diff --git a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs
@@ -168,6 +168,7 @@ runGovernorInMockEnvironment mockEnv =
       peerSelectionGovernor
         tracerTracePeerSelection
         tracerDebugPeerSelection
+        tracerTracePeerSelectionCounters
         actions
         policy
 
@@ -382,9 +383,10 @@ mockPeerSelectionPolicy GovernorMockEnvironment {
 -- Utils for properties
 --
 
-data TestTraceEvent = GovernorDebug (DebugPeerSelection PeerAddr ())
-                    | GovernorEvent (TracePeerSelection PeerAddr)
-                    | MockEnvEvent   TraceMockEnv
+data TestTraceEvent = GovernorDebug    (DebugPeerSelection PeerAddr ())
+                    | GovernorEvent    (TracePeerSelection PeerAddr)
+                    | GovernorCounters PeerSelectionCounters
+                    | MockEnvEvent     TraceMockEnv
   deriving Show
 
 tracerTracePeerSelection :: Tracer (IOSim s) (TracePeerSelection PeerAddr)
@@ -394,6 +396,9 @@ tracerDebugPeerSelection :: Tracer (IOSim s) (DebugPeerSelection PeerAddr peerco
 tracerDebugPeerSelection = contramap (GovernorDebug . fmap (const ()))
                                      tracerTestTraceEvent
 
+tracerTracePeerSelectionCounters :: Tracer (IOSim s) PeerSelectionCounters
+tracerTracePeerSelectionCounters = contramap GovernorCounters tracerTestTraceEvent
+
 tracerMockEnv :: Tracer (IOSim s) TraceMockEnv
 tracerMockEnv = contramap MockEnvEvent tracerTestTraceEvent