{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE NamedFieldPuns    #-}

-- | The module is designed to be imported qualified.
--
module Ouroboros.Network.PeerSelection.PublicRootPeers
  ( -- * Types
    PublicRootPeers (..)
    -- Export constructors for defining tests.
  , invariant
    -- ** Polymorphic operations
  , member
  , empty
  , null
  , size
  , toAllLedgerPeerSet
  , fromLedgerPeers
  , fromBigLedgerPeers
  , toSet
  , difference
  , intersection
  , fromDisjointSets
  , mergeG
  ) where

import Prelude hiding (null)

import Data.Set (Set, (\\))
import Data.Set qualified as Set

---------------------------------------
-- Public root peer set representation
--
-- This data type is useful to abstract several public root peer sources into
-- one type. This helps cleaning up the code and centralizing everything under
-- a nice API.

-- | Public Root Peers consist of either a set of manually configured
-- bootstrap peers.
--
-- There's an implicit precedence that will priorise bootstrap peers over the
-- other sets, so if we are adding a bootstrap peer and that peer is already a
-- member of other public root set, it is going to be removed from that set
-- and added to the bootstrap peer set.
--
data PublicRootPeers extraPeers peeraddr =
  PublicRootPeers { forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getLedgerPeers    :: !(Set peeraddr)
                  , forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getBigLedgerPeers :: !(Set peeraddr)
                  , forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers     :: !extraPeers
                  }
  deriving (PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr -> Bool
(PublicRootPeers extraPeers peeraddr
 -> PublicRootPeers extraPeers peeraddr -> Bool)
-> (PublicRootPeers extraPeers peeraddr
    -> PublicRootPeers extraPeers peeraddr -> Bool)
-> Eq (PublicRootPeers extraPeers peeraddr)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall extraPeers peeraddr.
(Eq peeraddr, Eq extraPeers) =>
PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr -> Bool
$c== :: forall extraPeers peeraddr.
(Eq peeraddr, Eq extraPeers) =>
PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr -> Bool
== :: PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr -> Bool
$c/= :: forall extraPeers peeraddr.
(Eq peeraddr, Eq extraPeers) =>
PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr -> Bool
/= :: PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr -> Bool
Eq, Int -> PublicRootPeers extraPeers peeraddr -> ShowS
[PublicRootPeers extraPeers peeraddr] -> ShowS
PublicRootPeers extraPeers peeraddr -> String
(Int -> PublicRootPeers extraPeers peeraddr -> ShowS)
-> (PublicRootPeers extraPeers peeraddr -> String)
-> ([PublicRootPeers extraPeers peeraddr] -> ShowS)
-> Show (PublicRootPeers extraPeers peeraddr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall extraPeers peeraddr.
(Show peeraddr, Show extraPeers) =>
Int -> PublicRootPeers extraPeers peeraddr -> ShowS
forall extraPeers peeraddr.
(Show peeraddr, Show extraPeers) =>
[PublicRootPeers extraPeers peeraddr] -> ShowS
forall extraPeers peeraddr.
(Show peeraddr, Show extraPeers) =>
PublicRootPeers extraPeers peeraddr -> String
$cshowsPrec :: forall extraPeers peeraddr.
(Show peeraddr, Show extraPeers) =>
Int -> PublicRootPeers extraPeers peeraddr -> ShowS
showsPrec :: Int -> PublicRootPeers extraPeers peeraddr -> ShowS
$cshow :: forall extraPeers peeraddr.
(Show peeraddr, Show extraPeers) =>
PublicRootPeers extraPeers peeraddr -> String
show :: PublicRootPeers extraPeers peeraddr -> String
$cshowList :: forall extraPeers peeraddr.
(Show peeraddr, Show extraPeers) =>
[PublicRootPeers extraPeers peeraddr] -> ShowS
showList :: [PublicRootPeers extraPeers peeraddr] -> ShowS
Show)

empty :: extraPeers -> PublicRootPeers extraPeers peeraddr
empty :: forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
empty extraPeers
emptyExtraPeers = Set peeraddr
-> Set peeraddr
-> extraPeers
-> PublicRootPeers extraPeers peeraddr
forall extraPeers peeraddr.
Set peeraddr
-> Set peeraddr
-> extraPeers
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers Set peeraddr
forall a. Set a
Set.empty Set peeraddr
forall a. Set a
Set.empty extraPeers
emptyExtraPeers

member :: Ord peeraddr
       => peeraddr
       -> (peeraddr -> extraPeers -> Bool)
       -> PublicRootPeers extraPeers peeraddr
       -> Bool
member :: forall peeraddr extraPeers.
Ord peeraddr =>
peeraddr
-> (peeraddr -> extraPeers -> Bool)
-> PublicRootPeers extraPeers peeraddr
-> Bool
member peeraddr
p peeraddr -> extraPeers -> Bool
memberExtraPeers (PublicRootPeers Set peeraddr
lp Set peeraddr
blp extraPeers
ep) =
     peeraddr -> extraPeers -> Bool
memberExtraPeers peeraddr
p extraPeers
ep
  Bool -> Bool -> Bool
|| peeraddr -> Set peeraddr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member peeraddr
p Set peeraddr
lp
  Bool -> Bool -> Bool
|| peeraddr -> Set peeraddr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member peeraddr
p Set peeraddr
blp

fromLedgerPeers :: Monoid extraPeers
                => Set peeraddr
                -> PublicRootPeers extraPeers peeraddr
fromLedgerPeers :: forall extraPeers peeraddr.
Monoid extraPeers =>
Set peeraddr -> PublicRootPeers extraPeers peeraddr
fromLedgerPeers Set peeraddr
lp =
  (extraPeers -> PublicRootPeers extraPeers peeraddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
empty extraPeers
forall a. Monoid a => a
mempty) { getLedgerPeers = lp }

fromBigLedgerPeers :: Monoid extraPeers
                   => Set peeraddr
                   -> PublicRootPeers extraPeers peeraddr
fromBigLedgerPeers :: forall extraPeers peeraddr.
Monoid extraPeers =>
Set peeraddr -> PublicRootPeers extraPeers peeraddr
fromBigLedgerPeers Set peeraddr
blp =
  (extraPeers -> PublicRootPeers extraPeers peeraddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
empty extraPeers
forall a. Monoid a => a
mempty) { getBigLedgerPeers = blp }

nullLedgerPeers :: PublicRootPeers extraPeers peeraddr -> Bool
nullLedgerPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Bool
nullLedgerPeers PublicRootPeers { Set peeraddr
getLedgerPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getLedgerPeers :: Set peeraddr
getLedgerPeers } =
  Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
getLedgerPeers

nullBigLedgerPeers :: PublicRootPeers extraPeers peeraddr -> Bool
nullBigLedgerPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Bool
nullBigLedgerPeers PublicRootPeers { Set peeraddr
getBigLedgerPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getBigLedgerPeers :: Set peeraddr
getBigLedgerPeers } =
  Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
getBigLedgerPeers

nullAllLedgerPeers :: PublicRootPeers extraPeers peeraddr -> Bool
nullAllLedgerPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Bool
nullAllLedgerPeers PublicRootPeers extraPeers peeraddr
prp =
  PublicRootPeers extraPeers peeraddr -> Bool
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Bool
nullLedgerPeers PublicRootPeers extraPeers peeraddr
prp Bool -> Bool -> Bool
&& PublicRootPeers extraPeers peeraddr -> Bool
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Bool
nullBigLedgerPeers PublicRootPeers extraPeers peeraddr
prp

toAllLedgerPeerSet :: Ord peeraddr => PublicRootPeers extraPeers peeraddr -> Set peeraddr
toAllLedgerPeerSet :: forall peeraddr extraPeers.
Ord peeraddr =>
PublicRootPeers extraPeers peeraddr -> Set peeraddr
toAllLedgerPeerSet (PublicRootPeers Set peeraddr
lp Set peeraddr
blp extraPeers
_) = Set peeraddr
lp Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
blp

toSet :: Ord peeraddr
      => (extraPeers -> Set peeraddr)
      -> PublicRootPeers extraPeers peeraddr
      -> Set peeraddr
toSet :: forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
toSet extraPeers -> Set peeraddr
extraPeersToSet (PublicRootPeers Set peeraddr
lp Set peeraddr
blp extraPeers
ep) =
  extraPeers -> Set peeraddr
extraPeersToSet extraPeers
ep Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
lp Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
blp

invariant :: Ord peeraddr
          => (extraPeers -> Bool)
          -> (extraPeers -> Set peeraddr)
          -> PublicRootPeers extraPeers peeraddr
          -> Bool
invariant :: forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Bool)
-> (extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr
-> Bool
invariant extraPeers -> Bool
invariantExtraPeers extraPeers -> Set peeraddr
extraPeersToSet (PublicRootPeers Set peeraddr
lp Set peeraddr
blp extraPeers
ep) =
  -- Invariant of extraPeers hold and its set is disjoint
     extraPeers -> Bool
invariantExtraPeers extraPeers
ep
  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 (extraPeers -> Set peeraddr
extraPeersToSet extraPeers
ep) Set peeraddr
lp)
  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 (extraPeers -> Set peeraddr
extraPeersToSet extraPeers
ep) Set peeraddr
blp)

    -- ledger and big ledger peers should 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
