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

module Ouroboros.Network.PeerSelection.Governor.EstablishedPeers
  ( belowTarget
  , aboveTarget
  ) 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)
import           Control.Monad.Class.MonadSTM
import           Control.Monad.Class.MonadTime
import           System.Random (randomR)

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


---------------------------------
-- Established peers below target
--


-- | If we are below the target of /warm peers/ we promote /cold peers/
-- according to 'policyPickColdPeersToPromote'.
--
-- There are two targets we are trying to hit here:
--
-- 1. a target for the overall number of established peers; and
-- 2. the target that all local root peers are established peers.
--
-- These two targets overlap: the conditions and the actions overlap since local
-- root peers are also known peers. Since they overlap, the order in which we
-- consider these targets is important. We consider the local peers target
-- /before/ the target for promoting other peers.
--
-- We will /always/ try to establish connections to the local root peers, even
-- if that would put us over target for the number of established peers. If we
-- do go over target then the action to demote will be triggered. The demote
-- action never picks local root peers.
--
belowTarget :: forall peeraddr peerconn 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 :: * -> *).
(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 :: * -> *).
(MonadSTM m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> MkGuardedDecision peeraddr peerconn m
belowTargetOther


-- | For locally configured root peers we have the (implicit) target that they
-- should all be warm peers all the time.
--
belowTargetLocal :: forall peeraddr peerconn 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
policyPickColdPeersToPromote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickColdPeersToPromote :: PickPolicy peeraddr m
policyPickColdPeersToPromote
                 }
                 st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                   LocalRootPeers peeraddr
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers :: LocalRootPeers peeraddr
localRootPeers,
                   KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers,
                   EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers,
                   Set peeraddr
inProgressPromoteCold :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold
                 }

    -- Are we below the target for number of /local/ root peers that are
    -- established? Our target for established local root peers is all of them!
    -- However we still don't want to go over the number of established peers
    -- or we'll end up in a cycle.
  | Int
numLocalEstablishedPeers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numLocalConnectInProgress
  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetNumberOfLocalPeers

    -- Are there any /local/ root peers that are cold we could possibly pick to
    -- connect to? We can subtract the local established ones because by
    -- definition they are not cold and our invariant is that they are always
    -- in the connect set. We can also subtract the in progress ones since they
    -- are also already in the connect set and we cannot pick them again.
  , Int
numLocalAvailableToConnect Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numLocalEstablishedPeers
                               Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numLocalConnectInProgress Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  --TODO: switch style to checking if the set is empty
  = 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
      -- The availableToPromote here is non-empty due to the second guard.
      -- The known peers map restricted to the connect set is the same size as
      -- the connect set (because it is a subset). The establishedPeers is a
      -- subset of the connect set and we also know that there is no overlap
      -- between inProgressPromoteCold and establishedPeers. QED.
      --
      -- The numPeersToPromote is positive based on the first guard.
      --
      let availableToPromote :: Set peeraddr
          availableToPromote :: Set peeraddr
availableToPromote = Set peeraddr
localAvailableToConnect
                                 Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
localEstablishedPeers
                                 Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
localConnectInProgress

          numPeersToPromote :: Int
numPeersToPromote  = Int
targetNumberOfLocalPeers
                             Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numLocalEstablishedPeers
                             Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numLocalConnectInProgress
      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
policyPickColdPeersToPromote
                             Set peeraddr
availableToPromote
                             Int
numPeersToPromote
      (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
TracePromoteColdLocalPeers
                          Int
targetNumberOfLocalPeers
                          Int
numLocalEstablishedPeers
                          Set peeraddr
selectedToPromote,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold = Set peeraddr
inProgressPromoteCold
                                               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 -> Job () m (Completion m peeraddr peerconn)
forall peeraddr peerconn (m :: * -> *).
(Monad m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> peeraddr -> Job () m (Completion m peeraddr peerconn)
jobPromoteColdPeer PeerSelectionActions peeraddr peerconn m
actions peeraddr
peer
                        | peeraddr
peer <- Set peeraddr -> [peeraddr]
forall a. Set a -> [a]
Set.toList Set peeraddr
selectedToPromote ]
      }

    -- If we could connect to a local root peer except that there are no local
    -- root peers currently available then we return the next wakeup time (if any)
    -- TODO: Note that this may wake up too soon, since it considers non-local
    -- known peers too for the purpose of the wakeup time.
  | Int
