Add contest redeemer type

We followed the same logic applied for close.

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -458,11 +458,16 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
                     , utxoToDecommit = Just toDecommit
                     , version = 0
                     }
-            postTx . ContestTx headId headParameters $
-              ConfirmedSnapshot
-                { snapshot = snapshot1
-                , signatures = aggregate [sign aliceSk snapshot1]
-                }
+            postTx $
+              ContestTx
+                headId
+                headParameters
+                ( ConfirmedSnapshot
+                    { snapshot = snapshot1
+                    , signatures = aggregate [sign aliceSk snapshot1]
+                    }
+                )
+                0
             aliceChain `observesInTime` OnContestTx{headId, snapshotNumber = 1, contestationDeadline = deadline}
 
             -- Alice contests with some snapshot U2 -> expect fail
@@ -476,11 +481,16 @@ spec = around (showLogsOnFailure "DirectChainSpec") $ do
                     , version = 1
                     }
             let contestAgain =
-                  postTx . ContestTx headId headParameters $
-                    ConfirmedSnapshot
-                      { snapshot = snapshot2
-                      , signatures = aggregate [sign aliceSk snapshot2]
-                      }
+                  postTx $
+                    ContestTx
+                      headId
+                      headParameters
+                      ( ConfirmedSnapshot
+                          { snapshot = snapshot2
+                          , signatures = aggregate [sign aliceSk snapshot2]
+                          }
+                      )
+                      1
             -- NOTE: We deliberately expect the transaction creation and
             -- submission code of the Chain.Direct module to fail here because
             -- the scripts don't validate. That is, the on-chain code prevented

hydra-node/src/Hydra/Chain.hs

@@ -73,8 +73,20 @@ data PostChainTx tx
       , snapshot :: Snapshot tx
       , signatures :: MultiSignature (Snapshot tx)
       }
-  | CloseTx {headId :: HeadId, headParameters :: HeadParameters, confirmedSnapshot :: ConfirmedSnapshot tx, version :: SnapshotVersion, closeUTxOToDecommit :: UTxOType tx}
-  | ContestTx {headId :: HeadId, headParameters :: HeadParameters, confirmedSnapshot :: ConfirmedSnapshot tx}
+  | CloseTx
+      { headId :: HeadId
+      , headParameters :: HeadParameters
+      , confirmedSnapshot :: ConfirmedSnapshot tx
+      , version :: SnapshotVersion
+      , -- REVIEW: remove it?
+        closeUTxOToDecommit :: UTxOType tx
+      }
+  | ContestTx
+      { headId :: HeadId
+      , headParameters :: HeadParameters
+      , confirmedSnapshot :: ConfirmedSnapshot tx
+      , version :: SnapshotVersion
+      }
   | FanoutTx {utxo :: UTxOType tx, utxoToDecommit :: Maybe (UTxOType tx), headSeed :: HeadSeed, contestationDeadline :: UTCTime}
   deriving stock (Generic)
 
@@ -92,7 +104,7 @@ instance IsTx tx => Arbitrary (PostChainTx tx) where
     DecrementTx{headId, headParameters, snapshot, signatures} ->
       DecrementTx <$> shrink headId <*> shrink headParameters <*> shrink snapshot <*> shrink signatures
     CloseTx{headId, headParameters, confirmedSnapshot, version, closeUTxOToDecommit} -> CloseTx <$> shrink headId <*> shrink headParameters <*> shrink confirmedSnapshot <*> shrink version <*> shrink closeUTxOToDecommit
-    ContestTx{headId, headParameters, confirmedSnapshot} -> ContestTx <$> shrink headId <*> shrink headParameters <*> shrink confirmedSnapshot
+    ContestTx{headId, headParameters, confirmedSnapshot, version} -> ContestTx <$> shrink headId <*> shrink headParameters <*> shrink confirmedSnapshot <*> shrink version
     FanoutTx{utxo, utxoToDecommit, headSeed, contestationDeadline} -> FanoutTx <$> shrink utxo <*> shrink utxoToDecommit <*> shrink headSeed <*> shrink contestationDeadline
 
 -- | Describes transactions as seen on chain. Holds as minimal information as

