{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}

module Cardano.Network.PeerSelection.ExtraRootPeers
  ( ExtraPeers (..)
  , ToExtraTrace (..)
  , ViewExtraPeers (..)
  , toAdvertisePeersMap
  , intersection
  , difference
  , size
  , toSet
  , member
  , nullAll
  , nullBootstrap
  , nullPublicConfig
  , empty
  , fromMapAndSet
  , invariant
  , cardanoPublicRootPeersAPI
  ) where

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

import Cardano.Network.LedgerStateJudgement
import Cardano.Network.PeerSelection.Bootstrap
import Ouroboros.Network.PeerSelection.Governor.Types (PeerSelectionState (..),
           SupportsPeerSelectionState (..))
import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers (..))
import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
import Ouroboros.Network.PeerSelection.Types

data ExtraPeers peeraddr =
  ExtraPeers
    { forall peeraddr. ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
publicConfigPeers :: !(Map peeraddr PeerAdvertise)
    , forall peeraddr. ExtraPeers peeraddr -> Set peeraddr
bootstrapPeers    :: !(Set peeraddr)
    }
  deriving (ExtraPeers peeraddr -> ExtraPeers peeraddr -> Bool
(ExtraPeers peeraddr -> ExtraPeers peeraddr -> Bool)
-> (ExtraPeers peeraddr -> ExtraPeers peeraddr -> Bool)
-> Eq (ExtraPeers peeraddr)
forall peeraddr.
Eq peeraddr =>
ExtraPeers peeraddr -> ExtraPeers peeraddr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall peeraddr.
Eq peeraddr =>
ExtraPeers peeraddr -> ExtraPeers peeraddr -> Bool
== :: ExtraPeers peeraddr -> ExtraPeers peeraddr -> Bool
$c/= :: forall peeraddr.
Eq peeraddr =>
ExtraPeers peeraddr -> ExtraPeers peeraddr -> Bool
/= :: ExtraPeers peeraddr -> ExtraPeers peeraddr -> Bool
Eq, Int -> ExtraPeers peeraddr -> ShowS
[ExtraPeers peeraddr] -> ShowS
ExtraPeers peeraddr -> String
(Int -> ExtraPeers peeraddr -> ShowS)
-> (ExtraPeers peeraddr -> String)
-> ([ExtraPeers peeraddr] -> ShowS)
-> Show (ExtraPeers peeraddr)
forall peeraddr.
Show peeraddr =>
Int -> ExtraPeers peeraddr -> ShowS
forall peeraddr. Show peeraddr => [ExtraPeers peeraddr] -> ShowS
forall peeraddr. Show peeraddr => ExtraPeers peeraddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peeraddr.
Show peeraddr =>
Int -> ExtraPeers peeraddr -> ShowS
showsPrec :: Int -> ExtraPeers peeraddr -> ShowS
$cshow :: forall peeraddr. Show peeraddr => ExtraPeers peeraddr -> String
show :: ExtraPeers peeraddr -> String
$cshowList :: forall peeraddr. Show peeraddr => [ExtraPeers peeraddr] -> ShowS
showList :: [ExtraPeers peeraddr] -> ShowS
Show)


instance ( Ord peeraddr
         , Show peeraddr
         ) => SupportsPeerSelectionState (ExtraPeers peeraddr) peeraddr where
  data ToExtraTrace (ExtraPeers peeraddr) =
           TraceLedgerStateJudgementChanged LedgerStateJudgement
         | TraceUseBootstrapPeersChanged UseBootstrapPeers
    deriving Int -> ToExtraTrace (ExtraPeers peeraddr) -> ShowS
