{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ouroboros.Network.PeerSelection.Governor.ActivePeers
  ( belowTarget
  , aboveTarget
  , jobDemoteActivePeer
  ) where

import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Semigroup (Min (..))
import           Data.Set (Set)
import qualified Data.Set as Set

import           Control.Concurrent.JobPool (Job (..))
import           Control.Exception (SomeException, assert)
import           Control.Monad.Class.MonadSTM
import           Control.Monad.Class.MonadTime
import           Control.Monad.Class.MonadTimer
import           System.Random (randomR)

import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as EstablishedPeers
import           Ouroboros.Network.PeerSelection.Governor.Types
import           Ouroboros.Network.PeerSelection.KnownPeers (setTepidFlag)
import qualified Ouroboros.Network.PeerSelection.KnownPeers as KnownPeers
import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers


----------------------------
-- Active peers below target
--


-- | If we are below the target of /hot peers/ we promote some of the /warm
-- peers/ according to 'policyPickWarmPeersToPromote' policy.
--
belowTarget :: forall peeraddr peerconn m.
               (MonadDelay m, MonadSTM m, Ord peeraddr)
            => PeerSelectionActions peeraddr peerconn m
            -> MkGuardedDecision peeraddr peerconn m
belowTarget :: PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
belowTarget = PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
forall peeraddr peerconn (m :: * -> *).
(MonadDelay m, MonadSTM m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
belowTargetLocal (PeerSelectionActions peeraddr peerconn m
 -> MkGuardedDecision peeraddr peerconn m)
-> (PeerSelectionActions peeraddr peerconn m
    -> MkGuardedDecision peeraddr peerconn m)
-> PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
forall a. Semigroup a => a -> a -> a
<> PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
forall peeraddr peerconn (m :: * -> *).
(MonadDelay m, MonadSTM m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
belowTargetOther


belowTargetLocal :: forall peeraddr peerconn m.
                    (MonadDelay m, MonadSTM m, Ord peeraddr)
                 => PeerSelectionActions peeraddr peerconn m
                 -> MkGuardedDecision peeraddr peerconn m
belowTargetLocal :: PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
belowTargetLocal PeerSelectionActions peeraddr peerconn m
actions
                 PeerSelectionPolicy {
                   PickPolicy peeraddr m
policyPickWarmPeersToPromote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickWarmPeersToPromote :: PickPolicy peeraddr m
policyPickWarmPeersToPromote
                 }
                 st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                   LocalRootPeers peeraddr
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers :: LocalRootPeers peeraddr
localRootPeers,
                   EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers,
                   Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers :: Set peeraddr
activePeers,
                   Set peeraddr
inProgressPromoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm,
                   Set peeraddr
inProgressDemoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm
                 }
    -- Are there any groups of local peers that are below target?
  | Bool -> Bool
not ([(Int, Set peeraddr, Set peeraddr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Set peeraddr, Set peeraddr)]
groupsBelowTarget)
    -- We need this detailed check because it is not enough to check we are
    -- below an aggregate target. We can be above target for some groups
    -- and below for others.

    -- Are there any groups where we can pick members to promote?
  , let groupsAvailableToPromote :: [(Int, Set peeraddr)]
groupsAvailableToPromote =
          [ (Int
numMembersToPromote, Set peeraddr
membersAvailableToPromote)
          | let availableToPromote :: Set peeraddr
availableToPromote =
                  (LocalRootPeers peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers peeraddr
localRootPeers
                    Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection`
                   EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.readyPeers EstablishedPeers peeraddr peerconn
establishedPeers)
                     Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
activePeers
                     Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressPromoteWarm
                     Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressDemoteWarm
                numPromoteInProgress :: Int
numPromoteInProgress = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
inProgressPromoteWarm
          , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
availableToPromote)
          , (Int
target, Set peeraddr
members, Set peeraddr
membersActive) <- [(Int, Set peeraddr, Set peeraddr)]
groupsBelowTarget
          , let membersAvailableToPromote :: Set peeraddr
membersAvailableToPromote = Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
                                              Set peeraddr
members Set peeraddr
availableToPromote
                numMembersToPromote :: Int
numMembersToPromote       = Int
target
                                          Int -> Int -> Int
forall a. Num a => a -> a -> a
- Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
membersActive
                                          Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numPromoteInProgress
          , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
membersAvailableToPromote)
          , Int
numMembersToPromote Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
          ]
  , Bool -> Bool
not ([(Int, Set peeraddr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Set peeraddr)]
groupsAvailableToPromote)
  = Maybe (Min Time)
-> STM m (Time -> Decision m peeraddr peerconn)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> m a -> Guarded m a
Guarded Maybe (Min Time)
forall a. Maybe a
Nothing (STM m (Time -> Decision m peeraddr peerconn)
 -> Guarded (STM m) (Time -> Decision m peeraddr peerconn))
-> STM m (Time -> Decision m peeraddr peerconn)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ do
      Set peeraddr
selectedToPromote <-
        [Set peeraddr] -> Set peeraddr
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set peeraddr] -> Set peeraddr)
-> STM m [Set peeraddr] -> STM m (Set peeraddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [STM m (Set peeraddr)] -> STM m [Set peeraddr]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
          [ PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> STM m (Set peeraddr)
forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m) =>
PeerSelectionState peeraddr peerconn
-> ((peeraddr -> PeerSource)
    -> (peeraddr -> Int)
    -> (peeraddr -> Bool)
    -> Set peeraddr
    -> Int
    -> m (Set peeraddr))
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers PeerSelectionState peeraddr peerconn
st
              PickPolicy peeraddr m
policyPickWarmPeersToPromote
              Set peeraddr
membersAvailableToPromote
              Int
numMembersToPromote
          | (Int
numMembersToPromote,
             Set peeraddr
membersAvailableToPromote) <- [(Int, Set peeraddr)]
groupsAvailableToPromote ]

      let selectedToPromote' :: Map peeraddr peerconn
          selectedToPromote' :: Map peeraddr peerconn
selectedToPromote' = EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
EstablishedPeers.toMap EstablishedPeers peeraddr peerconn
establishedPeers
                                 Map peeraddr peerconn -> Set peeraddr -> Map peeraddr peerconn
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set peeraddr
selectedToPromote
      (Time -> Decision m peeraddr peerconn)
-> STM m (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Time -> Decision m peeraddr peerconn)
 -> STM m (Time -> Decision m peeraddr peerconn))
-> (Time -> Decision m peeraddr peerconn)
-> STM m (Time -> Decision m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ \Time
_now -> Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
        decisionTrace :: TracePeerSelection peeraddr
decisionTrace = [(Int, Int)] -> Set peeraddr -> TracePeerSelection peeraddr
forall peeraddr.
[(Int, Int)] -> Set peeraddr -> TracePeerSelection peeraddr
TracePromoteWarmLocalPeers
                          [ (Int
target, Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
membersActive)
                          | (Int
target, Set peeraddr
_, Set peeraddr
membersActive) <- [(Int, Set peeraddr, Set peeraddr)]
groupsBelowTarget ]
                          Set peeraddr
selectedToPromote,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm = Set peeraddr
inProgressPromoteWarm
                                               Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
selectedToPromote
                        },
        decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = [ PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
forall peeraddr peerconn (m :: * -> *).
(MonadDelay m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
jobPromoteWarmPeer PeerSelectionActions peeraddr peerconn m
actions peeraddr
peeraddr peerconn
peerconn
                        | (peeraddr
peeraddr, peerconn
peerconn) <- Map peeraddr peerconn -> [(peeraddr, peerconn)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map peeraddr peerconn
selectedToPromote' ]
      }


    -- If we could promote except that there are no peers currently available
    -- then we return the next wakeup time (if any)
  | Bool -> Bool
not ([(Int, Set peeraddr, Set peeraddr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Set peeraddr, Set peeraddr)]
groupsBelowTarget)
  , let potentialToPromote :: Set peeraddr
potentialToPromote =
          -- These are local peers that are warm but not ready.
          (LocalRootPeers peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers peeraddr
localRootPeers
            Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection`
           EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet EstablishedPeers peeraddr peerconn
establishedPeers)
             Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
activePeers
             Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.readyPeers EstablishedPeers peeraddr peerconn
establishedPeers
  , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
potentialToPromote)
  = Maybe (Min Time)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip (Time -> Min Time
forall a. a -> Min a
Min (Time -> Min Time) -> Maybe Time -> Maybe (Min Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EstablishedPeers peeraddr peerconn -> Maybe Time
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Maybe Time
EstablishedPeers.minActivateTime EstablishedPeers peeraddr peerconn
establishedPeers)

  | Bool
otherwise
  = Maybe (Min Time)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip Maybe (Min Time)
forall a. Maybe a
Nothing
  where
    groupsBelowTarget :: [(Int, Set peeraddr, Set peeraddr)]
groupsBelowTarget =
      [ (Int
target, Set peeraddr
members, Set peeraddr
membersActive)
      | (Int
target, Set peeraddr
members) <- LocalRootPeers peeraddr -> [(Int, Set peeraddr)]
forall peeraddr. LocalRootPeers peeraddr -> [(Int, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers peeraddr
localRootPeers
      , let membersActive :: Set peeraddr
membersActive = Set peeraddr
members Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
activePeers
      , Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
membersActive Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
target
      ]

belowTargetOther :: forall peeraddr peerconn m.
                    (MonadDelay m, MonadSTM m, Ord peeraddr)
                 => PeerSelectionActions peeraddr peerconn m
                 -> MkGuardedDecision peeraddr peerconn m
belowTargetOther :: PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
belowTargetOther PeerSelectionActions peeraddr peerconn m
actions
                 PeerSelectionPolicy {
                   PickPolicy peeraddr m
policyPickWarmPeersToPromote :: PickPolicy peeraddr m
policyPickWarmPeersToPromote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickWarmPeersToPromote
                 }
                 st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                   LocalRootPeers peeraddr
localRootPeers :: LocalRootPeers peeraddr
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers,
                   EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                   Set peeraddr
activePeers :: Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers,
                   Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm,
                   Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteWarm,
                   targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                               Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers
                             }
                 }
    -- Are we below the target for number of active peers?
  | Int
numActivePeers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numPromoteInProgress Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetNumberOfActivePeers

    -- Are there any warm peers we could pick to promote?
  , let availableToPromote :: Set peeraddr
        availableToPromote :: Set peeraddr
availableToPromote = EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.readyPeers EstablishedPeers peeraddr peerconn
establishedPeers
                               Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
activePeers
                               Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressPromoteWarm
                               Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressDemoteWarm
                               Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ LocalRootPeers peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers peeraddr
localRootPeers
        numPeersToPromote :: Int
numPeersToPromote = Int
targetNumberOfActivePeers
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numActivePeers
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numPromoteInProgress
  , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
availableToPromote)
  , Int
numPeersToPromote Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  = Maybe (Min Time)
-> STM m (Time -> Decision m peeraddr peerconn)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> m a -> Guarded m a
Guarded Maybe (Min Time)
forall a. Maybe a
Nothing (STM m (Time -> Decision m peeraddr peerconn)
 -> Guarded (STM m) (Time -> Decision m peeraddr peerconn))
-> STM m (Time -> Decision m peeraddr peerconn)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ do
      Set peeraddr
selectedToPromote <- PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> STM m (Set peeraddr)
forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m) =>
PeerSelectionState peeraddr peerconn
-> ((peeraddr -> PeerSource)
    -> (peeraddr -> Int)
    -> (peeraddr -> Bool)
    -> Set peeraddr
    -> Int
    -> m (Set peeraddr))
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers PeerSelectionState peeraddr peerconn
st
                             PickPolicy peeraddr m
policyPickWarmPeersToPromote
                             Set peeraddr
availableToPromote
                             Int
numPeersToPromote
      let selectedToPromote' :: Map peeraddr peerconn
          selectedToPromote' :: Map peeraddr peerconn
selectedToPromote' = EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
EstablishedPeers.toMap EstablishedPeers peeraddr peerconn
establishedPeers
                                 Map peeraddr peerconn -> Set peeraddr -> Map peeraddr peerconn
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set peeraddr
selectedToPromote
      (Time -> Decision m peeraddr peerconn)
-> STM m (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Time -> Decision m peeraddr peerconn)
 -> STM m (Time -> Decision m peeraddr peerconn))
