Skip to content

Commit

Permalink
Merge pull request #467 from input-output-hk/jordan/byron-isolation-2…
Browse files Browse the repository at this point in the history
…-of-n-final

Byron isolation 2 of n
  • Loading branch information
Jimbo4350 authored Nov 22, 2023
2 parents e81955d + ffd8f5c commit 4c67eb5
Show file tree
Hide file tree
Showing 15 changed files with 231 additions and 280 deletions.
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ repository cardano-haskell-packages
-- you need to run if you change them
index-state:
, hackage.haskell.org 2023-11-09T23:50:15Z
, cardano-haskell-packages 2023-11-17T15:33:21Z
, cardano-haskell-packages 2023-11-21T19:00:47Z

packages:
cardano-cli
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/cardano-cli.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -206,7 +206,7 @@ library
, binary
, bytestring
, canonical-json
, cardano-api ^>= 8.33.0.0
, cardano-api ^>= 8.34.0.0
, cardano-binary
, cardano-crypto
, cardano-crypto-class ^>= 2.1.2
Expand Down
7 changes: 3 additions & 4 deletions cardano-cli/src/Cardano/CLI/Byron/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ module Cardano.CLI.Byron.Run
) where

import Cardano.Api hiding (GenesisParameters, UpdateProposal)
import Cardano.Api.Byron (SomeByronSigningKey (..), Tx (..))
import Cardano.Api.Byron (SomeByronSigningKey (..))

import qualified Cardano.Chain.Genesis as Genesis
import Cardano.CLI.Byron.Commands
Expand Down Expand Up @@ -178,9 +178,8 @@ runSubmitTx nodeSocketPath network fp = do
runGetTxId :: TxFile In -> ExceptT ByronClientCmdError IO ()
runGetTxId fp = firstExceptT ByronCmdTxError $ do
tx <- readByronTx fp
let txbody = getTxBody (ByronTx ByronEraOnlyByron tx)
txid = getTxId txbody
liftIO $ BS.putStrLn $ serialiseToRawBytesHex txid
let txId = getTxIdByron tx
liftIO . BS.putStrLn $ serialiseToRawBytesHex txId

runSpendGenesisUTxO
:: GenesisFile
Expand Down
71 changes: 12 additions & 59 deletions cardano-cli/src/Cardano/CLI/Byron/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@ where

import Cardano.Api
import Cardano.Api.Byron
import qualified Cardano.Api.Byron as Api
import qualified Cardano.Api.Ledger as L
import Cardano.Api.Pretty

import qualified Cardano.Binary as Binary
Expand Down Expand Up @@ -87,6 +89,7 @@ prettyAddress (ByronAddress addr) = sformat
(Common.addressF % "\n" % Common.addressDetailedF)
addr addr

-- TODO: Move to cardano-api
readByronTx :: TxFile In -> ExceptT ByronTxError IO (UTxO.ATxAux ByteString)
readByronTx (File fp) = do
txBS <- liftIO $ LB.readFile fp
Expand Down Expand Up @@ -147,37 +150,12 @@ txSpendGenesisUTxOByronPBFT
-> Address ByronAddr
-> [TxOut CtxTx ByronEra]
-> Tx ByronEra
txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do
let txBodyCont =
TxBodyContent
{ txIns =
[ (fromByronTxIn txIn, BuildTxWith (KeyWitness KeyWitnessForSpending))
]
, txInsCollateral = TxInsCollateralNone
, txInsReference = TxInsReferenceNone
, txOuts = outs
, txTotalCollateral = TxTotalCollateralNone
, txReturnCollateral = TxReturnCollateralNone
, txFee = TxFeeImplicit ByronEraOnlyByron
, txValidityLowerBound = TxValidityNoLowerBound
, txValidityUpperBound = defaultTxValidityUpperBound ByronEra
, txMetadata = TxMetadataNone
, txAuxScripts = TxAuxScriptsNone
, txExtraKeyWits = TxExtraKeyWitnessesNone
, txProtocolParams = BuildTxWith Nothing
, txWithdrawals = TxWithdrawalsNone
, txCertificates = TxCertificatesNone
, txUpdateProposal = TxUpdateProposalNone
, txMintValue = TxMintNone
, txScriptValidity = TxScriptValidityNone
, txProposalProcedures = Nothing
, txVotingProcedures = Nothing
}