[ToExtraTrace (ExtraPeers peeraddr)] -> ShowS
ToExtraTrace (ExtraPeers peeraddr) -> String
(Int -> ToExtraTrace (ExtraPeers peeraddr) -> ShowS)
-> (ToExtraTrace (ExtraPeers peeraddr) -> String)
-> ([ToExtraTrace (ExtraPeers peeraddr)] -> ShowS)
-> Show (ToExtraTrace (ExtraPeers peeraddr))
forall peeraddr. Int -> ToExtraTrace (ExtraPeers peeraddr) -> ShowS
forall peeraddr. [ToExtraTrace (ExtraPeers peeraddr)] -> ShowS
forall peeraddr. ToExtraTrace (ExtraPeers peeraddr) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peeraddr. Int -> ToExtraTrace (ExtraPeers peeraddr) -> ShowS
showsPrec :: Int -> ToExtraTrace (ExtraPeers peeraddr) -> ShowS
$cshow :: forall peeraddr. ToExtraTrace (ExtraPeers peeraddr) -> String
show :: ToExtraTrace (ExtraPeers peeraddr) -> String
$cshowList :: forall peeraddr. [ToExtraTrace (ExtraPeers peeraddr)] -> ShowS
showList :: [ToExtraTrace (ExtraPeers peeraddr)] -> ShowS
Show

  data ViewExtraPeers (ExtraPeers peeraddr) = ExtraPeerSelectionSetsWithSizes {
      forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewKnownBootstrapPeers           :: (Set peeraddr, Int)
    , forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewColdBootstrapPeersPromotions  :: (Set peeraddr, Int)
    , forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewEstablishedBootstrapPeers     :: (Set peeraddr, Int)
    , forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewWarmBootstrapPeersDemotions   :: (Set peeraddr, Int)
    , forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewWarmBootstrapPeersPromotions  :: (Set peeraddr, Int)
    , forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewActiveBootstrapPeers          :: (Set peeraddr, Int)
    , forall peeraddr.
ViewExtraPeers (ExtraPeers peeraddr) -> (Set peeraddr, Int)
viewActiveBootstrapPeersDemotions :: (Set peeraddr, Int)
    } deriving (ViewExtraPeers (ExtraPeers peeraddr)
-> ViewExtraPeers (ExtraPeers peeraddr) -> Bool
(ViewExtraPeers (ExtraPeers peeraddr)
 -> ViewExtraPeers (ExtraPeers peeraddr) -> Bool)
-> (ViewExtraPeers (ExtraPeers peeraddr)
    -> ViewExtraPeers (ExtraPeers peeraddr) -> Bool)
-> Eq (ViewExtraPeers (ExtraPeers peeraddr))
forall peeraddr.
Eq peeraddr =>
ViewExtraPeers (ExtraPeers peeraddr)
-> ViewExtraPeers (ExtraPeers peeraddr) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall peeraddr.
Eq peeraddr =>
ViewExtraPeers (ExtraPeers peeraddr)
-> ViewExtraPeers (ExtraPeers peeraddr) -> Bool
== :: ViewExtraPeers (ExtraPeers peeraddr)
-> ViewExtraPeers (ExtraPeers peeraddr) -> Bool
$c/= :: forall peeraddr.
Eq peeraddr =>
ViewExtraPeers (ExtraPeers peeraddr)
-> ViewExtraPeers (ExtraPeers peeraddr) -> Bool
/= :: ViewExtraPeers (ExtraPeers peeraddr)
-> ViewExtraPeers (ExtraPeers peeraddr) -> Bool
Eq, Int -> ViewExtraPeers (ExtraPeers peeraddr) -> ShowS
[ViewExtraPeers (ExtraPeers peeraddr)] -> ShowS
ViewExtraPeers (ExtraPeers peeraddr) -> String
(Int -> ViewExtraPeers (ExtraPeers peeraddr) -> ShowS)
-> (ViewExtraPeers (ExtraPeers peeraddr) -> String)
-> ([ViewExtraPeers (ExtraPeers peeraddr)] -> ShowS)
-> Show (ViewExtraPeers (ExtraPeers peeraddr))
forall peeraddr.
Show peeraddr =>
Int -> ViewExtraPeers (ExtraPeers peeraddr) -> ShowS
forall peeraddr.
Show peeraddr =>
[ViewExtraPeers (ExtraPeers peeraddr)] -> ShowS
forall peeraddr.
Show peeraddr =>
ViewExtraPeers (ExtraPeers peeraddr) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peeraddr.
Show peeraddr =>
Int -> ViewExtraPeers (ExtraPeers peeraddr) -> ShowS
showsPrec :: Int -> ViewExtraPeers (ExtraPeers peeraddr) -> ShowS
$cshow :: forall peeraddr.
Show peeraddr =>
ViewExtraPeers (ExtraPeers peeraddr) -> String
show :: ViewExtraPeers (ExtraPeers peeraddr) -> String
$cshowList :: forall peeraddr.
Show peeraddr =>
[ViewExtraPeers (ExtraPeers peeraddr)] -> ShowS
showList :: [ViewExtraPeers (ExtraPeers peeraddr)] -> ShowS
Show)

  publicExtraPeersAPI :: PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