-> (Time -> Decision m peeraddr peerconn)
-> STM m (Time -> Decision m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ \Time
_now -> Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
        decisionTrace :: TracePeerSelection peeraddr
decisionTrace = Int -> Int -> Set peeraddr -> TracePeerSelection peeraddr
forall peeraddr.
Int -> Int -> Set peeraddr -> TracePeerSelection peeraddr
TracePromoteWarmPeers
                          Int
targetNumberOfActivePeers
                          Int
numActivePeers
                          Set peeraddr
selectedToPromote,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm = Set peeraddr
inProgressPromoteWarm
                                               Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
selectedToPromote
                        },
        decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = [ PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
forall peeraddr peerconn (m :: * -> *).
(MonadDelay m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
jobPromoteWarmPeer PeerSelectionActions peeraddr peerconn m
actions peeraddr
peeraddr peerconn
peerconn
                        | (peeraddr
peeraddr, peerconn
peerconn) <- Map peeraddr peerconn -> [(peeraddr, peerconn)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map peeraddr peerconn
selectedToPromote' ]
      }

    -- If we could promote except that there are no peers currently available
    -- then we return the next wakeup time (if any)
  | Int
numActivePeers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numPromoteInProgress Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetNumberOfActivePeers
  = Maybe (Min Time)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip (Time -> Min Time
forall a. a -> Min a
Min (Time -> Min Time) -> Maybe Time -> Maybe (Min Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EstablishedPeers peeraddr peerconn -> Maybe Time
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Maybe Time
EstablishedPeers.minActivateTime EstablishedPeers peeraddr peerconn
establishedPeers)

  | Bool
otherwise
  = Maybe (Min Time)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip Maybe (Min Time)
forall a. Maybe a
Nothing
  where
    numActivePeers :: Int
numActivePeers       = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers
    numPromoteInProgress :: Int
numPromoteInProgress = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
inProgressPromoteWarm


jobPromoteWarmPeer :: forall peeraddr peerconn m.
                      (MonadDelay m, Ord peeraddr)
                   => PeerSelectionActions peeraddr peerconn m
                   -> peeraddr
                   -> peerconn
                   -> Job () m (Completion m peeraddr peerconn)
jobPromoteWarmPeer :: PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
jobPromoteWarmPeer PeerSelectionActions{peerStateActions :: forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> PeerStateActions peeraddr peerconn m
peerStateActions = PeerStateActions {peerconn -> m ()
activatePeerConnection :: forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m -> peerconn -> m ()
activatePeerConnection :: peerconn -> m ()
activatePeerConnection}}
                   peeraddr
peeraddr peerconn
peerconn =
    m (Completion m peeraddr peerconn)
-> (SomeException -> m (Completion m peeraddr peerconn))
-> ()
-> String
-> Job () m (Completion m peeraddr peerconn)
forall group (m :: * -> *) a.
m a -> (SomeException -> m a) -> group -> String -> Job group m a
Job m (Completion m peeraddr peerconn)
job SomeException -> m (Completion m peeraddr peerconn)
handler () String
"promoteWarmPeer"
  where
    baseReconnectDelay :: Double
    baseReconnectDelay :: Double
baseReconnectDelay = Double
10

    handler :: SomeException -> m (Completion m peeraddr peerconn)
    handler :: SomeException -> m (Completion m peeraddr peerconn)
handler SomeException
e = do
      -- We wait here, not to avoid race conditions or broken locking, this is
      -- just a very simple back-off strategy. For cold -> warm failures we use
      -- an exponential back-off retry strategy. For warm -> hot we do not need
      -- such a strategy. Simply a short pause is enough to ensure we never
      -- busy-loop.  Failures of warm -> hot will be accompanied by an
      -- asynchronous demotion to cold relatively promptly. If we did ever need
      -- to carry on after warm -> hot failures then we would need to implement
      -- a more sophisticated back-off strategy, like an exponential back-off
      -- (and perhaps use that failure count in the policy to drop useless peers
      -- in the warm -> cold transition).
      DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1
      Completion m peeraddr peerconn
-> m (Completion m peeraddr peerconn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Completion m peeraddr peerconn
 -> m (Completion m peeraddr peerconn))
-> Completion m peeraddr peerconn
-> m (Completion m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$
        -- When promotion fails we set the peer as cold.
        (PeerSelectionState peeraddr peerconn
 -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
forall (m :: * -> *) peeraddr peerconn.
(PeerSelectionState peeraddr peerconn
 -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
Completion ((PeerSelectionState peeraddr peerconn
  -> Time -> Decision m peeraddr peerconn)
 -> Completion m peeraddr peerconn)
-> (PeerSelectionState peeraddr peerconn
    -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
forall a b. (a -> b) -> a -> b
$ \st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                                 Set peeraddr
activePeers :: Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers,
                                 EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                                 KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers,
                                 StdGen
fuzzRng :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> StdGen
fuzzRng :: StdGen
fuzzRng,
                                 targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                                             Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers
                                           }
                               }
                      Time
now ->
          -- TODO: this is a temporary fix, which will by addressed by
          -- #3460
          if peeraddr
peeraddr peeraddr -> Set peeraddr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` PeerSelectionState peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm PeerSelectionState peeraddr peerconn
st
            then let establishedPeers' :: EstablishedPeers peeraddr peerconn
establishedPeers' = peeraddr
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall peeraddr peerconn.
Ord peeraddr =>
peeraddr
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
EstablishedPeers.delete peeraddr
peeraddr
                                           EstablishedPeers peeraddr peerconn
establishedPeers
                     (Double
fuzz, StdGen
fuzzRng')  = (Double, Double) -> StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (-Double
2, Double
2 :: Double) StdGen
fuzzRng
                     delay :: DiffTime
delay             = Double -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> DiffTime) -> Double -> DiffTime
forall a b. (a -> b) -> a -> b
$ Double
fuzz Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
baseReconnectDelay
                     knownPeers' :: KnownPeers peeraddr
knownPeers'       = if peeraddr
peeraddr peeraddr -> KnownPeers peeraddr -> Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Bool
`KnownPeers.member` KnownPeers peeraddr
knownPeers
                                            then Set peeraddr -> Time -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> Time -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.setConnectTime
                                                   (peeraddr -> Set peeraddr
forall a. a -> Set a
Set.singleton peeraddr
peeraddr)
                                                   (DiffTime
delay DiffTime -> Time -> Time
`addTime` Time
now)
                                                 (KnownPeers peeraddr -> KnownPeers peeraddr)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall a b. (a -> b) -> a -> b
$ (Int, KnownPeers peeraddr) -> KnownPeers peeraddr
forall a b. (a, b) -> b
snd ((Int, KnownPeers peeraddr) -> KnownPeers peeraddr)
-> (Int, KnownPeers peeraddr) -> KnownPeers peeraddr
forall a b. (a -> b) -> a -> b
$ peeraddr -> KnownPeers peeraddr -> (Int, KnownPeers peeraddr)
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> (Int, KnownPeers peeraddr)
KnownPeers.incrementFailCount
                                                   peeraddr
peeraddr
                                                   KnownPeers peeraddr
knownPeers
                                            else
                                              -- Apparently the governor can remove
                                              -- the peer we failed to promote from the
                                              -- set of known peers before we can process
                                              -- the failure.
                                              KnownPeers peeraddr
knownPeers in
                 Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
                   decisionTrace :: TracePeerSelection peeraddr
decisionTrace = Int
-> Int -> peeraddr -> SomeException -> TracePeerSelection peeraddr
forall peeraddr.
Int
-> Int -> peeraddr -> SomeException -> TracePeerSelection peeraddr
TracePromoteWarmFailed Int
targetNumberOfActivePeers
                                                          (Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers)
                                                          peeraddr
peeraddr SomeException
e,
                   decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                                     inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm = peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
peeraddr
                                                               (PeerSelectionState peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm PeerSelectionState peeraddr peerconn
st),
                                     knownPeers :: KnownPeers peeraddr
knownPeers            = KnownPeers peeraddr
knownPeers',
                                     establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers      = EstablishedPeers peeraddr peerconn
establishedPeers',
                                     fuzzRng :: StdGen
fuzzRng               = StdGen
fuzzRng'
                                   },
                   decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
                 }
            else Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
                   decisionTrace :: TracePeerSelection peeraddr
decisionTrace = Int -> Int -> peeraddr -> TracePeerSelection peeraddr
forall peeraddr.
Int -> Int -> peeraddr -> TracePeerSelection peeraddr
TracePromoteWarmAborted Int
targetNumberOfActivePeers
                                                           (Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers)
                                                           peeraddr
peeraddr,
                   decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st,
                   decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
                 }


    job :: m (Completion m peeraddr peerconn)
    job :: m (Completion m peeraddr peerconn)
job = do
      peerconn -> m ()
activatePeerConnection peerconn
peerconn
      Completion m peeraddr peerconn
-> m (Completion m peeraddr peerconn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Completion m peeraddr peerconn
 -> m (Completion m peeraddr peerconn))
-> Completion m peeraddr peerconn
-> m (Completion m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ (PeerSelectionState peeraddr peerconn
 -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
forall (m :: * -> *) peeraddr peerconn.
(PeerSelectionState peeraddr peerconn
 -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
Completion ((PeerSelectionState peeraddr peerconn
  -> Time -> Decision m peeraddr peerconn)
 -> Completion m peeraddr peerconn)
-> (PeerSelectionState peeraddr peerconn
    -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
forall a b. (a -> b) -> a -> b
$ \st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                               Set peeraddr
activePeers :: Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers,
                               targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                                           Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers
                                         }
                             }
                           Time
_now ->

        Bool
-> Decision m peeraddr peerconn -> Decision m peeraddr peerconn
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (peeraddr
peeraddr peeraddr -> KnownPeers peeraddr -> Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Bool
`KnownPeers.member` PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers PeerSelectionState peeraddr peerconn
st) (Decision m peeraddr peerconn -> Decision m peeraddr peerconn)
-> Decision m peeraddr peerconn -> Decision m peeraddr peerconn
forall a b. (a -> b) -> a -> b
$
        if peeraddr
peeraddr peeraddr -> EstablishedPeers peeraddr peerconn -> Bool
forall peeraddr peerconn.
Ord peeraddr =>
peeraddr -> EstablishedPeers peeraddr peerconn -> Bool
`EstablishedPeers.member` PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers PeerSelectionState peeraddr peerconn
st
          then
            let activePeers' :: Set peeraddr
activePeers' = peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.insert peeraddr
peeraddr Set peeraddr
activePeers in
            Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
              decisionTrace :: TracePeerSelection peeraddr
decisionTrace = Int -> Int -> peeraddr -> TracePeerSelection peeraddr
forall peeraddr.
Int -> Int -> peeraddr -> TracePeerSelection peeraddr
TracePromoteWarmDone Int
targetNumberOfActivePeers
                                                   (Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers')
                                                   peeraddr
peeraddr,
              decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                                activePeers :: Set peeraddr
activePeers           = Set peeraddr
activePeers',
                                inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm = peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
peeraddr
                                                          (PeerSelectionState peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm PeerSelectionState peeraddr peerconn
st)
                              },
              decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
            }
          else
            Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
              decisionTrace :: TracePeerSelection peeraddr
decisionTrace = Int -> Int -> peeraddr -> TracePeerSelection peeraddr
forall peeraddr.
Int -> Int -> peeraddr -> TracePeerSelection peeraddr
TracePromoteWarmAborted Int
targetNumberOfActivePeers
                                                      (Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers)
                                                      peeraddr
peeraddr,
              decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st,
              decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
            }


----------------------------
-- Active peers above target
--

-- | If we are above the target of /hot peers/ we demote some hot peers to be
-- /warm peers/, according to 'policyPickHotPeersToDemote'.
--
aboveTarget :: forall peeraddr peerconn m.
               (MonadSTM m, Ord peeraddr)
            => PeerSelectionActions peeraddr peerconn m
            -> MkGuardedDecision peeraddr peerconn m
aboveTarget :: PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
aboveTarget = PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
forall peeraddr peerconn (m :: * -> *).
(MonadSTM m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
aboveTargetLocal (PeerSelectionActions peeraddr peerconn m
 -> MkGuardedDecision peeraddr peerconn m)
-> (PeerSelectionActions peeraddr peerconn m
    -> MkGuardedDecision peeraddr peerconn m)
-> PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
forall a. Semigroup a => a -> a -> a
<> PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
forall peeraddr peerconn (m :: * -> *).
(MonadSTM m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
aboveTargetOther
  -- Start with the local root targets, then the general target. This makes
  -- sense since we need to hit both and making progress downwards with the
  -- local root targets makes progress for the general target too.


aboveTargetLocal :: forall peeraddr peerconn m.
                    (MonadSTM m, Ord peeraddr)
                 => PeerSelectionActions peeraddr peerconn m
                 -> MkGuardedDecision peeraddr peerconn m
aboveTargetLocal :: PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
aboveTargetLocal PeerSelectionActions peeraddr peerconn m
actions
                 PeerSelectionPolicy {
                   PickPolicy peeraddr m
policyPickHotPeersToDemote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickHotPeersToDemote :: PickPolicy peeraddr m
policyPickHotPeersToDemote
                 }
                 st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                   LocalRootPeers peeraddr
localRootPeers :: LocalRootPeers peeraddr
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers,
                   EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                   Set peeraddr
activePeers :: Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers,
                   Set peeraddr
inProgressDemoteHot :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot
                 }
    -- Are there any groups of local peers that are below target?
  | let groupsAboveTarget :: [(Int, Set peeraddr, Set peeraddr)]
groupsAboveTarget =
          [ (Int
target, Set peeraddr
members, Set peeraddr
membersActive)
          | (Int
target, Set peeraddr
members) <- LocalRootPeers peeraddr -> [(Int, Set peeraddr)]
forall peeraddr. LocalRootPeers peeraddr -> [(Int, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers peeraddr
localRootPeers
          , let membersActive :: Set peeraddr
membersActive = Set peeraddr
members Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
activePeers
          , Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
membersActive Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
target
          ]
  , Bool -> Bool
not ([(Int, Set peeraddr, Set peeraddr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Set peeraddr, Set peeraddr)]
groupsAboveTarget)
    -- We need this detailed check because it is not enough to check we are
    -- above an aggregate target. We can be above target for some groups
    -- and below for others.

    -- Are there any groups where we can pick members to demote?
  , let groupsAvailableToDemote :: [(Int, Set peeraddr)]
groupsAvailableToDemote =
          [ (Int
numMembersToDemote, Set peeraddr
membersAvailableToDemote)
          | let availableToDemote :: Set peeraddr
availableToDemote = (LocalRootPeers peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers peeraddr
localRootPeers
                                       Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection`
                                     Set peeraddr
activePeers)
                                       Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressDemoteHot
                numDemoteInProgress :: Int
numDemoteInProgress = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
inProgressDemoteHot
          , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
availableToDemote)
          , (Int
target, Set peeraddr
members, Set peeraddr
membersActive) <- [(Int, Set peeraddr, Set peeraddr)]
groupsAboveTarget
          , let membersAvailableToDemote :: Set peeraddr
membersAvailableToDemote = Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
                                             Set peeraddr
members Set peeraddr
availableToDemote
                numMembersToDemote :: Int
numMembersToDemote       = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
membersActive
                                         Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
target
                                         Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numDemoteInProgress
          , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
membersAvailableToDemote)
          , Int
numMembersToDemote Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
          ]
  , Bool -> Bool
not ([(Int, Set peeraddr)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Set peeraddr)]
groupsAvailableToDemote)
  = Maybe (Min Time)
