wip - fix tests

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)

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

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) :| [])

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

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs

@@ -4,7 +4,7 @@
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-
+{-# LANGUAGE DuplicateRecordFields #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}
@@ -13,7 +13,7 @@
 module Test.Ouroboros.Network.PeerSelection.MockEnvironment
   ( PeerGraph (..)
   , GovernorMockEnvironment (..)
-  , GovernorPreGenesisMockEnvironment (..)
+  , GovernorPraosMockEnvironment (..)
   , GovernorMockEnvironmentWithoutAsyncDemotion (..)
   , runGovernorInMockEnvironment
   , exploreGovernorInMockEnvironment
@@ -94,6 +94,7 @@ import Test.Ouroboros.Network.PeerSelection.PublicRootPeers ()
 import Test.QuickCheck
 import Test.Tasty (TestTree, localOption, testGroup)
 import Test.Tasty.QuickCheck (QuickCheckMaxSize (..), testProperty)
+import Ouroboros.Network.ConsensusMode
 
 tests :: TestTree
 tests =
@@ -140,7 +141,7 @@ data GovernorMockEnvironment = GovernorMockEnvironment {
        pickColdPeersToForget      :: !(PickScript PeerAddr),
        peerSharingFlag            :: !PeerSharing,
        useBootstrapPeers          :: !(TimedScript UseBootstrapPeers),
-       useGenesis                 :: !Bool,
+       consensusMode              :: !ConsensusMode,
        useLedgerPeers             :: !(TimedScript UseLedgerPeers),
        ledgerStateJudgement       :: !(TimedScript LedgerStateJudgement)
      }
@@ -149,7 +150,7 @@ data GovernorMockEnvironment = GovernorMockEnvironment {
 -- | This instance is used to generate test cases for properties
 -- which rely on peer selection prior to introduction of Genesis
 --
-newtype GovernorPreGenesisMockEnvironment = GovernorPreGenesisMockEnvironment { getPreGenesisMockEnv :: GovernorMockEnvironment }
+newtype GovernorPraosMockEnvironment = GovernorPraosMockEnvironment { getPraosMockEnv :: GovernorMockEnvironment }
   deriving (Eq, Show)
 
 data PeerConn m = PeerConn !PeerAddr !PeerSharing !(TVar m PeerStatus)
@@ -215,16 +216,15 @@ runGovernorInMockEnvironment mockEnv =
     runSimTrace $ governorAction mockEnv
 
 governorAction :: GovernorMockEnvironment -> IOSim s Void
-governorAction mockEnv = do
-    let genesisMode = useGenesis mockEnv
+governorAction mockEnv@GovernorMockEnvironment { consensusMode } = do
     publicStateVar <- makePublicPeerSelectionStateVar
     lsjVar <- playTimedScript (contramap TraceEnvSetLedgerStateJudgement tracerMockEnv)
                              (ledgerStateJudgement mockEnv)
     lpVar <- playTimedScript (contramap TraceEnvUseLedgerPeers tracerMockEnv)
                              (useLedgerPeers mockEnv)
     usbVar <- playTimedScript (contramap TraceEnvSetUseBootstrapPeers tracerMockEnv)
                              (useBootstrapPeers mockEnv)
-    debugStateVar <- StrictTVar.newTVarIO (emptyPeerSelectionState (mkStdGen 42) genesisMode)
+    debugStateVar <- StrictTVar.newTVarIO (emptyPeerSelectionState (mkStdGen 42) consensusMode)
     countersVar <- StrictTVar.newTVarIO emptyPeerSelectionCounters
     policy  <- mockPeerSelectionPolicy                mockEnv
     actions <- mockPeerSelectionActions tracerMockEnv mockEnv
@@ -248,7 +248,7 @@ governorAction mockEnv = do
         (tracerDebugPeerSelection <> traceAssociationMode interfaces actions)
         tracerTracePeerSelectionCounters
         (mkStdGen 42)
-        genesisMode
+        consensusMode
         actions
         policy
         interfaces
@@ -782,14 +782,14 @@ selectGovernorStateEvents trace = [ (t, e) | (t, GovernorDebug e) <- trace ]
 -- QuickCheck instances
 --
 
-instance Arbitrary GovernorPreGenesisMockEnvironment where
+instance Arbitrary GovernorPraosMockEnvironment where
   arbitrary = do
     mockEnv <- arbitrary
     bootstrapScript <- arbitrary
-    return $ GovernorPreGenesisMockEnvironment mockEnv {
-      useGenesis = False,
+    return $ GovernorPraosMockEnvironment mockEnv {
+      consensusMode = PraosMode,
       useBootstrapPeers = bootstrapScript }
-  shrink env = GovernorPreGenesisMockEnvironment <$> shrink (getPreGenesisMockEnv env)
+  shrink env = GovernorPraosMockEnvironment <$> shrink (getPraosMockEnv env)
 
 instance Arbitrary GovernorMockEnvironment where
   arbitrary = do
@@ -810,8 +810,10 @@ instance Arbitrary GovernorMockEnvironment where
       pickWarmPeersToDemote   <- arbitraryPickScript arbitrarySubsetOfPeers
       pickColdPeersToForget   <- arbitraryPickScript arbitrarySubsetOfPeers
       peerSharingFlag         <- arbitrary
-      useGenesis              <- arbitrary
-      useBootstrapPeers       <- if useGenesis then pure $ singletonTimedScript DontUseBootstrapPeers else arbitrary
+      consensusMode           <- arbitrary
+      useBootstrapPeers       <- case consensusMode of
+                                   GenesisMode -> pure $ singletonTimedScript DontUseBootstrapPeers
+                                   PraosMode   -> arbitrary
       useLedgerPeers          <- arbitrary
       ledgerStateJudgementList <- fmap getArbitraryLedgerStateJudgement <$> arbitrary
       ledgerStateJudgementDelays <- listOf1 (elements [NoDelay, ShortDelay])
@@ -894,7 +896,7 @@ instance Arbitrary GovernorMockEnvironment where
            pickColdPeersToForget,
            peerSharingFlag,
            useBootstrapPeers,
-           useGenesis,
+           consensusMode,
            useLedgerPeers,
            ledgerStateJudgement
          } =
@@ -947,9 +949,8 @@ instance Arbitrary GovernorMockEnvironment where
    ++ [ env { peerSharingFlag = peerSharingFlag' }
       | peerSharingFlag' <- shrink peerSharingFlag
       ]
-   -- TODOmw: fix
-   ++ [ env { useGenesis = useGenesis' }
-      | useGenesis' <- shrink useGenesis
+   ++ [ env { consensusMode = consensusMode' }
+      | consensusMode' <- shrink consensusMode
       ]
     where
       shrinkLocalRootPeers a =