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

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Ouroboros.Network.PeerSelection.State.EstablishedPeers
  ( EstablishedPeers
  , empty
  , toMap
  , toSet
  , readyPeers
  , size
  , sizeReady
  , member
  , insert
  , delete
  , deletePeers
    -- * Special operations
  , setCurrentTime
  , setActivateTimes
    -- ** Tracking when we can (re)activate
  , minActivateTime
    -- ** Tracking when we can peer share
  , minPeerShareTime
  , setPeerShareTime
  , availableForPeerShare
  , nextPeerShareTimes
  , invariant
  ) where

import Prelude

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

import Control.Exception (assert)
import Control.Monad.Class.MonadTime.SI


-------------------------------
-- Established peer set representation
--

-- | The set of established peers. To a first approximation it can be thought of
-- as a 'Set' of @peeraddr@.
--
-- It has one special feature:
--
--  * It tracks which peers we are permitted to ask for peers now, or for peers
--    we cannot issue share requests with now the time at which we would next be
--    allowed to do so.
--
data EstablishedPeers peeraddr peerconn = EstablishedPeers {
    -- | Peers which are either ready to become active or are active.
    --
    forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers              :: !(Map peeraddr peerconn),

    -- | The subset of established peers that we would be allowed to peer share
    -- with now. This is because we have not peer shared with them recently.
    --
    -- NOTE that this is the set of available peers one would be able to perform
    -- peer sharing _now_, it doesn't mean they are 100% eligible. This will
    -- depend on other factors like the peer's 'PeerSharing' value.
    --
    forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
availableForPeerShare :: !(Set peeraddr),

    -- | The subset of established peers that we cannot peer share with now. It
    -- keeps track of the next time we are allowed to peer share with them.
    --
    forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextPeerShareTimes    :: !(OrdPSQ peeraddr Time ()),


    -- | Peers which are not ready to become active.
    forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes     :: !(OrdPSQ peeraddr Time ())
  }
  deriving (Int -> EstablishedPeers peeraddr peerconn -> ShowS
[EstablishedPeers peeraddr peerconn] -> ShowS
EstablishedPeers peeraddr peerconn -> String
(Int -> EstablishedPeers peeraddr peerconn -> ShowS)
-> (EstablishedPeers peeraddr peerconn -> String)
-> ([EstablishedPeers peeraddr peerconn] -> ShowS)
-> Show (EstablishedPeers peeraddr peerconn)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall peeraddr peerconn.
(Show peeraddr, Show peerconn) =>
Int -> EstablishedPeers peeraddr peerconn -> ShowS
forall peeraddr peerconn.
(Show peeraddr, Show peerconn) =>
[EstablishedPeers peeraddr peerconn] -> ShowS
forall peeraddr peerconn.
(Show peeraddr, Show peerconn) =>
EstablishedPeers peeraddr peerconn -> String
$cshowsPrec :: forall peeraddr peerconn.
(Show peeraddr, Show peerconn) =>
Int -> EstablishedPeers peeraddr peerconn -> ShowS
showsPrec :: Int -> EstablishedPeers peeraddr peerconn -> ShowS
$cshow :: forall peeraddr peerconn.
(Show peeraddr, Show peerconn) =>
EstablishedPeers peeraddr peerconn -> String
show :: EstablishedPeers peeraddr peerconn -> String
$cshowList :: forall peeraddr peerconn.
(Show peeraddr, Show peerconn) =>
[EstablishedPeers peeraddr peerconn] -> ShowS
showList :: [EstablishedPeers peeraddr peerconn] -> ShowS
Show, (forall a b.
 (a -> b)
 -> EstablishedPeers peeraddr a -> EstablishedPeers peeraddr b)
-> (forall a b.
    a -> EstablishedPeers peeraddr b -> EstablishedPeers peeraddr a)
-> Functor (EstablishedPeers peeraddr)
forall a b.
a -> EstablishedPeers peeraddr b -> EstablishedPeers peeraddr a
forall a b.
(a -> b)
-> EstablishedPeers peeraddr a -> EstablishedPeers peeraddr b
forall peeraddr a b.
a -> EstablishedPeers peeraddr b -> EstablishedPeers peeraddr a
forall peeraddr a b.
(a -> b)
-> EstablishedPeers peeraddr a -> EstablishedPeers peeraddr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall peeraddr a b.
(a -> b)
-> EstablishedPeers peeraddr a -> EstablishedPeers peeraddr b
fmap :: forall a b.
(a -> b)
-> EstablishedPeers peeraddr a -> EstablishedPeers peeraddr b
$c<$ :: forall peeraddr a b.
a -> EstablishedPeers peeraddr b -> EstablishedPeers peeraddr a
<$ :: forall a b.
a -> EstablishedPeers peeraddr b -> EstablishedPeers peeraddr a
Functor)