-> STM m (Time -> Decision m peeraddr peerconn)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> m a -> Guarded m a
Guarded Maybe (Min Time)
forall a. Maybe a
Nothing (STM m (Time -> Decision m peeraddr peerconn)
 -> Guarded (STM m) (Time -> Decision m peeraddr peerconn))
-> STM m (Time -> Decision m peeraddr peerconn)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ do
      Set peeraddr
selectedToDemote <-
        [Set peeraddr] -> Set peeraddr
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set peeraddr] -> Set peeraddr)
-> STM m [Set peeraddr] -> STM m (Set peeraddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [STM m (Set peeraddr)] -> STM m [Set peeraddr]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
          [ PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> STM m (Set peeraddr)
forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m) =>
PeerSelectionState peeraddr peerconn
-> ((peeraddr -> PeerSource)
    -> (peeraddr -> Int)
    -> (peeraddr -> Bool)
    -> Set peeraddr
    -> Int
    -> m (Set peeraddr))
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers PeerSelectionState peeraddr peerconn
st
              PickPolicy peeraddr m
policyPickHotPeersToDemote
              Set peeraddr
membersAvailableToDemote
              Int
numMembersToDemote
          | (Int
numMembersToDemote,
             Set peeraddr
membersAvailableToDemote) <- [(Int, Set peeraddr)]
groupsAvailableToDemote ]
      let selectedToDemote' :: Map peeraddr peerconn
          selectedToDemote' :: Map peeraddr peerconn
