{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia        #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE RecordWildCards    #-}

module Ouroboros.Network.PeerSelection.State.LocalRootPeers
  ( -- * Types
    LocalRootPeers (..)
  , HotValency (..)
  , WarmValency (..)
  , Config
    -- Export constructors for defining tests.
  , invariant
    -- * Basic operations
  , empty
  , null
  , size
  , member
  , hotTarget
  , warmTarget
  , fromGroups
  , toGroups
  , toGroupSets
  , toMap
  , keysSet
  , trustableKeysSet
    -- * Special operations
  , clampToLimit
  , clampToTrustable
  , isPeerTrustable
  ) where

import Prelude hiding (null)

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.PeerTrustable (PeerTrustable (..))


---------------------------------------
-- Local root peer set representation
--

data LocalRootPeers peeraddr =
     LocalRootPeers
       -- We use two partial & overlapping representations:

       -- The collection of all the peers, with the associated PeerAdvertise
       -- and PeerTrustable values
       (Map peeraddr (PeerAdvertise, PeerTrustable))

       -- The groups, but without the associated PeerAdvertise and
       -- PeerTrustable values
       [(HotValency, WarmValency, Set peeraddr)]
  deriving LocalRootPeers peeraddr -> LocalRootPeers peeraddr -> Bool
(LocalRootPeers peeraddr -> LocalRootPeers peeraddr -> Bool)
-> (LocalRootPeers peeraddr -> LocalRootPeers peeraddr -> Bool)
-> Eq (LocalRootPeers peeraddr)
forall peeraddr.
Eq peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall peeraddr.
Eq peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr -> Bool
== :: LocalRootPeers peeraddr -> LocalRootPeers peeraddr -> Bool
$c/= :: forall peeraddr.
Eq peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr -> Bool
/= :: LocalRootPeers peeraddr -> LocalRootPeers peeraddr -> Bool
Eq

-- | Newtype wrapper representing hot valency value from local root group
-- configuration
--
newtype HotValency = HotValency { HotValency -> Int
getHotValency :: Int }
  deriving (Int -> HotValency -> ShowS
[HotValency] -> ShowS
HotValency -> String
(Int -> HotValency -> ShowS)
-> (HotValency -> String)
-> ([HotValency] -> ShowS)
-> Show HotValency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HotValency -> ShowS
showsPrec :: Int -> HotValency -> ShowS
$cshow :: HotValency -> String
show :: HotValency -> String
$cshowList :: [HotValency] -> ShowS
showList :: [HotValency] -> ShowS
Show, HotValency -> HotValency -> Bool
(HotValency -> HotValency -> Bool)
-> (HotValency -> HotValency -> Bool) -> Eq HotValency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HotValency -> HotValency -> Bool
== :: HotValency -> HotValency -> Bool
$c/= :: HotValency -> HotValency -> Bool
/= :: HotValency -> HotValency -> Bool
Eq, Eq HotValency
Eq HotValency =>
(HotValency -> HotValency -> Ordering)
-> (HotValency -> HotValency -> Bool)
-> (HotValency -> HotValency -> Bool)
-> (HotValency -> HotValency -> Bool)
-> (HotValency -> HotValency -> Bool)
-> (HotValency -> HotValency -> HotValency)
-> (HotValency -> HotValency -> HotValency)
-> Ord HotValency
HotValency -> HotValency -> Bool
HotValency -> HotValency -> Ordering
HotValency -> HotValency -> HotValency
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HotValency -> HotValency -> Ordering
compare :: HotValency -> HotValency -> Ordering
$c< :: HotValency -> HotValency -> Bool
< :: HotValency -> HotValency -> Bool
$c<= :: HotValency -> HotValency -> Bool
<= :: HotValency -> HotValency -> Bool
$c> :: HotValency -> HotValency -> Bool
> :: HotValency -> HotValency -> Bool
$c>= :: HotValency -> HotValency -> Bool
>= :: HotValency -> HotValency -> Bool
$cmax :: HotValency -> HotValency -> HotValency
max :: HotValency -> HotValency -> HotValency
$cmin :: HotValency -> HotValency -> HotValency
min :: HotValency -> HotValency -> HotValency
Ord)
  deriving Integer -> HotValency
HotValency -> HotValency
HotValency -> HotValency -> HotValency
(HotValency -> HotValency -> HotValency)
-> (HotValency -> HotValency -> HotValency)
-> (HotValency -> HotValency -> HotValency)
-> (HotValency -> HotValency)
-> (HotValency -> HotValency)
-> (HotValency -> HotValency)
-> (Integer -> HotValency)
-> Num HotValency
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: HotValency -> HotValency -> HotValency
+ :: HotValency -> HotValency -> HotValency
$c- :: HotValency -> HotValency -> HotValency
- :: HotValency -> HotValency -> HotValency
$c* :: HotValency -> HotValency -> HotValency
* :: HotValency -> HotValency -> HotValency
$cnegate :: HotValency -> HotValency
negate :: HotValency -> HotValency
$cabs :: HotValency -> HotValency
abs :: HotValency -> HotValency
$csignum :: HotValency -> HotValency
signum :: HotValency -> HotValency
$cfromInteger :: Integer -> HotValency
fromInteger :: Integer -> HotValency
Num via Int

-- | Newtype wrapper representing warm valency value from local root group
-- configuration
--
newtype WarmValency = WarmValency { WarmValency -> Int
getWarmValency :: Int }
  deriving (Int -> WarmValency -> ShowS
[WarmValency] -> ShowS
WarmValency -> String
(Int -> WarmValency -> ShowS)
-> (WarmValency -> String)
-> ([WarmValency] -> ShowS)
-> Show WarmValency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WarmValency -> ShowS
showsPrec :: Int -> WarmValency -> ShowS
$cshow :: WarmValency -> String
show :: WarmValency -> String
$cshowList :: [WarmValency] -> ShowS
showList :: [WarmValency] -> ShowS
Show, WarmValency -> WarmValency -> Bool
(WarmValency -> WarmValency -> Bool)
-> (WarmValency -> WarmValency -> Bool) -> Eq WarmValency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WarmValency -> WarmValency -> Bool
== :: WarmValency -> WarmValency -> Bool
$c/= :: WarmValency -> WarmValency -> Bool
/= :: WarmValency -> WarmValency -> Bool
Eq, Eq WarmValency
Eq WarmValency =>
(WarmValency -> WarmValency -> Ordering)
-> (WarmValency -> WarmValency -> Bool)
-> (WarmValency -> WarmValency -> Bool)
-> (WarmValency -> WarmValency -> Bool)
-> (WarmValency -> WarmValency -> Bool)
-> (WarmValency -> WarmValency -> WarmValency)
-> (WarmValency -> WarmValency -> WarmValency)
-> Ord WarmValency
WarmValency -> WarmValency -> Bool
WarmValency -> WarmValency -> Ordering
WarmValency -> WarmValency -> WarmValency
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WarmValency -> WarmValency -> Ordering
compare :: WarmValency -> WarmValency -> Ordering
$c< :: WarmValency -> WarmValency -> Bool
< :: WarmValency -> WarmValency -> Bool
$c<= :: WarmValency -> WarmValency -> Bool
<= :: WarmValency -> WarmValency -> Bool
$c> :: WarmValency -> WarmValency -> Bool
> :: WarmValency -> WarmValency -> Bool
$c>= :: WarmValency -> WarmValency -> Bool
>= :: WarmValency -> WarmValency -> Bool
$cmax :: WarmValency -> WarmValency -> WarmValency
max :: WarmValency -> WarmValency -> WarmValency
$cmin :: WarmValency -> WarmValency -> WarmValency
min :: WarmValency -> WarmValency -> WarmValency
Ord)
  deriving Integer -> WarmValency
WarmValency -> WarmValency
WarmValency -> WarmValency -> WarmValency
(WarmValency -> WarmValency -> WarmValency)
-> (WarmValency -> WarmValency -> WarmValency)
-> (WarmValency -> WarmValency -> WarmValency)
-> (WarmValency -> WarmValency)
-> (WarmValency -> WarmValency)
-> (WarmValency -> WarmValency)
-> (Integer -> WarmValency)
-> Num WarmValency
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: WarmValency -> WarmValency -> WarmValency
+ :: WarmValency -> WarmValency -> WarmValency
$c- :: WarmValency -> WarmValency -> WarmValency
- :: WarmValency -> WarmValency -> WarmValency
$c* :: WarmValency -> WarmValency -> WarmValency
* :: WarmValency -> WarmValency -> WarmValency
$cnegate :: WarmValency -> WarmValency
negate :: WarmValency -> WarmValency
$cabs :: WarmValency -> WarmValency
abs :: WarmValency -> WarmValency
$csignum :: WarmValency -> WarmValency
signum :: WarmValency -> WarmValency
$cfromInteger :: Integer -> WarmValency
fromInteger :: Integer -> WarmValency
Num via Int

-- | Data available from topology file.
--
type Config peeraddr =
     [(HotValency, WarmValency, Map peeraddr ( PeerAdvertise, PeerTrustable))]


-- It is an abstract type, so the derived Show is unhelpful, e.g. for replaying
-- test cases.
--
instance (Show peeraddr, Ord peeraddr) => Show (LocalRootPeers peeraddr) where
  show :: LocalRootPeers peeraddr -> String
show LocalRootPeers peeraddr
lrps = String
"fromGroups " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(HotValency, WarmValency,
  Map peeraddr (PeerAdvertise, PeerTrustable))]
