{-# LANGUAGE NamedFieldPuns #-}

module Cardano.Network.Diffusion.Topology where

import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
import Ouroboros.Network.Diffusion.Topology

type CardanoNetworkTopology =
  NetworkTopology UseBootstrapPeers PeerTrustable

-- | This function returns false if non-trustable peers are configured
--
isValidTrustedPeerConfiguration :: CardanoNetworkTopology -> Bool
isValidTrustedPeerConfiguration :: CardanoNetworkTopology -> Bool
isValidTrustedPeerConfiguration
  NetworkTopology { localRootPeersGroups :: forall extraConfig extraFlags.
NetworkTopology extraConfig extraFlags
-> LocalRootPeersGroups extraFlags
localRootPeersGroups = LocalRootPeersGroups [LocalRootPeersGroup PeerTrustable]
lprgs
                  , extraConfig :: forall extraConfig extraFlags.
NetworkTopology extraConfig extraFlags -> extraConfig
extraConfig          = UseBootstrapPeers
ubp
                  } =
    case UseBootstrapPeers
ubp of
      UseBootstrapPeers
DontUseBootstrapPeers   -> Bool
True
      UseBootstrapPeers []    -> Bool
anyTrustable
      UseBootstrapPeers (RelayAccessPoint
_:[RelayAccessPoint]
_) -> Bool
True
  where
    anyTrustable :: Bool
anyTrustable =
      (LocalRootPeersGroup PeerTrustable -> Bool)
-> [LocalRootPeersGroup PeerTrustable] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\LocalRootPeersGroup { RootConfig
localRoots :: RootConfig
localRoots :: forall extraFlags. LocalRootPeersGroup extraFlags -> RootConfig
localRoots
                                , extraFlags :: forall extraFlags. LocalRootPeersGroup extraFlags -> extraFlags
extraFlags = PeerTrustable
trustable
                                } ->
            case PeerTrustable
trustable of
              PeerTrustable
IsNotTrustable -> Bool
False
              PeerTrustable
IsTrustable    -> Bool -> Bool
not
                              (Bool -> Bool) -> (RootConfig -> Bool) -> RootConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelayAccessPoint] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
                              ([RelayAccessPoint] -> Bool)
-> (RootConfig -> [RelayAccessPoint]) -> RootConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RootConfig -> [RelayAccessPoint]
rootAccessPoints
                              (RootConfig -> Bool) -> RootConfig -> Bool
forall a b. (a -> b) -> a -> b
$ RootConfig
localRoots
          ) [LocalRootPeersGroup PeerTrustable]
lprgs