wip - fix tests

IntersectMBO · May 7, 2024 · 45e8f8b · 45e8f8b
1 parent a29089c
commit 45e8f8b
Show file tree

Hide file tree

Showing 8 changed files with 216 additions and 168 deletions.
diff --git a/ouroboros-network-api/src/Ouroboros/Network/ConsensusMode.hs b/ouroboros-network-api/src/Ouroboros/Network/ConsensusMode.hs
@@ -13,4 +13,4 @@ data ConsensusMode =
   -- ^ The legacy mode which depends on official relays and/or bootstrap peers
   -- configuration. This mode uses only the default target basis irrespective
   -- ledger state.
-  deriving Show
+  deriving (Eq, Show)
diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs
@@ -72,7 +72,7 @@ import Ouroboros.Network.Diffusion.P2P qualified as Diff.P2P
 import Ouroboros.Network.ExitPolicy (RepromoteDelay (..))
 import Ouroboros.Network.NodeToNode.Version (DiffusionMode (..))
 import Ouroboros.Network.PeerSelection.Governor (PeerSelectionTargets (..),
-           PublicPeerSelectionState (..), TargetsSelector)
+           PublicPeerSelectionState (..), ConsensusModePeerTargets)
 import Ouroboros.Network.PeerSelection.PeerMetric
            (PeerMetricsConfiguration (..), newPeerMetric)
 import Ouroboros.Network.Protocol.Handshake (HandshakeArguments (..))
