Rename and re-number head errors

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

@@ -172,7 +172,7 @@ genDecrementMutation (tx, _utxo) =
         mutatedParties <- arbitrary `suchThat` (/= healthyOnChainParties)
         pure $ ChangeOutput 0 $ modifyInlineDatum (replaceParties mutatedParties) headTxOut
     , -- New version v′ is incremented correctly
-      SomeMutation (pure $ toErrorCode IncorrectVersion) UseDifferentSnapshotVersion <$> do
+      SomeMutation (pure $ toErrorCode VersionNotIncremented) UseDifferentSnapshotVersion <$> do
         mutatedSnapshotVersion <- arbitrarySizedNatural `suchThat` (/= healthySnapshotVersion + 1)
         pure $ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotVersion $ toInteger mutatedSnapshotVersion) headTxOut
     , -- XXX: ξ is a valid multi-signature of the currency id cid, the current snapshot state η,

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

@@ -130,11 +130,11 @@ genFanoutMutation (tx, _utxo) =
 
     , -- XXX: The first m outputs are distributing funds according to η. That is, the outputs exactly
       -- correspond to the UTxO canonically combined U
-    SomeMutation (pure $ toErrorCode FannedOutUtxoHashNotEqualToClosedUtxoHash) MutateAddUnexpectedOutput . PrependOutput <$> do
+    SomeMutation (pure $ toErrorCode FanoutUTxOHashMismatch) MutateAddUnexpectedOutput . PrependOutput <$> do
         arbitrary >>= genOutput
     , -- XXX: The following n outputs are distributing funds according to η∆ .
       -- That is, the outputs exactly # correspond to the UTxO canonically combined U∆