numLocalEstablishedPeers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numLocalConnectInProgress Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetNumberOfLocalPeers
  = 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
<$> KnownPeers peeraddr -> Maybe Time
forall peeraddr. Ord peeraddr => KnownPeers peeraddr -> Maybe Time
KnownPeers.minConnectTime KnownPeers peeraddr
knownPeers)

  | 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
    localRootPeersSet :: Set peeraddr
localRootPeersSet          = LocalRootPeers peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers peeraddr
localRootPeers
    targetNumberOfLocalPeers :: Int
targetNumberOfLocalPeers   = LocalRootPeers peeraddr -> Int
forall peeraddr. LocalRootPeers peeraddr -> Int
LocalRootPeers.size LocalRootPeers peeraddr
localRootPeers

    localEstablishedPeers :: Set peeraddr
localEstablishedPeers      = 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.intersection` Set peeraddr
localRootPeersSet
    localAvailableToConnect :: Set peeraddr
localAvailableToConnect    = KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.availableToConnect KnownPeers peeraddr
knownPeers
                                  Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
localRootPeersSet
    localConnectInProgress :: Set peeraddr
localConnectInProgress     = Set peeraddr
inProgressPromoteCold
                                  Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
localRootPeersSet

    numLocalEstablishedPeers :: Int
numLocalEstablishedPeers   = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
localEstablishedPeers
    numLocalAvailableToConnect :: Int
numLocalAvailableToConnect = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
localAvailableToConnect
    numLocalConnectInProgress :: Int
numLocalConnectInProgress  = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
localConnectInProgress


belowTargetOther :: forall peeraddr peerconn 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
policyPickColdPeersToPromote :: PickPolicy peeraddr m
policyPickColdPeersToPromote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickColdPeersToPromote
                 }
                 st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
                   KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers,
                   EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                   Set peeraddr
inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteCold,
                   targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                               Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers
                             }
                 }
    -- Are we below the target for number of established peers?
  | Int
numEstablishedPeers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numConnectInProgress Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetNumberOfEstablishedPeers

    -- Are there any cold peers we could possibly pick to connect to?
    -- We can subtract the established ones because by definition they are
    -- not cold and our invariant is that they are always in the connect set.
    -- We can also subtract the in progress ones since they are also already
    -- in the connect set and we cannot pick them again.
  , Int
numAvailableToConnect Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numEstablishedPeers Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numConnectInProgress 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
      -- The availableToPromote here is non-empty due to the second guard.
      -- The known peers map restricted to the connect set is the same size as
      -- the connect set (because it is a subset). The establishedPeers is a
      -- subset of the connect set and we also know that there is no overlap
      -- between inProgressPromoteCold and establishedPeers. QED.
      --
      -- The numPeersToPromote is positive based on the first guard.
      --
      let availableToPromote :: Set peeraddr
          availableToPromote :: Set peeraddr
availableToPromote = Set peeraddr
availableToConnect
                                 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.
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
inProgressPromoteCold
          numPeersToPromote :: Int
numPeersToPromote  = Int
targetNumberOfEstablishedPeers
                             Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numEstablishedPeers
                             Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numConnectInProgress
      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
policyPickColdPeersToPromote
                             Set peeraddr
availableToPromote
                             Int
numPeersToPromote
      (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
TracePromoteColdPeers
                          Int
targetNumberOfEstablishedPeers
                          Int
numEstablishedPeers
                          Set peeraddr
selectedToPromote,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold = Set peeraddr
inProgressPromoteCold
                                               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 -> Job () m (Completion m peeraddr peerconn)
forall peeraddr peerconn (m :: * -> *).
(Monad m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> peeraddr -> Job () m (Completion m peeraddr peerconn)
jobPromoteColdPeer PeerSelectionActions peeraddr peerconn m
actions peeraddr
peer
                        | peeraddr
peer <- Set peeraddr -> [peeraddr]
forall a. Set a -> [a]
Set.toList Set peeraddr
selectedToPromote ]
      }

    -- If we could connect except that there are no peers currently available
    -- then we return the next wakeup time (if any)
  | Int
numEstablishedPeers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numConnectInProgress Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetNumberOfEstablishedPeers
  = 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
<$> KnownPeers peeraddr -> Maybe Time
forall peeraddr. Ord peeraddr => KnownPeers peeraddr -> Maybe Time
KnownPeers.minConnectTime KnownPeers peeraddr
knownPeers)

  | 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
    numEstablishedPeers, numConnectInProgress :: Int
    numEstablishedPeers :: Int
numEstablishedPeers  = EstablishedPeers peeraddr peerconn -> Int
forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
EstablishedPeers.size EstablishedPeers peeraddr peerconn
establishedPeers
    numConnectInProgress :: Int
numConnectInProgress = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
inProgressPromoteCold
    availableToConnect :: Set peeraddr
availableToConnect   = KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.availableToConnect KnownPeers peeraddr
knownPeers
    numAvailableToConnect :: Int
numAvailableToConnect= Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
availableToConnect


-- | Must be larger than '2' since we add a random value drawn from '(-2, 2)`.
--
baseColdPeerRetryDiffTime :: Int
baseColdPeerRetryDiffTime :: Int
baseColdPeerRetryDiffTime = Int
5