selectedToDemote' = EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
EstablishedPeers.toMap EstablishedPeers peeraddr peerconn
establishedPeers
                                Map peeraddr peerconn -> Set peeraddr -> Map peeraddr peerconn
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set peeraddr
selectedToDemote

      (Time -> Decision m peeraddr peerconn)
-> STM m (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Time -> Decision m peeraddr peerconn)
 -> STM m (Time -> Decision m peeraddr peerconn))
-> (Time -> Decision m peeraddr peerconn)
-> STM m (Time -> Decision m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ \Time
_now -> Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
        decisionTrace :: TracePeerSelection peeraddr
decisionTrace = [(Int, Int)] -> Set peeraddr -> TracePeerSelection peeraddr
forall peeraddr.
[(Int, Int)] -> Set peeraddr -> TracePeerSelection peeraddr
TraceDemoteLocalHotPeers
                          [ (Int
target, Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
membersActive)
                          | (Int
target, Set peeraddr
_, Set peeraddr
membersActive) <- [(Int, Set peeraddr, Set peeraddr)]
groupsAboveTarget ]
                          Set peeraddr
selectedToDemote,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot = Set peeraddr
inProgressDemoteHot
                                             Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
selectedToDemote
                        },
        decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = [ PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
forall peeraddr peerconn (m :: * -> *).
(Monad m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
jobDemoteActivePeer PeerSelectionActions peeraddr peerconn m
actions peeraddr
peeraddr peerconn
peerconn
                        | (peeraddr
peeraddr, peerconn
peerconn) <- Map peeraddr peerconn -> [(peeraddr, peerconn)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map peeraddr peerconn
selectedToDemote' ]
      }

  | Bool
otherwise
  = Maybe (Min Time)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip Maybe (Min Time)
forall a. Maybe a
Nothing


aboveTargetOther :: forall peeraddr peerconn m.
                    (MonadSTM m, Ord peeraddr)
                 => PeerSelectionActions peeraddr peerconn m
                 -> MkGuardedDecision peeraddr peerconn m
aboveTargetOther :: PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
aboveTargetOther PeerSelectionActions peeraddr peerconn m
actions
                 PeerSelectionPolicy {
                   PickPolicy peeraddr m
policyPickHotPeersToDemote :: PickPolicy peeraddr m
policyPickHotPeersToDemote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickHotPeersToDemote
                 }
                 st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                   LocalRootPeers peeraddr
localRootPeers :: LocalRootPeers peeraddr
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers,
                   EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                   Set peeraddr
activePeers :: Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers,
                   Set peeraddr
inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteHot,
                   targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                               Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers
                             }
                 }
    -- Are we above the general target for number of active peers?
  | Int
numActivePeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
targetNumberOfActivePeers

    -- Would we demote any if we could?
  , let numPeersToDemote :: Int
numPeersToDemote = Int
numActivePeers
                         Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
targetNumberOfActivePeers
                         Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numDemoteInProgress
  , Int
numPeersToDemote Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

    -- Are there any hot peers we actually can pick to demote?
    -- For the moment we say we cannot demote local root peers.
    -- TODO: review this decision. If we want to be able to demote local root
    -- peers, e.g. for churn and improved selection, then we'll need an extra
    -- mechanism to avoid promotion/demotion loops for local peers.
  , let availableToDemote :: Set peeraddr
availableToDemote = Set peeraddr
activePeers
                              Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressDemoteHot
                              Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ LocalRootPeers peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers peeraddr
localRootPeers
  , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
availableToDemote)
  = Maybe (Min Time)
-> STM m (Time -> Decision m peeraddr peerconn)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> m a -> Guarded m a
Guarded Maybe (Min Time)
forall a. Maybe a
Nothing (STM m (Time -> Decision m peeraddr peerconn)
 -> Guarded (STM m) (Time -> Decision m peeraddr peerconn))
-> STM m (Time -> Decision m peeraddr peerconn)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ do
      Set peeraddr
selectedToDemote <- PeerSelectionState peeraddr peerconn
-> PickPolicy peeraddr m
-> Set peeraddr
-> Int
-> STM m (Set peeraddr)
forall peeraddr (m :: * -> *) peerconn.
(Ord peeraddr, Functor m) =>
PeerSelectionState peeraddr peerconn
-> ((peeraddr -> PeerSource)
    -> (peeraddr -> Int)
    -> (peeraddr -> Bool)
    -> Set peeraddr
    -> Int
    -> m (Set peeraddr))
