Limit size of generated contesters to reasonable values

cardano-scaling · Jul 10, 2024 · 4429b42 · 4429b42
1 parent 56cb757
commit 4429b42
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 14 deletions.
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseCurrent.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Close/CloseCurrent.hs
@@ -7,7 +7,19 @@ import Hydra.Cardano.Api
 import Hydra.Prelude hiding (label)
 
 import Data.Maybe (fromJust)
-import Hydra.Chain.Direct.Contract.Close.Healthy (healthyConfirmedClosingTx, healthyContestationDeadline, healthyContestationPeriodSeconds, healthyOnChainParties, healthyOpenDatum, healthyOpenHeadTxIn, healthyOpenHeadTxOut, healthySignature, healthySnapshot, healthySplitUTxOInHead, somePartyCardanoVerificationKey)
+import Hydra.Chain.Direct.Contract.Close.Healthy (
+  healthyConfirmedClosingTx,
+  healthyContestationDeadline,
+  healthyContestationPeriodSeconds,
+  healthyOnChainParties,
+  healthyOpenDatum,
+  healthyOpenHeadTxIn,
+  healthyOpenHeadTxOut,
+  healthySignature,
+  healthySnapshot,
+  healthySplitUTxOInHead,
+  somePartyCardanoVerificationKey,
+ )
 import Hydra.Chain.Direct.Contract.Gen (genHash, genMintedOrBurnedValue)
 import Hydra.Chain.Direct.Contract.Mutation (
   Mutation (..),
@@ -40,7 +52,7 @@ import Hydra.Snapshot (Snapshot (..))
 import Hydra.Snapshot qualified as Snapshot
 import PlutusLedgerApi.V1.Time (DiffMilliSeconds (..), fromMilliSeconds)
 import PlutusLedgerApi.V2 (POSIXTime, PubKeyHash (PubKeyHash), toBuiltin)
-import Test.QuickCheck (arbitrarySizedNatural, choose, elements, listOf1, oneof, suchThat)
+import Test.QuickCheck (arbitrarySizedNatural, choose, elements, listOf1, oneof, resize, suchThat)
 import Test.QuickCheck.Instances ()
 
 healthyCurrentSnapshotNumber :: Snapshot.SnapshotNumber
@@ -237,7 +249,7 @@ genCloseCurrentMutation (tx, _utxo) =
         <$> (changeMintedTokens tx =<< genMintedOrBurnedValue)
     , -- Initializes the set of contesters
       SomeMutation (pure $ toErrorCode ContestersNonEmpty) MutateContesters . ChangeOutput 0 <$> do
-        mutatedContesters <- listOf1 $ PubKeyHash . toBuiltin <$> genHash
+        mutatedContesters <- resize 3 . listOf1 $ PubKeyHash . toBuiltin <$> genHash
         pure $ headTxOut & modifyInlineDatum (replaceContesters mutatedContesters)
     , -- Value in the head is preserved
       SomeMutation (pure $ toErrorCode HeadValueIsNotPreserved) MutateValueInOutput <$> do

diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Contest/ContestCurrent.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Contest/ContestCurrent.hs
@@ -52,7 +52,7 @@ import Hydra.Snapshot (Snapshot (..), SnapshotNumber, SnapshotVersion)
 import PlutusLedgerApi.V2 (BuiltinByteString, toBuiltin)
 import PlutusLedgerApi.V2 qualified as Plutus
 import Test.Hydra.Fixture (aliceSk, bobSk, carolSk, genForParty)
-import Test.QuickCheck (arbitrarySizedNatural, elements, listOf, listOf1, oneof, suchThat, vectorOf)
+import Test.QuickCheck (arbitrarySizedNatural, elements, listOf, listOf1, oneof, resize, suchThat, vectorOf)
 import Test.QuickCheck.Gen (choose)
 import Test.QuickCheck.Instances ()
 
@@ -381,19 +381,13 @@ genContestMutation (tx, _utxo) =
         <$> (changeMintedTokens tx =<< genMintedOrBurnedValue)
     , SomeMutation (pure $ toErrorCode SignerAlreadyContested) MutateInputContesters . ChangeInputHeadDatum <$> do
         let contester = toPlutusKeyHash (verificationKeyHash healthyContesterVerificationKey)
-            contesterAndSomeOthers = do
-              contesters <- listOf $ Plutus.PubKeyHash . toBuiltin <$> genHash
-              pure (contester : contesters)
-        mutatedContesters <-
-          oneof
-            [ pure [contester]
-            , contesterAndSomeOthers
-            ]
+        mutatedContesters <- do
+          contesters <- resize (length healthyParticipants - 1) . listOf $ Plutus.PubKeyHash . toBuiltin <$> genHash
+          pure (contester : contesters)
         pure $
           healthyClosedState & replaceContesters mutatedContesters
     , SomeMutation (pure $ toErrorCode ContesterNotIncluded) MutateContesters . ChangeOutput 0 <$> do
-        hashes <- listOf genHash
-        let mutatedContesters = Plutus.PubKeyHash . toBuiltin <$> hashes
+        mutatedContesters <- resize (length healthyParticipants) . listOf $ Plutus.PubKeyHash . toBuiltin <$> genHash
         pure $ modifyInlineDatum (replaceContesters mutatedContesters) headTxOut
     , SomeMutation (pure $ toErrorCode HeadValueIsNotPreserved) MutateValueInOutput <$> do
         newValue <- genValue