{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

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

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

import           Ouroboros.Network.ConnectionManager.Types (ConnectionType (..),
                     Provenance (..), PrunePolicy)
import           Ouroboros.Network.InboundGovernor
                     (InboundGovernorObservableState (..))
import           Ouroboros.Network.PeerSelection.Governor.Types
import           Ouroboros.Network.PeerSelection.PeerMetric


-- | Timeout for 'spsDeactivateTimeout'.
--
-- The maximal timeout on 'ChainSync' (in 'StMustReply' state) is @269s@.
--
deactivateTimeout :: DiffTime
deactivateTimeout :: DiffTime
deactivateTimeout = DiffTime
300

-- | Timeout for 'spsCloseConnectionTimeout'.
--
-- This timeout depends on 'KeepAlive' and 'TipSample' timeouts.  'KeepAlive'
-- keeps agancy 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


simplePeerSelectionPolicy :: forall m peerAddr.
                             ( MonadSTM m
                             , Ord peerAddr
                             )
                          => StrictTVar m StdGen
                          -> STM m ChurnMode
                          -> PeerMetrics m peerAddr
                          -> PeerSelectionPolicy peerAddr m
simplePeerSelectionPolicy :: StrictTVar m StdGen
-> STM m ChurnMode
-> PeerMetrics m peerAddr
-> PeerSelectionPolicy peerAddr m
simplePeerSelectionPolicy StrictTVar m StdGen
rngVar STM m ChurnMode
getChurnMode PeerMetrics m peerAddr
metrics = PeerSelectionPolicy :: forall peeraddr (m :: * -> *).
PickPolicy peeraddr m
-> PickPolicy peeraddr m
-> PickPolicy peeraddr m
-> PickPolicy peeraddr m
-> PickPolicy peeraddr m
-> PickPolicy peeraddr m
-> DiffTime
-> Int
-> DiffTime
-> DiffTime
-> DiffTime
-> PeerSelectionPolicy peeraddr m
PeerSelectionPolicy {
      policyPickKnownPeersForGossip :: PickPolicy peerAddr m
policyPickKnownPeersForGossip = PickPolicy peerAddr m
simplePromotionPolicy,
      policyPickColdPeersToPromote :: PickPolicy peerAddr m
policyPickColdPeersToPromote  = PickPolicy peerAddr m
simplePromotionPolicy,
      policyPickWarmPeersToPromote :: PickPolicy peerAddr m
policyPickWarmPeersToPromote  = PickPolicy peerAddr m
simplePromotionPolicy,

      policyPickHotPeersToDemote :: PickPolicy peerAddr m
policyPickHotPeersToDemote    = PickPolicy peerAddr m
hotDemotionPolicy,
      policyPickWarmPeersToDemote :: PickPolicy peerAddr m
policyPickWarmPeersToDemote   = PickPolicy peerAddr m
warmDemotionPolicy,
      policyPickColdPeersToForget :: PickPolicy peerAddr m
policyPickColdPeersToForget   = PickPolicy peerAddr m
coldForgetPolicy,

      policyFindPublicRootTimeout :: DiffTime
policyFindPublicRootTimeout   = DiffTime
5,    -- seconds
      policyMaxInProgressGossipReqs :: Int
policyMaxInProgressGossipReqs = Int
2,
      policyGossipRetryTime :: DiffTime
policyGossipRetryTime         = DiffTime
3600, -- seconds
      policyGossipBatchWaitTime :: DiffTime
policyGossipBatchWaitTime     = DiffTime
3,    -- seconds
      policyGossipOverallTimeout :: DiffTime
policyGossipOverallTimeout    = DiffTime
10    -- seconds
    }
  where

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

      let (StdGen
rng, StdGen
rng') = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
inRng
          rns :: [Word32]
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 a g. (Random a, RandomGen g) => g -> (a, g)
random)  StdGen
rng :: [Word32]
          available' :: Map peerAddr 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
      StrictTVar m StdGen -> StdGen -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m StdGen
rngVar StdGen
rng'
      Map peerAddr Word32 -> STM m (Map peerAddr Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Map peerAddr Word32
available'

    hotDemotionPolicy :: PickPolicy peerAddr m
    hotDemotionPolicy :: PickPolicy peerAddr m
hotDemotionPolicy peerAddr -> PeerSource
_ peerAddr -> Int
_ peerAddr -> Bool
_ Set peerAddr
available Int
pickNum = do
        ChurnMode
mode <- STM m ChurnMode
getChurnMode
        Map peerAddr Int
scores <- case ChurnMode
mode of
                       ChurnMode
ChurnModeNormal -> do
                           Map peerAddr Int
hup <- SlotMetric peerAddr -> Map peerAddr Int
forall p. Ord p => SlotMetric p -> Map p Int
upstreamyness (SlotMetric peerAddr -> Map peerAddr Int)
-> STM m (SlotMetric peerAddr) -> STM m (Map peerAddr Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerMetrics m peerAddr -> STM m (SlotMetric peerAddr)
forall (m :: * -> *) p.
MonadSTM m =>
PeerMetrics m p -> STM m (SlotMetric p)
getHeaderMetrics PeerMetrics m peerAddr
metrics
                           Map peerAddr Int
bup <- SlotMetric (peerAddr, Word32) -> Map peerAddr Int
forall p. Ord p => SlotMetric (p, Word32) -> Map p Int
fetchynessBlocks (SlotMetric (peerAddr, Word32) -> Map peerAddr Int)
-> STM m (SlotMetric (peerAddr, Word32))
-> STM m (Map peerAddr Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerMetrics m peerAddr -> STM m (SlotMetric (peerAddr, Word32))
forall (m :: * -> *) p.
MonadSTM m =>
PeerMetrics m p -> STM m (SlotMetric (p, Word32))
getFetchedMetrics PeerMetrics m peerAddr
metrics
                           Map peerAddr Int -> STM m (Map peerAddr Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map peerAddr Int -> STM m (Map peerAddr Int))
-> Map peerAddr Int -> STM m (Map peerAddr Int)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int)
-> Map peerAddr Int -> Map peerAddr Int -> Map peerAddr Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Map peerAddr Int
hup Map peerAddr Int
bup

                       ChurnMode
ChurnModeBulkSync ->
                           SlotMetric (peerAddr, Word32) -> Map peerAddr Int
forall p. Ord p => SlotMetric (p, Word32) -> Map p Int
fetchynessBytes (SlotMetric (peerAddr, Word32) -> Map peerAddr Int)
-> STM m (SlotMetric (peerAddr, Word32))
-> STM m (Map peerAddr Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerMetrics m peerAddr -> STM m (SlotMetric (peerAddr, Word32))
forall (m :: * -> *) p.
MonadSTM m =>
PeerMetrics m p -> STM m (SlotMetric (p, Word32))
getFetchedMetrics PeerMetrics m peerAddr
metrics
        Map peerAddr Word32
available' <- Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand Set peerAddr
available (,)
        Set peerAddr -> STM m (Set peerAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set peerAddr -> STM m (Set peerAddr))
-> Set peerAddr -> STM m (Set peerAddr)
forall a b. (a -> b) -> a -> b
$ [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
             ([(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, Word32))
-> [(peerAddr, Word32)] -> [(peerAddr, Word32)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(peerAddr
peer, Word32
rn) ->
                          (Int -> peerAddr -> Map peerAddr Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Int
0 peerAddr
peer Map peerAddr Int
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'

    -- Randomly pick peers to demote, peeers with knownPeerTepid set are twice
    -- as likely to be demoted.
    warmDemotionPolicy :: PickPolicy peerAddr m
    warmDemotionPolicy :: PickPolicy peerAddr m
warmDemotionPolicy peerAddr -> PeerSource
_ peerAddr -> Int
_ peerAddr -> Bool
isTepid Set peerAddr
available Int
pickNum = do
      Map peerAddr Word32
available' <- Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand Set peerAddr
available ((peerAddr -> Bool) -> peerAddr -> Word32 -> (peerAddr, Word32)
tepidWeight peerAddr -> Bool
isTepid)
      Set peerAddr -> STM m (Set peerAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set peerAddr -> STM m (Set peerAddr))
-> Set peerAddr -> STM m (Set peerAddr)
forall a b. (a -> b) -> a -> b
$ [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
             ([(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) -> Word32)
-> [(peerAddr, Word32)] -> [(peerAddr, Word32)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (peerAddr, Word32) -> Word32
forall a b. (a, b) -> b
snd
             ([(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'


    -- Randomly pick peers to forget, peers with failures are more likely to
    -- be forgotten.
    coldForgetPolicy :: PickPolicy peerAddr m
    coldForgetPolicy :: PickPolicy peerAddr m
coldForgetPolicy peerAddr -> PeerSource
_ peerAddr -> Int
failCnt peerAddr -> Bool
_ Set peerAddr
available Int
pickNum = do
      Map peerAddr Word32
available' <- Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand Set peerAddr
available ((peerAddr -> Int) -> peerAddr -> Word32 -> (peerAddr, Word32)
failWeight peerAddr -> Int
failCnt)
      Set peerAddr -> STM m (Set peerAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set peerAddr -> STM m (Set peerAddr))
-> Set peerAddr -> STM m (Set peerAddr)
forall a b. (a -> b) -> a -> b
$ [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
             ([(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) -> Word32)
-> [(peerAddr, Word32)] -> [(peerAddr, Word32)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (peerAddr, Word32) -> Word32
forall a b. (a, b) -> b
snd
             ([(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'

    simplePromotionPolicy :: PickPolicy peerAddr m
    simplePromotionPolicy :: PickPolicy peerAddr m
simplePromotionPolicy peerAddr -> PeerSource
_ peerAddr -> Int
_ peerAddr -> Bool
_ Set peerAddr
available Int
pickNum = do
      Map peerAddr Word32
available' <- Set peerAddr
-> (peerAddr -> Word32 -> (peerAddr, Word32))
-> STM m (Map peerAddr Word32)
addRand Set peerAddr
available (,)
      Set peerAddr -> STM m (Set peerAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set peerAddr -> STM m (Set peerAddr))
-> Set peerAddr -> STM m (Set peerAddr)
forall a b. (a -> b) -> a -> b
$ [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
             ([(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) -> Word32)
-> [(peerAddr, Word32)] -> [(peerAddr, Word32)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (peerAddr, Word32) -> Word32
forall a b. (a, b) -> b
snd
             ([(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'

    -- 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)


--
-- 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 :: ( MonadSTM m
               , Ord peerAddr
               )
            => StrictTVar m InboundGovernorObservableState
            -> PrunePolicy peerAddr (STM m)
prunePolicy :: StrictTVar m InboundGovernorObservableState
-> PrunePolicy peerAddr (STM m)
prunePolicy StrictTVar m InboundGovernorObservableState
stateVar Map peerAddr ConnectionType
mp Int
n = do
    InboundGovernorObservableState
state <- StrictTVar m InboundGovernorObservableState
-> STM m InboundGovernorObservableState
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m InboundGovernorObservableState
stateVar
    let (StdGen
prng', StdGen
prng'') = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
Rnd.split (InboundGovernorObservableState -> StdGen
igosPrng InboundGovernorObservableState
state)
    StrictTVar m InboundGovernorObservableState
-> InboundGovernorObservableState -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m InboundGovernorObservableState
stateVar (InboundGovernorObservableState
state { igosPrng :: StdGen
igosPrng = StdGen
prng'' })

    Set peerAddr -> STM m (Set peerAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return
      (Set peerAddr -> STM m (Set peerAddr))
-> Set peerAddr -> STM m (Set peerAddr)
forall a b. (a -> b) -> a -> b
$ [peerAddr] -> Set peerAddr
forall a. Ord a => [a] -> Set a
Set.fromList
      ([peerAddr] -> Set peerAddr)
-> ([Int] -> [peerAddr]) -> [Int] -> Set peerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [peerAddr] -> [peerAddr]
forall a. Int -> [a] -> [a]
take Int
n
      ([peerAddr] -> [peerAddr])
-> ([Int] -> [peerAddr]) -> [Int] -> [peerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((peerAddr, ConnectionType), Int) -> peerAddr)
-> [((peerAddr, ConnectionType), Int)] -> [peerAddr]
forall a b. (a -> b) -> [a] -> [b]
map ((peerAddr, ConnectionType) -> peerAddr
forall a b. (a, b) -> a
fst ((peerAddr, ConnectionType) -> peerAddr)
-> (((peerAddr, ConnectionType), Int)
    -> (peerAddr, ConnectionType))
-> ((peerAddr, ConnectionType), Int)
-> peerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((peerAddr, ConnectionType), Int) -> (peerAddr, ConnectionType)
forall a b. (a, b) -> a
fst)
      -- 'True' values (upstream / outbound connections) will sort last.
      ([((peerAddr, ConnectionType), Int)] -> [peerAddr])
-> ([Int] -> [((peerAddr, ConnectionType), Int)])
-> [Int]
-> [peerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((peerAddr, ConnectionType), Int) -> (Bool, Int, ConnectionType))
-> [((peerAddr, ConnectionType), Int)]
-> [((peerAddr, ConnectionType), Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\((peerAddr
_, ConnectionType
connType), Int
score) -> (ConnectionType -> Bool
isUpstream ConnectionType
connType, Int
score, ConnectionType
connType))
      ([((peerAddr, ConnectionType), Int)]
 -> [((peerAddr, ConnectionType), Int)])
-> ([Int] -> [((peerAddr, ConnectionType), Int)])
-> [Int]
-> [((peerAddr, ConnectionType), Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(peerAddr, ConnectionType)]
-> [Int] -> [((peerAddr, ConnectionType), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map peerAddr ConnectionType -> [(peerAddr, ConnectionType)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map peerAddr ConnectionType
mp)
      ([Int] -> Set peerAddr) -> [Int] -> Set peerAddr
forall a b. (a -> b) -> a -> b
$ (StdGen -> [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