peer-metrics: removed getHeaderMetrics and getFetchedMetrics

IntersectMBO · Aug 9, 2022 · 7926728 · 7926728
1 parent 79b4f09
commit 7926728
Show file tree

Hide file tree

Showing 3 changed files with 50 additions and 33 deletions.
diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs
@@ -88,12 +88,12 @@ simplePeerSelectionPolicy rngVar getChurnMode metrics errorDelay = PeerSelection
         mode <- getChurnMode
         scores <- case mode of
                        ChurnModeNormal -> do
-                           hup <- upstreamyness <$> getHeaderMetrics metrics
-                           bup <- fetchynessBlocks <$> getFetchedMetrics metrics
+                           hup <- upstreamyness metrics
+                           bup <- fetchynessBlocks metrics
                            return $ Map.unionWith (+) hup bup
 
                        ChurnModeBulkSync ->
-                           fetchynessBytes <$> getFetchedMetrics metrics
+                           fetchynessBytes metrics
         available' <- addRand available (,)
         return $ Set.fromList
              . map fst

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerMetric.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerMetric.hs
@@ -9,8 +9,6 @@ module Ouroboros.Network.PeerSelection.PeerMetric
   ( -- * Peer metrics
     PeerMetrics
   , newPeerMetric
-  , getHeaderMetrics
-  , getFetchedMetrics
     -- * Metric calculations
   , upstreamyness
   , fetchynessBytes
@@ -163,21 +161,6 @@ metricsTracer getMetrics writeMetrics = Tracer $ \(TraceLabelPeer !peer (!slot,
                 else writeMetrics (Pq.insert (slotMetricKey slot) slot (peer, time) metrics)
 
 
-getHeaderMetrics
-    :: MonadSTM m
-    => PeerMetrics m p
-    -> STM m (SlotMetric p)
-getHeaderMetrics PeerMetrics{peerMetricsVar} =
-    headerMetrics <$> readTVar peerMetricsVar
-
-getFetchedMetrics
-    :: MonadSTM m
-    => PeerMetrics m p
-    -> STM m (SlotMetric (p, SizeInBytes))
-getFetchedMetrics PeerMetrics{peerMetricsVar} =
-    fetchedMetrics <$> readTVar peerMetricsVar
-
-
 --
 -- Metrics
 --
@@ -190,10 +173,22 @@ getFetchedMetrics PeerMetrics{peerMetricsVar} =
 -- to present us with a block/header.
 --
 upstreamyness
-    :: forall p.  ( Ord p )
-    => SlotMetric p
+    :: forall p m.
+       MonadSTM m
+    => Ord p
+    => PeerMetrics m p
+    -> STM m (Map p Int)
+upstreamyness PeerMetrics {peerMetricsVar} =
+    upstreamynessImpl <$> readTVar peerMetricsVar
+
+
+upstreamynessImpl
+    :: forall p.
+       Ord p
+    => PeerMetricsState p
     -> Map p Int
-upstreamyness = Pq.fold' count Map.empty
+upstreamynessImpl PeerMetricsState { headerMetrics } =
+    Pq.fold' count Map.empty headerMetrics
   where
     count :: Int
           -> SlotNo
@@ -212,10 +207,21 @@ upstreamyness = Pq.fold' count Map.empty
 -- peer.
 --
 fetchynessBytes
-    :: forall p.  ( Ord p )
-    => SlotMetric (p, SizeInBytes)
+    :: forall p m.
+       MonadSTM m
+    => Ord p
+    => PeerMetrics m p
+    -> STM m (Map p Int)
+fetchynessBytes PeerMetrics {peerMetricsVar} =
+    fetchynessBytesImpl <$> readTVar peerMetricsVar
+
+fetchynessBytesImpl
+    :: forall p.
+       Ord p
+    => PeerMetricsState p
     -> Map p Int
-fetchynessBytes = Pq.fold' count Map.empty
+fetchynessBytesImpl PeerMetricsState { fetchedMetrics } =
+    Pq.fold' count Map.empty fetchedMetrics
   where
     count :: Int
           -> SlotNo
@@ -234,10 +240,21 @@ fetchynessBytes = Pq.fold' count Map.empty
 -- we downloaded a block from.
 --
 fetchynessBlocks
-    :: forall p.  ( Ord p )
-    => SlotMetric (p, SizeInBytes)
+    :: forall p m.
+       MonadSTM m
+    => Ord p
+    => PeerMetrics m p
+    -> STM m (Map p Int)
+fetchynessBlocks PeerMetrics {peerMetricsVar} =
+    fetchynessBlocksImpl <$> readTVar peerMetricsVar
+
+fetchynessBlocksImpl
+    :: forall p.
+       Ord p
+    => PeerMetricsState p
     -> Map p Int
-fetchynessBlocks = Pq.fold' count Map.empty
+fetchynessBlocksImpl PeerMetricsState { fetchedMetrics } =
+    Pq.fold' count Map.empty fetchedMetrics
   where
     count :: Int
           -> SlotNo

diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Diffusion/Policies.hs b/ouroboros-network/test/Test/Ouroboros/Network/Diffusion/Policies.hs
@@ -182,11 +182,11 @@ prop_hotToWarmM ArbitraryPolicyArguments{..} seed = do
     noneWorse metrics pickedSet = do
         scores <- atomically $ case apaChurnMode of
                       ChurnModeNormal -> do
-                          hup <- upstreamyness <$> getHeaderMetrics metrics
-                          bup <- fetchynessBlocks <$> getFetchedMetrics metrics
+                          hup <- upstreamyness metrics
+                          bup <- fetchynessBlocks metrics
                           return $ Map.unionWith (+) hup bup
-                      ChurnModeBulkSync -> fetchynessBytes <$>
-                          getFetchedMetrics metrics
+                      ChurnModeBulkSync ->
+                          fetchynessBytes metrics
         let (picked, notPicked) = Map.partitionWithKey fn scores
             maxPicked = maximum $ Map.elems picked
             minNotPicked = minimum $ Map.elems notPicked