Observe correct deposit UTxO in Increment observation (#1924)

This PR fixes the bug we found where increment observation would
pick the wrong deposit UTxO.

---

<!-- Consider each and tick it off one way or the other -->
* [x] CHANGELOG updated or not needed
* [x] Documentation updated or not needed
* [x] Haddocks updated or not needed
* [x] No new TODOs introduced or explained herafter

Author: noonio

CHANGELOG.md

@@ -26,6 +26,8 @@ changes.
     ETCD_AUTO_COMPACTION_RETENTION=168h
     ```
 
+- Fix a bug in increment observation where wrong deposited UTxO was picked up.
+
 - Fix a bug where incremental commits / decommits were not correctly observed after restart of `hydra-node`. This was due to incorrect handling of internal chain state [#1894](https://github.com/cardano-scaling/hydra/pull/1894)
 
 - Fix a bug where decoding `Party` information from chain would crash the node or chain observer.

hydra-node/hydra-node.cabal

@@ -328,6 +328,7 @@ test-suite tests
     , hydra-node
     , hydra-node:testlib
     , hydra-plutus
+    , hydra-plutus-extras
     , hydra-prelude
     , hydra-test-utils
     , hydra-tx

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

@@ -19,6 +19,8 @@ import Hydra.Cardano.Api (
   UTxO,
   findRedeemerSpending,
   genTxIn,
+  getTxBody,
+  getTxId,
   hashScript,
   isScriptTxOut,
   lovelaceToValue,
@@ -70,6 +72,7 @@ import Hydra.Chain.Direct.State (
   getContestationDeadline,
   getKnownUTxO,
   initialize,
+  maxGenParties,
   observeClose,
   observeCollect,
   observeCommit,
@@ -79,6 +82,7 @@ import Hydra.Chain.Direct.State (
   unsafeCollect,
   unsafeCommit,
   unsafeFanout,
+  unsafeIncrement,
   unsafeObserveInitAndCommits,
  )
 import Hydra.Chain.Direct.State qualified as Transition
@@ -93,6 +97,7 @@ import Hydra.Ledger.Cardano.Evaluate (
  )
 import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime)
 import Hydra.Plutus (initialValidatorScript)
+import Hydra.Plutus.Extras.Time (posixToUTCTime)
 import Hydra.Tx.Close (ClosedThreadOutput (closedContesters))
 import Hydra.Tx.ContestationPeriod (toNominalDiffTime)
 import Hydra.Tx.Deposit (DepositObservation (..), observeDepositTx)
@@ -110,6 +115,7 @@ import Hydra.Tx.Observe (
   observeCommitTx,
   observeDecrementTx,
   observeHeadTx,
+  observeIncrementTx,
   observeInitTx,
  )
 import Hydra.Tx.Recover (RecoverObservation (..), observeRecoverTx)
@@ -148,7 +154,7 @@ import Test.QuickCheck (
   (===),
   (==>),
  )
-import Test.QuickCheck.Monadic (monadicIO, monadicST, pick)
+import Test.QuickCheck.Monadic (assert, assertWith, monadicIO, monadicST, monitor, pick)
 import Prelude qualified
 
 spec :: Spec
@@ -348,6 +354,7 @@ spec = parallel $ do
   describe "increment" $ do
     propBelowSizeLimit maxTxSize forAllIncrement
     propIsValid forAllIncrement
+    it "increment observation observes correct utxo" prop_incrementObservesCorrectUTxO
 
   describe "decrement" $ do
     propBelowSizeLimit maxTxSize forAllDecrement
@@ -528,6 +535,31 @@ prop_canCloseFanoutEveryCollect = monadicST $ do
     checkCoverage
       (collectFails .||. collectCloseAndFanoutPass)
 
+prop_incrementObservesCorrectUTxO :: Property
+prop_incrementObservesCorrectUTxO = monadicIO $ do
+  (ctx, st@OpenState{headId}, _, txDeposit) <- pickBlind $ genDepositTx maxGenParties
+  (_, _, _, txDeposit2) <- pickBlind $ genDepositTx maxGenParties
+  case observeDepositTx (ctxNetworkId ctx) txDeposit of
+    Nothing -> assertWith False "Deposit not observed"
+    Just DepositObservation{depositTxId = depositedTxId, deadline} -> do
+      cctx <- pickBlind $ pickChainContext ctx
+      let slotNo = slotNoFromUTCTime systemStart slotLength (posixToUTCTime deadline)
+      let version = 0
+      let openUTxO = getKnownUTxO st
+      -- NOTE: Use second deposit utxo deliberately here to test that the
+      -- increment observation picks the correct one.
+      -- We rely here on a fact that eventually this property will generate
+      -- UTxO which would be wrongly picked up by the increment observation.
+      let utxo = getKnownUTxO st <> utxoFromTx txDeposit <> utxoFromTx txDeposit2
+      snapshot <- pickBlind $ Snapshot.genConfirmedSnapshot headId version 1 openUTxO (Just utxo) Nothing (ctxHydraSigningKeys ctx)
+      let txIncrement = unsafeIncrement cctx utxo headId (ctxHeadParameters ctx) snapshot depositedTxId slotNo
+      case observeIncrementTx utxo txIncrement of
+        Nothing -> assertWith False "Increment not observed"
+        Just IncrementObservation{depositTxId} -> do
+          let txDepositId = getTxId (getTxBody txDeposit)
+          monitor (counterexample $ "Expected TxId:" <> show depositTxId <> " Actual TxId:" <> show txDepositId)
+          assert (depositTxId == txDepositId)
+
 --
 -- Generic Properties
 --

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

@@ -121,7 +121,7 @@ observeIncrementTx ::
 observeIncrementTx utxo tx = do
   let inputUTxO = resolveInputsUTxO utxo tx
   (headInput, headOutput) <- findTxOutByScript inputUTxO Head.validatorScript
-  (TxIn depositTxId _, depositOutput) <- findTxOutByScript utxo depositValidatorScript
+  (TxIn depositTxId _, depositOutput) <- findTxOutByScript inputUTxO depositValidatorScript
   dat <- txOutScriptData $ toTxContext depositOutput
   -- we need to be able to decode the datum, no need to use it tho
   _ :: Deposit.DepositDatum <- fromScriptData dat