hydra-node/src/Hydra/Chain/Direct/Handlers.hs

@@ -382,11 +382,11 @@ prepareTxToPost timeHandle wallet ctx spendableUTxO tx =
       case close ctx spendableUTxO headId headParameters confirmedSnapshot currentSlot upperBound version of
         Left _ -> throwIO (FailedToConstructCloseTx @Tx)
         Right closeTx -> pure closeTx
-    ContestTx{headId, headParameters, confirmedSnapshot} -> do
+    ContestTx{headId, headParameters, confirmedSnapshot, version} -> do
       (_, currentTime) <- throwLeft currentPointInTime
       let HeadParameters{contestationPeriod} = headParameters
       upperBound <- calculateTxUpperBoundFromContestationPeriod currentTime contestationPeriod
-      case contest ctx spendableUTxO headId contestationPeriod confirmedSnapshot upperBound of
+      case contest ctx spendableUTxO headId contestationPeriod confirmedSnapshot upperBound version of
         Left _ -> throwIO (FailedToConstructContestTx @Tx)
         Right contestTx -> pure contestTx
     FanoutTx{utxo, utxoToDecommit, headSeed, contestationDeadline} -> do

hydra-node/src/Hydra/Chain/Direct/State.hs

@@ -561,14 +561,15 @@ contest ::
   ConfirmedSnapshot Tx ->
   -- | Current slot and posix time to be used as the contestation time.
   PointInTime ->
+  SnapshotVersion ->
   Either ContestTxError Tx
-contest ctx spendableUTxO headId contestationPeriod confirmedSnapshot pointInTime = do
+contest ctx spendableUTxO headId contestationPeriod confirmedSnapshot pointInTime offChainVersion = do
   pid <- headIdToPolicyId headId ?> InvalidHeadIdInContest{headId}
   headUTxO <-
     UTxO.find (isScriptTxOut headScript) (utxoOfThisHead pid spendableUTxO)
       ?> CannotFindHeadOutputToContest
   closedThreadOutput <- checkHeadDatum headUTxO
-  pure $ contestTx scriptRegistry ownVerificationKey sn sigs pointInTime closedThreadOutput headId contestationPeriod
+  pure $ contestTx scriptRegistry ownVerificationKey sn sigs pointInTime closedThreadOutput headId contestationPeriod offChainVersion
  where
   checkHeadDatum headUTxO@(_, headOutput) = do
     headDatum <- txOutScriptData (toTxContext headOutput) ?> MissingHeadDatumInContest
@@ -1066,19 +1067,20 @@ genContestTx = do
   ctx <- genHydraContextFor maximumNumberOfParties
   (u0, stOpen@OpenState{headId}) <- genStOpen ctx
   let (confirmedUtXO, utxoToDecommit) = splitUTxO u0
-  confirmed <- genConfirmedSnapshot headId 1 1 confirmedUtXO (Just utxoToDecommit) []
+  let version = 1
+  confirmed <- genConfirmedSnapshot headId 1 version confirmedUtXO (Just utxoToDecommit) []
   cctx <- pickChainContext ctx
   let cp = ctxContestationPeriod ctx
   (startSlot, closePointInTime) <- genValidityBoundsFromContestationPeriod cp
   let openUTxO = getKnownUTxO stOpen
-  let txClose = unsafeClose cctx openUTxO headId (ctxHeadParameters ctx) confirmed startSlot closePointInTime 1
+  let txClose = unsafeClose cctx openUTxO headId (ctxHeadParameters ctx) confirmed startSlot closePointInTime version
   let stClosed = snd $ fromJust $ observeClose stOpen txClose
   let utxo = getKnownUTxO stClosed
   someUtxo <- genUTxO1 genTxOut
   let (confirmedUTxO', utxoToDecommit') = splitUTxO someUtxo
-  contestSnapshot <- genConfirmedSnapshot headId (succ $ number $ getSnapshot confirmed) 1 confirmedUTxO' (Just utxoToDecommit') (ctxHydraSigningKeys ctx)
+  contestSnapshot <- genConfirmedSnapshot headId (succ $ number $ getSnapshot confirmed) version confirmedUTxO' (Just utxoToDecommit') (ctxHydraSigningKeys ctx)
   contestPointInTime <- genPointInTimeBefore (getContestationDeadline stClosed)
