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

module Ouroboros.Network.PeerSelection.Governor.RootPeers (belowTarget) where

import Data.Map.Strict qualified as Map
import Data.Set qualified as Set

import Control.Concurrent.JobPool (Job (..))
import Control.Exception (SomeException, assert)
import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadTime.SI

import Ouroboros.Network.PeerSelection.Governor.Types
import Ouroboros.Network.PeerSelection.LedgerPeers (LedgerPeersKind (..))
import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.PeerSelection.Types (PublicExtraPeersAPI (..))

import System.Random


--------------------------
-- Root peers below target
--

belowTarget
  :: ( MonadSTM m
     , Ord peeraddr
     , Semigroup extraPeers
     )
  => PeerSelectionActions
      extraState
      extraFlags
      extraPeers
      extraAPI
      extraCounters
      peeraddr
      peerconn
      m
  -> Time
  -> PeerSelectionState extraState extraFlags extraPeers peeraddr peerconn
  -> Guarded (STM m)
            (TimedDecision m extraState extraDebugState extraFlags extraPeers
                           peeraddr peerconn)
belowTarget :: forall (m :: * -> *) peeraddr extraPeers extraState extraFlags
       extraAPI extraCounters peerconn extraDebugState.
(MonadSTM m, Ord peeraddr, Semigroup extraPeers) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> Time
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
belowTarget actions :: PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions@PeerSelectionActions {
              extraPeersAPI :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI = PublicExtraPeersAPI {
                extraPeers -> Set peeraddr
extraPeersToSet :: extraPeers -> Set peeraddr
extraPeersToSet :: forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Set peeraddr
extraPeersToSet
              },
              PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters
            }
            Time
blockedAt
            st :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st@PeerSelectionState {
              Time
publicRootRetryTime :: Time
publicRootRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
publicRootRetryTime,
              Bool
inProgressPublicRootsReq :: Bool
inProgressPublicRootsReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inProgressPublicRootsReq,
              targets :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
targets = PeerSelectionTargets {
                          Int
targetNumberOfRootPeers :: Int
targetNumberOfRootPeers :: PeerSelectionTargets -> Int
targetNumberOfRootPeers
                        },
              StdGen
stdGen :: StdGen
stdGen :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> StdGen
stdGen
            }
    -- Are we under target for number of root peers?
  | Int
maxExtraRootPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

    -- Are we already requesting more root peers?
  , Bool -> Bool
not Bool
inProgressPublicRootsReq

    -- We limit how frequently we make requests, are we allowed to do it yet?
  , Time
blockedAt Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
publicRootRetryTime
  = Maybe Time
-> STM
     m
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> m a -> Guarded m a
Guarded Maybe Time
forall a. Maybe a
Nothing (STM
   m
   (TimedDecision
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)
 -> Guarded
      (STM m)
      (TimedDecision
         m
         extraState
         extraDebugState
         extraFlags
         extraPeers
         peeraddr
         peerconn))
-> STM
     m
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$
      TimedDecision
  m
  extraState
  extraDebugState
  extraFlags
  extraPeers
  peeraddr
  peerconn
-> STM
     m
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimedDecision
   m
   extraState
   extraDebugState
   extraFlags
   extraPeers
   peeraddr
   peerconn
 -> STM
      m
      (TimedDecision
         m
         extraState
         extraDebugState
         extraFlags
         extraPeers
         peeraddr
         peerconn))
-> TimedDecision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
-> STM
     m
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a b. (a -> b) -> a -> b
$ \Time
_now -> Decision {
        decisionTrace :: [TracePeerSelection extraDebugState extraFlags extraPeers peeraddr]
decisionTrace = [Int
-> Int
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
Int
-> Int
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TracePublicRootsRequest
                           Int
targetNumberOfRootPeers
                           Int
numRootPeers],
        decisionState :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
decisionState = PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st { inProgressPublicRootsReq = True
                           , stdGen = fst . split $ stdGen },
        decisionJobs :: [Job
   ()
   m
   (Completion
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)]
decisionJobs  = [PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> StdGen
-> Int
-> Job
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr peerconn.
(MonadSTM m, Ord peeraddr, Semigroup extraPeers) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> StdGen
-> Int
-> Job
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
jobReqPublicRootPeers PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
actions StdGen
stdGen Int
maxExtraRootPeers]
      }

    -- If we would be able to do the request except for the time, return the
    -- next retry time.
  | Int
maxExtraRootPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  , Bool -> Bool
not Bool
inProgressPublicRootsReq
  = Maybe Time
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> Guarded m a
GuardedSkip (Time -> Maybe Time
forall a. a -> Maybe a
Just Time
publicRootRetryTime)

  | Bool
