Add utxoToCommit and alphaUTxOHash to Snapshot and Closed datum

respectively

Signed-off-by: Sasha Bogicevic <[email protected]>

hydra-node/bench/tx-cost/TxCost.hs

@@ -186,7 +186,7 @@ computeContestCost = do
     utxo <- arbitrary
     (closedSnapshotNumber, _, _, stClosed@ClosedState{headId}) <- genStClosed ctx utxo mempty
     cctx <- pickChainContext ctx
-    snapshot <- genConfirmedSnapshot headId 0 (succ closedSnapshotNumber) utxo mempty (ctxHydraSigningKeys ctx)
+    snapshot <- genConfirmedSnapshot headId 0 (succ closedSnapshotNumber) utxo Nothing mempty (ctxHydraSigningKeys ctx)
     pointInTime <- genPointInTimeBefore (getContestationDeadline stClosed)
     let cp = ctxContestationPeriod ctx
     let contestUtxo = getKnownUTxO stClosed <> getKnownUTxO cctx
@@ -242,7 +242,7 @@ computeFanOutCost = do
     utxo <- genUTxOAdaOnlyOfSize numOutputs
     ctx <- genHydraContextFor numParties
     (_committed, stOpen@OpenState{headId, seedTxIn}) <- genStOpen ctx
-    snapshot <- genConfirmedSnapshot headId 0 1 utxo mempty [] -- We do not validate the signatures
+    snapshot <- genConfirmedSnapshot headId 0 1 utxo Nothing mempty [] -- We do not validate the signatures
     cctx <- pickChainContext ctx
     let cp = ctxContestationPeriod ctx
     (startSlot, closePoint) <- genValidityBoundsFromContestationPeriod cp

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

@@ -1095,7 +1095,7 @@ genDecrementTx numParties = do
   cctx <- pickChainContext ctx
   let (confirmedUtxo, toDecommit) = splitUTxO u0
   let version = 0
-  snapshot <- genConfirmedSnapshot headId version 1 confirmedUtxo (Just toDecommit) (ctxHydraSigningKeys ctx)
+  snapshot <- genConfirmedSnapshot headId version 1 confirmedUtxo Nothing (Just toDecommit) (ctxHydraSigningKeys ctx)
   let openUTxO = getKnownUTxO stOpen
   pure
     ( cctx
@@ -1110,7 +1110,7 @@ genCloseTx numParties = do
   (u0, stOpen@OpenState{headId}) <- genStOpen ctx
   let (confirmedUtxo, utxoToDecommit) = splitUTxO u0
   let version = 0
-  snapshot <- genConfirmedSnapshot headId version 1 confirmedUtxo (Just utxoToDecommit) (ctxHydraSigningKeys ctx)
+  snapshot <- genConfirmedSnapshot headId version 1 confirmedUtxo Nothing (Just utxoToDecommit) (ctxHydraSigningKeys ctx)
   cctx <- pickChainContext ctx
   let cp = ctxContestationPeriod ctx
   (startSlot, pointInTime) <- genValidityBoundsFromContestationPeriod cp
@@ -1123,7 +1123,7 @@ genContestTx = do
   (u0, stOpen@OpenState{headId}) <- genStOpen ctx
   let (confirmedUtXO, utxoToDecommit) = splitUTxO u0
   let version = 1
-  confirmed <- genConfirmedSnapshot headId version 1 confirmedUtXO (Just utxoToDecommit) []
+  confirmed <- genConfirmedSnapshot headId version 1 confirmedUtXO Nothing (Just utxoToDecommit) []
   cctx <- pickChainContext ctx
   let cp = ctxContestationPeriod ctx
   (startSlot, closePointInTime) <- genValidityBoundsFromContestationPeriod cp
@@ -1133,7 +1133,7 @@ genContestTx = do
   let utxo = getKnownUTxO stClosed
   someUtxo <- genUTxO1 genTxOut
   let (confirmedUTxO', utxoToDecommit') = splitUTxO someUtxo
-  contestSnapshot <- genConfirmedSnapshot headId version (succ $ number $ getSnapshot confirmed) confirmedUTxO' (Just utxoToDecommit') (ctxHydraSigningKeys ctx)
+  contestSnapshot <- genConfirmedSnapshot headId version (succ $ number $ getSnapshot confirmed) confirmedUTxO' Nothing (Just utxoToDecommit') (ctxHydraSigningKeys ctx)
   contestPointInTime <- genPointInTimeBefore (getContestationDeadline stClosed)
   pure (ctx, closePointInTime, stClosed, unsafeContest cctx utxo headId cp version contestSnapshot contestPointInTime)
 

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -244,7 +244,7 @@ spec = parallel $ do
                 send n1 (NewTx $ aValidTx 42)
                 waitUntil [n1, n2] $ TxValid testHeadId (aValidTx 42)
 