-  pure (ctx, closePointInTime, stClosed, unsafeContest cctx utxo headId cp contestSnapshot contestPointInTime)
+  pure (ctx, closePointInTime, stClosed, unsafeContest cctx utxo headId cp contestSnapshot contestPointInTime version)
 
 genFanoutTx :: Int -> Int -> Gen (HydraContext, ClosedState, Tx)
 genFanoutTx numParties numOutputs = do
@@ -1222,9 +1224,10 @@ unsafeContest ::
   ContestationPeriod ->
   ConfirmedSnapshot Tx ->
   PointInTime ->
+  SnapshotVersion ->
   Tx
-unsafeContest ctx spendableUTxO headId contestationPeriod confirmedSnapshot pointInTime =
-  either (error . show) id $ contest ctx spendableUTxO headId contestationPeriod confirmedSnapshot pointInTime
+unsafeContest ctx spendableUTxO headId contestationPeriod confirmedSnapshot pointInTime version =
+  either (error . show) id $ contest ctx spendableUTxO headId contestationPeriod confirmedSnapshot pointInTime version
 
 unsafeFanout ::
   HasCallStack =>

hydra-node/src/Hydra/Chain/Direct/Tx.hs

@@ -633,8 +633,9 @@ contestTx ::
   ClosedThreadOutput ->
   HeadId ->
   ContestationPeriod ->
+  SnapshotVersion ->
   Tx
-contestTx scriptRegistry vk Snapshot{number, utxo, utxoToDecommit, version} sig (slotNo, _) closedThreadOutput headId contestationPeriod =
+contestTx scriptRegistry vk Snapshot{number, utxo, utxoToDecommit, version} sig (slotNo, _) closedThreadOutput headId contestationPeriod offChainVersion =
   unsafeBuildTransaction $
     emptyTxBody
       & addInputs [(headInput, headWitness)]
@@ -655,14 +656,31 @@ contestTx scriptRegistry vk Snapshot{number, utxo, utxoToDecommit, version} sig
     BuildTxWith $
       ScriptWitness scriptWitnessInCtx $
         mkScriptReference headScriptRef headScript InlineScriptDatum headRedeemer
+
   headScriptRef =
     fst (headReference scriptRegistry)
+
   headScript =
     fromPlutusScript @PlutusScriptV2 Head.validatorScript
+
+  closeVersion
+    | offChainVersion == version = Head.CurrentVersion
+    | offChainVersion == version + 1 = Head.OutdatedVersion
+    | otherwise = Head.InitialVersion
+
   headRedeemer =
     toScriptData
       Head.Contest
         { signature = toPlutusSignatures sig
+        , version = closeVersion
+        , utxoToDecommitHash =
+            case closeVersion of
+              Head.CurrentVersion ->
+                toBuiltin $ hashUTxO @Tx mempty
+              Head.OutdatedVersion ->
+                utxoToDecommitHash
+              Head.InitialVersion ->
+                toBuiltin $ hashUTxO @Tx mempty
         }
   headOutputAfter =
     modifyTxOutDatum (const headDatumAfter) headOutputBefore
@@ -687,7 +705,7 @@ contestTx scriptRegistry vk Snapshot{number, utxo, utxoToDecommit, version} sig
         , contestationPeriod = onChainConstestationPeriod
         , headId = headIdToCurrencySymbol headId
         , contesters = contester : closedContesters
-        , version = toInteger version -- TODO: should version here come from a Snapshot or previous datum?
+        , version = toInteger version
         }
   utxoHash = toBuiltin $ hashUTxO @Tx utxo
 

hydra-node/src/Hydra/HeadLogic.hs

