diff --git a/cabal.project b/cabal.project index 4fc03f2d38..c125e35a91 100644 --- a/cabal.project +++ b/cabal.project @@ -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 diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 445baba6a5..e0640f2703 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -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 diff --git a/cardano-cli/src/Cardano/CLI/Byron/Run.hs b/cardano-cli/src/Cardano/CLI/Byron/Run.hs index a08642917c..82517c932f 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Run.hs @@ -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 @@ -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 diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index f36b9f11c6..eba3468645 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs index f872edb2e3..ca46a50f5d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs @@ -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 ] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 501ee94ebb..9f5866b42a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -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))] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 52c4769f13..70d313a8e0 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -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 = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs index b4a7453a73..0e67bf6f86 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs @@ -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) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index 22dd5b1eec..6d2f674a0e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -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 = @@ -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 @@ -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)" @@ -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 @@ -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 diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 75a44d5a63..b806a5d561 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -29,6 +29,7 @@ module Cardano.CLI.EraBased.Run.Transaction , runTransactionViewCmd , runTransactionWitnessCmd , runTransactionSignWitnessCmd + , toTxOutByronEra ) where import Cardano.Api @@ -69,7 +70,6 @@ import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe) import Data.Set (Set) import qualified Data.Set as Set -import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Type.Equality (TestEquality (..)) @@ -140,8 +140,8 @@ runTransactionBuildCmd , localNodeSocketPath = nodeSocketPath } - inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles era txins - certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles era certificates + inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon txins + certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon certificates -- TODO: Conway Era - How can we make this more composable? certsAndMaybeScriptWits <- @@ -151,13 +151,13 @@ runTransactionBuildCmd | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits ] withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ - readScriptWitnessFilesThruple era withdrawals + readScriptWitnessFilesThruple eon withdrawals txMetadata <- firstExceptT TxCmdMetadataError . newExceptT $ - readTxMetadata era metadataSchema metadataFiles - valuesWithScriptWits <- readValueScriptWitnesses era $ fromMaybe mempty mValue + readTxMetadata eon metadataSchema metadataFiles + valuesWithScriptWits <- readValueScriptWitnesses eon $ fromMaybe mempty mValue scripts <- firstExceptT TxCmdScriptFileError $ mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles - txAuxScripts <- hoistEither $ first TxCmdAuxScriptsValidationError $ validateTxAuxScripts era scripts + txAuxScripts <- hoistEither $ first TxCmdAuxScriptsValidationError $ validateTxAuxScripts eon scripts mProp <- case mfUpdateProposalFile of Just (Featured w (Just updateProposalFile)) -> @@ -177,7 +177,7 @@ runTransactionBuildCmd era proposals <- newExceptT $ first TxCmdConstitutionError - <$> readTxGovernanceActions era proposalFiles + <$> readTxGovernanceActions eon proposalFiles -- the same collateral input can be used for several plutus scripts let filteredTxinsc = Set.toList $ Set.fromList txinsc @@ -285,16 +285,6 @@ runTransactionBuildRawCmd certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon certificates - -- TODO: Conway era - How can we make this more composable? - certsAndMaybeScriptWits <- - forEraInEon eon (pure mempty) $ \sbe -> - shelleyBasedEraConstraints sbe $ - sequence - [ fmap (,mSwit) (firstExceptT TxCmdReadTextViewFileError . newExceptT $ - readFileTextEnvelope AsCertificate (File certFile)) - | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits - ] - withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFilesThruple eon withdrawals txMetadata <- firstExceptT TxCmdMetadataError @@ -308,11 +298,11 @@ runTransactionBuildRawCmd pparams <- forM mProtocolParamsFile $ \ppf -> firstExceptT TxCmdProtocolParamsError (readProtocolParameters ppf) - mLedgerPParams <- - forEraInEon eon (pure Nothing) $ \sbe -> - forM pparams $ \pp -> - firstExceptT TxCmdProtocolParamsConverstionError - . hoistEither $ convertToLedgerProtocolParameters sbe pp + mLedgerPParams <- case pparams of + Nothing -> return Nothing + Just pp -> do + ledgerpp <- firstExceptT TxCmdProtocolParamsConverstionError . hoistEither $ convertToLedgerProtocolParameters eon pp + return $ Just ledgerpp txUpdateProposal <- case mUpdateProprosalFile of Just (Featured w (Just updateProposalFile)) -> @@ -321,18 +311,21 @@ runTransactionBuildRawCmd requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners - mReturnCollateral <- forEraInEon eon (pure Nothing) $ \sbe -> - forM mReturnColl $ toTxOutInShelleyBasedEra sbe + mReturnCollateral <- case mReturnColl of + Nothing -> return Nothing + Just retColl -> do + txOut <- toTxOutInShelleyBasedEra eon retColl + return $ Just txOut -- NB: We need to be able to construct txs in Byron to other Byron addresses - txOuts <- mapM (toTxOutInAnyEra eon) txouts + txOuts <- mapM (toTxOutInAnyEra $ toCardanoEra eon) txouts -- the same collateral input can be used for several plutus scripts let filteredTxinsc = Set.toList $ Set.fromList txInsCollateral -- Conway related votingProcedures <- - inEonForEra + inEonForShelleyBasedEra (pure emptyVotingProcedures) (\w -> firstExceptT TxCmdVoteError $ ExceptT (readVotingProceduresFiles w voteFiles)) eon @@ -341,6 +334,13 @@ runTransactionBuildRawCmd lift (readTxGovernanceActions eon proposalFiles) & onLeft (left . TxCmdConstitutionError) + certsAndMaybeScriptWits <- + shelleyBasedEraConstraints eon $ + sequence + [ fmap (,mSwit) (firstExceptT TxCmdReadTextViewFileError . newExceptT $ + readFileTextEnvelope AsCertificate (File certFile)) + | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits + ] txBody <- hoistEither $ runTxBuildRaw eon mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns filteredTxinsc @@ -349,12 +349,14 @@ runTransactionBuildRawCmd txMetadata mLedgerPParams txUpdateProposal votingProcedures proposals let noWitTx = makeSignedTransaction [] txBody - lift (cardanoEraConstraints eon $ writeTxFileTextEnvelopeCddl eon txBodyOutFile noWitTx) + cEra = shelleyBasedToCardanoEra eon + -- TODO: Expose a version of writeTxFileTextEnvelopeCddl that is parameterized on ShelleyBasedEra + lift (cardanoEraConstraints cEra $ writeTxFileTextEnvelopeCddl cEra txBodyOutFile noWitTx) & onLeft (left . TxCmdWriteFileError) runTxBuildRaw :: () - => CardanoEra era + => ShelleyBasedEra era -> Maybe ScriptValidity -- ^ Mark script as expected to pass or fail validation -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] @@ -388,7 +390,7 @@ runTxBuildRaw :: () -> VotingProcedures era -> [Proposal era] -> Either TxCmdError (TxBody era) -runTxBuildRaw era +runTxBuildRaw sbe mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts @@ -397,13 +399,14 @@ runTxBuildRaw era certsAndMaybeSriptWits withdrawals reqSigners txAuxScripts txMetadata mpparams txUpdateProposal votingProcedures proposals = do - let allReferenceInputs = getAllReferenceInputs + let era = toCardanoEra sbe + allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits (snd valuesWithScriptWits) certsAndMaybeSriptWits withdrawals readOnlyRefIns - + validatedTxIns = validateTxIns inputsAndMaybeScriptWits validatedCollateralTxIns <- validateTxInsCollateral era txinsc validatedRefInputs <- validateTxInsReference era allReferenceInputs validatedTotCollateral @@ -430,7 +433,7 @@ runTxBuildRaw era validatedTxVotes = votingProcedures let txBodyContent = TxBodyContent - { txIns = validateTxIns inputsAndMaybeScriptWits + { txIns = validatedTxIns , txInsCollateral = validatedCollateralTxIns , txInsReference = validatedRefInputs , txOuts = txouts @@ -451,9 +454,7 @@ runTxBuildRaw era , txProposalProcedures = forEraInEonMaybe era (`Featured` validatedTxProposal) , txVotingProcedures = forEraInEonMaybe era (`Featured` validatedTxVotes) } - - first TxCmdTxBodyError $ - cardanoEraConstraints era $ createAndValidateTransactionBody era txBodyContent + first TxCmdTxBodyError $ createAndValidateTransactionBody sbe txBodyContent runTxBuild :: () => ShelleyBasedEra era @@ -501,6 +502,8 @@ runTxBuild certsAndMaybeScriptWits withdrawals reqSigners txAuxScripts txMetadata txUpdateProposal mOverrideWits votingProcedures proposals _outputOptions = shelleyBasedEraConstraints sbe $ do + -- TODO: All functions should be parameterized by ShelleyBasedEra + -- as it's not possible to call this function with ByronEra let era = shelleyBasedToCardanoEra sbe dummyFee = Just $ Lovelace 0 inputsThatRequireWitnessing = [input | (input,_) <- inputsAndMaybeScriptWits] @@ -765,6 +768,14 @@ toTxOutInShelleyBasedEra era (TxOutShelleyBasedEra addr' val' mDatumHash refScri pure $ TxOut addr val datum refScript +toTxOutByronEra + :: TxOutAnyEra + -> ExceptT TxCmdError IO (TxOut CtxTx ByronEra) +toTxOutByronEra (TxOutAnyEra addr' val' _ _) = do + addr <- hoistEither $ toAddressInAnyEra ByronEra addr' + val <- hoistEither $ toTxOutValueInAnyEra ByronEra val' + pure $ TxOut addr val TxOutDatumNone ReferenceScriptNone + -- TODO: toTxOutInAnyEra eventually will not be needed because -- byron related functionality will be treated -- separately @@ -886,7 +897,7 @@ scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _ mPid) _ _ _) readValueScriptWitnesses - :: CardanoEra era + :: ShelleyBasedEra era -> (Value, [ScriptWitnessFiles WitCtxMint]) -> ExceptT TxCmdError IO (Value, [ScriptWitness WitCtxMint era]) readValueScriptWitnesses era (v, sWitFiles) = do @@ -918,8 +929,7 @@ runTransactionSignCmd inputTxFile <- liftIO $ fileOrPipe inputTxFilePath anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdCddlError) - InAnyShelleyBasedEra sbe tx <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTx + InAnyShelleyBasedEra sbe tx <- pure anyTx let (txbody, existingTxKeyWits) = getTxBodyAndWitnesses tx @@ -941,8 +951,7 @@ runTransactionSignCmd case unwitnessed of IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra sbe unwitTx <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTx + InAnyShelleyBasedEra sbe unwitTx <- pure anyTx let txbody = getTxBody unwitTx -- Byron witnesses require the network ID. This can either be provided @@ -958,9 +967,7 @@ runTransactionSignCmd & onLeft (left . TxCmdWriteFileError) UnwitnessedCliFormattedTxBody anyTxbody -> do - InAnyShelleyBasedEra sbe txbody <- - --TODO: in principle we should be able to support Byron era txs too - onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody + InAnyShelleyBasedEra sbe txbody <- pure anyTxbody -- Byron witnesses require the network ID. This can either be provided -- directly or derived from a provided Byron address. byronWitnesses <- firstExceptT TxCmdBootstrapWitnessError @@ -990,8 +997,8 @@ runTransactionSubmitCmd , txFile } = do txFileOrPipe <- liftIO $ fileOrPipe txFile - InAnyCardanoEra era tx <- lift (readFileTx txFileOrPipe) & onLeft (left . TxCmdCddlError) - let txInMode = TxInMode era tx + InAnyShelleyBasedEra era tx <- lift (readFileTx txFileOrPipe) & onLeft (left . TxCmdCddlError) + let txInMode = TxInMode (toCardanoEra era) tx localNodeConnInfo = LocalNodeConnectInfo { localConsensusModeParams = consensusModeParams , localNodeNetworkId = networkId @@ -1029,8 +1036,7 @@ runTransactionCalculateMinFeeCmd pparams <- firstExceptT TxCmdProtocolParamsError $ readProtocolParameters protocolParamsFile case unwitnessed of IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra sbe unwitTx <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTx + InAnyShelleyBasedEra sbe unwitTx <- pure anyTx let txbody = getTxBody unwitTx let tx = makeSignedTransaction [] txbody Lovelace fee = estimateTransactionFee sbe @@ -1044,9 +1050,7 @@ runTransactionCalculateMinFeeCmd liftIO $ putStrLn $ (show fee :: String) <> " Lovelace" UnwitnessedCliFormattedTxBody anyTxBody -> do - InAnyShelleyBasedEra sbe txbody <- - --TODO: in principle we should be able to support Byron era txs too - onlyInShelleyBasedEras "calculate-min-fee for Byron era transactions" anyTxBody + InAnyShelleyBasedEra sbe txbody <- pure anyTxBody let tx = makeSignedTransaction [] txbody Lovelace fee = estimateTransactionFee sbe @@ -1158,7 +1162,7 @@ runTransactionTxIdCmd Cmd.TransactionTxIdCmdArgs { inputTxBodyOrTxFile } = do - InAnyCardanoEra _era txbody <- + InAnyShelleyBasedEra _era txbody <- case inputTxBodyOrTxFile of InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath @@ -1166,13 +1170,13 @@ runTransactionTxIdCmd $ readFileTxBody txbodyFile case unwitnessed of UnwitnessedCliFormattedTxBody anyTxBody -> return anyTxBody - IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> - return (InAnyCardanoEra era (getTxBody tx)) + IncompleteCddlFormattedTx (InAnyShelleyBasedEra era tx) -> + return (InAnyShelleyBasedEra era (getTxBody tx)) InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) - return . InAnyCardanoEra era $ getTxBody tx + InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) + return . InAnyShelleyBasedEra era $ getTxBody tx liftIO $ BS.putStrLn $ serialiseToRawBytesHex (getTxId txbody) @@ -1190,11 +1194,11 @@ runTransactionViewCmd txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile - InAnyCardanoEra era txbody <- + InAnyShelleyBasedEra era txbody <- case unwitnessed of UnwitnessedCliFormattedTxBody anyTxBody -> pure anyTxBody - IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> - pure $ InAnyCardanoEra era (getTxBody tx) + IncompleteCddlFormattedTx (InAnyShelleyBasedEra era tx) -> + pure $ InAnyShelleyBasedEra era (getTxBody tx) -- Why are we differentiating between a transaction body and a transaction? -- In the case of a transaction body, we /could/ simply call @makeSignedTransaction []@ -- to get a transaction which would allow us to reuse friendlyTxBS. However, @@ -1202,15 +1206,15 @@ runTransactionViewCmd -- is arguably not part of the transaction body. firstExceptT TxCmdWriteFileError . newExceptT $ case outputFormat of - TxViewOutputFormatYaml -> friendlyTxBody FriendlyYaml mOutFile era txbody - TxViewOutputFormatJson -> friendlyTxBody FriendlyJson mOutFile era txbody + TxViewOutputFormatYaml -> friendlyTxBody FriendlyYaml mOutFile (toCardanoEra era) txbody + TxViewOutputFormatJson -> friendlyTxBody FriendlyJson mOutFile (toCardanoEra era) txbody InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) + InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) firstExceptT TxCmdWriteFileError . newExceptT $ case outputFormat of - TxViewOutputFormatYaml -> friendlyTx FriendlyYaml mOutFile era tx - TxViewOutputFormatJson -> friendlyTx FriendlyJson mOutFile era tx + TxViewOutputFormatYaml -> friendlyTx FriendlyYaml mOutFile (toCardanoEra era) tx + TxViewOutputFormatJson -> friendlyTx FriendlyJson mOutFile (toCardanoEra era) tx -- ---------------------------------------------------------------------------- -- Witness commands @@ -1231,8 +1235,7 @@ runTransactionWitnessCmd $ readFileTxBody txbodyFile case unwitnessed of IncompleteCddlFormattedTx anyTx -> do - InAnyShelleyBasedEra sbe cddlTx <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTx + InAnyShelleyBasedEra sbe cddlTx <- pure anyTx let txbody = getTxBody cddlTx someWit <- firstExceptT TxCmdReadWitnessSigningDataError @@ -1252,8 +1255,7 @@ runTransactionWitnessCmd $ writeTxWitnessFileTextEnvelopeCddl sbe outFile witness UnwitnessedCliFormattedTxBody anyTxbody -> do - InAnyShelleyBasedEra sbe txbody <- - onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody + InAnyShelleyBasedEra sbe txbody <- pure anyTxbody someWit <- firstExceptT TxCmdReadWitnessSigningDataError . newExceptT $ readWitnessSigningData witnessSigningData @@ -1286,47 +1288,39 @@ runTransactionSignWitnessCmd txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- lift (readFileTxBody txbodyFile) & onLeft (left . TxCmdCddlError) case unwitnessed of - UnwitnessedCliFormattedTxBody (InAnyCardanoEra era txbody) -> cardanoEraConstraints era $ do + UnwitnessedCliFormattedTxBody (InAnyShelleyBasedEra era txbody) -> do witnesses <- sequence [ do - InAnyCardanoEra era' witness <- + InAnyShelleyBasedEra era' witness <- lift (readFileTxKeyWitness file) & onLeft (left . TxCmdCddlWitnessError) - + let cEra = shelleyBasedToCardanoEra era + cEra' = shelleyBasedToCardanoEra era' case testEquality era era' of - Nothing -> cardanoEraConstraints era' $ left $ TxCmdWitnessEraMismatch (AnyCardanoEra era) (AnyCardanoEra era') witnessFile + Nothing -> cardanoEraConstraints cEra' $ left $ TxCmdWitnessEraMismatch (AnyCardanoEra cEra) (AnyCardanoEra cEra') witnessFile Just Refl -> return witness | witnessFile@(WitnessFile file) <- witnessFiles ] let tx = makeSignedTransaction witnesses txbody - lift (writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing tx) + lift (writeLazyByteStringFile outFile $ cardanoEraConstraints (toCardanoEra era) $ textEnvelopeToJSON Nothing tx) & onLeft (left . TxCmdWriteFileError) - IncompleteCddlFormattedTx (InAnyCardanoEra era anyTx) -> do + IncompleteCddlFormattedTx (InAnyShelleyBasedEra era anyTx) -> do let txbody = getTxBody anyTx - + -- TODO: Left off here. Remember we were never reading byron key witnesses anyways! witnesses <- sequence [ do - InAnyCardanoEra era' witness <- + InAnyShelleyBasedEra era' witness <- lift (readFileTxKeyWitness file) & onLeft (left . TxCmdCddlWitnessError) case testEquality era era' of - Nothing -> left $ TxCmdWitnessEraMismatch (AnyCardanoEra era) (AnyCardanoEra era') witnessFile + Nothing -> left $ TxCmdWitnessEraMismatch (AnyCardanoEra $ shelleyBasedToCardanoEra era) (AnyCardanoEra $ shelleyBasedToCardanoEra era') witnessFile Just Refl -> return witness | witnessFile@(WitnessFile file) <- witnessFiles ] let tx = makeSignedTransaction witnesses txbody - lift (writeTxFileTextEnvelopeCddl era outFile tx) & onLeft (left . TxCmdWriteFileError) - --- | Constrain the era to be Shelley based. Fail for the Byron era. -onlyInShelleyBasedEras :: () - => Text - -> InAnyCardanoEra a - -> ExceptT TxCmdError IO (InAnyShelleyBasedEra a) -onlyInShelleyBasedEras notImplMsg (InAnyCardanoEra era x) = - forEraInEon era (left $ TxCmdNotImplemented notImplMsg) $ \sbe -> - shelleyBasedEraConstraints sbe $ return (InAnyShelleyBasedEra sbe x) + lift (writeTxFileTextEnvelopeCddl (shelleyBasedToCardanoEra era) outFile tx) & onLeft (left . TxCmdWriteFileError) diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index e9a2e76bb8..47e94b35f3 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -10,6 +10,7 @@ module Cardano.CLI.Legacy.Run.Transaction ) where import Cardano.Api +import qualified Cardano.Api.Byron as Api import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd import Cardano.CLI.EraBased.Run.Transaction @@ -19,6 +20,7 @@ import Cardano.CLI.Types.Errors.TxCmdError import Cardano.CLI.Types.Errors.TxValidationError import Cardano.CLI.Types.Governance +import Control.Monad.Trans.Class import Control.Monad.Trans.Except import Control.Monad.Trans.Except.Extra import Data.Function @@ -119,6 +121,13 @@ runLegacyTransactionBuildCmd proposalFiles outputOptions ) +-- TODO: Neither QA nor Sam is using `cardano-cli byron transaction build-raw` +-- for Byron era transactions. So we can parameterize this function on ShelleyBasedEra. +-- They are using `issue-utxo-expenditure`. +-- TODO: As a follow up we need to expose a simple tx building command that only +-- uses inputs, outputs and update proposals. NB: Update proposals are a separate +-- thing in the Byron era so we need to figure out how we are handling that at the +-- cli command level. runLegacyTransactionBuildRawCmd :: () => AnyCardanoEra -> Maybe ScriptValidity @@ -142,33 +151,44 @@ runLegacyTransactionBuildRawCmd :: () -> Maybe UpdateProposalFile -> TxBodyFile Out -> ExceptT TxCmdError IO () +runLegacyTransactionBuildRawCmd (AnyCardanoEra ByronEra) _ txins _ _ _ + _ _ txouts _ _ _ _ _ _ + _ _ _ _ _ + outFile = do + let apiTxIns = [ ( txIn, BuildTxWith (KeyWitness KeyWitnessForSpending)) | (txIn, _) <- txins] + byronOuts <- mapM toTxOutByronEra txouts + case makeByronTransactionBody apiTxIns byronOuts of + Left err -> error $ "Error occurred while creating a Byron based UTxO transaction: " <> show err + Right txBody -> do + let noWitTx = Api.ByronTx ByronEraOnlyByron $ makeSignedByronTransaction [] txBody + lift (cardanoEraConstraints ByronEra $ writeTxFileTextEnvelopeCddl ByronEra outFile noWitTx) + & onLeft (left . TxCmdWriteFileError) + runLegacyTransactionBuildRawCmd - anyEra@(AnyCardanoEra era) mScriptValidity txins readOnlyRefIns txinsc mReturnColl + (AnyCardanoEra era) mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpdateProposal outFile = do - mfUpdateProposalFile <- - validateUpdateProposalFile era mUpdateProposal - & hoistEither - & firstExceptT TxCmdTxUpdateProposalValidationError + caseByronOrShelleyBasedEra + (const $ error "runLegacyTransactionBuildRawCmd: This should be impossible") + (\sbe -> do + mfUpdateProposalFile <- validateUpdateProposalFile era mUpdateProposal + & hoistEither + & firstExceptT TxCmdTxUpdateProposalValidationError - upperBound <- - caseByronOrShelleyBasedEra - (\w -> case mUpperBound of - Nothing -> pure $ TxValidityNoUpperBound w - Just _ -> left $ TxCmdTxValidityUpperBoundValidationError $ TxValidityUpperBoundNotSupported anyEra - ) - (\w -> pure $ TxValidityUpperBound w mUpperBound) - era + let upperBound = TxValidityUpperBound sbe mUpperBound + + runTransactionBuildRawCmd + ( Cmd.TransactionBuildRawCmdArgs + sbe mScriptValidity txins readOnlyRefIns txinsc mReturnColl + mTotColl reqSigners txouts mValue mLowBound upperBound fee certs wdrls + metadataSchema scriptFiles metadataFiles mProtocolParamsFile mfUpdateProposalFile [] [] + outFile + ) + ) + era - runTransactionBuildRawCmd - ( Cmd.TransactionBuildRawCmdArgs - era mScriptValidity txins readOnlyRefIns txinsc mReturnColl - mTotColl reqSigners txouts mValue mLowBound upperBound fee certs wdrls - metadataSchema scriptFiles metadataFiles mProtocolParamsFile mfUpdateProposalFile [] [] - outFile - ) runLegacyTransactionSignCmd :: InputTxBodyOrTxFile -> [WitnessSigningData] diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index d160a9111e..a927f0383c 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -156,7 +156,6 @@ data MetadataError | MetadataErrorConversionError !FilePath !TxMetadataJsonError | MetadataErrorValidationError !FilePath ![(Word64, TxMetadataRangeError)] | MetadataErrorDecodeError !FilePath !CBOR.DecoderError - | MetadataErrorNotAvailableInEra AnyCardanoEra deriving Show renderMetadataError :: MetadataError -> Doc ann @@ -180,19 +179,15 @@ renderMetadataError = \case MetadataErrorDecodeError fp metadataErr -> "Error decoding CBOR metadata at: " <> pshow fp <> " Error: " <> pshow metadataErr - MetadataErrorNotAvailableInEra e -> - "Transaction metadata not supported in " <> pretty (renderEra e) -readTxMetadata :: CardanoEra era +readTxMetadata :: ShelleyBasedEra era -> TxMetadataJsonSchema -> [MetadataFile] -> IO (Either MetadataError (TxMetadataInEra era)) readTxMetadata _ _ [] = return $ Right TxMetadataNone -readTxMetadata era schema files = cardanoEraConstraints era $ runExceptT $ do - supported <- forEraMaybeEon era - & hoistMaybe (MetadataErrorNotAvailableInEra $ AnyCardanoEra era) +readTxMetadata era schema files = runExceptT $ do metadata <- mapM (readFileTxMetadata schema) files - pure $ TxMetadataInEra supported $ mconcat metadata + pure $ TxMetadataInEra era $ mconcat metadata readFileTxMetadata :: TxMetadataJsonSchema @@ -250,7 +245,7 @@ renderScriptWitnessError = \case renderScriptDataError sDataError readScriptWitnessFiles - :: CardanoEra era + :: ShelleyBasedEra era -> [(a, Maybe (ScriptWitnessFiles ctx))] -> ExceptT ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))] readScriptWitnessFiles era = mapM readSwitFile @@ -261,7 +256,7 @@ readScriptWitnessFiles era = mapM readSwitFile readSwitFile (tIn, Nothing) = return (tIn, Nothing) readScriptWitnessFilesThruple - :: CardanoEra era + :: ShelleyBasedEra era -> [(a, b, Maybe (ScriptWitnessFiles ctx))] -> ExceptT ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))] readScriptWitnessFilesThruple era = mapM readSwitFile @@ -272,7 +267,7 @@ readScriptWitnessFilesThruple era = mapM readSwitFile readSwitFile (tIn, b, Nothing) = return (tIn, b, Nothing) readScriptWitness - :: CardanoEra era + :: ShelleyBasedEra era -> ScriptWitnessFiles witctx -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era) readScriptWitness era (SimpleScriptWitnessFile (ScriptFile scriptFile)) = do @@ -322,10 +317,11 @@ readScriptWitness era (PlutusScriptWitnessFiles readScriptWitness era (PlutusReferenceScriptWitnessFiles refTxIn anyScrLang@(AnyScriptLanguage anyScriptLanguage) datumOrFile redeemerOrFile execUnits mPid) = do - caseByronToAlonzoOrBabbageEraOnwards + caseShelleyToAlonzoOrBabbageEraOnwards ( const $ left $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra - $ cardanoEraConstraints era (AnyCardanoEra era) + -- TODO: Update error to use AnyShelleyBasedEra + $ cardanoEraConstraints (toCardanoEra era) (AnyCardanoEra $ toCardanoEra era) ) ( const $ case scriptLanguageSupportedInEra era anyScriptLanguage of @@ -346,15 +342,15 @@ readScriptWitness era (PlutusReferenceScriptWitnessFiles refTxIn (PReferenceScript refTxIn (unPolicyId <$> mPid)) datum redeemer execUnits Nothing -> - left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era) + left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra $ toCardanoEra era) ) era readScriptWitness era (SimpleReferenceScriptWitnessFiles refTxIn anyScrLang@(AnyScriptLanguage anyScriptLanguage) mPid) = do - caseByronToAlonzoOrBabbageEraOnwards + caseShelleyToAlonzoOrBabbageEraOnwards ( const $ left $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra - $ cardanoEraConstraints era (AnyCardanoEra era) + $ cardanoEraConstraints (toCardanoEra era) (AnyCardanoEra $ toCardanoEra era) ) ( const $ case scriptLanguageSupportedInEra era anyScriptLanguage of @@ -366,17 +362,19 @@ readScriptWitness era (SimpleReferenceScriptWitnessFiles refTxIn PlutusScriptLanguage{} -> error "readScriptWitness: Should not be possible to specify a plutus script" Nothing -> - left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra era) + left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra + anyScrLang + (anyCardanoEra $ toCardanoEra era) ) era -validateScriptSupportedInEra :: CardanoEra era +validateScriptSupportedInEra :: ShelleyBasedEra era -> ScriptInAnyLang -> ExceptT ScriptWitnessError IO (ScriptInEra era) validateScriptSupportedInEra era script@(ScriptInAnyLang lang _) = case toScriptInEra era script of Nothing -> left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra - (AnyScriptLanguage lang) (anyCardanoEra era) + (AnyScriptLanguage lang) (anyCardanoEra $ toCardanoEra era) Just script' -> pure script' data ScriptDataError = @@ -483,11 +481,11 @@ deserialiseScriptInAnyLang bs = -- Tx & TxBody -newtype CddlTx = CddlTx {unCddlTx :: InAnyCardanoEra Tx} deriving (Show, Eq) +newtype CddlTx = CddlTx {unCddlTx :: InAnyShelleyBasedEra Tx} deriving (Show, Eq) -readFileTx :: FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx)) +readFileTx :: FileOrPipe -> IO (Either CddlError (InAnyShelleyBasedEra Tx)) readFileTx file = do - eAnyTx <- readFileInAnyCardanoEra AsTx file + eAnyTx <- readFileInAnyShelleyBasedEra AsTx file case eAnyTx of Left e -> fmap unCddlTx <$> acceptTxCDDLSerialisation file e Right tx -> return $ Right tx @@ -498,12 +496,12 @@ readFileTx file = do -- needs to be key witnessed. data IncompleteTx - = UnwitnessedCliFormattedTxBody (InAnyCardanoEra TxBody) - | IncompleteCddlFormattedTx (InAnyCardanoEra Tx) + = UnwitnessedCliFormattedTxBody (InAnyShelleyBasedEra TxBody) + | IncompleteCddlFormattedTx (InAnyShelleyBasedEra Tx) readFileTxBody :: FileOrPipe -> IO (Either CddlError IncompleteTx) readFileTxBody file = do - eTxBody <- readFileInAnyCardanoEra AsTxBody file + eTxBody <- readFileInAnyShelleyBasedEra AsTxBody file case eTxBody of Left e -> fmap (IncompleteCddlFormattedTx . unCddlTx) <$> acceptTxCDDLSerialisation file e Right txBody -> return $ Right $ UnwitnessedCliFormattedTxBody txBody @@ -542,8 +540,7 @@ acceptTxCDDLSerialisation file err = readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx) readCddlTx = readFileOrPipeTextEnvelopeCddlAnyOf teTypes where - teTypes = [ FromCDDLTx "Witnessed Tx ByronEra" CddlTx - , FromCDDLTx "Witnessed Tx ShelleyEra" CddlTx + teTypes = [ FromCDDLTx "Witnessed Tx ShelleyEra" CddlTx , FromCDDLTx "Witnessed Tx AllegraEra" CddlTx , FromCDDLTx "Witnessed Tx MaryEra" CddlTx , FromCDDLTx "Witnessed Tx AlonzoEra" CddlTx @@ -560,13 +557,13 @@ readCddlTx = readFileOrPipeTextEnvelopeCddlAnyOf teTypes -- Tx witnesses -newtype CddlWitness = CddlWitness { unCddlWitness :: InAnyCardanoEra KeyWitness} +newtype CddlWitness = CddlWitness { unCddlWitness :: InAnyShelleyBasedEra KeyWitness} readFileTxKeyWitness :: FilePath - -> IO (Either CddlWitnessError (InAnyCardanoEra KeyWitness)) + -> IO (Either CddlWitnessError (InAnyShelleyBasedEra KeyWitness)) readFileTxKeyWitness fp = do file <- fileOrPipe fp - eWitness <- readFileInAnyCardanoEra AsKeyWitness file + eWitness <- readFileInAnyShelleyBasedEra AsKeyWitness file case eWitness of Left e -> fmap unCddlWitness <$> acceptKeyWitnessCDDLSerialisation e Right keyWit -> return $ Right keyWit @@ -829,13 +826,13 @@ data ProposalError deriving Show readTxGovernanceActions - :: CardanoEra era + :: ShelleyBasedEra era -> [ProposalFile In] -> IO (Either ConstitutionError [Proposal era]) readTxGovernanceActions _ [] = return $ Right [] readTxGovernanceActions era files = runExceptT $ do - w <- forEraMaybeEon era - & hoistMaybe (ConstitutionNotSupportedInEra $ cardanoEraConstraints era $ AnyCardanoEra era) + w <- forShelleyBasedEraMaybeEon era + & hoistMaybe (ConstitutionNotSupportedInEra $ cardanoEraConstraints (toCardanoEra era) $ AnyCardanoEra (toCardanoEra era)) newExceptT $ sequence <$> mapM (fmap (first ConstitutionErrorFile) . readProposal w) files readProposal @@ -863,9 +860,10 @@ constitutionHashSourceToHash constitutionHashSource = do -- Misc -readFileInAnyCardanoEra - :: ( HasTextEnvelope (thing ByronEra) - , HasTextEnvelope (thing ShelleyEra) +-- readFileInByronEra = undefined + +readFileInAnyShelleyBasedEra + :: ( HasTextEnvelope (thing ShelleyEra) , HasTextEnvelope (thing AllegraEra) , HasTextEnvelope (thing MaryEra) , HasTextEnvelope (thing AlonzoEra) @@ -874,16 +872,15 @@ readFileInAnyCardanoEra ) => (forall era. AsType era -> AsType (thing era)) -> FileOrPipe - -> IO (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing)) -readFileInAnyCardanoEra asThing = + -> IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra thing)) +readFileInAnyShelleyBasedEra asThing = readFileOrPipeTextEnvelopeAnyOf - [ FromSomeType (asThing AsByronEra) (InAnyCardanoEra ByronEra) - , FromSomeType (asThing AsShelleyEra) (InAnyCardanoEra ShelleyEra) - , FromSomeType (asThing AsAllegraEra) (InAnyCardanoEra AllegraEra) - , FromSomeType (asThing AsMaryEra) (InAnyCardanoEra MaryEra) - , FromSomeType (asThing AsAlonzoEra) (InAnyCardanoEra AlonzoEra) - , FromSomeType (asThing AsBabbageEra) (InAnyCardanoEra BabbageEra) - , FromSomeType (asThing AsConwayEra) (InAnyCardanoEra ConwayEra) + [ FromSomeType (asThing AsShelleyEra) (InAnyShelleyBasedEra ShelleyBasedEraShelley) + , FromSomeType (asThing AsAllegraEra) (InAnyShelleyBasedEra ShelleyBasedEraAllegra) + , FromSomeType (asThing AsMaryEra) (InAnyShelleyBasedEra ShelleyBasedEraMary) + , FromSomeType (asThing AsAlonzoEra) (InAnyShelleyBasedEra ShelleyBasedEraAlonzo) + , FromSomeType (asThing AsBabbageEra) (InAnyShelleyBasedEra ShelleyBasedEraBabbage) + , FromSomeType (asThing AsConwayEra) (InAnyShelleyBasedEra ShelleyBasedEraConway) ] -- | We need a type for handling files that may be actually be things like diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index dc7af5cae1..ca318cfa16 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -58,13 +58,13 @@ instance Error ScriptLanguageValidationError where pretty (renderEra era) <> " era." validateScriptSupportedInEra - :: CardanoEra era + :: ShelleyBasedEra era -> ScriptInAnyLang -> Either ScriptLanguageValidationError (ScriptInEra era) validateScriptSupportedInEra era script@(ScriptInAnyLang lang _) = case toScriptInEra era script of Nothing -> Left $ ScriptLanguageValidationError - (AnyScriptLanguage lang) (anyCardanoEra era) + (AnyScriptLanguage lang) (anyCardanoEra $ toCardanoEra era) Just script' -> pure script' @@ -175,12 +175,12 @@ instance Error TxAuxScriptsValidationError where "Transaction auxiliary scripts error: " <> prettyError e validateTxAuxScripts - :: CardanoEra era + :: ShelleyBasedEra era -> [ScriptInAnyLang] -> Either TxAuxScriptsValidationError (TxAuxScripts era) validateTxAuxScripts _ [] = return TxAuxScriptsNone validateTxAuxScripts era scripts = do - supported <- conjureWitness era TxAuxScriptsNotSupportedInEra + supported <- conjureWitness (toCardanoEra era) TxAuxScriptsNotSupportedInEra scriptsInEra <- mapM (first TxAuxScriptsLanguageError . validateScriptSupportedInEra era) scripts pure $ TxAuxScripts supported scriptsInEra diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs index 7159784d56..7fc4272612 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs @@ -1,9 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Test.Golden.TxView - ( hprop_golden_view_byron_yaml - , hprop_golden_view_byron_json_default - , hprop_golden_view_shelley_yaml + ( hprop_golden_view_shelley_yaml , hprop_golden_view_allegra_yaml , hprop_golden_view_mary_yaml , hprop_golden_view_alonzo_yaml @@ -20,9 +18,9 @@ import Hedgehog.Extras (Integration, moduleWorkspace, note_, propertyO import qualified Hedgehog.Extras.Test.Golden as H {- HLINT ignore "Use camelCase" -} - -hprop_golden_view_byron_yaml :: Property -hprop_golden_view_byron_yaml = +-- TODO: Expose command to view byron tx files +_hprop_golden_view_byron_yaml :: Property +_hprop_golden_view_byron_yaml = propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do transactionBodyFile <- noteTempFile tempDir "transaction-body-file" @@ -45,8 +43,9 @@ hprop_golden_view_byron_yaml = ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-format", "yaml"] H.diffVsGoldenFile result "test/cardano-cli-golden/files/golden/byron/transaction-view.out" -hprop_golden_view_byron_json_default :: Property -hprop_golden_view_byron_json_default = +-- TODO: Expose command to view byron tx files +_hprop_golden_view_byron_json_default :: Property +_hprop_golden_view_byron_json_default = propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do transactionBodyFile <- noteTempFile tempDir "transaction-body-file" diff --git a/flake.lock b/flake.lock index 618d4fcfed..8efff985f0 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1700237790, - "narHash": "sha256-Ao1KfvvTPaYiud3L4iVydA+GefGcZsVlnfA9+yTJJv4=", + "lastModified": 1700639964, + "narHash": "sha256-iQ48z5eqSHP8d7B8BBJtnXkVPIKPvdWc0GhIgy4j8cc=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "88c8ae0fe53746733d9192b20fba9ca071bacc2e", + "rev": "eaf713ef8029332b9e4e23685fa157f26086da8b", "type": "github" }, "original": {