case createAndValidateTransactionBody ByronEra txBodyCont of
txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs =
let txins = [(fromByronTxIn txIn, BuildTxWith (KeyWitness KeyWitnessForSpending))]
in 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
in makeSignedTransaction [bWit] txBody
in Api.ByronTx ByronEraOnlyByron $ makeSignedByronTransaction [bWit] txBody
where
ByronVerificationKey vKey = byronWitnessToVerKey sk

Expand All @@ -193,40 +171,15 @@ txSpendUTxOByronPBFT
-> [TxOut CtxTx ByronEra]
-> Tx ByronEra
txSpendUTxOByronPBFT nId sk txIns outs = do
let txBodyCont =
TxBodyContent
{ txIns =
[ ( txIn
, BuildTxWith (KeyWitness KeyWitnessForSpending)
) | txIn <- txIns
]
, txInsCollateral = TxInsCollateralNone
, txInsReference = TxInsReferenceNone
, txOuts = outs
, txTotalCollateral = TxTotalCollateralNone
, txReturnCollateral = TxReturnCollateralNone
, txFee = TxFeeImplicit ByronEraOnlyByron
, txValidityLowerBound = TxValidityNoLowerBound
, txValidityUpperBound = defaultTxValidityUpperBound ByronEra
, txMetadata = TxMetadataNone
, txAuxScripts = TxAuxScriptsNone
, txExtraKeyWits = TxExtraKeyWitnessesNone
, txProtocolParams = BuildTxWith Nothing
, txWithdrawals = TxWithdrawalsNone
, txCertificates = TxCertificatesNone
, txUpdateProposal = TxUpdateProposalNone
, txMintValue = TxMintNone
, txScriptValidity = TxScriptValidityNone
, txProposalProcedures = Nothing
, txVotingProcedures = Nothing
}
let apiTxIns = [ ( txIn, BuildTxWith (KeyWitness KeyWitnessForSpending)) | txIn <- txIns]

case createAndValidateTransactionBody ByronEra txBodyCont of
case makeByronTransactionBody apiTxIns 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
in makeSignedTransaction [bWit] txBody
in Api.ByronTx ByronEraOnlyByron $ makeSignedByronTransaction [bWit] txBody

fromByronWitness :: SomeByronSigningKey -> NetworkId -> TxBody ByronEra -> KeyWitness ByronEra
fromByronWitness
:: SomeByronSigningKey -> NetworkId -> L.Annotated L.Tx ByteString -> KeyWitness ByronEra
fromByronWitness bw nId txBody =
case bw of
AByronSigningKeyLegacy sk -> makeByronKeyWitness nId txBody sk
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/src/Cardano/CLI/EraBased/Commands.hs
Original file line number Diff line number Diff line change
Expand Up @@ -123,5 +123,5 @@ pCmds era envCli =
, fmap StakeAddressCmds <$> pStakeAddressCmds (toCardanoEra era) envCli
, fmap StakePoolCmds <$> pStakePoolCmds (toCardanoEra era) envCli
, fmap TextViewCmds <$> pTextViewCmds
, fmap TransactionCmds <$> pTransactionCmds (toCardanoEra era) envCli
, fmap TransactionCmds <$> pTransactionCmds era envCli
]
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ data TransactionCmds era
| TransactionViewCmd !TransactionViewCmdArgs

