From 23b7bbf2bb511b148a558b44a0684a40410921e7 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 24 Aug 2023 15:38:31 -0400 Subject: [PATCH] Upgrade cardano-api 8.19 --- cabal.project | 2 +- cardano-cli/cardano-cli.cabal | 6 +- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 4 +- .../CLI/EraBased/Options/Governance/DRep.hs | 1 - .../src/Cardano/CLI/EraBased/Run/Query.hs | 81 ++++++++---------- .../Cardano/CLI/EraBased/Run/Transaction.hs | 82 +++++++++++-------- cardano-cli/src/Cardano/CLI/Helpers.hs | 7 -- .../src/Cardano/CLI/Legacy/Run/Query.hs | 2 +- .../src/Cardano/CLI/Legacy/Run/Transaction.hs | 13 +-- cardano-cli/src/Cardano/CLI/Orphans.hs | 19 +---- cardano-cli/src/Cardano/CLI/Read.hs | 7 +- .../CLI/Types/Errors/ShelleyQueryCmdError.hs | 2 + .../CLI/Types/Errors/TxValidationError.hs | 10 +-- cardano-cli/src/Cardano/CLI/Types/Output.hs | 5 +- flake.lock | 82 ++++++++----------- 15 files changed, 139 insertions(+), 184 deletions(-) diff --git a/cabal.project b/cabal.project index 0e0d8dba57..cf6f1ee3bb 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-08-08T19:56:09Z - , cardano-haskell-packages 2023-09-01T08:47:12Z + , cardano-haskell-packages 2023-09-06T08:30:00Z packages: cardano-cli diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 5c854e1112..aa938c1c16 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -181,7 +181,7 @@ library , binary , bytestring , canonical-json - , cardano-api ^>= 8.17.1 + , cardano-api ^>= 8.19 , cardano-binary , cardano-crypto , cardano-crypto-class ^>= 2.1.2 @@ -271,7 +271,7 @@ test-suite cardano-cli-test , base16-bytestring , bech32 >= 1.1.0 , bytestring - , cardano-api:{cardano-api, internal} ^>= 8.17.1 + , cardano-api:{cardano-api, internal} ^>= 8.19 , cardano-api-gen ^>= 8.2.0.0 , cardano-cli , cardano-cli:cardano-cli-test-lib @@ -315,7 +315,7 @@ test-suite cardano-cli-golden build-depends: aeson >= 1.5.6.0 , base16-bytestring , bytestring - , cardano-api:{cardano-api, gen} ^>= 8.17.1 + , cardano-api:{cardano-api, gen} ^>= 8.19 , cardano-binary , cardano-cli , cardano-cli:cardano-cli-test-lib diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 2117136667..3dce8cdc43 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -171,7 +171,7 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone , txScriptValidity = TxScriptValidityNone - , txGovernanceActions = TxGovernanceActionsNone + , txProposalProcedures = Nothing , txVotingProcedures = Nothing } @@ -220,7 +220,7 @@ txSpendUTxOByronPBFT nId sk txIns outs = do , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone , txScriptValidity = TxScriptValidityNone - , txGovernanceActions = TxGovernanceActionsNone + , txProposalProcedures = Nothing , txVotingProcedures = Nothing } diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs index e57b6f99dc..8ca845b409 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs @@ -9,7 +9,6 @@ module Cardano.CLI.EraBased.Options.Governance.DRep ) where import Cardano.Api -import qualified Cardano.Api.Ledger as Ledger import Cardano.CLI.Environment import Cardano.CLI.EraBased.Commands.Governance.DRep diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index cbe8978140..135cf3f74b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -10,8 +10,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} - module Cardano.CLI.EraBased.Run.Query ( runQueryConstitutionHashCmd , runQueryKesPeriodInfoCmd @@ -38,9 +36,10 @@ module Cardano.CLI.EraBased.Run.Query import Cardano.Api hiding (QueryInShelleyBasedEra (..)) import qualified Cardano.Api as Api import Cardano.Api.Byron hiding (QueryInShelleyBasedEra (..)) +import qualified Cardano.Api.Ledger as Ledger import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) -import Cardano.CLI.Helpers (hushM, pPrintCBOR) +import Cardano.CLI.Helpers (pPrintCBOR) import Cardano.CLI.Legacy.Run.Genesis (readAndDecodeShelleyGenesis) import Cardano.CLI.Pretty import Cardano.CLI.Types.Common @@ -72,9 +71,8 @@ import Control.Monad (forM, forM_, join) import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Unlift (MonadIO (..)) import Control.Monad.Trans.Class -import Control.Monad.Trans.Except (ExceptT (..), except, runExcept, runExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, - hoistMaybe, left, onLeft, onNothing) +import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra import Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.Types as Aeson @@ -151,36 +149,32 @@ runQueryProtocolParametersCmd -> ExceptT ShelleyQueryCmdError IO () runQueryProtocolParametersCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath + anyE@(AnyCardanoEra era) <- firstExceptT ShelleyQueryCmdAcquireFailure $ newExceptT $ determineEra cModeParams localNodeConnInfo + sbe <- case cardanoEraStyle era of + LegacyByronEra -> left ShelleyQueryCmdByronEra + ShelleyBasedEra sbe -> return sbe + let cMode = consensusModeOnly cModeParams + eInMode <- toEraInMode era cMode + & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - - sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) - - let cMode = consensusModeOnly cModeParams - - eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) - - lift (queryProtocolParameters eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdEraMismatch) - - writeProtocolParameters mOutFile =<< except (join (first ShelleyQueryCmdAcquireFailure result)) - - where - writeProtocolParameters - :: Maybe (File () Out) - -> ProtocolParameters - -> ExceptT ShelleyQueryCmdError IO () - writeProtocolParameters mOutFile' pparams = - case mOutFile' of - Nothing -> liftIO $ LBS.putStrLn (encodePretty pparams) - Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) $ - LBS.writeFile fpath (encodePretty pparams) + let qInMode = QueryInEra eInMode $ QueryInShelleyBasedEra sbe Api.QueryProtocolParameters + pp <- firstExceptT ShelleyQueryCmdConvenienceError + . newExceptT $ executeQueryAnyMode era localNodeConnInfo qInMode + writeProtocolParameters sbe mOutFile pp + where + -- TODO: Conway era - use ledger PParams JSON + writeProtocolParameters + :: ShelleyBasedEra era + -> Maybe (File () Out) + -> Ledger.PParams (ShelleyLedgerEra era) + -> ExceptT ShelleyQueryCmdError IO () + writeProtocolParameters sbe mOutFile' pparams = + let apiPParamsJSON = (encodePretty $ fromLedgerPParams sbe pparams) + in case mOutFile' of + Nothing -> liftIO $ LBS.putStrLn apiPParamsJSON + Just (File fpath) -> + handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) $ + LBS.writeFile fpath apiPParamsJSON -- | Calculate the percentage sync rendered as text. percentage @@ -417,7 +411,7 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode where - currentKesPeriod :: ChainTip -> GenesisParameters -> CurrentKesPeriod + currentKesPeriod :: ChainTip -> GenesisParameters era -> CurrentKesPeriod currentKesPeriod ChainTipAtGenesis _ = CurrentKesPeriod 0 currentKesPeriod (ChainTip currSlot _ _) gParams = let slotsPerKesPeriod = fromIntegral $ protocolParamSlotsPerKESPeriod gParams @@ -426,7 +420,7 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network opCertStartingKesPeriod :: OperationalCertificate -> OpCertStartingKesPeriod opCertStartingKesPeriod = OpCertStartingKesPeriod . fromIntegral . getKesPeriod - opCertEndKesPeriod :: GenesisParameters -> OperationalCertificate -> OpCertEndingKesPeriod + opCertEndKesPeriod :: GenesisParameters era -> OperationalCertificate -> OpCertEndingKesPeriod opCertEndKesPeriod gParams oCert = let OpCertStartingKesPeriod start = opCertStartingKesPeriod oCert maxKesEvo = fromIntegral $ protocolParamMaxKESEvolutions gParams @@ -434,7 +428,7 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network -- See OCERT rule in Shelley Spec: https://hydra.iohk.io/job/Cardano/cardano-ledger-specs/shelleyLedgerSpec/latest/download-by-type/doc-pdf/ledger-spec opCertIntervalInfo - :: GenesisParameters + :: GenesisParameters era -> ChainTip -> CurrentKesPeriod -> OpCertStartingKesPeriod @@ -460,7 +454,7 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network opCertExpiryUtcTime :: Tentative (EpochInfo (Either Text)) - -> GenesisParameters + -> GenesisParameters era -> OpCertEndingKesPeriod -> Maybe UTCTime opCertExpiryUtcTime eInfo gParams (OpCertEndingKesPeriod oCertExpiryKesPeriod) = @@ -521,7 +515,7 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network :: OpCertIntervalInformation -> OpCertNodeAndOnDiskCounterInformation -> Tentative (EpochInfo (Either Text)) - -> GenesisParameters + -> GenesisParameters era -> O.QueryKesPeriodInfoOutput createQueryKesPeriodInfoOutput oCertIntervalInfo oCertCounterInfo eInfo gParams = let (e, mStillExp) = case oCertIntervalInfo of @@ -1285,9 +1279,6 @@ runQueryLeadershipScheduleCmd & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) - bpp <- hoistEither . first ShelleyQueryCmdProtocolParameterConversionError $ - bundleProtocolParams era pparams - case whichSchedule of CurrentEpoch -> do serCurrentEpochState <- lift (queryPoolDistribution eInMode sbe (Just (Set.singleton poolid))) @@ -1301,7 +1292,7 @@ runQueryLeadershipScheduleCmd sbe shelleyGenesis eInfo - bpp + pparams ptclState poolid vrkSkey @@ -1321,7 +1312,7 @@ runQueryLeadershipScheduleCmd schedule <- firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither $ shelleyBasedEraConstraints sbe $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis - serCurrentEpochState ptclState poolid vrkSkey bpp + serCurrentEpochState ptclState poolid vrkSkey pparams eInfo (tip, curentEpoch) writeSchedule mJsonOutputFile eInfo shelleyGenesis schedule diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 64af888b29..d3b3d5da4d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -7,11 +7,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -{- HLINT ignore "Unused LANGUAGE pragma" -} -{- HLINT ignore "Use let" -} - module Cardano.CLI.EraBased.Run.Transaction ( runTransactionCmds , runTxBuildCmd @@ -30,6 +25,7 @@ module Cardano.CLI.EraBased.Run.Transaction import Cardano.Api import Cardano.Api.Byron hiding (SomeByronSigningKey (..)) +import qualified Cardano.Api.Ledger as Ledger import Cardano.Api.Shelley import Cardano.CLI.EraBased.Commands.Transaction @@ -41,8 +37,9 @@ import Cardano.CLI.Types.Errors.ShelleyBootstrapWitnessError import Cardano.CLI.Types.Errors.ShelleyTxCmdError import Cardano.CLI.Types.Errors.TxValidationError import Cardano.CLI.Types.Governance -import Cardano.CLI.Types.Output +import Cardano.CLI.Types.Output (renderScriptCosts) import Cardano.CLI.Types.TxFeature +import qualified Cardano.Ledger.Alonzo.Core as Ledger import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx import Control.Monad (forM) @@ -58,7 +55,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Data ((:~:) (..)) import Data.Foldable (Foldable (..)) import Data.Function ((&)) -import Data.Functor import qualified Data.List as List import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -69,6 +65,7 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Type.Equality (TestEquality (..)) +import Lens.Micro ((^.)) import qualified System.IO as IO runTransactionCmds :: TransactionCmds era -> ExceptT ShelleyTxCmdError IO () @@ -177,7 +174,7 @@ runTxBuildCmd $ readScriptWitnessFilesThruple era wdrls txMetadata <- firstExceptT ShelleyTxCmdMetadataError . newExceptT $ readTxMetadata era metadataSchema metadataFiles - valuesWithScriptWits <- readValueScriptWitnesses era $ fromMaybe (mempty, []) mValue + valuesWithScriptWits <- readValueScriptWitnesses era $ fromMaybe mempty mValue scripts <- firstExceptT ShelleyTxCmdScriptFileError $ mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles txAuxScripts <- hoistEither $ first ShelleyTxCmdAuxScriptsValidationError $ validateTxAuxScripts era scripts @@ -233,13 +230,7 @@ runTxBuildCmd let BuildTxWith mTxProtocolParams = txProtocolParams txBodycontent pparams <- pure mTxProtocolParams & onNothing (left ShelleyTxCmdProtocolParametersNotPresentInTxBody) - pp <- case cardanoEraStyle era of - LegacyByronEra -> left ShelleyTxCmdByronEra - ShelleyBasedEra sbe -> - hoistEither . first ShelleyTxCmdProtocolParamsConverstionError $ toLedgerPParams sbe pparams - - executionUnitPrices <- pure (protocolParamPrices pparams) & onNothing (left ShelleyTxCmdPParamExecutionUnitsNotAvailable) - + executionUnitPrices <- pure (getExecutionUnitPrices era pparams) & onNothing (left ShelleyTxCmdPParamExecutionUnitsNotAvailable) let consensusMode = consensusModeOnly cModeParams case consensusMode of @@ -262,7 +253,7 @@ runTxBuildCmd firstExceptT ShelleyTxCmdTxExecUnitsErr $ hoistEither $ evaluateTransactionExecutionUnits systemStart (toLedgerEpochInfo eraHistory) - pp txEraUtxo balancedTxBody + pparams txEraUtxo balancedTxBody scriptCostOutput <- firstExceptT ShelleyTxCmdPlutusScriptCostErr $ hoistEither @@ -279,8 +270,19 @@ runTxBuildCmd in lift (cardanoEraConstraints era $ writeTxFileTextEnvelopeCddl fpath noWitTx) & onLeft (left . ShelleyTxCmdWriteFileError) -runTxBuildRawCmd :: () - => CardanoEra era +getExecutionUnitPrices :: CardanoEra era -> LedgerProtocolParameters era -> Maybe Ledger.Prices +getExecutionUnitPrices cEra (LedgerProtocolParameters pp) = do + ShelleyBasedEra sbe <- pure $ cardanoEraStyle cEra + case sbe of + ShelleyBasedEraShelley -> Nothing + ShelleyBasedEraAllegra -> Nothing + ShelleyBasedEraMary -> Nothing + ShelleyBasedEraAlonzo -> Just $ pp ^. Ledger.ppPricesL + ShelleyBasedEraBabbage -> Just $ pp ^. Ledger.ppPricesL + ShelleyBasedEraConway -> Just $ pp ^. Ledger.ppPricesL + +runTxBuildRawCmd + :: CardanoEra era -> Maybe ScriptValidity -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] -> [TxIn] -- ^ Read only reference inputs @@ -326,14 +328,22 @@ runTxBuildRawCmd $ readScriptWitnessFilesThruple era wdrls txMetadata <- firstExceptT ShelleyTxCmdMetadataError . newExceptT $ readTxMetadata era metadataSchema metadataFiles - valuesWithScriptWits <- readValueScriptWitnesses era $ fromMaybe (mempty, []) mValue + valuesWithScriptWits <- readValueScriptWitnesses era $ fromMaybe mempty mValue scripts <- firstExceptT ShelleyTxCmdScriptFileError $ mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles txAuxScripts <- hoistEither $ first ShelleyTxCmdAuxScriptsValidationError $ validateTxAuxScripts era scripts + -- TODO: Conway era - update readProtocolParameters to rely on Ledger.PParams JSON instances pparams <- forM mpParamsFile $ \ppf -> firstExceptT ShelleyTxCmdProtocolParamsError (readProtocolParameters ppf) + mLedgerPParams <- case cardanoEraStyle era of + LegacyByronEra -> return Nothing + ShelleyBasedEra sbe -> + forM pparams $ \pp -> + firstExceptT ShelleyTxCmdProtocolParamsConverstionError + . hoistEither $ convertToLedgerProtocolParameters sbe pp + mProp <- forM mUpProp $ \(UpdateProposalFile upFp) -> firstExceptT ShelleyTxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) @@ -347,7 +357,7 @@ runTxBuildRawCmd txBody <- hoistEither $ runTxBuildRaw era mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns filteredTxinsc mReturnCollateral mTotColl txOuts mLowBound mUpperBound fee valuesWithScriptWits certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits requiredSigners txAuxScripts - txMetadata pparams mProp + txMetadata mLedgerPParams mProp let noWitTx = makeSignedTransaction [] txBody lift (getIsCardanoEraConstraint era $ writeTxFileTextEnvelopeCddl out noWitTx) @@ -384,7 +394,7 @@ runTxBuildRaw :: () -- ^ Required signers -> TxAuxScripts era -> TxMetadataInEra era - -> Maybe ProtocolParameters + -> Maybe (LedgerProtocolParameters era) -> Maybe UpdateProposal -> Either ShelleyTxCmdError (TxBody era) runTxBuildRaw era @@ -427,7 +437,7 @@ runTxBuildRaw era <- createTxMintValue era valuesWithScriptWits validatedTxScriptValidity <- first ShelleyTxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity - let validatedTxGovernanceActions = TxGovernanceActionsNone -- TODO: Conwary era + let validatedTxProposalProcedures = Nothing -- TODO: Conwary era validatedTxVotes = Nothing -- TODO: Conwary era let txBodyContent = TxBodyContent @@ -448,7 +458,7 @@ runTxBuildRaw era , txUpdateProposal = validatedTxUpProp , txMintValue = validatedMintValue , txScriptValidity = validatedTxScriptValidity - , txGovernanceActions = validatedTxGovernanceActions + , txProposalProcedures = validatedTxProposalProcedures , txVotingProcedures = validatedTxVotes } @@ -492,7 +502,7 @@ runTxBuild :: () -> Maybe UpdateProposal -> Maybe Word -> VotingProcedures era - -> TxGovernanceActions era + -> [Proposal era] -> TxBuildOutputOptions -> ExceptT ShelleyTxCmdError IO (BalancedTxBody era) runTxBuild @@ -530,10 +540,9 @@ runTxBuild validatedTxScriptValidity <- hoistEither (first ShelleyTxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity) case (consensusMode, cardanoEraStyle era) of - (CardanoMode, ShelleyBasedEra sbe) -> do - void $ pure (toEraInMode era CardanoMode) - & onNothing (left (ShelleyTxCmdEraConsensusModeMismatchTxBalance outputOptions - (AnyConsensusMode CardanoMode) (AnyCardanoEra era))) + (CardanoMode, ShelleyBasedEra _) -> do + _ <- toEraInMode era CardanoMode + & hoistMaybe (ShelleyTxCmdEraConsensusModeMismatchTxBalance outputOptions (AnyConsensusMode CardanoMode) (AnyCardanoEra era)) let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc localNodeConnInfo = LocalNodeConnectInfo @@ -546,25 +555,26 @@ runTxBuild & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) & onLeft (left . ShelleyTxCmdQueryConvenienceError . QceUnsupportedNtcVersion) + Refl <- testEquality era nodeEra + & hoistMaybe (ShelleyTxCmdTxEraCastErr $ EraCastError ("nodeEra" :: Text) era nodeEra) + let certs = case validatedTxCerts of TxCertificates _ cs _ -> cs _ -> [] - nodeEraCerts <- pure (forM certs $ eraCast nodeEra) - & onLeft (left . ShelleyTxCmdTxEraCastErr) + nodeEraCerts <- forM certs (eraCast nodeEra) + & firstExceptT ShelleyTxCmdTxEraCastErr . hoistEither (nodeEraUTxO, pparams, eraHistory, systemStart, stakePools, stakeDelegDeposits) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryStateForBalancedTx nodeEra allTxInputs nodeEraCerts) & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) & onLeft (left . ShelleyTxCmdQueryConvenienceError) - pp <- hoistEither . first ShelleyTxCmdProtocolParamsConverstionError $ toLedgerPParams sbe pparams - validatedPParams <- hoistEither $ first ShelleyTxCmdProtocolParametersValidationError $ validateProtocolParameters era (Just pparams) - let validatedTxGovernanceActions = proposals + let validatedTxProposalProcedures = proposals validatedTxVotes = votes txBodyContent = TxBodyContent @@ -585,8 +595,8 @@ runTxBuild , txUpdateProposal = validatedTxUpProp , txMintValue = validatedMintValue , txScriptValidity = validatedTxScriptValidity - , txGovernanceActions = validatedTxGovernanceActions - , txVotingProcedures = inEraFeature era Nothing (\w -> Just (Featured w validatedTxVotes)) + , txProposalProcedures = inEraFeatureMaybe era (`Featured` validatedTxProposalProcedures) + , txVotingProcedures = inEraFeatureMaybe era (`Featured` validatedTxVotes) } firstExceptT ShelleyTxCmdTxInsDoNotExist @@ -606,7 +616,7 @@ runTxBuild firstExceptT ShelleyTxCmdBalanceTxBody . hoistEither $ makeTransactionBodyAutoBalance systemStart (toLedgerEpochInfo eraHistory) - pp stakePools stakeDelegDeposits txEraUtxo + pparams stakePools stakeDelegDeposits txEraUtxo txBodyContent cAddr mOverrideWits liftIO $ putStrLn $ "Estimated transaction fee: " <> (show fee :: String) diff --git a/cardano-cli/src/Cardano/CLI/Helpers.hs b/cardano-cli/src/Cardano/CLI/Helpers.hs index 7bcd76141b..ac04634d22 100644 --- a/cardano-cli/src/Cardano/CLI/Helpers.hs +++ b/cardano-cli/src/Cardano/CLI/Helpers.hs @@ -12,7 +12,6 @@ module Cardano.CLI.Helpers , readCBOR , renderHelpersError , validateCBOR - , hushM ) where import Cardano.Chain.Block (decCBORABlockOrBoundary) @@ -130,9 +129,3 @@ validateCBOR cborObject bs = void $ decodeCBOR bs (fromCBOR :: Decoder s Update.Vote) Right "Valid Byron vote." --- | Convert an Either to a Maybe and execute the supplied handler --- in the Left case. -hushM :: forall e m a. Monad m => Either e a -> (e -> m ()) -> m (Maybe a) -hushM r f = case r of - Right a -> return (Just a) - Left e -> f e >> return Nothing diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs index f5e2325ed8..f43305c8bc 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs @@ -17,7 +17,7 @@ import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.ShelleyQueryCmdError import Cardano.CLI.Types.Key (VerificationKeyOrHashOrFile) -import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Except import Data.Time.Clock runLegacyQueryCmds :: LegacyQueryCmds -> ExceptT ShelleyQueryCmdError IO () diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index d1a0f2d591..82b6c01a9e 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -1,16 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -{- HLINT ignore "Unused LANGUAGE pragma" -} -{- HLINT ignore "Use let" -} module Cardano.CLI.Legacy.Run.Transaction ( runLegacyTransactionCmds @@ -26,6 +18,7 @@ import Cardano.CLI.Types.Governance import Control.Monad.Trans.Except + runLegacyTransactionCmds :: LegacyTransactionCmds -> ExceptT ShelleyTxCmdError IO () runLegacyTransactionCmds cmd = case cmd of @@ -49,8 +42,8 @@ runLegacyTransactionCmds cmd = runLegacyTxSubmitCmd mNodeSocketPath anyConsensusModeParams network txFp TxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses -> runLegacyTxCalculateMinFeeCmd txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses - TxCalculateMinRequiredUTxO era pParamsFile txOuts -> - runLegacyTxCalculateMinRequiredUTxOCmd era pParamsFile txOuts + TxCalculateMinRequiredUTxO era pParamsFile txOuts' -> + runLegacyTxCalculateMinRequiredUTxOCmd era pParamsFile txOuts' TxHashScriptData scriptDataOrFile -> runLegacyTxHashScriptDataCmd scriptDataOrFile TxGetTxId txinfile -> diff --git a/cardano-cli/src/Cardano/CLI/Orphans.hs b/cardano-cli/src/Cardano/CLI/Orphans.hs index bd4af04789..b0bad01c8e 100644 --- a/cardano-cli/src/Cardano/CLI/Orphans.hs +++ b/cardano-cli/src/Cardano/CLI/Orphans.hs @@ -1,23 +1,6 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.CLI.Orphans () where -import Cardano.Api (CardanoEra (..), FeatureInEra (..), ShelleyBasedEra (..)) +import Cardano.Api () -instance FeatureInEra ShelleyBasedEra where - featureInEra no yes = \case - ByronEra -> no - ShelleyEra -> yes ShelleyBasedEraShelley - AllegraEra -> yes ShelleyBasedEraAllegra - MaryEra -> yes ShelleyBasedEraMary - AlonzoEra -> yes ShelleyBasedEraAlonzo - BabbageEra -> yes ShelleyBasedEraBabbage - ConwayEra -> yes ShelleyBasedEraConway diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 85147a260d..cf646ee2e7 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -803,13 +803,12 @@ data ProposalError readTxGovernanceActions :: CardanoEra era -> [ProposalFile In] - -> IO (Either ConstitutionError (TxGovernanceActions era)) -readTxGovernanceActions _ [] = return $ Right TxGovernanceActionsNone + -> IO (Either ConstitutionError [Proposal era]) +readTxGovernanceActions _ [] = return $ Right [] readTxGovernanceActions era files = runExceptT $ do w <- maybeFeatureInEra era & hoistMaybe (ConstitutionNotSupportedInEra $ cardanoEraConstraints era $ AnyCardanoEra era) - proposals <- newExceptT $ sequence <$> mapM (readProposal w) files - pure $ TxGovernanceActions w proposals + newExceptT $ sequence <$> mapM (readProposal w) files readProposal :: ConwayEraOnwards era diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdError.hs index ab47680d01..51a7094084 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdError.hs @@ -34,6 +34,7 @@ import Formatting.Buildable (build) data ShelleyQueryCmdError = ShelleyQueryCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError + | ShelleyQueryCmdConvenienceError !QueryConvenienceError | ShelleyQueryCmdWriteFileError !(FileError ()) | ShelleyQueryCmdHelpersError !HelpersError | ShelleyQueryCmdAcquireFailure !AcquiringFailure @@ -89,3 +90,4 @@ renderShelleyQueryCmdError err = "Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)." ShelleyQueryCmdProtocolParameterConversionError ppce -> Text.pack $ "Failed to convert protocol parameter: " <> displayError ppce + ShelleyQueryCmdConvenienceError qce -> renderQueryConvenienceError qce diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index 73657d4b00..97d125cb48 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -309,15 +309,15 @@ instance Error TxProtocolParametersValidationError where validateProtocolParameters :: CardanoEra era - -> Maybe ProtocolParameters - -> Either TxProtocolParametersValidationError (BuildTxWith BuildTx (Maybe ProtocolParameters)) + -> Maybe (LedgerProtocolParameters era) + -> Either TxProtocolParametersValidationError (BuildTxWith BuildTx (Maybe (LedgerProtocolParameters era))) validateProtocolParameters _ Nothing = return (BuildTxWith Nothing) validateProtocolParameters era (Just pparams) = - case scriptDataSupportedInEra era of - Nothing -> Left $ ProtocolParametersNotSupported + case cardanoEraStyle era of + LegacyByronEra -> Left $ ProtocolParametersNotSupported $ getIsCardanoEraConstraint era $ AnyCardanoEra era - Just _ -> return . BuildTxWith $ Just pparams + ShelleyBasedEra _ -> return . BuildTxWith $ Just pparams newtype TxUpdateProposalValidationError = TxUpdateProposalNotSupported AnyCardanoEra diff --git a/cardano-cli/src/Cardano/CLI/Types/Output.hs b/cardano-cli/src/Cardano/CLI/Types/Output.hs index d2115f0821..5c9342bee9 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Output.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Output.hs @@ -12,6 +12,7 @@ module Cardano.CLI.Types.Output ) where import Cardano.Api +import qualified Cardano.Api.Ledger as Ledger import Cardano.Api.Shelley import Cardano.CLI.Orphans () @@ -260,7 +261,7 @@ instance ToJSON ScriptCostOutput where data PlutusScriptCostError = PlutusScriptCostErrPlutusScriptNotFound ScriptWitnessIndex | PlutusScriptCostErrExecError ScriptWitnessIndex (Maybe ScriptHash) ScriptExecutionError - | PlutusScriptCostErrRationalExceedsBound ExecutionUnitPrices ExecutionUnits + | PlutusScriptCostErrRationalExceedsBound Ledger.Prices ExecutionUnits | PlutusScriptCostErrRefInputNoScript TxIn | PlutusScriptCostErrRefInputNotInUTxO TxIn deriving Show @@ -282,7 +283,7 @@ instance Error PlutusScriptCostError where renderScriptCosts :: UTxO era - -> ExecutionUnitPrices + -> Ledger.Prices -> [(ScriptWitnessIndex, AnyScriptWitness era)] -- ^ Initial mapping of script witness index to actual script. -- We need this in order to know which script corresponds to the diff --git a/flake.lock b/flake.lock index a8b7272bc9..6ea1ea97ad 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1693560763, - "narHash": "sha256-Ta2CkAzPn70QiGn62vYQDfxwYCrqiOFfrONrUuza1u8=", + "lastModified": 1693988844, + "narHash": "sha256-0fvQy6GxgSkpufa0QeEtYNEY4G5nSQ7L4VIkGdfTt+w=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "f941b803944a7c70e27a8fb02fc6456807053684", + "rev": "27f047c00b5d079e6322a3eab53549cad9e77680", "type": "github" }, "original": { @@ -153,24 +153,6 @@ "type": "github" } }, - "flake-utils_2": { - "inputs": { - "systems": "systems_2" - }, - "locked": { - "lastModified": 1692799911, - "narHash": "sha256-3eihraek4qL744EvQXsK1Ha6C3CR7nnT8X2qWap4RNk=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "f9e7cf818399d17d347f847525c5a5a8032e4e44", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, "ghc-8.6.5-iohk": { "flake": false, "locked": { @@ -191,11 +173,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1693182531, - "narHash": "sha256-OejogS2E745biMj8NuUYatN7uoMRsg7giVnRQwfiays=", + "lastModified": 1693959895, + "narHash": "sha256-qLmbEucG4NTA507cQzhsqnE3nJqUSVAALQX6MgzDwGo=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "34cd9fe31d210f2ff041f490eaa4029f6b2812c4", + "rev": "d0d990c3a8daba50aee6ee31794cb87226f4e18f", "type": "github" }, "original": { @@ -212,11 +194,11 @@ "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", "flake-compat": "flake-compat", - "flake-utils": "flake-utils_2", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", "hackage": "hackage", "hls-1.10": "hls-1.10", "hls-2.0": "hls-2.0", + "hls-2.2": "hls-2.2", "hpc-coveralls": "hpc-coveralls", "hydra": "hydra", "iserv-proxy": "iserv-proxy", @@ -235,11 +217,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1693196365, - "narHash": "sha256-3fC4Ynlzxbpwwqnwlw+UesIB2808z6bTh3MitM1EVd4=", + "lastModified": 1693961398, + "narHash": "sha256-+ju59T0KJL0rIDhUXsS+OKrx7TOlE+R4GjbtVEjo9mA=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "5ed5f276df29a441ee4991667e7947528fa3cbb9", + "rev": "37d562be0e4c0090c230347968eb3d0d813cac02", "type": "github" }, "original": { @@ -282,6 +264,23 @@ "type": "github" } }, + "hls-2.2": { + "flake": false, + "locked": { + "lastModified": 1693064058, + "narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85", + "type": "github" + }, + "original": { + "owner": "haskell", + "ref": "2.2.0.0", + "repo": "haskell-language-server", + "type": "github" + } + }, "hpc-coveralls": { "flake": false, "locked": { @@ -347,11 +346,11 @@ "sodium": "sodium" }, "locked": { - "lastModified": 1692743532, - "narHash": "sha256-OcnZRZBh3pOx5uChTuO+4o9OHiG1ip36C35DaFrwjbM=", + "lastModified": 1693968598, + "narHash": "sha256-2wFadXHMgNYrF7N6jndfp3Ywm2G0r+QTPifrlzugkjo=", "owner": "input-output-hk", "repo": "iohk-nix", - "rev": "e5b4889e4d191cf2cb1495dd16b13ea016b5569a", + "rev": "7d738e59d276336d1e02447e27b0373164d3bc88", "type": "github" }, "original": { @@ -656,11 +655,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1693181390, - "narHash": "sha256-SWcgiVwyYfbd/ypwhkEmjJ92tCCsqQ179vwKH1m2lZE=", + "lastModified": 1693786159, + "narHash": "sha256-IzpBwbwD90CIdhOKfdzS98+o3AtoADNsSz5QBr281Gg=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "6479adae3f7559a300d3ee94af92ed9da5030794", + "rev": "69d620fde80c1dfbe78b081db1b5725e9c0ce9e2", "type": "github" }, "original": { @@ -683,21 +682,6 @@ "repo": "default", "type": "github" } - }, - "systems_2": { - "locked": { - "lastModified": 1681028828, - "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", - "owner": "nix-systems", - "repo": "default", - "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", - "type": "github" - }, - "original": { - "owner": "nix-systems", - "repo": "default", - "type": "github" - } } }, "root": "root",