@@ -776,7 +776,7 @@ onOpenChainCloseTx openState newChainState closedSnapshotNumber contestationDead
     <> causes
       ( notifyClient
           : [ OnChainEffect
-              { postChainTx = ContestTx{headId, headParameters, confirmedSnapshot}
+              { postChainTx = ContestTx{headId, headParameters, confirmedSnapshot, version}
               }
             | doContest
             ]
@@ -793,7 +793,7 @@ onOpenChainCloseTx openState newChainState closedSnapshotNumber contestationDead
         , contestationDeadline
         }
 
-  CoordinatedHeadState{confirmedSnapshot} = coordinatedHeadState
+  CoordinatedHeadState{confirmedSnapshot, version} = coordinatedHeadState
 
   OpenState{parameters = headParameters, headId, coordinatedHeadState} = openState
 
@@ -815,7 +815,7 @@ onClosedChainContestTx closedState newChainState snapshotNumber contestationDead
     <> if
       | snapshotNumber < number (getSnapshot confirmedSnapshot) ->
           cause notifyClients
-            <> cause OnChainEffect{postChainTx = ContestTx{headId, headParameters, confirmedSnapshot}}
+            <> cause OnChainEffect{postChainTx = ContestTx{headId, headParameters, confirmedSnapshot, version}}
       | snapshotNumber > number (getSnapshot confirmedSnapshot) ->
           -- TODO: A more recent snapshot number was succesfully contested, we will
           -- not be able to fanout! We might want to communicate that to the client!
@@ -831,7 +831,7 @@ onClosedChainContestTx closedState newChainState snapshotNumber contestationDead
         , contestationDeadline
         }
 
-  ClosedState{parameters = headParameters, confirmedSnapshot, headId} = closedState
+  ClosedState{parameters = headParameters, confirmedSnapshot, headId, version} = closedState
 
 -- | Client request to fanout leads to a fanout transaction on chain using the
 -- latest confirmed snapshot from 'ClosedState'.

hydra-node/test/Hydra/Chain/Direct/Contract/Contest/ContestCurrent.hs

@@ -79,6 +79,7 @@ healthyContestTx =
       closedThreadOutput
       (mkHeadId testPolicyId)
       healthyContestationPeriod
+      healthyCloseSnapshotVersion
 
   scriptRegistry = genScriptRegistry `generateWith` 42
 
@@ -291,15 +292,19 @@ genContestMutation (tx, _utxo) =
         pure $ ChangeOutput 0 (modifyTxOutAddress (const mutatedAddress) headTxOut)
     , SomeMutation (pure $ toErrorCode SignatureVerificationFailed) MutateSignatureButNotSnapshotNumber . ChangeHeadRedeemer <$> do
         mutatedSignature <- arbitrary :: Gen (MultiSignature (Snapshot Tx))
+        let expectedHash = toBuiltin $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthyContestSnapshot)
         pure $
           Head.Contest
             { signature = toPlutusSignatures mutatedSignature
+            , version = Head.CurrentVersion
+            , utxoToDecommitHash = expectedHash
             }
     , SomeMutation (pure $ toErrorCode SignatureVerificationFailed) MutateSnapshotNumberButNotSignature <$> do
         mutatedSnapshotNumber <- arbitrarySizedNatural `suchThat` (> healthyContestSnapshotNumber)
         pure $ ChangeOutput 0 $ modifyInlineDatum (replaceSnapshotNumber $ toInteger mutatedSnapshotNumber) headTxOut
     , SomeMutation (pure $ toErrorCode TooOldSnapshot) MutateToNonNewerSnapshot <$> do
         mutatedSnapshotNumber <- choose (toInteger healthyContestSnapshotNumber, toInteger healthyContestSnapshotNumber + 1)
+        let expectedHash = toBuiltin $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthyContestSnapshot)
         pure $
           Changes
             [ ChangeInputHeadDatum $
@@ -309,6 +314,8 @@ genContestMutation (tx, _utxo) =
                   { signature =
                       toPlutusSignatures $
                         healthySignature (fromInteger mutatedSnapshotNumber)
+                  , version = Head.CurrentVersion
+                  , utxoToDecommitHash = expectedHash
                   }
             ]
     , SomeMutation (pure $ toErrorCode SignerIsNotAParticipant) MutateRequiredSigner <$> do
@@ -344,6 +351,7 @@ genContestMutation (tx, _utxo) =
       -- This also seems to be covered by MutateRequiredSigner
       SomeMutation (pure $ toErrorCode SignerIsNotAParticipant) ContestFromDifferentHead <$> do
         otherHeadId <- headPolicyId <$> arbitrary `suchThat` (/= healthyClosedHeadTxIn)
