From ce103fa7f0309d001251a3aa782beeb660bc7123 Mon Sep 17 00:00:00 2001
From: Karl Knutsson <karl.knutsson@iohk.io>
Date: Wed, 17 Nov 2021 18:25:33 +0100
Subject: [PATCH] Use block download when ranking peers

Use both who ever gave us a header first, and who ever provided us with
the block first when ranking peers in deadline mode. For larger blocks
forged far away it is likely that we learned of the header
from a node on another continent, but the node from which we first
downloaded the block is much closer. This change gives both nodes
credit.
---
 .../Ouroboros/Network/Diffusion/Policies.hs   |  7 +++++--
 .../Network/PeerSelection/PeerMetric.hs       | 19 +++++++++++++++++++
 2 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs
index 8cf61307623..5b1632174f1 100644
--- a/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs
+++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs
@@ -81,8 +81,11 @@ simplePeerSelectionPolicy rngVar getChurnMode metrics = PeerSelectionPolicy {
     hotDemotionPolicy _ _ _ available pickNum = do
         mode <- getChurnMode
         scores <- case mode of
-                       ChurnModeNormal ->
-                           upstreamyness <$> getHeaderMetrics metrics
+                       ChurnModeNormal -> do
+                           hup <- upstreamyness <$> getHeaderMetrics metrics
+                           bup <- fetchyness' <$> getFetchedMetrics metrics
+                           return $ Map.unionWith (+) hup bup
+
                        ChurnModeBulkSync ->
                            fetchyness <$> getFetchedMetrics metrics
         available' <- addRand available (,)
diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerMetric.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerMetric.hs
index a62e500cfc0..c41ad3b088e 100644
--- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerMetric.hs
+++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerMetric.hs
@@ -163,5 +163,24 @@ fetchyness = Pq.fold' count Map.empty
         fn Nothing = Just $ fromIntegral bytes
         fn (Just oldBytes) = Just $! oldBytes + fromIntegral bytes
 
+-- Returns a Map which counts the number of times a given peer
+-- was the first we downloaded a block from.
+fetchyness'
+    :: forall p.  ( Ord p )
+    => SlotMetric (p, SizeInBytes)
+    -> Map p Int
+fetchyness' = Pq.fold' count Map.empty
+  where
+    count :: Int
+          -> SlotNo
+          -> ((p, SizeInBytes), Time)
+          -> Map p Int
+          -> Map p Int
+    count _ _ ((peer, _),_) m =
+        Map.alter fn peer m
+      where
+        fn :: Maybe Int -> Maybe Int
+        fn Nothing = Just 1
+        fn (Just c) = Just $! c + 1