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

module Ouroboros.Network.PeerSelection.State.KnownPeers
  ( -- * Types
    KnownPeers
  , KnownPeerInfo (..)
  , invariant
  , allPeers
    -- * KnownPeerInfo operations
  , alterKnownPeerInfo
    -- * Basic container operations
  , empty
  , size
  , insert
  , alter
  , delete
  , toSet
  , member
    -- * Special operations
  , setCurrentTime
  , incrementFailCount
  , resetFailCount
  , lookupFailCount
  , lookupTepidFlag
  , setTepidFlag
  , clearTepidFlag
  , setSuccessfulConnectionFlag
    -- ** Tracking when we can (re)connect
  , minConnectTime
  , setConnectTimes
  , availableToConnect
    -- ** Selecting peers to ask
  , canPeerShareRequest
  , getPeerSharingRequestPeers
    -- * Selecting peers to share
  , canSharePeers
  , getPeerSharingResponsePeers
  ) where

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

import Control.Applicative ((<|>))
import Control.Exception (assert)
import Control.Monad.Class.MonadTime.SI

import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))


-------------------------------
-- Known peer set representation
--

-- | The set of known peers. To a first approximation it can be thought of as
-- a 'Set' of @peeraddr@.
--
-- It has one special feature:
--
--  * It tracks the subset of peers that we are happy to publish in reply to
--    peer share requests to our node. It supports random sampling from this set.
--
data KnownPeers peeraddr = KnownPeers {

       -- | All the known peers.
       --
       forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers           :: !(Map peeraddr KnownPeerInfo),

       -- | The subset of known peers that we would be allowed to try to
       -- establish a connection to now. This is because we have not connected
       -- with them before or because any failure backoff time has expired.
       --
       forall peeraddr. KnownPeers peeraddr -> Set peeraddr
availableToConnect :: !(Set peeraddr),

       -- | The subset of known peers that we cannot connect to for the moment.
       -- It keeps track of the next time we are allowed to make the next
       -- connection attempt.
       forall peeraddr. KnownPeers peeraddr -> OrdPSQ peeraddr Time ()
nextConnectTimes   :: !(OrdPSQ peeraddr Time ())
     }
  deriving (KnownPeers peeraddr -> KnownPeers peeraddr -> Bool
(KnownPeers peeraddr -> KnownPeers peeraddr -> Bool)
-> (KnownPeers peeraddr -> KnownPeers peeraddr -> Bool)
-> Eq (KnownPeers peeraddr)
forall peeraddr.
Ord peeraddr =>
KnownPeers peeraddr -> KnownPeers peeraddr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall peeraddr.
Ord peeraddr =>
KnownPeers peeraddr -> KnownPeers peeraddr -> Bool
== :: KnownPeers peeraddr -> KnownPeers peeraddr -> Bool
$c/= :: forall peeraddr.
Ord peeraddr =>
KnownPeers peeraddr -> KnownPeers peeraddr -> Bool
/= :: KnownPeers peeraddr -> KnownPeers peeraddr -> Bool
Eq, Int -> KnownPeers peeraddr -> ShowS
[KnownPeers peeraddr] -> ShowS
KnownPeers peeraddr -> String
(Int -> KnownPeers peeraddr -> ShowS)
-> (KnownPeers peeraddr -> String)
-> ([KnownPeers peeraddr] -> ShowS)
-> Show (KnownPeers peeraddr)
forall peeraddr.
Show peeraddr =>
Int -> KnownPeers peeraddr -> ShowS
forall peeraddr. Show peeraddr => [KnownPeers peeraddr] -> ShowS
forall peeraddr. Show peeraddr => KnownPeers peeraddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peeraddr.
Show peeraddr =>
Int -> KnownPeers peeraddr -> ShowS
showsPrec :: Int -> KnownPeers peeraddr -> ShowS
$cshow :: forall peeraddr. Show peeraddr => KnownPeers peeraddr -> String
show :: KnownPeers peeraddr -> String
$cshowList :: forall peeraddr. Show peeraddr => [KnownPeers peeraddr] -> ShowS
showList :: [KnownPeers peeraddr] -> ShowS
Show)

