{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE TypeSynonymInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Network.PeerSelection.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 Cardano.Network.PeerSelection.ExtraRootPeers (ExtraPeers (..))
import Cardano.Network.PeerSelection.ExtraRootPeers qualified as ExtraPeers
import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
import Ouroboros.Network.PeerSelection.PublicRootPeers

type CardanoPublicRootPeers peeraddr =
  PublicRootPeers (ExtraPeers peeraddr) peeraddr

instance ( Ord peeraddr
         ) => Semigroup (CardanoPublicRootPeers peeraddr) where
  <> :: CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
(<>) = CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
forall peeraddr.
Ord peeraddr =>
CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
merge

instance ( Ord peeraddr
         ) => Monoid (CardanoPublicRootPeers peeraddr) where
  mempty :: CardanoPublicRootPeers peeraddr
mempty = ExtraPeers peeraddr -> CardanoPublicRootPeers peeraddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
empty ExtraPeers peeraddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty

merge :: Ord peeraddr
      => CardanoPublicRootPeers peeraddr
      -> CardanoPublicRootPeers peeraddr
      -> CardanoPublicRootPeers peeraddr
merge :: forall peeraddr.
Ord peeraddr =>
CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
merge CardanoPublicRootPeers peeraddr
a CardanoPublicRootPeers peeraddr
b = (ExtraPeers peeraddr -> Set peeraddr)
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
forall peeraddr extraPeers.
(Ord peeraddr, Semigroup extraPeers) =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
-> PublicRootPeers extraPeers peeraddr
mergeG ExtraPeers peeraddr -> Set peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet CardanoPublicRootPeers peeraddr
a CardanoPublicRootPeers peeraddr
b

getPublicConfigPeers :: CardanoPublicRootPeers peeraddr -> Map peeraddr PeerAdvertise
getPublicConfigPeers :: forall peeraddr.
CardanoPublicRootPeers peeraddr -> Map peeraddr PeerAdvertise
getPublicConfigPeers PublicRootPeers { getExtraPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers = (ExtraPeers Map peeraddr PeerAdvertise
pp Set peeraddr
_) } = Map peeraddr PeerAdvertise
pp

getBootstrapPeers :: CardanoPublicRootPeers peeraddr -> Set peeraddr
getBootstrapPeers :: forall peeraddr. CardanoPublicRootPeers peeraddr -> Set peeraddr
getBootstrapPeers PublicRootPeers { getExtraPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers = (ExtraPeers Map peeraddr PeerAdvertise
_ Set peeraddr
bsp) } = Set peeraddr
bsp

toPublicConfigPeerSet :: CardanoPublicRootPeers peeraddr -> Set peeraddr
toPublicConfigPeerSet :: forall peeraddr. CardanoPublicRootPeers peeraddr -> Set peeraddr
toPublicConfigPeerSet PublicRootPeers {
                        getExtraPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers = ExtraPeers Map peeraddr PeerAdvertise
pp Set peeraddr
_
                      } = Map peeraddr PeerAdvertise -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr PeerAdvertise
pp

-- | Preserves PublicRootPeers invariant. If the two sets are not disjoint,
-- removes the common ones from the bootstrap peers set since its the most
-- sensitive set.
--
fromMapAndSet :: Ord peeraddr
              => Map peeraddr PeerAdvertise -- ^ public configured root peers
              -> Set peeraddr -- ^ bootstrap peers
              -> Set peeraddr -- ^ ledger peers
              -> Set peeraddr -- ^ big ledger peers
              -> CardanoPublicRootPeers peeraddr
fromMapAndSet :: forall peeraddr.
Ord peeraddr =>
Map peeraddr PeerAdvertise
-> Set peeraddr
-> Set peeraddr
-> Set peeraddr
-> CardanoPublicRootPeers peeraddr
fromMapAndSet Map peeraddr PeerAdvertise
pp Set peeraddr
bsp =
  (ExtraPeers peeraddr -> Set peeraddr)
-> ExtraPeers peeraddr
-> Set peeraddr
-> Set peeraddr
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> extraPeers
-> Set peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
fromDisjointSets ExtraPeers peeraddr -> Set peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet (Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Ord peeraddr =>
Map peeraddr PeerAdvertise -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers.fromMapAndSet Map peeraddr PeerAdvertise
pp Set peeraddr
bsp)

fromPublicRootPeers :: Map peeraddr PeerAdvertise
                    -> CardanoPublicRootPeers peeraddr
fromPublicRootPeers :: forall peeraddr.
Map peeraddr PeerAdvertise -> CardanoPublicRootPeers peeraddr
fromPublicRootPeers Map peeraddr PeerAdvertise
pp =
  ExtraPeers peeraddr
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
empty (ExtraPeers peeraddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty { publicConfigPeers = pp })

fromBootstrapPeers :: Set peeraddr
                   -> CardanoPublicRootPeers peeraddr
fromBootstrapPeers :: forall peeraddr. Set peeraddr -> CardanoPublicRootPeers peeraddr
fromBootstrapPeers Set peeraddr
bsp =
  ExtraPeers peeraddr
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
empty (ExtraPeers peeraddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty { bootstrapPeers = bsp })

insertPublicConfigPeer :: Ord peeraddr
                       => peeraddr
                       -> PeerAdvertise
                       -> CardanoPublicRootPeers peeraddr
                       -> CardanoPublicRootPeers peeraddr
insertPublicConfigPeer :: forall peeraddr.
Ord peeraddr =>
peeraddr
-> PeerAdvertise
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
insertPublicConfigPeer peeraddr
p PeerAdvertise
pa prp :: CardanoPublicRootPeers peeraddr
prp@PublicRootPeers {
                              getExtraPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers = ExtraPeers {
                                bootstrapPeers :: forall peeraddr. ExtraPeers peeraddr -> Set peeraddr
bootstrapPeers = Set peeraddr
getBootstrapPeers'
                              }
                            } =
  let prp' :: CardanoPublicRootPeers peeraddr
prp'@PublicRootPeers {
        getExtraPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers = ExtraPeers {
          publicConfigPeers :: forall peeraddr. ExtraPeers peeraddr -> Map peeraddr PeerAdvertise
publicConfigPeers = Map peeraddr PeerAdvertise
pp
        }
      } = (ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr)