-> Set peeraddr
-> Int
-> m (Set peeraddr)
pickPeers PeerSelectionState peeraddr peerconn
st
                            PickPolicy peeraddr m
policyPickHotPeersToDemote
                            Set peeraddr
availableToDemote
                            Int
numPeersToDemote
      let selectedToDemote' :: Map peeraddr peerconn
          selectedToDemote' :: Map peeraddr peerconn
selectedToDemote' = EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
EstablishedPeers.toMap EstablishedPeers peeraddr peerconn
establishedPeers
                                Map peeraddr peerconn -> Set peeraddr -> Map peeraddr peerconn
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set peeraddr
selectedToDemote

      (Time -> Decision m peeraddr peerconn)
-> STM m (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Time -> Decision m peeraddr peerconn)
 -> STM m (Time -> Decision m peeraddr peerconn))
-> (Time -> Decision m peeraddr peerconn)
-> STM m (Time -> Decision m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ \Time
_now -> Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
        decisionTrace :: TracePeerSelection peeraddr
decisionTrace = Int -> Int -> Set peeraddr -> TracePeerSelection peeraddr
forall peeraddr.
Int -> Int -> Set peeraddr -> TracePeerSelection peeraddr
TraceDemoteHotPeers
                          Int
targetNumberOfActivePeers
                          Int
numActivePeers
                          Set peeraddr
selectedToDemote,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot = Set peeraddr
inProgressDemoteHot
                                             Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
selectedToDemote
                        },
        decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = [ PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
forall peeraddr peerconn (m :: * -> *).
(Monad m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
jobDemoteActivePeer PeerSelectionActions peeraddr peerconn m
actions peeraddr
peeraddr peerconn
peerconn
                        | (peeraddr
peeraddr, peerconn
peerconn) <- Map peeraddr peerconn -> [(peeraddr, peerconn)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map peeraddr peerconn
selectedToDemote' ]
      }

  | Bool
otherwise
  = Maybe (Min Time)
-> Guarded (STM m) (Time -> Decision m peeraddr peerconn)
forall (m :: * -> *) a. Maybe (Min Time) -> Guarded m a
GuardedSkip Maybe (Min Time)
forall a. Maybe a
Nothing
  where
    numActivePeers :: Int
numActivePeers      = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers
    numDemoteInProgress :: Int
numDemoteInProgress = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
inProgressDemoteHot

-- | Reconnect delay for peers which asynchronously transitioned to cold state.
--
reconnectDelay :: DiffTime
reconnectDelay :: DiffTime
reconnectDelay = DiffTime
10
--TODO: make this a policy param

jobDemoteActivePeer :: forall peeraddr peerconn m.
                       (Monad m, Ord peeraddr)
                    => PeerSelectionActions peeraddr peerconn m
                    -> peeraddr
                    -> peerconn
                    -> Job () m (Completion m peeraddr peerconn)
jobDemoteActivePeer :: PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
jobDemoteActivePeer PeerSelectionActions{peerStateActions :: forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> PeerStateActions peeraddr peerconn m
peerStateActions = PeerStateActions {peerconn -> m ()
deactivatePeerConnection :: forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m -> peerconn -> m ()
deactivatePeerConnection :: peerconn -> m ()
deactivatePeerConnection}}
                    peeraddr
peeraddr peerconn
peerconn =
    m (Completion m peeraddr peerconn)
-> (SomeException -> m (Completion m peeraddr peerconn))
-> ()
-> String
-> Job () m (Completion m peeraddr peerconn)
forall group (m :: * -> *) a.
m a -> (SomeException -> m a) -> group -> String -> Job group m a
Job m (Completion m peeraddr peerconn)
job SomeException -> m (Completion m peeraddr peerconn)
handler () String
"demoteActivePeer"
  where
    handler :: SomeException -> m (Completion m peeraddr peerconn)
    handler :: SomeException -> m (Completion m peeraddr peerconn)
handler SomeException
e = Completion m peeraddr peerconn
-> m (Completion m peeraddr peerconn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Completion m peeraddr peerconn
 -> m (Completion m peeraddr peerconn))
-> Completion m peeraddr peerconn
-> m (Completion m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$
      -- It's quite bad if demoting fails. The peer is cold so
      -- remove if from the set of established and hot peers.
      (PeerSelectionState peeraddr peerconn
 -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
forall (m :: * -> *) peeraddr peerconn.
(PeerSelectionState peeraddr peerconn
 -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
Completion ((PeerSelectionState peeraddr peerconn
  -> Time -> Decision m peeraddr peerconn)
 -> Completion m peeraddr peerconn)
-> (PeerSelectionState peeraddr peerconn
    -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
forall a b. (a -> b) -> a -> b
$ \st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                      Set peeraddr
activePeers :: Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers,
                      EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                      Set peeraddr
inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteHot,
                      KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers,
                      targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                                  Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers
                                },
                      StdGen
fuzzRng :: StdGen
fuzzRng :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> StdGen
fuzzRng
                    }
                    Time
now ->
        let (Double
rFuzz, StdGen
fuzzRng')     = (Double, Double) -> StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (-Double
2, Double
2 :: Double) StdGen
fuzzRng
            peerSet :: Set peeraddr
peerSet               = peeraddr -> Set peeraddr
forall a. a -> Set a
Set.singleton peeraddr
peeraddr
            activePeers' :: Set peeraddr
activePeers'          = peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
peeraddr Set peeraddr
activePeers
            inProgressDemoteHot' :: Set peeraddr
inProgressDemoteHot'  = peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
peeraddr Set peeraddr
inProgressDemoteHot
            knownPeers' :: KnownPeers peeraddr
knownPeers'           = Set peeraddr -> Time -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> Time -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.setConnectTime
                                      Set peeraddr
peerSet
                                      ((Double -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rFuzz DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
reconnectDelay)
                                       DiffTime -> Time -> Time
`addTime` Time
now)
                                  (KnownPeers peeraddr -> KnownPeers peeraddr)
-> (Set peeraddr -> KnownPeers peeraddr)
-> Set peeraddr
-> KnownPeers peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr)
-> KnownPeers peeraddr -> Set peeraddr -> KnownPeers peeraddr
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr'
                                      (((Int, KnownPeers peeraddr) -> KnownPeers peeraddr
forall a b. (a, b) -> b
snd ((Int, KnownPeers peeraddr) -> KnownPeers peeraddr)
-> (KnownPeers peeraddr -> (Int, KnownPeers peeraddr))
-> KnownPeers peeraddr
-> KnownPeers peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((KnownPeers peeraddr -> (Int, KnownPeers peeraddr))
 -> KnownPeers peeraddr -> KnownPeers peeraddr)
-> (peeraddr -> KnownPeers peeraddr -> (Int, KnownPeers peeraddr))
-> peeraddr
-> KnownPeers peeraddr
-> KnownPeers peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. peeraddr -> KnownPeers peeraddr -> (Int, KnownPeers peeraddr)
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> (Int, KnownPeers peeraddr)
KnownPeers.incrementFailCount)
                                      KnownPeers peeraddr
knownPeers
                                  (Set peeraddr -> KnownPeers peeraddr)
-> Set peeraddr -> KnownPeers peeraddr
forall a b. (a -> b) -> a -> b
$ Set peeraddr
peerSet
            establishedPeers' :: EstablishedPeers peeraddr peerconn
establishedPeers'     = Set peeraddr
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall peeraddr peerconn.
Ord peeraddr =>
Set peeraddr
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
EstablishedPeers.deletePeers
                                     Set peeraddr
peerSet
                                     EstablishedPeers peeraddr peerconn
establishedPeers in
        Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
        decisionTrace :: TracePeerSelection peeraddr
decisionTrace = Int
-> Int -> peeraddr -> SomeException -> TracePeerSelection peeraddr
forall peeraddr.
Int
-> Int -> peeraddr -> SomeException -> TracePeerSelection peeraddr
TraceDemoteHotFailed Int
targetNumberOfActivePeers
                                             (Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers) peeraddr
peeraddr SomeException
e,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot = Set peeraddr
inProgressDemoteHot',
                          fuzzRng :: StdGen
fuzzRng = StdGen
fuzzRng',
                          activePeers :: Set peeraddr
activePeers = Set peeraddr
activePeers',
                          knownPeers :: KnownPeers peeraddr
knownPeers = KnownPeers peeraddr
knownPeers',
                          establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers = EstablishedPeers peeraddr peerconn
establishedPeers'
                        },
        decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
      }

    job :: m (Completion m peeraddr peerconn)
    job :: m (Completion m peeraddr peerconn)
job = do
      peerconn -> m ()
deactivatePeerConnection peerconn
peerconn
      Completion m peeraddr peerconn
-> m (Completion m peeraddr peerconn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Completion m peeraddr peerconn
 -> m (Completion m peeraddr peerconn))
-> Completion m peeraddr peerconn
-> m (Completion m peeraddr peerconn)
forall a b. (a -> b) -> a -> b
$ (PeerSelectionState peeraddr peerconn
 -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
forall (m :: * -> *) peeraddr peerconn.
(PeerSelectionState peeraddr peerconn
 -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
Completion ((PeerSelectionState peeraddr peerconn
  -> Time -> Decision m peeraddr peerconn)
 -> Completion m peeraddr peerconn)
-> (PeerSelectionState peeraddr peerconn
    -> Time -> Decision m peeraddr peerconn)
-> Completion m peeraddr peerconn
forall a b. (a -> b) -> a -> b
$ \st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                                Set peeraddr
activePeers :: Set peeraddr
activePeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers,
                                KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers,
                                targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                                            Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers
                                          }
                             }
                             Time
_now ->
        Bool
-> Decision m peeraddr peerconn -> Decision m peeraddr peerconn
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (peeraddr
peeraddr peeraddr -> EstablishedPeers peeraddr peerconn -> Bool
forall peeraddr peerconn.
Ord peeraddr =>
peeraddr -> EstablishedPeers peeraddr peerconn -> Bool
`EstablishedPeers.member` PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers PeerSelectionState peeraddr peerconn
st) (Decision m peeraddr peerconn -> Decision m peeraddr peerconn)
-> Decision m peeraddr peerconn -> Decision m peeraddr peerconn
forall a b. (a -> b) -> a -> b
$
        let activePeers' :: Set peeraddr
activePeers' = peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
peeraddr Set peeraddr
activePeers
            knownPeers' :: KnownPeers peeraddr
knownPeers'  = peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
setTepidFlag peeraddr
peeraddr KnownPeers peeraddr
knownPeers in
        Decision :: forall (m :: * -> *) peeraddr peerconn.
TracePeerSelection peeraddr
-> PeerSelectionState peeraddr peerconn
-> [Job () m (Completion m peeraddr peerconn)]
-> Decision m peeraddr peerconn
Decision {
          decisionTrace :: TracePeerSelection peeraddr
decisionTrace = Int -> Int -> peeraddr -> TracePeerSelection peeraddr
forall peeraddr.
Int -> Int -> peeraddr -> TracePeerSelection peeraddr
TraceDemoteHotDone Int
targetNumberOfActivePeers
                                             (Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers')
                                             peeraddr
peeraddr,
          decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                            activePeers :: Set peeraddr
activePeers         = Set peeraddr
activePeers',
                            knownPeers :: KnownPeers peeraddr
knownPeers          = KnownPeers peeraddr
knownPeers',
                            inProgressDemoteHot :: Set peeraddr
inProgressDemoteHot = peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
peeraddr
                                                    (PeerSelectionState peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteHot PeerSelectionState peeraddr peerconn
st)
                          },
          decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
        }