Migrate to experimental TxOut in createCompatibleTx

cabal.project

@@ -26,6 +26,29 @@ packages:
 program-options
   ghc-options: -Werror
 
+-- TEMPORARY: build against cardano-api PR #1209
+-- (jordan/remove-legacy-txout-from-compat-and-experimental).
+-- The PR removes legacy TxOut from the Compatible and Experimental APIs,
+-- which this branch migrates cardano-cli to. Remove this stanza and the
+-- per-package warning downgrades below once #1209 is merged and the next
+-- cardano-api release is published to CHaP.
+source-repository-package
+    type: git
+    location: https://github.com/IntersectMBO/cardano-api
+    tag: d848cec1ba4769b9daf4ac5ac9ed61a3f76c8042
+    subdir:
+      cardano-api
+      cardano-api-gen
+
+-- TEMPORARY: the PR branch is several commits ahead of cardano-api-11.1.0.0
+-- and surfaces unrelated TxBody/TxBodyContent deprecations (cardano-api PR
+-- #1200) plus a redundant Cardano.Ledger.Core import in Cardano.CLI.Read
+-- that became visible after upstream re-exports widened. Both are separate
+-- cardano-cli cleanups; downgrade to warnings here so the migration build
+-- is not blocked by them. Remove once the underlying cleanups land.
+package cardano-cli
+  ghc-options: -Wwarn=deprecations -Wwarn=unused-imports
+
 package crypton
   -- Using RDRAND instead of /dev/urandom as an entropy source for key
   -- generation is dubious. Set the flag so we use /dev/urandom by default.

cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs

@@ -33,6 +33,7 @@ where
 import Cardano.Api as Api
 import Cardano.Api.Experimental (obtainCommonConstraints)
 import Cardano.Api.Experimental qualified as Exp
+import Cardano.Api.Experimental.Tx qualified as Exp
 import Cardano.Api.Ledger (ExUnits (..), extractHash, strictMaybeToMaybe)
 import Cardano.Api.Ledger qualified as Alonzo
 import Cardano.Api.Ledger qualified as L
@@ -219,8 +220,7 @@ basePairs
   -> [Aeson.Pair]
 basePairs era body mAuxData =
   Exp.obtainCommonConstraints era $
-    let sbe = convert era :: ShelleyBasedEra era
-        certs = toList (body ^. L.certsTxBodyL)
+    let certs = toList (body ^. L.certsTxBodyL)
      in [ "auxiliary scripts" .= friendlyAuxScripts era mAuxData
         , "certificates"
             .= if null certs
@@ -232,7 +232,7 @@ basePairs era body mAuxData =
         , "metadata" .= friendlyMetadata mAuxData
         , "outputs"
             .= map
-              (friendlyTxOut era . fromCtxUTxOTxOut . fromShelleyTxOut sbe)
+              (friendlyTxOut era . Exp.TxOut)
               (toList (body ^. L.outputsTxBodyL))
         , "withdrawals" .= friendlyWithdrawals (body ^. L.withdrawalsTxBodyL)
         ]
@@ -472,8 +472,7 @@ friendlyReturnCollateral era = \case
   L.SNothing -> Aeson.Null
   L.SJust collOut ->
     Exp.obtainCommonConstraints era $
-      let sbe = convert era :: ShelleyBasedEra era
-       in friendlyTxOut era (fromCtxUTxOTxOut (fromShelleyTxOut sbe collOut))
+      friendlyTxOut era (Exp.TxOut collOut)
 
 friendlyExtraKeyWits :: Set.Set (L.KeyHash L.Guard) -> Aeson.Value
 friendlyExtraKeyWits keyhashes
@@ -499,35 +498,59 @@ friendlyStakeAddress (StakeAddress net cred) =
   , friendlyStakeCredential cred
   ]
 
-friendlyTxOut :: Exp.Era era -> TxOut CtxTx era -> Aeson.Value
-friendlyTxOut era (TxOut addr amount mdatum script) =
+friendlyTxOut
+  :: forall era
+   . Exp.Era era
+  -> Exp.TxOut (Exp.LedgerEra era)
+  -> Aeson.Value
+friendlyTxOut era (Exp.TxOut ledgerTxOut) =
   Exp.obtainCommonConstraints era $