maxColdPeerRetryBackoff :: Int
maxColdPeerRetryBackoff :: Int
maxColdPeerRetryBackoff = Int
5


jobPromoteColdPeer :: forall peeraddr peerconn m.
                       (Monad m, Ord peeraddr)
                   => PeerSelectionActions peeraddr peerconn m
                   -> peeraddr
                   -> Job () m (Completion m peeraddr peerconn)
jobPromoteColdPeer :: PeerSelectionActions peeraddr peerconn m
-> peeraddr -> Job () m (Completion m peeraddr peerconn)
jobPromoteColdPeer PeerSelectionActions {
                     peerStateActions :: forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> PeerStateActions peeraddr peerconn m
peerStateActions = PeerStateActions {peeraddr -> m peerconn
establishPeerConnection :: forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m -> peeraddr -> m peerconn
establishPeerConnection :: peeraddr -> m peerconn
establishPeerConnection}
                   } peeraddr
peeraddr =
    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
"promoteColdPeer"
  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
$
      (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 {
                      EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                      StdGen
fuzzRng :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> StdGen
fuzzRng :: StdGen
fuzzRng,
                      targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                                  Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers
                                }
                    }
                    Time
now ->
        let (Int
failCount, KnownPeers peeraddr
knownPeers') = peeraddr -> KnownPeers peeraddr -> (Int, KnownPeers peeraddr)
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> (Int, KnownPeers peeraddr)
KnownPeers.incrementFailCount
                                         peeraddr
peeraddr
                                         (PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers PeerSelectionState peeraddr peerconn
st)
            (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

            -- exponential backoff: 5s, 10s, 20s, 40s, 80s, 160s.
            delay :: DiffTime
            delay :: DiffTime
delay = Double -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fuzz
                  DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ Int -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                      ( Int
baseColdPeerRetryDiffTime
                      Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Int
forall a. Enum a => a -> a
pred Int
failCount Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
maxColdPeerRetryBackoff)
                      )
        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
-> DiffTime
-> SomeException
-> TracePeerSelection peeraddr
forall peeraddr.
Int
-> Int
-> peeraddr
-> DiffTime
-> SomeException
-> TracePeerSelection peeraddr
TracePromoteColdFailed Int
targetNumberOfEstablishedPeers
                                                   (EstablishedPeers peeraddr peerconn -> Int
forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
EstablishedPeers.size EstablishedPeers peeraddr peerconn
establishedPeers)
                                                   peeraddr
peeraddr DiffTime
delay SomeException
e,
            decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                              knownPeers :: KnownPeers peeraddr
knownPeers            = 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',
                              inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold = 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
inProgressPromoteCold PeerSelectionState peeraddr peerconn
st),
                              fuzzRng :: StdGen