publicExtraPeersAPI = PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
forall peeraddr.
Ord peeraddr =>
PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
cardanoPublicRootPeersAPI

  mkViewExtraPeers :: forall extraState extraFlags peerconn.
PeerSelectionState
  extraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> ViewExtraPeers (ExtraPeers peeraddr)
mkViewExtraPeers PeerSelectionState {extraState
Bool
Int
Maybe (LedgerPeerSnapshot BigLedgerPeers)
StdGen
Set peeraddr
Time
PublicRootPeers (ExtraPeers peeraddr) peeraddr
EstablishedPeers peeraddr peerconn
KnownPeers peeraddr
LocalRootPeers extraFlags peeraddr
PeerSelectionTargets
targets :: PeerSelectionTargets
localRootPeers :: LocalRootPeers extraFlags peeraddr
publicRootPeers :: PublicRootPeers (ExtraPeers peeraddr) peeraddr
knownPeers :: KnownPeers peeraddr
establishedPeers :: EstablishedPeers peeraddr peerconn
activePeers :: Set peeraddr
publicRootBackoffs :: Int
publicRootRetryTime :: Time
inProgressPublicRootsReq :: Bool
bigLedgerPeerBackoffs :: Int
bigLedgerPeerRetryTime :: Time
inProgressBigLedgerPeersReq :: Bool
inProgressPeerShareReqs :: Int
inProgressPromoteCold :: Set peeraddr
inProgressPromoteWarm :: Set peeraddr
inProgressDemoteWarm :: Set peeraddr
inProgressDemoteHot :: Set peeraddr
inProgressDemoteToCold :: Set peeraddr
stdGen :: StdGen
inboundPeersRetryTime :: Time
ledgerPeerSnapshot :: Maybe (LedgerPeerSnapshot BigLedgerPeers)
extraState :: extraState
activePeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
bigLedgerPeerBackoffs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
bigLedgerPeerRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
establishedPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
extraState :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
inProgressBigLedgerPeersReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inProgressDemoteHot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteToCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressDemoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPeerShareReqs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
inProgressPromoteCold :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPromoteWarm :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
inProgressPublicRootsReq :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Bool
inboundPeersRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
knownPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
ledgerPeerSnapshot :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Maybe (LedgerPeerSnapshot BigLedgerPeers)
localRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
publicRootBackoffs :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Int
publicRootPeers :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
publicRootRetryTime :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Time
stdGen :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> StdGen
targets :: forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
..} =
      ExtraPeerSelectionSetsWithSizes {
          viewKnownBootstrapPeers :: (Set peeraddr, Int)
viewKnownBootstrapPeers           = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size'   Set peeraddr
knownBootstrapPeersSet
        , viewColdBootstrapPeersPromotions :: (Set peeraddr, Int)
viewColdBootstrapPeersPromotions  = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size' (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
knownBootstrapPeersSet
                                              Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressPromoteCold
        , viewEstablishedBootstrapPeers :: (Set peeraddr, Int)
viewEstablishedBootstrapPeers     = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size'   Set peeraddr
establishedBootstrapPeersSet
        , viewWarmBootstrapPeersDemotions :: (Set peeraddr, Int)
viewWarmBootstrapPeersDemotions   = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size' (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
establishedBootstrapPeersSet
                                              Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressDemoteWarm
        , viewWarmBootstrapPeersPromotions :: (Set peeraddr, Int)
viewWarmBootstrapPeersPromotions  = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size' (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
establishedBootstrapPeersSet
                                              Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressPromoteWarm
        , viewActiveBootstrapPeers :: (Set peeraddr, Int)
viewActiveBootstrapPeers          = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size'   Set peeraddr
activeBootstrapPeersSet
        , viewActiveBootstrapPeersDemotions :: (Set peeraddr, Int)
viewActiveBootstrapPeersDemotions = Set peeraddr -> (Set peeraddr, Int)
forall {a}. Set a -> (Set a, Int)
size' (Set peeraddr -> (Set peeraddr, Int))
-> Set peeraddr -> (Set peeraddr, Int)
forall a b. (a -> b) -> a -> b
$ Set peeraddr
activeBootstrapPeersSet
                                              Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
inProgressDemoteHot
        }
    where
      size' :: Set a -> (Set a, Int)