otherwise
  = Maybe Time
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall (m :: * -> *) a. Maybe Time -> Guarded m a
GuardedSkip Maybe Time
forall a. Maybe a
Nothing
  where
    PeerSelectionCounters {
        numberOfRootPeers :: forall extraCounters. PeerSelectionCounters extraCounters -> Int
numberOfRootPeers = Int
numRootPeers
      }
      =
      (extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraCounters)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionCounters extraCounters
forall peeraddr extraPeers extraState extraFlags peerconn
       extraCounters.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraCounters)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionCounters extraCounters
peerSelectionStateToCounters extraPeers -> Set peeraddr
extraPeersToSet PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraCounters
extraStateToExtraCounters PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st

    maxExtraRootPeers :: Int
maxExtraRootPeers = Int
targetNumberOfRootPeers Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numRootPeers


jobReqPublicRootPeers
  :: forall m extraState extraDebugState extraFlags extraPeers
           extraAPI extraCounters peeraddr peerconn.
     ( MonadSTM m
     , Ord peeraddr
     , Semigroup extraPeers
     )
  => PeerSelectionActions
      extraState
      extraFlags
      extraPeers
      extraAPI
      extraCounters
      peeraddr
      peerconn
      m
  -> StdGen
  -> Int
  -> Job () m (Completion m extraState extraDebugState extraFlags extraPeers
                         peeraddr peerconn)
jobReqPublicRootPeers :: forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr peerconn.
(MonadSTM m, Ord peeraddr, Semigroup extraPeers) =>
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> StdGen
-> Int
-> Job
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
jobReqPublicRootPeers PeerSelectionActions{ LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers peeraddr, DiffTime)
requestPublicRootPeers :: LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers peeraddr, DiffTime)
requestPublicRootPeers :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers peeraddr, DiffTime)
requestPublicRootPeers,
                                            extraPeersAPI :: forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PublicExtraPeersAPI extraPeers peeraddr
extraPeersAPI = PublicExtraPeersAPI {
                                              extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers :: extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers :: forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers,
                                              extraPeers -> Set peeraddr
extraPeersToSet :: forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Set peeraddr
extraPeersToSet :: extraPeers -> Set peeraddr
extraPeersToSet,
                                              extraPeers -> Bool
nullExtraPeers :: extraPeers -> Bool
nullExtraPeers :: forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr -> extraPeers -> Bool
nullExtraPeers,
                                              extraPeers -> Map peeraddr PeerAdvertise
toAdvertise :: extraPeers -> Map peeraddr PeerAdvertise
toAdvertise :: forall extraPeers peeraddr.
PublicExtraPeersAPI extraPeers peeraddr
-> extraPeers -> Map peeraddr PeerAdvertise
toAdvertise
                                          }
                                          }
                      StdGen
rng
                      Int
