Add checkSnapshot to checkDecrement

Make sure the mutation of the snapshot number is successfull
input-output-hk · May 7, 2024 · 7f4780b · 7f4780b
1 parent 60b0f0d
commit 7f4780b
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 9 deletions.
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Decrement.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Decrement.hs
@@ -8,7 +8,7 @@ import Hydra.Chain.Direct.Contract.Mutation (
   SomeMutation (..),
   modifyInlineDatum,
   replaceParties,
-  replaceSnapshotNumber,
+  replaceSnapshotNumberInOpen,
  )
 import Hydra.Prelude hiding (label)
 
@@ -97,7 +97,7 @@ healthySnapshot =
   let (utxoToDecommit', utxo) = splitDecommitUTxO healthyUTxO
    in Snapshot
         { headId = mkHeadId testPolicyId
-        , number = healthySnapshotNumber
+        , number = succ healthySnapshotNumber
         , utxo
         , confirmed = []
         , utxoToDecommit = Just utxoToDecommit'
@@ -161,9 +161,9 @@ genDecrementMutation (tx, _utxo) =
     [ SomeMutation (Just $ toErrorCode ChangedParameters) MutatePartiesInOutput <$> do
         mutatedParties <- arbitrary `suchThat` (/= healthyOnChainParties)
         pure $ ChangeOutput 0 $ modifyInlineDatum (replaceParties mutatedParties) headTxOut
-    , SomeMutation (Just "H38") MutateSnapshotNumber <$> do
-        mutatedSnapshotNumber <- arbitrarySizedNatural `suchThat` (/= healthySnapshotNumber)
-        pure $ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotNumber $ toInteger mutatedSnapshotNumber) headTxOut
+    , SomeMutation (Just $ toErrorCode SnapshotNumberMismatch) MutateSnapshotNumber <$> do
+        mutatedSnapshotNumber <- arbitrarySizedNatural `suchThat` (< healthySnapshotNumber)
+        pure $ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotNumberInOpen $ toInteger mutatedSnapshotNumber) headTxOut
     ]
  where
   headTxOut = fromJust $ txOuts' tx !!? 0
diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Mutation.hs
@@ -734,6 +734,17 @@ replacePolicyInValue original replacement =
       | pid == original -> (AssetId replacement an, q)
     _ -> (aid, q)
 
+replaceSnapshotNumberInOpen :: Head.SnapshotNumber -> Head.State -> Head.State
+replaceSnapshotNumberInOpen snapshotNumber = \case
+  Head.Open{parties, utxoHash, headId, contestationPeriod} ->
+    Head.Open
+      { Head.parties = parties
+      , Head.snapshotNumber = snapshotNumber
+      , Head.utxoHash = utxoHash
+      , Head.contestationPeriod = contestationPeriod
+      , Head.headId = headId
+      }
+  otherState -> otherState
 replaceSnapshotNumber :: Head.SnapshotNumber -> Head.State -> Head.State
 replaceSnapshotNumber snapshotNumber = \case
   Head.Closed{parties, utxoHash, utxoToDecommitHash, contestationDeadline, headId, contesters, contestationPeriod} ->

diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs
@@ -73,7 +73,7 @@ headValidator oldState input ctx =
       checkCollectCom ctx (contestationPeriod, parties, headId)
     (Initial{parties, headId}, Abort) ->
       checkAbort ctx headId parties
-    (Open{parties, contestationPeriod, headId}, Decrement{}) -> checkDecrement ctx parties contestationPeriod headId
+    (Open{parties, contestationPeriod, snapshotNumber, headId}, Decrement{signature}) -> checkDecrement ctx parties snapshotNumber contestationPeriod headId signature
     (Open{parties, utxoHash = initialUtxoHash, contestationPeriod, headId}, Close{signature}) ->
       checkClose ctx parties initialUtxoHash signature contestationPeriod headId
     (Closed{parties, snapshotNumber = closedSnapshotNumber, contestationDeadline, contestationPeriod, headId, contesters}, Contest{signature}) ->
@@ -230,28 +230,36 @@ commitDatum input = do
 checkDecrement ::
   ScriptContext ->
   [Party] ->
+  SnapshotNumber ->
   ContestationPeriod ->
   CurrencySymbol ->
+  [Signature] ->
   Bool
-checkDecrement ctx parties cperiod headPolicyId =
+checkDecrement ctx parties snapshotNumber cperiod headPolicyId _signature =
   mustNotChangeParameters
+    && checkSnapshot
  where
-  (_, parties', cperiod', headId') =
+  (_, parties', snapshotNumber', cperiod', headId') =
     case fromBuiltinData @DatumType $ getDatum (headOutputDatum ctx) of
       Just
         Open
           { utxoHash
           , parties = p
           , headId
           , contestationPeriod
-          } -> (utxoHash, p, contestationPeriod, headId)
+          , snapshotNumber = sn
+          } -> (utxoHash, p, sn, contestationPeriod, headId)
       _ -> traceError $(errorCode WrongStateInOutputDatum)
 
   mustNotChangeParameters =
     traceIfFalse $(errorCode ChangedParameters) $
       headId' == headPolicyId
         && parties' == parties
         && cperiod' == cperiod
+
+  checkSnapshot =
+    traceIfFalse $(errorCode SnapshotNumberMismatch) $
+      snapshotNumber' > snapshotNumber
 {-# INLINEABLE checkDecrement #-}
 
 -- | The close validator must verify that:

diff --git a/hydra-plutus/src/Hydra/Contract/HeadError.hs b/hydra-plutus/src/Hydra/Contract/HeadError.hs
@@ -44,6 +44,7 @@ data HeadError
   | PartySignatureVerificationFailed
   | NotPayingToHead
   | NotAllValueCollected
+  | SnapshotNumberMismatch
   deriving stock (Show)
 
 instance ToErrorCode HeadError where
@@ -85,3 +86,4 @@ instance ToErrorCode HeadError where
     PartySignatureVerificationFailed -> "H35"
     NotPayingToHead -> "H36"
     NotAllValueCollected -> "H37"
+    SnapshotNumberMismatch -> "H38"