Reduce memory and time efficiency of test

IntersectMBO · Oct 31, 2023 · 12b7a3f · 12b7a3f
1 parent e3536c8
commit 12b7a3f
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 6 deletions.
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
@@ -70,6 +70,9 @@ instance Arbitrary UseBootstrapPeers where
                         , (1, UseBootstrapPeers <$> arbitrary)
                         ]
 
+  shrink DontUseBootstrapPeers = []
+  shrink (UseBootstrapPeers _) = [DontUseBootstrapPeers]
+
 instance Arbitrary PeerTrustable where
   arbitrary = elements [ IsNotTrustable, IsTrustable ]
 

diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs
@@ -80,7 +80,7 @@ import           Ouroboros.Network.PeerSelection.LedgerPeers.Type
                      (IsBigLedgerPeer, LedgerStateJudgement (..))
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import           Ouroboros.Network.PeerSelection.PublicRootPeers
-                     (PublicRootPeers)
+                     (PublicRootPeers (..))
 import qualified Ouroboros.Network.PeerSelection.PublicRootPeers as PublicRootPeers
 import           Ouroboros.Network.PeerSelection.Types (PeerStatus (..))
 import           Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount,
@@ -772,25 +772,38 @@ instance Arbitrary GovernorMockEnvironment where
           ledgerStateJudgement    = fmap (first getArbitraryLedgerStateJudgement)
                                          ledgerStateJudgement'
         }
-      | (localRootPeers', publicRootPeers', targets',
+      | (targets',
          pickKnownPeersForPeerShare',
          pickColdPeersToPromote',
          pickWarmPeersToPromote',
          pickHotPeersToDemote',
          pickWarmPeersToDemote',
          pickColdPeersToForget',
-         ledgerStateJudgement')
-          <- shrink (localRootPeers, publicRootPeers, targets,
+         ledgerStateJudgement',
+         useBootstrapPeers'
+        )
+          <- shrink (targets,
                      pickKnownPeersForPeerShare,
                      pickColdPeersToPromote,
                      pickWarmPeersToPromote,
                      pickHotPeersToDemote,
                      pickWarmPeersToDemote,
                      pickColdPeersToForget,
-                     fmap (first ArbitraryLedgerStateJudgement) ledgerStateJudgement
+                     fmap (first ArbitraryLedgerStateJudgement) ledgerStateJudgement,
+                     useBootstrapPeers
                     ),
-         useBootstrapPeers' <- shrink useBootstrapPeers
+         localRootPeers' <- shrinkLocalRootPeers localRootPeers,
+         publicRootPeers' <- shrinkPublicRootPeers publicRootPeers
       ]
+    where
+      shrinkLocalRootPeers (LocalRootPeers m g) =
+        [ LocalRootPeers m' g'
+          | (m', g') <- shrink (m, g)
+        ]
+      shrinkPublicRootPeers (PublicRootPeers pp bsp lp blp) =
+        [ PublicRootPeers pp' bsp' lp' blp'
+          | (pp', bsp', lp', blp') <- shrink (pp, bsp, lp, blp)
+        ]
 
 
 --