-> String
forall a. Show a => a -> String
show (LocalRootPeers peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (PeerAdvertise, PeerTrustable))]
forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (PeerAdvertise, PeerTrustable))]
toGroups LocalRootPeers peeraddr
lrps)

invariant :: Ord peeraddr => LocalRootPeers peeraddr -> Bool
invariant :: forall peeraddr. Ord peeraddr => LocalRootPeers peeraddr -> Bool
invariant (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
gs) =

    -- The overlapping representations must be consistent
    [Set peeraddr] -> Set peeraddr
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ Set peeraddr
g | (HotValency
_, WarmValency
_, Set peeraddr
g) <- [(HotValency, WarmValency, Set peeraddr)]
gs ] Set peeraddr -> Set peeraddr -> Bool
forall a. Eq a => a -> a -> Bool
== Map peeraddr (PeerAdvertise, PeerTrustable) -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr (PeerAdvertise, PeerTrustable)
m

    -- The localRootPeers groups must not overlap with each other
 Bool -> Bool -> Bool
&& Map peeraddr (PeerAdvertise, PeerTrustable) -> Int
forall k a. Map k a -> Int
Map.size Map peeraddr (PeerAdvertise, PeerTrustable)
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
g | (HotValency
_, WarmValency
_, Set peeraddr
g) <- [(HotValency, WarmValency, Set peeraddr)]
gs ]

    -- Individual group targets must be greater than zero and achievable given
    -- the group sizes.
    --
    -- Also the warm target needs to be greater than or equal to the hot target
 Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [   HotValency
0 HotValency -> HotValency -> Bool
forall a. Ord a => a -> a -> Bool
< HotValency
h
          Bool -> Bool -> Bool
&& WarmValency -> Int
getWarmValency WarmValency
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= HotValency -> Int
getHotValency HotValency
h
          -- If warm valency is achievable, by monotonicity, hot valency also is
          Bool -> Bool -> Bool
&& WarmValency -> Int
getWarmValency WarmValency
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
g
       | (HotValency
h, WarmValency
w, Set peeraddr
g) <- [(HotValency, WarmValency, Set peeraddr)]
gs ]