data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
{ eon :: !(CardanoEra era)
{ eon :: !(ShelleyBasedEra era)
, mScriptValidity :: !(Maybe ScriptValidity)
-- ^ Mark script as expected to pass or fail validation
, txIns :: ![(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]
Expand Down
53 changes: 25 additions & 28 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2078,36 +2078,33 @@ pLegacyInvalidHereafter =
]

pInvalidHereafter :: ()
=> CardanoEra era
=> ShelleyBasedEra era
-> Parser (TxValidityUpperBound era)
pInvalidHereafter =
caseByronOrShelleyBasedEra
(pure . TxValidityNoUpperBound)
(\eon ->
fmap (TxValidityUpperBound eon) $ asum
[ fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
[ Opt.long "invalid-hereafter"
, Opt.metavar "SLOT"
, Opt.help "Time that transaction is valid until (in slots)."
]
, fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
[ Opt.long "upper-bound"
, Opt.metavar "SLOT"
, Opt.help $ mconcat
[ "Time that transaction is valid until (in slots) "
, "(deprecated; use --invalid-hereafter instead)."
]
, Opt.internal
]
, fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
[ Opt.long "ttl"
, Opt.metavar "SLOT"
, Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
, Opt.internal
]
, pure Nothing
pInvalidHereafter eon =
fmap (TxValidityUpperBound eon) $ asum
[ fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
[ Opt.long "invalid-hereafter"
, Opt.metavar "SLOT"
, Opt.help "Time that transaction is valid until (in slots)."
]
, fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
[ Opt.long "upper-bound"
, Opt.metavar "SLOT"
, Opt.help $ mconcat
[ "Time that transaction is valid until (in slots) "
, "(deprecated; use --invalid-hereafter instead)."
]
)
, Opt.internal
]
, fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
[ Opt.long "ttl"
, Opt.metavar "SLOT"
, Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
, Opt.internal
]
, pure Nothing
]


pTxFee :: Parser Lovelace
pTxFee =
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -281,7 +281,7 @@ pIntroducedInConwayPParams =
<$> convertToLedger id (optional pPoolVotingThresholds)
<*> convertToLedger id (optional pDRepVotingThresholds)
<*> convertToLedger id (optional pMinCommitteeSize)
<*> convertToLedger id (optional pCommitteeTermLength)
<*> convertToLedger id (optional (fromIntegral . unEpochNo <$> pCommitteeTermLength))
<*> convertToLedger id (optional pGovActionLifetime)
<*> convertToLedger toShelleyLovelace (optional pGovActionDeposit)
<*> convertToLedger toShelleyLovelace (optional pDRepDeposit)
Expand Down
26 changes: 9 additions & 17 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ import Prettyprinter (line, pretty)
{- HLINT ignore "Move brackets to avoid $" -}

pTransactionCmds :: ()
=> CardanoEra era
=> ShelleyBasedEra era
-> EnvCli
-> Maybe (Parser (TransactionCmds era))
pTransactionCmds era envCli =
Expand Down Expand Up @@ -78,17 +78,10 @@ pTransactionCmds era envCli =
$ subParser "calculate-min-fee"
$ Opt.info (pTransactionCalculateMinFee envCli)
$ Opt.progDesc "Calculate the minimum fee for a transaction."
, caseByronOrShelleyBasedEra
(const Nothing)
(\sbe -> Just $ subParser "calculate-min-required-utxo"
$ Opt.info (pTransactionCalculateMinReqUTxO sbe)
$ Opt.progDesc "Calculate the minimum required UTxO for a transaction output."
)
era
, caseByronOrShelleyBasedEra
(const Nothing)
(Just . pCalculateMinRequiredUtxoBackwardCompatible)
era
, Just $ subParser "calculate-min-required-utxo"
$ Opt.info (pTransactionCalculateMinReqUTxO era)
$ Opt.progDesc "Calculate the minimum required UTxO for a transaction output."
, Just $ pCalculateMinRequiredUtxoBackwardCompatible era
, Just
$ subParser "hash-script-data"
$ Opt.info pTxHashScriptData
Expand Down Expand Up @@ -140,12 +133,11 @@ pScriptValidity = asum
]
]

pTransactionBuildCmd :: CardanoEra era -> EnvCli -> Maybe (Parser (TransactionCmds era))
pTransactionBuildCmd :: ShelleyBasedEra era -> EnvCli -> Maybe (Parser (TransactionCmds era))
pTransactionBuildCmd era envCli = do
w <- forEraMaybeEon era
pure
$ subParser "build"
$ Opt.info (pCmd w)
$ Opt.info (pCmd era)
$ Opt.progDescDoc
$ Just $ mconcat
[ pretty @String "Build a balanced transaction (automatically calculates fees)"
Expand Down Expand Up @@ -178,7 +170,7 @@ pTransactionBuildCmd era envCli = do
<*> pChangeAddress
<*> optional (pMintMultiAsset AutoBalance)
<*> optional pInvalidBefore
<*> pInvalidHereafter (shelleyBasedToCardanoEra sbe)
<*> pInvalidHereafter sbe
<*> many (pCertificateFile AutoBalance)
<*> many (pWithdrawal AutoBalance)
<*> pTxMetadataJsonSchema
Expand All @@ -200,7 +192,7 @@ pChangeAddress =
, Opt.help "Address where ADA in excess of the tx fee will go to."
]

pTransactionBuildRaw :: CardanoEra era -> Parser (TransactionCmds era)
pTransactionBuildRaw :: ShelleyBasedEra era -> Parser (TransactionCmds era)
pTransactionBuildRaw era =
fmap TransactionBuildRawCmd $
TransactionBuildRawCmdArgs era
Expand Down
Loading

0 comments on commit 4c67eb5

Please sign in to comment.