{-# LANGUAGE NamedFieldPuns #-} module Cardano.Network.PeerSelection.State.LocalRootPeers ( clampToTrustable , isPeerTrustable , trustableKeysSet , module Ouroboros.Network.PeerSelection.State.LocalRootPeers ) where import Data.Map.Strict qualified as Map import Data.Set (Set) import Data.Set qualified as Set import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) import Ouroboros.Network.PeerSelection.State.LocalRootPeers clampToTrustable :: Ord peeraddr => LocalRootPeers PeerTrustable peeraddr -> LocalRootPeers PeerTrustable peeraddr clampToTrustable :: forall peeraddr. Ord peeraddr => LocalRootPeers PeerTrustable peeraddr -> LocalRootPeers PeerTrustable peeraddr clampToTrustable (LocalRootPeers Map peeraddr (LocalRootConfig PeerTrustable) m [(HotValency, WarmValency, Set peeraddr)] gs) = let trustedMap :: Map peeraddr (LocalRootConfig PeerTrustable) trustedMap = (LocalRootConfig PeerTrustable -> Bool) -> Map peeraddr (LocalRootConfig PeerTrustable) -> Map peeraddr (LocalRootConfig PeerTrustable) forall a k. (a -> Bool) -> Map k a -> Map k a Map.filter (\LocalRootConfig { PeerTrustable extraLocalRootFlags :: PeerTrustable extraLocalRootFlags :: forall extraFlags. LocalRootConfig extraFlags -> extraFlags extraLocalRootFlags } -> case PeerTrustable extraLocalRootFlags of PeerTrustable IsTrustable -> Bool True PeerTrustable IsNotTrustable -> Bool False ) Map peeraddr (LocalRootConfig PeerTrustable) m in Map peeraddr (LocalRootConfig PeerTrustable) -> [(HotValency, WarmValency, Set peeraddr)] -> LocalRootPeers PeerTrustable peeraddr forall extraFlags peeraddr. Map peeraddr (LocalRootConfig extraFlags) -> [(HotValency, WarmValency, Set peeraddr)] -> LocalRootPeers extraFlags peeraddr LocalRootPeers Map peeraddr (LocalRootConfig 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 (LocalRootConfig PeerTrustable) trusted = (LocalRootConfig PeerTrustable -> Bool) -> Map peeraddr (LocalRootConfig PeerTrustable) -> Map peeraddr (LocalRootConfig PeerTrustable) forall a k. (a -> Bool) -> Map k a -> Map k a Map.filter (\LocalRootConfig { PeerTrustable extraLocalRootFlags :: forall extraFlags. LocalRootConfig extraFlags -> extraFlags extraLocalRootFlags :: PeerTrustable extraLocalRootFlags } -> case PeerTrustable extraLocalRootFlags of PeerTrustable IsTrustable -> Bool True PeerTrustable IsNotTrustable -> Bool False ) Map peeraddr (LocalRootConfig PeerTrustable) m trustedSet :: Set peeraddr trustedSet = Map peeraddr (LocalRootConfig PeerTrustable) -> Set peeraddr forall k a. Map k a -> Set k Map.keysSet Map peeraddr (LocalRootConfig 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 PeerTrustable peeraddr -> Bool isPeerTrustable :: forall peeraddr. Ord peeraddr => peeraddr -> LocalRootPeers PeerTrustable peeraddr -> Bool isPeerTrustable peeraddr peeraddr LocalRootPeers PeerTrustable peeraddr lrp = case peeraddr -> Map peeraddr (LocalRootConfig PeerTrustable) -> Maybe (LocalRootConfig PeerTrustable) forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup peeraddr peeraddr (LocalRootPeers PeerTrustable peeraddr -> Map peeraddr (LocalRootConfig PeerTrustable) forall extraFlags peeraddr. LocalRootPeers extraFlags peeraddr -> Map peeraddr (LocalRootConfig extraFlags) toMap LocalRootPeers PeerTrustable peeraddr lrp) of Just LocalRootConfig { extraLocalRootFlags :: forall extraFlags. LocalRootConfig extraFlags -> extraFlags extraLocalRootFlags = PeerTrustable IsTrustable } -> Bool True Maybe (LocalRootConfig PeerTrustable) _ -> Bool False trustableKeysSet :: LocalRootPeers PeerTrustable peeraddr -> Set peeraddr trustableKeysSet :: forall peeraddr. LocalRootPeers PeerTrustable peeraddr -> Set peeraddr trustableKeysSet (LocalRootPeers Map peeraddr (LocalRootConfig PeerTrustable) m [(HotValency, WarmValency, Set peeraddr)] _) = Map peeraddr (LocalRootConfig PeerTrustable) -> Set peeraddr forall k a. Map k a -> Set k Map.keysSet (Map peeraddr (LocalRootConfig PeerTrustable) -> Set peeraddr) -> (Map peeraddr (LocalRootConfig PeerTrustable) -> Map peeraddr (LocalRootConfig PeerTrustable)) -> Map peeraddr (LocalRootConfig PeerTrustable) -> Set peeraddr forall b c a. (b -> c) -> (a -> b) -> a -> c . (LocalRootConfig PeerTrustable -> Bool) -> Map peeraddr (LocalRootConfig PeerTrustable) -> Map peeraddr (LocalRootConfig PeerTrustable) forall a k. (a -> Bool) -> Map k a -> Map k a Map.filter (\LocalRootConfig { PeerTrustable extraLocalRootFlags :: forall extraFlags. LocalRootConfig extraFlags -> extraFlags extraLocalRootFlags :: PeerTrustable extraLocalRootFlags } -> case PeerTrustable extraLocalRootFlags of PeerTrustable IsTrustable -> Bool True PeerTrustable IsNotTrustable -> Bool False) (Map peeraddr (LocalRootConfig PeerTrustable) -> Set peeraddr) -> Map peeraddr (LocalRootConfig PeerTrustable) -> Set peeraddr forall a b. (a -> b) -> a -> b $ Map peeraddr (LocalRootConfig PeerTrustable) m