size' Set a
s = (Set a
s, Set a -> Int
forall a. Set a -> Int
Set.size Set a
s)

      -- common sets
      establishedSet :: Set peeraddr
establishedSet = EstablishedPeers peeraddr peerconn -> Set peeraddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet EstablishedPeers peeraddr peerconn
establishedPeers
      bigLedgerSet :: Set peeraddr
bigLedgerSet   = PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getBigLedgerPeers PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers

      -- non big ledger peers
      establishedPeersSet :: Set peeraddr
establishedPeersSet = Set peeraddr
establishedSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
establishedBigLedgerPeersSet
      activePeersSet :: Set peeraddr
activePeersSet      = Set peeraddr
activePeers Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set peeraddr
activeBigLedgerPeersSet

      -- big ledger peers
      establishedBigLedgerPeersSet :: Set peeraddr
establishedBigLedgerPeersSet = Set peeraddr
establishedSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
bigLedgerSet
      activeBigLedgerPeersSet :: Set peeraddr
activeBigLedgerPeersSet      = Set peeraddr
establishedBigLedgerPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
activePeers

      -- bootstrap peers
      bootstrapSet :: Set peeraddr
bootstrapSet = ExtraPeers peeraddr -> Set peeraddr
forall peeraddr. ExtraPeers peeraddr -> Set peeraddr
bootstrapPeers (ExtraPeers peeraddr -> Set peeraddr)
-> ExtraPeers peeraddr -> Set peeraddr
forall a b. (a -> b) -> a -> b
$ PublicRootPeers (ExtraPeers peeraddr) peeraddr
-> ExtraPeers peeraddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers PublicRootPeers (ExtraPeers peeraddr) peeraddr
publicRootPeers
      -- bootstrap peers and big ledger peers are disjoint, hence we can use
      -- `knownPeersSet`, `establishedPeersSet` and `activePeersSet` below.
      knownBootstrapPeersSet :: Set peeraddr
knownBootstrapPeersSet       = Set peeraddr
bootstrapSet
      establishedBootstrapPeersSet :: Set peeraddr
establishedBootstrapPeersSet = Set peeraddr
establishedPeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
bootstrapSet
      activeBootstrapPeersSet :: Set peeraddr
activeBootstrapPeersSet      = Set peeraddr
activePeersSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
bootstrapSet


