From c99fdc4716d264b3c115cd84b37e9a8fcbc25bd0 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 29 Jun 2026 15:15:41 -0400 Subject: [PATCH 1/2] Use Exp.TxOut directly in Compatible/TxOut; simplify Byron output types --- ...i_jordan.millar_use_exp_txout_directly.yml | 9 + cardano-cli/src/Cardano/CLI/Byron/Command.hs | 5 +- cardano-cli/src/Cardano/CLI/Byron/Parser.hs | 24 +-- cardano-cli/src/Cardano/CLI/Byron/Run.hs | 5 +- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 29 +++- .../CLI/Compatible/Transaction/TxOut.hs | 158 ++++++++++-------- 6 files changed, 136 insertions(+), 94 deletions(-) create mode 100644 .changes/20260629_152640_cardano-cli_jordan.millar_use_exp_txout_directly.yml diff --git a/.changes/20260629_152640_cardano-cli_jordan.millar_use_exp_txout_directly.yml b/.changes/20260629_152640_cardano-cli_jordan.millar_use_exp_txout_directly.yml new file mode 100644 index 0000000000..cc8854c374 --- /dev/null +++ b/.changes/20260629_152640_cardano-cli_jordan.millar_use_exp_txout_directly.yml @@ -0,0 +1,9 @@ +project: cardano-cli + +pr: 1392 + +kind: + - refactoring + +description: | + Build Exp.TxOut directly via ledger constructors in Compatible/Transaction/TxOut, eliminating the TxOut CtxTx era intermediate. Simplify Byron output types to (Address ByronAddr, L.Coin) throughout the Byron command path. diff --git a/cardano-cli/src/Cardano/CLI/Byron/Command.hs b/cardano-cli/src/Cardano/CLI/Byron/Command.hs index dcef57f0d5..ed3284ac38 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Command.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Command.hs @@ -13,6 +13,7 @@ where import Cardano.Api hiding (GenesisParameters) import Cardano.Api.Byron qualified as Byron +import Cardano.Api.Ledger qualified as L import Cardano.CLI.Byron.Genesis import Cardano.CLI.Byron.Key @@ -67,7 +68,7 @@ data ByronCommand -- ^ Signing key of genesis UTxO owner. (Address ByronAddr) -- ^ Genesis UTxO address. - [TxOut CtxTx ByronEra] + [(Address ByronAddr, L.Coin)] -- ^ Tx output. | SpendUTxO NetworkId @@ -78,7 +79,7 @@ data ByronCommand -- ^ Signing key of Tx underwriter. [TxIn] -- ^ Inputs available for spending to the Tx underwriter's key. - [TxOut CtxTx ByronEra] + [(Address ByronAddr, L.Coin)] -- ^ Genesis UTxO output Address. | GetTxId (TxFile In) | --- Misc Commands --- diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parser.hs b/cardano-cli/src/Cardano/CLI/Byron/Parser.hs index 28f6e650c9..1f36693bc5 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Parser.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Parser.hs @@ -282,33 +282,25 @@ parseTxIdAtto = ( "Transaction ID (hexadecimal)") $ do parseTxIxAtto :: Atto.Parser TxIx parseTxIxAtto = toEnum <$> Atto.decimal -parseTxOut :: Parser (TxOut CtxTx ByronEra) +parseTxOut :: Parser (Address ByronAddr, L.Coin) parseTxOut = Opt.option - ( ( \(addr, lovelace) -> - TxOut - (pAddressInEra addr) - (pLovelaceTxOut lovelace) - TxOutDatumNone - ReferenceScriptNone - ) - <$> auto - ) + ((\(addr, lovelace) -> (parseByronAddr addr, pLovelaceCoin lovelace)) <$> auto) $ long "txout" <> metavar "'(\"ADDR\", LOVELACE)'" <> help "Specify a transaction output, as a pair of an address and lovelace." where - pAddressInEra :: Text -> AddressInEra ByronEra - pAddressInEra t = + parseByronAddr :: Text -> Address ByronAddr + parseByronAddr t = case Byron.decodeAddressBase58 t of Left err -> error $ "Bad Base58 address: " <> show err - Right byronAddress -> AddressInEra ByronAddressInAnyEra $ ByronAddress byronAddress + Right byronAddress -> ByronAddress byronAddress - pLovelaceTxOut :: Word64 -> TxOutValue ByronEra - pLovelaceTxOut l = + pLovelaceCoin :: Word64 -> L.Coin + pLovelaceCoin l = if l > (maxBound :: Word64) then error $ show l <> " lovelace exceeds the Word64 upper bound" - else TxOutValueByron $ L.Coin $ toInteger l + else L.Coin $ toInteger l readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a readerFromAttoParser p = diff --git a/cardano-cli/src/Cardano/CLI/Byron/Run.hs b/cardano-cli/src/Cardano/CLI/Byron/Run.hs index af82e74392..70fc25e0a9 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Run.hs @@ -17,6 +17,7 @@ import Cardano.Api.Byron , VerificationKey (ByronVerificationKey) ) import Cardano.Api.Byron qualified as Byron +import Cardano.Api.Ledger qualified as L import Cardano.CLI.Byron.Command import Cardano.CLI.Byron.Delegation @@ -176,7 +177,7 @@ runSpendGenesisUTxO -> NewTxFile -> SigningKeyFile In -> Address ByronAddr - -> [TxOut CtxTx ByronEra] + -> [(Address ByronAddr, L.Coin)] -> CIO e () runSpendGenesisUTxO genesisFile nw bKeyFormat (NewTxFile ctTx) ctKey genRichAddr outs = do genesis <- fromExceptTCli $ readGenesis genesisFile nw @@ -195,7 +196,7 @@ runSpendUTxO -> NewTxFile -> SigningKeyFile In -> [TxIn] - -> [TxOut CtxTx ByronEra] + -> [(Address ByronAddr, L.Coin)] -> CIO e () runSpendUTxO nw bKeyFormat (NewTxFile ctTx) ctKey ins outs = do sk <- fromExceptTCli $ readByronSigningKey bKeyFormat ctKey diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 606605b396..a004fa4387 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -144,11 +144,20 @@ txSpendGenesisUTxOByronPBFT -> NetworkId -> Byron.SomeByronSigningKey -> Address ByronAddr - -> [TxOut CtxTx ByronEra] + -> [(Address ByronAddr, L.Coin)] -> Byron.ATxAux ByteString -txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = +txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs' = let txins = [(Byron.fromByronTxIn txIn, BuildTxWith (KeyWitness KeyWitnessForSpending))] - in case makeByronTransactionBody txins outs of + outs = + [ TxOut + (AddressInEra ByronAddressInAnyEra addr) + (TxOutValueByron coin) + TxOutDatumNone + ReferenceScriptNone + | (addr, coin) <- outs' + ] + in -- TODO: switch to the ledger's TxOut type for Byron once makeByronTransactionBody is updated + case makeByronTransactionBody txins outs of Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err Right txBody -> let bWit = fromByronWitness sk nId txBody @@ -165,11 +174,19 @@ txSpendUTxOByronPBFT :: NetworkId -> Byron.SomeByronSigningKey -> [TxIn] - -> [TxOut CtxTx ByronEra] + -> [(Address ByronAddr, L.Coin)] -> Byron.ATxAux ByteString -txSpendUTxOByronPBFT nId sk txIns outs = do +txSpendUTxOByronPBFT nId sk txIns outs' = do let apiTxIns = [(txIn, BuildTxWith (KeyWitness KeyWitnessForSpending)) | txIn <- txIns] - + outs = + [ TxOut + (AddressInEra ByronAddressInAnyEra addr) + (TxOutValueByron coin) + TxOutDatumNone + ReferenceScriptNone + | (addr, coin) <- outs' + ] + -- TODO: switch to the ledger's TxOut type for Byron once makeByronTransactionBody is updated case makeByronTransactionBody apiTxIns outs of Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err Right txBody -> diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs index 38be2af237..1353a0a477 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs @@ -18,11 +18,12 @@ import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.Orphan () import Cardano.CLI.Read import Cardano.CLI.Type.Common +import Cardano.Ledger.Api.Tx qualified as L import Cardano.Ledger.Hashes (DataHash) -import Cardano.Ledger.Plutus.Data qualified as L import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map +import Lens.Micro toTxOutInAnyEra :: ShelleyBasedEra era @@ -32,15 +33,6 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do let addr = anyAddressInShelleyBasedEra era addr' mkTxOut era addr val' mDatumHash refScriptFp --- | Build an output for a transaction body. Produces the experimental --- 'Exp.TxOut' plus any supplemental datum bodies that the caller-supplied --- datum carries. The legacy 'TxOut CtxTx era' bundled supplemental datums --- inside outputs; 'Exp.TxOut' only carries the datum hash, so callers thread --- the full datum bodies in separately (e.g. via 'createCompatibleTx'). --- --- The legacy 'TxOut CtxTx era' is used internally as a stepping stone to --- reuse the api's 'toShelleyTxOutAny' field-level conversion logic; it is --- not exposed. mkTxOut :: ShelleyBasedEra era -> AddressInEra era @@ -48,35 +40,94 @@ mkTxOut -> TxOutDatumAnyEra -> ReferenceScriptAnyEra -> CIO e (Exp.TxOut (ShelleyLedgerEra era), Map DataHash (L.Data (ShelleyLedgerEra era))) -mkTxOut sbe addr val' mDatumHash refScriptFp = do - let era = toCardanoEra sbe - val <- toTxOutValueInShelleyBasedEra sbe val' - - datum <- - inEonForEra - (pure TxOutDatumNone) - (`toTxAlonzoDatum` mDatumHash) - era - - refScript <- - inEonForEra - (pure ReferenceScriptNone) - (`getReferenceScript` refScriptFp) - era - - let legacyTxOut = TxOut addr val datum refScript - pure $ - shelleyBasedEraConstraints sbe $ - (Exp.TxOut (toShelleyTxOutAny sbe legacyTxOut), supplementalsOf datum) - where - supplementalsOf - :: L.Era (ShelleyLedgerEra era) - => TxOutDatum CtxTx era - -> Map DataHash (L.Data (ShelleyLedgerEra era)) - supplementalsOf (TxOutSupplementalDatum _ h) = - let ld = toAlonzoData h - in Map.singleton (L.hashData ld) ld - supplementalsOf _ = mempty +mkTxOut sbe addr val' mDatumAnyEra refScriptFp = do + txVal <- toTxOutValueInShelleyBasedEra sbe val' + let ledgerAddr = toShelleyAddr addr + shelleyBasedEraConstraints sbe $ + case txVal of + TxOutValueShelleyBased _ ledgerVal -> + case sbe of + ShelleyBasedEraShelley -> pure (Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal), mempty) + ShelleyBasedEraAllegra -> pure (Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal), mempty) + ShelleyBasedEraMary -> pure (Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal), mempty) + ShelleyBasedEraAlonzo -> do + (mDH, suppl) <- alonzoDatumFields mDatumAnyEra + pure + ( Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal & L.dataHashTxOutL .~ mDH) + , suppl + ) + ShelleyBasedEraBabbage -> do + (dat, suppl) <- babbageDatumFields mDatumAnyEra + refScript <- readRefScript sbe refScriptFp + pure + ( Exp.TxOut + ( L.mkBasicTxOut ledgerAddr ledgerVal + & L.datumTxOutL .~ dat + & L.referenceScriptTxOutL .~ refScript + ) + , suppl + ) + ShelleyBasedEraConway -> do + (dat, suppl) <- babbageDatumFields mDatumAnyEra + refScript <- readRefScript sbe refScriptFp + pure + ( Exp.TxOut + ( L.mkBasicTxOut ledgerAddr ledgerVal + & L.datumTxOutL .~ dat + & L.referenceScriptTxOutL .~ refScript + ) + , suppl + ) + +alonzoDatumFields + :: L.Era ledgerera + => TxOutDatumAnyEra + -> CIO e (L.StrictMaybe DataHash, Map DataHash (L.Data ledgerera)) +alonzoDatumFields = \case + TxOutDatumByNone -> + pure (L.SNothing, mempty) + TxOutDatumByHashOnly h -> + pure (L.SJust (unScriptDataHash h), mempty) + TxOutDatumByHashOf sDataOrFile -> do + sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile + pure (L.SJust (unScriptDataHash (hashScriptDataBytes sData)), mempty) + TxOutDatumByValue sDataOrFile -> do + sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile + let ld = toAlonzoData sData + dh = L.hashData ld + pure (L.SJust dh, Map.singleton dh ld) + TxOutInlineDatumByValue _ -> + throwCliError $ TxCmdTxFeatureMismatch (AnyCardanoEra AlonzoEra) TxFeatureInlineDatums + +babbageDatumFields + :: L.Era ledgerera + => TxOutDatumAnyEra + -> CIO e (L.Datum ledgerera, Map DataHash (L.Data ledgerera)) +babbageDatumFields = \case + TxOutDatumByNone -> + pure (L.NoDatum, mempty) + TxOutDatumByHashOnly h -> + pure (L.DatumHash (unScriptDataHash h), mempty) + TxOutDatumByHashOf sDataOrFile -> do + sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile + pure (L.DatumHash (unScriptDataHash (hashScriptDataBytes sData)), mempty) + TxOutDatumByValue sDataOrFile -> do + sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile + let dh = unScriptDataHash (hashScriptDataBytes sData) + pure (L.DatumHash dh, Map.singleton dh (toAlonzoData sData)) + TxOutInlineDatumByValue sDataOrFile -> do + sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile + pure (scriptDataToInlineDatum sData, mempty) + +readRefScript + :: ShelleyBasedEra era + -> ReferenceScriptAnyEra + -> CIO e (L.StrictMaybe (L.Script (ShelleyLedgerEra era))) +readRefScript sbe = \case + ReferenceScriptAnyEraNone -> pure L.SNothing + ReferenceScriptAnyEra fp -> do + script <- readFileScriptInAnyLang fp + pure $ maybe L.SNothing (L.SJust . toShelleyScript) (toScriptInEra sbe script) toTxOutValueInShelleyBasedEra :: ShelleyBasedEra era @@ -91,35 +142,6 @@ toTxOutValueInShelleyBasedEra sbe val = (\w -> return (TxOutValueShelleyBased sbe (toLedgerValue w val))) sbe -toTxAlonzoDatum - :: () - => AlonzoEraOnwards era - -> TxOutDatumAnyEra - -> CIO e (TxOutDatum CtxTx era) -toTxAlonzoDatum supp cliDatum = - case cliDatum of - TxOutDatumByNone -> pure TxOutDatumNone - TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h) - TxOutDatumByHashOf sDataOrFile -> do - sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile - pure (TxOutDatumHash supp $ hashScriptDataBytes sData) - TxOutDatumByValue sDataOrFile -> do - sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile - pure (TxOutSupplementalDatum supp sData) - TxOutInlineDatumByValue sDataOrFile -> do - let cEra = toCardanoEra supp - forEraInEon cEra (txFeatureMismatch cEra TxFeatureInlineDatums) $ \babbageOnwards -> do - sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile - pure $ TxOutDatumInline babbageOnwards sData - -getReferenceScript - :: BabbageEraOnwards era - -> ReferenceScriptAnyEra - -> CIO e (ReferenceScript era) -getReferenceScript w = \case - ReferenceScriptAnyEraNone -> return ReferenceScriptNone - ReferenceScriptAnyEra fp -> ReferenceScript w <$> readFileScriptInAnyLang fp - -- | An enumeration of era-dependent features where we have to check that it -- is permissible to use this feature in this era. data TxFeature From 6bde6c1c5d6da8777f92daa9ea31b145d279165a Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 30 Jun 2026 13:26:26 -0400 Subject: [PATCH 2/2] Address review comments: fix pLovelaceCoin and align babbageDatumFields - pLovelaceCoin: parse lovelace as Integer; reject negatives and values exceeding the Word64 upper bound with clear error messages (matching the pattern used by parseLovelaceAtto elsewhere in this file) - babbageDatumFields TxOutDatumByValue: convert to ledger data first then hash, matching alonzoDatumFields pattern and avoiding a redundant toAlonzoData call --- cardano-cli/src/Cardano/CLI/Byron/Parser.hs | 17 +++++++++++------ .../Cardano/CLI/Compatible/Transaction/TxOut.hs | 5 +++-- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parser.hs b/cardano-cli/src/Cardano/CLI/Byron/Parser.hs index 1f36693bc5..fca8f88d3e 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Parser.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Parser.hs @@ -285,7 +285,11 @@ parseTxIxAtto = toEnum <$> Atto.decimal parseTxOut :: Parser (Address ByronAddr, L.Coin) parseTxOut = Opt.option - ((\(addr, lovelace) -> (parseByronAddr addr, pLovelaceCoin lovelace)) <$> auto) + ( do + (addr, lovelace) <- auto + coin <- pLovelaceCoin lovelace + pure (parseByronAddr addr, coin) + ) $ long "txout" <> metavar "'(\"ADDR\", LOVELACE)'" <> help "Specify a transaction output, as a pair of an address and lovelace." @@ -296,11 +300,12 @@ parseTxOut = Left err -> error $ "Bad Base58 address: " <> show err Right byronAddress -> ByronAddress byronAddress - pLovelaceCoin :: Word64 -> L.Coin - pLovelaceCoin l = - if l > (maxBound :: Word64) - then error $ show l <> " lovelace exceeds the Word64 upper bound" - else L.Coin $ toInteger l + pLovelaceCoin :: Integer -> Opt.ReadM L.Coin + pLovelaceCoin l + | l < 0 = Opt.readerError $ show l <> " lovelace is negative" + | l > toInteger (maxBound :: Word64) = + Opt.readerError $ show l <> " lovelace exceeds the Word64 upper bound" + | otherwise = pure $ L.Coin l readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a readerFromAttoParser p = diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs index 1353a0a477..657cd5ee1f 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs @@ -113,8 +113,9 @@ babbageDatumFields = \case pure (L.DatumHash (unScriptDataHash (hashScriptDataBytes sData)), mempty) TxOutDatumByValue sDataOrFile -> do sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile - let dh = unScriptDataHash (hashScriptDataBytes sData) - pure (L.DatumHash dh, Map.singleton dh (toAlonzoData sData)) + let ld = toAlonzoData sData + dh = L.hashData ld + pure (L.DatumHash dh, Map.singleton dh ld) TxOutInlineDatumByValue sDataOrFile -> do sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile pure (scriptDataToInlineDatum sData, mempty)