{-# LANGUAGE ScopedTypeVariables #-}

-- Constants used in 'Ouroboros.Network.Diffusion'
module Ouroboros.Network.Diffusion.Policies where

import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadTime.SI

import Data.List (sortOn, unfoldr)
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Word (Word32)
import System.Random
import System.Random qualified as Rnd

import Ouroboros.Network.Block (SlotNo)
import Ouroboros.Network.ConnectionManager.Types (ConnectionType (..),
           Provenance (..), PrunePolicy)
import Ouroboros.Network.ExitPolicy as ExitPolicy
import Ouroboros.Network.PeerSelection.Governor.Types
import Ouroboros.Network.PeerSelection.PeerMetric


-- | Timeout for 'spsDeactivateTimeout' and churn hot to warm demotions.
--
-- The maximal timeout on 'ChainSync' (in 'StMustReply' state) is @269s@,
-- see `maxChainSyncTimeout` below.
--
deactivateTimeout :: DiffTime
deactivateTimeout :: DiffTime
deactivateTimeout = DiffTime
300

-- | Timeout for 'spsCloseConnectionTimeout'.
--
-- This timeout depends on 'KeepAlive' and 'TipSample' timeouts.  'KeepAlive'
-- keeps agency most of the time, but 'TipSample' can give away its agency for
-- longer periods of time.  Here we allow it to get 6 blocks (assuming a new
-- block every @20s@).
--
closeConnectionTimeout :: DiffTime
closeConnectionTimeout :: DiffTime
closeConnectionTimeout = DiffTime
120

-- | Churn timeouts after 60s trying to establish a connection.
--
-- This doesn't mean the connection is terminated after it, just churns moves
-- on.
--
churnEstablishConnectionTimeout :: DiffTime
churnEstablishConnectionTimeout :: DiffTime
churnEstablishConnectionTimeout = DiffTime
60


-- | Number of events tracked by 'PeerMetrics'.  This corresponds to one hour of
-- blocks on mainnet.
--
-- TODO: issue #3866
--
peerMetricsConfiguration :: PeerMetricsConfiguration
peerMetricsConfiguration :: PeerMetricsConfiguration
peerMetricsConfiguration = PeerMetricsConfiguration {
    maxEntriesToTrack :: Int
maxEntriesToTrack = Int
180
  }


-- | Minimal delay between adding inbound peers to known set of outbound
-- governor.
--
-- It is set to 60s, the same as the peer sharing request timeout.
--
inboundPeersRetryDelay :: DiffTime
inboundPeersRetryDelay :: DiffTime
inboundPeersRetryDelay = DiffTime
60


-- | Maximal number of light peers included at once.
--
maxInboundPeers :: Int
maxInboundPeers :: Int
maxInboundPeers = Int
10


-- | Delay before a peer is re-promoted by the outbound-governor after an
-- error.
--
repromoteErrorDelay :: RepromoteDelay
repromoteErrorDelay :: RepromoteDelay
repromoteErrorDelay = RepromoteDelay
10


-- | Merge two dictionaries where values of the first one are obligatory, while
-- the second one are optional.
--
optionalMerge
    :: Ord k
    => Map k a
    -> Map k b
    -> Map k (a, Maybe b)
optionalMerge :: forall k a b. Ord k => Map k a -> Map k b -> Map k (a, Maybe b)
optionalMerge = SimpleWhenMissing k a (a, Maybe b)
-> SimpleWhenMissing k b (a, Maybe b)
-> SimpleWhenMatched k a b (a, Maybe b)
-> Map k a
-> Map k b
-> Map k (a, Maybe b)
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge ((k -> a -> (a, Maybe b)) -> SimpleWhenMissing k a (a, Maybe b)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\k
_ a
a -> (a
a, Maybe b
forall a. Maybe a
Nothing)))
                           SimpleWhenMissing k b (a, Maybe b)
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
                          ((k -> a -> b -> (a, Maybe b))
-> SimpleWhenMatched k a b (a, Maybe b)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\k
_ a
a b
b -> (a
a, b -> Maybe b
forall a. a -> Maybe a
Just b
b)))