instance Ord peeraddr => Semigroup (ExtraPeers peeraddr) where
  (ExtraPeers Map peeraddr PeerAdvertise
a Set peeraddr
b) <> :: ExtraPeers peeraddr -> ExtraPeers peeraddr -> ExtraPeers peeraddr
<> (ExtraPeers Map peeraddr PeerAdvertise
a' Set peeraddr
b') =
    let -- Combine the sets, prioritizing bootstrapPeers
        combinedSet :: Set peeraddr
combinedSet = Set peeraddr
b Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set peeraddr
b'
        -- Combine the maps and remove any peers that are now in the set
        combinedMap :: Map peeraddr PeerAdvertise
combinedMap = (Map peeraddr PeerAdvertise
a Map peeraddr PeerAdvertise
-> Map peeraddr PeerAdvertise -> Map peeraddr PeerAdvertise
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map peeraddr PeerAdvertise
a') Map peeraddr PeerAdvertise
-> Set peeraddr -> Map peeraddr PeerAdvertise
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set peeraddr
combinedSet
    in Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers Map peeraddr PeerAdvertise
combinedMap Set peeraddr
combinedSet

instance Ord peeraddr => Monoid (ExtraPeers peeraddr) where
  mempty :: ExtraPeers peeraddr
mempty = ExtraPeers peeraddr
forall peeraddr. ExtraPeers peeraddr
empty

-- Cardano Public Root Peers Actions
cardanoPublicRootPeersAPI :: Ord peeraddr => PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
cardanoPublicRootPeersAPI :: forall peeraddr.
Ord peeraddr =>
PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
cardanoPublicRootPeersAPI =
  PublicExtraPeersAPI {
    nullExtraPeers :: ExtraPeers peeraddr -> Bool
nullExtraPeers         = ExtraPeers peeraddr -> Bool
forall peeraddr. ExtraPeers peeraddr -> Bool
nullAll
  , invariantExtraPeers :: ExtraPeers peeraddr -> Bool
invariantExtraPeers    = ExtraPeers peeraddr -> Bool
forall peeraddr. Ord peeraddr => ExtraPeers peeraddr -> Bool
invariant
  , memberExtraPeers :: peeraddr -> ExtraPeers peeraddr -> Bool
memberExtraPeers       = peeraddr -> ExtraPeers peeraddr -> Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> ExtraPeers peeraddr -> Bool
member
  , extraPeersToSet :: ExtraPeers peeraddr -> Set peeraddr
extraPeersToSet        = ExtraPeers peeraddr -> Set peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
toSet
  , sizeExtraPeers :: ExtraPeers peeraddr -> Int
sizeExtraPeers         = ExtraPeers peeraddr -> Int
forall peeraddr. ExtraPeers peeraddr -> Int
size
  , differenceExtraPeers :: ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
differenceExtraPeers   = ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
difference
  , intersectionExtraPeers :: ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
intersectionExtraPeers = ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
intersection
  , toAdvertise :: ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
toAdvertise            = ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
toAdvertisePeersMap
  }

-- Map and Set are disjoint
invariant :: Ord peeraddr => ExtraPeers peeraddr -> Bool
invariant :: forall peeraddr. Ord peeraddr => ExtraPeers peeraddr -> Bool
invariant (ExtraPeers Map peeraddr PeerAdvertise
a Set peeraddr
b) = (peeraddr -> Bool) -> Set peeraddr -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (peeraddr -> Map peeraddr PeerAdvertise -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map peeraddr PeerAdvertise
a) Set peeraddr
b

fromMapAndSet :: Ord peeraddr
              => Map peeraddr PeerAdvertise
              -> Set peeraddr
              -> ExtraPeers peeraddr
fromMapAndSet :: forall peeraddr.
Ord peeraddr =>
Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
fromMapAndSet Map peeraddr PeerAdvertise
pp Set peeraddr
bsp =
  let newPP :: Map peeraddr PeerAdvertise
newPP = Map peeraddr PeerAdvertise
pp Map peeraddr PeerAdvertise
-> Set peeraddr -> Map peeraddr PeerAdvertise
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set peeraddr
bsp
   in Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers Map peeraddr PeerAdvertise
newPP Set peeraddr
bsp

empty :: ExtraPeers peeraddr
empty :: forall peeraddr. ExtraPeers peeraddr
empty = Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers Map peeraddr PeerAdvertise
forall k a. Map k a
Map.empty Set peeraddr
forall a. Set a
Set.empty

nullPublicConfig :: ExtraPeers peeraddr -> Bool
nullPublicConfig :: forall peeraddr. ExtraPeers peeraddr -> Bool
nullPublicConfig ExtraPeers { Map peeraddr PeerAdvertise
publicConfigPeers :: forall peeraddr. ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
publicConfigPeers :: Map peeraddr PeerAdvertise
publicConfigPeers } =
  Map peeraddr PeerAdvertise -> Bool
forall k a. Map k a -> Bool
Map.null Map peeraddr PeerAdvertise
publicConfigPeers

nullBootstrap :: ExtraPeers peeraddr -> Bool
nullBootstrap :: forall peeraddr. ExtraPeers peeraddr -> Bool
nullBootstrap ExtraPeers { Set peeraddr
bootstrapPeers :: forall peeraddr. ExtraPeers peeraddr -> Set peeraddr
bootstrapPeers :: Set peeraddr
bootstrapPeers } =
  Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
bootstrapPeers

nullAll :: ExtraPeers peeraddr -> Bool
nullAll :: forall peeraddr. ExtraPeers peeraddr -> Bool
nullAll ExtraPeers peeraddr
cprp = ExtraPeers peeraddr -> Bool
forall peeraddr. ExtraPeers peeraddr -> Bool
nullPublicConfig ExtraPeers peeraddr
cprp Bool -> Bool -> Bool
&& ExtraPeers peeraddr -> Bool
forall peeraddr. ExtraPeers peeraddr -> Bool
nullBootstrap ExtraPeers peeraddr
cprp

member :: Ord peeraddr => peeraddr -> ExtraPeers peeraddr -> Bool
member :: forall peeraddr.
Ord peeraddr =>
peeraddr -> ExtraPeers peeraddr -> Bool
member peeraddr
addr (ExtraPeers Map peeraddr PeerAdvertise
a Set peeraddr
b) =
  peeraddr -> Map peeraddr PeerAdvertise -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member peeraddr
addr Map peeraddr PeerAdvertise
a Bool -> Bool -> Bool
|| peeraddr -> Set peeraddr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member peeraddr
addr Set peeraddr
b

toSet :: Ord peeraddr => ExtraPeers peeraddr -> Set peeraddr
toSet :: forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
toSet (ExtraPeers Map peeraddr PeerAdvertise
a Set peeraddr
b) = Map peeraddr PeerAdvertise -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr PeerAdvertise
a Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
b

size :: ExtraPeers peeraddr -> Int
size :: forall peeraddr. ExtraPeers peeraddr -> Int
size (ExtraPeers Map peeraddr PeerAdvertise
a Set peeraddr
b) = Map peeraddr PeerAdvertise -> Int
forall k a. Map k a -> Int
Map.size Map peeraddr PeerAdvertise
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
b

difference :: Ord peeraddr
           => ExtraPeers peeraddr
           -> Set peeraddr
           -> ExtraPeers peeraddr
difference :: forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
difference (ExtraPeers Map peeraddr PeerAdvertise
a Set peeraddr
b) Set peeraddr
addrs =
  Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers (Map peeraddr PeerAdvertise
-> Set peeraddr -> Map peeraddr PeerAdvertise
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map peeraddr PeerAdvertise
a Set peeraddr
addrs)
                         (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set peeraddr
b Set peeraddr
addrs)

intersection :: Ord peeraddr
             => ExtraPeers peeraddr
             -> Set peeraddr
             -> ExtraPeers peeraddr
intersection :: forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
intersection (ExtraPeers Map peeraddr PeerAdvertise
a Set peeraddr
b) Set peeraddr
addrs =
  Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers (Map peeraddr PeerAdvertise
-> Set peeraddr -> Map peeraddr PeerAdvertise
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map peeraddr PeerAdvertise
a Set peeraddr
addrs)
                         (Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
b Set peeraddr
addrs)

toAdvertisePeersMap :: Ord peeraddr
                    => ExtraPeers peeraddr
                    -> Map peeraddr PeerAdvertise
toAdvertisePeersMap :: forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
toAdvertisePeersMap (ExtraPeers Map peeraddr PeerAdvertise
a Set peeraddr
b) =
  Map peeraddr PeerAdvertise
a Map peeraddr PeerAdvertise
-> Map peeraddr PeerAdvertise -> Map peeraddr PeerAdvertise
forall a. Semigroup a => a -> a -> a
<> (Map peeraddr PeerAdvertise
 -> peeraddr -> Map peeraddr PeerAdvertise)
-> Map peeraddr PeerAdvertise
-> Set peeraddr
-> Map peeraddr PeerAdvertise
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl (\Map peeraddr PeerAdvertise
m peeraddr
p -> peeraddr
-> PeerAdvertise
-> Map peeraddr PeerAdvertise
-> Map peeraddr PeerAdvertise
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert peeraddr
p PeerAdvertise
DoNotAdvertisePeer Map peeraddr PeerAdvertise
m) Map peeraddr PeerAdvertise
forall k a. Map k a
Map.empty Set peeraddr
b