-    object $
-      case addr of
-        AddressInEra ByronAddressInAnyEra byronAdr ->
-          [ "address era" .= String "Byron"
-          , "address" .= serialiseAddress byronAdr
-          , "amount" .= friendlyTxOutValue era amount
-          ]
-        AddressInEra (ShelleyAddressInEra _) saddr@(ShelleyAddress net cred stake) ->
-          let preAlonzo =
-                friendlyPaymentCredential (fromShelleyPaymentCredential cred)
-                  : [ "address era" .= Aeson.String "Shelley"
-                    , "network" .= net
-                    , "address" .= serialiseAddress saddr
-                    , "amount" .= friendlyTxOutValue era amount
-                    , "stake reference" .= friendlyStakeReference (fromShelleyStakeReference stake)
-                    ]
-              datum = ["datum" .= d | d <- maybeToList $ renderDatum mdatum]
-              sinceAlonzo = ["reference script" .= script]
-           in preAlonzo ++ datum ++ sinceAlonzo
+    babbageEraOnwardsConstraints beo $
+      let addr = fromShelleyAddr sbe (ledgerTxOut ^. L.addrTxOutL)
+          ledgerValue = ledgerTxOut ^. L.valueTxOutL
+          refScript = case ledgerTxOut ^. L.referenceScriptTxOutL of
+            L.SNothing -> ReferenceScriptNone
+            L.SJust s -> fromShelleyScriptToReferenceScript sbe s
+       in object $
+            case addr of
+              AddressInEra ByronAddressInAnyEra byronAdr ->
+                [ "address era" .= String "Byron"
+                , "address" .= serialiseAddress byronAdr
+                , "amount" .= friendlyLedgerValue era ledgerValue
+                ]
+              AddressInEra (ShelleyAddressInEra _) saddr@(ShelleyAddress net cred stake) ->
+                let preAlonzo =
+                      friendlyPaymentCredential (fromShelleyPaymentCredential cred)
+                        : [ "address era" .= Aeson.String "Shelley"
+                          , "network" .= net
+                          , "address" .= serialiseAddress saddr
+                          , "amount" .= friendlyLedgerValue era ledgerValue
+                          , "stake reference"
+                              .= friendlyStakeReference (fromShelleyStakeReference stake)
+                          ]
+                    datumField =
+                      [ "datum" .= d
+                      | d <- maybeToList $ renderLedgerDatum beo (ledgerTxOut ^. L.datumTxOutL)
+                      ]
+                    sinceAlonzo = ["reference script" .= refScript]
+                 in preAlonzo ++ datumField ++ sinceAlonzo
  where
-  renderDatum :: TxOutDatum CtxTx era -> Maybe Aeson.Value
-  renderDatum = \case
-    TxOutDatumNone -> Nothing
-    TxOutDatumHash _ h -> Just $ toJSON h
-    TxOutSupplementalDatum _ sData -> Just $ scriptDataToJson ScriptDataJsonDetailedSchema sData
-    TxOutDatumInline _ sData -> Just $ scriptDataToJson ScriptDataJsonDetailedSchema sData
+  beo = convert era :: BabbageEraOnwards era
+  sbe = convert era :: ShelleyBasedEra era
+
+  renderLedgerDatum
+    :: BabbageEraOnwards era
+    -> L.Datum (Exp.LedgerEra era)
+    -> Maybe Aeson.Value
+  renderLedgerDatum w = \case
+    L.NoDatum -> Nothing
+    L.DatumHash dh -> Just $ toJSON (ScriptDataHash dh)
+    L.Datum binData ->
+      babbageEraOnwardsConstraints w $
+        Just $
+          scriptDataToJson
+            ScriptDataJsonDetailedSchema
+            (fromAlonzoData (L.binaryDataToData binData))
 
 friendlyStakeReference :: StakeAddressReference -> Aeson.Value
 friendlyStakeReference = \case
@@ -690,12 +713,6 @@ friendlyPaymentCredential = \case
 friendlyLovelace :: Lovelace -> Aeson.Value
 friendlyLovelace value = String $ docToText (pretty value)
 
