From f0794663b0f0dcd878b4452ae5bb4ce11c9b260b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 30 Jan 2023 10:30:07 -0400 Subject: [PATCH 1/2] Define LedgerEpochInfo Modify constructBalancedTx to take LedgerEpochInfo instead of EraHistory CardanoMode --- cardano-api/src/Cardano/Api.hs | 1 + .../Cardano/Api/Convenience/Construction.hs | 6 +++--- cardano-api/src/Cardano/Api/Fees.hs | 18 ++++++------------ cardano-api/src/Cardano/Api/Query.hs | 16 +++++++++++++++- 4 files changed, 25 insertions(+), 16 deletions(-) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 1a63a388f96..22cf67b4c44 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -239,6 +239,7 @@ module Cardano.Api ( totalAndReturnCollateralSupportedInEra, -- ** Fee calculation + LedgerEpochInfo(..), transactionFee, toLedgerEpochInfo, estimateTransactionFee, diff --git a/cardano-api/src/Cardano/Api/Convenience/Construction.hs b/cardano-api/src/Cardano/Api/Convenience/Construction.hs index 1ffc03e6d90..f68ffeaff94 100644 --- a/cardano-api/src/Cardano/Api/Convenience/Construction.hs +++ b/cardano-api/src/Cardano/Api/Convenience/Construction.hs @@ -44,16 +44,16 @@ constructBalancedTx -> Maybe Word -- ^ Override key witnesses -> UTxO era -- ^ Just the transaction inputs, not the entire 'UTxO'. -> ProtocolParameters - -> EraHistory CardanoMode + -> LedgerEpochInfo -> SystemStart -> Set PoolId -- ^ The set of registered stake pools -> [ShelleyWitnessSigningKey] -> Either TxBodyErrorAutoBalance (Tx era) constructBalancedTx eInMode txbodcontent changeAddr mOverrideWits utxo pparams - eraHistory systemStart stakePools shelleyWitSigningKeys = do + ledgerEpochInfo systemStart stakePools shelleyWitSigningKeys = do BalancedTxBody _ txbody _txBalanceOutput _fee <- makeTransactionBodyAutoBalance - eInMode systemStart eraHistory + eInMode systemStart ledgerEpochInfo pparams stakePools utxo txbodcontent changeAddr mOverrideWits diff --git a/cardano-api/src/Cardano/Api/Fees.hs b/cardano-api/src/Cardano/Api/Fees.hs index 57fa7669e53..d646f094d30 100644 --- a/cardano-api/src/Cardano/Api/Fees.hs +++ b/cardano-api/src/Cardano/Api/Fees.hs @@ -38,7 +38,6 @@ module Cardano.Api.Fees ( -- * Internal helpers mapTxScriptWitnesses, - toLedgerEpochInfo, ) where import qualified Data.Array as Array @@ -56,13 +55,11 @@ import GHC.Records (HasField (..)) import Lens.Micro ((^.)) import Numeric.Natural -import Control.Monad.Trans.Except import qualified Prettyprinter as PP import qualified Prettyprinter.Render.String as PP import qualified Cardano.Binary as CBOR import qualified Cardano.Ledger.BaseTypes as Ledger -import Cardano.Slotting.EpochInfo (EpochInfo, hoistEpochInfo) import qualified Cardano.Chain.Common as Byron @@ -505,13 +502,14 @@ evaluateTransactionExecutionUnits :: forall era mode. EraInMode era mode -> SystemStart - -> EraHistory mode + -> LedgerEpochInfo -> ProtocolParameters -> UTxO era -> TxBody era -> Either TransactionValidityError (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)) -evaluateTransactionExecutionUnits _eraInMode systemstart history pparams utxo txbody = +evaluateTransactionExecutionUnits _eraInMode systemstart (LedgerEpochInfo ledgerEpochInfo) + pparams utxo txbody = case makeSignedTransaction [] txbody of ByronTx {} -> evalPreAlonzo ShelleyTx era tx' -> @@ -548,7 +546,7 @@ evaluateTransactionExecutionUnits _eraInMode systemstart history pparams utxo tx (toLedgerPParams era pparams) tx (toLedgerUTxO era utxo) - (toLedgerEpochInfo history) + ledgerEpochInfo systemstart cModelArray of Left err -> Left (TransactionValidityTranslationError err) @@ -570,7 +568,7 @@ evaluateTransactionExecutionUnits _eraInMode systemstart history pparams utxo tx (toLedgerPParams era pparams) tx (toLedgerUTxO era utxo) - (toLedgerEpochInfo history) + ledgerEpochInfo systemstart costModelsArray of Left err -> Left (TransactionValidityTranslationError err) @@ -631,10 +629,6 @@ evaluateTransactionExecutionUnits _eraInMode systemstart history pparams utxo tx obtainHasFieldConstraint CollateralInAlonzoEra f = f obtainHasFieldConstraint CollateralInBabbageEra f = f -toLedgerEpochInfo :: EraHistory mode -> EpochInfo (Either Text.Text) -toLedgerEpochInfo (EraHistory _ interpreter) = - hoistEpochInfo (first (Text.pack . show) . runExcept) $ - Consensus.interpreterToEpochInfo interpreter -- ---------------------------------------------------------------------------- -- Transaction balance @@ -927,7 +921,7 @@ makeTransactionBodyAutoBalance IsShelleyBasedEra era => EraInMode era mode -> SystemStart - -> EraHistory mode + -> LedgerEpochInfo -> ProtocolParameters -> Set PoolId -- ^ The set of registered stake pools -> UTxO era -- ^ Just the transaction inputs, not the entire 'UTxO'. diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index cca94f338a4..e18603e70f1 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -59,6 +59,9 @@ module Cardano.Api.Query ( EraHistory(..), SystemStart(..), + LedgerEpochInfo(..), + toLedgerEpochInfo, + SlotsInEpoch(..), SlotsToEpochEnd(..), @@ -71,10 +74,10 @@ module Cardano.Api.Query ( -- * Internal conversion functions toLedgerUTxO, fromLedgerUTxO, - ) where import Control.Monad (forM) +import Control.Monad.Trans.Except import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Types (Parser) @@ -90,6 +93,7 @@ import qualified Data.Set as Set import Data.Sharing (FromSharedCBOR, Interns, Share) import Data.SOP.Strict (SListI) import Data.Text (Text) +import qualified Data.Text as Text import Data.Typeable import Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..)) @@ -98,6 +102,7 @@ import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch) import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus import qualified Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus +import qualified Ouroboros.Consensus.HardFork.History as Consensus import qualified Ouroboros.Consensus.HardFork.History as History import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry @@ -112,6 +117,7 @@ import Ouroboros.Network.Block (Serialised (..)) import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..)) import Cardano.Binary +import Cardano.Slotting.EpochInfo (hoistEpochInfo) import Cardano.Slotting.Slot (WithOrigin (..)) import Cardano.Slotting.Time (SystemStart (..)) @@ -188,6 +194,14 @@ data EraHistory mode where getProgress :: SlotNo -> EraHistory mode -> Either Qry.PastHorizonException (RelativeTime, SlotLength) getProgress slotNo (EraHistory _ interpreter) = Qry.interpretQuery interpreter (Qry.slotToWallclock slotNo) + +newtype LedgerEpochInfo = LedgerEpochInfo { unLedgerEpochInfo :: Consensus.EpochInfo (Either Text) } + +toLedgerEpochInfo :: EraHistory mode -> LedgerEpochInfo +toLedgerEpochInfo (EraHistory _ interpreter) = + LedgerEpochInfo $ hoistEpochInfo (first (Text.pack . show) . runExcept) $ + Consensus.interpreterToEpochInfo interpreter + --TODO: add support for these -- QueryEraStart :: ConsensusModeIsMultiEra mode -- -> EraInMode era mode From 180f41c88e542d73d50c4c9f4752fbfc8a17dc08 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 30 Jan 2023 10:30:16 -0400 Subject: [PATCH 2/2] Propagate LedgerEpochInfo changes to cardano-cli --- cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs | 1 + cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index 037f3a69b5f..b4360326579 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -19,6 +19,7 @@ module Cardano.CLI.Shelley.Run.Query , renderShelleyQueryCmdError , renderLocalStateQueryError , runQueryCmd + , toEpochInfo , determineEra , mergeDelegsAndRewards , percentage diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 959b5db0b90..1957db89ef3 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -428,7 +428,7 @@ runTxBuildCmd scriptExecUnitsMap <- firstExceptT ShelleyTxCmdTxExecUnitsErr $ hoistEither $ evaluateTransactionExecutionUnits - eInMode systemStart eraHistory + eInMode systemStart (toLedgerEpochInfo eraHistory) pparams txEraUtxo balancedTxBody scriptCostOutput <- firstExceptT ShelleyTxCmdPlutusScriptCostErr $ hoistEither $ renderScriptCosts @@ -753,7 +753,7 @@ runTxBuild era (AnyConsensusModeParams cModeParams) networkId mScriptValidity balancedTxBody@(BalancedTxBody _ _ _ fee) <- firstExceptT ShelleyTxCmdBalanceTxBody . hoistEither - $ makeTransactionBodyAutoBalance eInMode systemStart eraHistory + $ makeTransactionBodyAutoBalance eInMode systemStart (toLedgerEpochInfo eraHistory) pparams stakePools txEraUtxo txBodyContent cAddr mOverrideWits