wip - fix tests

IntersectMBO · May 8, 2024 · cee3efb · cee3efb
1 parent a29089c
commit cee3efb
Show file tree

Hide file tree

Showing 9 changed files with 386 additions and 228 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-testing/src/Ouroboros/Network/Testing/Data/Script.hs b/ouroboros-network-testing/src/Ouroboros/Network/Testing/Data/Script.hs
@@ -150,7 +150,8 @@ instance Arbitrary ScriptDelay where
   shrink LongDelay  = [NoDelay, ShortDelay]
   shrink ShortDelay = [NoDelay]
   shrink NoDelay    = []
-  shrink (Delay _)  = []
+  shrink (Delay delay) | delay * 0.8 <= 1 = [ShortDelay]
+  shrink (Delay delay) = [Delay $ delay * 0.8]
 
 playTimedScript :: (MonadAsync m, MonadDelay m)
                 => Tracer m a -> TimedScript a -> m (TVar m a)

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
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
@@ -121,6 +127,22 @@ instance Arbitrary PeerSelectionTargets where
     , let targets' = PeerSelectionTargets r' k' e' a' kb' eb' ab'
     , sanePeerSelectionTargets targets' ]
 
+instance Arbitrary ConsensusModePeerTargets where
+  arbitrary = do
+    praosTargets <- arbitrary
+    genesisSyncTargets <- suchThatMap (choose (1, min 100 (targetNumberOfEstablishedBigLedgerPeers praosTargets))) $
+                                      \n ->
+                                        if n /= targetNumberOfActiveBigLedgerPeers praosTargets
+                                        then Just praosTargets{ targetNumberOfActiveBigLedgerPeers = n }
+                                        else Nothing
+    return ConsensusModePeerTargets { praosTargets, genesisSyncTargets }
+  shrink ConsensusModePeerTargets { praosTargets, genesisSyncTargets } =
+    let genesisSyncTargets' = shrink genesisSyncTargets
+        praosTargets'       = shrink praosTargets
+    in [ConsensusModePeerTargets { praosTargets = praos, genesisSyncTargets = genesis }
+       | praos <- praosTargets',
+         genesis <- genesisSyncTargets']
+
 instance Arbitrary DomainAccessPoint where
   arbitrary =
     DomainAccessPoint . encodeUtf8