+        let expectedHash = toBuiltin $ hashUTxO @Tx (fromMaybe mempty $ utxoToDecommit healthyContestSnapshot)
         pure $
           Changes
             [ ChangeOutput 0 (replacePolicyIdWith testPolicyId otherHeadId headTxOut)
@@ -356,6 +364,8 @@ genContestMutation (tx, _utxo) =
                           { signature =
                               toPlutusSignatures $
                                 healthySignature healthyContestSnapshotNumber
+                          , version = Head.CurrentVersion
+                          , utxoToDecommitHash = expectedHash
                           }
                       )
                 )

hydra-node/test/Hydra/Chain/Direct/TxSpec.hs

@@ -468,7 +468,7 @@ produceContest ::
   ([Bool], UTxO, Snapshot Tx, MultiSignature (Snapshot Tx)) ->
   ([Bool], UTxO, Snapshot Tx, MultiSignature (Snapshot Tx))
 produceContest ctx scriptRegistry headId (p, spendableUTxO, snapshot, signatures) = do
-  case contest ctx spendableUTxO headId defaultContestationPeriod ConfirmedSnapshot{snapshot, signatures} (0, posixSecondsToUTCTime 0) of
+  case contest ctx spendableUTxO headId defaultContestationPeriod ConfirmedSnapshot{snapshot, signatures} (0, posixSecondsToUTCTime 0) (version snapshot) of
     Left _ -> (p <> [False], spendableUTxO, snapshot, signatures)
     Right tx ->
       ( p <> [evaluateTransaction tx spendableUTxO]

hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs

@@ -772,6 +772,7 @@ newContestTx actor snapshot = do
       Fixture.cperiod
       snapshot
       currentTime
+      (version (getSnapshot snapshot))
  where
   currentTime = (0, posixSecondsToUTCTime 0)
 

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -549,7 +549,8 @@ spec =
           lift $ outcome2 `hasEffect` ClientEffect (ReadyToFanout testHeadId)
 
       it "contests when detecting close with old snapshot" $ do
-        let snapshot = testSnapshot 2 0 mempty []
+        let snapshotVersion = 0
+            snapshot = testSnapshot 2 snapshotVersion mempty []
             latestConfirmedSnapshot = ConfirmedSnapshot snapshot (Crypto.aggregate [])
             s0 =
               inOpenState' threeParties $
@@ -558,21 +559,22 @@ spec =
             params = fromMaybe (HeadParameters defaultContestationPeriod threeParties) (getHeadParameters s0)
         runHeadLogic bobEnv ledger s0 $ do
           o1 <- step $ observeTx (OnCloseTx testHeadId 0 deadline)
-          lift $ o1 `hasEffect` chainEffect (ContestTx testHeadId params latestConfirmedSnapshot)
+          lift $ o1 `hasEffect` chainEffect (ContestTx testHeadId params latestConfirmedSnapshot snapshotVersion)
           s1 <- getState
           lift $
             s1 `shouldSatisfy` \case
               Closed ClosedState{} -> True
               _ -> False
 
       it "re-contests when detecting contest with old snapshot" $ do
-        let snapshot2 = testSnapshot 2 0 mempty []
+        let snapshotVersion = 0
+            snapshot2 = testSnapshot 2 snapshotVersion mempty []
             latestConfirmedSnapshot = ConfirmedSnapshot snapshot2 (Crypto.aggregate [])
             s0 = inClosedState' threeParties latestConfirmedSnapshot
             deadline = arbitrary `generateWith` 42
             params = fromMaybe (HeadParameters defaultContestationPeriod threeParties) (getHeadParameters s0)
         update bobEnv ledger s0 (observeTx $ OnContestTx testHeadId 1 deadline)
-          `hasEffect` chainEffect (ContestTx testHeadId params latestConfirmedSnapshot)
+          `hasEffect` chainEffect (ContestTx testHeadId params latestConfirmedSnapshot snapshotVersion)
 
       it "ignores unrelated initTx" prop_ignoresUnrelatedOnInitTx