-- | The score by which 'simplePeerSelectionPolicy' ranks hot peers for
-- demotion: the peer's 'upstreamyness' plus its 'fetchynessBlocks', with
-- 'joinedPeerMetricAt' as the tie-break.
--
deadlineHotScores :: (MonadSTM m, Ord peerAddr)
                  => PeerMetrics m peerAddr
                  -> STM m (Map peerAddr (Int, Maybe SlotNo))
deadlineHotScores :: forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
PeerMetrics m peerAddr -> STM m (Map peerAddr (Int, Maybe SlotNo))
deadlineHotScores PeerMetrics m peerAddr
metrics = do
    jpm <- PeerMetrics m peerAddr -> STM m (Map peerAddr SlotNo)
forall p (m :: * -> *).
(MonadSTM m, Ord p) =>
PeerMetrics m p -> STM m (Map p SlotNo)
joinedPeerMetricAt PeerMetrics m peerAddr
metrics
    hup <- upstreamyness metrics
    bup <- fetchynessBlocks metrics
    return $ Map.unionWith (+) hup bup `optionalMerge` jpm


-- | A hot demotion policy which picks the lowest scoring peers, and returns
-- the scores it ranked them by so that the governor can trace the decision.
-- A peer without a score is ranked as if it scored 0 but before every peer
-- which did, and is returned as 'Nothing' so that the trace keeps the two
-- apart.
--
mkHotDemotionPolicy :: (MonadSTM m, Ord peerAddr)
                    => StrictTVar m StdGen
                    -> STM m (Map peerAddr (Int, Maybe SlotNo))
                    -- ^ the scores, with a slot number as the tie-break, see
                    -- 'joinedPeerMetricAt'
                    -> HotDemotionPolicy peerAddr (STM m)
mkHotDemotionPolicy :: forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> STM m (Map peerAddr (Int, Maybe SlotNo))
-> HotDemotionPolicy peerAddr (STM m)
mkHotDemotionPolicy StrictTVar m StdGen
rngVar STM m (Map peerAddr (Int, Maybe SlotNo))
hotScores peerAddr -> PeerSource
_ peerAddr -> Int
_ peerAddr -> Bool
_ Set peerAddr
available Int
pickNum = do
    scores     <- STM m (Map peerAddr (Int, Maybe SlotNo))
hotScores
    available' <- addRand rngVar available (,)
    let picked = [peerAddr] -> Set peerAddr
forall a. Ord a => [a] -> Set a
Set.fromList
               ([peerAddr] -> Set peerAddr)
-> (Map peerAddr Word32 -> [peerAddr])
-> Map peerAddr Word32
-> Set peerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((peerAddr, Word32) -> peerAddr)
-> [(peerAddr, Word32)] -> [peerAddr]
forall a b. (a -> b) -> [a] -> [b]
map (peerAddr, Word32) -> peerAddr
forall a b. (a, b) -> a
fst
               ([(peerAddr, Word32)] -> [peerAddr])
-> (Map peerAddr Word32 -> [(peerAddr, Word32)])
-> Map peerAddr Word32
-> [peerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(peerAddr, Word32)] -> [(peerAddr, Word32)]
forall a. Int -> [a] -> [a]
take Int
pickNum
                 -- order the results, resolve the ties using slot number when
                 -- a peer joined the leader board.
                 --
                 -- note: this will prefer to preserve newer peers, whose results
                 -- less certain than peers who entered leader board earlier.
               ([(peerAddr, Word32)] -> [(peerAddr, Word32)])