lp Set peeraddr
blp)

null :: (extraPeers -> Bool)
     -> PublicRootPeers extraPeers peeraddr -> Bool
null :: forall extraPeers peeraddr.
(extraPeers -> Bool) -> PublicRootPeers extraPeers peeraddr -> Bool
null extraPeers -> Bool
nullExtraPeers prp :: PublicRootPeers extraPeers peeraddr
prp@(PublicRootPeers Set peeraddr
_ Set peeraddr
_ extraPeers
ep)  =
    extraPeers -> Bool
nullExtraPeers extraPeers
ep
  Bool -> Bool -> Bool
&& PublicRootPeers extraPeers peeraddr -> Bool
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Bool
nullAllLedgerPeers PublicRootPeers extraPeers peeraddr
prp

size :: (extraPeers -> Int)
     -> PublicRootPeers extraPeers peeraddr -> Int
size :: forall extraPeers peeraddr.
(extraPeers -> Int) -> PublicRootPeers extraPeers peeraddr -> Int
size extraPeers -> Int
sizeExtraPeers (PublicRootPeers Set peeraddr
lp Set peeraddr
blp extraPeers
ep) =
    extraPeers -> Int
sizeExtraPeers extraPeers
ep
  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
lp
  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
blp

difference :: Ord peeraddr
           => (extraPeers -> Set peeraddr -> extraPeers)
           -> PublicRootPeers extraPeers peeraddr
           -> Set peeraddr
           -> PublicRootPeers extraPeers peeraddr