numExtraAllowed =
    m (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
-> (SomeException
    -> m (Completion
            m
            extraState
            extraDebugState
            extraFlags
            extraPeers
            peeraddr
            peerconn))
-> ()
-> String
-> Job
     ()
     m
     (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall group (m :: * -> *) a.
m a -> (SomeException -> m a) -> group -> String -> Job group m a
Job m (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
job (Completion
  m
  extraState
  extraDebugState
  extraFlags
  extraPeers
  peeraddr
  peerconn
-> m (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Completion
   m
   extraState
   extraDebugState
   extraFlags
   extraPeers
   peeraddr
   peerconn
 -> m (Completion
         m
         extraState
         extraDebugState
         extraFlags
         extraPeers
         peeraddr
         peerconn))
-> (SomeException
    -> Completion
         m
         extraState
         extraDebugState
         extraFlags
         extraPeers
         peeraddr
         peerconn)
-> SomeException
-> m (Completion
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException
-> Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
handler) () String
"reqPublicRootPeers"
  where
    handler :: SomeException
            -> Completion m extraState extraDebugState extraFlags extraPeers
                          peeraddr peerconn
    handler :: SomeException
-> Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
handler SomeException
e =
      (PeerSelectionState
   extraState extraFlags extraPeers peeraddr peerconn
 -> Time
 -> Decision
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)
-> Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers peeraddr peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers peeraddr peerconn
 -> Time
 -> Decision
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)
-> Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
Completion ((PeerSelectionState
    extraState extraFlags extraPeers peeraddr peerconn
  -> Time
  -> Decision
       m
       extraState
       extraDebugState
       extraFlags
       extraPeers
       peeraddr
       peerconn)
 -> Completion
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> Time
    -> Decision
         m
         extraState
         extraDebugState
         extraFlags
         extraPeers
         peeraddr
         peerconn)
-> Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
forall a b. (a -> b) -> a -> b
$ \PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st Time
now ->
      -- This is a failure, so move the backoff counter one in the failure
      -- direction (negative) and schedule the next retry time accordingly.
      -- We use an exponential backoff strategy. The max retry time of 2^8
      -- seconds is about 4 minutes.
      let publicRootBackoffs'      :: Int
          publicRootBackoffs' :: Int
publicRootBackoffs'      = (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
publicRootBackoffs PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

          publicRootRetryDiffTime' :: DiffTime
          publicRootRetryDiffTime' :: DiffTime
publicRootRetryDiffTime' = DiffTime
2 DiffTime -> Int -> DiffTime
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Int
forall a. Num a => a -> a
abs Int
publicRootBackoffs' Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
8)

          publicRootRetryTime'     :: Time
          publicRootRetryTime' :: Time
publicRootRetryTime'     = DiffTime -> Time -> Time
addTime DiffTime
publicRootRetryDiffTime' Time
now
       in Decision {
            decisionTrace :: [TracePeerSelection extraDebugState extraFlags extraPeers peeraddr]
decisionTrace = [SomeException
-> Int
-> DiffTime
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
SomeException
-> Int
-> DiffTime
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TracePublicRootsFailure
                               SomeException
e
                               Int
publicRootBackoffs'
                               DiffTime
publicRootRetryDiffTime'],
            decisionState :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
decisionState = PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st {
                              inProgressPublicRootsReq = False,
                              publicRootBackoffs  = publicRootBackoffs',
                              publicRootRetryTime = publicRootRetryTime'
                            },
            decisionJobs :: [Job
   ()
   m
   (Completion
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)]
decisionJobs  = []
          }

    job :: m (Completion m extraState extraDebugState extraFlags extraPeers
                         peeraddr peerconn)
    job :: m (Completion
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn)
job = do
      (results, ttl) <- LedgerPeersKind
-> StdGen
-> Int
-> m (PublicRootPeers extraPeers peeraddr, DiffTime)
requestPublicRootPeers LedgerPeersKind
AllLedgerPeers StdGen
rng Int
numExtraAllowed
      return $ Completion $ \PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st Time
now ->
        let newPeers :: PublicRootPeers extraPeers peeraddr
newPeers =
              (extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers.difference extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers
                ((extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers.difference extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers
                   PublicRootPeers extraPeers peeraddr
results (LocalRootPeers extraFlags peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
localRootPeers PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st)))
                ((extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet extraPeers -> Set peeraddr
extraPeersToSet (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st))
            publicRootPeers' :: PublicRootPeers extraPeers peeraddr
publicRootPeers'  = (extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
forall peeraddr extraPeers.
(Ord peeraddr, Semigroup extraPeers) =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers.mergeG extraPeers -> Set peeraddr
extraPeersToSet (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootPeers PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st) PublicRootPeers extraPeers peeraddr
newPeers
            extraPeers :: extraPeers
extraPeers = PublicRootPeers extraPeers peeraddr -> extraPeers
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
PublicRootPeers.getExtraPeers PublicRootPeers extraPeers peeraddr
publicRootPeers'
            ledgerPeers :: Set peeraddr
ledgerPeers       = PublicRootPeers extraPeers peeraddr -> Set peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toAllLedgerPeerSet PublicRootPeers extraPeers peeraddr
publicRootPeers'
            -- Add extra peers
            knownPeers' :: KnownPeers peeraddr
knownPeers' = Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.insert
                            -- When we don't know about the PeerSharing information
                            -- we default to PeerSharingDisabled. I.e. we only pass
                            -- a Just value if we want a different value than
                            -- the the default one.
                            ( [(peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise))]
-> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            ([(peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise))]
 -> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise))
-> ([(peeraddr, PeerAdvertise)]
    -> [(peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise))])
-> [(peeraddr, PeerAdvertise)]
-> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((peeraddr, PeerAdvertise)
 -> (peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise)))
-> [(peeraddr, PeerAdvertise)]
-> [(peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise))]
forall a b. (a -> b) -> [a] -> [b]
map (\(peeraddr
p, PeerAdvertise
pa) -> (peeraddr
p, (Maybe PeerSharing
forall a. Maybe a
Nothing, PeerAdvertise -> Maybe PeerAdvertise
forall a. a -> Maybe a
Just PeerAdvertise
pa)))
                            ([(peeraddr, PeerAdvertise)]
 -> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise))
