Changes to Peer Selection Governor

- Move Peer Sharing request decision information to EstablishedPeers module
- Add Peer Sharing reply decision information to KnownPeers module
- Refactor Peer Selection Governor code to account the 2 points above
- Remove a repeated Peer Sharing test
- Fixed prop_governor_gossip_1hr
  - Instead of using just firstGossipPeers use all reachable peers from
    the gossip script
  - Removed bigEnoughProperty since it might be the case that
    in the MockEnvironment, a peer never gets promoted to warm
    hence not allowing us to reach all possible reachable peers
- Fixed prop_governor_target_known_below to make sense with the change
  for EstablishedPeers

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

@@ -1,6 +1,7 @@
-{-# LANGUAGE DeriveFunctor  #-}
-{-# LANGUAGE LambdaCase     #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DeriveFunctor   #-}
+{-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE NamedFieldPuns  #-}
+{-# LANGUAGE RecordWildCards #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
@@ -17,47 +18,96 @@ module Ouroboros.Network.PeerSelection.EstablishedPeers
   , insert
   , delete
   , deletePeers
+    -- * Special operations
   , setCurrentTime
-  , minActivateTime
   , setActivateTimes
+    -- ** Tracking when we can (re)activate
+  , minActivateTime
+    -- ** Tracking when we can gossip
+  , minGossipTime
+  , setGossipTime
+  , availableForGossip
   , invariant
   ) where
 
 import           Prelude
 
-import           Data.Foldable (foldl')
+import qualified Data.List as List
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.OrdPSQ (OrdPSQ)
 import qualified Data.OrdPSQ as PSQ
+import           Data.Semigroup (Min (..))
 import           Data.Set (Set)
 import qualified Data.Set as Set
 
 import           Control.Exception (assert)
 import           Control.Monad.Class.MonadTime
 
 
+-------------------------------
+-- Established peer set representation
+--
+
+-- | The set of established peers. To a first approximation it can be thought of
+-- as a 'Set' of @peeraddr@.
+--
+-- It has one special feature:
+--
+--  * It tracks which peers we are permitted to gossip with now, or for peers
+--    we cannot gossip with now the time at which we would next be allowed to
+--    do so.
+--
 data EstablishedPeers peeraddr peerconn = EstablishedPeers {
     -- | Peers which are either ready to become active or are active.
     --
-    allPeers          :: !(Map peeraddr peerconn),
+    allPeers           :: !(Map peeraddr peerconn),
+
+    -- | The subset of established peers that we would be allowed to gossip with
+    -- now. This is because we have not gossiped with them recently.
+    --
+    -- NOTE that this is the set of available peers one would be able to perform
+    -- peer sharing _now_, it doesn't mean they are 100% eligible. This will
+    -- depend on other factors like the peer's 'PeerSharing' value.
+    --
+    availableForGossip :: !(Set peeraddr),
+
+    -- | The subset of established peers that we cannot gossip with now. It
+    -- keeps track of the next time we are allowed to gossip with them.
+    --
+    nextGossipTimes    :: !(OrdPSQ peeraddr Time ()),
+
 
     -- | Peers which are not ready to become active.
-    nextActivateTimes :: !(OrdPSQ peeraddr Time ())
+    nextActivateTimes  :: !(OrdPSQ peeraddr Time ())
   }
   deriving (Show, Functor)
 
 
 empty :: EstablishedPeers peeraddr perconn
-empty = EstablishedPeers Map.empty PSQ.empty
+empty = EstablishedPeers {
+      allPeers           = Map.empty,
+      availableForGossip = Set.empty,
+      nextGossipTimes    = PSQ.empty,
+      nextActivateTimes  = PSQ.empty
+    }
 
 
 invariant :: Ord peeraddr
           => EstablishedPeers peeraddr peerconn
           -> Bool
-invariant EstablishedPeers { allPeers, nextActivateTimes } =
+invariant EstablishedPeers {..} =
+       -- The combo of the gossip set + psq = the whole set of peers
+       availableForGossip
+    <> Set.fromList (PSQ.keys nextGossipTimes)
+    == Map.keysSet allPeers
+       -- The gossip set and psq do not overlap
+ && Set.null
+      (Set.intersection
+         availableForGossip
+        (Set.fromList (PSQ.keys nextGossipTimes)))
      -- nextActivateTimes is a subset of allPeers
-     Set.fromList (PSQ.keys nextActivateTimes)
+ &&  Set.fromList (PSQ.keys nextActivateTimes)
      `Set.isSubsetOf`
      Map.keysSet allPeers
 
@@ -114,16 +164,33 @@ insert :: Ord peeraddr
        -> peerconn
        -> EstablishedPeers peeraddr peerconn
        -> EstablishedPeers peeraddr peerconn
-insert peeraddr peerconn ep@EstablishedPeers { allPeers } =
-  ep { allPeers          = Map.insert peeraddr peerconn allPeers }
+insert peeraddr peerconn ep@EstablishedPeers { allPeers, availableForGossip } =
+   ep { allPeers = Map.insert peeraddr peerconn allPeers,
+
+        -- The sets tracking peers ready for gossip need to be updated with any
+        -- /fresh/ peers, but any already present are ignored since they are
+        -- either already in these sets or they are in the corresponding PSQs,
+        -- for which we also preserve existing info.
+        availableForGossip =
+          if Map.member peeraddr allPeers
+             then availableForGossip
+             else Set.insert peeraddr availableForGossip
+      }
 
 delete :: Ord peeraddr
        => peeraddr
        -> EstablishedPeers peeraddr peerconn
        -> EstablishedPeers peeraddr peerconn
-delete peeraddr es@EstablishedPeers { allPeers, nextActivateTimes } =
-    es { allPeers          = Map.delete peeraddr allPeers,
-         nextActivateTimes = PSQ.delete peeraddr nextActivateTimes }
+delete peeraddr es@EstablishedPeers { allPeers
+                                    , availableForGossip
+                                    , nextGossipTimes
+                                    , nextActivateTimes
+                                    } =
+    es { allPeers           = Map.delete peeraddr allPeers,
+         availableForGossip = Set.delete peeraddr availableForGossip,
+         nextGossipTimes    = PSQ.delete peeraddr nextGossipTimes,
+         nextActivateTimes  = PSQ.delete peeraddr nextActivateTimes
+       }
 
 
 
@@ -133,9 +200,18 @@ deletePeers :: Ord peeraddr
             => Set peeraddr
             -> EstablishedPeers peeraddr peerconn
             -> EstablishedPeers peeraddr peerconn
-deletePeers peeraddrs es@EstablishedPeers { allPeers, nextActivateTimes } =
-    es { allPeers          = foldl' (flip Map.delete) allPeers  peeraddrs,
-         nextActivateTimes = foldl' (flip PSQ.delete) nextActivateTimes peeraddrs }
+deletePeers peeraddrs es@EstablishedPeers { allPeers
+                                          , availableForGossip
+                                          , nextGossipTimes
+                                          , nextActivateTimes
+                                          } =
+    es { allPeers           = Map.withoutKeys allPeers peeraddrs,
+         availableForGossip = Set.difference availableForGossip peeraddrs,
+         nextGossipTimes    =
+           List.foldl' (flip PSQ.delete) nextGossipTimes peeraddrs,
+         nextActivateTimes  =
+           List.foldl' (flip PSQ.delete) nextActivateTimes peeraddrs
+       }
 
 
 --
@@ -146,10 +222,34 @@ setCurrentTime :: Ord peeraddr
                => Time
                -> EstablishedPeers peeraddr peerconn
                -> EstablishedPeers peeraddr peerconn
-setCurrentTime now ep@EstablishedPeers { nextActivateTimes } =
-    let ep' = ep { nextActivateTimes = nextActivateTimes' }
+setCurrentTime now ep@EstablishedPeers { nextGossipTimes
+                                       , nextActivateTimes
+                                       }
+ -- Efficient check for the common case of there being nothing to do:
+  | Just (Min t) <- (f <$> PSQ.minView nextGossipTimes)
+                 <> (f <$> PSQ.minView nextActivateTimes)
+  , t > now
+  = ep
+  where
+    f (_,t,_,_) = Min t
+
+setCurrentTime now ep@EstablishedPeers { nextGossipTimes
+                                       , availableForGossip
+                                       , nextActivateTimes
+                                       } =
+  let ep' = ep { nextGossipTimes   = nextGossipTimes'
+               , availableForGossip = availableForGossip'
+               , nextActivateTimes = nextActivateTimes'
+               }
     in assert (invariant ep') ep'
   where
+    (nowAvailableForGossip, nextGossipTimes') =
+      PSQ.atMostView now nextGossipTimes
+
+    availableForGossip' =
+         availableForGossip
+      <> Set.fromList [ peeraddr | (peeraddr, _, _) <- nowAvailableForGossip ]
+
     (_, nextActivateTimes') = PSQ.atMostView now nextActivateTimes
 
 
@@ -185,3 +285,48 @@ setActivateTimes times ep@EstablishedPeers { nextActivateTimes } =
     in   assert (all (not . (`Set.member` readyPeers ep')) (Map.keys times))
        . assert (invariant ep')
        $ ep'
+
+-------------------------------
+-- Tracking when we can gossip
+--
+
+-- | The first time that a peer will become available for gossip. If peers are
+-- already available for gossip, or there are no peers at all then the
+-- result is @Nothing@.
+--
+minGossipTime :: Ord peeraddr => EstablishedPeers peeraddr peercon -> Maybe Time
+minGossipTime EstablishedPeers {
+                availableForGossip,
+                nextGossipTimes
+              }
+  | Set.null availableForGossip
+  , Just (_k, t, _, _psq) <- PSQ.minView nextGossipTimes
+  = Just t
+
+  | otherwise
+  = Nothing
+
+setGossipTime :: Ord peeraddr
+                 => Set peeraddr
+                 -> Time
+                 -> EstablishedPeers peeraddr peercon
+                 -> EstablishedPeers peeraddr peercon
+setGossipTime peeraddrs time
+                 ep@EstablishedPeers {
+                   allPeers,
+                   availableForGossip,
+                   nextGossipTimes
+                 } =
+    assert (all (`Map.member` allPeers) peeraddrs) $
+    let ep' = ep {
+          availableForGossip =
+                   availableForGossip
+            Set.\\ peeraddrs,
+
+          nextGossipTimes =
+            List.foldl' (\psq peeraddr -> PSQ.insert peeraddr time () psq)
+                        nextGossipTimes
+                        peeraddrs
+        }
+    in assert (invariant ep') ep'
+

ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs

@@ -49,6 +49,7 @@ belowTarget actions
             }
             st@PeerSelectionState {
               knownPeers,
+              establishedPeers,
               inProgressGossipReqs,
               targets = PeerSelectionTargets {
                           targetNumberOfKnownPeers
@@ -78,10 +79,10 @@ belowTarget actions
         decisionState = st {
                           inProgressGossipReqs = inProgressGossipReqs
                                                + numGossipReqs,
-                          knownPeers = KnownPeers.setGossipTime
-                                         selectedForGossip
-                                         (addTime policyGossipRetryTime now)
-                                         knownPeers
+                          establishedPeers = EstablishedPeers.setGossipTime
+                                              selectedForGossip
+                                              (addTime policyGossipRetryTime now)
+                                              establishedPeers
                         },
         decisionJobs  = [jobGossip actions policy
                            (Set.toList selectedForGossip)]
@@ -92,15 +93,15 @@ belowTarget actions
   | numKnownPeers < targetNumberOfKnownPeers
   , numGossipReqsPossible > 0
   , Set.null availableForGossip
-  = GuardedSkip (Min <$> KnownPeers.minGossipTime knownPeers)
+  = GuardedSkip (Min <$> EstablishedPeers.minGossipTime establishedPeers)
 
   | otherwise
   = GuardedSkip Nothing
   where
     numKnownPeers         = KnownPeers.size knownPeers
     numGossipReqsPossible = policyMaxInProgressGossipReqs
                           - inProgressGossipReqs
-    availableForGossip    = KnownPeers.availableForGossip knownPeers
+    availableForGossip    = EstablishedPeers.availableForGossip establishedPeers
 
 
 jobGossip :: forall m peeraddr peerconn.