Add a check for the auxiliary data hashes

input-output-hk · May 3, 2024 · 64b4e8b · 64b4e8b
1 parent c4dfd67
commit 64b4e8b
Show file tree

Hide file tree

Showing 2 changed files with 29 additions and 16 deletions.
diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs
@@ -18,6 +18,7 @@ import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), hashAlonzoTxAuxDat
 import Cardano.Ledger.Api (
   AlonzoPlutusPurpose (..),
   AsIndex (..),
+  Metadatum,
   Redeemers (..),
   auxDataHashTxBodyL,
   auxDataTxL,
@@ -334,11 +335,17 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput,
   commitDatum =
     mkTxOutDatumInline $ mkCommitDatum party utxoToCommit (headIdToCurrencySymbol headId)
 
-  TxMetadata metadataMap = mkHydraHeadV1TxName "CommitTx"
+  TxMetadata commitMetadataMap = commitMetadata
 
-  txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata metadataMap) []
+  txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata commitMetadataMap) []
   CommitBlueprintTx{lookupUTxO, blueprintTx} = commitBlueprintTx
 
+commitMetadata :: TxMetadata
+commitMetadata = mkHydraHeadV1TxName "CommitTx"
+
+getAuxMetadata :: AlonzoTxAuxData LedgerEra -> Map Word64 Metadatum
+getAuxMetadata (AlonzoTxAuxData metadata _ _) = metadata
+
 mkCommitDatum :: Party -> UTxO -> CurrencySymbol -> Plutus.Datum
 mkCommitDatum party utxo headId =
   Commit.datum (partyToChain party, commits, headId)

diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
@@ -8,10 +8,11 @@ module Hydra.Chain.Direct.TxSpec where
 import Hydra.Prelude hiding (label)
 
 import Cardano.Api.UTxO qualified as UTxO
-import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), mkAlonzoTxAuxData)
+import Cardano.Ledger.Alonzo.TxAuxData (hashAlonzoTxAuxData, mkAlonzoTxAuxData)
 import Cardano.Ledger.Api (
-  AlonzoPlutusPurpose (AlonzoSpending),
   Metadatum,
+  AlonzoPlutusPurpose (AlonzoSpending),
+  auxDataHashTxBodyL,
   auxDataTxL,
   bodyTxL,
   inputsTxBodyL,
@@ -30,7 +31,7 @@ import Cardano.Ledger.Credential (Credential (..))
 import Control.Lens ((^.))
 import Data.ByteString qualified as BS
 import Data.Map qualified as Map
-import Data.Maybe.Strict (fromSMaybe)
+import Data.Maybe.Strict (StrictMaybe (..), fromSMaybe)
 import Data.Set qualified as Set
 import Data.Text qualified as T
 import Data.Text qualified as Text
@@ -218,15 +219,23 @@ spec =
                   & counterexample ("Blueprint transaction failed to evaluate: " <> renderTxWithUTxO lookupUTxO blueprintTx')
               , propTransactionEvaluates (commitTx', spendableUTxO)
                   & counterexample ("Commit transaction failed to evaluate: " <> renderTxWithUTxO spendableUTxO commitTx')
-              , let blueprintMetadata = fromSMaybe mempty $ getAuxMetadata <$> blueprintTx ^. auxDataTxL
-                    commitMetadata = fromSMaybe mempty $ getAuxMetadata <$> tx ^. auxDataTxL
-                 in ( blueprintMetadata
-                        `Map.isSubmapOf` commitMetadata
-                        .&&. prop_validateTxMetadata blueprintMetadata
-                        .&&. prop_validateTxMetadata commitMetadata
+              , let blueprintMetadataVal = fromSMaybe mempty $ getAuxMetadata <$> blueprintTx ^. auxDataTxL
+                    commitMetadataVal = fromSMaybe mempty $ getAuxMetadata <$> tx ^. auxDataTxL
+                    TxMetadata commitMetadata' = commitMetadata
+                    commitMetadataHash = tx ^. bodyTxL . auxDataHashTxBodyL
+                    expectedMetadataHash =
+                      SJust $
+                        hashAlonzoTxAuxData $
+                          mkAlonzoTxAuxData @[] @LedgerEra (Map.union (toShelleyMetadata commitMetadata') blueprintMetadataVal) []
+                 in ( blueprintMetadataVal `Map.isSubmapOf` commitMetadataVal
+                        .&&. prop_validateTxMetadata blueprintMetadataVal
+                        .&&. prop_validateTxMetadata (toShelleyMetadata commitMetadata')
+                        .&&. commitMetadataHash === expectedMetadataHash
                     )
-                      & counterexample ("blueprint metadata: " <> show blueprintMetadata)
-                      & counterexample ("commit metadata: " <> show commitMetadata)
+                      & counterexample ("blueprint metadata: " <> show blueprintMetadataVal)
+                      & counterexample ("commit metadata: " <> show commitMetadataVal)
+                      & counterexample ("expected metadata hash: " <> show expectedMetadataHash)
+                      & counterexample ("commit metadata hash: " <> show commitMetadataHash)
               , let blueprintValidity = blueprintBody ^. vldtTxBodyL
                     commitValidity = commitTxBody ^. vldtTxBodyL
                  in blueprintValidity === commitValidity
@@ -263,9 +272,6 @@ prop_validateTxMetadata metadataMap = do
   let txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata $ fromShelleyMetadata metadataMap) []
   validateTxAuxData (pparams ^. ppProtocolVersionL) txAuxMetadata
 
-getAuxMetadata :: AlonzoTxAuxData LedgerEra -> Map Word64 Metadatum
-getAuxMetadata (AlonzoTxAuxData metadata _ _) = metadata
-
 genBlueprintTxWithUTxO :: Gen (UTxO, Tx)
 genBlueprintTxWithUTxO =
   fmap (second unsafeBuildTransaction) $