fix(threat-model): fix Phase 1 validation for doubleSatisfaction

- Fix inline datum handling: TxOutDatumInline should not add datums to
  witness set (fixes NotAllowedSupplementalDatums error)
- Add recalculateScriptIntegrityHash to recompute PPViewHash after
  transaction modifications (fixes PPViewHashesDontMatch error)
- All 4 threat model tests now pass correctly

Author: bogdan-manole

src/coin-selection/test/Spec.hs

@@ -576,22 +576,19 @@ This test runs the doubleSatisfaction threat model against the VULNERABLE
 bounty validator. The threat model attempts to bundle a "safe script" input
 that satisfies the vulnerable script's output requirement.
 
-The bounty script only checks "some output pays to beneficiary" without
-uniquely identifying which output belongs to this spend.
+Since the vulnerable bounty only checks "some output pays to beneficiary"
+without uniquely identifying which output belongs to this spend, the threat
+model WILL find a vulnerability.
 
-NOTE: In Conway era, the doubleSatisfaction attack is blocked by Phase 1
-ledger rules (PPViewHashesDontMatch, NotAllowedSupplementalDatums) before the
-script even runs. The threat model needs to be updated to properly handle
-Conway-era datum and protocol parameter rules for the attack to work.
-
-For now, this test verifies that the attack is rejected (by Phase 1 rules),
-which is still a secure outcome even if not for the intended reason.
+We use 'expectFailure' because finding the vulnerability means the
+QuickCheck property fails (which is the expected behavior for a vulnerable
+script).
 
 NOTE: This test uses runThreatModelM which runs INSIDE MockchainT for full
 Phase 1 + Phase 2 validation with re-balancing and re-signing.
 -}
 propBountyVulnerableToDoubleSatisfaction :: RunOptions -> Property
-propBountyVulnerableToDoubleSatisfaction opts = monadicIO $ do
+propBountyVulnerableToDoubleSatisfaction opts = QC.expectFailure $ monadicIO $ do
   let Options{params} = mcOptions opts
 
   -- Run the scenario AND the threat model INSIDE MockchainT

src/testing-interface/lib/Convex/ThreatModel/Cardano/Api.hs

@@ -9,7 +9,9 @@ module Convex.ThreatModel.Cardano.Api where
 import Cardano.Api
 
 import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
+import Cardano.Ledger.Alonzo.PParams (getLanguageView)
 import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
+import Cardano.Ledger.Alonzo.Tx (hashScriptIntegrity)
 import Cardano.Ledger.Alonzo.TxBody qualified as Ledger
 import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
 import Cardano.Ledger.Api.Era qualified as Ledger (eraProtVerLow)
@@ -18,6 +20,7 @@ import Cardano.Ledger.Binary qualified as CBOR
 import Cardano.Ledger.Conway.Scripts qualified as Conway
 import Cardano.Ledger.Conway.TxBody qualified as Conway
 import Cardano.Ledger.Keys (WitVKey (..), coerceKeyRole, hashKey)
+import Cardano.Ledger.Plutus.Language qualified as Plutus
 import Cardano.Slotting.Slot ()
 import Cardano.Slotting.Time (SlotLength, mkSlotLength)
 import Control.Lens ((&), (.~), _1)
@@ -41,6 +44,7 @@ import Data.Maybe (listToMaybe)
 import Data.Maybe.Strict
 import Data.SOP.NonEmpty (NonEmpty (NonEmptyOne))
 import Data.Sequence.Strict qualified as Seq
+import Data.Set qualified as Set
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Data.Word
 import GHC.Exts (toList)
@@ -354,9 +358,6 @@ This function:
 1. Calculates the new required fee
 2. Adjusts the change output (last output to wallet address) to compensate
 3. Re-signs the transaction with the wallet's key
-
-Note: This works at the ledger level to preserve the transaction structure
-created by TxModifier operations.
 -}
 rebalanceAndSign
   :: (MonadMockchain Era m, MonadFail m)
@@ -392,13 +393,66 @@ rebalanceAndSign wallet tx utxo = do
   adjustedOutputs <- adjustChangeOutput walletAddr feeDiff currentOuts
 
   -- Apply the changes: new fee and adjusted outputs
-  let finalTx = setTxOutputsList adjustedOutputs $ setTxFeeCoin newFee tx
+  let modifiedTx = setTxOutputsList adjustedOutputs $ setTxFeeCoin newFee tx
+
+  -- Recalculate script integrity hash
+  let finalTx = recalculateScriptIntegrityHash pparams modifiedTx
 
   -- Re-sign (strip old signatures and add new one)
   let Tx finalBody _ = finalTx
       unsignedTx = makeSignedTransaction [] finalBody
   pure $ Wallet.signTx wallet unsignedTx
 