empty :: LocalRootPeers peeraddr
empty :: forall peeraddr. LocalRootPeers peeraddr
empty = Map peeraddr (PeerAdvertise, PeerTrustable)
-> [(HotValency, WarmValency, Set peeraddr)]
-> LocalRootPeers peeraddr
forall peeraddr.
Map peeraddr (PeerAdvertise, PeerTrustable)
-> [(HotValency, WarmValency, Set peeraddr)]
-> LocalRootPeers peeraddr
LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
forall k a. Map k a
Map.empty []

null :: LocalRootPeers peeraddr -> Bool
null :: forall peeraddr. LocalRootPeers peeraddr -> Bool
null (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
_) = Map peeraddr (PeerAdvertise, PeerTrustable) -> Bool
forall k a. Map k a -> Bool
Map.null Map peeraddr (PeerAdvertise, PeerTrustable)
m

size :: LocalRootPeers peeraddr -> Int
size :: forall peeraddr. LocalRootPeers peeraddr -> Int
size (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
_) = Map peeraddr (PeerAdvertise, PeerTrustable) -> Int
forall k a. Map k a -> Int
Map.size Map peeraddr (PeerAdvertise, PeerTrustable)
m

member :: Ord peeraddr => peeraddr -> LocalRootPeers peeraddr -> Bool
member :: forall peeraddr.
Ord peeraddr =>
peeraddr -> LocalRootPeers peeraddr -> Bool
member peeraddr
p (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
_) = peeraddr -> Map peeraddr (PeerAdvertise, PeerTrustable) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member peeraddr
p Map peeraddr (PeerAdvertise, PeerTrustable)
m