data KnownPeerInfo = KnownPeerInfo {
       -- | The current number of consecutive connection attempt failures. This
       -- is reset as soon as there is a successful connection.
       --
       -- It is used to implement the exponential backoff strategy and may also
       -- be used by policies to select peers to forget.
       --
       KnownPeerInfo -> Int
knownPeerFailCount        :: !Int,

       -- | Indicates if the peer was hot but then got demoted.
       --
       -- It is set on the hot to warm promotion and reset on cold to warm,
       -- thus it can be present for warm or cold peers.  It's purpose is to
       -- provide information to demotion policies.
       --
       -- It is also used as useful information for the Peer Selection Governor
       -- when deciding which peers to share when Peer Sharing.
       --
       KnownPeerInfo -> Bool
knownPeerTepid            :: !Bool,

       -- | Indicates current remote Peer Willingness information.
       --
       -- If a connection with this address hasn't been established we won't
       -- have any information about this particular flag
       --
       -- It is used by the Peer Sharing logic to decide if we should share/ask
       -- about/to this peer's address to others.
       KnownPeerInfo -> StrictMaybe PeerSharing
knownPeerSharing          :: !(StrictMaybe PeerSharing),

       -- | Indicates current local Peer Willingness information.
       --
       -- If this address didn't come from a local configuration then this
       -- value is set to 'DoAdvertise' by default.
       --
       -- It is used by the Peer Sharing logic to decide if we should share
       -- about this peer's address to others.
       KnownPeerInfo -> StrictMaybe PeerAdvertise
knownPeerAdvertise        :: !(StrictMaybe PeerAdvertise),

       -- | Indicates if the node managed to connect to the peer at some point
       -- in time.
       --
       -- This differs from the tepid flag in a way that this flag will be
       -- set/enabled if we established a successful connection with this
       -- peer. It won't be unset after this.
       --
       KnownPeerInfo -> Bool
knownSuccessfulConnection :: !Bool
     }
  deriving (KnownPeerInfo -> KnownPeerInfo -> Bool
(KnownPeerInfo -> KnownPeerInfo -> Bool)
-> (KnownPeerInfo -> KnownPeerInfo -> Bool) -> Eq KnownPeerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KnownPeerInfo -> KnownPeerInfo -> Bool
== :: KnownPeerInfo -> KnownPeerInfo -> Bool
$c/= :: KnownPeerInfo -> KnownPeerInfo -> Bool
/= :: KnownPeerInfo -> KnownPeerInfo -> Bool
Eq, Int -> KnownPeerInfo -> ShowS
[KnownPeerInfo] -> ShowS
KnownPeerInfo -> String
(Int -> KnownPeerInfo -> ShowS)
-> (KnownPeerInfo -> String)
-> ([KnownPeerInfo] -> ShowS)
-> Show KnownPeerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KnownPeerInfo -> ShowS
showsPrec :: Int -> KnownPeerInfo -> ShowS
$cshow :: KnownPeerInfo -> String
show :: KnownPeerInfo -> String
$cshowList :: [KnownPeerInfo] -> ShowS
showList :: [KnownPeerInfo] -> ShowS
Show)


invariant :: Ord peeraddr => KnownPeers peeraddr -> Bool
invariant :: forall peeraddr. Ord peeraddr => KnownPeers peeraddr -> Bool
invariant KnownPeers{Map peeraddr KnownPeerInfo
Set peeraddr
OrdPSQ peeraddr Time ()
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
availableToConnect :: forall peeraddr. KnownPeers peeraddr -> Set peeraddr
nextConnectTimes :: forall peeraddr. KnownPeers peeraddr -> OrdPSQ peeraddr Time ()
allPeers :: Map peeraddr KnownPeerInfo
availableToConnect :: Set peeraddr
nextConnectTimes :: OrdPSQ peeraddr Time ()
..} =
       -- The combo of the connect set + psq = the whole set of peers
       Set peeraddr
availableToConnect
    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 ()
nextConnectTimes)
    Set peeraddr -> Set peeraddr -> Bool
forall a. Eq a => a -> a -> Bool
== Map peeraddr KnownPeerInfo -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr KnownPeerInfo
allPeers

       -- The connect 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
availableToConnect
        ([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 ()
nextConnectTimes)))


-------------------------------
-- KnownPeerInfo manipulation
--

alterKnownPeerInfo
  :: (Maybe PeerSharing, Maybe PeerAdvertise)
  -> Maybe KnownPeerInfo
  -> Maybe KnownPeerInfo
alterKnownPeerInfo :: (Maybe PeerSharing, Maybe PeerAdvertise)
-> Maybe KnownPeerInfo -> Maybe KnownPeerInfo
alterKnownPeerInfo (Maybe PeerSharing
peerSharing, Maybe PeerAdvertise
peerAdvertise) Maybe KnownPeerInfo
peerLookupResult =
  case Maybe KnownPeerInfo
