Merge pull request #706 from input-output-hk/mutations/explicit_expec…

…ted_errors

ADD explicit error expectations for Fanout and CollecCom

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

@@ -16,6 +16,7 @@ import Hydra.Chain.Direct.Contract.Mutation (
   SomeMutation (..),
   changeHeadOutputDatum,
   changeMintedTokens,
+  replaceParties,
  )
 import Hydra.Chain.Direct.Fixture (
   testNetworkId,
@@ -166,7 +167,10 @@ data CollectComMutation
   = MutateOpenUTxOHash
   | -- | Test that collectCom cannot collect from an initial UTxO.
     MutateCommitToInitial
-  | -- | Test that every party has a chance to commit.
+  | -- | Every party should have commited and been taken into account for the collectCom transaction to be
+    --   valid. Here we increase the number of parties in input and output but keep the commits unchanged.
+    --   This simulates the situation where one participant would not have commited already or whose commit
+    --   would have been ignored by the collectCom transaction.
     MutateNumberOfParties
   | MutateHeadId
   | MutateRequiredSigner
@@ -177,28 +181,28 @@ data CollectComMutation
 genCollectComMutation :: (Tx, UTxO) -> Gen SomeMutation
 genCollectComMutation (tx, _utxo) =
   oneof
-    [ SomeMutation Nothing MutateOpenUTxOHash . ChangeOutput 0 <$> mutateUTxOHash
-    , SomeMutation Nothing MutateNumberOfParties <$> do
-        -- NOTE: This also mutates the contestation period becuase we could not
-        -- be bothered to decode/lookup the current one.
-        c <- arbitrary
+    [ SomeMutation (Just "incorrect utxo hash") MutateOpenUTxOHash . ChangeOutput 0 <$> mutateUTxOHash
+    , SomeMutation (Just "missing commits") MutateNumberOfParties <$> do
         moreParties <- (: healthyOnChainParties) <$> arbitrary
         pure $
           Changes
-            [ ChangeInputHeadDatum $ Head.Initial c moreParties (toPlutusCurrencySymbol testPolicyId)
+            [ ChangeInputHeadDatum $ replaceParties moreParties healthyCollectComInitialDatum
             , ChangeOutput 0 $ mutatedPartiesHeadTxOut moreParties headTxOut
             ]
-    , SomeMutation Nothing MutateHeadId <$> do
+    , SomeMutation (Just "ST not spent") MutateHeadId <$> do
         illedHeadResolvedInput <-
           mkHeadOutput
             <$> pure testNetworkId
             <*> fmap headPolicyId (arbitrary `suchThat` (/= testSeedInput))
             <*> pure (toUTxOContext $ mkTxOutDatum healthyCollectComInitialDatum)
         return $ ChangeInput healthyHeadInput illedHeadResolvedInput (Just $ toScriptData Head.CollectCom)
-    , SomeMutation Nothing MutateRequiredSigner <$> do
+    , SomeMutation (Just "signer is not a participant") MutateRequiredSigner <$> do
         newSigner <- verificationKeyHash <$> genVerificationKey
         pure $ ChangeRequiredSigners [newSigner]
-    , SomeMutation Nothing MutateCommitToInitial <$> do
+    , SomeMutation (Just "datum not found") MutateCommitToInitial <$> do
+        -- we're satisfied with "datum not found" as the current version of the validator will consider
+        -- the initial input as if it were a commit input, hence fetching the datum which is expected
+        -- in a commit and complaining that it did not find it
         (txIn, HealthyCommit{cardanoKey}) <- elements $ Map.toList healthyCommits
         pure $ ChangeInput txIn (toUTxOContext $ mkInitialOutput testNetworkId testPolicyId cardanoKey) Nothing
     , SomeMutation (Just "minting or burning is forbidden") MutateTokenMintingOrBurning

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

@@ -94,17 +94,17 @@ data FanoutMutation
 genFanoutMutation :: (Tx, UTxO) -> Gen SomeMutation
 genFanoutMutation (tx, _utxo) =
   oneof
-    [ SomeMutation Nothing MutateAddUnexpectedOutput . PrependOutput <$> do
+    [ SomeMutation (Just "fannedOutUtxoHash /= closedUtxoHash") MutateAddUnexpectedOutput . PrependOutput <$> do
         arbitrary >>= genOutput
-    , SomeMutation Nothing MutateChangeOutputValue <$> do
+    , SomeMutation (Just "fannedOutUtxoHash /= closedUtxoHash") MutateChangeOutputValue <$> do
         let outs = txOuts' tx
         -- NOTE: Assumes the fanout transaction has non-empty outputs, which
         -- might not be always the case when testing unbalanced txs and we need
         -- to ensure it by at least one utxo is in healthyFanoutUTxO
         (ix, out) <- elements (zip [0 .. length outs - 1] outs)
         value' <- genValue `suchThat` (/= txOutValue out)
         pure $ ChangeOutput (fromIntegral ix) (modifyTxOutValue (const value') out)
-    , SomeMutation Nothing MutateValidityBeforeDeadline . ChangeValidityInterval <$> do
+    , SomeMutation (Just "lower bound before contestation deadline") MutateValidityBeforeDeadline . ChangeValidityInterval <$> do
         lb <- arbitrary `suchThat` slotBeforeContestationDeadline
         pure (TxValidityLowerBound lb, TxValidityNoUpperBound)
     ]

hydra-plutus/src/Hydra/Contract/Head.hs

@@ -182,7 +182,7 @@ checkCollectCom ctx@ScriptContext{scriptContextTxInfo = txInfo} (contestationPer
     && mustNotChangeParameters
     && everyoneHasCommitted
     && mustBeSignedByParticipant ctx headId
-    && hasST headId val
+    && traceIfFalse "ST not spent" (hasST headId val)
  where
   mustCollectUtxoHash =
     traceIfFalse "incorrect utxo hash" $