Skip to content

Commit d1213e6

Browse files
Jimbo4350Jimbo4350
committed
Use Exp.TxOut directly in Compatible/TxOut; simplify Byron output types
In Compatible/Transaction/TxOut.hs, eliminate the TxOut CtxTx era / TxOutDatum CtxTx era intermediates and build Exp.TxOut (wrapping L.TxOut) directly via L.mkBasicTxOut and era-specific lenses (dataHashTxOutL for Alonzo, datumTxOutL + referenceScriptTxOutL for Babbage/Conway). readRefScript takes only BabbageEraOnwards era, deriving ShelleyBasedEra via convert. In the Byron path, replace [TxOut CtxTx ByronEra] with [(Address ByronAddr, L.Coin)] throughout Command, Parser, Run, and Tx. The conversion back to [TxOut CtxTx ByronEra] is confined to the single makeByronTransactionBody call sites in Byron/Tx.hs.
1 parent f017b71 commit d1213e6

5 files changed

Lines changed: 123 additions & 97 deletions

File tree

‎cardano-cli/src/Cardano/CLI/Byron/Command.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ where
1313

1414
import Cardano.Api hiding (GenesisParameters)
1515
import Cardano.Api.Byron qualified as Byron
16+
import Cardano.Api.Ledger qualified as L
1617

1718
import Cardano.CLI.Byron.Genesis
1819
import Cardano.CLI.Byron.Key
@@ -67,7 +68,7 @@ data ByronCommand
6768
-- ^ Signing key of genesis UTxO owner.
6869
(Address ByronAddr)
6970
-- ^ Genesis UTxO address.
70-
[TxOut CtxTx ByronEra]
71+
[(Address ByronAddr, L.Coin)]
7172
-- ^ Tx output.
7273
| SpendUTxO
7374
NetworkId
@@ -78,8 +79,8 @@ data ByronCommand
7879
-- ^ Signing key of Tx underwriter.
7980
[TxIn]
8081
-- ^ Inputs available for spending to the Tx underwriter's key.
81-
[TxOut CtxTx ByronEra]
82-
-- ^ Genesis UTxO output Address.
82+
[(Address ByronAddr, L.Coin)]
83+
-- ^ Tx outputs.
8384
| GetTxId (TxFile In)
8485
| --- Misc Commands ---
8586

‎cardano-cli/src/Cardano/CLI/Byron/Parser.hs‎

Lines changed: 6 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
23

34
module Cardano.CLI.Byron.Parser
45
( ByronCommand (..)
@@ -282,33 +283,19 @@ parseTxIdAtto = (<?> "Transaction ID (hexadecimal)") $ do
282283
parseTxIxAtto :: Atto.Parser TxIx
283284
parseTxIxAtto = toEnum <$> Atto.decimal
284285

285-
parseTxOut :: Parser (TxOut CtxTx ByronEra)
286+
parseTxOut :: Parser (Address ByronAddr, L.Coin)
286287
parseTxOut =
287288
Opt.option
288-
( ( \(addr, lovelace) ->
289-
TxOut
290-
(pAddressInEra addr)
291-
(pLovelaceTxOut lovelace)
292-
TxOutDatumNone
293-
ReferenceScriptNone
294-
)
295-
<$> auto
296-
)
289+
((\(addr, lovelace :: Word64) -> (parseByronAddr addr, L.Coin (toInteger lovelace))) <$> auto)
297290
$ long "txout"
298291
<> metavar "'(\"ADDR\", LOVELACE)'"
299292
<> help "Specify a transaction output, as a pair of an address and lovelace."
300293
where
301-
pAddressInEra :: Text -> AddressInEra ByronEra
302-
pAddressInEra t =
294+
parseByronAddr :: Text -> Address ByronAddr
295+
parseByronAddr t =
303296
case Byron.decodeAddressBase58 t of
304297
Left err -> error $ "Bad Base58 address: " <> show err
305-
Right byronAddress -> AddressInEra ByronAddressInAnyEra $ ByronAddress byronAddress
306-
307-
pLovelaceTxOut :: Word64 -> TxOutValue ByronEra
308-
pLovelaceTxOut l =
309-
if l > (maxBound :: Word64)
310-
then error $ show l <> " lovelace exceeds the Word64 upper bound"
311-
else TxOutValueByron $ L.Coin $ toInteger l
298+
Right byronAddress -> ByronAddress byronAddress
312299

313300
readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a
314301
readerFromAttoParser p =

‎cardano-cli/src/Cardano/CLI/Byron/Run.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import Cardano.Api.Byron
1717
, VerificationKey (ByronVerificationKey)
1818
)
1919
import Cardano.Api.Byron qualified as Byron
20+
import Cardano.Api.Ledger qualified as L
2021

