Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Modify constructBalancedTx to take LedgerEpochInfo #4858

Merged
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -239,6 +239,7 @@ module Cardano.Api (
totalAndReturnCollateralSupportedInEra,

-- ** Fee calculation
LedgerEpochInfo(..),
transactionFee,
toLedgerEpochInfo,
estimateTransactionFee,
Expand Down
6 changes: 3 additions & 3 deletions cardano-api/src/Cardano/Api/Convenience/Construction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
18 changes: 6 additions & 12 deletions cardano-api/src/Cardano/Api/Fees.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,6 @@ module Cardano.Api.Fees (

-- * Internal helpers
mapTxScriptWitnesses,
toLedgerEpochInfo,
) where

import qualified Data.Array as Array
Expand All @@ -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

Expand Down Expand Up @@ -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' ->
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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'.
Expand Down
16 changes: 15 additions & 1 deletion cardano-api/src/Cardano/Api/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,9 @@ module Cardano.Api.Query (
EraHistory(..),
SystemStart(..),

LedgerEpochInfo(..),
toLedgerEpochInfo,

SlotsInEpoch(..),
SlotsToEpochEnd(..),

Expand All @@ -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)
Expand All @@ -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 (..))
Expand All @@ -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

Expand All @@ -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 (..))

Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ module Cardano.CLI.Shelley.Run.Query
, renderShelleyQueryCmdError
, renderLocalStateQueryError
, runQueryCmd
, toEpochInfo
, determineEra
, mergeDelegsAndRewards
, percentage
Expand Down
4 changes: 2 additions & 2 deletions cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down