+{- | Recalculate and update the script integrity hash in a transaction.
+
+The script integrity hash commits to:
+- The redeemers in the transaction
+- The datums in the witness set
+- The cost models for languages used (from protocol parameters)
+
+After modifying a transaction (adding/removing inputs, changing redeemers/datums),
+this hash becomes stale and must be recalculated.
+-}
+recalculateScriptIntegrityHash :: LedgerProtocolParameters Era -> Tx Era -> Tx Era
+recalculateScriptIntegrityHash pparams (Tx (ShelleyTxBody era body scripts scriptData auxData validity) wits) =
+  let
+    -- Extract redeemers and datums from scriptData
+    (redeemers, datums) = case scriptData of
+      TxBodyNoScriptData -> (Ledger.Redeemers mempty, Ledger.TxDats mempty)
+      TxBodyScriptData _ dats rdmrs -> (rdmrs, dats)
+
+    -- Get the protocol parameters
+    pp = unLedgerProtocolParameters pparams
+
+    -- Determine which languages are used by examining the scripts in the transaction
+    usedLangs =
+      Set.fromList
+        [ lang
+        | script <- scripts
+        , Just lang <- [getScriptLanguage script]
+        ]
+
+    -- Get LangDepView for each used language
+    langs =
+      Set.fromList
+        [ getLanguageView pp lang
+        | lang <- Set.toList usedLangs
+        ]
+
+    -- Compute new script integrity hash
+    newHash = hashScriptIntegrity langs redeemers datums
+
+    -- Update the body with new hash
+    body' = body{Conway.ctbScriptIntegrityHash = newHash}
+   in
+    Tx (ShelleyTxBody era body' scripts scriptData auxData validity) wits
+
+-- | Extract the Plutus language from a ledger script, if it's a Plutus script
+getScriptLanguage :: Ledger.AlonzoScript LedgerEra -> Maybe Plutus.Language
+getScriptLanguage script = case script of
+  Ledger.TimelockScript{} -> Nothing
+  Ledger.PlutusScript ps -> Just $ Ledger.plutusScriptLanguage ps
+
 -- | Get the fee from a transaction
 getTxFeeCoin :: Tx Era -> Coin
 getTxFeeCoin (Tx (ShelleyTxBody _ body _ _ _ _) _) = Conway.ctbTxfee body

src/testing-interface/lib/Convex/ThreatModel/TxModifier.hs

@@ -247,11 +247,13 @@ applyTxMod tx utxos (AddOutput addr value datum refscript) =
     toShelleyTxOut
       shelleyBasedEra
       (makeTxOut addr value datum refscript)
+  -- Note: Inline datums are embedded in the output itself, NOT in the witness set.
+  -- Only supplemental datums (for TxOutDatumHash outputs) go in the witness set.
   scriptData' = case datum of
     TxOutDatumNone -> scriptData
     TxOutDatumHash{} -> scriptData
     TxOutSupplementalDatum _ d -> addDatum (toAlonzoData d) scriptData
-    TxOutDatumInline _ d -> addDatum (toAlonzoData d) scriptData
+    TxOutDatumInline{} -> scriptData
 applyTxMod tx utxos (AddInput addr value datum rscript False) =
   ( Tx (ShelleyTxBody era body{Conway.ctbSpendInputs = inputs'} scripts scriptData'' auxData validity) wits
   , utxos'
@@ -271,11 +273,12 @@ applyTxMod tx utxos (AddInput addr value datum rscript False) =
     | idx' >= idx = idx' + 1
     | otherwise = idx'
 
+  -- Note: Inline datums are embedded in the output itself, NOT in the witness set.
   scriptData'' = case datum of
     TxOutDatumNone -> scriptData'
     TxOutDatumHash{} -> scriptData'
     TxOutSupplementalDatum _ d -> addDatum (toAlonzoData d) scriptData'
-    TxOutDatumInline _ d -> addDatum (toAlonzoData d) scriptData'
+    TxOutDatumInline{} -> scriptData'
 
   scriptData' = recomputeScriptData Nothing idxUpdate scriptData
 applyTxMod tx utxos (AddInput addr value datum rscript True) =
@@ -455,13 +458,14 @@ applyTxMod tx utxos (ChangeOutput ix maddr mvalue mdatum mrscript) =
         (fromMaybe datum mdatum)
         (fromMaybe rscript mrscript)
 
+  -- Note: Inline datums are embedded in the output itself, NOT in the witness set.
   scriptData' = case mdatum of
     Nothing -> scriptData
     Just d -> case d of
       TxOutDatumNone -> scriptData
       TxOutDatumHash{} -> scriptData
       TxOutSupplementalDatum _ d' -> addDatum (toAlonzoData d') scriptData
-      TxOutDatumInline _ d' -> addDatum (toAlonzoData d') scriptData
+      TxOutDatumInline{} -> scriptData
 applyTxMod tx utxos (ChangeInput txIn maddr mvalue mdatum mrscript) =
   (Tx (ShelleyTxBody era body scripts scriptData' auxData validity) wits, utxos')
  where
@@ -479,12 +483,13 @@ applyTxMod tx utxos (ChangeInput txIn maddr mvalue mdatum mrscript) =
       (fromMaybe rscript mrscript)
   utxos' = UTxO . Map.insert txIn txOut . unUTxO $ utxos
 
+  -- Note: Inline datums are embedded in the output itself, NOT in the witness set.
   scriptData' = case mdatum of
     Nothing -> scriptData
     Just TxOutDatumNone -> scriptData
     Just TxOutDatumHash{} -> scriptData
     Just (TxOutSupplementalDatum _ d) -> addDatum (toAlonzoData d) scriptData
-    Just (TxOutDatumInline _ d) -> addDatum (toAlonzoData d) scriptData
+    Just TxOutDatumInline{} -> scriptData
 applyTxMod tx utxos (ChangeScriptInput txIn mvalue mdatum mredeemer mrscript) =
   (Tx (ShelleyTxBody era body scripts scriptData' auxData validity) wits, utxos')
  where