Implement mutation changing commit value during initial script valida…

…tion.

  Note that, we could also change the datum (or more generally, the resolving input associated with that commit).

hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs

@@ -8,16 +8,18 @@ import Hydra.Prelude
 import Hydra.Chain.Direct.TxSpec ()
 
 import Data.Maybe (fromJust)
-import Hydra.Chain.Direct.Contract.Mutation (Mutation (ChangeInput, ChangeOutput), SomeMutation (SomeMutation))
+import Hydra.Chain.Direct.Contract.Mutation (
+  Mutation (..),
+  SomeMutation (..),
+  isInitialOutput,
+ )
 import qualified Hydra.Chain.Direct.Fixture as Fixture
 import Hydra.Chain.Direct.Tx (commitTx, mkInitialOutput, pubKeyHash)
 import Hydra.Ledger.Cardano (
   CardanoTx,
   CtxUTxO,
   Era,
   PaymentKey,
-  TxBody (..),
-  TxBodyContent (TxBodyContent, txIns),
   TxIn,
   TxOut (TxOut),
   Utxo,
@@ -26,16 +28,16 @@ import Hydra.Ledger.Cardano (
   genOutput,
   genValue,
   getOutputs,
-  getTxBody,
   lovelaceToValue,
   mkTxOutValue,
   modifyTxOutValue,
   singletonUtxo,
   toCtxUTxOTxOut,
   toLedgerTxIn,
+  utxoPairs,
  )
 import Hydra.Party (Party)
-import Test.QuickCheck (oneof, suchThat)
+import Test.QuickCheck (elements, oneof, suchThat)
 
 --
 -- CommitTx
@@ -83,16 +85,21 @@ data CommitMutation
   deriving (Generic, Show, Enum, Bounded)
 
 genCommitMutation :: (CardanoTx, Utxo) -> Gen SomeMutation
-genCommitMutation (tx, _utxo) =
+genCommitMutation (tx, utxo) =
   oneof
     [ SomeMutation MutateCommitOutputValue . ChangeOutput 0 <$> do
         mutatedValue <- (mkTxOutValue <$> genValue) `suchThat` (/= commitOutputValue)
         pure $ TxOut commitOutputAddress mutatedValue commitOutputDatum
-    , SomeMutation MutateComittedValue . ChangeInput comittedTxIn
-        <$> (genOutput =<< arbitrary)
+    , SomeMutation MutateComittedValue <$> do
+        (comittedTxIn, _) <- elements comittedTxIns
+        newResolvedTxIn <- genOutput =<< arbitrary
+        pure $ ChangeInput comittedTxIn newResolvedTxIn
     ]
  where
   TxOut commitOutputAddress commitOutputValue commitOutputDatum =
     fromJust $ getOutputs tx !!? 0
 
-  comittedTxIn = undefined
+  -- NOTE: This filtering will also yield any input added for fees, but we don't
+  -- have any in our test scenario so far.
+  comittedTxIns =
+    filter (not . isInitialOutput . snd) . utxoPairs $ utxo

hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs

@@ -24,6 +24,7 @@ import Hydra.Chain.Direct.Tx (
  )
 import qualified Hydra.Contract.Head as Head
 import qualified Hydra.Contract.HeadState as Head
+import qualified Hydra.Contract.Initial as Initial
 import Hydra.Ledger.Cardano (
   AlonzoEra,
   CardanoTx,
@@ -255,6 +256,12 @@ isHeadOutput (TxOut addr _ _) = addr == headAddress
   headAddress = Api.mkScriptAddress @Api.PlutusScriptV1 Fixture.testNetworkId headScript
   headScript = Api.fromPlutusScript $ Head.validatorScript policyId
 
+isInitialOutput :: TxOut CtxUTxO Era -> Bool
+isInitialOutput (TxOut addr _ _) = addr == initialAddress
+ where
+  initialAddress = Api.mkScriptAddress @Api.PlutusScriptV1 Fixture.testNetworkId initialScript
+  initialScript = Api.fromPlutusScript Initial.validatorScript
+
 -- | Adds given 'Datum' and corresponding hash to the transaction's scripts.
 -- TODO: As we are creating the `TxOutDatum` from a known datum, passing a `TxOutDatum` is
 -- pointless and requires more work than needed to check impossible variants.