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/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 (,)

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
 
 

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

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