-friendlyTxOutValue :: Exp.Era era -> TxOutValue era -> Aeson.Value
-friendlyTxOutValue era = \case
-  TxOutValueByron lovelace -> friendlyLovelace lovelace
-  TxOutValueShelleyBased _ v ->
-    Exp.obtainCommonConstraints era $ friendlyLedgerValue era v
-
 friendlyLedgerValue
   :: ()
   => Exp.Era era

cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs

@@ -38,6 +38,7 @@ import Cardano.CLI.Type.Common
 
 import Control.Monad
 import Data.Map.Ordered.Strict qualified as OMap
+import Data.Map.Strict qualified as Map
 import Lens.Micro
 
 runCompatibleTransactionCmd
@@ -60,7 +61,9 @@ runCompatibleTransactionCmd
     ) = shelleyBasedEraConstraints sbe $ do
     sks <- mapM (fromEitherIOCli . readWitnessSigningData) witnesses
 
-    allOuts <- mapM (toTxOutInAnyEra sbe) outs
+    outsAndDatums <- mapM (toTxOutInAnyEra sbe) outs
+    let allOuts = map fst outsAndDatums
+        extraDatums = Map.unions (map snd outsAndDatums)
 
     certFilesAndMaybeScriptWits <-
       readCertificateScriptWitnesses' sbe certificates
@@ -107,7 +110,7 @@ runCompatibleTransactionCmd
 
     transaction@(ShelleyTx _ ledgerTx) <-
       fromEitherCli $
-        createCompatibleTx sbe ins allOuts fee protocolUpdates votes txCerts
+        createCompatibleTx sbe ins allOuts extraDatums fee protocolUpdates votes txCerts
 
     let txBody = ledgerTx ^. L.bodyTxL
 

cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 
@@ -8,28 +10,44 @@
 where
 
 import Cardano.Api
+import Cardano.Api.Experimental.Tx qualified as Exp
+import Cardano.Api.Ledger qualified as L
 
 import Cardano.CLI.Compatible.Exception
 import Cardano.CLI.EraBased.Script.Read.Common
 import Cardano.CLI.Orphan ()
 import Cardano.CLI.Read
 import Cardano.CLI.Type.Common
+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
 
 toTxOutInAnyEra
   :: ShelleyBasedEra era
   -> TxOutAnyEra
-  -> CIO e (TxOut CtxTx era)
+  -> CIO e (Exp.TxOut (ShelleyLedgerEra era), Map DataHash (L.Data (ShelleyLedgerEra era)))
 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
   -> Value
   -> TxOutDatumAnyEra
   -> ReferenceScriptAnyEra
-  -> CIO e (TxOut CtxTx era)
+  -> 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'
@@ -46,7 +64,19 @@
       (`getReferenceScript` refScriptFp)
       era
 
-  pure $ TxOut addr val datum refScript
+  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
 
 toTxOutValueInShelleyBasedEra
   :: ShelleyBasedEra era

cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs

@@ -41,6 +41,7 @@ import Cardano.Api qualified as Api
 import Cardano.Api.Consensus qualified as Consensus
 import Cardano.Api.Experimental (obtainCommonConstraints)
 import Cardano.Api.Experimental qualified as Exp
+import Cardano.Api.Experimental.Tx qualified as Exp
 import Cardano.Api.Ledger (strictMaybeToMaybe)
 import Cardano.Api.Ledger qualified as L
 import Cardano.Api.Network qualified as Consensus
@@ -67,6 +68,7 @@ import Cardano.CLI.Type.Output qualified as O
 import Cardano.Crypto.Hash (hashToBytesAsHex)
 import Cardano.Ledger.Address qualified as L
 import Cardano.Ledger.Api.State.Query qualified as L
+import Cardano.Ledger.Api.Tx qualified as L
 import Cardano.Ledger.Conway.State (ChainAccountState (..))
 import Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCTime, hoistEpochInfo)
 import Cardano.Slotting.Time (RelativeTime (..), toRelativeTime)