-                let snapshot = Snapshot testHeadId 0 1 [42] (utxoRefs [1, 2, 42]) mempty
+                let snapshot = Snapshot testHeadId 0 1 [42] (utxoRefs [1, 2, 42]) mempty mempty
                     sigs = aggregate [sign aliceSk snapshot, sign bobSk snapshot]
                 waitUntil [n1] $ SnapshotConfirmed testHeadId snapshot sigs
 

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

@@ -676,6 +676,7 @@ signedSnapshot ms =
       , number = ms.number
       , confirmed = []
       , utxo
+      , utxoToCommit = Nothing
       , utxoToDecommit = Just toDecommit
       }
 

hydra-node/test/Hydra/HeadLogicSnapshotSpec.hs

@@ -70,7 +70,7 @@ spec = do
     let sendReqSn = \case
           NetworkEffect ReqSn{} -> True
           _ -> False
-    let snapshot1 = Snapshot testHeadId 0 1 [] mempty Nothing
+    let snapshot1 = Snapshot testHeadId 0 1 [] mempty Nothing Nothing
 
     let ackFrom sk vk = receiveMessageFrom vk $ AckSn (sign sk snapshot1) 1
 
@@ -96,7 +96,7 @@ spec = do
 
       it "does NOT send ReqSn when we are the leader but snapshot in flight" $ do
         let tx = aValidTx 1
-            sn1 = Snapshot testHeadId 1 1 [] u0 Nothing :: Snapshot SimpleTx
+            sn1 = Snapshot testHeadId 1 1 [] u0 Nothing Nothing :: Snapshot SimpleTx
             st = coordinatedHeadState{seenSnapshot = SeenSnapshot sn1 mempty}
             outcome = update (envFor aliceSk) simpleLedger (inOpenState' [alice, bob] st) $ receiveMessage $ ReqTx tx
 

hydra-node/test/Hydra/HeadLogicSpec.hs

@@ -121,7 +121,7 @@ spec =
 
       it "confirms snapshot given it receives AckSn from all parties" $ do
         let reqSn = receiveMessage $ ReqSn 0 1 [] Nothing Nothing
-            snapshot1 = Snapshot testHeadId 0 1 [] mempty Nothing
+            snapshot1 = Snapshot testHeadId 0 1 [] mempty Nothing Nothing
             ackFrom sk vk = receiveMessageFrom vk $ AckSn (sign sk snapshot1) 1
         snapshotInProgress <- runHeadLogic bobEnv ledger (inOpenState threeParties) $ do
           step reqSn

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

@@ -15,7 +15,7 @@ import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV2))
 import Hydra.Contract.Commit (Commit (..))
 import Hydra.Contract.Commit qualified as Commit
 import Hydra.Contract.HeadError (HeadError (..), errorCode)
