Merge #4858

4858: Modify constructBalancedTx to take LedgerEpochInfo r=Jimbo4350 a=Jimbo4350 Modifying `constructBalancedTx` to take `LedgerEpochInfo` instead of `EraHistory mode` makes it significantly easier to use this function with a service such as BlockFrost. Constructing an `LedgerEpochInfo` value can be done with the helper function [fixedEpochInfo](https://github.com/input-output-hk/cardano-base/blob/631cb6cf1fa01ab346233b610a38b3b4cba6e6ab/slotting/src/Cardano/Slotting/EpochInfo/Impl.hs#L16) which requires the slot length and the epoch length. Both of these values can be retrieved from the ShelleyGenesis whereas constructing an `EraHistory mode` value is difficult without using a local node query (which necessitates running a node locally). Co-authored-by: Jordan Millar <[email protected]>
IntersectMBO · Feb 2, 2023 · 658560d · 658560d
2 parents 0891800 + 180f41c
commit 658560d
Show file tree

Hide file tree

Showing 6 changed files with 28 additions and 18 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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

diff --git 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
@@ -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