diff --git a/cabal.project b/cabal.project index b2c78c5fee..92eb15287b 100644 --- a/cabal.project +++ b/cabal.project @@ -74,6 +74,16 @@ write-ghc-environment-files: always -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. +-- TEMPORARY: pin cardano-api to a master commit containing PR #1200 +-- (deprecation of TxBody / TxBodyContent) so this PR can verify -Wdeprecations +-- is clean against the deprecated surface. Remove once cardano-api releases a +-- version containing PR #1200. +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-api + tag: 1272b84342425dcbc653abe9b8eb11447a34ec01 + subdir: cardano-api + -- cabal-allow-newer begin if impl(ghc >= 9.14) allow-newer: diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index aaa82fdc60..b2930f79ed 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -37,6 +37,7 @@ import Cardano.Api hiding ) import Cardano.Api qualified as Api import Cardano.Api.Byron qualified as Byron +import Cardano.Api.Compatible (addWitnesses) import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp @@ -1258,17 +1259,18 @@ runTransactionSignCmd InAnyShelleyBasedEra sbe tx@(ShelleyTx _ ledgerTx) <- pure anyTx - let (apiTxBody, existingTxKeyWits) = getTxBodyAndWitnesses tx + let existingTxKeyWits = getTxWitnesses tx + ledgerTxBody = shelleyBasedEraConstraints sbe $ ledgerTx ^. L.bodyTxL byronWitnesses <- firstExceptT TxCmdBootstrapWitnessError . liftEither $ forM sksByron $ shelleyBasedEraConstraints sbe $ - mkShelleyBootstrapWitness sbe mNetworkId (ledgerTx ^. L.bodyTxL) + mkShelleyBootstrapWitness sbe mNetworkId ledgerTxBody - let newShelleyKeyWits = map (makeShelleyKeyWitness sbe apiTxBody) sksShelley + let newShelleyKeyWits = map (makeShelleyKeyWitness' sbe ledgerTxBody) sksShelley allKeyWits = existingTxKeyWits ++ newShelleyKeyWits ++ byronWitnesses - signedTx = makeSignedTransaction allKeyWits apiTxBody + signedTx = addWitnesses allKeyWits tx modifyError TxCmdWriteFileError $ hoistIOEither $ @@ -1282,8 +1284,9 @@ runTransactionSignCmd readFileTxBody txbodyFile case unwitnessed of - IncompleteTxBody anyTxBody -> do - InAnyShelleyBasedEra sbe txbody@(ShelleyTxBody _ ledgerTxBody _ _ _ _) <- pure anyTxBody + IncompleteTxBody sbe (Exp.UnsignedTx ledgerTx) -> do + let ledgerTxBody = shelleyBasedEraConstraints sbe $ ledgerTx ^. L.bodyTxL + unsignedTxAsTx = shelleyBasedEraConstraints sbe $ ShelleyTx sbe ledgerTx -- Byron witnesses require the network ID. This can either be provided -- directly or derived from a provided Byron address. @@ -1292,8 +1295,8 @@ runTransactionSignCmd forM sksByron $ mkShelleyBootstrapWitness sbe mNetworkId ledgerTxBody - let shelleyKeyWitnesses = map (makeShelleyKeyWitness sbe txbody) sksShelley - tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody + let shelleyKeyWitnesses = map (makeShelleyKeyWitness' sbe ledgerTxBody) sksShelley + tx = addWitnesses (byronWitnesses ++ shelleyKeyWitnesses) unsignedTxAsTx modifyError TxCmdWriteFileError $ hoistIOEither $ @@ -1315,14 +1318,19 @@ runTransactionSubmitCmd , txFile } = do txFileOrPipe <- liftIO $ fileOrPipe txFile - InAnyShelleyBasedEra era tx <- + InAnyShelleyBasedEra era tx@(ShelleyTx _ ledgerTx) <- lift (readFileTx txFileOrPipe) & onLeft (left . TxCmdTextEnvError) let txInMode = TxInMode era tx res <- liftIO $ submitTxToNodeLocal nodeConnInfo txInMode case res of TxSubmitSuccess -> do liftIO $ Text.hPutStrLn IO.stderr "Transaction successfully submitted. Transaction hash is:" - liftIO $ LBS.putStrLn $ Aeson.encode $ TxSubmissionResult $ getTxId $ getTxBody tx + liftIO $ + LBS.putStrLn $ + Aeson.encode $ + TxSubmissionResult $ + shelleyBasedEraConstraints era $ + getTxIdShelley era (ledgerTx ^. L.bodyTxL) TxSubmitFail reason -> case reason of TxValidationErrorInCardanoMode err -> left . TxCmdTxSubmitError . Text.pack $ show err @@ -1348,27 +1356,31 @@ runTransactionCalculateMinFeeCmd , outFile } = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- + IncompleteTxBody (sbe :: ShelleyBasedEra era) (Exp.UnsignedTx ledgerTx) <- fromEitherIOCli $ readFileTxBody txbodyFile - let nShelleyKeyWitW32 = fromIntegral nShelleyKeyWitnesses - - InAnyShelleyBasedEra sbe txbody <- pure $ unIncompleteTxBody unwitnessed + let nShelleyKeyWitW32 :: Word + nShelleyKeyWitW32 = fromIntegral nShelleyKeyWitnesses era <- fromEitherCli $ Exp.sbeToEra sbe - lpparams <- + (lpparams :: L.PParams (Exp.LedgerEra era)) <- fromExceptTCli @ProtocolParamsError $ Exp.obtainCommonConstraints era $ readProtocolParameters protocolParamsFile - let shelleyfee = evaluateTransactionFee sbe lpparams txbody nShelleyKeyWitW32 0 sReferenceScript - - let byronfee = - shelleyBasedEraConstraints sbe $ - calculateByronWitnessFees (lpparams ^. L.ppTxFeePerByteL) nByronKeyWitnesses - - let fee = shelleyfee + byronfee + let unsignedTx :: Exp.UnsignedTx (Exp.LedgerEra era) + unsignedTx = obtainCommonConstraints era $ Exp.UnsignedTx ledgerTx + shelleyfee :: Lovelace + shelleyfee = + obtainCommonConstraints era $ + Exp.evaluateTransactionFee lpparams unsignedTx nShelleyKeyWitW32 0 sReferenceScript + txFeePerByte :: L.CoinPerByte + txFeePerByte = obtainCommonConstraints era $ lpparams ^. L.ppTxFeePerByteL + byronfee :: Lovelace + byronfee = calculateByronWitnessFees txFeePerByte nByronKeyWitnesses + fee :: Lovelace + fee = shelleyfee + byronfee textToWrite = docToText $ pretty fee content = Aeson.object ["fee" .= fee] @@ -1539,7 +1551,7 @@ runTransactionCalculatePlutusScriptCostCmd -> UTxO era -> Tx era -> ExceptT TxCmdError IO () - calculatePlutusScriptsCosts aeo systemStart eraHistory pparams txEraUtxo tx = do + calculatePlutusScriptsCosts aeo systemStart eraHistory pparams txEraUtxo tx@(ShelleyTx sbe ledgerTx) = do let era' = toCardanoEra aeo let scriptHashes = collectPlutusScriptHashes aeo tx txEraUtxo @@ -1548,13 +1560,13 @@ runTransactionCalculatePlutusScriptCostCmd pure (getExecutionUnitPrices era' pparams) & onNothing (left TxCmdPParamExecutionUnitsNotAvailable) let scriptExecUnitsMap = - evaluateTransactionExecutionUnits - era' + evaluateTransactionExecutionUnitsShelley + sbe systemStart (toLedgerEpochInfo eraHistory) pparams txEraUtxo - (getTxBody tx) + ledgerTx scriptCostOutput <- firstExceptT TxCmdPlutusScriptCostErr $ @@ -1663,20 +1675,19 @@ runTransactionTxIdCmd { inputTxBodyOrTxFile , outputFormat } = do - InAnyShelleyBasedEra _era txbody <- + txId <- case inputTxBodyOrTxFile of InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- + IncompleteTxBody sbe (Exp.UnsignedTx ledgerTx) <- firstExceptT TxCmdTextEnvError . newExceptT $ readFileTxBody txbodyFile - return $ unIncompleteTxBody unwitnessed + return $ shelleyBasedEraConstraints sbe $ getTxIdShelley sbe (ledgerTx ^. L.bodyTxL) InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath - InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdTextEnvError) - return . InAnyShelleyBasedEra era $ getTxBody tx - - let txId = getTxId txbody + InAnyShelleyBasedEra era (ShelleyTx _ ledgerTx) <- + lift (readFileTx txFile) & onLeft (left . TxCmdTextEnvError) + return $ shelleyBasedEraConstraints era $ getTxIdShelley era (ledgerTx ^. L.bodyTxL) liftIO $ outputFormat @@ -1703,28 +1714,26 @@ runTransactionWitnessCmd , outFile } = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- + IncompleteTxBody sbe (Exp.UnsignedTx ledgerTx) <- firstExceptT TxCmdTextEnvError . newExceptT $ readFileTxBody txbodyFile - case unwitnessed of - IncompleteTxBody anyTxBody -> do - InAnyShelleyBasedEra sbe txbody@(ShelleyTxBody _ ledgerTxBody _ _ _ _) <- pure anyTxBody - someWit <- - firstExceptT TxCmdReadWitnessSigningDataError - . newExceptT - $ readWitnessSigningData witnessSigningData - witness <- - case categoriseSomeSigningWitness someWit of - -- Byron witnesses require the network ID. This can either be provided - -- directly or derived from a provided Byron address. - AByronWitness bootstrapWitData -> - firstExceptT TxCmdBootstrapWitnessError . liftEither $ - mkShelleyBootstrapWitness sbe mNetworkId ledgerTxBody bootstrapWitData - AShelleyKeyWitness skShelley -> - pure $ makeShelleyKeyWitness sbe txbody skShelley + let ledgerTxBody = shelleyBasedEraConstraints sbe $ ledgerTx ^. L.bodyTxL + someWit <- + firstExceptT TxCmdReadWitnessSigningDataError + . newExceptT + $ readWitnessSigningData witnessSigningData + witness <- + case categoriseSomeSigningWitness someWit of + -- Byron witnesses require the network ID. This can either be provided + -- directly or derived from a provided Byron address. + AByronWitness bootstrapWitData -> + firstExceptT TxCmdBootstrapWitnessError . liftEither $ + mkShelleyBootstrapWitness sbe mNetworkId ledgerTxBody bootstrapWitData + AShelleyKeyWitness skShelley -> + pure $ makeShelleyKeyWitness' sbe ledgerTxBody skShelley - firstExceptT TxCmdWriteFileError . newExceptT $ - writeTxWitnessFileTextEnvelope sbe outFile witness + firstExceptT TxCmdWriteFileError . newExceptT $ + writeTxWitnessFileTextEnvelope sbe outFile witness runTransactionSignWitnessCmd :: () @@ -1739,7 +1748,7 @@ runTransactionSignWitnessCmd } = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath -- unwitnessed body - IncompleteTxBody (InAnyShelleyBasedEra era txbody) <- + IncompleteTxBody era (Exp.UnsignedTx ledgerTx) <- lift (readFileTxBody txbodyFile) & onLeft (left . TxCmdTextEnvError) witnesses <- sequence @@ -1759,7 +1768,8 @@ runTransactionSignWitnessCmd | witnessFile@(WitnessFile file) <- witnessFiles ] - let tx = makeSignedTransaction witnesses txbody + let unsignedTxAsTx = shelleyBasedEraConstraints era $ ShelleyTx era ledgerTx + tx = addWitnesses witnesses unsignedTxAsTx modifyError TxCmdWriteFileError $ hoistIOEither $ if isCborOutCanonical == TxCborCanonical diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Debug/TransactionView/Run.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Debug/TransactionView/Run.hs index 153b61db96..cc15524e97 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Debug/TransactionView/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Debug/TransactionView/Run.hs @@ -37,19 +37,15 @@ runTransactionViewCmd case inputTxBodyOrTxFile of InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- - fromEitherIOCli $ - readFileTxBody txbodyFile - InAnyShelleyBasedEra (sbe :: ShelleyBasedEra era) txbody <- - pure $ unIncompleteTxBody unwitnessed + IncompleteTxBody (sbe :: ShelleyBasedEra era) (Exp.UnsignedTx ledgerTx) <- + fromEitherIOCli $ readFileTxBody txbodyFile era <- fromEitherCli (Exp.sbeToEra sbe) -- Why are we differentiating between a transaction body and a transaction? - -- In the case of a transaction body, we /could/ simply call @makeSignedTransaction []@ + -- In the case of a transaction body, we /could/ simply call @addWitnesses []@ -- to get a transaction which would allow us to reuse friendlyTxBS. However, -- this would mean that we'd have an empty list of witnesses mentioned in the output, which -- is arguably not part of the transaction body. - let ShelleyTx _ ledgerTx = makeSignedTransaction [] txbody - unsignedTx :: Exp.UnsignedTx (Exp.LedgerEra era) + let unsignedTx :: Exp.UnsignedTx (Exp.LedgerEra era) unsignedTx = Exp.obtainCommonConstraints era $ Exp.UnsignedTx ledgerTx fromEitherIOCli @(FileError ()) $ friendlyTxBody outputFormat mOutFile era unsignedTx diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index a1bac324a8..a9aa5d6c13 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -303,8 +303,12 @@ readFileTx file = do InAnyShelleyBasedEra sbe tx <- pure cddlTx return $ Right $ inAnyShelleyBasedEra sbe tx -newtype IncompleteTxBody - = IncompleteTxBody {unIncompleteTxBody :: InAnyShelleyBasedEra TxBody} +data IncompleteTxBody where + IncompleteTxBody + :: IsShelleyBasedEra era + => ShelleyBasedEra era + -> Exp.UnsignedTx (ShelleyLedgerEra era) + -> IncompleteTxBody readFileTxBody :: FileOrPipe -> IO (Either (FileError TextEnvelopeError) IncompleteTxBody) readFileTxBody file = do @@ -312,8 +316,8 @@ readFileTxBody file = do case cddlTxOrErr of Left e -> return $ Left e Right cddlTx -> do - InAnyShelleyBasedEra sbe tx <- pure cddlTx - return $ Right $ IncompleteTxBody $ inAnyShelleyBasedEra sbe $ getTxBody tx + InAnyShelleyBasedEra sbe (ShelleyTx _ ledgerTx) <- pure cddlTx + return $ Right $ shelleyBasedEraConstraints sbe $ IncompleteTxBody sbe (Exp.UnsignedTx ledgerTx) readTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)) readTx = diff --git a/cardano-cli/src/Cardano/CLI/Type/Common.hs b/cardano-cli/src/Cardano/CLI/Type/Common.hs index ac7c8e43c5..c39b7ec73a 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Common.hs @@ -498,7 +498,9 @@ data EpochLeadershipSchedule | NextEpoch deriving Show -type TxBodyFile = File (TxBody ()) +data TxBodyTag + +type TxBodyFile = File TxBodyTag type TxFile = File (Tx ())