-      SomeMutation (pure $ toErrorCode FannedOutUtxoHashNotEqualToClosedUtxoHashToDecommit) MutateChangeOutputValue <$> do
+      SomeMutation (pure $ toErrorCode FanoutUTxOToDecommitHashMismatch) 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
@@ -146,7 +146,7 @@ genFanoutMutation (tx, _utxo) =
         pure $ ChangeOutput (fromIntegral ix) (modifyTxOutValue (const value') out)
     , -- XXX: The following n outputs are distributing funds according to η∆ .
       -- That is, the outputs exactly # correspond to the UTxO canonically combined U∆
-      SomeMutation (pure $ toErrorCode FannedOutUtxoHashNotEqualToClosedUtxoHash) MutateChangeOutputValue <$> do
+      SomeMutation (pure $ toErrorCode FanoutUTxOHashMismatch) 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
@@ -158,14 +158,14 @@ genFanoutMutation (tx, _utxo) =
         pure $ ChangeOutput (fromIntegral ix) (modifyTxOutValue (const value') out)
     , -- XXX: The following n outputs are distributing funds according to η∆ .
       -- That is, the outputs exactly # correspond to the UTxO canonically combined U∆
-      SomeMutation (pure $ toErrorCode FannedOutUtxoHashNotEqualToClosedUtxoHashToDecommit) MutateFanoutRedeemer . ChangeHeadRedeemer <$> do
+      SomeMutation (pure $ toErrorCode FanoutUTxOToDecommitHashMismatch) MutateFanoutRedeemer . ChangeHeadRedeemer <$> do
         let noOfUtxoToOutputs = fromIntegral . size $ toMap (fst healthyFanoutSnapshotUTxO)
         let noOfUtxoDecommitToOutputs = fromIntegral . size $ toMap (snd healthyFanoutSnapshotUTxO)
         n <- elements [1 .. 3]
         pure (Head.Fanout noOfUtxoToOutputs (noOfUtxoDecommitToOutputs - n))
     , -- XXX: The first m outputs are distributing funds according to η. That is, the outputs exactly
       -- correspond to the UTxO canonically combined U
-      SomeMutation (pure $ toErrorCode FannedOutUtxoHashNotEqualToClosedUtxoHash) MutateFanoutRedeemer . ChangeHeadRedeemer <$> do
+      SomeMutation (pure $ toErrorCode FanoutUTxOHashMismatch) MutateFanoutRedeemer . ChangeHeadRedeemer <$> do
         let noOfUtxoToOutputs = fromIntegral . size $ toMap (fst healthyFanoutSnapshotUTxO)
         let noOfUtxoDecommitToOutputs = fromIntegral . size $ toMap (snd healthyFanoutSnapshotUTxO)
         n <- elements [1 .. 3]

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

@@ -243,7 +243,7 @@ checkDecrement ctx openBefore redeemer =
       headInValue == headOutValue <> foldMap txOutValue decommitOutputs
 
   mustIncreaseVersion =
-    traceIfFalse $(errorCode IncorrectVersion) $
+    traceIfFalse $(errorCode VersionNotIncremented) $
       nextVersion == prevVersion + 1
 
   decommitUtxoHash = hashTxOuts decommitOutputs
@@ -415,16 +415,18 @@ checkContest ctx contestationDeadline contestationPeriod parties snapshotNumber
   mustBeValidSnapshot =
     case redeemer of
       ContestCurrent{signature} ->
-        verifySnapshotSignature
-          parties
-          (headId, version, snapshotNumber', utxoHash', utxoDeltaHash')
-          signature
-      ContestOutdated{signature, alreadyDecommittedUTxOHash} ->
-        utxoDeltaHash' == mempty -- TODO: make this 'Maybe Hash'
-          && verifySnapshotSignature
+        traceIfFalse $(errorCode FailedContestCurrent) $
+          verifySnapshotSignature
             parties
-            (headId, version - 1, snapshotNumber', utxoHash', alreadyDecommittedUTxOHash)
+            (headId, version, snapshotNumber', utxoHash', utxoDeltaHash')
             signature
+      ContestOutdated{signature, alreadyDecommittedUTxOHash} ->
+        traceIfFalse $(errorCode FailedContestOutdated) $
+          utxoDeltaHash' == mempty -- TODO: make this 'Maybe Hash'
+            && verifySnapshotSignature
+              parties
+              (headId, version - 1, snapshotNumber', utxoHash', alreadyDecommittedUTxOHash)
+              signature
 
   mustBeWithinContestationPeriod =
     case ivTo (txInfoValidRange txInfo) of
@@ -480,11 +482,11 @@ checkFanout utxoHash utxoToDecommitHash contestationDeadline numberOfFanoutOutpu
   minted = txInfoMint txInfo
 
   hasSameUTxOHash =
-    traceIfFalse $(errorCode FannedOutUtxoHashNotEqualToClosedUtxoHash) $
+    traceIfFalse $(errorCode FanoutUTxOHashMismatch) $
       fannedOutUtxoHash == utxoHash
 
   hasSameUTxOToDecommitHash =
-    traceIfFalse $(errorCode FannedOutUtxoHashNotEqualToClosedUtxoHashToDecommit) $
+    traceIfFalse $(errorCode FanoutUTxOToDecommitHashMismatch) $
       decommitUtxoHash == utxoToDecommitHash
 
   fannedOutUtxoHash = hashTxOuts $ take numberOfFanoutOutputs txInfoOutputs

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

@@ -7,20 +7,35 @@ import Hydra.Contract.Error (ToErrorCode (..), errorCode)
 
 data HeadError
   = InvalidHeadStateTransition
+  | ChangedParameters
+  | WrongStateInOutputDatum
+  | HeadValueIsNotPreserved
+  | SignerIsNotAParticipant
+  | NoSigners
+  | TooManySigners
+  | ScriptNotSpendingAHeadInput
+  | NoOutputDatumError
+  | UnexpectedNonInlineDatum
+  | NotPayingToHead
+  | SignatureVerificationFailed
+  | MustNotChangeVersion
   | BurntTokenNumberMismatch
   | ReimbursedOutputsDontMatch
   | STNotSpent
   | IncorrectUtxoHash
-  | ChangedParameters
-  | WrongStateInOutputDatum
   | MissingCommits
-  | HeadValueIsNotPreserved
+  | NotAllValueCollected
+  | IncorrectVersion
+  | VersionNotIncremented
   | HasBoundedValidityCheckFailed
-  | ClosedWithNonInitialHash
   | IncorrectClosedContestationDeadline
   | InfiniteUpperBound
   | InfiniteLowerBound
   | ContestersNonEmpty
+  | CloseNoUpperBoundDefined
+  | FailedCloseInitial
+  | FailedCloseCurrent
+  | FailedCloseOutdated
   | TooOldSnapshot
   | UpperBoundBeyondContestationDeadline
   | ContestNoUpperBoundDefined
@@ -29,70 +44,63 @@ data HeadError
   | ContesterNotIncluded
   | WrongNumberOfSigners
   | SignerAlreadyContested
-  | FannedOutUtxoHashNotEqualToClosedUtxoHash
+  | FailedContestCurrent
+  | FailedContestOutdated
+  | FanoutUTxOHashMismatch
   | LowerBoundBeforeContestationDeadline
   | FanoutNoLowerBoundDefined
-  | CloseNoUpperBoundDefined
-  | ScriptNotSpendingAHeadInput
-  | SignerIsNotAParticipant
-  | NoSigners
-  | TooManySigners
-  | NoOutputDatumError
-  | UnexpectedNonInlineDatum
-  | SignatureVerificationFailed
-  | NotPayingToHead
-  | NotAllValueCollected
-  | SnapshotNumberMismatch
-  | IncorrectVersion
-  | MustNotChangeVersion
-  | FannedOutUtxoHashNotEqualToClosedUtxoHashToDecommit
-  | FailedCloseInitial
-  | FailedCloseCurrent
-  | FailedCloseOutdated
+  | FanoutUTxOToDecommitHashMismatch
 
 instance ToErrorCode HeadError where
   toErrorCode = \case
-    InvalidHeadStateTransition -> "H01"
-    BurntTokenNumberMismatch -> "H02"
-    ReimbursedOutputsDontMatch -> "H03"
-    STNotSpent -> "H04"
-    IncorrectUtxoHash -> "H05"
-    ChangedParameters -> "H06"
-    WrongStateInOutputDatum -> "H07"
-    MissingCommits -> "H08"
-    HeadValueIsNotPreserved -> "H09"
-    HasBoundedValidityCheckFailed -> "H10"
-    -- TODO: remove as unused (and re-order?)
-    ClosedWithNonInitialHash -> "H11"
-    IncorrectClosedContestationDeadline -> "H12"
-    InfiniteUpperBound -> "H13"
-    InfiniteLowerBound -> "H14"
-    ContestersNonEmpty -> "H15"
-    TooOldSnapshot -> "H16"
-    UpperBoundBeyondContestationDeadline -> "H17"
-    ContestNoUpperBoundDefined -> "H18"
-    MustNotPushDeadline -> "H19"
-    MustPushDeadline -> "H20"
-    ContesterNotIncluded -> "H21"
-    WrongNumberOfSigners -> "H22"
-    SignerAlreadyContested -> "H23"
-    FannedOutUtxoHashNotEqualToClosedUtxoHash -> "H24"
-    LowerBoundBeforeContestationDeadline -> "H25"
-    FanoutNoLowerBoundDefined -> "H26"
+    -- Generic
+    InvalidHeadStateTransition -> "H1"
+    ChangedParameters -> "H2"
+    WrongStateInOutputDatum -> "H3"
+    HeadValueIsNotPreserved -> "H4"
+    SignerIsNotAParticipant -> "H5"
+    NoSigners -> "H6"
+    TooManySigners -> "H7"
+    ScriptNotSpendingAHeadInput -> "H8"
+    NoOutputDatumError -> "H9"
+    UnexpectedNonInlineDatum -> "H10"
+    NotPayingToHead -> "H11"
+    SignatureVerificationFailed -> "H12"
+    MustNotChangeVersion -> "H13"
+    -- Abort
+    BurntTokenNumberMismatch -> "H14"
+    ReimbursedOutputsDontMatch -> "H15"
+    -- Collect
+    STNotSpent -> "H16"
+    IncorrectUtxoHash -> "H17"
+    MissingCommits -> "H18"
+    NotAllValueCollected -> "H19"
+    IncorrectVersion -> "H20"
+    -- Decrement
+    VersionNotIncremented -> "H21"
+    -- Close
+    HasBoundedValidityCheckFailed -> "H22"
+    IncorrectClosedContestationDeadline -> "H23"
+    InfiniteUpperBound -> "H24"
+    InfiniteLowerBound -> "H25"
+    ContestersNonEmpty -> "H26"
     CloseNoUpperBoundDefined -> "H27"
-    ScriptNotSpendingAHeadInput -> "H28"
-    SignerIsNotAParticipant -> "H29"
-    NoSigners -> "H30"
-    TooManySigners -> "H31"
-    NoOutputDatumError -> "H32"
-    UnexpectedNonInlineDatum -> "H33"
-    SignatureVerificationFailed -> "H34"
-    NotPayingToHead -> "H35"
-    NotAllValueCollected -> "H36"
-    SnapshotNumberMismatch -> "H37"
-    IncorrectVersion -> "H38"
-    MustNotChangeVersion -> "H39"
-    FannedOutUtxoHashNotEqualToClosedUtxoHashToDecommit -> "H40"
-    FailedCloseInitial -> "H41"
-    FailedCloseCurrent -> "H42"
-    FailedCloseOutdated -> "H43"
+    FailedCloseInitial -> "H28"
+    FailedCloseCurrent -> "H29"
+    FailedCloseOutdated -> "H30"
+    -- Contest
+    TooOldSnapshot -> "H31"
+    UpperBoundBeyondContestationDeadline -> "H32"
+    ContestNoUpperBoundDefined -> "H33"
+    MustNotPushDeadline -> "H34"
+    MustPushDeadline -> "H35"
+    ContesterNotIncluded -> "H36"
+    WrongNumberOfSigners -> "H37"
+    SignerAlreadyContested -> "H38"
+    FailedContestCurrent -> "H39"
+    FailedContestOutdated -> "H40"
+    -- Fanout
+    FanoutUTxOHashMismatch -> "H41"
+    FanoutUTxOToDecommitHashMismatch -> "H42"
+    LowerBoundBeforeContestationDeadline -> "H43"
+    FanoutNoLowerBoundDefined -> "H44"