difference :: forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
difference extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers (PublicRootPeers Set peeraddr
lp Set peeraddr
blp extraPeers
ep) Set peeraddr
addrs =
  Set peeraddr
-> Set peeraddr
-> extraPeers
-> PublicRootPeers extraPeers peeraddr
forall extraPeers peeraddr.
Set peeraddr
-> Set peeraddr
-> extraPeers
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers (Set peeraddr
lp Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
\\ Set peeraddr
addrs) (Set peeraddr
blp Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
\\ Set peeraddr
addrs) (extraPeers -> Set peeraddr -> extraPeers
differenceExtraPeers extraPeers
ep Set peeraddr
addrs)

intersection :: Ord peeraddr
             => (extraPeers -> Set peeraddr -> extraPeers)
             -> PublicRootPeers extraPeers peeraddr
             -> Set peeraddr
             -> PublicRootPeers extraPeers peeraddr
intersection :: forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
intersection extraPeers -> Set peeraddr -> extraPeers
intersectionExtraPeers (PublicRootPeers Set peeraddr
lp Set peeraddr
blp extraPeers
ep) Set peeraddr
addrs =
  Set peeraddr
-> Set peeraddr
-> extraPeers
-> PublicRootPeers extraPeers peeraddr
forall extraPeers peeraddr.
Set peeraddr
-> Set peeraddr
-> extraPeers
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers (Set peeraddr
lp Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
addrs)
                  (Set peeraddr
blp Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set peeraddr
addrs)
                  (extraPeers -> Set peeraddr -> extraPeers
intersectionExtraPeers extraPeers
ep Set peeraddr
addrs)

-- Generalized fromMapAndSet function
fromDisjointSets :: Ord peeraddr
                 => (extraPeers -> Set peeraddr)
                 -> extraPeers
                 -> Set peeraddr -- ^ ledger peers
                 -> Set peeraddr -- ^ big ledger peers
                 -> PublicRootPeers extraPeers peeraddr
fromDisjointSets :: forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> extraPeers
-> Set peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
fromDisjointSets extraPeers -> Set peeraddr
extraPeersToSet extraPeers
ep Set peeraddr
lp Set peeraddr
blp =
    let epSet :: Set peeraddr
epSet = extraPeers -> Set peeraddr
extraPeersToSet extraPeers
ep
        newBLP :: Set peeraddr
newBLP = Set peeraddr
blp Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` (Set peeraddr
epSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
lp)
        newLP :: Set peeraddr
newLP = Set peeraddr
lp Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` (Set peeraddr
epSet Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
newBLP)
    in Set peeraddr
-> Set peeraddr
-> extraPeers
-> PublicRootPeers extraPeers peeraddr
forall extraPeers peeraddr.
Set peeraddr
-> Set peeraddr
-> extraPeers
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers Set peeraddr
newLP Set peeraddr
newBLP extraPeers
ep

-- Generalized merge function
mergeG :: ( Ord peeraddr
          , Semigroup extraPeers
          )
       => (extraPeers -> Set peeraddr)
       -> PublicRootPeers extraPeers peeraddr
       -> PublicRootPeers extraPeers peeraddr
       -> PublicRootPeers extraPeers peeraddr
mergeG :: forall peeraddr extraPeers.
(Ord peeraddr, Semigroup extraPeers) =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
mergeG extraPeers -> Set peeraddr
extraPeersToSet
       (PublicRootPeers Set peeraddr
lp1 Set peeraddr
blp1 extraPeers
ep1) (PublicRootPeers Set peeraddr
lp2 Set peeraddr
blp2 extraPeers
ep2) =
    (extraPeers -> Set peeraddr)
-> extraPeers
-> Set peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> extraPeers
-> Set peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
fromDisjointSets
        extraPeers -> Set peeraddr
extraPeersToSet
        (extraPeers
ep1 extraPeers -> extraPeers -> extraPeers
forall a. Semigroup a => a -> a -> a
<> extraPeers
ep2)
        (Set peeraddr
lp1 Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
lp2)
        (Set peeraddr
blp1 Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Semigroup a => a -> a -> a
<> Set peeraddr
blp2)