-> CardanoPublicRootPeers peeraddr
-> Set peeraddr
-> CardanoPublicRootPeers peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
difference ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers.difference CardanoPublicRootPeers peeraddr
prp (peeraddr -> Set peeraddr
forall a. a -> Set a
Set.singleton peeraddr
p)
  in if peeraddr -> Set peeraddr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member peeraddr
p Set peeraddr
getBootstrapPeers'
     then CardanoPublicRootPeers peeraddr
prp
     else CardanoPublicRootPeers peeraddr
prp' { getExtraPeers = (getExtraPeers prp') {
                   publicConfigPeers = Map.insert p pa pp
                 }
               }

insertBootstrapPeer :: Ord peeraddr
                    => peeraddr
                    -> CardanoPublicRootPeers peeraddr
                    -> CardanoPublicRootPeers peeraddr
insertBootstrapPeer :: forall peeraddr.
Ord peeraddr =>
peeraddr
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
insertBootstrapPeer peeraddr
p CardanoPublicRootPeers peeraddr
prp =
  let prp' :: CardanoPublicRootPeers peeraddr
prp'@PublicRootPeers {
        getExtraPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers = ExtraPeers {
          bootstrapPeers :: forall peeraddr. ExtraPeers peeraddr -> Set peeraddr
bootstrapPeers = Set peeraddr
bsp
        }
      } = (ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr)
-> CardanoPublicRootPeers peeraddr
-> Set peeraddr
-> CardanoPublicRootPeers peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
difference ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers.difference CardanoPublicRootPeers peeraddr
prp (peeraddr -> Set peeraddr
forall a. a -> Set a
Set.singleton peeraddr
p)
  in CardanoPublicRootPeers peeraddr
prp' { getExtraPeers = (getExtraPeers prp') {
              bootstrapPeers = Set.insert p bsp
            }
          }

insertLedgerPeer :: Ord peeraddr
                 => peeraddr
                 -> CardanoPublicRootPeers peeraddr
                 -> CardanoPublicRootPeers peeraddr
insertLedgerPeer :: forall peeraddr.
Ord peeraddr =>
peeraddr
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
insertLedgerPeer peeraddr
p prp :: CardanoPublicRootPeers peeraddr
prp@PublicRootPeers {
                     getExtraPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers = ExtraPeers {
                       bootstrapPeers :: forall peeraddr. ExtraPeers peeraddr -> Set peeraddr
bootstrapPeers = Set peeraddr
getBootstrapPeers'
                     }
                   } =
  let prp' :: CardanoPublicRootPeers peeraddr
prp'@PublicRootPeers { Set peeraddr
getLedgerPeers :: Set peeraddr
getLedgerPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getLedgerPeers } =
        (ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr)
-> CardanoPublicRootPeers peeraddr
-> Set peeraddr
-> CardanoPublicRootPeers peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
difference ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers.difference CardanoPublicRootPeers peeraddr
prp (peeraddr -> Set peeraddr
forall a. a -> Set a
Set.singleton peeraddr
p)
   in if peeraddr -> Set peeraddr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member peeraddr
p Set peeraddr
getBootstrapPeers'
         then CardanoPublicRootPeers peeraddr
prp
         else CardanoPublicRootPeers peeraddr
prp' {getLedgerPeers = Set.insert p getLedgerPeers }

insertBigLedgerPeer :: Ord peeraddr
                    => peeraddr
                    -> CardanoPublicRootPeers peeraddr
                    -> CardanoPublicRootPeers peeraddr
insertBigLedgerPeer :: forall peeraddr.
Ord peeraddr =>
peeraddr
-> CardanoPublicRootPeers peeraddr
-> CardanoPublicRootPeers peeraddr
insertBigLedgerPeer peeraddr
p prp :: CardanoPublicRootPeers peeraddr
prp@PublicRootPeers{
                        getExtraPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> extraPeers
getExtraPeers = ExtraPeers {
                          bootstrapPeers :: forall peeraddr. ExtraPeers peeraddr -> Set peeraddr
bootstrapPeers = Set peeraddr
getBootstrapPeers'
                        }
                      } =
  let prp' :: CardanoPublicRootPeers peeraddr
prp'@PublicRootPeers { Set peeraddr
getBigLedgerPeers :: Set peeraddr
getBigLedgerPeers :: forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
getBigLedgerPeers } =
        (ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr)
-> CardanoPublicRootPeers peeraddr
-> Set peeraddr
-> CardanoPublicRootPeers peeraddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
difference ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers.difference CardanoPublicRootPeers peeraddr
prp (peeraddr -> Set peeraddr
forall a. a -> Set a
Set.singleton peeraddr
p)
   in if peeraddr -> Set peeraddr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member peeraddr
p Set peeraddr
getBootstrapPeers'
         then CardanoPublicRootPeers peeraddr
prp
         else CardanoPublicRootPeers peeraddr
prp' { getBigLedgerPeers = Set.insert p getBigLedgerPeers }