{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

import           Data.Maybe (fromMaybe)
import           Data.Semigroup (Min (..))
import qualified Data.Set as Set

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

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


---------------------------
-- Known peers below target
--


-- | If we are below the target of /known peers/ we gossip (if we are above the
-- gossip request threashold).
--
belowTarget :: (MonadAsync m, MonadTimer 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
actions
            policy :: PeerSelectionPolicy peeraddr m
policy@PeerSelectionPolicy {
              Int
policyMaxInProgressGossipReqs :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> Int
policyMaxInProgressGossipReqs :: Int
policyMaxInProgressGossipReqs,
              PickPolicy peeraddr m
policyPickKnownPeersForGossip :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickKnownPeersForGossip :: PickPolicy peeraddr m
policyPickKnownPeersForGossip,
              DiffTime
policyGossipRetryTime :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyGossipRetryTime :: DiffTime
policyGossipRetryTime
            }
            st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
              KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers,
              Int
inProgressGossipReqs :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
inProgressGossipReqs :: Int
inProgressGossipReqs,
              targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                          Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers
                        }
            }
    -- Are we under target for number of known peers?
  | Int
numKnownPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetNumberOfKnownPeers

    -- Are we at our limit for number of gossip requests?
  , Int
numGossipReqsPossible Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

    -- Are there any known peers that we can send a gossip request to?
    -- We can only ask ones where we have not asked them within a certain time.
  , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
availableForGossip)
  = 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
selectedForGossip <- 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
policyPickKnownPeersForGossip
                             Set peeraddr
availableForGossip
                             Int
numGossipReqsPossible
      let numGossipReqs :: Int
numGossipReqs = Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
selectedForGossip
      (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
-> Set peeraddr
-> TracePeerSelection peeraddr
forall peeraddr.
Int
-> Int
-> Set peeraddr
-> Set peeraddr
-> TracePeerSelection peeraddr
TraceGossipRequests
                          Int
targetNumberOfKnownPeers
                          Int
numKnownPeers
                          Set peeraddr
availableForGossip
                          Set peeraddr
selectedForGossip,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressGossipReqs :: Int
inProgressGossipReqs = Int
inProgressGossipReqs
                                               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numGossipReqs,
                          knownPeers :: KnownPeers peeraddr
knownPeers = Set peeraddr -> Time -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> Time -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.setGossipTime
                                         Set peeraddr
selectedForGossip
                                         (DiffTime -> Time -> Time
addTime DiffTime
policyGossipRetryTime Time
now)
                                         KnownPeers peeraddr
knownPeers
                        },
        decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = [PeerSelectionActions peeraddr peerconn m
-> PeerSelectionPolicy peeraddr m
-> [peeraddr]
-> Job () m (Completion m peeraddr peerconn)
forall (m :: * -> *) peeraddr peerconn.
(MonadAsync m, MonadTimer m, Ord peeraddr) =>
PeerSelectionActions peeraddr peerconn m
-> PeerSelectionPolicy peeraddr m
-> [peeraddr]
-> Job () m (Completion m peeraddr peerconn)
jobGossip PeerSelectionActions peeraddr peerconn m
actions PeerSelectionPolicy peeraddr m
policy
                           (Set peeraddr -> [peeraddr]
forall a. Set a -> [a]
Set.toList Set peeraddr
selectedForGossip)]
      }

    -- If we could gossip except that there are none currently available
    -- then we return the next wakeup time (if any)
  | Int
numKnownPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
targetNumberOfKnownPeers
  , Int
numGossipReqsPossible Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  , Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
availableForGossip
  = 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.minGossipTime 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
    numKnownPeers :: Int
numKnownPeers         = KnownPeers peeraddr -> Int
forall peeraddr. KnownPeers peeraddr -> Int
KnownPeers.size KnownPeers peeraddr
knownPeers
    numGossipReqsPossible :: Int
numGossipReqsPossible = Int
policyMaxInProgressGossipReqs
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inProgressGossipReqs
    availableForGossip :: Set peeraddr
availableForGossip    = KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.availableForGossip KnownPeers peeraddr
knownPeers