-> (Map peerAddr Word32 -> [(peerAddr, Word32)])
-> Map peerAddr Word32
-> [(peerAddr, Word32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((peerAddr, Word32) -> ((Int, Maybe SlotNo), Word32))
-> [(peerAddr, Word32)] -> [(peerAddr, Word32)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(peerAddr
peer, Word32
rn) ->
                            ((Int, Maybe SlotNo)
-> peerAddr
-> Map peerAddr (Int, Maybe SlotNo)
-> (Int, Maybe SlotNo)
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (Int
0, Maybe SlotNo
forall a. Maybe a
Nothing) peerAddr
peer Map peerAddr (Int, Maybe SlotNo)
scores, Word32
rn))
               ([(peerAddr, Word32)] -> [(peerAddr, Word32)])
-> (Map peerAddr Word32 -> [(peerAddr, Word32)])
-> Map peerAddr Word32
-> [(peerAddr, Word32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map peerAddr Word32 -> [(peerAddr, Word32)]
forall k a. Map k a -> [(k, a)]
Map.assocs
               (Map peerAddr Word32 -> Set peerAddr)
-> Map peerAddr Word32 -> Set peerAddr
forall a b. (a -> b) -> a -> b
$ Map peerAddr Word32
available'
    return ( picked
           , Map.fromSet (\peerAddr
peer -> (Int, Maybe SlotNo) -> Int
forall a b. (a, b) -> a
fst ((Int, Maybe SlotNo) -> Int)
-> Maybe (Int, Maybe SlotNo) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> peerAddr
-> Map peerAddr (Int, Maybe SlotNo) -> Maybe (Int, Maybe SlotNo)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peer Map peerAddr (Int, Maybe SlotNo)
scores) available
           )


simplePeerSelectionPolicy :: forall m peerAddr.
                             ( MonadSTM m
                             , Ord peerAddr
                             )
                          => StrictTVar m StdGen
                          -> PeerMetrics m peerAddr
                          -> PeerSelectionPolicy peerAddr m
simplePeerSelectionPolicy :: forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> PeerMetrics m peerAddr -> PeerSelectionPolicy peerAddr m
simplePeerSelectionPolicy StrictTVar m StdGen
rngVar PeerMetrics m peerAddr
metrics = PeerSelectionPolicy {
      policyPickKnownPeersForPeerShare :: PickPolicy peerAddr (STM m)
policyPickKnownPeersForPeerShare = PickPolicy peerAddr (STM m)
simplePromotionPolicy,
      policyPickColdPeersToPromote :: PickPolicy peerAddr (STM m)
policyPickColdPeersToPromote     = PickPolicy peerAddr (STM m)
simplePromotionPolicy,
      policyPickWarmPeersToPromote :: PickPolicy peerAddr (STM m)
policyPickWarmPeersToPromote     = PickPolicy peerAddr (STM m)
warmPromotionPolicy,
      policyPickInboundPeers :: PickPolicy peerAddr (STM m)
policyPickInboundPeers           = PickPolicy peerAddr (STM m)
simplePromotionPolicy,

      policyPickHotPeersToDemote :: HotDemotionPolicy peerAddr (STM m)
policyPickHotPeersToDemote  = StrictTVar m StdGen
-> STM m (Map peerAddr (Int, Maybe SlotNo))
-> HotDemotionPolicy peerAddr (STM m)
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> STM m (Map peerAddr (Int, Maybe SlotNo))
-> HotDemotionPolicy peerAddr (STM m)
mkHotDemotionPolicy StrictTVar m StdGen
rngVar (PeerMetrics m peerAddr -> STM m (Map peerAddr (Int, Maybe SlotNo))
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
PeerMetrics m peerAddr -> STM m (Map peerAddr (Int, Maybe SlotNo))
deadlineHotScores PeerMetrics m peerAddr
metrics),
      policyPickWarmPeersToDemote :: PickPolicy peerAddr (STM m)
policyPickWarmPeersToDemote = PickPolicy peerAddr (STM m)
warmDemotionPolicy,
      policyPickColdPeersToForget :: PickPolicy peerAddr (STM m)
policyPickColdPeersToForget = PickPolicy peerAddr (STM m)
coldForgetPolicy,

      policyFindPublicRootTimeout :: DiffTime
policyFindPublicRootTimeout      = DiffTime
5,    -- seconds
      policyMaxInProgressPeerShareReqs :: Int
policyMaxInProgressPeerShareReqs = Int
2,
      policyPeerShareRetryTime :: DiffTime
policyPeerShareRetryTime         = DiffTime
900,  -- seconds
      policyPeerShareFailureRetryTime :: DiffTime
policyPeerShareFailureRetryTime  = DiffTime
3600, -- seconds (4x)
      policyPeerShareBatchWaitTime :: DiffTime
policyPeerShareBatchWaitTime     = DiffTime
3,    -- seconds
      policyPeerShareOverallTimeout :: DiffTime
policyPeerShareOverallTimeout    = DiffTime
10,   -- seconds
      policyPeerShareActivationDelay :: DiffTime
policyPeerShareActivationDelay   = DiffTime
300,  -- seconds
      policyMaxConnectionRetries :: Int
policyMaxConnectionRetries       = Int
5,
      policyClearFailCountDelay :: DiffTime
policyClearFailCountDelay        = DiffTime
120   -- seconds
    }
  where

    -- Randomly pick peers to demote. Halving r for peers with
    -- knownPeerTepid set makes a tepid peer win a pairwise draw against a
    -- non-tepid one with probability 3/4.
    warmDemotionPolicy :: PickPolicy peerAddr (STM m)
    warmDemotionPolicy :: PickPolicy peerAddr (STM m)
warmDemotionPolicy peerAddr -> PeerSource
_ peerAddr -> Int
_ peerAddr -> Bool
isTepid Set peerAddr
available Int
pickNum = do
      available' <- StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand StrictTVar m StdGen
rngVar Set peerAddr
available ((peerAddr -> Bool) -> peerAddr -> Word32 -> (peerAddr, Word32)
tepidWeight peerAddr -> Bool
isTepid)
      return $ Set.fromList
             . map fst
             . take pickNum
             . sortOn snd
             . Map.assocs
             $ available'


    -- Randomly pick peers to forget, peers with failures are more likely to
    -- be forgotten.
    coldForgetPolicy :: PickPolicy peerAddr (STM m)
    coldForgetPolicy :: PickPolicy peerAddr (STM m)
coldForgetPolicy peerAddr -> PeerSource
_ peerAddr -> Int
failCnt peerAddr -> Bool
_ Set peerAddr
available Int
pickNum = do
      available' <- StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand StrictTVar m StdGen
rngVar Set peerAddr
available ((peerAddr -> Int) -> peerAddr -> Word32 -> (peerAddr, Word32)
failWeight peerAddr -> Int
failCnt)
      return $ Set.fromList
             . map fst
             . take pickNum
             . sortOn snd
             . Map.assocs
             $ available'

    -- Randomly pick warm peers to promote, peers with knownPeerTepid set
    -- are less likely to be re-promoted.
    warmPromotionPolicy :: PickPolicy peerAddr (STM m)
    warmPromotionPolicy :: PickPolicy peerAddr (STM m)
warmPromotionPolicy peerAddr -> PeerSource
_ peerAddr -> Int
_ peerAddr -> Bool
isTepid Set peerAddr
available Int
pickNum = do
      available' <- StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand StrictTVar m StdGen
rngVar Set peerAddr
available ((peerAddr -> Bool) -> peerAddr -> Word32 -> (peerAddr, Word32)
promoteWeight peerAddr -> Bool
isTepid)
      return $ Set.fromList
             . map fst
             . take pickNum
             . sortOn snd
             . Map.assocs
             $ available'

    simplePromotionPolicy :: PickPolicy peerAddr (STM m)
    simplePromotionPolicy :: PickPolicy peerAddr (STM m)
simplePromotionPolicy peerAddr -> PeerSource
_ peerAddr -> Int
_ peerAddr -> Bool
_ Set peerAddr
available Int
pickNum = do
      available' <- StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand StrictTVar m StdGen
rngVar Set peerAddr
available (,)
      return $ Set.fromList
             . map fst
             . take pickNum
             . sortOn snd
             . Map.assocs
             $ available'

    -- Failures lowers r
    failWeight :: (peerAddr -> Int)
                -> peerAddr
                -> Word32
                -> (peerAddr, Word32)
    failWeight :: (peerAddr -> Int) -> peerAddr -> Word32 -> (peerAddr, Word32)
failWeight peerAddr -> Int
failCnt peerAddr
peer Word32
r =
        (peerAddr
peer, Word32
r Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (peerAddr -> Int
failCnt peerAddr
peer Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

    -- Tepid flag cuts r in half
    tepidWeight :: (peerAddr -> Bool)
                -> peerAddr
                -> Word32
                -> (peerAddr, Word32)
    tepidWeight :: (peerAddr -> Bool) -> peerAddr -> Word32 -> (peerAddr, Word32)
tepidWeight peerAddr -> Bool
isTepid peerAddr
peer Word32
r =
          if peerAddr -> Bool
isTepid peerAddr
peer then (peerAddr
peer, Word32
r Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
2)
                          else (peerAddr
peer, Word32
r)

    -- The inverse of 'tepidWeight': everyone else's r is quartered. The
    -- lowest r wins, so a tepid peer beats one non-tepid peer with
    -- probability 1/8, and a larger pool with less.
    promoteWeight :: (peerAddr -> Bool)
                  -> peerAddr
                  -> Word32
                  -> (peerAddr, Word32)
    promoteWeight :: (peerAddr -> Bool) -> peerAddr -> Word32 -> (peerAddr, Word32)
promoteWeight peerAddr -> Bool
isTepid peerAddr
peer Word32
r =
          if peerAddr -> Bool
isTepid peerAddr
peer then (peerAddr
peer, Word32
r)
                          else (peerAddr
peer, Word32
r Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
4)


 -- Add scaled random number in order to prevent ordering based on SockAddr
addRand :: ( MonadSTM m
           , Ord peerAddr
           )
        => StrictTVar m StdGen
        -> Set.Set peerAddr
        -> (peerAddr -> Word32 -> (peerAddr, Word32))
        -> STM m (Map.Map peerAddr Word32)
addRand :: forall (m :: * -> *) peerAddr.
(MonadSTM m, Ord peerAddr) =>
StrictTVar m StdGen
-> Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand StrictTVar m StdGen
rngVar Set peerAddr
available peerAddr -> Word32 -> (peerAddr, Word32)
scaleFn = do
  inRng <- StrictTVar m StdGen -> STM m StdGen
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m StdGen
rngVar

  let (rng, rng') = splitGen inRng
      rns = Int -> [Word32] -> [Word32]
forall a. Int -> [a] -> [a]
take (Set peerAddr -> Int
forall a. Set a -> Int
Set.size Set peerAddr
available) ([Word32] -> [Word32]) -> [Word32] -> [Word32]
forall a b. (a -> b) -> a -> b
$ (StdGen -> Maybe (Word32, StdGen)) -> StdGen -> [Word32]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ((Word32, StdGen) -> Maybe (Word32, StdGen)
forall a. a -> Maybe a
Just ((Word32, StdGen) -> Maybe (Word32, StdGen))
-> (StdGen -> (Word32, StdGen)) -> StdGen -> Maybe (Word32, StdGen)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> (Word32, StdGen)
forall g. RandomGen g => g -> (Word32, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random)  StdGen
rng :: [Word32]
      available' = [(peerAddr, Word32)] -> Map peerAddr Word32
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(peerAddr, Word32)] -> Map peerAddr Word32)
-> [(peerAddr, Word32)] -> Map peerAddr Word32
forall a b. (a -> b) -> a -> b
$ (peerAddr -> Word32 -> (peerAddr, Word32))
-> [peerAddr] -> [Word32] -> [(peerAddr, Word32)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith peerAddr -> Word32 -> (peerAddr, Word32)
scaleFn (Set peerAddr -> [peerAddr]
forall a. Set a -> [a]
Set.toList Set peerAddr
available) [Word32]
rns
  writeTVar rngVar rng'
  return available'

--
-- PrunePolicy
--

-- | Sort by upstreamness and a random score.
--
-- Note: this 'PrunePolicy' does not depend on 'igsConnections'.  We put
-- 'igsPrng' in 'InboundGovernorState' only to show that we can have
-- a 'PrunePolicy' which depends on the 'InboundGovernorState' as a more
-- refined policy would do.
--
-- /complexity:/ \(\mathcal{O}(n\log\;n)\)
--
-- TODO: complexity could be improved.
--
prunePolicy :: Ord peerAddr
            => PrunePolicy peerAddr
prunePolicy :: forall peerAddr. Ord peerAddr => PrunePolicy peerAddr
prunePolicy StdGen
prng Map (ConnectionId peerAddr) ConnectionType
mp Int
n =
        [ConnectionId peerAddr] -> Set (ConnectionId peerAddr)
forall a. Ord a => [a] -> Set a
Set.fromList
      ([ConnectionId peerAddr] -> Set (ConnectionId peerAddr))
-> ([Int] -> [ConnectionId peerAddr])
-> [Int]
-> Set (ConnectionId peerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ConnectionId peerAddr] -> [ConnectionId peerAddr]
forall a. Int -> [a] -> [a]
take Int
n
      ([ConnectionId peerAddr] -> [ConnectionId peerAddr])
-> ([Int] -> [ConnectionId peerAddr])
-> [Int]
-> [ConnectionId peerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((ConnectionId peerAddr, ConnectionType), Int)
 -> ConnectionId peerAddr)
-> [((ConnectionId peerAddr, ConnectionType), Int)]
-> [ConnectionId peerAddr]
forall a b. (a -> b) -> [a] -> [b]
map ((ConnectionId peerAddr, ConnectionType) -> ConnectionId peerAddr
forall a b. (a, b) -> a
fst ((ConnectionId peerAddr, ConnectionType) -> ConnectionId peerAddr)
-> (((ConnectionId peerAddr, ConnectionType), Int)
    -> (ConnectionId peerAddr, ConnectionType))
-> ((ConnectionId peerAddr, ConnectionType), Int)
-> ConnectionId peerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ConnectionId peerAddr, ConnectionType), Int)
-> (ConnectionId peerAddr, ConnectionType)
forall a b. (a, b) -> a
fst)
      -- 'True' values (upstream / outbound connections) will sort last.
      ([((ConnectionId peerAddr, ConnectionType), Int)]
 -> [ConnectionId peerAddr])
-> ([Int] -> [((ConnectionId peerAddr, ConnectionType), Int)])
-> [Int]
-> [ConnectionId peerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((ConnectionId peerAddr, ConnectionType), Int)
 -> (Bool, Int, ConnectionType))
-> [((ConnectionId peerAddr, ConnectionType), Int)]
-> [((ConnectionId peerAddr, ConnectionType), Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\((ConnectionId peerAddr
_, ConnectionType
connType), Int
score) -> (ConnectionType -> Bool
isUpstream ConnectionType
connType, Int
score, ConnectionType
connType))
      ([((ConnectionId peerAddr, ConnectionType), Int)]
 -> [((ConnectionId peerAddr, ConnectionType), Int)])
-> ([Int] -> [((ConnectionId peerAddr, ConnectionType), Int)])
-> [Int]
-> [((ConnectionId peerAddr, ConnectionType), Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ConnectionId peerAddr, ConnectionType)]
-> [Int] -> [((ConnectionId peerAddr, ConnectionType), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map (ConnectionId peerAddr) ConnectionType
-> [(ConnectionId peerAddr, ConnectionType)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map (ConnectionId peerAddr) ConnectionType
mp)
      ([Int] -> Set (ConnectionId peerAddr))
-> [Int] -> Set (ConnectionId peerAddr)
forall a b. (a -> b) -> a -> b
$ (StdGen -> [Int]
forall g. RandomGen g => g -> [Int]
forall a g. (Random a, RandomGen g) => g -> [a]
Rnd.randoms StdGen
prng :: [Int])
  where
    isUpstream :: ConnectionType -> Bool
    isUpstream :: ConnectionType -> Bool
isUpstream = \ConnectionType
connType ->
      case ConnectionType
connType of
        UnnegotiatedConn Provenance
Outbound -> Bool
True
        UnnegotiatedConn Provenance
Inbound  -> Bool
False
        OutboundIdleConn DataFlow
_        -> Bool
True
        InboundIdleConn         DataFlow
_ -> Bool
False
        NegotiatedConn Provenance
Outbound DataFlow
_ -> Bool
True
        NegotiatedConn Provenance
Inbound  DataFlow
_ -> Bool
False
        ConnectionType
DuplexConn                -> Bool
True