empty :: EstablishedPeers peeraddr perconn
empty :: forall peeraddr perconn. EstablishedPeers peeraddr perconn
empty = EstablishedPeers {
      allPeers :: Map peeraddr perconn
allPeers              = Map peeraddr perconn
forall k a. Map k a
Map.empty,
      availableForPeerShare :: Set peeraddr
availableForPeerShare = Set peeraddr
forall a. Set a
Set.empty,
      nextPeerShareTimes :: OrdPSQ peeraddr Time ()
nextPeerShareTimes    = OrdPSQ peeraddr Time ()
forall k p v. OrdPSQ k p v
PSQ.empty,
      nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes     = OrdPSQ peeraddr Time ()
forall k p v. OrdPSQ k p v
PSQ.empty
    }


invariant :: Ord peeraddr
          => EstablishedPeers peeraddr peerconn
          -> Bool
invariant :: forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Bool
invariant EstablishedPeers {Map peeraddr peerconn
Set peeraddr
OrdPSQ peeraddr Time ()
availableForPeerShare :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
nextPeerShareTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
allPeers :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
allPeers :: Map peeraddr peerconn
availableForPeerShare :: Set peeraddr
nextPeerShareTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
..} =
       -- The combo of the peer share set + psq = a subset of all peers
 (  Set peeraddr
availableForPeerShare
    Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> [peeraddr] -> Set peeraddr
forall a. Ord a => [a] -> Set a
Set.fromList (OrdPSQ peeraddr Time () -> [peeraddr]
forall k p v. OrdPSQ k p v -> [k]
PSQ.keys OrdPSQ peeraddr Time ()
nextPeerShareTimes)
 )
    Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Map peeraddr peerconn -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr peerconn
allPeers
       -- The peer share set and psq do not overlap
 Bool -> Bool -> Bool
&& Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null
      (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
         Set peeraddr
availableForPeerShare
        ([peeraddr] -> Set peeraddr
forall a. Ord a => [a] -> Set a
Set.fromList (OrdPSQ peeraddr Time () -> [peeraddr]
forall k p v. OrdPSQ k p v -> [k]
PSQ.keys OrdPSQ peeraddr Time ()
nextPeerShareTimes)))
     -- nextActivateTimes is a subset of allPeers
 Bool -> Bool -> Bool