hotTarget :: LocalRootPeers peeraddr -> HotValency
hotTarget :: forall peeraddr. LocalRootPeers peeraddr -> HotValency
hotTarget (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
_ [(HotValency, WarmValency, Set peeraddr)]
gs) = [HotValency] -> HotValency
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ HotValency
h | (HotValency
h, WarmValency
_, Set peeraddr
_) <- [(HotValency, WarmValency, Set peeraddr)]
gs ]

warmTarget :: LocalRootPeers peeraddr -> WarmValency
warmTarget :: forall peeraddr. LocalRootPeers peeraddr -> WarmValency
warmTarget (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
_ [(HotValency, WarmValency, Set peeraddr)]
gs) = [WarmValency] -> WarmValency
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ WarmValency
w | (HotValency
_, WarmValency
w, Set peeraddr
_) <- [(HotValency, WarmValency, Set peeraddr)]
gs ]

toMap :: LocalRootPeers peeraddr -> Map peeraddr (PeerAdvertise, PeerTrustable)
toMap :: forall peeraddr.
LocalRootPeers peeraddr
-> Map peeraddr (PeerAdvertise, PeerTrustable)
toMap (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
_) = Map peeraddr (PeerAdvertise, PeerTrustable)
m

keysSet :: LocalRootPeers peeraddr -> Set peeraddr
keysSet :: forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
keysSet (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
_) = Map peeraddr (PeerAdvertise, PeerTrustable) -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr (PeerAdvertise, PeerTrustable)
m

toGroupSets :: LocalRootPeers peeraddr -> [(HotValency, WarmValency, Set peeraddr)]
toGroupSets :: forall peeraddr.
LocalRootPeers peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
toGroupSets (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
_ [(HotValency, WarmValency, Set peeraddr)]
gs) = [(HotValency, WarmValency, Set peeraddr)]
gs


-- | The local root peers info has some invariants that are not directly
-- enforced in the types, and the config comes from an external source. Of
-- course it's good to validate that at source, but here we need to not fail
-- if we're given imperfect data.
--
-- So what we do is bash it until it is valid. We don't need to be too careful
-- about how we do it, it's ok to be brutal. We should however make sure we
-- trace a warning about dodgy config.
--
fromGroups :: Ord peeraddr
           => [(HotValency, WarmValency, Map peeraddr (PeerAdvertise, PeerTrustable))]
           -> LocalRootPeers peeraddr