-import Hydra.Contract.HeadState (CloseRedeemer (..), ClosedDatum (..), ContestRedeemer (..), DecrementRedeemer (..), Hash, Input (..), OpenDatum (..), Signature, SnapshotNumber, SnapshotVersion, State (..), IncrementRedeemer)
+import Hydra.Contract.HeadState (CloseRedeemer (..), ClosedDatum (..), ContestRedeemer (..), DecrementRedeemer (..), Hash, IncrementRedeemer, Input (..), OpenDatum (..), Signature, SnapshotNumber, SnapshotVersion, State (..))
 import Hydra.Contract.Util (hasST, mustBurnAllHeadTokens, mustNotMintOrBurn, (===))
 import Hydra.Data.ContestationPeriod (ContestationPeriod, addContestationPeriod, milliseconds)
 import Hydra.Data.Party (Party (vkey))
@@ -52,6 +52,7 @@ import PlutusTx (CompiledCode)
 import PlutusTx qualified
 import PlutusTx.AssocMap qualified as AssocMap
 import PlutusTx.Builtins qualified as Builtins
+import Test.QuickCheck.Text (number)
 
 type DatumType = State
 type RedeemerType = Input
@@ -248,7 +249,8 @@ checkDecrement ctx openBefore redeemer =
     && mustBeSignedByParticipant ctx prevHeadId
  where
   checkSnapshotSignature =
-    verifySnapshotSignature nextParties (nextHeadId, prevVersion, snapshotNumber, nextUtxoHash, decommitUtxoHash) signature
+    -- TODO: introduce emptyHash instead of hashTxOuts [] ?
+    verifySnapshotSignature nextParties (nextHeadId, prevVersion, snapshotNumber, nextUtxoHash, hashTxOuts [], decommitUtxoHash) signature
 
   mustDecreaseValue =
     traceIfFalse $(errorCode HeadValueIsNotPreserved) $
