Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
@@ -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.
5 changes: 3 additions & 2 deletions cardano-cli/src/Cardano/CLI/Byron/Command.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 ---
Expand Down
33 changes: 15 additions & 18 deletions cardano-cli/src/Cardano/CLI/Byron/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -282,33 +282,30 @@ 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
( 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."
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

pLovelaceTxOut :: Word64 -> TxOutValue ByronEra
pLovelaceTxOut l =
if l > (maxBound :: Word64)
then error $ show l <> " lovelace exceeds the Word64 upper bound"
else TxOutValueByron $ L.Coin $ toInteger l
Right byronAddress -> ByronAddress byronAddress

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 =
Expand Down
5 changes: 3 additions & 2 deletions cardano-cli/src/Cardano/CLI/Byron/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
29 changes: 23 additions & 6 deletions cardano-cli/src/Cardano/CLI/Byron/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ->
Expand Down
159 changes: 91 additions & 68 deletions cardano-cli/src/Cardano/CLI/Compatible/Transaction/TxOut.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -32,51 +33,102 @@ 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 (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 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)

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
Expand All @@ -91,35 +143,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
Expand Down
Loading