jobGossip :: forall m peeraddr peerconn.
             (MonadAsync m, MonadTimer m, Ord peeraddr)
          => PeerSelectionActions peeraddr peerconn m
          -> PeerSelectionPolicy peeraddr m
          -> [peeraddr]
          -> Job () m (Completion m peeraddr peerconn)
jobGossip :: PeerSelectionActions peeraddr peerconn m
-> PeerSelectionPolicy peeraddr m
-> [peeraddr]
-> Job () m (Completion m peeraddr peerconn)
jobGossip PeerSelectionActions{peeraddr -> m [peeraddr]
requestPeerGossip :: forall peeraddr peerconn (m :: * -> *).
PeerSelectionActions peeraddr peerconn m
-> peeraddr -> m [peeraddr]
requestPeerGossip :: peeraddr -> m [peeraddr]
requestPeerGossip}
           PeerSelectionPolicy{Int
DiffTime
PickPolicy peeraddr m
policyGossipOverallTimeout :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyGossipBatchWaitTime :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyFindPublicRootTimeout :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyPickColdPeersToForget :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickWarmPeersToDemote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickHotPeersToDemote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickWarmPeersToPromote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickColdPeersToPromote :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyGossipOverallTimeout :: DiffTime
policyGossipBatchWaitTime :: DiffTime
policyGossipRetryTime :: DiffTime
policyMaxInProgressGossipReqs :: Int
policyFindPublicRootTimeout :: DiffTime
policyPickColdPeersToForget :: PickPolicy peeraddr m
policyPickWarmPeersToDemote :: PickPolicy peeraddr m
policyPickHotPeersToDemote :: PickPolicy peeraddr m
policyPickWarmPeersToPromote :: PickPolicy peeraddr m
policyPickColdPeersToPromote :: PickPolicy peeraddr m
policyPickKnownPeersForGossip :: PickPolicy peeraddr m
policyGossipRetryTime :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> DiffTime
policyPickKnownPeersForGossip :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyMaxInProgressGossipReqs :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> Int
..} =
    \[peeraddr]
peers -> 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 ([peeraddr] -> m (Completion m peeraddr peerconn)
jobPhase1 [peeraddr]
peers) ([peeraddr] -> SomeException -> m (Completion m peeraddr peerconn)
handler [peeraddr]
peers) () String
"gossipPhase1"
  where
    handler :: [peeraddr] -> SomeException -> m (Completion m peeraddr peerconn)
    handler :: [peeraddr] -> SomeException -> m (Completion m peeraddr peerconn)
handler [peeraddr]
peers 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
$ \PeerSelectionState peeraddr peerconn
st Time
_ ->
      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 = [(peeraddr, Either SomeException [peeraddr])]
-> TracePeerSelection peeraddr
forall peeraddr.
[(peeraddr, Either SomeException [peeraddr])]
-> TracePeerSelection peeraddr
TraceGossipResults [ (peeraddr
p, SomeException -> Either SomeException [peeraddr]
forall a b. a -> Either a b
Left SomeException
e) | peeraddr
p <- [peeraddr]
peers ],
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          inProgressGossipReqs :: Int
inProgressGossipReqs = PeerSelectionState peeraddr peerconn -> Int
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
inProgressGossipReqs PeerSelectionState peeraddr peerconn
st
                                               Int -> Int -> Int
forall a. Num a => a -> a -> a
- [peeraddr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [peeraddr]
peers
                        },
        decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
      }

    jobPhase1 :: [peeraddr] -> m (Completion m peeraddr peerconn)
    jobPhase1 :: [peeraddr] -> m (Completion m peeraddr peerconn)
jobPhase1 [peeraddr]
peers = do
      -- In the typical case, where most requests return within a short
      -- timeout we want to collect all the responses into a batch and
      -- add them to the known peers set in one go.
      --
      -- So fire them all off in one go:
      [Async m [peeraddr]]
gossips <- [m (Async m [peeraddr])] -> m [Async m [peeraddr]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ m [peeraddr] -> m (Async m [peeraddr])
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (peeraddr -> m [peeraddr]
requestPeerGossip peeraddr
peer) | peeraddr
peer <- [peeraddr]
peers ]

      -- First to finish synchronisation between /all/ the gossips completing
      -- or the timeout (with whatever partial results we have at the time)
      Either
  [Maybe (Either SomeException [peeraddr])]
  [Either SomeException [peeraddr]]