fromGroups :: forall peeraddr.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (PeerAdvertise, PeerTrustable))]
-> LocalRootPeers peeraddr
fromGroups =
    (\[(HotValency, WarmValency,
  Map peeraddr (PeerAdvertise, PeerTrustable))]
gs -> let m' :: Map peeraddr (PeerAdvertise, PeerTrustable)
m'  = [Map peeraddr (PeerAdvertise, PeerTrustable)]
-> Map peeraddr (PeerAdvertise, PeerTrustable)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [ Map peeraddr (PeerAdvertise, PeerTrustable)
g | (HotValency
_, WarmValency
_, Map peeraddr (PeerAdvertise, PeerTrustable)
g) <- [(HotValency, WarmValency,
  Map peeraddr (PeerAdvertise, PeerTrustable))]
gs ]
                gs' :: [(HotValency, WarmValency, Set peeraddr)]
gs' = [ (HotValency
h, WarmValency
w, Map peeraddr (PeerAdvertise, PeerTrustable) -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr (PeerAdvertise, PeerTrustable)
g) | (HotValency
h, WarmValency
w, Map peeraddr (PeerAdvertise, PeerTrustable)
g) <- [(HotValency, WarmValency,
  Map peeraddr (PeerAdvertise, PeerTrustable))]
gs ]
             in Map peeraddr (PeerAdvertise, PeerTrustable)
-> [(HotValency, WarmValency, Set peeraddr)]
-> LocalRootPeers peeraddr
forall peeraddr.
Map peeraddr (PeerAdvertise, PeerTrustable)
-> [(HotValency, WarmValency, Set peeraddr)]
-> LocalRootPeers peeraddr
LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m' [(HotValency, WarmValency, Set peeraddr)]
gs')
  ([(HotValency, WarmValency,
   Map peeraddr (PeerAdvertise, PeerTrustable))]
 -> LocalRootPeers peeraddr)
-> ([(HotValency, WarmValency,
      Map peeraddr (PeerAdvertise, PeerTrustable))]
    -> [(HotValency, WarmValency,
         Map peeraddr (PeerAdvertise, PeerTrustable))])
-> [(HotValency, WarmValency,
     Map peeraddr (PeerAdvertise, PeerTrustable))]
-> LocalRootPeers peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (PeerAdvertise, PeerTrustable))]
-> [(HotValency, WarmValency,
     Map peeraddr (PeerAdvertise, PeerTrustable))]
forall {k} {a}.
Ord k =>
Set k
-> [(HotValency, WarmValency, Map k a)]
-> [(HotValency, WarmValency, Map k a)]
establishStructureInvariant Set peeraddr
forall a. Set a
Set.empty
  where
    -- The groups must not overlap;
    -- have achievable targets;
    -- Hot targets need to be smaller than or equal to warm targets
    -- and be non-empty.
    establishStructureInvariant :: Set k
-> [(HotValency, WarmValency, Map k a)]
-> [(HotValency, WarmValency, Map k a)]
establishStructureInvariant !Set k
_ [] = []
    establishStructureInvariant !Set k
acc ((HotValency
h, WarmValency
w, Map k a
g): [(HotValency, WarmValency, Map k a)]
gs)
      | WarmValency