peerLookupResult of
    Maybe KnownPeerInfo
Nothing -> KnownPeerInfo -> Maybe KnownPeerInfo
forall a. a -> Maybe a
Just (KnownPeerInfo -> Maybe KnownPeerInfo)
-> KnownPeerInfo -> Maybe KnownPeerInfo
forall a b. (a -> b) -> a -> b
$
      KnownPeerInfo {
        knownPeerFailCount :: Int
knownPeerFailCount = Int
0
      , knownPeerTepid :: Bool
knownPeerTepid     = Bool
False
      , knownPeerSharing :: StrictMaybe PeerSharing
knownPeerSharing   = Maybe PeerSharing -> StrictMaybe PeerSharing
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PeerSharing
peerSharing
      , knownPeerAdvertise :: StrictMaybe PeerAdvertise
knownPeerAdvertise = Maybe PeerAdvertise -> StrictMaybe PeerAdvertise
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PeerAdvertise
peerAdvertise
      , knownSuccessfulConnection :: Bool
knownSuccessfulConnection = Bool
False
      }
    Just KnownPeerInfo
kpi -> KnownPeerInfo -> Maybe KnownPeerInfo
forall a. a -> Maybe a
Just (KnownPeerInfo -> Maybe KnownPeerInfo)
-> KnownPeerInfo -> Maybe KnownPeerInfo
forall a b. (a -> b) -> a -> b
$
      -- pick first known value
      KnownPeerInfo
kpi {
        knownPeerSharing   = maybeToStrictMaybe peerSharing
                         <|> knownPeerSharing kpi
      , knownPeerAdvertise = maybeToStrictMaybe peerAdvertise
                         <|> knownPeerAdvertise kpi
      }

-------------------------------
-- Basic container operations
--

empty :: KnownPeers peeraddr
empty :: forall peeraddr. KnownPeers peeraddr
empty =
    KnownPeers {
      allPeers :: Map peeraddr KnownPeerInfo
allPeers           = Map peeraddr KnownPeerInfo
forall k a. Map k a
Map.empty,
      availableToConnect :: Set peeraddr
availableToConnect = Set peeraddr
forall a. Set a
Set.empty,
      nextConnectTimes :: OrdPSQ peeraddr Time ()
nextConnectTimes   = OrdPSQ peeraddr Time ()
forall k p v. OrdPSQ k p v
PSQ.empty
    }

size :: KnownPeers peeraddr -> Int
size :: forall peeraddr. KnownPeers peeraddr -> Int
size = Map peeraddr KnownPeerInfo -> Int
forall k a. Map k a -> Int
Map.size (Map peeraddr KnownPeerInfo -> Int)
-> (KnownPeers peeraddr -> Map peeraddr KnownPeerInfo)
-> KnownPeers peeraddr
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers

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

member :: Ord peeraddr
       => peeraddr
       -> KnownPeers peeraddr
       -> Bool
member :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Bool
member peeraddr
peeraddr KnownPeers {Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers} =
    peeraddr
peeraddr peeraddr -> Map peeraddr KnownPeerInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map peeraddr KnownPeerInfo
allPeers

-- | This inserts a map of peers with its respective peer sharing, peer
-- advertise and ledger flags into the known peers set.
--
-- Please note that if in the map there's an entry for a peer already present
-- in the known peers set, then its values will only be overwritten if they
-- are a 'Just'. Otherwise the current information will be preserved. On the
-- other hand if there's an entry for a peer that isn't a member of the known
-- peer set, the 'Nothing' values will default to 'PeerSharingDisabled',
-- 'DoNotAdvertisePeer' and 'IsNotLedgerPeer', respectively, unless a 'Just'
-- value is used.
--
insert :: Ord peeraddr
       => Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
       -> KnownPeers peeraddr
       -> KnownPeers peeraddr
insert :: forall peeraddr.
Ord peeraddr =>
Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
insert Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
peeraddrs
       knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers {
         Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers,
         Set peeraddr
availableToConnect :: forall peeraddr. KnownPeers peeraddr -> Set peeraddr
availableToConnect :: Set peeraddr
availableToConnect
       } =
    let allPeersAddrs :: Set peeraddr
allPeersAddrs = Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
peeraddrs
        knownPeers' :: KnownPeers peeraddr