fuzzRng = StdGen
fuzzRng'
                            },
            decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
          }

    job :: m (Completion m peeraddr peerconn)
    job :: m (Completion m peeraddr peerconn)
job = do
      --TODO: decide if we should do timeouts here or if we should make that
      -- the responsibility of establishPeerConnection
      peerconn
peerconn <- peeraddr -> m peerconn
establishPeerConnection peeraddr
peeraddr
      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 {
                               EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                               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
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers
                                         }
                             }
                             Time
_now ->
        let establishedPeers' :: EstablishedPeers peeraddr peerconn
establishedPeers' = peeraddr
-> peerconn
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall peeraddr peerconn.
Ord peeraddr =>
peeraddr
-> peerconn
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
EstablishedPeers.insert peeraddr
peeraddr peerconn
peerconn
                                                        EstablishedPeers peeraddr peerconn
establishedPeers
            knownPeers' :: KnownPeers peeraddr
knownPeers'       = peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.clearTepidFlag peeraddr
peeraddr (KnownPeers peeraddr -> KnownPeers peeraddr)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall a b. (a -> b) -> a -> b
$
                                    peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.resetFailCount
                                        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
TracePromoteColdDone Int
targetNumberOfEstablishedPeers
                                                  (EstablishedPeers peeraddr peerconn -> Int
forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
EstablishedPeers.size EstablishedPeers peeraddr peerconn
establishedPeers')
                                                  peeraddr
peeraddr,
             decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                               establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers      = EstablishedPeers peeraddr peerconn
establishedPeers',
                               inProgressPromoteCold :: Set peeraddr
inProgressPromoteCold = 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
inProgressPromoteCold PeerSelectionState peeraddr peerconn
st),
                               knownPeers :: KnownPeers peeraddr
knownPeers            = KnownPeers peeraddr
knownPeers'
                             },
             decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
           }


---------------------------------
-- Established peers above target
--
--


-- | If we are above the target of /established peers/ we demote some of the
-- /warm peers/ to the cold state, according to 'policyPickWarmPeersToDemote'.
--
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
actions
            PeerSelectionPolicy {
              PickPolicy peeraddr m
policyPickWarmPeersToDemote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickWarmPeersToDemote :: PickPolicy peeraddr m
policyPickWarmPeersToDemote
            }
            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 :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
activePeers :: Set peeraddr
activePeers,
              Set peeraddr
inProgressDemoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm,
              Set peeraddr
inProgressPromoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressPromoteWarm,
              targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                          Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers
                        }
            }
    -- Are we above the target for number of established peers?
    -- Or more precisely, how many established peers could we demote?
    -- We only want to pick established peers that are not active, since for
    -- active one we need to demote them first.
  | let numEstablishedPeers, numActivePeers, numPeersToDemote :: Int
        numEstablishedPeers :: Int
numEstablishedPeers = EstablishedPeers peeraddr peerconn -> Int
forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
EstablishedPeers.size EstablishedPeers peeraddr peerconn
establishedPeers
        numActivePeers :: Int
numActivePeers      = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
activePeers
        numLocalWarmPeers :: Int
numLocalWarmPeers   = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
localWarmPeers
        localWarmPeers :: Set peeraddr
