Use block download when ranking peers

ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs

@@ -81,10 +81,13 @@ 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 <- fetchynessBlocks <$> getFetchedMetrics metrics
+                           return $ Map.unionWith (+) hup bup
+
                        ChurnModeBulkSync ->
-                           fetchyness <$> getFetchedMetrics metrics
+                           fetchynessBytes <$> getFetchedMetrics metrics
         available' <- addRand available (,)
         return $ Set.fromList
              . map fst

ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerMetric.hs

@@ -145,11 +145,11 @@ upstreamyness = Pq.fold' count Map.empty
 
 -- Returns a Map which counts the number of bytes downloaded
 -- for a given peer.
-fetchyness
+fetchynessBytes
     :: forall p.  ( Ord p )
     => SlotMetric (p, SizeInBytes)
     -> Map p Int
-fetchyness = Pq.fold' count Map.empty
+fetchynessBytes = Pq.fold' count Map.empty
   where
     count :: Int
           -> SlotNo
@@ -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.
+fetchynessBlocks
+    :: forall p.  ( Ord p )
+    => SlotMetric (p, SizeInBytes)
+    -> Map p Int
+fetchynessBlocks = 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
 
 

ouroboros-network/test/Test/Ouroboros/Network/Diffusion/Policies.hs

@@ -182,9 +182,11 @@ prop_hotToWarmM ArbitraryPolicyArguments{..} seed = do
               -> m Property
     noneWorse metrics pickedSet = do
         scores <- atomically $ case apaChurnMode of
-                      ChurnModeNormal -> upstreamyness <$>
-                          getHeaderMetrics metrics
-                      ChurnModeBulkSync -> fetchyness <$>
+                      ChurnModeNormal -> do
+                          hup <- upstreamyness <$> getHeaderMetrics metrics
+                          bup <- fetchynessBlocks <$> getFetchedMetrics metrics
+                          return $ Map.unionWith (+) hup bup
+                      ChurnModeBulkSync -> fetchynessBytes <$>
                           getFetchedMetrics metrics
         let (picked, notPicked) = Map.partitionWithKey fn scores
             maxPicked = maximum $ Map.elems picked