@@ -1191,7 +1193,7 @@ writeFilteredUTxOs era format mOutFile utxo = do
                   . Vary.on (\FormatCborBin -> CBOR.serialize $ toLedgerUTxO era utxo)
                   . Vary.on (\FormatCborHex -> Base16.encode . CBOR.serialize $ toLedgerUTxO era utxo)
                   . Vary.on (\FormatJson -> Json.encodeJson utxo)
-                  . Vary.on (\FormatText -> strictTextToLazyBytestring $ filteredUTxOsToText utxo)
+                  . Vary.on (\FormatText -> strictTextToLazyBytestring $ filteredUTxOsToText era utxo)
                   . Vary.on (\FormatYaml -> Json.encodeYaml utxo)
                   $ Vary.exhaustiveCase
               )
@@ -1200,40 +1202,53 @@ writeFilteredUTxOs era format mOutFile utxo = do
     . newExceptT
     $ writeLazyByteStringOutput mOutFile output
 
-filteredUTxOsToText :: UTxO era -> Text
-filteredUTxOsToText (UTxO utxo) = do
-  mconcat
-    [ Text.unlines [title, Text.replicate (Text.length title + 2) "-"]
-    , Text.unlines $
-        map utxoToText $
-          toList utxo
-    ]
+filteredUTxOsToText :: ShelleyBasedEra era -> UTxO era -> Text
+filteredUTxOsToText sbe utxo =
+  shelleyBasedEraConstraints sbe $
+    let entries =
+          [ (fromShelleyTxIn ledgerTxIn, Exp.TxOut ledgerTxOut)
+          | (ledgerTxIn, ledgerTxOut) <- Map.toList . L.unUTxO $ toLedgerUTxO sbe utxo
+          ]
+     in mconcat
+          [ Text.unlines [title, Text.replicate (Text.length title + 2) "-"]
+          , Text.unlines $ map (utxoToText sbe) entries
+          ]
  where
   title :: Text
   title =
     "                           TxHash                                 TxIx        Amount"
 
 utxoToText
-  :: (TxIn, TxOut CtxUTxO era)
+  :: ShelleyBasedEra era
+  -> (TxIn, Exp.TxOut (ShelleyLedgerEra era))
   -> Text
-utxoToText txInOutTuple =
-  let (TxIn (TxId txhash) (TxIx index), TxOut _ value mDatum _) = txInOutTuple
-   in mconcat
-        [ Text.decodeLatin1 (hashToBytesAsHex txhash)
-        , textShowN 6 index
-        , "        " <> printableValue value <> " + " <> Text.pack (show mDatum)
-        ]
+utxoToText sbe (TxIn (TxId txhash) (TxIx index), Exp.TxOut ledgerTxOut) =
+  shelleyBasedEraConstraints sbe $
+    mconcat
+      [ Text.decodeLatin1 (hashToBytesAsHex txhash)
+      , textShowN 6 index
+      , "        " <> printableValue <> " + " <> printableDatum
+      ]
  where
   textShowN :: Show a => Int -> a -> Text
   textShowN len x =
     let str = show x
         slen = length str
      in Text.pack $ replicate (max 1 (len - slen)) ' ' ++ str
 
-  printableValue :: TxOutValue era -> Text
-  printableValue = \case
-    TxOutValueByron (L.Coin i) -> Text.pack $ show i
-    TxOutValueShelleyBased sbe2 val -> renderValue $ Api.fromLedgerValue sbe2 val
+  printableValue :: Text
+  printableValue =
+    renderValue $ Api.fromLedgerValue sbe (ledgerTxOut ^. L.valueTxOutL)
+
+  -- Debug-style datum rendering — pre-Babbage outputs have no datum
+  -- representation we can read uniformly, so show the babbage+ ledger
+  -- datum where it exists and an empty placeholder otherwise.
+  printableDatum :: Text
+  printableDatum =
+    caseShelleyToAlonzoOrBabbageEraOnwards
+      (const "")
+      (\beo -> babbageEraOnwardsConstraints beo $ Text.pack $ show (ledgerTxOut ^. L.datumTxOutL))
+      sbe
 
 runQueryStakePoolsCmd
   :: ()