w' WarmValency -> WarmValency -> Bool
forall a. Ord a => a -> a -> Bool
> WarmValency
0 Bool -> Bool -> Bool
&& HotValency
h' HotValency -> HotValency -> Bool
forall a. Ord a => a -> a -> Bool
> HotValency
0 = (HotValency
h', WarmValency
w', Map k a
g') (HotValency, WarmValency, Map k a)
-> [(HotValency, WarmValency, Map k a)]
-> [(HotValency, WarmValency, Map k a)]
forall a. a -> [a] -> [a]
: Set k
-> [(HotValency, WarmValency, Map k a)]
-> [(HotValency, WarmValency, Map k a)]
establishStructureInvariant Set k
acc' [(HotValency, WarmValency, Map k a)]
gs
      | Bool
otherwise        =                  Set k
-> [(HotValency, WarmValency, Map k a)]
-> [(HotValency, WarmValency, Map k a)]
establishStructureInvariant Set k
acc' [(HotValency, WarmValency, Map k a)]
gs
      where
        !g' :: Map k a
g'   = Map k a
g Map k a -> Set k -> Map k a
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set k
acc
        !w' :: WarmValency
w'   = WarmValency -> WarmValency -> WarmValency
forall a. Ord a => a -> a -> a
min WarmValency
w (Int -> WarmValency
WarmValency (Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
g'))
        !h' :: HotValency
h'   = Int -> HotValency
HotValency (HotValency -> Int
getHotValency HotValency
h Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` WarmValency -> Int
getWarmValency WarmValency
w')
        !acc' :: Set k
acc' = Set k
acc Set k -> Set k -> Set k
forall a. Semigroup a => a -> a -> a
<> Map k a -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k a
g

-- | Inverse of 'fromGroups', for the subset of inputs to 'fromGroups' that
-- satisfy the invariant.
--
toGroups :: Ord peeraddr
         => LocalRootPeers peeraddr
         -> [(HotValency, WarmValency, Map peeraddr (PeerAdvertise, PeerTrustable))]
toGroups :: forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (PeerAdvertise, PeerTrustable))]
toGroups (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
gs) =
    [ (HotValency
h, WarmValency
w, (peeraddr -> (PeerAdvertise, PeerTrustable))
-> Set peeraddr -> Map peeraddr (PeerAdvertise, PeerTrustable)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Map peeraddr (PeerAdvertise, PeerTrustable)
m Map peeraddr (PeerAdvertise, PeerTrustable)
-> peeraddr -> (PeerAdvertise, PeerTrustable)
forall k a. Ord k => Map k a -> k -> a
Map.!) Set peeraddr
g)
    | (HotValency
h, WarmValency
w, Set peeraddr
g) <- [(HotValency, WarmValency, Set peeraddr)]
gs ]


-- | Limit the size of the root peers collection to fit within given bounds.
--
-- The governor needs to be able to do this to enforce its invariant that:
--
-- > LocalRootPeers.size localRootPeers <= targetNumberOfKnownPeers
--
-- It needs to be able to /establish/ that invariant given arbitrary
-- configuration for local root peers. It makes sense to do it this way rather
-- than just enforce that local root peers config fits the invariant because
-- the invariant depends on both the targets and the local root peers config
-- and these can both vary dynamically and independently.
--
-- It is unlikely in practice that there are so many local root peers
-- configured that it goes over this targets, so it's ok to resolve it pretty
-- arbitrarily. We just take the local roots in left to right order up to the
-- limit. So we have the property that
--
-- > LocalRootPeers.size (LocalRootPeers.clampToLimit sz lrps)
-- >  == min sz (LocalRootPeers.size lrps)
--
clampToLimit :: Ord peeraddr
             => Int -- ^ The limit on the total number of local peers
             -> LocalRootPeers peeraddr
             -> LocalRootPeers peeraddr
clampToLimit :: forall peeraddr.
Ord peeraddr =>
Int -> LocalRootPeers peeraddr -> LocalRootPeers peeraddr
clampToLimit Int
totalLimit (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
gs0) =
    let gs' :: [(HotValency, WarmValency, Set peeraddr)]
gs' = Int
-> [(HotValency, WarmValency, Set peeraddr)]
-> [(HotValency, WarmValency, Set peeraddr)]
forall {a}.
Int
-> [(HotValency, WarmValency, Set a)]
-> [(HotValency, WarmValency, Set a)]
limitTotalSize Int
0 [(HotValency, WarmValency, Set peeraddr)]
gs0
        m' :: Map peeraddr (PeerAdvertise, PeerTrustable)
m'  = Map peeraddr (PeerAdvertise, PeerTrustable)
m Map peeraddr (PeerAdvertise, PeerTrustable)
-> Set peeraddr -> Map peeraddr (PeerAdvertise, PeerTrustable)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` [Set peeraddr] -> Set peeraddr
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ Set peeraddr
g | (HotValency
_, WarmValency
_, Set peeraddr
g) <- [(HotValency, WarmValency, Set peeraddr)]
gs' ]
     in Map peeraddr (PeerAdvertise, PeerTrustable)
-> [(HotValency, WarmValency, Set peeraddr)]
-> LocalRootPeers peeraddr
forall peeraddr.
Map peeraddr (PeerAdvertise, PeerTrustable)
-> [(HotValency, WarmValency, Set peeraddr)]
-> LocalRootPeers peeraddr
LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m' [(HotValency, WarmValency, Set peeraddr)]
gs'

  where
    limitTotalSize :: Int
-> [(HotValency, WarmValency, Set a)]
-> [(HotValency, WarmValency, Set a)]
limitTotalSize !Int
_ [] = []
    limitTotalSize !Int
n ((HotValency
h, WarmValency
w, Set a
g) : [(HotValency, WarmValency, Set a)]
gs)

        -- No space at all!
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
totalLimit
      = []

        -- It fits entirely!
      | let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
Set.size Set a
g
      , Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
totalLimit
      = (HotValency
h, WarmValency
w, Set a
g) (HotValency, WarmValency, Set a)
-> [(HotValency, WarmValency, Set a)]
-> [(HotValency, WarmValency, Set a)]
forall a. a -> [a] -> [a]
: Int
-> [(HotValency, WarmValency, Set a)]
-> [(HotValency, WarmValency, Set a)]
limitTotalSize Int
n' [(HotValency, WarmValency, Set a)]
gs

        -- We can fit a bit more if we chop it up!
      | Bool
otherwise
      , let !g' :: Set a
g' = Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
Set.take (Int
totalLimit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Set a
g
            !w' :: WarmValency
w' = WarmValency -> WarmValency -> WarmValency
forall a. Ord a => a -> a -> a
min WarmValency
w (Int -> WarmValency
WarmValency (Set a -> Int
forall a. Set a -> Int
Set.size Set a
g'))
            !h' :: HotValency
h' = Int -> HotValency
HotValency (HotValency -> Int
getHotValency HotValency
h Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` WarmValency -> Int
getWarmValency WarmValency
w')
      = [(HotValency
h', WarmValency
w', Set a
g')]

clampToTrustable :: Ord peeraddr
                 => LocalRootPeers peeraddr
                 -> LocalRootPeers peeraddr
clampToTrustable :: forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr
clampToTrustable (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
gs) =
  let trustedMap :: Map peeraddr (PeerAdvertise, PeerTrustable)
trustedMap = ((PeerAdvertise, PeerTrustable) -> Bool)
-> Map peeraddr (PeerAdvertise, PeerTrustable)
-> Map peeraddr (PeerAdvertise, PeerTrustable)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(PeerAdvertise
_, PeerTrustable
pt) -> case PeerTrustable
pt of
                                 PeerTrustable
IsTrustable    -> Bool
True
                                 PeerTrustable
IsNotTrustable -> Bool
False
                              )
                              Map peeraddr (PeerAdvertise, PeerTrustable)
m
   in Map peeraddr (PeerAdvertise, PeerTrustable)
-> [(HotValency, WarmValency, Set peeraddr)]
-> LocalRootPeers peeraddr
forall peeraddr.
Map peeraddr (PeerAdvertise, PeerTrustable)
-> [(HotValency, WarmValency, Set peeraddr)]
-> LocalRootPeers peeraddr
LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
trustedMap ([(HotValency, WarmValency, Set peeraddr)]
-> [(HotValency, WarmValency, Set peeraddr)]
trustedGroups [(HotValency, WarmValency, Set peeraddr)]
gs)
  where
    trustedGroups :: [(HotValency, WarmValency, Set peeraddr)]
-> [(HotValency, WarmValency, Set peeraddr)]
trustedGroups [] = []
    trustedGroups ((HotValency
h, WarmValency
w, Set peeraddr
g):[(HotValency, WarmValency, Set peeraddr)]
gss) =
      let trusted :: Map peeraddr (PeerAdvertise, PeerTrustable)
trusted = ((PeerAdvertise, PeerTrustable) -> Bool)
-> Map peeraddr (PeerAdvertise, PeerTrustable)
-> Map peeraddr (PeerAdvertise, PeerTrustable)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(PeerAdvertise
_, PeerTrustable
pt) -> case PeerTrustable
pt of
                                  PeerTrustable
IsTrustable    -> Bool
True
                                  PeerTrustable
IsNotTrustable -> Bool
False
                               )
                               Map peeraddr (PeerAdvertise, PeerTrustable)
m
          trustedSet :: Set peeraddr
trustedSet = Map peeraddr (PeerAdvertise, PeerTrustable) -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet Map peeraddr (PeerAdvertise, PeerTrustable)
trusted
          trustedGroup :: Set peeraddr
trustedGroup = Set peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set peeraddr
g Set peeraddr
trustedSet
          w' :: WarmValency
w' = WarmValency -> WarmValency -> WarmValency
forall a. Ord a => a -> a -> a
min WarmValency
w (Int -> WarmValency
WarmValency (Set peeraddr -> Int
forall a. Set a -> Int
Set.size Set peeraddr
trustedGroup))
          h' :: HotValency
h' = Int -> HotValency
HotValency (HotValency -> Int
getHotValency HotValency
h Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` WarmValency -> Int
getWarmValency WarmValency
w')
       in if Set peeraddr -> Bool
forall a. Set a -> Bool
Set.null Set peeraddr
trustedGroup
             then [(HotValency, WarmValency, Set peeraddr)]
-> [(HotValency, WarmValency, Set peeraddr)]
trustedGroups [(HotValency, WarmValency, Set peeraddr)]
gss
             else (HotValency
h', WarmValency
w', Set peeraddr
trustedGroup) (HotValency, WarmValency, Set peeraddr)
-> [(HotValency, WarmValency, Set peeraddr)]
-> [(HotValency, WarmValency, Set peeraddr)]
forall a. a -> [a] -> [a]
: [(HotValency, WarmValency, Set peeraddr)]
-> [(HotValency, WarmValency, Set peeraddr)]
trustedGroups [(HotValency, WarmValency, Set peeraddr)]
gss

isPeerTrustable :: Ord peeraddr
                => peeraddr
                -> LocalRootPeers peeraddr
                -> Bool
isPeerTrustable :: forall peeraddr.
Ord peeraddr =>
peeraddr -> LocalRootPeers peeraddr -> Bool
isPeerTrustable peeraddr
peeraddr LocalRootPeers peeraddr
lrp =
  case peeraddr
-> Map peeraddr (PeerAdvertise, PeerTrustable)
-> Maybe (PeerAdvertise, PeerTrustable)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peeraddr
peeraddr (LocalRootPeers peeraddr
-> Map peeraddr (PeerAdvertise, PeerTrustable)
forall peeraddr.
LocalRootPeers peeraddr
-> Map peeraddr (PeerAdvertise, PeerTrustable)
toMap LocalRootPeers peeraddr
lrp) of
    Just (PeerAdvertise
_, PeerTrustable
IsTrustable) -> Bool
True
    Maybe (PeerAdvertise, PeerTrustable)
_                     -> Bool
False

trustableKeysSet :: LocalRootPeers peeraddr
                 -> Set peeraddr
trustableKeysSet :: forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
trustableKeysSet (LocalRootPeers Map peeraddr (PeerAdvertise, PeerTrustable)
m [(HotValency, WarmValency, Set peeraddr)]
_) =
    Map peeraddr (PeerAdvertise, PeerTrustable) -> Set peeraddr
forall k a. Map k a -> Set k
Map.keysSet
  (Map peeraddr (PeerAdvertise, PeerTrustable) -> Set peeraddr)
-> (Map peeraddr (PeerAdvertise, PeerTrustable)
    -> Map peeraddr (PeerAdvertise, PeerTrustable))
-> Map peeraddr (PeerAdvertise, PeerTrustable)
-> Set peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerAdvertise, PeerTrustable) -> Bool)
-> Map peeraddr (PeerAdvertise, PeerTrustable)
-> Map peeraddr (PeerAdvertise, PeerTrustable)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\(PeerAdvertise
_, PeerTrustable
trustable) -> case PeerTrustable
trustable of
                    PeerTrustable
IsTrustable    -> Bool
True
                    PeerTrustable
IsNotTrustable -> Bool
False)
  (Map peeraddr (PeerAdvertise, PeerTrustable) -> Set peeraddr)
-> Map peeraddr (PeerAdvertise, PeerTrustable) -> Set peeraddr
forall a b. (a -> b) -> a -> b
$ Map peeraddr (PeerAdvertise, PeerTrustable)
m