knownPeers' = KnownPeers peeraddr
knownPeers {
          allPeers = Map.foldlWithKey' (\Map peeraddr KnownPeerInfo
m peeraddr
peer (Maybe PeerSharing, Maybe PeerAdvertise)
v -> (Maybe KnownPeerInfo -> Maybe KnownPeerInfo)
-> peeraddr
-> Map peeraddr KnownPeerInfo
-> Map peeraddr KnownPeerInfo
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter ((Maybe PeerSharing, Maybe PeerAdvertise)
-> Maybe KnownPeerInfo -> Maybe KnownPeerInfo
alterKnownPeerInfo (Maybe PeerSharing, Maybe PeerAdvertise)
v) peeraddr
peer Map peeraddr KnownPeerInfo
m)
                                       allPeers
                                       peeraddrs,
          availableToConnect =
              availableToConnect
           <> Set.filter (`Map.notMember` allPeers) allPeersAddrs
        }
    in Bool -> KnownPeers peeraddr -> KnownPeers peeraddr
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (KnownPeers peeraddr -> Bool
forall peeraddr. Ord peeraddr => KnownPeers peeraddr -> Bool
invariant KnownPeers peeraddr
knownPeers') KnownPeers peeraddr
knownPeers'

alter :: Ord peeraddr
      => (Maybe KnownPeerInfo -> Maybe KnownPeerInfo)
      -> Set peeraddr
      -> KnownPeers peeraddr
      -> KnownPeers peeraddr
alter :: forall peeraddr.
Ord peeraddr =>
(Maybe KnownPeerInfo -> Maybe KnownPeerInfo)
-> Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
alter Maybe KnownPeerInfo -> Maybe KnownPeerInfo
f Set peeraddr
ks knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers {
            allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers = Map peeraddr KnownPeerInfo
allPeers
          , availableToConnect :: forall peeraddr. KnownPeers peeraddr -> Set peeraddr
availableToConnect = Set peeraddr
availableToConnect
          , OrdPSQ peeraddr Time ()
nextConnectTimes :: forall peeraddr. KnownPeers peeraddr -> OrdPSQ peeraddr Time ()
nextConnectTimes :: OrdPSQ peeraddr Time ()
nextConnectTimes
          } =
  let newAllPeers :: Map peeraddr KnownPeerInfo
newAllPeers =
        (Map peeraddr KnownPeerInfo
 -> peeraddr -> Map peeraddr KnownPeerInfo)
-> Map peeraddr KnownPeerInfo
-> Set peeraddr
-> Map peeraddr KnownPeerInfo
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' (\Map peeraddr KnownPeerInfo
acc peeraddr
k -> (Maybe KnownPeerInfo -> Maybe KnownPeerInfo)
-> peeraddr
-> Map peeraddr KnownPeerInfo
-> Map peeraddr KnownPeerInfo
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe KnownPeerInfo -> Maybe KnownPeerInfo
f peeraddr
k Map peeraddr KnownPeerInfo
acc)
                   Map peeraddr KnownPeerInfo
allPeers
                   Set peeraddr
ks
      deletedPeers :: Set peeraddr
deletedPeers =
        (peeraddr -> Bool) -> Set peeraddr -> Set peeraddr
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (peeraddr -> Map peeraddr KnownPeerInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map peeraddr KnownPeerInfo
newAllPeers) Set peeraddr
ks
      newAvailableToConnect :: Set peeraddr
