{-# LANGUAGE NamedFieldPuns     #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications   #-}

module Test.Cardano.Network.PeerSelection.LocalRootPeers (tests) where

import Data.Map.Strict qualified as Map


import Cardano.Network.ConsensusMode (ConsensusMode (..))
import Cardano.Network.PeerSelection.ExtraRootPeers qualified as Cardano.ExtraPeers
import Cardano.Network.PeerSelection.Governor.Monitor qualified as Monitor
import Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Cardano.ExtraState
import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable)
import Cardano.Network.PeerSelection.State.LocalRootPeers (LocalRootPeers)
import Cardano.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers

import Test.Cardano.Network.PeerSelection.Instances ()
import Test.Ouroboros.Network.PeerSelection.Instances (PeerAddr)
import Test.Ouroboros.Network.PeerSelection.LocalRootPeers (AdvertiseChange,
           governorAdvertiseChanges)

import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.PeerSelection.Cardano"
  [ TestName -> [TestTree] -> TestTree
testGroup TestName
"LocalRootPeers"
    [ TestName
-> (LocalRootPeers PeerTrustable PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"clampToTrustable" LocalRootPeers PeerTrustable PeerAddr -> Property
prop_clampToTrustable
    , TestName -> (AdvertiseChange PeerTrustable -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"the governor gives the known peers the new flags"
                   AdvertiseChange PeerTrustable -> Property
prop_governor_advertiseChanges
    ]
  ]

prop_clampToTrustable :: LocalRootPeers PeerTrustable PeerAddr
                      -> Property
prop_clampToTrustable :: LocalRootPeers PeerTrustable PeerAddr -> Property
prop_clampToTrustable LocalRootPeers PeerTrustable PeerAddr
localRootPeers =

    let trustedPeers :: Set PeerAddr
trustedPeers = LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet
                     (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr)
-> LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ LocalRootPeers PeerTrustable PeerAddr
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
LocalRootPeers.clampToTrustable LocalRootPeers PeerTrustable PeerAddr
localRootPeers

     in TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (Map PeerAddr (LocalRootConfig PeerTrustable) -> TestName
forall a. Show a => a -> TestName
show (Map PeerAddr (LocalRootConfig PeerTrustable) -> TestName)
-> Map PeerAddr (LocalRootConfig PeerTrustable) -> TestName
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (LocalRootConfig PeerTrustable)
-> Set PeerAddr -> Map PeerAddr (LocalRootConfig PeerTrustable)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (LocalRootPeers PeerTrustable PeerAddr
-> Map PeerAddr (LocalRootConfig PeerTrustable)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers PeerTrustable PeerAddr
localRootPeers) Set PeerAddr
trustedPeers)
      (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ (PeerAddr -> Bool) -> Set PeerAddr -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (PeerAddr -> LocalRootPeers PeerTrustable PeerAddr -> Bool
forall peeraddr.
Ord peeraddr =>
peeraddr -> LocalRootPeers PeerTrustable peeraddr -> Bool
`LocalRootPeers.isPeerTrustable` LocalRootPeers PeerTrustable PeerAddr
localRootPeers) Set PeerAddr
trustedPeers

-- | The Cardano governor's local roots monitor, from a state holding the old
-- local roots and known peers with their flags, reads the new ones and
-- leaves the known peers as 'knownPeersAfter' requires; it does not fire
-- when nothing changed. The node is not in a sensitive state, so no local
-- root is clamped away.
prop_governor_advertiseChanges :: AdvertiseChange PeerTrustable -> Property
prop_governor_advertiseChanges :: AdvertiseChange PeerTrustable -> Property
prop_governor_advertiseChanges =
    (forall s.
 PeerSelectionActions
   ExtraState
   PeerTrustable
   (ExtraPeers PeerAddr)
   ()
   PeerAddr
   ()
   (IOSim s)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr ()
 -> Guarded
      (STM (IOSim s))
      (TimedDecision
         (IOSim s)
         ExtraState
         ()
         PeerTrustable
         (ExtraPeers PeerAddr)
         PeerAddr
         ()))
-> ExtraState
-> ExtraPeers PeerAddr
-> PublicExtraPeersAPI (ExtraPeers PeerAddr) PeerAddr
-> AdvertiseChange PeerTrustable
-> Property
forall extraState extraFlags extraPeers.
(Eq extraFlags, Show extraFlags) =>
(forall s.
 PeerSelectionActions
   extraState extraFlags extraPeers () PeerAddr () (IOSim s)
 -> PeerSelectionState extraState extraFlags extraPeers PeerAddr ()
 -> Guarded
      (STM (IOSim s))
      (TimedDecision
         (IOSim s) extraState () extraFlags extraPeers PeerAddr ()))
-> extraState
-> extraPeers
-> PublicExtraPeersAPI extraPeers PeerAddr
-> AdvertiseChange extraFlags
-> Property
governorAdvertiseChanges
      PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers PeerAddr)
  ()
  PeerAddr
  ()
  (IOSim s)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr ()
-> Guarded
     (STM (IOSim s))
     (TimedDecision
        (IOSim s)
        ExtraState
        ()
        PeerTrustable
        (ExtraPeers PeerAddr)
        PeerAddr
        ())
forall s.
PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers PeerAddr)
  ()
  PeerAddr
  ()
  (IOSim s)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr ()
-> Guarded
     (STM (IOSim s))
     (TimedDecision
        (IOSim s)
        ExtraState
        ()
        PeerTrustable
        (ExtraPeers PeerAddr)
        PeerAddr
        ())
forall extraDebugState extraAPI peeraddr peerconn (m :: * -> *).
(MonadTimer m, Ord peeraddr) =>
PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers peeraddr)
  extraAPI
  peeraddr
  peerconn
  m
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers peeraddr) peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        ExtraState
        extraDebugState
        PeerTrustable
        (ExtraPeers peeraddr)
        peeraddr
        peerconn)
Monitor.localRoots
      (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
Cardano.ExtraState.empty ConsensusMode
PraosMode (Int -> NumberOfBigLedgerPeers
Cardano.ExtraState.NumberOfBigLedgerPeers Int
0))
      ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
Cardano.ExtraPeers.empty
      PublicExtraPeersAPI (ExtraPeers PeerAddr) PeerAddr
forall peeraddr.
Ord peeraddr =>
PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
Cardano.ExtraPeers.cardanoPublicRootPeersAPI