2122
import Cardano.CLI.Byron.Command
2223
import Cardano.CLI.Byron.Delegation
@@ -176,7 +177,7 @@ runSpendGenesisUTxO
176177
-> NewTxFile
177178
-> SigningKeyFile In
178179
-> Address ByronAddr
179-
-> [TxOut CtxTx ByronEra]
180+
-> [(Address ByronAddr, L.Coin)]
180181
-> CIO e ()
181182
runSpendGenesisUTxO genesisFile nw bKeyFormat (NewTxFile ctTx) ctKey genRichAddr outs = do
182183
genesis <- fromExceptTCli $ readGenesis genesisFile nw
@@ -195,7 +196,7 @@ runSpendUTxO
195196
-> NewTxFile
196197
-> SigningKeyFile In
197198
-> [TxIn]
198-
-> [TxOut CtxTx ByronEra]
199+
-> [(Address ByronAddr, L.Coin)]
199200
-> CIO e ()
200201
runSpendUTxO nw bKeyFormat (NewTxFile ctTx) ctKey ins outs = do
201202
sk <- fromExceptTCli $ readByronSigningKey bKeyFormat ctKey

‎cardano-cli/src/Cardano/CLI/Byron/Tx.hs‎

Lines changed: 20 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -144,10 +144,18 @@ txSpendGenesisUTxOByronPBFT
144144
-> NetworkId
145145
-> Byron.SomeByronSigningKey
146146
-> Address ByronAddr
147-
-> [TxOut CtxTx ByronEra]
147+
-> [(Address ByronAddr, L.Coin)]
148148
-> Byron.ATxAux ByteString
149-
txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs =
149+
txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs' =
150150
let txins = [(Byron.fromByronTxIn txIn, BuildTxWith (KeyWitness KeyWitnessForSpending))]
151+
outs =
152+
[ TxOut
153+
(AddressInEra ByronAddressInAnyEra addr)
154+
(TxOutValueByron coin)
155+
TxOutDatumNone
156+
ReferenceScriptNone
157+
| (addr, coin) <- outs'
158+
]
151159
in case makeByronTransactionBody txins outs of
152160
Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err
153161
Right txBody ->
@@ -165,11 +173,18 @@ txSpendUTxOByronPBFT
165173
:: NetworkId
166174
-> Byron.SomeByronSigningKey
167175
-> [TxIn]
168-
-> [TxOut CtxTx ByronEra]
176+
-> [(Address ByronAddr, L.Coin)]
169177
-> Byron.ATxAux ByteString
170-
txSpendUTxOByronPBFT nId sk txIns outs = do
178+
txSpendUTxOByronPBFT nId sk txIns outs' = do
171179
let apiTxIns = [(txIn, BuildTxWith (KeyWitness KeyWitnessForSpending)) | txIn <- txIns]
172-
180+
outs =
181+
[ TxOut
182+
(AddressInEra ByronAddressInAnyEra addr)
183+
(TxOutValueByron coin)
184+
TxOutDatumNone
185+
ReferenceScriptNone
186+
| (addr, coin) <- outs'
187+
]
173188
case makeByronTransactionBody apiTxIns outs of
174189
Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err
175190
Right txBody ->

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

Lines changed: 90 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -18,11 +18,12 @@ import Cardano.CLI.EraBased.Script.Read.Common
1818
import Cardano.CLI.Orphan ()
1919
import Cardano.CLI.Read
2020
import Cardano.CLI.Type.Common
21+
import Cardano.Ledger.Api.Tx qualified as L
2122
import Cardano.Ledger.Hashes (DataHash)
22-
import Cardano.Ledger.Plutus.Data qualified as L
2323

2424
import Data.Map.Strict (Map)
2525
import Data.Map.Strict qualified as Map
26+
import Lens.Micro
2627

2728
toTxOutInAnyEra
2829
:: ShelleyBasedEra era
@@ -32,51 +33,101 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do
3233
let addr = anyAddressInShelleyBasedEra era addr'
3334
mkTxOut era addr val' mDatumHash refScriptFp
3435

