diff --git a/cabal.project b/cabal.project index b2c78c5fee..7bdcb7d3b9 100644 --- a/cabal.project +++ b/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. diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs index f8f0e712b5..ae562650ac 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs +++ b/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 diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs index 935c9e62d9..c2140b8731 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs +++ b/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 diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs index f5b6935ed7..38be2af237 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs +++ b/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 @@ module Cardano.CLI.Compatible.Transaction.TxOut 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 @@ mkTxOut sbe addr val' mDatumHash refScriptFp = do (`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 diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs index 587d5b6c42..c213935e2c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs +++ b/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,29 +1202,33 @@ 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 = @@ -1230,10 +1236,19 @@ utxoToText txInOutTuple = 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 :: () diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index aaa82fdc60..0faaa0e203 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -366,13 +366,15 @@ runTransactionBuildCmd else writeTxFileTextEnvelope eon fpath noWitTx toTxOutInEra - :: Exp.IsEra era + :: forall era e + . Exp.IsEra era => TxOutAnyEra -> 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 - fromEitherCli $ Exp.fromLegacyTxOut o + let sbe = convert (Exp.useEra @era) + addr = anyAddressInShelleyBasedEra sbe addr' + obtainCommonConstraints (Exp.useEra @era) $ + mkTxOut sbe addr val' mDatumHash refScriptFp runTransactionBuildEstimateCmd :: forall era e @@ -1176,14 +1178,15 @@ getAllReferenceInputs ] toTxOutInShelleyBasedEra - :: Exp.IsEra era + :: forall era e + . Exp.IsEra era => TxOutShelleyBasedEra -> 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 + let sbe = convert (Exp.useEra @era) addr = shelleyAddressInEra sbe addr' - o <- mkTxOut sbe addr val' mDatumHash refScriptFp - fromEitherCli $ Exp.fromLegacyTxOut o + obtainCommonConstraints (Exp.useEra @era) $ + mkTxOut sbe addr val' mDatumHash refScriptFp -- TODO: Currently we specify the policyId with the '--mint' option on the cli -- and we added a separate '--policy-id' parser that parses the policy id for the diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs index f73c1e76f8..1d5131706c 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs @@ -42,7 +42,6 @@ data AnyTxBodyErrorAutoBalance where data TxCmdError = TxCmdCBORDecodeError !CBOR.DecoderError - | TxCmdDatumDecodingError Exp.DatumDecodingError | TxCmdProtocolParamsError ProtocolParamsError | forall era. LostScriptWitnesses [Exp.AnyIndexedPlutusScriptWitness (Exp.LedgerEra era)] @@ -199,8 +198,6 @@ renderTxCmdError = \case , pretty (length after) , "." ] - TxCmdDatumDecodingError err -> - "Error decoding datum: " <> pshow err prettyPolicyIdList :: [PolicyId] -> Doc ann prettyPolicyIdList = diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/TxValidationError.hs index 7d625925e8..b4785d15ea 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/TxValidationError.hs @@ -13,7 +13,6 @@ module Cardano.CLI.Type.Error.TxValidationError , validateScriptSupportedInEra , validateTxAuxScripts , validateRequiredSigners - , validateTxReturnCollateral , validateTxScriptValidity , validateTxTotalCollateral , validateTxValidityLowerBound @@ -88,14 +87,6 @@ validateTxTreasuryDonation mTreasuryDonation = do Exp.obtainCommonConstraints (Exp.useEra @era) $ mkFeatured unTxTreasuryDonation -validateTxReturnCollateral - :: IsEra era - => Maybe (TxOut CtxTx era) - -> TxReturnCollateral CtxTx era -validateTxReturnCollateral Nothing = TxReturnCollateralNone -validateTxReturnCollateral (Just retColTxOut) = do - TxReturnCollateral (convert useEra) retColTxOut - validateTxValidityLowerBound :: IsEra era => Maybe SlotNo