Generate healthy deposit transactions

This makes sure we test a wider range of transactions and we can easily
switch to this approach for deposits as the mutations are fully defined
on the mutated tx/utxo.

Author: ch1bo

hydra-tx/test/Hydra/Tx/Contract/ContractSpec.hs

@@ -44,7 +44,7 @@ import Hydra.Tx.Contract.Contest.ContestCurrent (genContestMutation)
 import Hydra.Tx.Contract.Contest.ContestDec (genContestDecMutation)
 import Hydra.Tx.Contract.Contest.Healthy (healthyContestTx)
 import Hydra.Tx.Contract.Decrement (genDecrementMutation, healthyDecrementTx)
-import Hydra.Tx.Contract.Deposit (genDepositMutation, healthyDepositTx)
+import Hydra.Tx.Contract.Deposit (genDepositMutation, genHealthyDepositTx)
 import Hydra.Tx.Contract.FanOut (genFanoutMutation, healthyFanoutTx)
 import Hydra.Tx.Contract.Increment (genIncrementMutation, healthyIncrementTx)
 import Hydra.Tx.Contract.Init (genInitMutation, healthyInitTx)
@@ -126,18 +126,19 @@ spec = parallel $ do
       propMutation healthyDecrementTx genDecrementMutation
   describe "Deposit" $ do
     prop "healthy evaluates" $
-      propTransactionEvaluates healthyDepositTx
+      forAll genHealthyDepositTx propTransactionEvaluates
     prop "healthy observed" $
-      isJust $
-        observeDepositTx testNetworkId (fst healthyDepositTx)
+      forAll genHealthyDepositTx $ \(tx, _) ->
+        isJust $ observeDepositTx testNetworkId tx
     prop "mutated not observed" $
-      forAll (genDepositMutation healthyDepositTx) $ \SomeMutation{label, mutation} -> do
-        let (tx, utxo) = healthyDepositTx & applyMutation mutation
-        counterexample ("Mutated transaction: " <> renderTxWithUTxO utxo tx) $
-          property (isNothing $ observeDepositTx testNetworkId tx)
-            & counterexample "Mutated transaction still observed"
-            & genericCoverTable [label]
-            & checkCoverage
+      forAll genHealthyDepositTx $ \(tx, utxo) ->
+        forAll (genDepositMutation (tx, utxo)) $ \SomeMutation{label, mutation} -> do
+          let (tx', utxo') = (tx, utxo) & applyMutation mutation
+          counterexample ("Mutated transaction: " <> renderTxWithUTxO utxo' tx') $
+            property (isNothing $ observeDepositTx testNetworkId tx')
+              & counterexample "Mutated transaction still observed"
+              & genericCoverTable [label]
+              & checkCoverage
   describe "Recover" $ do
     prop "is healthy" $
       propTransactionEvaluates healthyRecoverTx

hydra-tx/test/Hydra/Tx/Contract/Deposit.hs

@@ -1,5 +1,4 @@
 -- | Healthy deposit transactions and mutations
---
 -- As no Hydra script is run in these transactions, the mutations here should
 -- make the deposit transaction not observed as a valid deposi.
 module Hydra.Tx.Contract.Deposit where
@@ -13,23 +12,23 @@ import Hydra.Tx (mkHeadId)
 import Hydra.Tx.BlueprintTx (CommitBlueprintTx (..))
 import Hydra.Tx.Deposit (depositTx)
 import Test.Hydra.Tx.Fixture (depositDeadline, testNetworkId, testPolicyId)
-import Test.Hydra.Tx.Gen (genUTxO)
+import Test.Hydra.Tx.Gen (genUTxOSized)
 import Test.Hydra.Tx.Mutation (Mutation (ChangeOutput), SomeMutation (..))
-import Test.QuickCheck (chooseInteger, elements, oneof, resize)
+import Test.QuickCheck (chooseInteger, elements, oneof)
 
-healthyDepositTx :: (Tx, UTxO)
-healthyDepositTx =
-  (tx, healthyDepositUTxO)
- where
-  tx =
-    depositTx
-      testNetworkId
-      (mkHeadId testPolicyId)
-      CommitBlueprintTx{blueprintTx = txSpendingUTxO healthyDepositUTxO, lookupUTxO = healthyDepositUTxO}
-      depositDeadline
-
-healthyDepositUTxO :: UTxO
-healthyDepositUTxO = resize 3 genUTxO `generateWith` 42
+genHealthyDepositTx :: Gen (Tx, UTxO)
+genHealthyDepositTx = do
+  -- XXX: Ideally we would want to have more arbitrary utxo here, but 'genUTxO'
+  -- and other generators yield value quantities that fail to be put into
+  -- transaction outputs.
+  healthyDepositUTxO <- genUTxOSized 1
+  let tx =
+        depositTx
+          testNetworkId
+          (mkHeadId testPolicyId)
+          CommitBlueprintTx{blueprintTx = txSpendingUTxO healthyDepositUTxO, lookupUTxO = healthyDepositUTxO}
+          depositDeadline -- TODO: should generate
+  pure (tx, healthyDepositUTxO)
 
 data DepositMutation
   = -- | Change the output value to a subset of the deposited value. This

hydra-tx/test/Hydra/Tx/Contract/Increment.hs

@@ -26,14 +26,11 @@ import Hydra.Data.Party qualified as OnChain
 import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime)
 import Hydra.Plutus.Orphans ()
 import Hydra.Tx.ContestationPeriod (ContestationPeriod, toChain)
