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 ac0435a97d6..61718a7d19d 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -339,7 +339,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 6be421cc140..eda0a142a47 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)]