&&  [peeraddr] -> Set peeraddr
forall a. Ord a => [a] -> Set a
Set.fromList (OrdPSQ peeraddr Time () -> [peeraddr]
forall k p v. OrdPSQ k p v -> [k]
PSQ.keys OrdPSQ peeraddr Time ()
nextActivateTimes)
     Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf`
     Map peeraddr peerconn -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr peerconn
allPeers


-- | /O(1)/
toMap :: EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
toMap :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
toMap = EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers

-- | /O(n)/
toSet :: EstablishedPeers peeraddr peerconn -> Set peeraddr
toSet :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
toSet = Map peeraddr peerconn -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet (Map peeraddr peerconn -> Set peeraddr)
-> (EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn)
-> EstablishedPeers peeraddr peerconn
-> Set peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers


-- | Map of established peers that are either active or ready to be promoted
-- to active.
--
-- /O(n log m), for n not-ready peers, and m established peers/
--
readyPeers :: Ord peeraddr
           => EstablishedPeers peeraddr peerconn
           -> Set peeraddr
readyPeers :: forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Set peeraddr
readyPeers EstablishedPeers { Map peeraddr peerconn
allPeers :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers :: Map peeraddr peerconn
allPeers, OrdPSQ peeraddr Time ()
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes } =
    (peeraddr -> Time -> () -> Set peeraddr -> Set peeraddr)
-> Set peeraddr -> OrdPSQ peeraddr Time () -> Set peeraddr
forall k p v a. (k -> p -> v -> a -> a) -> a -> OrdPSQ k p v -> a
PSQ.fold'
      (\peeraddr
peeraddr Time
_ ()
_ -> peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
peeraddr)
      (Map peeraddr peerconn -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr peerconn
allPeers)
      OrdPSQ peeraddr Time ()
nextActivateTimes


-- | The number of established peers. The size of 'allPeers'
--
-- /O(1)/
--
size :: EstablishedPeers peeraddr peerconn -> Int
size :: forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
size EstablishedPeers { Map peeraddr peerconn
allPeers :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers :: Map peeraddr peerconn
allPeers } = Map peeraddr peerconn -> Int
forall k a. Map k a -> Int
Map.size Map peeraddr peerconn
allPeers


-- | The number of ready peers. The size of 'readyPeers'
--
-- /O(1)/
--
sizeReady :: EstablishedPeers peeraddr peerconn -> Int
sizeReady :: forall peeraddr peerconn. EstablishedPeers peeraddr peerconn -> Int
sizeReady EstablishedPeers { Map peeraddr peerconn
allPeers :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers :: Map peeraddr peerconn
allPeers, OrdPSQ peeraddr Time ()
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes } =
    Map peeraddr peerconn -> Int
forall k a. Map k a -> Int
Map.size Map peeraddr peerconn
allPeers Int -> Int -> Int
forall a. Num a => a -> a -> a
- OrdPSQ peeraddr Time () -> Int
forall k p v. OrdPSQ k p v -> Int
PSQ.size OrdPSQ peeraddr Time ()
nextActivateTimes


member :: Ord peeraddr => peeraddr -> EstablishedPeers peeraddr peerconn -> Bool
member :: forall peeraddr peerconn.
Ord peeraddr =>
peeraddr -> EstablishedPeers peeraddr peerconn -> Bool
member peeraddr
peeraddr = peeraddr -> Map peeraddr peerconn -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member peeraddr
peeraddr (Map peeraddr peerconn -> Bool)
-> (EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn)
-> EstablishedPeers peeraddr peerconn
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers


-- | Insert a peer into 'EstablishedPeers'.
--
insert :: Ord peeraddr
       => peeraddr
       -> peerconn
       -> Maybe Time -- ^ When to first peershare with peer, Nothing means never
       -> EstablishedPeers peeraddr peerconn
       -> EstablishedPeers peeraddr peerconn
insert :: forall peeraddr peerconn.
Ord peeraddr =>
peeraddr
-> peerconn
-> Maybe Time
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
insert peeraddr
peeraddr peerconn
peerconn Maybe Time
peerShareAt_m ep :: EstablishedPeers peeraddr peerconn
ep@EstablishedPeers { Map peeraddr peerconn
allPeers :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers :: Map peeraddr peerconn
allPeers } =
   -- Ask newly established peers for its peers after the specified delay.
   let ep' :: EstablishedPeers peeraddr peerconn
ep' = EstablishedPeers peeraddr peerconn
ep { allPeers = Map.insert peeraddr peerconn allPeers } in
   case Maybe Time
peerShareAt_m of
        Maybe Time
Nothing          -> EstablishedPeers peeraddr peerconn
ep'
        Just Time
peerShareAt ->
          Set peeraddr
-> Time
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall peeraddr peercon.
Ord peeraddr =>
Set peeraddr
-> Time
-> EstablishedPeers peeraddr peercon
-> EstablishedPeers peeraddr peercon
setPeerShareTime (peeraddr -> Set peeraddr
forall a. a -> Set a
Set.singleton peeraddr
peeraddr) Time
peerShareAt (EstablishedPeers peeraddr peerconn
 -> EstablishedPeers peeraddr peerconn)
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall a b. (a -> b) -> a -> b
$ EstablishedPeers peeraddr peerconn
ep'

delete :: Ord peeraddr
       => peeraddr
       -> EstablishedPeers peeraddr peerconn
       -> EstablishedPeers peeraddr peerconn
delete :: forall peeraddr peerconn.
Ord peeraddr =>
peeraddr
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
delete peeraddr
peeraddr es :: EstablishedPeers peeraddr peerconn
es@EstablishedPeers { Map peeraddr peerconn
allPeers :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers :: Map peeraddr peerconn
allPeers
                                    , Set peeraddr
availableForPeerShare :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
availableForPeerShare :: Set peeraddr
availableForPeerShare
                                    , OrdPSQ peeraddr Time ()
nextPeerShareTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextPeerShareTimes :: OrdPSQ peeraddr Time ()
nextPeerShareTimes
                                    , OrdPSQ peeraddr Time ()
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes
                                    } =
    EstablishedPeers peeraddr peerconn
es { allPeers              = Map.delete peeraddr allPeers,
         availableForPeerShare = Set.delete peeraddr availableForPeerShare,
         nextPeerShareTimes    = PSQ.delete peeraddr nextPeerShareTimes,
         nextActivateTimes     = PSQ.delete peeraddr nextActivateTimes
       }



-- | Bulk delete of peers from 'EstablishedPeers.
--
deletePeers :: Ord peeraddr
            => Set peeraddr
            -> EstablishedPeers peeraddr peerconn
            -> EstablishedPeers peeraddr peerconn
deletePeers :: forall peeraddr peerconn.
Ord peeraddr =>
Set peeraddr
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
deletePeers Set peeraddr
peeraddrs es :: EstablishedPeers peeraddr peerconn
es@EstablishedPeers { Map peeraddr peerconn
allPeers :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers :: Map peeraddr peerconn
allPeers,
                                            Set peeraddr
availableForPeerShare :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
availableForPeerShare :: Set peeraddr
availableForPeerShare,
                                            OrdPSQ peeraddr Time ()
nextPeerShareTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextPeerShareTimes :: OrdPSQ peeraddr Time ()
nextPeerShareTimes,
                                            OrdPSQ peeraddr Time ()
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes
                                          } =
    EstablishedPeers peeraddr peerconn
es { allPeers              = Map.withoutKeys allPeers peeraddrs,
         availableForPeerShare = Set.difference availableForPeerShare peeraddrs,
         nextPeerShareTimes    =
           List.foldl' (flip PSQ.delete) nextPeerShareTimes peeraddrs,
         nextActivateTimes     =
           List.foldl' (flip PSQ.delete) nextActivateTimes peeraddrs
       }


--
-- Time managment
--

setCurrentTime :: Ord peeraddr
               => Time
               -> EstablishedPeers peeraddr peerconn
               -> EstablishedPeers peeraddr peerconn
setCurrentTime :: forall peeraddr peerconn.
Ord peeraddr =>
Time
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
setCurrentTime Time
now ep :: EstablishedPeers peeraddr peerconn
ep@EstablishedPeers { OrdPSQ peeraddr Time ()
nextPeerShareTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextPeerShareTimes :: OrdPSQ peeraddr Time ()
nextPeerShareTimes
                                       , OrdPSQ peeraddr Time ()
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes
                                       }
 -- Efficient check for the common case of there being nothing to do:
    | Just (Min Time
t) <- ((peeraddr, Time, (), OrdPSQ peeraddr Time ()) -> Min Time
forall {a} {a} {c} {d}. (a, a, c, d) -> Min a
f ((peeraddr, Time, (), OrdPSQ peeraddr Time ()) -> Min Time)
-> Maybe (peeraddr, Time, (), OrdPSQ peeraddr Time ())
-> Maybe (Min Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrdPSQ peeraddr Time ()
-> Maybe (peeraddr, Time, (), OrdPSQ peeraddr Time ())
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
PSQ.minView OrdPSQ peeraddr Time ()
nextPeerShareTimes)
                   Maybe (Min Time) -> Maybe (Min Time) -> Maybe (Min Time)
forall a. Semigroup a => a -> a -> a
<> ((peeraddr, Time, (), OrdPSQ peeraddr Time ()) -> Min Time
forall {a} {a} {c} {d}. (a, a, c, d) -> Min a
f ((peeraddr, Time, (), OrdPSQ peeraddr Time ()) -> Min Time)
-> Maybe (peeraddr, Time, (), OrdPSQ peeraddr Time ())
-> Maybe (Min Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrdPSQ peeraddr Time ()
-> Maybe (peeraddr, Time, (), OrdPSQ peeraddr Time ())
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
PSQ.minView OrdPSQ peeraddr Time ()
nextActivateTimes)
    , Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
now
    = EstablishedPeers peeraddr peerconn
ep
  where
    f :: (a, a, c, d) -> Min a
f (a
_,a
t,c
_,d
_) = a -> Min a
forall a. a -> Min a
Min a
t

setCurrentTime Time
now ep :: EstablishedPeers peeraddr peerconn
ep@EstablishedPeers { OrdPSQ peeraddr Time ()
nextPeerShareTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextPeerShareTimes :: OrdPSQ peeraddr Time ()
nextPeerShareTimes
                                       , Set peeraddr
availableForPeerShare :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
availableForPeerShare :: Set peeraddr
availableForPeerShare
                                       , OrdPSQ peeraddr Time ()
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes
                                       } =
  let ep' :: EstablishedPeers peeraddr peerconn
ep' = EstablishedPeers peeraddr peerconn
ep { nextPeerShareTimes    = nextPeerShareTimes'
               , availableForPeerShare = availableForPeerShare'
               , nextActivateTimes     = nextActivateTimes'
               }
    in Bool
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (EstablishedPeers peeraddr peerconn -> Bool
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Bool
invariant EstablishedPeers peeraddr peerconn
ep') EstablishedPeers peeraddr peerconn
ep'
  where
    ([(peeraddr, Time, ())]
nowAvailableForPeerShare, OrdPSQ peeraddr Time ()
nextPeerShareTimes') =
      Time
-> OrdPSQ peeraddr Time ()
-> ([(peeraddr, Time, ())], OrdPSQ peeraddr Time ())
forall k p v.
(Ord k, Ord p) =>
p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
PSQ.atMostView Time
now OrdPSQ peeraddr Time ()
nextPeerShareTimes

    availableForPeerShare' :: Set peeraddr
availableForPeerShare' =
         Set peeraddr
availableForPeerShare
      Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> [peeraddr] -> Set peeraddr
forall a. Ord a => [a] -> Set a
Set.fromList [ peeraddr
peeraddr | (peeraddr
peeraddr, Time
_, ()
_) <- [(peeraddr, Time, ())]
nowAvailableForPeerShare ]

    ([(peeraddr, Time, ())]
_, OrdPSQ peeraddr Time ()
nextActivateTimes') = Time
-> OrdPSQ peeraddr Time ()
-> ([(peeraddr, Time, ())], OrdPSQ peeraddr Time ())
forall k p v.
(Ord k, Ord p) =>
p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
PSQ.atMostView Time
now OrdPSQ peeraddr Time ()
nextActivateTimes


-- | Find smallest activation time for a peer belonging to a given set.
--
minActivateTime :: Ord peeraddr
                => EstablishedPeers peeraddr peerconn
                -> (peeraddr -> Bool)
                -- ^ a predicate which describes the peers to take into
                -- account
                -> Maybe Time
minActivateTime :: forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn
-> (peeraddr -> Bool) -> Maybe Time
minActivateTime EstablishedPeers { OrdPSQ peeraddr Time ()
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes } peeraddr -> Bool
fn = OrdPSQ peeraddr Time () -> Maybe Time
forall {a} {v}. Ord a => OrdPSQ peeraddr a v -> Maybe a
go OrdPSQ peeraddr Time ()
nextActivateTimes
  where
    go :: OrdPSQ peeraddr a v -> Maybe a
go OrdPSQ peeraddr a v
psq = case OrdPSQ peeraddr a v -> Maybe (peeraddr, a, v, OrdPSQ peeraddr a v)
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
PSQ.minView OrdPSQ peeraddr a v
psq of
      Just (peeraddr
k, a
t, v
_, OrdPSQ peeraddr a v
psq') | peeraddr -> Bool
fn peeraddr
k      -> a -> Maybe a
forall a. a -> Maybe a
Just a
t
                           | Bool
otherwise -> OrdPSQ peeraddr a v -> Maybe a
go OrdPSQ peeraddr a v
psq'
      Maybe (peeraddr, a, v, OrdPSQ peeraddr a v)
Nothing                          -> Maybe a
forall a. Maybe a
Nothing


setActivateTimes :: Ord peeraddr
                 => Map peeraddr Time
                 -> EstablishedPeers peeraddr peerconn
                 -> EstablishedPeers peeraddr peerconn
setActivateTimes :: forall peeraddr peerconn.
Ord peeraddr =>
Map peeraddr Time
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
setActivateTimes Map peeraddr Time
times EstablishedPeers peeraddr peerconn
ep | Map peeraddr Time -> Bool
forall k a. Map k a -> Bool
Map.null Map peeraddr Time
times = EstablishedPeers peeraddr peerconn
ep
setActivateTimes Map peeraddr Time
times ep :: EstablishedPeers peeraddr peerconn
ep@EstablishedPeers { OrdPSQ peeraddr Time ()
nextActivateTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextActivateTimes :: OrdPSQ peeraddr Time ()
nextActivateTimes } =
    let ep' :: EstablishedPeers peeraddr peerconn
ep' = EstablishedPeers peeraddr peerconn
ep { nextActivateTimes =
                     Map.foldlWithKey'
                       (\OrdPSQ peeraddr Time ()
psq peeraddr
peeraddr Time
time ->
                             ((), OrdPSQ peeraddr Time ()) -> OrdPSQ peeraddr Time ()
forall a b. (a, b) -> b
snd (((), OrdPSQ peeraddr Time ()) -> OrdPSQ peeraddr Time ())
-> ((), OrdPSQ peeraddr Time ()) -> OrdPSQ peeraddr Time ()
forall a b. (a -> b) -> a -> b
$
                             (Maybe (Time, ()) -> ((), Maybe (Time, ())))
-> peeraddr
-> OrdPSQ peeraddr Time ()
-> ((), OrdPSQ peeraddr Time ())
forall k p v b.
(Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (b, OrdPSQ k p v)
PSQ.alter (\case
                                           Maybe (Time, ())
Nothing         -> ((), (Time, ()) -> Maybe (Time, ())
forall a. a -> Maybe a
Just (Time
time, ()))
                                           Just (Time
time', ()
_) -> ((), (Time, ()) -> Maybe (Time, ())
forall a. a -> Maybe a
Just (Time
time Time -> Time -> Time
forall a. Ord a => a -> a -> a
`max` Time
time', ()))
                                       )
                                       peeraddr
peeraddr OrdPSQ peeraddr Time ()
psq)
                       nextActivateTimes
                       times
                 }
    in   Bool
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((peeraddr -> Bool) -> [peeraddr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (peeraddr -> Bool) -> peeraddr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (peeraddr -> Set peeraddr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Set peeraddr
readyPeers EstablishedPeers peeraddr peerconn
ep')) (Map peeraddr Time -> [peeraddr]
forall k a. Map k a -> [k]
Map.keys Map peeraddr Time
times))
       (EstablishedPeers peeraddr peerconn
 -> EstablishedPeers peeraddr peerconn)
-> (EstablishedPeers peeraddr peerconn
    -> EstablishedPeers peeraddr peerconn)
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (EstablishedPeers peeraddr peerconn -> Bool
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Bool
invariant EstablishedPeers peeraddr peerconn
ep')
       (EstablishedPeers peeraddr peerconn
 -> EstablishedPeers peeraddr peerconn)
-> EstablishedPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
forall a b. (a -> b) -> a -> b
$ EstablishedPeers peeraddr peerconn
ep'

-------------------------------
-- Tracking when we can peer share
--

-- | The first time that a peer will become available for peer sharing. If
-- peers are already available for peer share, or there are no peers at all
-- then the result is @Nothing@.
--
minPeerShareTime :: Ord peeraddr
                 => EstablishedPeers peeraddr peercon
                 -> Maybe Time
minPeerShareTime :: forall peeraddr peercon.
Ord peeraddr =>
EstablishedPeers peeraddr peercon -> Maybe Time
minPeerShareTime EstablishedPeers { Set peeraddr
availableForPeerShare :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
availableForPeerShare :: Set peeraddr
availableForPeerShare,
                                    OrdPSQ peeraddr Time ()
nextPeerShareTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextPeerShareTimes :: OrdPSQ peeraddr Time ()
nextPeerShareTimes
                                  }
  | Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
availableForPeerShare
  , Just (peeraddr
_k, Time
t, ()
_, OrdPSQ peeraddr Time ()
_psq) <- OrdPSQ peeraddr Time ()
-> Maybe (peeraddr, Time, (), OrdPSQ peeraddr Time ())
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
PSQ.minView OrdPSQ peeraddr Time ()
nextPeerShareTimes
  = Time -> Maybe Time
forall a. a -> Maybe a
Just Time
t

  | Bool
otherwise
  = Maybe Time
forall a. Maybe a
Nothing

setPeerShareTime :: Ord peeraddr
                 => Set peeraddr
                 -> Time
                 -> EstablishedPeers peeraddr peercon
                 -> EstablishedPeers peeraddr peercon
setPeerShareTime :: forall peeraddr peercon.
Ord peeraddr =>
Set peeraddr
-> Time
-> EstablishedPeers peeraddr peercon
-> EstablishedPeers peeraddr peercon
setPeerShareTime Set peeraddr
peeraddrs Time
time
                 ep :: EstablishedPeers peeraddr peercon
ep@EstablishedPeers {
                   Map peeraddr peercon
allPeers :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Map peeraddr peerconn
allPeers :: Map peeraddr peercon
allPeers,
                   Set peeraddr
availableForPeerShare :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
availableForPeerShare :: Set peeraddr
availableForPeerShare,
                   OrdPSQ peeraddr Time ()
nextPeerShareTimes :: forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> OrdPSQ peeraddr Time ()
nextPeerShareTimes :: OrdPSQ peeraddr Time ()
nextPeerShareTimes
                 } =
    Bool
-> EstablishedPeers peeraddr peercon
-> EstablishedPeers peeraddr peercon
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((peeraddr -> Bool) -> Set peeraddr -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (peeraddr -> Map peeraddr peercon -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map peeraddr peercon
allPeers) Set peeraddr
peeraddrs) (EstablishedPeers peeraddr peercon
 -> EstablishedPeers peeraddr peercon)
-> EstablishedPeers peeraddr peercon
-> EstablishedPeers peeraddr peercon
forall a b. (a -> b) -> a -> b
$
    let ep' :: EstablishedPeers peeraddr peercon
ep' = EstablishedPeers peeraddr peercon
ep {
          availableForPeerShare =
                   availableForPeerShare
            Set.\\ peeraddrs,

          nextPeerShareTimes =
            List.foldl' (\OrdPSQ peeraddr Time ()
psq peeraddr
peeraddr -> peeraddr
-> Time -> () -> OrdPSQ peeraddr Time () -> OrdPSQ peeraddr Time ()
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.insert peeraddr
peeraddr Time
time () OrdPSQ peeraddr Time ()
psq)
                        nextPeerShareTimes
                        peeraddrs
        }
    in Bool
-> EstablishedPeers peeraddr peercon
-> EstablishedPeers peeraddr peercon
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (EstablishedPeers peeraddr peercon -> Bool
forall peeraddr peerconn.
Ord peeraddr =>
EstablishedPeers peeraddr peerconn -> Bool
invariant EstablishedPeers peeraddr peercon
ep') EstablishedPeers peeraddr peercon
ep'