35-
-- | Build an output for a transaction body. Produces the experimental
36-
-- 'Exp.TxOut' plus any supplemental datum bodies that the caller-supplied
37-
-- datum carries. The legacy 'TxOut CtxTx era' bundled supplemental datums
38-
-- inside outputs; 'Exp.TxOut' only carries the datum hash, so callers thread
39-
-- the full datum bodies in separately (e.g. via 'createCompatibleTx').
40-
--
41-
-- The legacy 'TxOut CtxTx era' is used internally as a stepping stone to
42-
-- reuse the api's 'toShelleyTxOutAny' field-level conversion logic; it is
43-
-- not exposed.
4436
mkTxOut
4537
:: ShelleyBasedEra era
4638
-> AddressInEra era
4739
-> Value
4840
-> TxOutDatumAnyEra
4941
-> ReferenceScriptAnyEra
5042
-> CIO e (Exp.TxOut (ShelleyLedgerEra era), Map DataHash (L.Data (ShelleyLedgerEra era)))
51-
mkTxOut sbe addr val' mDatumHash refScriptFp = do
52-
let era = toCardanoEra sbe
53-
val <- toTxOutValueInShelleyBasedEra sbe val'
54-
55-
datum <-
56-
inEonForEra
57-
(pure TxOutDatumNone)
58-
(`toTxAlonzoDatum` mDatumHash)
59-
era
60-
61-
refScript <-
62-
inEonForEra
63-
(pure ReferenceScriptNone)
64-
(`getReferenceScript` refScriptFp)
65-
era
66-
67-
let legacyTxOut = TxOut addr val datum refScript
68-
pure $
69-
shelleyBasedEraConstraints sbe $
70-
(Exp.TxOut (toShelleyTxOutAny sbe legacyTxOut), supplementalsOf datum)
71-
where
72-
supplementalsOf
73-
:: L.Era (ShelleyLedgerEra era)
74-
=> TxOutDatum CtxTx era
75-
-> Map DataHash (L.Data (ShelleyLedgerEra era))
76-
supplementalsOf (TxOutSupplementalDatum _ h) =
77-
let ld = toAlonzoData h
78-
in Map.singleton (L.hashData ld) ld
79-
supplementalsOf _ = mempty
43+
mkTxOut sbe addr val' mDatumAnyEra refScriptFp = do
44+
txVal <- toTxOutValueInShelleyBasedEra sbe val'
45+
let ledgerAddr = toShelleyAddr addr
46+
shelleyBasedEraConstraints sbe $
47+
case txVal of
48+
TxOutValueShelleyBased _ ledgerVal ->
49+
case sbe of
50+
ShelleyBasedEraShelley -> pure (Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal), mempty)
51+
ShelleyBasedEraAllegra -> pure (Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal), mempty)
52+
ShelleyBasedEraMary -> pure (Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal), mempty)
53+
ShelleyBasedEraAlonzo -> do
54+
(mDH, suppl) <- alonzoDatumFields mDatumAnyEra
55+
pure
56+
( Exp.TxOut (L.mkBasicTxOut ledgerAddr ledgerVal & L.dataHashTxOutL .~ mDH)
57+
, suppl
58+
)
59+
ShelleyBasedEraBabbage -> do
60+
(dat, suppl) <- babbageDatumFields mDatumAnyEra
61+
refScript <- readRefScript BabbageEraOnwardsBabbage refScriptFp
62+
pure
63+
( Exp.TxOut
64+
( L.mkBasicTxOut ledgerAddr ledgerVal
65+
& L.datumTxOutL .~ dat
66+
& L.referenceScriptTxOutL .~ refScript
67+
)
68+
, suppl
69+
)
70+
ShelleyBasedEraConway -> do
71+
(dat, suppl) <- babbageDatumFields mDatumAnyEra
72+
refScript <- readRefScript BabbageEraOnwardsConway refScriptFp
73+
pure
74+
( Exp.TxOut
75+
( L.mkBasicTxOut ledgerAddr ledgerVal
76+
& L.datumTxOutL .~ dat
77+
& L.referenceScriptTxOutL .~ refScript
78+
)
79+
, suppl
80+
)
81+
82+
alonzoDatumFields
83+
:: L.Era ledgerera
84+
=> TxOutDatumAnyEra
85+
-> CIO e (L.StrictMaybe DataHash, Map DataHash (L.Data ledgerera))
86+
alonzoDatumFields = \case
87+
TxOutDatumByNone ->
88+
pure (L.SNothing, mempty)
89+
TxOutDatumByHashOnly h ->
90+
pure (L.SJust (unScriptDataHash h), mempty)
91+
TxOutDatumByHashOf sDataOrFile -> do
92+
sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile
93+
pure (L.SJust (unScriptDataHash (hashScriptDataBytes sData)), mempty)
94+
TxOutDatumByValue sDataOrFile -> do
95+
sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile
96+
let ld = toAlonzoData sData
97+
dh = L.hashData ld
98+
pure (L.SJust dh, Map.singleton dh ld)
99+
TxOutInlineDatumByValue _ ->
100+
throwCliError $ TxCmdTxFeatureMismatch (AnyCardanoEra AlonzoEra) TxFeatureInlineDatums
101+
102+
babbageDatumFields
103+
:: L.Era ledgerera
104+
=> TxOutDatumAnyEra
105+
-> CIO e (L.Datum ledgerera, Map DataHash (L.Data ledgerera))
106+
babbageDatumFields = \case
107+
TxOutDatumByNone ->
108+
pure (L.NoDatum, mempty)
109+
TxOutDatumByHashOnly h ->
110+
pure (L.DatumHash (unScriptDataHash h), mempty)
111+
TxOutDatumByHashOf sDataOrFile -> do
112+
sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile
113+
pure (L.DatumHash (unScriptDataHash (hashScriptDataBytes sData)), mempty)
114+
TxOutDatumByValue sDataOrFile -> do
115+
sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile
116+
let dh = unScriptDataHash (hashScriptDataBytes sData)
117+
pure (L.DatumHash dh, Map.singleton dh (toAlonzoData sData))
118+
TxOutInlineDatumByValue sDataOrFile -> do
119+
sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile
120+
pure (scriptDataToInlineDatum sData, mempty)
121+
122+
readRefScript
123+
:: BabbageEraOnwards era
124+
-> ReferenceScriptAnyEra
125+
-> CIO e (L.StrictMaybe (L.Script (ShelleyLedgerEra era)))
126+
readRefScript boe = \case
127+
ReferenceScriptAnyEraNone -> pure L.SNothing
128+
ReferenceScriptAnyEra fp -> do
129+
script <- readFileScriptInAnyLang fp
130+
pure $ refScriptToShelleyScript (convert boe) (ReferenceScript boe script)
80131

