From e37abeae3b5e2dcf896989f56232c06d10f718ee Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Tue, 30 Apr 2024 10:11:18 +0200 Subject: [PATCH 01/17] Validate blueprint and commit tx metadata --- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index ccbfcec45ec..ee7d385154b 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -8,7 +8,7 @@ module Hydra.Chain.Direct.TxSpec where import Hydra.Prelude hiding (label) import Cardano.Api.UTxO qualified as UTxO -import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) +import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), mkAlonzoTxAuxData) import Cardano.Ledger.Api ( AlonzoPlutusPurpose (AlonzoSpending), Metadatum, @@ -16,10 +16,12 @@ import Cardano.Ledger.Api ( bodyTxL, inputsTxBodyL, outputsTxBodyL, + ppProtocolVersionL, rdmrsTxWitsL, referenceInputsTxBodyL, reqSignerHashesTxBodyL, unRedeemers, + validateTxAuxData, vldtTxBodyL, witsTxL, ) @@ -32,6 +34,7 @@ import Data.Set qualified as Set import Data.Text qualified as T import Data.Text qualified as Text import Hydra.Cardano.Api +import Hydra.Cardano.Api.Prelude (fromShelleyMetadata, toShelleyMetadata) import Hydra.Cardano.Api.Pretty (renderTx, renderTxWithUTxO) import Hydra.Chain (CommitBlueprintTx (..), HeadParameters (..)) import Hydra.Chain.Direct.Contract.Commit (commitSigningKey, healthyInitialTxIn, healthyInitialTxOut) @@ -87,6 +90,7 @@ import Test.QuickCheck ( property, vectorOf, withMaxSuccess, + (.&&.), (===), ) import Test.QuickCheck.Instances.Semigroup () @@ -214,7 +218,11 @@ spec = & 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 + in ( blueprintMetadata + `Map.isSubmapOf` commitMetadata + .&&. prop_validateTxMetadata blueprintMetadata + .&&. prop_validateTxMetadata commitMetadata + ) & counterexample ("blueprint metadata: " <> show blueprintMetadata) & counterexample ("commit metadata: " <> show commitMetadata) , let blueprintValidity = blueprintBody ^. vldtTxBodyL @@ -248,6 +256,11 @@ spec = & counterexample ("commit reference inputs: " <> show commitRefInputs) ] +prop_validateTxMetadata :: Map Word64 Metadatum -> Bool +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 From c011fe613900036885e9b4795d78907e9f2f5f72 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Tue, 30 Apr 2024 10:47:45 +0200 Subject: [PATCH 02/17] Add more rich metadata --- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 33 ++++++++++++++++---- 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index ee7d385154b..2d2202dba86 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -319,17 +319,38 @@ genBlueprintTxWithUTxO = ) addRandomMetadata (utxo, txbody) = do - mtdt <- oneof [randomMetadata, pure TxMetadataNone] + mtdt <- + oneof $ + ( fmap TxMetadataInEra + <$> [bytesMetadata, numberMetadata, textMetadata, listMetadata] + ) + <> [pure TxMetadataNone] pure (utxo, txbody{txMetadata = mtdt}) where - randomMetadata = do + mkMeta = TxMetadata . Map.fromList + + listMetadata = do + TxMetadata bytes <- bytesMetadata + TxMetadata numbers <- numberMetadata + TxMetadata text <- textMetadata + l <- arbitrary + pure $ mkMeta [(l, TxMetaList $ Map.elems bytes <> Map.elems numbers <> Map.elems text)] + + bytesMetadata = do + metadata <- arbitrary + l <- arbitrary + pure $ mkMeta [(l, TxMetaBytes metadata)] + + numberMetadata = do + metadata <- arbitrary + l <- arbitrary + pure $ mkMeta [(l, TxMetaNumber metadata)] + + textMetadata = do n <- choose (2, 50) metadata <- Text.take n <$> genSomeText l <- arbitrary - pure $ - TxMetadataInEra $ - TxMetadata $ - Map.fromList [(l, TxMetaText metadata)] + pure $ mkMeta [(l, TxMetaText metadata)] removeRandomInputs (utxo, txbody) = do someInput <- elements $ txIns txbody From 505a43d1a08b199b139bab0e407f2a3612dba7d6 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Tue, 30 Apr 2024 16:47:44 +0200 Subject: [PATCH 03/17] Limit the metadata to reasonable sizes --- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index 2d2202dba86..e25d514402b 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -28,6 +28,7 @@ import Cardano.Ledger.Api ( import Cardano.Ledger.Core (EraTx (getMinFeeTx)) 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.Set qualified as Set @@ -78,6 +79,7 @@ import Test.Hydra.Prelude import Test.QuickCheck ( Positive (..), Property, + checkCoverage, choose, conjoin, counterexample, @@ -88,6 +90,7 @@ import Test.QuickCheck ( label, oneof, property, + vector, vectorOf, withMaxSuccess, (.&&.), @@ -95,7 +98,6 @@ import Test.QuickCheck ( ) import Test.QuickCheck.Instances.Semigroup () import Test.QuickCheck.Monadic (monadicIO) -import Test.QuickCheck.Property (checkCoverage) spec :: Spec spec = @@ -337,17 +339,18 @@ genBlueprintTxWithUTxO = pure $ mkMeta [(l, TxMetaList $ Map.elems bytes <> Map.elems numbers <> Map.elems text)] bytesMetadata = do - metadata <- arbitrary + n <- choose (1, 50) + metadata <- BS.pack <$> vector n l <- arbitrary pure $ mkMeta [(l, TxMetaBytes metadata)] numberMetadata = do - metadata <- arbitrary + metadata <- elements [0 .. 100] l <- arbitrary pure $ mkMeta [(l, TxMetaNumber metadata)] textMetadata = do - n <- choose (2, 50) + n <- choose (2, 22) metadata <- Text.take n <$> genSomeText l <- arbitrary pure $ mkMeta [(l, TxMetaText metadata)] From 69fada4cd5c393c2f89d3e058b9d389351be1708 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Tue, 30 Apr 2024 16:50:22 +0200 Subject: [PATCH 04/17] Add a check for the auxiliary data hashes --- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 11 +++++-- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 34 ++++++++++++-------- 2 files changed, 29 insertions(+), 16 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index dbdb3de0ace..99dd9a66493 100644 --- 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 index e25d514402b..970098d91ab 100644 --- 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) $ From 6d89b0a456ee35541827f09947acb66a21b30870 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 3 May 2024 15:49:21 +0200 Subject: [PATCH 05/17] Implement genMetadata using cardano-ledger functions The genMatadata' generator seems reasonable for our use case here. --- hydra-cardano-api/src/Hydra/Cardano/Api.hs | 2 + hydra-node/hydra-node.cabal | 2 +- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 50 ++++---------------- hydra-node/test/Hydra/Model/Payment.hs | 1 + 4 files changed, 14 insertions(+), 41 deletions(-) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api.hs b/hydra-cardano-api/src/Hydra/Cardano/Api.hs index 8f10dd6395e..05a56f96375 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api.hs @@ -102,8 +102,10 @@ import Cardano.Api.Shelley as X ( fromAlonzoCostModels, fromAlonzoPrices, fromPlutusData, + fromShelleyMetadata, toAlonzoPrices, toPlutusData, + toShelleyMetadata, toShelleyNetwork, ) import Cardano.Api.UTxO ( diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 6c98513fd3b..fdf98cc32d2 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -341,7 +341,7 @@ test-suite tests , cardano-ledger-babbage:{cardano-ledger-babbage, testlib} , cardano-ledger-core , cardano-ledger-mary - , cardano-ledger-shelley + , cardano-ledger-shelley:{cardano-ledger-shelley, testlib} , cardano-slotting , cardano-strict-containers , cborg diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index 970098d91ab..e62ca65b3ad 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -5,13 +5,14 @@ -- "direct" chain component. module Hydra.Chain.Direct.TxSpec where +import Hydra.Cardano.Api import Hydra.Prelude hiding (label) import Cardano.Api.UTxO qualified as UTxO import Cardano.Ledger.Alonzo.TxAuxData (hashAlonzoTxAuxData, mkAlonzoTxAuxData) import Cardano.Ledger.Api ( - Metadatum, AlonzoPlutusPurpose (AlonzoSpending), + Metadatum, auxDataHashTxBodyL, auxDataTxL, bodyTxL, @@ -25,18 +26,15 @@ import Cardano.Ledger.Api ( validateTxAuxData, vldtTxBodyL, witsTxL, + pattern ShelleyTxAuxData, ) import Cardano.Ledger.Core (EraTx (getMinFeeTx)) import Cardano.Ledger.Credential (Credential (..)) import Control.Lens ((^.)) -import Data.ByteString qualified as BS import Data.Map qualified as Map import Data.Maybe.Strict (StrictMaybe (..), fromSMaybe) import Data.Set qualified as Set import Data.Text qualified as T -import Data.Text qualified as Text -import Hydra.Cardano.Api -import Hydra.Cardano.Api.Prelude (fromShelleyMetadata, toShelleyMetadata) import Hydra.Cardano.Api.Pretty (renderTx, renderTxWithUTxO) import Hydra.Chain (CommitBlueprintTx (..), HeadParameters (..)) import Hydra.Chain.Direct.Contract.Commit (commitSigningKey, healthyInitialTxIn, healthyInitialTxOut) @@ -73,8 +71,8 @@ import Hydra.Ledger.Cardano ( ) import Hydra.Ledger.Cardano.Evaluate (EvaluationReport, maxTxExecutionUnits, propTransactionEvaluates) import Hydra.Party (Party) -import Hydra.PersistenceSpec (genSomeText) import PlutusLedgerApi.Test.Examples qualified as Plutus +import Test.Cardano.Ledger.Shelley.Arbitrary (genMetadata') import Test.Hydra.Fixture (genForParty) import Test.Hydra.Prelude import Test.QuickCheck ( @@ -89,9 +87,7 @@ import Test.QuickCheck ( forAll, forAllBlind, label, - oneof, property, - vector, vectorOf, withMaxSuccess, (.&&.), @@ -327,39 +323,8 @@ genBlueprintTxWithUTxO = ) addRandomMetadata (utxo, txbody) = do - mtdt <- - oneof $ - ( fmap TxMetadataInEra - <$> [bytesMetadata, numberMetadata, textMetadata, listMetadata] - ) - <> [pure TxMetadataNone] + mtdt <- genMetadata pure (utxo, txbody{txMetadata = mtdt}) - where - mkMeta = TxMetadata . Map.fromList - - listMetadata = do - TxMetadata bytes <- bytesMetadata - TxMetadata numbers <- numberMetadata - TxMetadata text <- textMetadata - l <- arbitrary - pure $ mkMeta [(l, TxMetaList $ Map.elems bytes <> Map.elems numbers <> Map.elems text)] - - bytesMetadata = do - n <- choose (1, 50) - metadata <- BS.pack <$> vector n - l <- arbitrary - pure $ mkMeta [(l, TxMetaBytes metadata)] - - numberMetadata = do - metadata <- elements [0 .. 100] - l <- arbitrary - pure $ mkMeta [(l, TxMetaNumber metadata)] - - textMetadata = do - n <- choose (2, 22) - metadata <- Text.take n <$> genSomeText - l <- arbitrary - pure $ mkMeta [(l, TxMetaText metadata)] removeRandomInputs (utxo, txbody) = do someInput <- elements $ txIns txbody @@ -372,6 +337,11 @@ genBlueprintTxWithUTxO = , txbody{txInsCollateral = TxInsCollateral $ toList (UTxO.inputSet utxoToSpend)} ) +genMetadata :: Gen TxMetadataInEra +genMetadata = + genMetadata' @LedgerEra >>= \(ShelleyTxAuxData m) -> + pure . TxMetadataInEra . TxMetadata $ fromShelleyMetadata m + prop_interestingBlueprintTx :: Property prop_interestingBlueprintTx = do forAll genBlueprintTxWithUTxO $ \(utxo, tx) -> diff --git a/hydra-node/test/Hydra/Model/Payment.hs b/hydra-node/test/Hydra/Model/Payment.hs index b5ef6dab88f..1d2620b6225 100644 --- a/hydra-node/test/Hydra/Model/Payment.hs +++ b/hydra-node/test/Hydra/Model/Payment.hs @@ -81,6 +81,7 @@ instance HasVariables Payment where getAllVariables _ = mempty -- | Making `Payment` an instance of `IsTx` allows us to use it with `HeadLogic'`s messages. +-- FIXME: Missing method implementation instance IsTx Payment where type TxIdType Payment = Int type UTxOType Payment = [(CardanoSigningKey, Value)] From d68a2dbbdedcaba9e1f32878fe9be797162b8a22 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 3 May 2024 17:38:23 +0200 Subject: [PATCH 06/17] Refactor tests for auxiliary data hash --- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 3 - hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 78 +++++++++++++------- 2 files changed, 53 insertions(+), 28 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index 99dd9a66493..6dcddbdbd9a 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -343,9 +343,6 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, 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 index e62ca65b3ad..8eacc4f7990 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -9,7 +9,8 @@ import Hydra.Cardano.Api import Hydra.Prelude hiding (label) import Cardano.Api.UTxO qualified as UTxO -import Cardano.Ledger.Alonzo.TxAuxData (hashAlonzoTxAuxData, mkAlonzoTxAuxData) +import Cardano.Ledger.Alonzo.Core (EraTxAuxData (hashTxAuxData)) +import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) import Cardano.Ledger.Api ( AlonzoPlutusPurpose (AlonzoSpending), Metadatum, @@ -32,7 +33,7 @@ import Cardano.Ledger.Core (EraTx (getMinFeeTx)) import Cardano.Ledger.Credential (Credential (..)) import Control.Lens ((^.)) import Data.Map qualified as Map -import Data.Maybe.Strict (StrictMaybe (..), fromSMaybe) +import Data.Maybe.Strict (StrictMaybe (..)) import Data.Set qualified as Set import Data.Text qualified as T import Hydra.Cardano.Api.Pretty (renderTx, renderTxWithUTxO) @@ -50,7 +51,24 @@ import Hydra.Chain.Direct.Fixture qualified as Fixture import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO) import Hydra.Chain.Direct.State (ChainContext (..), HasKnownUTxO (getKnownUTxO), genChainStateWithTx) import Hydra.Chain.Direct.State qualified as Transition -import Hydra.Chain.Direct.Tx +import Hydra.Chain.Direct.Tx ( + HeadObservation (..), + InitObservation (..), + abortTx, + commitTx, + currencySymbolToHeadId, + headIdToCurrencySymbol, + headIdToPolicyId, + headSeedToTxIn, + initTx, + mkCommitDatum, + mkHeadId, + observeHeadTx, + observeInitTx, + onChainIdToAssetName, + txInToHeadSeed, + verificationKeyToOnChainId, + ) import Hydra.Chain.Direct.Wallet (ErrCoverFee (..), coverFee_) import Hydra.Contract.Commit qualified as Commit import Hydra.Contract.HeadTokens (headPolicyId, mkHeadTokenScript) @@ -215,23 +233,15 @@ spec = & counterexample ("Blueprint transaction failed to evaluate: " <> renderTxWithUTxO lookupUTxO blueprintTx') , propTransactionEvaluates (commitTx', spendableUTxO) & counterexample ("Commit transaction failed to evaluate: " <> renderTxWithUTxO spendableUTxO commitTx') - , 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 blueprintMetadataVal) - & counterexample ("commit metadata: " <> show commitMetadataVal) - & counterexample ("expected metadata hash: " <> show expectedMetadataHash) - & counterexample ("commit metadata hash: " <> show commitMetadataHash) + , conjoin + [ getAuxMetadata blueprintTx' `Map.isSubmapOf` getAuxMetadata commitTx' + & counterexample ("blueprint metadata: " <> show (getAuxMetadata blueprintTx')) + & counterexample ("commit metadata: " <> show (getAuxMetadata commitTx')) + , propHasValidAuxData blueprintTx' + & counterexample "Blueprint tx has invalid aux data" + , propHasValidAuxData commitTx' + & counterexample "Commit tx has invalid aux data" + ] , let blueprintValidity = blueprintBody ^. vldtTxBodyL commitValidity = commitTxBody ^. vldtTxBodyL in blueprintValidity === commitValidity @@ -263,10 +273,22 @@ spec = & counterexample ("commit reference inputs: " <> show commitRefInputs) ] -prop_validateTxMetadata :: Map Word64 Metadatum -> Bool -prop_validateTxMetadata metadataMap = do - let txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata $ fromShelleyMetadata metadataMap) [] - validateTxAuxData (pparams ^. ppProtocolVersionL) txAuxMetadata +-- | Check auxiliary data of a transaction against 'pparams' and whether the aux +-- data hash is consistent. +propHasValidAuxData :: Tx -> Property +propHasValidAuxData tx = + case toLedgerTx tx ^. auxDataTxL of + SNothing -> property True + SJust auxData -> + isValid auxData .&&. hashConsistent auxData + where + isValid auxData = + validateTxAuxData (pparams ^. ppProtocolVersionL) auxData + & counterexample "Auxiliary data validation failed" + + hashConsistent auxData = + toLedgerTx tx ^. bodyTxL . auxDataHashTxBodyL === SJust (hashTxAuxData auxData) + & counterexample "Auxiliary data hash inconsistent" genBlueprintTxWithUTxO :: Gen (UTxO, Tx) genBlueprintTxWithUTxO = @@ -338,10 +360,16 @@ genBlueprintTxWithUTxO = ) genMetadata :: Gen TxMetadataInEra -genMetadata = +genMetadata = do genMetadata' @LedgerEra >>= \(ShelleyTxAuxData m) -> pure . TxMetadataInEra . TxMetadata $ fromShelleyMetadata m +getAuxMetadata :: Tx -> Map Word64 Metadatum +getAuxMetadata tx = + case toLedgerTx tx ^. auxDataTxL of + SNothing -> mempty + SJust (AlonzoTxAuxData m _ _) -> m + prop_interestingBlueprintTx :: Property prop_interestingBlueprintTx = do forAll genBlueprintTxWithUTxO $ \(utxo, tx) -> From 6a5b238e72776122160ec1643f178db0a367d9b6 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Tue, 30 Apr 2024 16:56:18 +0200 Subject: [PATCH 07/17] Combine blueprint and commit tx metadata --- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index 6dcddbdbd9a..10fc3bd4fc7 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -33,7 +33,7 @@ import Cardano.Ledger.Api ( unRedeemers, witsTxL, ) -import Cardano.Ledger.BaseTypes (StrictMaybe (..)) +import Cardano.Ledger.BaseTypes (StrictMaybe (..), fromSMaybe) import Control.Lens ((.~), (<>~), (^.)) import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS @@ -255,7 +255,7 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, & bodyTxL . referenceInputsTxBodyL <>~ Set.fromList [toLedgerTxIn initialScriptRef] & bodyTxL . outputsTxBodyL .~ StrictSeq.singleton (toLedgerTxOut commitOutput) & bodyTxL . reqSignerHashesTxBodyL <>~ Set.singleton (toLedgerKeyHash vkh) - & bodyTxL . auxDataHashTxBodyL .~ SJust (hashAlonzoTxAuxData txAuxMetadata) + & bodyTxL . auxDataHashTxBodyL .~ combinedMetadata & bodyTxL . mintTxBodyL .~ mempty & auxDataTxL .~ addMetadata txAuxMetadata existingWits = toLedgerTx blueprintTx ^. witsTxL @@ -338,6 +338,12 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, TxMetadata commitMetadataMap = commitMetadata txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata commitMetadataMap) [] + + combinedMetadata = + let existingMetadataMap = fromSMaybe mempty $ getAuxMetadata <$> toLedgerTx blueprintTx ^. auxDataTxL + in SJust . hashAlonzoTxAuxData $ + mkAlonzoTxAuxData @[] @LedgerEra (Map.union (toShelleyMetadata commitMetadataMap) existingMetadataMap) [] + CommitBlueprintTx{lookupUTxO, blueprintTx} = commitBlueprintTx commitMetadata :: TxMetadata From 9bd7418805d1b8f98361d2ff873e7661ecb57d96 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 3 May 2024 17:48:13 +0200 Subject: [PATCH 08/17] Refactor how metadata is set on commitTx --- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 44 +++++++++---------------- 1 file changed, 16 insertions(+), 28 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index 10fc3bd4fc7..c36998022b6 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -14,18 +14,17 @@ import Hydra.Prelude import Cardano.Api.UTxO qualified as UTxO import Cardano.Ledger.Alonzo.Scripts (ExUnits (..)) -import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), hashAlonzoTxAuxData) +import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..)) import Cardano.Ledger.Api ( AlonzoPlutusPurpose (..), AsIndex (..), - Metadatum, + EraTxAuxData (hashTxAuxData), Redeemers (..), auxDataHashTxBodyL, auxDataTxL, bodyTxL, inputsTxBodyL, mintTxBodyL, - mkAlonzoTxAuxData, outputsTxBodyL, rdmrsTxWitsL, referenceInputsTxBodyL, @@ -33,7 +32,7 @@ import Cardano.Ledger.Api ( unRedeemers, witsTxL, ) -import Cardano.Ledger.BaseTypes (StrictMaybe (..), fromSMaybe) +import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Control.Lens ((.~), (<>~), (^.)) import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS @@ -42,7 +41,6 @@ import Data.Map qualified as Map import Data.Sequence.Strict qualified as StrictSeq import Data.Set qualified as Set import Hydra.Cardano.Api.Network (networkIdToNetwork) -import Hydra.Cardano.Api.Prelude (toShelleyMetadata) import Hydra.Chain (CommitBlueprintTx (..), HeadParameters (..)) import Hydra.Chain.Direct.ScriptRegistry (ScriptRegistry (..)) import Hydra.Chain.Direct.TimeHandle (PointInTime) @@ -255,9 +253,8 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, & bodyTxL . referenceInputsTxBodyL <>~ Set.fromList [toLedgerTxIn initialScriptRef] & bodyTxL . outputsTxBodyL .~ StrictSeq.singleton (toLedgerTxOut commitOutput) & bodyTxL . reqSignerHashesTxBodyL <>~ Set.singleton (toLedgerKeyHash vkh) - & bodyTxL . auxDataHashTxBodyL .~ combinedMetadata & bodyTxL . mintTxBodyL .~ mempty - & auxDataTxL .~ addMetadata txAuxMetadata + & addMetadata (mkHydraHeadV1TxName "CommitTx") existingWits = toLedgerTx blueprintTx ^. witsTxL allInputs = ledgerBlueprintTx ^. bodyTxL . inputsTxBodyL blueprintRedeemers = unRedeemers $ toLedgerTx blueprintTx ^. witsTxL . rdmrsTxWitsL @@ -270,15 +267,18 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, in fromLedgerTx $ ledgerBlueprintTx & wits where - addMetadata newMetadata@(AlonzoTxAuxData metadata' _ _) = - case toLedgerTx blueprintTx ^. auxDataTxL of - SNothing -> SJust newMetadata - SJust (AlonzoTxAuxData metadata timeLocks languageMap) -> - SJust $ - AlonzoTxAuxData - (Map.union metadata metadata') - timeLocks - languageMap + addMetadata (TxMetadata newMetadata) tx = + let + newMetadataMap = toShelleyMetadata newMetadata + newAuxData = + case toLedgerTx blueprintTx ^. auxDataTxL of + SNothing -> AlonzoTxAuxData newMetadataMap mempty mempty + SJust (AlonzoTxAuxData metadata timeLocks languageMap) -> + AlonzoTxAuxData (Map.union metadata newMetadataMap) timeLocks languageMap + in + tx + & auxDataTxL .~ SJust newAuxData + & bodyTxL . auxDataHashTxBodyL .~ SJust (hashTxAuxData newAuxData) -- re-associates final commit tx inputs with the redeemer data from blueprint tx reassociate resolved allInputs = @@ -335,20 +335,8 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, commitDatum = mkTxOutDatumInline $ mkCommitDatum party utxoToCommit (headIdToCurrencySymbol headId) - TxMetadata commitMetadataMap = commitMetadata - - txAuxMetadata = mkAlonzoTxAuxData @[] @LedgerEra (toShelleyMetadata commitMetadataMap) [] - - combinedMetadata = - let existingMetadataMap = fromSMaybe mempty $ getAuxMetadata <$> toLedgerTx blueprintTx ^. auxDataTxL - in SJust . hashAlonzoTxAuxData $ - mkAlonzoTxAuxData @[] @LedgerEra (Map.union (toShelleyMetadata commitMetadataMap) existingMetadataMap) [] - CommitBlueprintTx{lookupUTxO, blueprintTx} = commitBlueprintTx -commitMetadata :: TxMetadata -commitMetadata = mkHydraHeadV1TxName "CommitTx" - mkCommitDatum :: Party -> UTxO -> CurrencySymbol -> Plutus.Datum mkCommitDatum party utxo headId = Commit.datum (partyToChain party, commits, headId) From 3a842ca0a9a1d2117313d862df8b812731ced54b Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 3 May 2024 19:04:25 +0200 Subject: [PATCH 09/17] Refactor redeemer update in commitTx This is hopefully a bit clearer to read and maintain going forward. --- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 95 ++++++++++++------------- 1 file changed, 47 insertions(+), 48 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index c36998022b6..fa6173f963d 100644 --- 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 (..)) import Cardano.Ledger.Api ( AlonzoPlutusPurpose (..), AsIndex (..), + AsItem (..), EraTxAuxData (hashTxAuxData), Redeemers (..), auxDataHashTxBodyL, @@ -32,6 +33,7 @@ import Cardano.Ledger.Api ( unRedeemers, witsTxL, ) +import Cardano.Ledger.Babbage.Core (redeemerPointerInverse) import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Control.Lens ((.~), (<>~), (^.)) import Data.Aeson qualified as Aeson @@ -246,26 +248,16 @@ commitTx :: (TxIn, TxOut CtxUTxO, Hash PaymentKey) -> Tx commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, out, vkh) = - let - ledgerBlueprintTx = - toLedgerTx blueprintTx - & bodyTxL . inputsTxBodyL <>~ Set.singleton (toLedgerTxIn initialInput) - & bodyTxL . referenceInputsTxBodyL <>~ Set.fromList [toLedgerTxIn initialScriptRef] - & bodyTxL . outputsTxBodyL .~ StrictSeq.singleton (toLedgerTxOut commitOutput) - & bodyTxL . reqSignerHashesTxBodyL <>~ Set.singleton (toLedgerKeyHash vkh) - & bodyTxL . mintTxBodyL .~ mempty - & addMetadata (mkHydraHeadV1TxName "CommitTx") - existingWits = toLedgerTx blueprintTx ^. witsTxL - allInputs = ledgerBlueprintTx ^. bodyTxL . inputsTxBodyL - blueprintRedeemers = unRedeemers $ toLedgerTx blueprintTx ^. witsTxL . rdmrsTxWitsL - resolved = resolveRedeemers blueprintRedeemers committedTxIns - wits = - witsTxL - .~ ( existingWits - & rdmrsTxWitsL .~ Redeemers (Map.fromList $ reassociate resolved allInputs) - ) - in - fromLedgerTx $ ledgerBlueprintTx & wits + -- NOTE: We use the cardano-ledger-api functions here such that we can use the + -- blueprint transaction as a starting point (cardano-api does not allow + -- convenient transaction modifications). + fromLedgerTx $ + toLedgerTx blueprintTx + & spendFromInitial + & bodyTxL . outputsTxBodyL .~ StrictSeq.singleton (toLedgerTxOut commitOutput) + & bodyTxL . reqSignerHashesTxBodyL <>~ Set.singleton (toLedgerKeyHash vkh) + & bodyTxL . mintTxBodyL .~ mempty + & addMetadata (mkHydraHeadV1TxName "CommitTx") where addMetadata (TxMetadata newMetadata) tx = let @@ -280,42 +272,49 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, & auxDataTxL .~ SJust newAuxData & bodyTxL . auxDataHashTxBodyL .~ SJust (hashTxAuxData newAuxData) - -- re-associates final commit tx inputs with the redeemer data from blueprint tx - reassociate resolved allInputs = - foldl' - ( \newRedeemerData txin -> - let key = mkSpendingKey $ Set.findIndex txin allInputs - in case find (\(txin', _) -> txin == txin') resolved of - Nothing -> newRedeemerData - Just (_, d) -> - (key, d) : newRedeemerData - ) - [] - allInputs - - -- Creates a list of 'TxIn' paired with redeemer data and also adds the initial txIn and it's redeemer. - resolveRedeemers existingRedeemerMap blueprintInputs = - (toLedgerTxIn initialInput, (toLedgerData @LedgerEra initialRedeemer, ExUnits 0 0)) - : foldl' - ( \pairs txin -> - let key = mkSpendingKey $ Set.findIndex txin blueprintInputs - in case Map.lookup key existingRedeemerMap of - Nothing -> pairs - Just d -> (txin, d) : pairs + spendFromInitial tx = + let newRedeemers = + resolveSpendingRedeemers tx + & Map.insert (toLedgerTxIn initialInput) (toLedgerData @LedgerEra initialRedeemer) + newInputs = tx ^. bodyTxL . inputsTxBodyL <> Set.singleton (toLedgerTxIn initialInput) + in tx + & bodyTxL . inputsTxBodyL .~ newInputs + & bodyTxL . referenceInputsTxBodyL <>~ Set.singleton (toLedgerTxIn initialScriptRef) + & witsTxL . rdmrsTxWitsL .~ mkRedeemers newRedeemers newInputs + + -- Make redeemers (with zeroed units) from a TxIn -> Data map and a set of transaction inputs + mkRedeemers resolved inputs = + Redeemers . Map.fromList $ + foldl' + ( \newRedeemerData txin -> + let ix = fromIntegral $ Set.findIndex txin inputs + in case Map.lookup txin resolved of + Nothing -> newRedeemerData + Just d -> + (AlonzoSpending (AsIndex ix), (d, ExUnits 0 0)) : newRedeemerData ) [] - committedTxIns - - mkSpendingKey i = AlonzoSpending (AsIndex $ fromIntegral i) + inputs + + -- Create a TxIn -> Data map of all spending redeemers + resolveSpendingRedeemers tx = + Map.foldMapWithKey + ( \p (d, _ex) -> + -- XXX: Should soon be available through cardano-ledger-api again + case redeemerPointerInverse (tx ^. bodyTxL) p of + SJust (AlonzoSpending (AsItem txIn)) -> Map.singleton txIn d + _ -> mempty + ) + (unRedeemers $ tx ^. witsTxL . rdmrsTxWitsL) initialScriptRef = fst (initialReference scriptRegistry) initialRedeemer = toScriptData . Initial.redeemer $ - Initial.ViaCommit (toPlutusTxOutRef . fromLedgerTxIn <$> Set.toList committedTxIns) + Initial.ViaCommit (toPlutusTxOutRef <$> committedTxIns) - committedTxIns = toLedgerTx blueprintTx ^. bodyTxL . inputsTxBodyL + committedTxIns = txIns' blueprintTx commitOutput = TxOut commitAddress commitValue commitDatum ReferenceScriptNone @@ -327,7 +326,7 @@ commitTx networkId scriptRegistry headId party commitBlueprintTx (initialInput, mkScriptAddress @PlutusScriptV2 networkId commitScript utxoToCommit = - UTxO.fromPairs $ mapMaybe (\txin -> (txin,) <$> UTxO.resolve txin lookupUTxO) (txIns' blueprintTx) + UTxO.fromPairs $ mapMaybe (\txin -> (txin,) <$> UTxO.resolve txin lookupUTxO) committedTxIns commitValue = txOutValue out <> foldMap txOutValue utxoToCommit From d705836b5132a9bb2ef386e0dd64cf3562279a34 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 3 May 2024 19:11:36 +0200 Subject: [PATCH 10/17] Resolve compiler warning by defining txSpendinUTxO for Payment --- hydra-node/test/Hydra/Model/Payment.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/hydra-node/test/Hydra/Model/Payment.hs b/hydra-node/test/Hydra/Model/Payment.hs index 1d2620b6225..3e71b92c34c 100644 --- a/hydra-node/test/Hydra/Model/Payment.hs +++ b/hydra-node/test/Hydra/Model/Payment.hs @@ -81,7 +81,6 @@ instance HasVariables Payment where getAllVariables _ = mempty -- | Making `Payment` an instance of `IsTx` allows us to use it with `HeadLogic'`s messages. --- FIXME: Missing method implementation instance IsTx Payment where type TxIdType Payment = Int type UTxOType Payment = [(CardanoSigningKey, Value)] @@ -90,6 +89,10 @@ instance IsTx Payment where txSpendingUTxO = error "undefined" balance = foldMap snd hashUTxO = encodeUtf8 . show @Text + txSpendingUTxO = \case + [] -> error "nothing to spend spending" + [(from, value)] -> Payment{from, to = from, value} + _ -> error "cant spend from multiple utxo in one payment" applyTx :: UTxOType Payment -> Payment -> UTxOType Payment applyTx utxo Payment{from, to, value} = From 5eb806f41bc4a672ec5a1581e087247832b19592 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 3 May 2024 19:13:35 +0200 Subject: [PATCH 11/17] Fix changelog --- CHANGELOG.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7ff39f322d2..1e9fdb027e1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,14 @@ changes. from a script `UTxO`, and also unlock more involved use-cases, users need to provide additional unsigned transaction that correctly specifies required data (like redeemers, validity ranges etc.) +- **BREAKING** `hydra-node` `/commit` endpoint now also accepts a + _blueprint/draft_ transaction together with the `UTxO` which is spent in this + transaction. `hydra-node` can still be used like before if the provided + `UTxO` is at public key address. In order to spend from a script `UTxO`, and + also unlock more involved use-cases, users need to provide additional + unsigned transaction that correctly specifies required data (like redeemers, + validity ranges etc.) + - Update navigation and re-organized documentation website https://hydra.family - Updated logos - Removed localization as it got outdated and on-demand site translation tools exist. @@ -37,6 +45,7 @@ changes. - Make `hydra-cluster --devnet` more configurable - Now it is idle by default again and a `--busy` will make it busy respending the same UTxO. + ## [0.16.0] - 2024-04-03 - Tested with `cardano-node 8.9.0`, `cardano-cli 8.20.3.0` and `mithril 2412.0`. From c047623b8c8e99093d81255b48c449da77f4e8a9 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Fri, 3 May 2024 19:32:35 +0200 Subject: [PATCH 12/17] Improve counter examples in in TxSpec Reducing noise in the code and providing more counter examples by DRYing things up a bit. --- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 116 +++++++++---------- 1 file changed, 54 insertions(+), 62 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index 8eacc4f7990..ba688eb5b95 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -209,69 +209,49 @@ spec = forAllBlind arbitrary $ \chainContext -> do let ChainContext{networkId, ownVerificationKey, ownParty, scriptRegistry} = chainContext{ownVerificationKey = getVerificationKey commitSigningKey, networkId = testNetworkId} - forAll genBlueprintTxWithUTxO $ \(lookupUTxO, blueprintTx') -> do - let commitTx' = - commitTx - networkId - scriptRegistry - (mkHeadId Fixture.testPolicyId) - ownParty - CommitBlueprintTx{lookupUTxO, blueprintTx = blueprintTx'} - (healthyInitialTxIn, toUTxOContext healthyInitialTxOut, verificationKeyHash ownVerificationKey) - let blueprintTx = toLedgerTx blueprintTx' - let blueprintBody = blueprintTx ^. bodyTxL - let tx = toLedgerTx commitTx' - let commitTxBody = tx ^. bodyTxL - - let spendableUTxO = - UTxO.singleton (healthyInitialTxIn, toUTxOContext healthyInitialTxOut) - <> lookupUTxO - <> registryUTxO scriptRegistry - - conjoin - [ propTransactionEvaluates (blueprintTx', lookupUTxO) - & counterexample ("Blueprint transaction failed to evaluate: " <> renderTxWithUTxO lookupUTxO blueprintTx') - , propTransactionEvaluates (commitTx', spendableUTxO) - & counterexample ("Commit transaction failed to evaluate: " <> renderTxWithUTxO spendableUTxO commitTx') - , conjoin - [ getAuxMetadata blueprintTx' `Map.isSubmapOf` getAuxMetadata commitTx' - & counterexample ("blueprint metadata: " <> show (getAuxMetadata blueprintTx')) - & counterexample ("commit metadata: " <> show (getAuxMetadata commitTx')) - , propHasValidAuxData blueprintTx' - & counterexample "Blueprint tx has invalid aux data" - , propHasValidAuxData commitTx' - & counterexample "Commit tx has invalid aux data" + forAllBlind genBlueprintTxWithUTxO $ \(lookupUTxO, blueprintTx) -> + counterexample ("Blueprint tx: " <> renderTxWithUTxO lookupUTxO blueprintTx) $ do + let createdTx = + commitTx + networkId + scriptRegistry + (mkHeadId Fixture.testPolicyId) + ownParty + CommitBlueprintTx{lookupUTxO, blueprintTx} + (healthyInitialTxIn, toUTxOContext healthyInitialTxOut, verificationKeyHash ownVerificationKey) + counterexample ("\n\n\nCommit tx: " <> renderTxWithUTxO lookupUTxO createdTx) $ do + let blueprintBody = toLedgerTx blueprintTx ^. bodyTxL + let commitTxBody = toLedgerTx createdTx ^. bodyTxL + let spendableUTxO = + UTxO.singleton (healthyInitialTxIn, toUTxOContext healthyInitialTxOut) + <> lookupUTxO + <> registryUTxO scriptRegistry + + conjoin + [ propTransactionEvaluates (blueprintTx, lookupUTxO) + & counterexample "Blueprint transaction failed to evaluate" + , propTransactionEvaluates (createdTx, spendableUTxO) + & counterexample "Commit transaction failed to evaluate" + , conjoin + [ getAuxMetadata blueprintTx `propIsSubmapOf` getAuxMetadata createdTx + & counterexample "Blueprint metadata incomplete" + , propHasValidAuxData blueprintTx + & counterexample "Blueprint tx has invalid aux data" + , propHasValidAuxData createdTx + & counterexample "Commit tx has invalid aux data" + ] + , blueprintBody ^. vldtTxBodyL === commitTxBody ^. vldtTxBodyL + & counterexample "Validity range mismatch" + , (blueprintBody ^. inputsTxBodyL) `propIsSubsetOf` (commitTxBody ^. inputsTxBodyL) + & counterexample "Blueprint inputs missing" + , property + ((`all` (blueprintBody ^. outputsTxBodyL)) (`notElem` (commitTxBody ^. outputsTxBodyL))) + & counterexample "Blueprint outputs not discarded" + , (blueprintBody ^. reqSignerHashesTxBodyL) `propIsSubsetOf` (commitTxBody ^. reqSignerHashesTxBodyL) + & counterexample "Blueprint required signatures missing" + , (blueprintBody ^. referenceInputsTxBodyL) `propIsSubsetOf` (commitTxBody ^. referenceInputsTxBodyL) + & counterexample "Blueprint reference inputs missing" ] - , let blueprintValidity = blueprintBody ^. vldtTxBodyL - commitValidity = commitTxBody ^. vldtTxBodyL - in blueprintValidity === commitValidity - & counterexample ("blueprint validity: " <> show blueprintValidity) - & counterexample ("commit validity: " <> show commitValidity) - , let blueprintInputs = blueprintBody ^. inputsTxBodyL - commitInputs = commitTxBody ^. inputsTxBodyL - in property (blueprintInputs `Set.isSubsetOf` commitInputs) - & counterexample ("blueprint inputs: " <> show blueprintInputs) - & counterexample ("commit inputs: " <> show commitInputs) - , let blueprintOutputs = toList $ blueprintBody ^. outputsTxBodyL - commitOutputs = toList $ commitTxBody ^. outputsTxBodyL - in property - ( all - (`notElem` blueprintOutputs) - commitOutputs - ) - & counterexample ("blueprint outputs: " <> show blueprintOutputs) - & counterexample ("commit outputs: " <> show commitOutputs) - , let blueprintSigs = blueprintBody ^. reqSignerHashesTxBodyL - commitSigs = commitTxBody ^. reqSignerHashesTxBodyL - in property (blueprintSigs `Set.isSubsetOf` commitSigs) - & counterexample ("blueprint signatures: " <> show blueprintSigs) - & counterexample ("commit signatures: " <> show commitSigs) - , let blueprintRefInputs = blueprintBody ^. referenceInputsTxBodyL - commitRefInputs = commitTxBody ^. referenceInputsTxBodyL - in property (blueprintRefInputs `Set.isSubsetOf` commitRefInputs) - & counterexample ("blueprint reference inputs: " <> show blueprintRefInputs) - & counterexample ("commit reference inputs: " <> show commitRefInputs) - ] -- | Check auxiliary data of a transaction against 'pparams' and whether the aux -- data hash is consistent. @@ -290,6 +270,18 @@ propHasValidAuxData tx = toLedgerTx tx ^. bodyTxL . auxDataHashTxBodyL === SJust (hashTxAuxData auxData) & counterexample "Auxiliary data hash inconsistent" +-- | Check whether one set 'isSubsetOf' of another with nice counter examples. +propIsSubsetOf :: (Show a, Ord a) => Set a -> Set a -> Property +propIsSubsetOf as bs = + as `Set.isSubsetOf` bs + & counterexample (show as <> "\n is not a subset of\n" <> show bs) + +-- | Check whether one map 'isSubmapOf' of another with nice counter examples. +propIsSubmapOf :: (Show k, Show v, Ord k, Eq v) => Map k v -> Map k v -> Property +propIsSubmapOf as bs = + as `Map.isSubmapOf` bs + & counterexample (show as <> "\n is not a submap of\n" <> show bs) + genBlueprintTxWithUTxO :: Gen (UTxO, Tx) genBlueprintTxWithUTxO = fmap (second unsafeBuildTransaction) $ From d54a8894fe973871f7a3c54ea6322dcdc4264223 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 6 May 2024 10:20:00 +0200 Subject: [PATCH 13/17] Generate blueprints spending from key AND script This was not covered before and seems like we have failing transactions now. --- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index ba688eb5b95..934c8e84453 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -94,7 +94,6 @@ import Test.Cardano.Ledger.Shelley.Arbitrary (genMetadata') import Test.Hydra.Fixture (genForParty) import Test.Hydra.Prelude import Test.QuickCheck ( - Positive (..), Property, checkCoverage, choose, @@ -290,11 +289,10 @@ genBlueprintTxWithUTxO = >>= addSomeReferenceInputs >>= addValidityRange >>= addRandomMetadata - >>= removeRandomInputs >>= addCollateralInput where spendingPubKeyOutput (utxo, txbody) = do - utxoToSpend <- (genUTxOAdaOnlyOfSize . getPositive) . Positive =<< choose (0, 50) + utxoToSpend <- genUTxOAdaOnlyOfSize =<< choose (0, 3) pure ( utxo <> utxoToSpend , txbody & addVkInputs (toList $ UTxO.inputSet utxoToSpend) @@ -303,8 +301,7 @@ genBlueprintTxWithUTxO = spendSomeScriptInputs (utxo, txbody) = do let alwaysSucceedingScript = PlutusScriptSerialised $ Plutus.alwaysSucceedingNAryFunction 3 datum <- unsafeHashableScriptData . fromPlutusData <$> arbitrary - redeemer <- - unsafeHashableScriptData . fromPlutusData <$> arbitrary -- . B . BS.pack <$> vector n + redeemer <- unsafeHashableScriptData . fromPlutusData <$> arbitrary let genTxOut = do value <- genValue let scriptAddress = mkScriptAddress testNetworkId alwaysSucceedingScript @@ -340,10 +337,6 @@ genBlueprintTxWithUTxO = mtdt <- genMetadata pure (utxo, txbody{txMetadata = mtdt}) - removeRandomInputs (utxo, txbody) = do - someInput <- elements $ txIns txbody - pure (utxo, txbody{txIns = [someInput]}) - addCollateralInput (utxo, txbody) = do utxoToSpend <- genUTxOAdaOnlyOfSize 1 pure @@ -369,6 +362,7 @@ prop_interestingBlueprintTx = do True & cover 1 (spendsFromScript (utxo, tx)) "blueprint spends script UTxO" & cover 1 (spendsFromPubKey (utxo, tx)) "blueprint spends pub key UTxO" + & cover 1 (spendsFromPubKey (utxo, tx) && spendsFromScript (utxo, tx)) "blueprint spends from script AND pub key" & cover 1 (hasReferenceInputs tx) "blueprint has reference input" where hasReferenceInputs tx = From bfc4c9ecf6e49009c2f775448d07e3271883c864 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 8 May 2024 10:48:51 +0200 Subject: [PATCH 14/17] Maybe fix toLedgerTx in presence of aux data changes We suspect that toLedgerTx is incomplete if the cardano-api Tx was modified in it's auxiliary data. --- hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs index 5d23c6984be..fd85dbfdaf1 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs @@ -32,6 +32,7 @@ import Cardano.Ledger.Api ( datsTxWitsL, feeTxBodyL, hashScriptTxWitsL, + hashTxAuxData, inputsTxBodyL, isValidTxL, mintTxBodyL, @@ -56,7 +57,7 @@ import Cardano.Ledger.Api qualified as Ledger import Cardano.Ledger.Babbage qualified as Ledger import Cardano.Ledger.Babbage.Tx qualified as Ledger import Cardano.Ledger.Babbage.TxWits (upgradeTxDats) -import Cardano.Ledger.BaseTypes (maybeToStrictMaybe, strictMaybeToMaybe) +import Cardano.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe, strictMaybeToMaybe) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Scripts (PlutusScript (..)) import Cardano.Ledger.Conway.Scripts qualified as Conway @@ -225,7 +226,9 @@ toLedgerTx = \case & hashScriptTxWitsL .~ scripts & datsTxWitsL .~ datums & rdmrsTxWitsL .~ redeemers - in mkBasicTx body + in mkBasicTx + -- TODO: Test that aux data hash is correctly updated in conversions + (body & auxDataHashTxBodyL .~ maybe SNothing (SJust . hashTxAuxData) auxData) & isValidTxL .~ toLedgerScriptValidity validity & auxDataTxL .~ maybeToStrictMaybe auxData & witsTxL .~ wits From e06353dba4fe83e7673247bba60e7edf4694f7b7 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Wed, 8 May 2024 14:56:01 +0200 Subject: [PATCH 15/17] Recalculate aux data hash on conversion and test it On each conversion we need to recalculate the aux data hash since cardano-api does not provide a way to set the data hash and on top of it it seems that it removes it completely. Add a roundtrip test to assert the metadata is correctly converted. --- hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs | 4 ++-- hydra-node/test/Hydra/Ledger/CardanoSpec.hs | 10 +++++++++- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs index fd85dbfdaf1..8fb4b5766e1 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs @@ -227,7 +227,6 @@ toLedgerTx = \case & datsTxWitsL .~ datums & rdmrsTxWitsL .~ redeemers in mkBasicTx - -- TODO: Test that aux data hash is correctly updated in conversions (body & auxDataHashTxBodyL .~ maybe SNothing (SJust . hashTxAuxData) auxData) & isValidTxL .~ toLedgerScriptValidity validity & auxDataTxL .~ maybeToStrictMaybe auxData @@ -237,12 +236,13 @@ toLedgerTx = \case fromLedgerTx :: Ledger.Tx (ShelleyLedgerEra Era) -> Tx Era fromLedgerTx ledgerTx = Tx - (ShelleyTxBody shelleyBasedEra body scripts scriptsData (strictMaybeToMaybe auxData) validity) + (ShelleyTxBody shelleyBasedEra body' scripts scriptsData (strictMaybeToMaybe auxData) validity) (fromLedgerTxWitness wits) where -- XXX: The suggested way (by the ledger team) forward is to use lenses to -- introspect ledger transactions. Ledger.AlonzoTx body wits isValid auxData = ledgerTx + body' = body & auxDataHashTxBodyL .~ (hashTxAuxData <$> auxData) scripts = Map.elems $ Ledger.txscripts' wits diff --git a/hydra-node/test/Hydra/Ledger/CardanoSpec.hs b/hydra-node/test/Hydra/Ledger/CardanoSpec.hs index b1bd3e38ae1..3dbed3aca5c 100644 --- a/hydra-node/test/Hydra/Ledger/CardanoSpec.hs +++ b/hydra-node/test/Hydra/Ledger/CardanoSpec.hs @@ -8,9 +8,11 @@ import Hydra.Prelude import Test.Hydra.Prelude import Cardano.Binary (decodeFull, serialize') -import Cardano.Ledger.Api (ensureMinCoinTxOut) +import Cardano.Ledger.Api (auxDataHashTxBodyL, bodyTxL, ensureMinCoinTxOut) +import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Core (PParams ()) import Cardano.Ledger.Credential (Credential (..)) +import Control.Lens ((.~)) import Data.Aeson (eitherDecode, encode) import Data.Aeson qualified as Aeson import Data.Aeson.Lens (key) @@ -71,6 +73,8 @@ spec = prop "Roundtrip to and from Ledger" roundtripLedger + prop "Roundtrip tx metadata" roundtripTxMetadata + prop "Roundtrip CBOR encoding" $ roundtripCBOR @Tx prop "JSON encoding of Tx according to schema" $ @@ -152,6 +156,10 @@ roundtripLedger :: Tx -> Property roundtripLedger tx = fromLedgerTx (toLedgerTx tx) === tx +roundtripTxMetadata :: Tx -> Property +roundtripTxMetadata tx = + fromLedgerTx (toLedgerTx tx & bodyTxL . auxDataHashTxBodyL .~ SNothing) === tx + roundtripCBOR :: (Eq a, Show a, ToCBOR a, FromCBOR a) => a -> Property roundtripCBOR a = let encoded = serialize' a From e994c7055b7f2c01788b363aa6c658da28fdcd1f Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 13 May 2024 18:21:24 +0200 Subject: [PATCH 16/17] Define toLedgerTx and fromLedgerTx using ShelleyTx The cardano-api Tx type is just a wrapper around the ledger and we should be using that data constructor to do this "conversion". This also drops a test for "self-healing" auxiliary data hashes, but we did not require that in the first place: if you modify a transaction using the ledger-api, make sure to re-compute the auxDataHashTxBodyL. --- hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs | 67 +++---------------- hydra-node/test/Hydra/Ledger/CardanoSpec.hs | 10 +-- 2 files changed, 9 insertions(+), 68 deletions(-) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs index 8fb4b5766e1..a38accdc1af 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs @@ -2,13 +2,6 @@ module Hydra.Cardano.Api.Tx where import Hydra.Cardano.Api.Prelude -import Hydra.Cardano.Api.KeyWitness ( - fromLedgerTxWitness, - toLedgerBootstrapWitness, - toLedgerKeyWitness, - ) -import Hydra.Cardano.Api.TxScriptValidity (toLedgerScriptValidity) - import Cardano.Api.UTxO qualified as UTxO import Cardano.Ledger.Allegra.Scripts (translateTimelock) import Cardano.Ledger.Alonzo qualified as Ledger @@ -31,8 +24,6 @@ import Cardano.Ledger.Api ( dataTxOutL, datsTxWitsL, feeTxBodyL, - hashScriptTxWitsL, - hashTxAuxData, inputsTxBodyL, isValidTxL, mintTxBodyL, @@ -55,9 +46,8 @@ import Cardano.Ledger.Api ( ) import Cardano.Ledger.Api qualified as Ledger import Cardano.Ledger.Babbage qualified as Ledger -import Cardano.Ledger.Babbage.Tx qualified as Ledger import Cardano.Ledger.Babbage.TxWits (upgradeTxDats) -import Cardano.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe, strictMaybeToMaybe) +import Cardano.Ledger.BaseTypes (maybeToStrictMaybe) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Scripts (PlutusScript (..)) import Cardano.Ledger.Conway.Scripts qualified as Conway @@ -207,55 +197,14 @@ txFee' (getTxBody -> TxBody body) = -- | Convert a cardano-api 'Tx' into a matching cardano-ledger 'Tx'. toLedgerTx :: - forall era. - ( Ledger.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto - , Ledger.AlonzoEraTx (ShelleyLedgerEra era) - ) => Tx era -> Ledger.Tx (ShelleyLedgerEra era) -toLedgerTx = \case - Tx (ShelleyTxBody _era body scripts scriptsData auxData validity) vkWits -> - let (datums, redeemers) = - case scriptsData of - TxBodyScriptData _ ds rs -> (ds, rs) - TxBodyNoScriptData -> (mempty, Ledger.Redeemers mempty) - wits = - mkBasicTxWits - & addrTxWitsL .~ toLedgerKeyWitness vkWits - & bootAddrTxWitsL .~ toLedgerBootstrapWitness vkWits - & hashScriptTxWitsL .~ scripts - & datsTxWitsL .~ datums - & rdmrsTxWitsL .~ redeemers - in mkBasicTx - (body & auxDataHashTxBodyL .~ maybe SNothing (SJust . hashTxAuxData) auxData) - & isValidTxL .~ toLedgerScriptValidity validity - & auxDataTxL .~ maybeToStrictMaybe auxData - & witsTxL .~ wits +toLedgerTx (ShelleyTx _era tx) = tx -- | Convert a cardano-ledger's 'Tx' in the Babbage era into a cardano-api 'Tx'. -fromLedgerTx :: Ledger.Tx (ShelleyLedgerEra Era) -> Tx Era -fromLedgerTx ledgerTx = - Tx - (ShelleyTxBody shelleyBasedEra body' scripts scriptsData (strictMaybeToMaybe auxData) validity) - (fromLedgerTxWitness wits) - where - -- XXX: The suggested way (by the ledger team) forward is to use lenses to - -- introspect ledger transactions. - Ledger.AlonzoTx body wits isValid auxData = ledgerTx - body' = body & auxDataHashTxBodyL .~ (hashTxAuxData <$> auxData) - - scripts = - Map.elems $ Ledger.txscripts' wits - - scriptsData :: TxBodyScriptData Era - scriptsData = - TxBodyScriptData - alonzoEraOnwards - (Ledger.txdats' wits) - (Ledger.txrdmrs' wits) - - validity = case isValid of - Ledger.IsValid True -> - TxScriptValidity alonzoEraOnwards ScriptValid - Ledger.IsValid False -> - TxScriptValidity alonzoEraOnwards ScriptInvalid +fromLedgerTx :: + IsShelleyBasedEra era => + Ledger.Tx (ShelleyLedgerEra era) -> + Tx era +fromLedgerTx = + ShelleyTx shelleyBasedEra diff --git a/hydra-node/test/Hydra/Ledger/CardanoSpec.hs b/hydra-node/test/Hydra/Ledger/CardanoSpec.hs index 3dbed3aca5c..b1bd3e38ae1 100644 --- a/hydra-node/test/Hydra/Ledger/CardanoSpec.hs +++ b/hydra-node/test/Hydra/Ledger/CardanoSpec.hs @@ -8,11 +8,9 @@ import Hydra.Prelude import Test.Hydra.Prelude import Cardano.Binary (decodeFull, serialize') -import Cardano.Ledger.Api (auxDataHashTxBodyL, bodyTxL, ensureMinCoinTxOut) -import Cardano.Ledger.BaseTypes (StrictMaybe (..)) +import Cardano.Ledger.Api (ensureMinCoinTxOut) import Cardano.Ledger.Core (PParams ()) import Cardano.Ledger.Credential (Credential (..)) -import Control.Lens ((.~)) import Data.Aeson (eitherDecode, encode) import Data.Aeson qualified as Aeson import Data.Aeson.Lens (key) @@ -73,8 +71,6 @@ spec = prop "Roundtrip to and from Ledger" roundtripLedger - prop "Roundtrip tx metadata" roundtripTxMetadata - prop "Roundtrip CBOR encoding" $ roundtripCBOR @Tx prop "JSON encoding of Tx according to schema" $ @@ -156,10 +152,6 @@ roundtripLedger :: Tx -> Property roundtripLedger tx = fromLedgerTx (toLedgerTx tx) === tx -roundtripTxMetadata :: Tx -> Property -roundtripTxMetadata tx = - fromLedgerTx (toLedgerTx tx & bodyTxL . auxDataHashTxBodyL .~ SNothing) === tx - roundtripCBOR :: (Eq a, Show a, ToCBOR a, FromCBOR a) => a -> Property roundtripCBOR a = let encoded = serialize' a From f3ba1380df2f18a0b38d451be124620d3772ca78 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 16 May 2024 12:14:06 +0200 Subject: [PATCH 17/17] Update changelog --- CHANGELOG.md | 18 ++++-------------- hydra-node/test/Hydra/Model/Payment.hs | 1 - 2 files changed, 4 insertions(+), 15 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1e9fdb027e1..16ff45106c7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,19 +10,10 @@ changes. ## [0.17.0] - UNRELEASED -- **BREAKING** `hydra-node` `/commit` enpoint now also accepts a _blueprint/draft_ - transaction together with the `UTxO` which is spent in this transaction. `hydra-node` can - still be used like before if the provided `UTxO` is at public key address. In order to spend - from a script `UTxO`, and also unlock more involved use-cases, users need to provide additional - unsigned transaction that correctly specifies required data (like redeemers, validity ranges etc.) - -- **BREAKING** `hydra-node` `/commit` endpoint now also accepts a - _blueprint/draft_ transaction together with the `UTxO` which is spent in this - transaction. `hydra-node` can still be used like before if the provided - `UTxO` is at public key address. In order to spend from a script `UTxO`, and - also unlock more involved use-cases, users need to provide additional - unsigned transaction that correctly specifies required data (like redeemers, - validity ranges etc.) +- **BREAKING** Change `hydra-node` API `/commit` endpoint for committing from scripts:o + - Instead of the custom `witness` extension of `UTxO`, the endpoint now accepts a _blueprint_ transaction together with the `UTxO` which is spent in this transaction. + - Usage is still the same for commiting "normal" `UTxO` owned by public key addresses. + - Spending from a script `UTxO` now needs the `blueprintTx` request type, which also unlocks more involved use-cases, where the commit transaction should also satisfy script spending constraints (like additional signers, validity ranges etc.) - Update navigation and re-organized documentation website https://hydra.family - Updated logos @@ -45,7 +36,6 @@ changes. - Make `hydra-cluster --devnet` more configurable - Now it is idle by default again and a `--busy` will make it busy respending the same UTxO. - ## [0.16.0] - 2024-04-03 - Tested with `cardano-node 8.9.0`, `cardano-cli 8.20.3.0` and `mithril 2412.0`. diff --git a/hydra-node/test/Hydra/Model/Payment.hs b/hydra-node/test/Hydra/Model/Payment.hs index 3e71b92c34c..6a98d32cb67 100644 --- a/hydra-node/test/Hydra/Model/Payment.hs +++ b/hydra-node/test/Hydra/Model/Payment.hs @@ -86,7 +86,6 @@ instance IsTx Payment where type UTxOType Payment = [(CardanoSigningKey, Value)] type ValueType Payment = Value txId = error "undefined" - txSpendingUTxO = error "undefined" balance = foldMap snd hashUTxO = encodeUtf8 . show @Text txSpendingUTxO = \case