results <- [Async m [peeraddr]]
-> DiffTime
-> m (Either
        [Maybe (Either SomeException [peeraddr])]
        [Either SomeException [peeraddr]])
forall (m :: * -> *) a.
(MonadAsync m, MonadTimer m) =>
[Async m a]
-> DiffTime
-> m (Either
        [Maybe (Either SomeException a)] [Either SomeException a])
waitAllCatchOrTimeout [Async m [peeraddr]]
gossips DiffTime
policyGossipBatchWaitTime
      case Either
  [Maybe (Either SomeException [peeraddr])]
  [Either SomeException [peeraddr]]
results of
        Right [Either SomeException [peeraddr]]
totalResults -> do
          let peerResults :: [(peeraddr, Either SomeException [peeraddr])]
peerResults = [peeraddr]
-> [Either SomeException [peeraddr]]
-> [(peeraddr, Either SomeException [peeraddr])]
forall a b. [a] -> [b] -> [(a, b)]
zip [peeraddr]
peers [Either SomeException [peeraddr]]
totalResults
              newPeers :: [peeraddr]
newPeers    = [ peeraddr
p | Right [peeraddr]
ps <- [Either SomeException [peeraddr]]
totalResults, peeraddr
p <- [peeraddr]
ps ]
          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
$ \PeerSelectionState peeraddr peerconn
st Time
_ -> 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 = [(peeraddr, Either SomeException [peeraddr])]
-> TracePeerSelection peeraddr
forall peeraddr.
[(peeraddr, Either SomeException [peeraddr])]
-> TracePeerSelection peeraddr
TraceGossipResults [(peeraddr, Either SomeException [peeraddr])]
peerResults,
            decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                              --TODO: also update with the failures
                              knownPeers :: KnownPeers peeraddr
knownPeers = Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.insert
                                             ([peeraddr] -> Set peeraddr
forall a. Ord a => [a] -> Set a
Set.fromList [peeraddr]
newPeers)
                                             (PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers PeerSelectionState peeraddr peerconn
st),
                              inProgressGossipReqs :: Int
inProgressGossipReqs = PeerSelectionState peeraddr peerconn -> Int
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
inProgressGossipReqs PeerSelectionState peeraddr peerconn
st
                                                   Int -> Int -> Int
forall a. Num a => a -> a -> a
- [peeraddr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [peeraddr]
peers
                            },
            decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
          }

        -- But if any don't make the first timeout then they'll be added later
        -- when they do reply or never if we hit the hard timeout.
        Left [Maybe (Either SomeException [peeraddr])]
partialResults -> do

          -- We have to keep track of the relationship between the peer
          -- addresses and the gossip requests, completed and still in progress:
          let peerResults :: [(peeraddr, Either SomeException [peeraddr])]