newAvailableToConnect =
        (Set peeraddr
availableToConnect Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
ks)
        Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference`
        Set peeraddr
deletedPeers
      newNextConnectTimes :: OrdPSQ peeraddr Time ()
newNextConnectTimes =
        (OrdPSQ peeraddr Time () -> peeraddr -> OrdPSQ peeraddr Time ())
-> OrdPSQ peeraddr Time ()
-> Set peeraddr
-> OrdPSQ peeraddr Time ()
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' ((peeraddr -> OrdPSQ peeraddr Time () -> OrdPSQ peeraddr Time ())
-> OrdPSQ peeraddr Time () -> peeraddr -> OrdPSQ peeraddr Time ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip peeraddr -> OrdPSQ peeraddr Time () -> OrdPSQ peeraddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete) OrdPSQ peeraddr Time ()
nextConnectTimes Set peeraddr
ks
   in KnownPeers peeraddr
knownPeers {
        allPeers           = newAllPeers
      , availableToConnect = newAvailableToConnect
      , nextConnectTimes   = newNextConnectTimes
      }

delete :: Ord peeraddr
       => Set peeraddr
       -> KnownPeers peeraddr
       -> KnownPeers peeraddr
delete :: forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
delete Set peeraddr
peeraddrs
       knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers {
         Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers,
         Set peeraddr
availableToConnect :: forall peeraddr. KnownPeers peeraddr -> Set peeraddr
availableToConnect :: Set peeraddr
availableToConnect,
         OrdPSQ peeraddr Time ()
nextConnectTimes :: forall peeraddr. KnownPeers peeraddr -> OrdPSQ peeraddr Time ()
nextConnectTimes :: OrdPSQ peeraddr Time ()
nextConnectTimes
       } =
    KnownPeers peeraddr
knownPeers {
      allPeers =
        Map.withoutKeys allPeers peeraddrs,

      availableToConnect =
        Set.difference availableToConnect peeraddrs,

      nextConnectTimes =
        List.foldl' (flip PSQ.delete) nextConnectTimes peeraddrs
    }


-------------------------------
-- Special operations
--

setCurrentTime :: Ord peeraddr
               => Time
               -> KnownPeers peeraddr
               -> KnownPeers peeraddr
setCurrentTime :: forall peeraddr.
Ord peeraddr =>
Time -> KnownPeers peeraddr -> KnownPeers peeraddr
setCurrentTime Time
now knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers {
                     Set peeraddr
availableToConnect :: forall peeraddr. KnownPeers peeraddr -> Set peeraddr
availableToConnect :: Set peeraddr
availableToConnect,
                     OrdPSQ peeraddr Time ()
nextConnectTimes :: forall peeraddr. KnownPeers peeraddr -> OrdPSQ peeraddr Time ()
nextConnectTimes :: OrdPSQ peeraddr Time ()
nextConnectTimes
                   } =
  let knownPeers' :: KnownPeers peeraddr
knownPeers' =
        KnownPeers peeraddr
knownPeers {
          availableToConnect = availableToConnect',
          nextConnectTimes   = nextConnectTimes'
        }
   in Bool -> KnownPeers peeraddr -> KnownPeers peeraddr
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (KnownPeers peeraddr -> Bool
forall peeraddr. Ord peeraddr => KnownPeers peeraddr -> Bool
invariant KnownPeers peeraddr
knownPeers') KnownPeers peeraddr
knownPeers'
  where
    ([(peeraddr, Time, ())]
nowAvailableToConnect, OrdPSQ peeraddr Time ()
nextConnectTimes') =
      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 ()
nextConnectTimes

    availableToConnect' :: Set peeraddr
availableToConnect' =
         Set peeraddr
availableToConnect
      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, ())]
nowAvailableToConnect ]


incrementFailCount :: Ord peeraddr
                   => peeraddr
                   -> KnownPeers peeraddr
                   -> (Int, KnownPeers peeraddr)
incrementFailCount :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> (Int, KnownPeers peeraddr)
incrementFailCount peeraddr
peeraddr knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers{Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers} =
    Bool -> (Int, KnownPeers peeraddr) -> (Int, KnownPeers peeraddr)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (peeraddr
peeraddr peeraddr -> Map peeraddr KnownPeerInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map peeraddr KnownPeerInfo
allPeers) ((Int, KnownPeers peeraddr) -> (Int, KnownPeers peeraddr))
-> (Int, KnownPeers peeraddr) -> (Int, KnownPeers peeraddr)
forall a b. (a -> b) -> a -> b
$
    let allPeers' :: Map peeraddr KnownPeerInfo
allPeers' = (KnownPeerInfo -> Maybe KnownPeerInfo)
-> peeraddr
-> Map peeraddr KnownPeerInfo
-> Map peeraddr KnownPeerInfo
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update (KnownPeerInfo -> Maybe KnownPeerInfo
forall a. a -> Maybe a
Just (KnownPeerInfo -> Maybe KnownPeerInfo)
-> (KnownPeerInfo -> KnownPeerInfo)
-> KnownPeerInfo
-> Maybe KnownPeerInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownPeerInfo -> KnownPeerInfo
incr) peeraddr
peeraddr Map peeraddr KnownPeerInfo
allPeers
    in ( -- since the `peeraddr` is assumed to be part of `allPeers` the `Map.!`
         -- is safe
         KnownPeerInfo -> Int
knownPeerFailCount (Map peeraddr KnownPeerInfo
allPeers' Map peeraddr KnownPeerInfo -> peeraddr -> KnownPeerInfo
forall k a. Ord k => Map k a -> k -> a
Map.! peeraddr
peeraddr)
       , KnownPeers peeraddr
knownPeers { allPeers = allPeers' }
       )
  where
    incr :: KnownPeerInfo -> KnownPeerInfo
incr KnownPeerInfo
kpi = KnownPeerInfo
kpi { knownPeerFailCount = knownPeerFailCount kpi + 1 }


resetFailCount :: Ord peeraddr
               => peeraddr
               -> KnownPeers peeraddr
               -> KnownPeers peeraddr
resetFailCount :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
resetFailCount peeraddr
peeraddr knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers{Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers} =
    Bool -> KnownPeers peeraddr -> KnownPeers peeraddr
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (peeraddr
peeraddr peeraddr -> Map peeraddr KnownPeerInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map peeraddr KnownPeerInfo
allPeers) (KnownPeers peeraddr -> KnownPeers peeraddr)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall a b. (a -> b) -> a -> b
$
    KnownPeers peeraddr
knownPeers { allPeers = Map.update (\KnownPeerInfo
kpi  -> KnownPeerInfo -> Maybe KnownPeerInfo
forall a. a -> Maybe a
Just KnownPeerInfo
kpi { knownPeerFailCount = 0 })
                              peeraddr allPeers
               }

lookupFailCount :: Ord peeraddr
                => peeraddr
                -> KnownPeers peeraddr
                -> Maybe Int
lookupFailCount :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Maybe Int
lookupFailCount peeraddr
peeraddr KnownPeers{Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers} =
    KnownPeerInfo -> Int
knownPeerFailCount (KnownPeerInfo -> Int) -> Maybe KnownPeerInfo -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> peeraddr -> Map peeraddr KnownPeerInfo -> Maybe KnownPeerInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peeraddr
peeraddr Map peeraddr KnownPeerInfo
allPeers


lookupTepidFlag :: Ord peeraddr
                => peeraddr
                -> KnownPeers peeraddr
                -> Maybe Bool
lookupTepidFlag :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Maybe Bool
lookupTepidFlag peeraddr
peeraddr KnownPeers{Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers} =
    KnownPeerInfo -> Bool
knownPeerTepid (KnownPeerInfo -> Bool) -> Maybe KnownPeerInfo -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> peeraddr -> Map peeraddr KnownPeerInfo -> Maybe KnownPeerInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peeraddr
peeraddr Map peeraddr KnownPeerInfo
allPeers

setTepidFlag' :: Ord peeraddr
             => Bool
             -> peeraddr
             -> KnownPeers peeraddr
             -> KnownPeers peeraddr
setTepidFlag' :: forall peeraddr.
Ord peeraddr =>
Bool -> peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
setTepidFlag' Bool
val peeraddr
peeraddr knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers{Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers} =
    Bool -> KnownPeers peeraddr -> KnownPeers peeraddr
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (peeraddr
peeraddr peeraddr -> Map peeraddr KnownPeerInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map peeraddr KnownPeerInfo
allPeers) (KnownPeers peeraddr -> KnownPeers peeraddr)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall a b. (a -> b) -> a -> b
$
    KnownPeers peeraddr
knownPeers { allPeers = Map.update (\KnownPeerInfo
kpi  -> KnownPeerInfo -> Maybe KnownPeerInfo
forall a. a -> Maybe a
Just KnownPeerInfo
kpi { knownPeerTepid = val })
                              peeraddr allPeers
               }

clearTepidFlag :: Ord peeraddr
             => peeraddr
             -> KnownPeers peeraddr
             -> KnownPeers peeraddr
clearTepidFlag :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
clearTepidFlag = Bool -> peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Bool -> peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
setTepidFlag' Bool
False

setTepidFlag :: Ord peeraddr
             => peeraddr
             -> KnownPeers peeraddr
             -> KnownPeers peeraddr
setTepidFlag :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
setTepidFlag = Bool -> peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Bool -> peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
setTepidFlag' Bool
True


setSuccessfulConnectionFlag :: Ord peeraddr
                            => Set peeraddr
                            -> KnownPeers peeraddr
                            -> KnownPeers peeraddr
setSuccessfulConnectionFlag :: forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
setSuccessfulConnectionFlag Set peeraddr
peers knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers{Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers} =
    Bool -> KnownPeers peeraddr -> KnownPeers peeraddr
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Set peeraddr
peers Set peeraddr -> Set peeraddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Map peeraddr KnownPeerInfo -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr KnownPeerInfo
allPeers) (KnownPeers peeraddr -> KnownPeers peeraddr)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall a b. (a -> b) -> a -> b
$
    KnownPeers peeraddr
knownPeers { allPeers = foldr (Map.update (\KnownPeerInfo
kpi  -> KnownPeerInfo -> Maybe KnownPeerInfo
forall a. a -> Maybe a
Just KnownPeerInfo
kpi { knownSuccessfulConnection = True }))
                                  allPeers peers
               }

-----------------------------------
-- Tracking when we can (re)connect
--

minConnectTime :: Ord peeraddr
               => KnownPeers peeraddr
               -> (peeraddr -> Bool)
               -- ^ a predicate which describes the peers to take into account
               -> Maybe Time
minConnectTime :: forall peeraddr.
Ord peeraddr =>
KnownPeers peeraddr -> (peeraddr -> Bool) -> Maybe Time
minConnectTime KnownPeers { OrdPSQ peeraddr Time ()
nextConnectTimes :: forall peeraddr. KnownPeers peeraddr -> OrdPSQ peeraddr Time ()
nextConnectTimes :: OrdPSQ peeraddr Time ()
nextConnectTimes } peeraddr -> Bool
fn =
    OrdPSQ peeraddr Time () -> Maybe Time
forall {a} {v}. Ord a => OrdPSQ peeraddr a v -> Maybe a
go OrdPSQ peeraddr Time ()
nextConnectTimes
  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


setConnectTimes :: Ord peeraddr
                => Map peeraddr Time --TODO: make this a single entry
                -> KnownPeers peeraddr
                -> KnownPeers peeraddr
setConnectTimes :: forall peeraddr.
Ord peeraddr =>
Map peeraddr Time -> KnownPeers peeraddr -> KnownPeers peeraddr
setConnectTimes Map peeraddr Time
times
                knownPeers :: KnownPeers peeraddr
knownPeers@KnownPeers {
                  Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers,
                  Set peeraddr
availableToConnect :: forall peeraddr. KnownPeers peeraddr -> Set peeraddr
availableToConnect :: Set peeraddr
availableToConnect,
                  OrdPSQ peeraddr Time ()
nextConnectTimes :: forall peeraddr. KnownPeers peeraddr -> OrdPSQ peeraddr Time ()
nextConnectTimes :: OrdPSQ peeraddr Time ()
nextConnectTimes
                } =
    Bool -> KnownPeers peeraddr -> KnownPeers peeraddr
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 KnownPeerInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map peeraddr KnownPeerInfo
allPeers) (Map peeraddr Time -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr Time
times)) (KnownPeers peeraddr -> KnownPeers peeraddr)
-> KnownPeers peeraddr -> KnownPeers peeraddr
forall a b. (a -> b) -> a -> b
$
    let knownPeers' :: KnownPeers peeraddr
knownPeers' = KnownPeers peeraddr
knownPeers {
          availableToConnect =
                   availableToConnect
            Set.\\ Map.keysSet times,

          nextConnectTimes =
            Map.foldlWithKey' (\OrdPSQ peeraddr Time ()
psq peeraddr
peeraddr Time
time -> 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)
                              nextConnectTimes
                              times
        }
    in Bool -> KnownPeers peeraddr -> KnownPeers peeraddr
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (KnownPeers peeraddr -> Bool
forall peeraddr. Ord peeraddr => KnownPeers peeraddr -> Bool
invariant KnownPeers peeraddr
knownPeers') KnownPeers peeraddr
knownPeers'


---------------------------------
-- Selecting peers to ask
--

-- Only make Peer Share requests to peers which wish to participate in
-- PeerSharing, i.e. have non-'PeerSharingDisabled' 'PeerSharing' values.
--
canPeerShareRequest :: Ord peeraddr => peeraddr -> KnownPeers peeraddr -> Bool
canPeerShareRequest :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Bool
canPeerShareRequest peeraddr
pa KnownPeers { Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers } =
  case peeraddr -> Map peeraddr KnownPeerInfo -> Maybe KnownPeerInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peeraddr
pa Map peeraddr KnownPeerInfo
allPeers of
    Just KnownPeerInfo
          { knownPeerSharing :: KnownPeerInfo -> StrictMaybe PeerSharing
knownPeerSharing = SJust PeerSharing
PeerSharingEnabled
          } -> Bool
True
    Maybe KnownPeerInfo
_       -> Bool
False

-- Only share peers which are allowed to be advertised, i.e. have
-- 'DoAdvertisePeer' 'PeerAdvertise' values.
--
canSharePeers :: Ord peeraddr => peeraddr -> KnownPeers peeraddr -> Bool
canSharePeers :: forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Bool
canSharePeers peeraddr
pa KnownPeers { Map peeraddr KnownPeerInfo
allPeers :: forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers :: Map peeraddr KnownPeerInfo
allPeers } =
  case peeraddr -> Map peeraddr KnownPeerInfo -> Maybe KnownPeerInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peeraddr
pa Map peeraddr KnownPeerInfo
allPeers of
    Just KnownPeerInfo
          { knownPeerAdvertise :: KnownPeerInfo -> StrictMaybe PeerAdvertise
knownPeerAdvertise        = SJust PeerAdvertise
DoAdvertisePeer
          , knownSuccessfulConnection :: KnownPeerInfo -> Bool
knownSuccessfulConnection = Bool
True
          , knownPeerFailCount :: KnownPeerInfo -> Int
knownPeerFailCount        = Int
0
          } -> Bool
True
    Maybe KnownPeerInfo
_       -> Bool
False

-- | Filter peers available for Peer Sharing requests, according to their
-- 'PeerSharing' information
--
getPeerSharingRequestPeers :: Ord peeraddr
                           => Set peeraddr
                           -> KnownPeers peeraddr
                           -> Set peeraddr
getPeerSharingRequestPeers :: forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> Set peeraddr
getPeerSharingRequestPeers Set peeraddr
availableForPeerShare KnownPeers peeraddr
knownPeers =
  (peeraddr -> Bool) -> Set peeraddr -> Set peeraddr
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (peeraddr -> KnownPeers peeraddr -> Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> KnownPeers peeraddr -> Bool
`canPeerShareRequest` KnownPeers peeraddr
knownPeers) Set peeraddr
availableForPeerShare

-- | Filter peers available for Peer Sharing replies, according to their
-- 'PeerAdvertise' information
--
getPeerSharingResponsePeers :: KnownPeers peeraddr
                            -> Set peeraddr
getPeerSharingResponsePeers :: forall peeraddr. KnownPeers peeraddr -> Set peeraddr
getPeerSharingResponsePeers KnownPeers peeraddr
knownPeers =
    Map peeraddr KnownPeerInfo -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet
  (Map peeraddr KnownPeerInfo -> Set peeraddr)
-> Map peeraddr KnownPeerInfo -> Set peeraddr
forall a b. (a -> b) -> a -> b
$ (KnownPeerInfo -> Bool)
-> Map peeraddr KnownPeerInfo -> Map peeraddr KnownPeerInfo
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\case
                  KnownPeerInfo
                    { knownPeerAdvertise :: KnownPeerInfo -> StrictMaybe PeerAdvertise
knownPeerAdvertise        = SJust PeerAdvertise
DoAdvertisePeer
                    , knownSuccessfulConnection :: KnownPeerInfo -> Bool
knownSuccessfulConnection = Bool
True
                    , knownPeerFailCount :: KnownPeerInfo -> Int
knownPeerFailCount        = Int
0
                    } -> Bool
True
                  KnownPeerInfo
_   -> Bool
False
               )
  (Map peeraddr KnownPeerInfo -> Map peeraddr KnownPeerInfo)
-> Map peeraddr KnownPeerInfo -> Map peeraddr KnownPeerInfo
forall a b. (a -> b) -> a -> b
$ KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
allPeers KnownPeers peeraddr
knownPeers


---------------------------------
-- Selecting peers to advertise
--

-- | Select a random subset of the known peers that are available to publish.
--
-- The selection is done in such a way that when the same initial PRNG state is
-- used, the selected set does not significantly vary with small perturbations
-- in the set of published peers.
--
-- The intention of this selection method is that the selection should give
-- approximately the same replies to the same peers over the course of multiple
-- requests from the same peer. This is to deliberately slow the rate at which
-- peers can discover and map out the entire network.
--
{-
sampleAdvertisedPeers :: RandomGen prng
                      => KnownPeers peeraddr
                      -> prng
                      -> Int
                      -> [peeraddr]
sampleAdvertisedPeers _ _ _ = []
-- idea is to generate a sequence of random numbers and map them to locations
-- in a relatively stable way, that's mostly insensitive to additions or
-- deletions
-}