@@ -332,6 +334,7 @@ checkClose ctx openBefore redeemer =
   ClosedDatum
     { snapshotNumber = snapshotNumber'
     , utxoHash = utxoHash'
+    , alphaUTxOHash = alphaUTxOHash'
     , deltaUTxOHash = deltaUTxOHash'
     , parties = parties'
     , contestationDeadline = deadline
@@ -356,14 +359,14 @@ checkClose ctx openBefore redeemer =
         traceIfFalse $(errorCode FailedCloseCurrent) $
           verifySnapshotSignature
             parties
-            (headId, version, snapshotNumber', utxoHash', deltaUTxOHash')
+            (headId, version, snapshotNumber', utxoHash', alphaUTxOHash', deltaUTxOHash')
             signature
       CloseUsed{signature, alreadyDecommittedUTxOHash} ->
         traceIfFalse $(errorCode FailedCloseOutdated) $
           deltaUTxOHash' == hashTxOuts mempty
             && verifySnapshotSignature
               parties
-              (headId, version - 1, snapshotNumber', utxoHash', alreadyDecommittedUTxOHash)
+              (headId, version - 1, snapshotNumber', utxoHash', alphaUTxOHash', alreadyDecommittedUTxOHash)
               signature
 
   checkDeadline =
@@ -430,14 +433,14 @@ checkContest ctx closedDatum redeemer =
         traceIfFalse $(errorCode FailedContestCurrent) $
           verifySnapshotSignature
             parties
-            (headId, version, snapshotNumber', utxoHash', deltaUTxOHash')
+            (headId, version, snapshotNumber', utxoHash', alphaUTxOHash', deltaUTxOHash')
             signature
       ContestOutdated{signature, alreadyDecommittedUTxOHash} ->
         traceIfFalse $(errorCode FailedContestOutdated) $
           deltaUTxOHash' == hashTxOuts mempty
             && verifySnapshotSignature
               parties
-              (headId, version - 1, snapshotNumber', utxoHash', alreadyDecommittedUTxOHash)
+              (headId, version - 1, snapshotNumber', utxoHash', alphaUTxOHash', alreadyDecommittedUTxOHash)
               signature
 
   mustBeWithinContestationPeriod =
@@ -473,6 +476,7 @@ checkContest ctx closedDatum redeemer =
   ClosedDatum
     { snapshotNumber = snapshotNumber'
     , utxoHash = utxoHash'
+    , alphaUTxOHash = alphaUTxOHash'
     , deltaUTxOHash = deltaUTxOHash'
     , parties = parties'
     , contestationDeadline = contestationDeadline'
@@ -516,15 +520,24 @@ checkFanout ScriptContext{scriptContextTxInfo = txInfo} closedDatum numberOfFano
     traceIfFalse $(errorCode FanoutUTxOHashMismatch) $
       fannedOutUtxoHash == utxoHash
 
+  hasSameUTxOToCommitHash =
+    traceIfFalse $(errorCode FanoutUTxOToCommitHashMismatch) $
+      alphaUTxOHash == commitUtxoHash
+
   hasSameUTxOToDecommitHash =
     traceIfFalse $(errorCode FanoutUTxOToDecommitHashMismatch) $
       deltaUTxOHash == decommitUtxoHash
 
   fannedOutUtxoHash = hashTxOuts $ take numberOfFanoutOutputs txInfoOutputs
 
+  -- TODO: get the numberOfCommitOutputs number from the redeemer
+  numberOfCommitOutputs = 0
+
+  commitUtxoHash = hashTxOuts $ take numberOfCommitOutputs $ drop numberOfFanoutOutputs txInfoOutputs
+
   decommitUtxoHash = hashTxOuts $ take numberOfDecommitOutputs $ drop numberOfFanoutOutputs txInfoOutputs
 
-  ClosedDatum{utxoHash, deltaUTxOHash, parties, headId, contestationDeadline} = closedDatum
+  ClosedDatum{utxoHash, alphaUTxOHash, deltaUTxOHash, parties, headId, contestationDeadline} = closedDatum
 
   TxInfo{txInfoOutputs} = txInfo
 
@@ -667,7 +680,7 @@ hasPT headCurrencySymbol txOut =
 -- | Verify the multi-signature of a snapshot using given constituents 'headId',
 -- 'version', 'number', 'utxoHash' and 'utxoToDecommitHash'. See
 -- 'SignableRepresentation Snapshot' for more details.
-verifySnapshotSignature :: [Party] -> (CurrencySymbol, SnapshotVersion, SnapshotNumber, Hash, Hash) -> [Signature] -> Bool
+verifySnapshotSignature :: [Party] -> (CurrencySymbol, SnapshotVersion, SnapshotNumber, Hash, Hash, Hash) -> [Signature] -> Bool
 verifySnapshotSignature parties msg sigs =
   traceIfFalse $(errorCode SignatureVerificationFailed) $
     length parties == length sigs
@@ -676,15 +689,16 @@ verifySnapshotSignature parties msg sigs =
 
 -- | Verify individual party signature of a snapshot. See
 -- 'SignableRepresentation Snapshot' for more details.
-verifyPartySignature :: (CurrencySymbol, SnapshotVersion, SnapshotNumber, Hash, Hash) -> Party -> Signature -> Bool
-verifyPartySignature (headId, snapshotVersion, snapshotNumber, utxoHash, utxoToDecommitHash) party =
+verifyPartySignature :: (CurrencySymbol, SnapshotVersion, SnapshotNumber, Hash, Hash, Hash) -> Party -> Signature -> Bool
+verifyPartySignature (headId, snapshotVersion, snapshotNumber, utxoHash, utxoToCommitHash, utxoToDecommitHash) party =
   verifyEd25519Signature (vkey party) message
  where
   message =
     Builtins.serialiseData (toBuiltinData headId)
       <> Builtins.serialiseData (toBuiltinData snapshotVersion)
       <> Builtins.serialiseData (toBuiltinData snapshotNumber)
       <> Builtins.serialiseData (toBuiltinData utxoHash)
+      <> Builtins.serialiseData (toBuiltinData utxoToCommitHash)
       <> Builtins.serialiseData (toBuiltinData utxoToDecommitHash)
 {-# INLINEABLE verifyPartySignature #-}
 

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

@@ -50,6 +50,7 @@ data HeadError
   | LowerBoundBeforeContestationDeadline
   | FanoutNoLowerBoundDefined
   | FanoutUTxOToDecommitHashMismatch
+  | FanoutUTxOToCommitHashMismatch
 
 instance ToErrorCode HeadError where
   toErrorCode = \case
@@ -104,3 +105,4 @@ instance ToErrorCode HeadError where
     FanoutUTxOToDecommitHashMismatch -> "H42"
     LowerBoundBeforeContestationDeadline -> "H43"
     FanoutNoLowerBoundDefined -> "H44"
+    FanoutUTxOToCommitHashMismatch -> "H45"

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

@@ -52,6 +52,8 @@ data ClosedDatum = ClosedDatum
   -- ^ Spec: s
   , utxoHash :: Hash
   -- ^ Spec: η. Digest of snapshotted UTxO
+  , alphaUTxOHash :: Hash
+  -- TODO: ^ Spec: η?. Digest of UTxO still to be committed
   , deltaUTxOHash :: Hash
   -- ^ Spec: ηΔ. Digest of UTxO still to be distributed
   , contesters :: [PubKeyHash]

hydra-tx/src/Hydra/Tx/Close.hs

@@ -100,7 +100,7 @@ closeTx scriptRegistry vk headId openVersion confirmedSnapshot startSlotNo (endS
   closeRedeemer =
     case confirmedSnapshot of
       InitialSnapshot{} -> Head.CloseInitial
-      ConfirmedSnapshot{signatures, snapshot = Snapshot{version, utxoToDecommit}}
+      ConfirmedSnapshot{signatures, snapshot = Snapshot{version, utxoToCommit, utxoToDecommit}}
         | version == openVersion ->
             Head.CloseUnused{signature = toPlutusSignatures signatures}
         | otherwise ->
@@ -121,6 +121,8 @@ closeTx scriptRegistry vk headId openVersion confirmedSnapshot startSlotNo (endS
               fromIntegral . number $ getSnapshot confirmedSnapshot
           , utxoHash =
               toBuiltin . hashUTxO . utxo $ getSnapshot confirmedSnapshot
+          , alphaUTxOHash =
+              toBuiltin . hashUTxO @Tx . fromMaybe mempty . utxoToCommit $ getSnapshot confirmedSnapshot
           , deltaUTxOHash =
               case closeRedeemer of
                 Head.CloseUnused{} ->

hydra-tx/src/Hydra/Tx/Contest.hs

@@ -60,7 +60,7 @@ contestTx ::
   -- | Everything needed to spend the Head state-machine output.
   ClosedThreadOutput ->
   Tx
-contestTx scriptRegistry vk headId contestationPeriod openVersion Snapshot{number, utxo, utxoToDecommit, version} sig (slotNo, _) closedThreadOutput =
+contestTx scriptRegistry vk headId contestationPeriod openVersion Snapshot{number, utxo, utxoToCommit, utxoToDecommit, version} sig (slotNo, _) closedThreadOutput =
   unsafeBuildTransaction $
     emptyTxBody
       & addInputs [(headInput, headWitness)]
@@ -120,6 +120,8 @@ contestTx scriptRegistry vk headId contestationPeriod openVersion Snapshot{numbe
         Head.ClosedDatum
           { snapshotNumber = toInteger number
           , utxoHash = toBuiltin $ hashUTxO @Tx utxo
+          , alphaUTxOHash =
+              toBuiltin $ hashUTxO @Tx $ fromMaybe mempty utxoToCommit
           , deltaUTxOHash =
               case contestRedeemer of
                 Head.ContestCurrent{} ->