-> [(peeraddr, PeerAdvertise)]
-> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
forall a b. (a -> b) -> a -> b
$ Map peeraddr PeerAdvertise -> [(peeraddr, PeerAdvertise)]
forall k a. Map k a -> [(k, a)]
Map.assocs (extraPeers -> Map peeraddr PeerAdvertise
toAdvertise extraPeers
extraPeers)
                            )
                            (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
knownPeers PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st)

            -- Add ledger peers
            knownPeers'' :: KnownPeers peeraddr
knownPeers'' = Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.insert
                            -- When we don't know about the PeerSharing information
                            -- we default to NoPeerSharing. I.e. we only pass
                            -- a Just value if we want a different value than
                            -- the the default one.
                            ( [(peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise))]
-> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            ([(peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise))]
 -> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise))
-> ([peeraddr]
    -> [(peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise))])
-> [peeraddr]
-> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (peeraddr -> (peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise)))
-> [peeraddr]
-> [(peeraddr, (Maybe PeerSharing, Maybe PeerAdvertise))]
forall a b. (a -> b) -> [a] -> [b]
map (,(Maybe PeerSharing
forall a. Maybe a
Nothing, Maybe PeerAdvertise
forall a. Maybe a
Nothing))
                            ([peeraddr]
 -> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise))
-> [peeraddr]
-> Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
forall a b. (a -> b) -> a -> b
$ Set peeraddr -> [peeraddr]
forall a. Set a -> [a]
Set.toList Set peeraddr
ledgerPeers
                            )
                            KnownPeers peeraddr
knownPeers'

            -- We got a successful response to our request, but if we're still
            -- below target we're going to want to try again at some point.
            -- If we made progress towards our target then we will retry at the
            -- suggested ttl. But if we did not make progress then we want to
            -- follow an exponential backoff strategy. The max retry time of 2^8
            -- seconds is about 4 minutes.
            publicRootBackoffs' :: Int
            publicRootBackoffs' :: Int
publicRootBackoffs'
              | (extraPeers -> Bool) -> PublicRootPeers extraPeers peeraddr -> Bool
forall extraPeers peeraddr.
(extraPeers -> Bool) -> PublicRootPeers extraPeers peeraddr -> Bool
PublicRootPeers.null extraPeers -> Bool
nullExtraPeers PublicRootPeers extraPeers peeraddr
newPeers = (PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
publicRootBackoffs PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              | Bool
otherwise                     = Int
0

            publicRootRetryDiffTime :: DiffTime
            publicRootRetryDiffTime :: DiffTime
publicRootRetryDiffTime
              | Int
publicRootBackoffs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                          = DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
min DiffTime
60 DiffTime
ttl -- don't let days long dns timeout kreep in here.
              | Bool
otherwise = DiffTime
2DiffTime -> Int -> DiffTime
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
publicRootBackoffs' Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
8)

            publicRootRetryTime :: Time
            publicRootRetryTime :: Time
publicRootRetryTime = DiffTime -> Time -> Time
addTime DiffTime
publicRootRetryDiffTime Time
now

         in Bool
-> Decision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
-> Decision
     m
     extraState
     extraDebugState
     extraFlags
     extraPeers
     peeraddr
     peerconn
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
                     ((extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet extraPeers -> Set peeraddr
extraPeersToSet PublicRootPeers extraPeers peeraddr
publicRootPeers')
                     (KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers''))

             Decision {
                decisionTrace :: [TracePeerSelection extraDebugState extraFlags extraPeers peeraddr]
decisionTrace = [PublicRootPeers extraPeers peeraddr
-> Int
-> DiffTime
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
forall extraDebugState extraFlags extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr
-> Int
-> DiffTime
-> TracePeerSelection
     extraDebugState extraFlags extraPeers peeraddr
TracePublicRootsResults
                                  PublicRootPeers extraPeers peeraddr
newPeers
                                  Int
publicRootBackoffs'
                                  DiffTime
publicRootRetryDiffTime],
                decisionState :: PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
decisionState = PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
st {
                                  publicRootPeers     = publicRootPeers',
                                  knownPeers          = knownPeers'',
                                  publicRootBackoffs  = publicRootBackoffs',
                                  publicRootRetryTime = publicRootRetryTime,
                                  inProgressPublicRootsReq = False
                                },
                decisionJobs :: [Job
   ()
   m
   (Completion
      m
      extraState
      extraDebugState
      extraFlags
      extraPeers
      peeraddr
      peerconn)]
decisionJobs  = []
              }