From e50737f94d1d70487a00609923eb8352921234a8 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 23 Feb 2026 15:01:27 -0400 Subject: [PATCH] Potential supplementary datum fix --- cabal.project | 8 +++ .../Cardano/CLI/EraBased/Transaction/Run.hs | 56 ++++++++++++++----- .../shelley/build-raw-tx-body-out-6.json | 2 +- 3 files changed, 50 insertions(+), 16 deletions(-) diff --git a/cabal.project b/cabal.project index 2e6043e080..ca7bce1f98 100644 --- a/cabal.project +++ b/cabal.project @@ -74,3 +74,11 @@ if impl (ghc >= 9.12) -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-api + tag: 21c8a25e35fdeaf100600500c546874d7def77c0 + subdir: + cardano-api + cardano-api-gen + diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index 15696929ba..fda445704b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -43,6 +43,7 @@ import Cardano.Api.Experimental.AnyScript qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp import Cardano.Api.Experimental.Tx qualified as Exp import Cardano.Api.Ledger qualified as L +import Cardano.Ledger.Hashes (DataHash) import Cardano.Api.Network qualified as Consensus import Cardano.Api.Network qualified as Net.Tx @@ -203,13 +204,14 @@ runTransactionBuildCmd requiredSigners <- mapM (fromEitherIOCli . readRequiredSigner) reqSigners - mReturnCollateral :: Maybe (Exp.TxOut (Exp.LedgerEra era)) <- + mReturnCollateralAndDatums <- forM mReturnColl toTxOutInShelleyBasedEra + let mReturnCollateral = fst <$> mReturnCollateralAndDatums + returnCollDatums = maybe mempty snd mReturnCollateralAndDatums - txOuts <- - mapM - toTxOutInEra - txouts + txOutsAndDatums <- mapM toTxOutInEra txouts + let txOuts = map fst txOutsAndDatums + supplementalDatums = mconcat (map snd txOutsAndDatums) <> returnCollDatums -- Conway related votingProceduresAndMaybeScriptWits :: [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] <- @@ -321,6 +323,7 @@ runTransactionBuildCmd votingProceduresAndMaybeScriptWits proposals currentTreasuryValueAndDonation + supplementalDatums -- TODO: Calculating the script cost should live as a different command. -- Why? Because then we can simply read a txbody and figure out @@ -374,7 +377,7 @@ runTransactionBuildCmd toTxOutInEra :: Exp.IsEra era => TxOutAnyEra - -> CIO e (Exp.TxOut (Exp.LedgerEra era)) + -> CIO e (Exp.TxOut (Exp.LedgerEra era), Map.Map DataHash (L.Data (Exp.LedgerEra era))) toTxOutInEra (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do let addr = anyAddressInShelleyBasedEra (convert Exp.useEra) addr' o <- mkTxOut (convert Exp.useEra) addr val' mDatumHash refScriptFp @@ -445,9 +448,13 @@ runTransactionBuildEstimateCmd -- TODO change type requiredSigners <- mapM (fromEitherIOCli . readRequiredSigner) reqSigners - mReturnCollateral <- mapM toTxOutInShelleyBasedEra mReturnColl + mReturnCollateralAndDatums <- mapM toTxOutInShelleyBasedEra mReturnColl + let mReturnCollateral = fst <$> mReturnCollateralAndDatums + returnCollDatums = maybe mempty snd mReturnCollateralAndDatums - txOuts <- mapM toTxOutInEra txouts + txOutsAndDatums <- mapM toTxOutInEra txouts + let txOuts = map fst txOutsAndDatums + supplementalDatums = mconcat (map snd txOutsAndDatums) <> returnCollDatums -- the same collateral input can be used for several plutus scripts let filteredTxinsc = nubOrd txInsCollateral @@ -498,6 +505,7 @@ runTransactionBuildEstimateCmd -- TODO change type votingProceduresAndMaybeScriptWits proposals currentTreasuryValueAndDonation + supplementalDatums let stakeCredentialsToDeregisterMap = fromList $ catMaybes [getStakeDeregistrationInfo cert | (cert, _) <- certsAndMaybeScriptWits] drepsToDeregisterMap = @@ -653,9 +661,13 @@ runTransactionBuildRawCmd requiredSigners <- mapM (fromEitherIOCli . readRequiredSigner) reqSigners - mReturnCollateral <- mapM toTxOutInShelleyBasedEra mReturnColl + mReturnCollateralAndDatums <- mapM toTxOutInShelleyBasedEra mReturnColl + let mReturnCollateral = fst <$> mReturnCollateralAndDatums + returnCollDatums = maybe mempty snd mReturnCollateralAndDatums - txOuts <- mapM toTxOutInEra txouts + txOutsAndDatums <- mapM toTxOutInEra txouts + let txOuts = map fst txOutsAndDatums + supplementalDatums = mconcat (map snd txOutsAndDatums) <> returnCollDatums -- the same collateral input can be used for several plutus scripts let filteredTxinsc = toList @(Set _) $ fromList txInsCollateral @@ -700,6 +712,7 @@ runTransactionBuildRawCmd votingProceduresAndMaybeScriptWits proposals currentTreasuryValueAndDonation + supplementalDatums let Exp.UnsignedTx lTx = txBody noWitTx = ShelleyTx (convert eon) lTx fromEitherIOCli $ @@ -741,6 +754,8 @@ runTxBuildRaw -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) + -> Map.Map DataHash (L.Data (Exp.LedgerEra era)) + -- ^ Supplemental datums -> Either TxCmdError (Exp.UnsignedTx (Exp.LedgerEra era)) runTxBuildRaw mScriptValidity @@ -762,7 +777,8 @@ runTxBuildRaw mpparams votingProcedures proposals - mCurrentTreasuryValueAndDonation = do + mCurrentTreasuryValueAndDonation + suppDatums = do txBodyContent <- constructTxBodyContent mScriptValidity @@ -785,6 +801,7 @@ runTxBuildRaw votingProcedures proposals mCurrentTreasuryValueAndDonation + suppDatums return $ Exp.makeUnsignedTx Exp.useEra txBodyContent @@ -827,6 +844,8 @@ constructTxBodyContent -- ^ The current treasury value and the donation. This is a stop gap as the -- semantics of the donation and treasury value depend on the script languages -- being used. + -> Map.Map DataHash (L.Data (Exp.LedgerEra era)) + -- ^ Supplemental datums -> Either TxCmdError (Exp.TxBodyContent (Exp.LedgerEra era)) constructTxBodyContent mScriptValidity @@ -848,7 +867,8 @@ constructTxBodyContent txMetadata votingProcedures proposals - mCurrentTreasuryValueAndDonation = + mCurrentTreasuryValueAndDonation + suppDatums = do let allReferenceInputs = getAllReferenceInputs @@ -912,6 +932,7 @@ constructTxBodyContent & Exp.setTxProposalProcedures validatedTxProposals & maybe id Exp.setTxCurrentTreasuryValue validatedCurrentTreasuryValue & maybe id Exp.setTxTreasuryDonation validatedTreasuryDonation + & Exp.setTxSupplementalDatums suppDatums ) convertWithdrawals @@ -978,6 +999,8 @@ runTxBuild -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) -- ^ The current treasury value and the donation. + -> Map.Map DataHash (L.Data (Exp.LedgerEra era)) + -- ^ Supplemental datums -> ExceptT TxCmdError IO (Exp.UnsignedTx (Exp.LedgerEra era), Exp.TxBodyContent (Exp.LedgerEra era)) runTxBuild socketPath @@ -1002,7 +1025,8 @@ runTxBuild mOverrideWits votingProcedures proposals - mCurrentTreasuryValueAndDonation = do + mCurrentTreasuryValueAndDonation + suppDatums = do let sbe = convert (Exp.useEra @era) shelleyBasedEraConstraints sbe $ do -- TODO: All functions should be parameterized by ShelleyBasedEra @@ -1068,6 +1092,7 @@ runTxBuild votingProcedures proposals mCurrentTreasuryValueAndDonation + suppDatums firstExceptT TxCmdTxInsDoNotExist . hoistEither @@ -1156,7 +1181,7 @@ getAllReferenceInputs toTxOutInShelleyBasedEra :: Exp.IsEra era => TxOutShelleyBasedEra - -> CIO e (Exp.TxOut (Exp.LedgerEra era)) + -> CIO e (Exp.TxOut (Exp.LedgerEra era), Map.Map DataHash (L.Data (Exp.LedgerEra era))) toTxOutInShelleyBasedEra (TxOutShelleyBasedEra addr' val' mDatumHash refScriptFp) = do let sbe = convert Exp.useEra addr = shelleyAddressInEra sbe addr' @@ -1439,7 +1464,8 @@ runTransactionCalculateMinValueCmd pp :: L.PParams (Exp.LedgerEra era) <- fromExceptTCli @ProtocolParamsError (obtainCommonConstraints era $ readProtocolParameters protocolParamsFile) - out <- obtainCommonConstraints era $ toTxOutInShelleyBasedEra txOut + (out, _suppDatums :: Map.Map DataHash (L.Data (Exp.LedgerEra era))) <- + obtainCommonConstraints era $ toTxOutInShelleyBasedEra txOut let minValue = Exp.calculateMinimumUTxO pp out liftIO . IO.print $ minValue diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/build-raw-tx-body-out-6.json b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/build-raw-tx-body-out-6.json index 09115d8552..dcea3acf85 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/build-raw-tx-body-out-6.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/build-raw-tx-body-out-6.json @@ -1,5 +1,5 @@ { "type": "Tx ConwayEra", "description": "Ledger Cddl Format", - "cborHex": "84a300d90102818258202392d2b1200b5139fe555c81261697b29a8ccf561c5c783d46e78a479d977053000181a3005839016b837ca50316ee4e00033482ed128887d72c2bae5b0438d692dc1251b0c8b17595ebdb93c1f974be0a9b1ef26c474649d9c2ae766ed135cf011864028201d81842182a020ca104d9010281182af5f6" + "cborHex": "84a300d90102818258202392d2b1200b5139fe555c81261697b29a8ccf561c5c783d46e78a479d977053000181a3005839016b837ca50316ee4e00033482ed128887d72c2bae5b0438d692dc1251b0c8b17595ebdb93c1f974be0a9b1ef26c474649d9c2ae766ed135cf011864028201d81842182a020ca0f5f6" }