From e92dedfdcbc7af0f22b23890cc661cf6336774b8 Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Thu, 9 Nov 2023 11:11:07 +0100
Subject: [PATCH] Check commits are spending from vInitial in observeCommitTx

This ensures that the commit tx is part of the Head protocol (because
the validators must have ran).
---
 hydra-node/src/Hydra/Chain/Direct/State.hs    |  3 +-
 hydra-node/src/Hydra/Chain/Direct/Tx.hs       | 28 ++++++++++++++-----
 .../test/Hydra/Chain/Direct/StateSpec.hs      |  4 +--
 3 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs
index 529cb6ecba7..c05cc184eea 100644
--- a/hydra-node/src/Hydra/Chain/Direct/State.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/State.hs
@@ -611,7 +611,8 @@ observeCommit ::
   Tx ->
   Maybe (OnChainTx Tx, InitialState)
 observeCommit ctx st tx = do
-  observation <- observeCommitTx networkId tx
+  let utxo = getKnownUTxO st
+  observation <- observeCommitTx networkId utxo tx
   let CommitObservation{commitOutput, party, committed} = observation
   let event = OnCommitTx{party, committed}
   let st' =
diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
index 9a73fe2b908..9912795c0c5 100644
--- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs
+++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
@@ -634,7 +634,7 @@ observeHeadTx networkId utxo tx =
   fromMaybe NoHeadTx $
     either (const Nothing) (Just . Init) (observeRawInitTx networkId tx)
       <|> Abort <$> observeAbortTx utxo tx
-      <|> Commit <$> observeCommitTx networkId tx
+      <|> Commit <$> observeCommitTx networkId utxo tx
       <|> CollectCom <$> observeCollectComTx utxo tx
       <|> Close <$> observeCloseTx utxo tx
       <|> Contest <$> observeContestTx utxo tx
@@ -851,22 +851,27 @@ observeInitTx cardanoKeys expectedCP party otherParties rawTx = do
 data CommitObservation = CommitObservation
   { commitOutput :: UTxOWithScript
   , party :: Party
+  -- ^ Hydra participant who committed the UTxO.
   , committed :: UTxO
   , headId :: HeadId
   }
 
 -- | Identify a commit tx by:
 --
+-- - Check that its spending from the init validator,
 -- - Find the outputs which pays to the commit validator,
 -- - Using the datum of that output, deserialize the committed output,
 -- - Reconstruct the committed UTxO from both values (tx input and output).
--- - TODO: Need to ensure this is a head protocol transaction.
 observeCommitTx ::
   NetworkId ->
+  -- | A UTxO set to lookup tx inputs. Should at least contain the input
+  -- spending from νInitial.
+  UTxO ->
   Tx ->
   Maybe CommitObservation
-observeCommitTx networkId tx = do
-  -- FIXME: Strategy to observe without looking at resolved inputs (utxo):
+observeCommitTx networkId utxo tx = do
+  -- FIXME: Instead checking to spend from initial we could be looking at the
+  -- seed:
   --
   --  - We must check that participation token in output satisfies
   --      policyId = hash(mu_head(seed))
@@ -880,6 +885,9 @@ observeCommitTx networkId tx = do
   --
   --  Right now we only have the headId in the datum, so we use that in place of
   --  the seed -> THIS CAN NOT BE TRUSTED.
+
+  guard isSpendingFromInitial
+
   (commitIn, commitOut) <- findTxOutByAddress commitAddress tx
   dat <- txOutScriptData commitOut
   (onChainParty, onChainCommits, headId) :: Commit.DatumType <- fromScriptData dat
@@ -889,9 +897,6 @@ observeCommitTx networkId tx = do
   -- the commit into the datum (+ changing the hashing strategy of
   -- collect/fanout)
   committed <- do
-    -- TODO: We could simplify this by just using the datum. However, we would
-    -- need to ensure the commit is belonging to a head / is rightful. By just
-    -- looking for some known initials we achieve this (a bit complicated) now.
     committedUTxO <- traverse (Commit.deserializeCommit (networkIdToNetwork networkId)) onChainCommits
     pure . UTxO.fromPairs $ committedUTxO
 
@@ -903,6 +908,15 @@ observeCommitTx networkId tx = do
       , headId = mkHeadId $ fromPlutusCurrencySymbol headId
       }
  where
+  isSpendingFromInitial :: Bool
+  isSpendingFromInitial = do
+    let resolvedInputs = mapMaybe (`UTxO.resolve` utxo) $ txIns' tx
+    any (\o -> txOutAddress o == initialAddress) resolvedInputs
+
+  initialAddress = mkScriptAddress @PlutusScriptV2 networkId initialScript
+
+  initialScript = fromPlutusScript Initial.validatorScript
+
   commitAddress = mkScriptAddress @PlutusScriptV2 networkId commitScript
 
   commitScript = fromPlutusScript Commit.validatorScript
diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
index 2647a951549..082e8aad9c5 100644
--- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
+++ b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs
@@ -216,7 +216,7 @@ spec = parallel $ do
           mutation <- pick $ genCommitTxMutation utxo tx
           let (tx', utxo') = applyMutation mutation (tx, utxo)
 
-              originalIsObserved = property $ isJust $ observeCommitTx testNetworkId tx
+              originalIsObserved = property $ isJust $ observeCommitTx testNetworkId utxo tx
 
               -- We expected mutated transaction to still be valid, but not observed.
               mutatedIsValid =
@@ -227,7 +227,7 @@ spec = parallel $ do
                     | otherwise -> property False & counterexample (show ok)
 
               mutatedIsNotObserved =
-                isNothing $ observeCommitTx testNetworkId tx'
+                isNothing $ observeCommitTx testNetworkId utxo' tx'
 
           pure $
             conjoin