peerResults      = [ (peeraddr
p, Either SomeException [peeraddr]
r)
                                 | (peeraddr
p, Just Either SomeException [peeraddr]
r)  <- [peeraddr]
-> [Maybe (Either SomeException [peeraddr])]
-> [(peeraddr, Maybe (Either SomeException [peeraddr]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [peeraddr]
peers   [Maybe (Either SomeException [peeraddr])]
partialResults ]
              newPeers :: [peeraddr]
newPeers         = [  peeraddr
p
                                 | Just (Right [peeraddr]
ps) <-          [Maybe (Either SomeException [peeraddr])]
partialResults
                                 ,  peeraddr
p <- [peeraddr]
ps ]
              peersRemaining :: [peeraddr]
peersRemaining   = [  peeraddr
p
                                 | (peeraddr
p, Maybe (Either SomeException [peeraddr])
Nothing) <- [peeraddr]
-> [Maybe (Either SomeException [peeraddr])]
-> [(peeraddr, Maybe (Either SomeException [peeraddr]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [peeraddr]
peers   [Maybe (Either SomeException [peeraddr])]
partialResults ]
              gossipsRemaining :: [Async m [peeraddr]]
gossipsRemaining = [  Async m [peeraddr]
a
                                 | (Async m [peeraddr]
a, Maybe (Either SomeException [peeraddr])
Nothing) <- [Async m [peeraddr]]
-> [Maybe (Either SomeException [peeraddr])]
-> [(Async m [peeraddr], Maybe (Either SomeException [peeraddr]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Async m [peeraddr]]
gossips [Maybe (Either SomeException [peeraddr])]
partialResults ]

          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
$ \PeerSelectionState peeraddr peerconn
st Time
_ -> 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 = [(peeraddr, Either SomeException [peeraddr])]
-> TracePeerSelection peeraddr
forall peeraddr.
[(peeraddr, Either SomeException [peeraddr])]
-> TracePeerSelection peeraddr
TraceGossipResults [(peeraddr, Either SomeException [peeraddr])]
peerResults,
            decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                              --TODO: also update with the failures
                              knownPeers :: KnownPeers peeraddr
knownPeers = Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.insert
                                             ([peeraddr] -> Set peeraddr
forall a. Ord a => [a] -> Set a
Set.fromList [peeraddr]
newPeers)
                                             (PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers PeerSelectionState peeraddr peerconn
st),
                              inProgressGossipReqs :: Int
inProgressGossipReqs = PeerSelectionState peeraddr peerconn -> Int
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
inProgressGossipReqs PeerSelectionState peeraddr peerconn
st
                                                   Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(peeraddr, Either SomeException [peeraddr])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(peeraddr, Either SomeException [peeraddr])]
peerResults
                            },
            decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = [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 ([peeraddr]
-> [Async m [peeraddr]] -> m (Completion m peeraddr peerconn)
jobPhase2 [peeraddr]
peersRemaining [Async m [peeraddr]]
gossipsRemaining)
                                 ([peeraddr] -> SomeException -> m (Completion m peeraddr peerconn)
handler [peeraddr]
peersRemaining)
                                 ()
                                 String
"gossipPhase2"]
          }

    jobPhase2 :: [peeraddr] -> [Async m [peeraddr]]
              -> m (Completion m peeraddr peerconn)
    jobPhase2 :: [peeraddr]
-> [Async m [peeraddr]] -> m (Completion m peeraddr peerconn)
jobPhase2 [peeraddr]
peers [Async m [peeraddr]]
gossips = do

      -- Wait again, for all remaining to finish or a timeout.
      Either
  [Maybe (Either SomeException [peeraddr])]
  [Either SomeException [peeraddr]]
results <- [Async m [peeraddr]]
-> DiffTime
-> m (Either
        [Maybe (Either SomeException [peeraddr])]
        [Either SomeException [peeraddr]])
forall (m :: * -> *) a.
(MonadAsync m, MonadTimer m) =>
[Async m a]
-> DiffTime
-> m (Either
        [Maybe (Either SomeException a)] [Either SomeException a])
waitAllCatchOrTimeout
                      [Async m [peeraddr]]
gossips
                      (DiffTime
policyGossipOverallTimeout
                       DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
policyGossipBatchWaitTime)
      let peerResults :: [(peeraddr, Either SomeException [peeraddr])]
peerResults =
            case Either
  [Maybe (Either SomeException [peeraddr])]
  [Either SomeException [peeraddr]]
results of
              Right [Either SomeException [peeraddr]]
totalResults  -> [peeraddr]
-> [Either SomeException [peeraddr]]
-> [(peeraddr, Either SomeException [peeraddr])]
forall a b. [a] -> [b] -> [(a, b)]
zip [peeraddr]
peers [Either SomeException [peeraddr]]
totalResults
              Left [Maybe (Either SomeException [peeraddr])]
partialResults -> [ (peeraddr
p, Either SomeException [peeraddr]
-> Maybe (Either SomeException [peeraddr])
-> Either SomeException [peeraddr]
forall a. a -> Maybe a -> a
fromMaybe Either SomeException [peeraddr]
forall b. Either SomeException b
err Maybe (Either SomeException [peeraddr])
r)
                                     | (peeraddr
p, Maybe (Either SomeException [peeraddr])
r) <- [peeraddr]
-> [Maybe (Either SomeException [peeraddr])]
-> [(peeraddr, Maybe (Either SomeException [peeraddr]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [peeraddr]
peers [Maybe (Either SomeException [peeraddr])]
partialResults ]
                where err :: Either SomeException b
err = SomeException -> Either SomeException b
forall a b. a -> Either a b
Left (AsyncCancelled -> SomeException
forall e. Exception e => e -> SomeException
toException AsyncCancelled
AsyncCancelled)

          newPeers :: [peeraddr]
newPeers =
            case Either
  [Maybe (Either SomeException [peeraddr])]
  [Either SomeException [peeraddr]]
results of
              Right [Either SomeException [peeraddr]]
totalResults  -> [ peeraddr
p | Right [peeraddr]
ps <- [Either SomeException [peeraddr]]
totalResults,  peeraddr
p <- [peeraddr]
ps ]
              Left [Maybe (Either SomeException [peeraddr])]
partialResults -> [ peeraddr
p | Just (Right [peeraddr]
ps) <- [Maybe (Either SomeException [peeraddr])]
partialResults,  peeraddr
p <- [peeraddr]
ps ]

          gossipsIncomplete :: [Async m [peeraddr]]
gossipsIncomplete =
            case Either
  [Maybe (Either SomeException [peeraddr])]
  [Either SomeException [peeraddr]]
results of
              Right [Either SomeException [peeraddr]]
_totalResults -> []
              Left [Maybe (Either SomeException [peeraddr])]
partialResults ->
                [ Async m [peeraddr]
a | (Async m [peeraddr]
a, Maybe (Either SomeException [peeraddr])
Nothing) <- [Async m [peeraddr]]
-> [Maybe (Either SomeException [peeraddr])]
-> [(Async m [peeraddr], Maybe (Either SomeException [peeraddr]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Async m [peeraddr]]
gossips [Maybe (Either SomeException [peeraddr])]
partialResults ]

      (Async m [peeraddr] -> m ()) -> [Async m [peeraddr]] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async m [peeraddr] -> m ()
forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel [Async m [peeraddr]]
gossipsIncomplete

      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
$ \PeerSelectionState peeraddr peerconn
st Time
_ -> 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 = [(peeraddr, Either SomeException [peeraddr])]
-> TracePeerSelection peeraddr
forall peeraddr.
[(peeraddr, Either SomeException [peeraddr])]
-> TracePeerSelection peeraddr
TraceGossipResults [(peeraddr, Either SomeException [peeraddr])]
peerResults,
        decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st {
                          --TODO: also update with the failures
                          knownPeers :: KnownPeers peeraddr
knownPeers = Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.insert
                                         ([peeraddr] -> Set peeraddr
forall a. Ord a => [a] -> Set a
Set.fromList [peeraddr]
newPeers)
                                         (PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
knownPeers PeerSelectionState peeraddr peerconn
st),
                          inProgressGossipReqs :: Int
inProgressGossipReqs = PeerSelectionState peeraddr peerconn -> Int
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Int
inProgressGossipReqs PeerSelectionState peeraddr peerconn
st
                                               Int -> Int -> Int
forall a. Num a => a -> a -> a
- [peeraddr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [peeraddr]
peers
                        },
        decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
      }


---------------------------
-- Known peers above target
--


-- | If we are above the target of /known peers/ (i.e. /cold/, /warm/ and /hot/
-- combined), we drop some of the /cold peers/ but we protect the
-- 'targetNumberOfRootPeers' (from combined sets of /local/ and /public root/
-- peers). 'policyPickColdPeersToForget' policy is used to pick the peers.
--
aboveTarget :: (MonadSTM m, Ord peeraddr)
            => MkGuardedDecision peeraddr peerconn m
aboveTarget :: MkGuardedDecision peeraddr peerconn m
aboveTarget PeerSelectionPolicy {
              PickPolicy peeraddr m
policyPickColdPeersToForget :: PickPolicy peeraddr m
policyPickColdPeersToForget :: forall peeraddr (m :: * -> *).
PeerSelectionPolicy peeraddr m -> PickPolicy peeraddr m
policyPickColdPeersToForget
            }
            st :: PeerSelectionState peeraddr peerconn
st@PeerSelectionState {
              LocalRootPeers peeraddr
localRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
localRootPeers :: LocalRootPeers peeraddr
localRootPeers,
              Set peeraddr
publicRootPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
publicRootPeers :: Set peeraddr
publicRootPeers,
              KnownPeers peeraddr
knownPeers :: KnownPeers peeraddr
knownPeers :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> 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,
              targets :: forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
targets = PeerSelectionTargets {
                          Int
targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers,
                          Int
targetNumberOfRootPeers :: PeerSelectionTargets -> Int
targetNumberOfRootPeers :: Int
targetNumberOfRootPeers
                        }
            }
    -- Are we above the target for number of known peers?
  | Int
numKnownPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
targetNumberOfKnownPeers

    -- Are there any cold peers we could pick to forget?
    -- As a first cheap approximation, check if there are any cold peers.
  , Int
numKnownPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
numEstablishedPeers

    -- Beyond this it gets more complicated, and it is not clear that there
    -- are any precise cheap checks. So we just do the full calculation.
    -- In particular there can be overlap between cold peers and root peers
    -- and we have constraints on forgetting root peers.
    --
    -- We must never pick local root peers to forget as this would violate
    -- our invariant that the localRootPeers is a subset of the knownPeers.
    --
    -- We also need to avoid picking public root peers if that would put us
    -- below the target for root peers.
    --
  , let numRootPeersCanForget :: Int
numRootPeersCanForget = LocalRootPeers peeraddr -> Int
forall peeraddr. LocalRootPeers peeraddr -> Int
LocalRootPeers.size LocalRootPeers peeraddr
localRootPeers
                              Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
publicRootPeers
                              Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
targetNumberOfRootPeers
        availableToForget :: Set peeraddr
availableToForget     = KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers
                                  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.\\ 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.\\ (if Int
numRootPeersCanForget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                                            then Set peeraddr
publicRootPeers else Set peeraddr
forall a. Set a
Set.empty)
                                  Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
inProgressPromoteCold

  , Bool -> Bool
not (Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
availableToForget)
  = 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 numOtherPeersToForget :: Int
numOtherPeersToForget         = Int
numKnownPeers
                                        Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
targetNumberOfKnownPeers
          numPeersToForget :: Int
numPeersToForget
            | Int
numRootPeersCanForget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
numRootPeersCanForget
                                              Int
numOtherPeersToForget
            | Bool
otherwise                 = Int
numOtherPeersToForget
      -- If we /might/ pick a root peer, limit the number to forget so we do
      -- not pick too many root peers. This may cause us to go round several
      -- times but that is ok.
      Set peeraddr
selectedToForget <- 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
policyPickColdPeersToForget
                            Set peeraddr
availableToForget
                            Int
numPeersToForget
      (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 ->
        let knownPeers' :: KnownPeers peeraddr
knownPeers'      = Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.delete
                                 Set peeraddr
selectedToForget
                                 KnownPeers peeraddr
knownPeers
            publicRootPeers' :: Set peeraddr
publicRootPeers' = Set peeraddr
publicRootPeers
                                 Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
selectedToForget
        in Bool
-> Decision m peeraddr peerconn -> Decision m 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
                     Set peeraddr
publicRootPeers'
                    (KnownPeers peeraddr -> Set peeraddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers peeraddr
knownPeers'))

              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
TraceForgetColdPeers
                                  Int
targetNumberOfKnownPeers
                                  Int
numKnownPeers
                                  Set peeraddr
selectedToForget,
                decisionState :: PeerSelectionState peeraddr peerconn
decisionState = PeerSelectionState peeraddr peerconn
st { knownPeers :: KnownPeers peeraddr
knownPeers      = KnownPeers peeraddr
knownPeers',
                                     publicRootPeers :: Set peeraddr
publicRootPeers = Set peeraddr
publicRootPeers' },
                decisionJobs :: [Job () m (Completion m peeraddr peerconn)]
decisionJobs  = []
              }

  | 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
    numKnownPeers, numEstablishedPeers :: Int
    numKnownPeers :: Int
numKnownPeers        = KnownPeers peeraddr -> Int
forall peeraddr. KnownPeers peeraddr -> Int
KnownPeers.size KnownPeers peeraddr
knownPeers
    numEstablishedPeers :: Int
numEstablishedPeers  = EstablishedPeers peeraddr peerconn -> Int
forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
EstablishedPeers.size EstablishedPeers peeraddr peerconn
establishedPeers


-------------------------------
-- Utils
--

-- | Perform a first-to-finish synchronisation between:
--
-- * /all/ the async actions completing; or
-- * the timeout with whatever partial results we have at the time
--
-- The result list is the same length and order as the asyncs, so the results
-- can be paired up.
--
waitAllCatchOrTimeout :: (MonadAsync m, MonadTimer m)
                      => [Async m a]
                      -> DiffTime
                      -> m (Either [Maybe (Either SomeException a)]
                                   [Either SomeException a])
waitAllCatchOrTimeout :: [Async m a]
-> DiffTime
-> m (Either
        [Maybe (Either SomeException a)] [Either SomeException a])
waitAllCatchOrTimeout [Async m a]
as DiffTime
time = do
    Timeout m
t       <- DiffTime -> m (Timeout m)
forall (m :: * -> *). MonadTimer m => DiffTime -> m (Timeout m)
newTimeout DiffTime
time
    Either [Maybe (Either SomeException a)] [Either SomeException a]
results <- STM
  m
  (Either [Maybe (Either SomeException a)] [Either SomeException a])
-> m (Either
        [Maybe (Either SomeException a)] [Either SomeException a])
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
   m
   (Either [Maybe (Either SomeException a)] [Either SomeException a])
 -> m (Either
         [Maybe (Either SomeException a)] [Either SomeException a]))
-> STM
     m
     (Either [Maybe (Either SomeException a)] [Either SomeException a])
-> m (Either
        [Maybe (Either SomeException a)] [Either SomeException a])
forall a b. (a -> b) -> a -> b
$
                         ([Either SomeException a]
-> Either [Maybe (Either SomeException a)] [Either SomeException a]
forall a b. b -> Either a b
Right ([Either SomeException a]
 -> Either
      [Maybe (Either SomeException a)] [Either SomeException a])
-> STM m [Either SomeException a]
-> STM
     m
     (Either [Maybe (Either SomeException a)] [Either SomeException a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Async m a -> STM m (Either SomeException a))
-> [Async m a] -> STM m [Either SomeException a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Async m a -> STM m (Either SomeException a)
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM [Async m a]
as)
                STM
  m
  (Either [Maybe (Either SomeException a)] [Either SomeException a])
-> STM
     m
     (Either [Maybe (Either SomeException a)] [Either SomeException a])
-> STM
     m
     (Either [Maybe (Either SomeException a)] [Either SomeException a])
forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse` ([Maybe (Either SomeException a)]
-> Either [Maybe (Either SomeException a)] [Either SomeException a]
forall a b. a -> Either a b
Left  ([Maybe (Either SomeException a)]
 -> Either
      [Maybe (Either SomeException a)] [Either SomeException a])
-> STM m [Maybe (Either SomeException a)]
-> STM
     m
     (Either [Maybe (Either SomeException a)] [Either SomeException a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Timeout m -> STM m Bool
forall (m :: * -> *). MonadTimer m => Timeout m -> STM m Bool
awaitTimeout Timeout m
t STM m Bool
-> STM m [Maybe (Either SomeException a)]
-> STM m [Maybe (Either SomeException a)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Async m a -> STM m (Maybe (Either SomeException a)))
-> [Async m a] -> STM m [Maybe (Either SomeException a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Async m a -> STM m (Maybe (Either SomeException a))
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Maybe (Either SomeException a))
pollSTM [Async m a]
as))
    case Either [Maybe (Either SomeException a)] [Either SomeException a]
results of
      Right{} -> Timeout m -> m ()
forall (m :: * -> *). MonadTimer m => Timeout m -> m ()
cancelTimeout Timeout m
t
      Either [Maybe (Either SomeException a)] [Either SomeException a]
_       -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Either [Maybe (Either SomeException a)] [Either SomeException a]
-> m (Either
        [Maybe (Either SomeException a)] [Either SomeException a])
forall (m :: * -> *) a. Monad m => a -> m a
return Either [Maybe (Either SomeException a)] [Either SomeException a]
results