{-# LANGUAGE NamedFieldPuns #-}

module Ouroboros.Cardano.Network.PublicRootPeers where

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
import Ouroboros.Network.PeerSelection.Types

data ExtraPeers peeraddr =
  ExtraPeers
    { forall peeraddr. ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
getPublicConfigPeers :: !(Map peeraddr PeerAdvertise)
    , forall peeraddr. ExtraPeers peeraddr -> Set peeraddr
getBootstrapPeers    :: !(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 => 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
getPublicConfigPeers :: forall peeraddr. ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
getPublicConfigPeers :: Map peeraddr PeerAdvertise
getPublicConfigPeers } =
  Map peeraddr PeerAdvertise -> Bool
forall k a. Map k a -> Bool
Map.null Map peeraddr PeerAdvertise
getPublicConfigPeers

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

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