-import Hydra.Tx.Contract.Deposit (healthyDepositTx, healthyDepositUTxO)
 import Hydra.Tx.Crypto (HydraKey, MultiSignature (..), aggregate, sign, toPlutusSignatures)
 import Hydra.Tx.Deposit qualified as Deposit
 import Hydra.Tx.HeadId (mkHeadId)
 import Hydra.Tx.HeadParameters (HeadParameters (..))
-import Hydra.Tx.Increment (
-  incrementTx,
- )
+import Hydra.Tx.Increment (incrementTx)
 import Hydra.Tx.Init (mkHeadOutput)
 import Hydra.Tx.IsTx (IsTx (hashUTxO))
 import Hydra.Tx.Party (Party, deriveParty, partyToChain)
@@ -43,7 +40,7 @@ import Hydra.Tx.Utils (adaOnly)
 import PlutusLedgerApi.V2 qualified as Plutus
 import PlutusTx.Builtins (toBuiltin)
 import Test.Hydra.Tx.Fixture (aliceSk, bobSk, carolSk, depositDeadline, slotLength, systemStart, testNetworkId, testPolicyId)
-import Test.Hydra.Tx.Gen (genForParty, genScriptRegistry, genUTxOSized, genValue, genVerificationKey)
+import Test.Hydra.Tx.Gen (genForParty, genScriptRegistry, genUTxO, genUTxOSized, genValue, genVerificationKey)
 import Test.QuickCheck (arbitrarySizedNatural, elements, oneof, suchThat)
 import Test.QuickCheck.Instances ()
 
@@ -53,7 +50,7 @@ healthyIncrementTx =
  where
   lookupUTxO =
     UTxO.singleton (headInput, headOutput)
-      <> depositUTxO
+      <> healthyDepositUTxO
       <> registryUTxO scriptRegistry
 
   tx =
@@ -64,7 +61,7 @@ healthyIncrementTx =
       parameters
       (headInput, headOutput)
       healthySnapshot
-      depositUTxO
+      healthyDepositUTxO
       (slotNoFromUTCTime systemStart slotLength depositDeadline)
       healthySignature
 
@@ -83,8 +80,8 @@ healthyIncrementTx =
       & addParticipationTokens healthyParticipants
       & modifyTxOutValue (<> foldMap txOutValue healthyUTxO)
 
-depositUTxO :: UTxO
-depositUTxO = utxoFromTx (fst healthyDepositTx)
+healthyDepositUTxO :: UTxO
+healthyDepositUTxO = genUTxO `generateWith` 42
 
 somePartyCardanoVerificationKey :: VerificationKey PaymentKey
 somePartyCardanoVerificationKey =
@@ -195,7 +192,7 @@ genIncrementMutation (tx, utxo) =
             Head.IncrementRedeemer
               { signature = invalidSignature
               , snapshotNumber = fromIntegral healthySnapshotNumber
-              , increment = toPlutusTxOutRef $ fst $ List.head $ UTxO.pairs depositUTxO
+              , increment = toPlutusTxOutRef $ fst $ List.head $ UTxO.pairs healthyDepositUTxO
               }
     , SomeMutation (pure $ toErrorCode HeadValueIsNotPreserved) ChangeHeadValue <$> do
         newValue <- genValue `suchThat` (/= txOutValue headTxOut)