@@ -112,6 +112,7 @@ import Test.Ouroboros.Network.Diffusion.Node.NodeKernel (NodeKernel (..),
 import Test.Ouroboros.Network.Diffusion.Node.NodeKernel qualified as Node
 import Test.Ouroboros.Network.PeerSelection.RootPeersDNS (DNSLookupDelay,
            DNSTimeout, mockDNSActions)
+import Ouroboros.Network.ConsensusMode (ConsensusMode)
 
 
 data Interfaces m = Interfaces
@@ -141,14 +142,14 @@ data Arguments m = Arguments
     , aShouldChainSyncExit  :: BlockHeader -> m Bool
     , aChainSyncEarlyExit   :: Bool
 
-    , aPeerTargetsSelector  :: TargetsSelector
+    , aPeerTargets          :: ConsensusModePeerTargets
     , aReadLocalRootPeers   :: STM m [( HotValency
                                       , WarmValency
                                       , Map RelayAccessPoint ( PeerAdvertise
                                                              , PeerTrustable))]
     , aReadPublicRootPeers  :: STM m (Map RelayAccessPoint PeerAdvertise)
     , aReadUseBootstrapPeers :: Script UseBootstrapPeers
-    , aUseGenesis           :: Bool
+    , aConsensusMode        :: ConsensusMode
     , aOwnPeerSharing       :: PeerSharing
     , aReadUseLedgerPeers   :: STM m UseLedgerPeers
     , aProtocolIdleTimeout  :: DiffTime
@@ -391,7 +392,7 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch =
     mkArgsExtra :: StrictTVar m (Script UseBootstrapPeers)
                 -> Diff.P2P.ArgumentsExtra m
     mkArgsExtra ubpVar = Diff.P2P.ArgumentsExtra
-      { Diff.P2P.daPeerTargetsSelector   = aPeerTargetsSelector na
+      { Diff.P2P.daPeerTargets            = aPeerTargets na
       , Diff.P2P.daReadLocalRootPeers     = aReadLocalRootPeers na
       , Diff.P2P.daReadPublicRootPeers    = aReadPublicRootPeers na
       , Diff.P2P.daReadUseBootstrapPeers  = stepScriptSTM' ubpVar

diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs
@@ -95,6 +95,7 @@ import Test.QuickCheck.Monoids
 import Test.Tasty
 import Test.Tasty.QuickCheck
 import Text.Pretty.Simple
+import Ouroboros.Network.ConsensusMode (ConsensusMode(PraosMode))
 
 
 -- Exactly as named.
@@ -180,15 +181,15 @@ tests =
       ]
     , testGroup "bootstrap peers"
       [ testProperty "progress towards only bootstrap peers after changing to fallback state"
-                     $ prop_governor_only_bootstrap_peers_in_fallback_state . getPreGenesisMockEnv
+                     $ prop_governor_only_bootstrap_peers_in_fallback_state . getPraosMockEnv
       , testProperty "node does not learn about non trustable peers when in fallback state"
-                     $ prop_governor_no_non_trustable_peers_before_caught_up_state . getPreGenesisMockEnv
+                     $ prop_governor_no_non_trustable_peers_before_caught_up_state . getPraosMockEnv
       , testProperty "node only use bootstrap peers if in sensitive state"
-                     prop_governor_stops_using_bootstrap_peers . getPreGenesisMockEnv
+                     $ prop_governor_stops_using_bootstrap_peers . getPraosMockEnv
       , testProperty "node never uses non-trustable peers in clean state"
-                     prop_governor_only_bootstrap_peers_in_clean_state . getPreGenesisMockEnv
+                     $ prop_governor_only_bootstrap_peers_in_clean_state . getPraosMockEnv
       , testProperty "node uses ledger peers in non-sensitive mode"
-                     $ prop_governor_uses_ledger_peers . getPreGenesisMockEnv
+                     $ prop_governor_uses_ledger_peers . getPraosMockEnv
       ]
     , testProperty "association mode" prop_governor_association_mode
     ]
@@ -1506,7 +1507,7 @@ prop_governor_target_known_1_valid_subset (MaxTime maxTime) env =
 prop_governor_target_known_2_opportunity_taken :: MaxTime
                                                -> GovernorMockEnvironment
                                                -> Property
-prop_governor_target_known_2_opportunity_taken (MaxTime maxTime) env =
+prop_governor_target_known_2_opportunity_taken (MaxTime maxTime) env@GovernorMockEnvironment { consensusMode } =
 
     let events = Signal.eventsFromListUpToTime maxTime
                . selectPeerSelectionTraceEvents
@@ -1560,7 +1561,7 @@ prop_governor_target_known_2_opportunity_taken (MaxTime maxTime) env =
 
         govUseBootstrapPeersSig :: Signal UseBootstrapPeers
         govUseBootstrapPeersSig =
-          selectGovStateGenesis Governor.bootstrapPeersFlag (useGenesis env) events
+          selectGovStateGenesis Governor.bootstrapPeersFlag consensusMode events
 
         -- We define the governor's peer sharing opportunities at any point in time
         -- to be the governor's set of established peers, less the ones we can see
@@ -3539,20 +3540,20 @@ selectGovState :: Eq a
 selectGovState f =
     Signal.nub
   -- TODO: #3182 Rng seed should come from quickcheck.
-  . Signal.fromChangeEvents (f $! Governor.emptyPeerSelectionState (mkStdGen 42) False)
+  . Signal.fromChangeEvents (f $! Governor.emptyPeerSelectionState (mkStdGen 42) PraosMode)
   . Signal.selectEvents
       (\case GovernorDebug (TraceGovernorState _ _ st) -> Just $! f st
              _                                         -> Nothing)
 
 selectGovStateGenesis :: Eq a
                       => (forall peerconn. Governor.PeerSelectionState PeerAddr peerconn -> a)
-                      -> Bool
+                      -> ConsensusMode
                       -> Events TestTraceEvent
                       -> Signal a
-selectGovStateGenesis f useGenesisFlag =
+selectGovStateGenesis f consensusMode =
     Signal.nub
   -- TODO: #3182 Rng seed should come from quickcheck.
-  . Signal.fromChangeEvents (f $! Governor.emptyPeerSelectionState (mkStdGen 42) useGenesisFlag)
+  . Signal.fromChangeEvents (f $! Governor.emptyPeerSelectionState (mkStdGen 42) consensusMode)
   . Signal.selectEvents
       (\case GovernorDebug (TraceGovernorState _ _ st) -> Just $! f st
              _                                         -> Nothing)
@@ -3586,12 +3587,12 @@ _governorFindingPublicRoots :: Int
                             -> STM IO LedgerStateJudgement
                             -> PeerSharing
                             -> StrictTVar IO OutboundConnectionsState
-                            -> Bool
+                            -> ConsensusMode
                             -> IO Void
-_governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrapPeers readLedgerStateJudgement peerSharing olocVar useGenesisFlag = do
+_governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrapPeers readLedgerStateJudgement peerSharing olocVar consensusMode = do
     countersVar <- newTVarIO emptyPeerSelectionCounters
     publicStateVar <- makePublicPeerSelectionStateVar
-    debugStateVar <- newTVarIO $ emptyPeerSelectionState (mkStdGen 42)
+    debugStateVar <- newTVarIO $ emptyPeerSelectionState (mkStdGen 42) consensusMode
     dnsSemaphore <- newLedgerAndPublicRootDNSSemaphore
     let interfaces = PeerSelectionInterfaces {
             countersVar,
@@ -3610,7 +3611,7 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrap
           tracer tracer tracer
           -- TODO: #3182 Rng seed should come from quickcheck.
           (mkStdGen 42)
-          useGenesisFlag
+          consensusMode
           actions
             { requestPublicRootPeers = \_ ->
                 transformPeerSelectionAction requestPublicRootPeers }
@@ -3703,7 +3704,7 @@ prop_issue_3550 = prop_governor_target_established_below defaultMaxTime $
       pickWarmPeersToDemote = Script (PickFirst :| []),
       pickColdPeersToForget = Script (PickFirst :| []),
       peerSharingFlag = PeerSharingEnabled,
-      useGenesis = False,
+      consensusMode = PraosMode,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
       useLedgerPeers = Script ((UseLedgerPeers Always, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
@@ -3741,7 +3742,7 @@ prop_issue_3515 = prop_governor_nolivelock $
       pickWarmPeersToDemote = Script (PickFirst :| []),
       pickColdPeersToForget = Script (PickFirst :| []),
       peerSharingFlag = PeerSharingEnabled,
-      useGenesis = False,
+      consensusMode = PraosMode,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
       useLedgerPeers = Script ((UseLedgerPeers Always, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
@@ -3779,7 +3780,7 @@ prop_issue_3494 = prop_governor_nofail $
       pickWarmPeersToDemote = Script (PickFirst :| []),
       pickColdPeersToForget = Script (PickFirst :| []),
       peerSharingFlag = PeerSharingEnabled,
-      useGenesis = False,
+      consensusMode = PraosMode,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
       useLedgerPeers = Script ((UseLedgerPeers Always, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
@@ -3833,7 +3834,7 @@ prop_issue_3233 = prop_governor_nolivelock $
       pickWarmPeersToDemote = Script (PickFirst :| []),
       pickColdPeersToForget = Script (PickFirst :| []),
       peerSharingFlag = PeerSharingEnabled,
-      useGenesis = False,
+      consensusMode = PraosMode,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
       useLedgerPeers = Script ((UseLedgerPeers Always, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])

diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/Instances.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/Instances.hs
@@ -37,6 +37,7 @@ import Ouroboros.Network.PeerSelection.RelayAccessPoint (DomainAccessPoint (..),
 import Ouroboros.Network.Testing.Utils (ShrinkCarefully, prop_shrink_nonequal,
            prop_shrink_valid)
 import Test.QuickCheck
+import Ouroboros.Network.ConsensusMode
 
 
 --
@@ -69,6 +70,11 @@ instance Arbitrary PeerSharing where
   shrink PeerSharingDisabled = []
   shrink PeerSharingEnabled  = [PeerSharingDisabled]
 
+instance Arbitrary ConsensusMode where
+  arbitrary = elements [ PraosMode, GenesisMode ]
+  shrink GenesisMode = [PraosMode]
+  shrink PraosMode   = []
+
 instance Arbitrary AfterSlot where
   arbitrary = oneof [ pure Always
                     , After <$> arbitrary