81132
toTxOutValueInShelleyBasedEra
82133
:: ShelleyBasedEra era
@@ -91,35 +142,6 @@ toTxOutValueInShelleyBasedEra sbe val =
91142
(\w -> return (TxOutValueShelleyBased sbe (toLedgerValue w val)))
92143
sbe
93144

94-
toTxAlonzoDatum
95-
:: ()
96-
=> AlonzoEraOnwards era
97-
-> TxOutDatumAnyEra
98-
-> CIO e (TxOutDatum CtxTx era)
99-
toTxAlonzoDatum supp cliDatum =
100-
case cliDatum of
101-
TxOutDatumByNone -> pure TxOutDatumNone
102-
TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h)
103-
TxOutDatumByHashOf sDataOrFile -> do
104-
sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile
105-
pure (TxOutDatumHash supp $ hashScriptDataBytes sData)
106-
TxOutDatumByValue sDataOrFile -> do
107-
sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile
108-
pure (TxOutSupplementalDatum supp sData)
109-
TxOutInlineDatumByValue sDataOrFile -> do
110-
let cEra = toCardanoEra supp
111-
forEraInEon cEra (txFeatureMismatch cEra TxFeatureInlineDatums) $ \babbageOnwards -> do
112-
sData <- fromExceptTCli $ readScriptDataOrFile sDataOrFile
113-
pure $ TxOutDatumInline babbageOnwards sData
114-
115-
getReferenceScript
116-
:: BabbageEraOnwards era
117-
-> ReferenceScriptAnyEra
118-
-> CIO e (ReferenceScript era)
119-
getReferenceScript w = \case
120-
ReferenceScriptAnyEraNone -> return ReferenceScriptNone
121-
ReferenceScriptAnyEra fp -> ReferenceScript w <$> readFileScriptInAnyLang fp
122-
123145
-- | An enumeration of era-dependent features where we have to check that it
124146
-- is permissible to use this feature in this era.
125147
data TxFeature

0 commit comments

Comments
 (0)