localWarmPeers      = Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
                                (LocalRootPeers peeraddr -> Set peeraddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers peeraddr
localRootPeers)
                                (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
        -- One constraint on how many to demote is the difference in the
        -- number we have now vs the target. The other constraint is that
        -- we pick established peers that are not also active. These
        -- constraints combine by taking the minimum. We must also subtract
        -- the number we're demoting so we don't repeat the same work. And
        -- cannot demote ones we're in the process of promoting.
        numPeersToDemote :: Int
numPeersToDemote    = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
numEstablishedPeers
                                   Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
targetNumberOfEstablishedPeers)
                                  (Int
numEstablishedPeers
                                   Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numLocalWarmPeers
                                   Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numActivePeers)
                            Int -> Int -> Int
forall a. Num a => a -> a -> a
- Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
inProgressDemoteWarm
                            Int -> Int -> Int
forall a. Num a => a -> a -> a
- Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
inProgressPromoteWarm
  , Int
numPeersToDemote 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

      let availableToDemote :: Set peeraddr
          availableToDemote :: Set peeraddr
availableToDemote = 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.\\ 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.\\ Set peeraddr
inProgressDemoteWarm
                                Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressPromoteWarm
      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
policyPickWarmPeersToDemote
                            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
TraceDemoteWarmPeers
                          Int
targetNumberOfEstablishedPeers
                          Int
numEstablishedPeers
                          Set peeraddr
selectedToDemote,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm = Set peeraddr
inProgressDemoteWarm
                                              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)
jobDemoteEstablishedPeer 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


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

jobDemoteEstablishedPeer :: forall peeraddr peerconn m.
                            (Monad m, Ord peeraddr)
                         => PeerSelectionActions peeraddr peerconn m
                         -> peeraddr
                         -> peerconn
                         -> Job () m (Completion m peeraddr peerconn)
jobDemoteEstablishedPeer :: PeerSelectionActions peeraddr peerconn m
-> peeraddr
-> peerconn
-> Job () m (Completion m peeraddr peerconn)
jobDemoteEstablishedPeer PeerSelectionActions{peerStateActions :: forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> PeerStateActions peeraddr peerconn m
peerStateActions = PeerStateActions {peerconn -> m ()
closePeerConnection :: forall peeraddr peerconn (m :: * -> *).
PeerStateActions peeraddr peerconn m -> peerconn -> m ()
closePeerConnection :: peerconn -> m ()
closePeerConnection}}
                         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
"demoteEstablishedPeer"
  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 closing fails. The peer is cold so
      -- remove if from the set of established.
      (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 {
                       EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                       Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
inProgressDemoteWarm,
                       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
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers
                                 },
                       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
            inProgressDemoteWarm' :: Set peeraddr
inProgressDemoteWarm' = peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
peeraddr Set peeraddr
inProgressDemoteWarm
            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
TraceDemoteWarmFailed Int
targetNumberOfEstablishedPeers
                                              (EstablishedPeers peeraddr peerconn -> Int
forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
EstablishedPeers.size EstablishedPeers peeraddr peerconn
establishedPeers)
                                              peeraddr
peeraddr SomeException
e,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm = Set peeraddr
inProgressDemoteWarm',
                          fuzzRng :: StdGen
fuzzRng = StdGen
fuzzRng',
                          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 ()
closePeerConnection 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 {
                               EstablishedPeers peeraddr peerconn
establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
establishedPeers,
                               targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                                           Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers
                                         }
                             }
                             Time
_now ->
        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
        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
TraceDemoteWarmDone Int
targetNumberOfEstablishedPeers
                                                 (EstablishedPeers peeraddr peerconn -> Int
forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
EstablishedPeers.size EstablishedPeers peeraddr peerconn
establishedPeers')
                                                 peeraddr
peeraddr,
             decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                               establishedPeers :: EstablishedPeers peeraddr peerconn
establishedPeers     = EstablishedPeers peeraddr peerconn
establishedPeers',
                               inProgressDemoteWarm :: Set peeraddr
inProgressDemoteWarm = 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
inProgressDemoteWarm PeerSelectionState peeraddr peerconn
st)
                             },
             decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
           }