diff --git a/cardano-api/CHANGELOG.md b/cardano-api/CHANGELOG.md index dc88f8de11..629b72312c 100644 --- a/cardano-api/CHANGELOG.md +++ b/cardano-api/CHANGELOG.md @@ -350,7 +350,7 @@ (feature, compatible) [PR 410](https://github.com/IntersectMBO/cardano-api/pull/410) -- Implement Era GADT and UseEra class as an alternative to the existing era handling code +- Implement Era GADT and IsEra class as an alternative to the existing era handling code (feature, compatible) [PR 402](https://github.com/IntersectMBO/cardano-api/pull/402) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 1c19c39f7f..46e4c02646 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -83,6 +83,8 @@ library internal Cardano.Api.Eras.Case Cardano.Api.Eras.Core Cardano.Api.Error + Cardano.Api.Experimental.Eras + Cardano.Api.Experimental.Tx Cardano.Api.Feature Cardano.Api.Fees Cardano.Api.Genesis @@ -123,7 +125,6 @@ library internal Cardano.Api.Orphans Cardano.Api.Pretty Cardano.Api.Protocol - Cardano.Api.Protocol.Version Cardano.Api.ProtocolParameters Cardano.Api.Query Cardano.Api.Query.Expr diff --git a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs index 081f66eb0b..d33f041032 100644 --- a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs +++ b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs @@ -17,6 +17,10 @@ where import Cardano.Api.Address import Cardano.Api.Certificate import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eon.ShelleyToAlonzoEra +import Cardano.Api.Eras +import Cardano.Api.Experimental.Eras +import Cardano.Api.Experimental.Tx import Cardano.Api.Fees import Cardano.Api.ProtocolParameters import Cardano.Api.Query @@ -29,6 +33,7 @@ import qualified Cardano.Ledger.Coin as L import qualified Cardano.Ledger.Credential as L import qualified Cardano.Ledger.Keys as L +import Data.Bifunctor import qualified Data.List as List import qualified Data.Map.Strict as Map import Data.Set (Set) @@ -72,7 +77,9 @@ constructBalancedTx stakeDelegDeposits drepDelegDeposits shelleyWitSigningKeys = do - BalancedTxBody _ txbody _txBalanceOutput _fee <- + availableEra <- first TxBodyErrorDeprecatedEra $ sbeToEra sbe + + BalancedTxBody _ unsignedTx _txBalanceOutput _fee <- makeTransactionBodyAutoBalance sbe systemStart @@ -86,8 +93,13 @@ constructBalancedTx changeAddr mOverrideWits - let keyWits = map (makeShelleyKeyWitness sbe txbody) shelleyWitSigningKeys - return $ makeSignedTransaction keyWits txbody + let alternateKeyWits = map (makeKeyWitness availableEra unsignedTx) shelleyWitSigningKeys + signedTx = signTx availableEra [] alternateKeyWits unsignedTx + + caseShelleyToAlonzoOrBabbageEraOnwards + (Left . TxBodyErrorDeprecatedEra . DeprecatedEra . shelleyToAlonzoEraToShelleyBasedEra) + (\w -> return $ ShelleyTx sbe $ obtainShimConstraints w signedTx) + sbe data TxInsExistError = TxInsDoNotExist [TxIn] diff --git a/cardano-api/internal/Cardano/Api/Experimental/Eras.hs b/cardano-api/internal/Cardano/Api/Experimental/Eras.hs new file mode 100644 index 0000000000..893e96c99e --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Experimental/Eras.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} + +-- | This module defines the protocol versions corresponding to the eras in the Cardano blockchain. +module Cardano.Api.Experimental.Eras + ( BabbageEra + , ConwayEra + , Era (..) + , LedgerEra + , IsEra + , ApiEraToLedgerEra + , ExperimentalEraToApiEra + , ApiEraToExperimentalEra + , DeprecatedEra (..) + , EraCommonConstraints + , EraShimConstraints + , obtainCommonConstraints + , obtainShimConstraints + , useEra + , eraToSbe + , babbageEraOnwardsToEra + , sbeToEra + ) +where + +import Cardano.Api.Eon.BabbageEraOnwards +import Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..), ShelleyLedgerEra) +import Cardano.Api.Eras.Core (BabbageEra, ConwayEra) +import qualified Cardano.Api.Eras.Core as Api +import qualified Cardano.Api.ReexposeLedger as L +import Cardano.Api.Via.ShowOf + +import qualified Cardano.Ledger.Api as L +import qualified Cardano.Ledger.Babbage as Ledger +import qualified Cardano.Ledger.Conway as Ledger +import qualified Cardano.Ledger.Core as Ledger +import Cardano.Ledger.Hashes +import qualified Cardano.Ledger.SafeHash as L +import qualified Cardano.Ledger.UTxO as L + +import Control.Monad.Error.Class +import Data.Kind +import Prettyprinter + +-- | Users typically interact with the latest features on the mainnet or experiment with features +-- from the upcoming era. Hence, the protocol versions are limited to the current mainnet era +-- and the next era (upcoming era). + +-- Allows us to gradually change the api without breaking things. +-- This will eventually be removed. +type family ExperimentalEraToApiEra era = (r :: Type) | r -> era where + ExperimentalEraToApiEra BabbageEra = Api.BabbageEra + ExperimentalEraToApiEra ConwayEra = Api.ConwayEra + +type family ApiEraToExperimentalEra era = (r :: Type) | r -> era where + ApiEraToExperimentalEra Api.BabbageEra = BabbageEra + ApiEraToExperimentalEra Api.ConwayEra = ConwayEra + +type family LedgerEra era = (r :: Type) | r -> era where + LedgerEra BabbageEra = Ledger.Babbage + LedgerEra ConwayEra = Ledger.Conway + +type family ApiEraToLedgerEra era = (r :: Type) | r -> era where + ApiEraToLedgerEra Api.BabbageEra = Ledger.Babbage + ApiEraToLedgerEra Api.ConwayEra = Ledger.Conway + +-- | Represents the eras in Cardano's blockchain. +-- This type represents eras currently on mainnet and new eras which are +-- in development. +-- +-- After a hardfork, the era from which we hardfork from gets deprecated and +-- after deprecation period, gets removed. During deprecation period, +-- consumers of cardano-api should update their codebase to the mainnet era. +data Era era where + -- | The era currently active on Cardano's mainnet. + BabbageEra :: Era BabbageEra + -- | The upcoming era in development. + ConwayEra :: Era ConwayEra + +deriving instance Show (Era era) + +-- | How to deprecate an era +-- +-- 1. Add DEPRECATED pragma to the era type tag and the era constructor at the same time: +-- @ +-- {-# DEPRECATED BabbageEra "BabbageEra no longer supported, use ConwayEra" #-} +-- data BabbageEra +-- @ +-- +-- 2. Update haddock for the constructor of the deprecated era, mentioning deprecation. +-- +-- @ +-- data Era era where +-- {-# DEPRECATED BabbageEra "BabbageEra no longer supported, use ConwayEra" #-} +-- BabbageEra :: Era BabbageEra +-- -- | The era currently active on Cardano's mainnet. +-- ConwayEra :: Era ConwayEra +-- @ +-- +-- 3. Add new 'IsEra' instance and update the deprecated era instance to produce a compile-time error: +-- @ +-- instance TypeError ('Text "IsEra BabbageEra: Deprecated. Update to ConwayEra") => IsEra BabbageEra where +-- useEra = error "unreachable" +-- +-- instance IsEra ConwayEra where +-- useEra = ConwayEra +-- @ +eraToSbe + :: Era era + -> ShelleyBasedEra (ExperimentalEraToApiEra era) +eraToSbe BabbageEra = ShelleyBasedEraBabbage +eraToSbe ConwayEra = ShelleyBasedEraConway + +newtype DeprecatedEra era + = DeprecatedEra (ShelleyBasedEra era) + deriving Show + +deriving via (ShowOf (DeprecatedEra era)) instance Pretty (DeprecatedEra era) + +sbeToEra + :: MonadError (DeprecatedEra era) m => ShelleyBasedEra era -> m (Era (ApiEraToExperimentalEra era)) +sbeToEra ShelleyBasedEraConway = return ConwayEra +sbeToEra ShelleyBasedEraBabbage = return BabbageEra +sbeToEra e@ShelleyBasedEraAlonzo = throwError $ DeprecatedEra e +sbeToEra e@ShelleyBasedEraMary = throwError $ DeprecatedEra e +sbeToEra e@ShelleyBasedEraAllegra = throwError $ DeprecatedEra e +sbeToEra e@ShelleyBasedEraShelley = throwError $ DeprecatedEra e + +babbageEraOnwardsToEra :: BabbageEraOnwards era -> Era (ApiEraToExperimentalEra era) +babbageEraOnwardsToEra BabbageEraOnwardsBabbage = BabbageEra +babbageEraOnwardsToEra BabbageEraOnwardsConway = ConwayEra + +------------------------------------------------------------------------- + +-- | Type class interface for the 'Era' type. +class IsEra era where + useEra :: Era era + +instance IsEra BabbageEra where + useEra = BabbageEra + +instance IsEra ConwayEra where + useEra = ConwayEra + +obtainShimConstraints + :: BabbageEraOnwards era + -> (EraShimConstraints era => a) + -> a +obtainShimConstraints BabbageEraOnwardsBabbage x = x +obtainShimConstraints BabbageEraOnwardsConway x = x + +-- We need these constraints in order to propagate the new +-- experimental api without changing the existing api +type EraShimConstraints era = + ( LedgerEra (ApiEraToExperimentalEra era) ~ ShelleyLedgerEra era + , ExperimentalEraToApiEra (ApiEraToExperimentalEra era) ~ era + , L.EraTx (ApiEraToLedgerEra era) + ) + +obtainCommonConstraints + :: Era era + -> (EraCommonConstraints era => a) + -> a +obtainCommonConstraints BabbageEra x = x +obtainCommonConstraints ConwayEra x = x + +type EraCommonConstraints era = + ( L.AlonzoEraTx (LedgerEra era) + , L.BabbageEraTxBody (LedgerEra era) + , L.EraTx (LedgerEra era) + , L.EraUTxO (LedgerEra era) + , Ledger.EraCrypto (LedgerEra era) ~ L.StandardCrypto + , ShelleyLedgerEra (ExperimentalEraToApiEra era) ~ LedgerEra era + , L.HashAnnotated (Ledger.TxBody (LedgerEra era)) EraIndependentTxBody L.StandardCrypto + ) diff --git a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs new file mode 100644 index 0000000000..865b647f55 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Cardano.Api.Experimental.Tx + ( UnsignedTx (..) + , UnsignedTxError (..) + , makeUnsignedTx + , makeKeyWitness + , signTx + , convertTxBodyToUnsignedTx + , hashTxBody + ) +where + +import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eras.Case +import Cardano.Api.Experimental.Eras +import Cardano.Api.Feature +import Cardano.Api.ReexposeLedger (StrictMaybe (..), maybeToStrictMaybe) +import qualified Cardano.Api.ReexposeLedger as L +import Cardano.Api.Tx.Body +import Cardano.Api.Tx.Sign + +import qualified Cardano.Ledger.Alonzo.TxBody as L +import qualified Cardano.Ledger.Api as L +import qualified Cardano.Ledger.Babbage as Ledger +import qualified Cardano.Ledger.Conway as Ledger +import qualified Cardano.Ledger.Conway.TxBody as L +import qualified Cardano.Ledger.Core as Ledger +import Cardano.Ledger.Hashes +import qualified Cardano.Ledger.Keys as L +import qualified Cardano.Ledger.SafeHash as L + +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import Lens.Micro + +-- | A transaction that can contain everything +-- except key witnesses +newtype UnsignedTx era + = UnsignedTx (Ledger.Tx (LedgerEra era)) + +instance IsEra era => Show (UnsignedTx era) where + showsPrec p (UnsignedTx tx) = case useEra @era of + BabbageEra -> showsPrec p (tx :: Ledger.Tx Ledger.Babbage) + ConwayEra -> showsPrec p (tx :: Ledger.Tx Ledger.Conway) + +newtype UnsignedTxError + = UnsignedTxError TxBodyError + +makeUnsignedTx + :: Era era + -> TxBodyContent BuildTx (ExperimentalEraToApiEra era) + -> Either TxBodyError (UnsignedTx era) +makeUnsignedTx era bc = obtainCommonConstraints era $ do + let sbe = eraToSbe era + + -- cardano-api types + let apiTxOuts = txOuts bc + apiScriptWitnesses = collectTxBodyScriptWitnesses sbe bc + apiScriptValidity = txScriptValidity bc + apiMintValue = txMintValue bc + apiProtocolParameters = txProtocolParams bc + apiCollateralTxIns = txInsCollateral bc + apiReferenceInputs = txInsReference bc + apiExtraKeyWitnesses = txExtraKeyWits bc + apiReturnCollateral = txReturnCollateral bc + apiTotalCollateral = txTotalCollateral bc + + -- Ledger types + txins = convTxIns $ txIns bc + collTxIns = convCollateralTxIns apiCollateralTxIns + refTxIns = convReferenceInputs apiReferenceInputs + outs = convTxOuts sbe apiTxOuts + fee = convTransactionFee sbe $ txFee bc + withdrawals = convWithdrawals $ txWithdrawals bc + returnCollateral = convReturnCollateral sbe apiReturnCollateral + totalCollateral = convTotalCollateral apiTotalCollateral + certs = convCertificates sbe $ txCertificates bc + txAuxData = toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc) + scripts = convScripts apiScriptWitnesses + languages = convLanguages apiScriptWitnesses + sData = convScriptData sbe apiTxOuts apiScriptWitnesses + + let setMint = convMintValue apiMintValue + setReqSignerHashes = convExtraKeyWitnesses apiExtraKeyWitnesses + ledgerTxBody = + L.mkBasicTxBody + & L.inputsTxBodyL .~ txins + & L.collateralInputsTxBodyL .~ collTxIns + & L.referenceInputsTxBodyL .~ refTxIns + & L.outputsTxBodyL .~ outs + & L.totalCollateralTxBodyL .~ totalCollateral + & L.collateralReturnTxBodyL .~ returnCollateral + & L.feeTxBodyL .~ fee + & L.vldtTxBodyL . L.invalidBeforeL .~ convValidityLowerBound (txValidityLowerBound bc) + & L.vldtTxBodyL . L.invalidHereAfterL .~ convValidityUpperBound sbe (txValidityUpperBound bc) + & L.reqSignerHashesTxBodyL .~ setReqSignerHashes + & L.scriptIntegrityHashTxBodyL .~ getScriptIntegrityHash apiProtocolParameters languages sData + & L.withdrawalsTxBodyL .~ withdrawals + & L.certsTxBodyL .~ certs + & L.mintTxBodyL .~ setMint + & L.auxDataHashTxBodyL .~ maybe SNothing (SJust . Ledger.hashTxAuxData) txAuxData + + scriptWitnesses = + L.mkBasicTxWits + & L.scriptTxWitsL + .~ Map.fromList + [ (L.hashScript sw, sw) + | sw <- scripts + ] + eraSpecificTxBody <- eraSpecificLedgerTxBody era ledgerTxBody bc + + return . UnsignedTx $ + L.mkBasicTx eraSpecificTxBody + & L.witsTxL .~ scriptWitnesses + & L.auxDataTxL .~ maybeToStrictMaybe (toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc)) + & L.isValidTxL .~ txScriptValidityToIsValid apiScriptValidity + +eraSpecificLedgerTxBody + :: Era era + -> Ledger.TxBody (LedgerEra era) + -> TxBodyContent BuildTx (ExperimentalEraToApiEra era) + -> Either TxBodyError (Ledger.TxBody (LedgerEra era)) +eraSpecificLedgerTxBody BabbageEra ledgerbody bc = do + let sbe = eraToSbe BabbageEra + + setUpdateProposal <- convTxUpdateProposal sbe (txUpdateProposal bc) + + return $ ledgerbody & L.updateTxBodyL .~ setUpdateProposal +eraSpecificLedgerTxBody ConwayEra ledgerbody bc = + let propProcedures = txProposalProcedures bc + voteProcedures = txVotingProcedures bc + treasuryDonation = txTreasuryDonation bc + currentTresuryValue = txCurrentTreasuryValue bc + in return $ + ledgerbody + & L.proposalProceduresTxBodyL + .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured propProcedures) + & L.votingProceduresTxBodyL + .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured voteProcedures) + & L.treasuryDonationTxBodyL .~ maybe (L.Coin 0) unFeatured treasuryDonation + & L.currentTreasuryValueTxBodyL + .~ L.maybeToStrictMaybe (maybe (Just $ L.Coin 0) unFeatured currentTresuryValue) + +hashTxBody + :: L.HashAnnotated (Ledger.TxBody era) EraIndependentTxBody L.StandardCrypto + => L.TxBody era -> L.Hash L.StandardCrypto EraIndependentTxBody +hashTxBody = L.extractHash @L.StandardCrypto . L.hashAnnotated + +makeKeyWitness + :: Era era + -> UnsignedTx era + -> ShelleyWitnessSigningKey + -> L.WitVKey L.Witness L.StandardCrypto +makeKeyWitness era (UnsignedTx unsignedTx) wsk = + obtainCommonConstraints era $ + let txbody = unsignedTx ^. L.bodyTxL + txhash :: L.Hash L.StandardCrypto EraIndependentTxBody + txhash = obtainCommonConstraints era $ hashTxBody txbody + sk = toShelleySigningKey wsk + vk = getShelleyKeyWitnessVerificationKey sk + signature = makeShelleySignature txhash sk + in L.WitVKey vk signature + +signTx + :: Era era + -> [L.BootstrapWitness L.StandardCrypto] + -> [L.WitVKey L.Witness L.StandardCrypto] + -> UnsignedTx era + -> Ledger.Tx (LedgerEra era) +signTx era bootstrapWits shelleyKeyWits (UnsignedTx unsigned) = + obtainCommonConstraints era $ + let currentScriptWitnesses = unsigned ^. L.witsTxL + keyWits = + obtainCommonConstraints era $ + L.mkBasicTxWits + & L.addrTxWitsL + .~ Set.fromList shelleyKeyWits + & L.bootAddrTxWitsL + .~ Set.fromList bootstrapWits + signedTx = unsigned & L.witsTxL .~ (keyWits <> currentScriptWitnesses) + in signedTx + +-- Compatibility related. Will be removed once the old api has been deprecated and deleted. + +convertTxBodyToUnsignedTx + :: ShelleyBasedEra era -> TxBody era -> UnsignedTx (ApiEraToExperimentalEra era) +convertTxBodyToUnsignedTx sbe txbody = + caseShelleyToAlonzoOrBabbageEraOnwards + (const $ error "convertTxBodyToUnsignedTx: Error") + ( \w -> + let ShelleyTx _ unsignedLedgerTx = makeSignedTransaction [] txbody + in UnsignedTx $ obtainShimConstraints w unsignedLedgerTx + ) + sbe diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 477ab46115..ba1a9dbdb3 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -8,6 +8,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} -- | Fee calculation module Cardano.Api.Fees @@ -18,6 +19,7 @@ module Cardano.Api.Fees -- * Script execution units , evaluateTransactionExecutionUnits + , evaluateTransactionExecutionUnitsShelley , ScriptExecutionError (..) , TransactionValidityError (..) @@ -52,9 +54,13 @@ import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eon.ShelleyToAlonzoEra import Cardano.Api.Eras.Case import Cardano.Api.Eras.Core import Cardano.Api.Error +import Cardano.Api.Experimental.Eras (obtainShimConstraints, sbeToEra) +import qualified Cardano.Api.Experimental.Eras as Exp +import Cardano.Api.Experimental.Tx import Cardano.Api.Feature import qualified Cardano.Api.Ledger.Lens as A import Cardano.Api.Pretty @@ -374,7 +380,7 @@ estimateBalancedTxBody return ( BalancedTxBody finalTxBodyContent - txbody3 + (convertTxBodyToUnsignedTx sbe txbody3) (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) fee ) @@ -799,24 +805,26 @@ evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits u TxOutValueShelleyBased sbe $ L.evalBalanceTxBody pp - lookupDelegDeposit - lookupDRepDeposit - isRegPool + (lookupDelegDeposit stakeDelegDeposits) + (lookupDRepDeposit drepDelegDeposits) + (isRegPool poolids) (toLedgerUTxO sbe utxo) txbody - where - isRegPool :: Ledger.KeyHash Ledger.StakePool Ledger.StandardCrypto -> Bool - isRegPool kh = StakePoolKeyHash kh `Set.member` poolids - lookupDelegDeposit - :: Ledger.Credential 'Ledger.Staking L.StandardCrypto -> Maybe L.Coin - lookupDelegDeposit stakeCred = - Map.lookup (fromShelleyStakeCredential stakeCred) stakeDelegDeposits +isRegPool :: Set PoolId -> Ledger.KeyHash Ledger.StakePool Ledger.StandardCrypto -> Bool +isRegPool poolids kh = StakePoolKeyHash kh `Set.member` poolids + +lookupDelegDeposit + :: Map StakeCredential L.Coin -> Ledger.Credential 'Ledger.Staking L.StandardCrypto -> Maybe L.Coin +lookupDelegDeposit stakeDelegDeposits stakeCred = + Map.lookup (fromShelleyStakeCredential stakeCred) stakeDelegDeposits - lookupDRepDeposit - :: Ledger.Credential 'Ledger.DRepRole L.StandardCrypto -> Maybe L.Coin - lookupDRepDeposit drepCred = - Map.lookup drepCred drepDelegDeposits +lookupDRepDeposit + :: Map (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto) L.Coin + -> Ledger.Credential 'Ledger.DRepRole L.StandardCrypto + -> Maybe L.Coin +lookupDRepDeposit drepDelegDeposits drepCred = + Map.lookup drepCred drepDelegDeposits -- ---------------------------------------------------------------------------- -- Automated transaction building @@ -863,6 +871,7 @@ data TxBodyErrorAutoBalance era | TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap ScriptWitnessIndex (Map ScriptWitnessIndex ExecutionUnits) + | TxBodyErrorDeprecatedEra (Exp.DeprecatedEra era) deriving Show instance Error (TxBodyErrorAutoBalance era) where @@ -916,6 +925,8 @@ instance Error (TxBodyErrorAutoBalance era) where [ "ScriptWitnessIndex (redeemer pointer): " <> pshow sIndex <> " is missing from the execution " , "units (redeemer pointer) map: " <> pshow eUnitsMap ] + TxBodyErrorDeprecatedEra deprecatedEra -> + "The era " <> pretty deprecatedEra <> " is deprecated and no longer supported." handleExUnitsErrors :: ScriptValidity @@ -934,15 +945,18 @@ handleExUnitsErrors ScriptInvalid failuresMap exUnitsMap | null failuresMap = Left TxBodyScriptBadScriptValidity | otherwise = Right $ Map.map (\_ -> ExecutionUnits 0 0) failuresMap <> exUnitsMap -data BalancedTxBody era - = BalancedTxBody - (TxBodyContent BuildTx era) - (TxBody era) - (TxOut CtxTx era) - -- ^ Transaction balance (change output) - L.Coin - -- ^ Estimated transaction fee - deriving Show +data BalancedTxBody era where + BalancedTxBody + :: (TxBodyContent BuildTx era) + -> (UnsignedTx (Exp.ApiEraToExperimentalEra era)) + -> (TxOut CtxTx era) + -- ^ Transaction balance (change output) + -> L.Coin + -- ^ Estimated transaction fee + -> BalancedTxBody era + +deriving instance + (Exp.IsEra (Exp.ApiEraToExperimentalEra era), IsShelleyBasedEra era) => Show (BalancedTxBody era) newtype RequiredShelleyKeyWitnesses = RequiredShelleyKeyWitnesses {unRequiredShelleyKeyWitnesses :: Int} @@ -1037,167 +1051,186 @@ makeTransactionBodyAutoBalance txbodycontent changeaddr mnkeys = - shelleyBasedEraConstraints sbe $ do - -- Our strategy is to: - -- 1. evaluate all the scripts to get the exec units, update with ex units - -- 2. figure out the overall min fees - -- 3. update tx with fees - -- 4. balance the transaction and update tx change output - txbody0 <- - first TxBodyError $ - createAndValidateTransactionBody - sbe - txbodycontent - { txOuts = - txOuts txbodycontent - ++ [TxOut changeaddr (lovelaceToTxOutValue sbe 0) TxOutDatumNone ReferenceScriptNone] - -- TODO: think about the size of the change output - -- 1,2,4 or 8 bytes? - } - - exUnitsMapWithLogs <- - first TxBodyErrorValidityInterval $ - evaluateTransactionExecutionUnits - era - systemstart - history - lpp - utxo - txbody0 - let exUnitsMap = Map.map (fmap snd) exUnitsMapWithLogs - - exUnitsMap' <- - case Map.mapEither id exUnitsMap of - (failures, exUnitsMap') -> - handleExUnitsErrors - (txScriptValidityToScriptValidity (txScriptValidity txbodycontent)) - failures - exUnitsMap' - - txbodycontent1 <- substituteExecutionUnits exUnitsMap' txbodycontent - - -- Make a txbody that we will use for calculating the fees. For the purpose - -- of fees we just need to make a txbody of the right size in bytes. We do - -- not need the right values for the fee or change output. We use - -- "big enough" values for the change output and set so that the CBOR - -- encoding size of the tx will be big enough to cover the size of the final - -- output and fee. Yes this means this current code will only work for - -- final fee of less than around 4000 ada (2^32-1 lovelace) and change output - -- of less than around 18 trillion ada (2^64-1 lovelace). - -- However, since at this point we know how much non-Ada change to give - -- we can use the true values for that. - let maxLovelaceChange = L.Coin (2 ^ (64 :: Integer)) - 1 - let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1) - - let totalValueAtSpendableUTxO = fromLedgerValue sbe $ calculateIncomingUTxOValue $ Map.elems $ unUTxO utxo - let change = - forShelleyBasedEraInEon - sbe - mempty - (\w -> toLedgerValue w $ calculateChangeValue sbe totalValueAtSpendableUTxO txbodycontent1) - let changeWithMaxLovelace = change & A.adaAssetL sbe .~ maxLovelaceChange - let changeTxOut = - forShelleyBasedEraInEon - sbe - (lovelaceToTxOutValue sbe maxLovelaceChange) - (\w -> maryEraOnwardsConstraints w $ TxOutValueShelleyBased sbe changeWithMaxLovelace) - - let (dummyCollRet, dummyTotColl) = maybeDummyTotalCollAndCollReturnOutput sbe txbodycontent changeaddr - txbody1 <- - first TxBodyError $ -- TODO: impossible to fail now - createAndValidateTransactionBody - sbe - txbodycontent1 - { txFee = TxFeeExplicit sbe maxLovelaceFee - , txOuts = - TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone - : txOuts txbodycontent - , txReturnCollateral = dummyCollRet - , txTotalCollateral = dummyTotColl - } - -- NB: This has the potential to over estimate the fees because estimateTransactionKeyWitnessCount - -- makes the conservative assumption that all inputs are from distinct - -- addresses. - let nkeys = - fromMaybe - (estimateTransactionKeyWitnessCount txbodycontent1) - mnkeys - fee = calculateMinTxFee sbe pp utxo txbody1 nkeys - (retColl, reqCol) = - caseShelleyToAlonzoOrBabbageEraOnwards - (const (TxReturnCollateralNone, TxTotalCollateralNone)) - ( \w -> - let collIns = case txInsCollateral txbodycontent of - TxInsCollateral _ collIns' -> collIns' - TxInsCollateralNone -> mempty - collateralOuts = catMaybes [Map.lookup txin (unUTxO utxo) | txin <- collIns] - totalPotentialCollateral = mconcat $ map (\(TxOut _ txOutVal _ _) -> txOutValueToLovelace txOutVal) collateralOuts - in calcReturnAndTotalCollateral - w - fee + caseShelleyToAlonzoOrBabbageEraOnwards + (Left . TxBodyErrorDeprecatedEra . Exp.DeprecatedEra . shelleyToAlonzoEraToShelleyBasedEra) + ( \bEraOnwards -> + shelleyBasedEraConstraints sbe $ do + availableEra <- first TxBodyErrorDeprecatedEra $ sbeToEra sbe + + -- Our strategy is to: + -- 1. evaluate all the scripts to get the exec units, update with ex units + -- 2. figure out the overall min fees + -- 3. update tx with fees + -- 4. balance the transaction and update tx change output + UnsignedTx unsignedTx0 <- + first TxBodyError + $ makeUnsignedTx + availableEra + $ obtainShimConstraints bEraOnwards + $ txbodycontent + { txOuts = + txOuts txbodycontent + ++ [TxOut changeaddr (lovelaceToTxOutValue sbe 0) TxOutDatumNone ReferenceScriptNone] + -- TODO: think about the size of the change output + -- 1,2,4 or 8 bytes? + } + exUnitsMapWithLogs <- + first TxBodyErrorValidityInterval + $ evaluateTransactionExecutionUnitsShelley + sbe + systemstart + history + lpp + utxo + $ obtainShimConstraints bEraOnwards unsignedTx0 + + let exUnitsMap = Map.map (fmap snd) exUnitsMapWithLogs + + exUnitsMap' <- + case Map.mapEither id exUnitsMap of + (failures, exUnitsMap') -> + handleExUnitsErrors + (txScriptValidityToScriptValidity (txScriptValidity txbodycontent)) + failures + exUnitsMap' + + txbodycontent1 <- substituteExecutionUnits exUnitsMap' txbodycontent + + -- Make a txbody that we will use for calculating the fees. For the purpose + -- of fees we just need to make a txbody of the right size in bytes. We do + -- not need the right values for the fee or change output. We use + -- "big enough" values for the change output and set so that the CBOR + -- encoding size of the tx will be big enough to cover the size of the final + -- output and fee. Yes this means this current code will only work for + -- final fee of less than around 4000 ada (2^32-1 lovelace) and change output + -- of less than around 18 trillion ada (2^64-1 lovelace). + -- However, since at this point we know how much non-Ada change to give + -- we can use the true values for that. + let maxLovelaceChange = L.Coin (2 ^ (64 :: Integer)) - 1 + let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1) + + let totalValueAtSpendableUTxO = fromLedgerValue sbe $ calculateIncomingUTxOValue $ Map.elems $ unUTxO utxo + let change = + forShelleyBasedEraInEon + sbe + mempty + (\w -> toLedgerValue w $ calculateChangeValue sbe totalValueAtSpendableUTxO txbodycontent1) + let changeWithMaxLovelace = change & A.adaAssetL sbe .~ maxLovelaceChange + let changeTxOut = + forShelleyBasedEraInEon + sbe + (lovelaceToTxOutValue sbe maxLovelaceChange) + (\w -> maryEraOnwardsConstraints w $ TxOutValueShelleyBased sbe changeWithMaxLovelace) + + let (dummyCollRet, dummyTotColl) = maybeDummyTotalCollAndCollReturnOutput sbe txbodycontent changeaddr + UnsignedTx txbody1 <- + first TxBodyError + $ makeUnsignedTx -- TODO: impossible to fail now + availableEra + $ obtainShimConstraints bEraOnwards + $ txbodycontent1 + { txFee = TxFeeExplicit sbe maxLovelaceFee + , txOuts = + TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone + : txOuts txbodycontent + , txReturnCollateral = dummyCollRet + , txTotalCollateral = dummyTotColl + } + -- NB: This has the potential to over estimate the fees because estimateTransactionKeyWitnessCount + -- makes the conservative assumption that all inputs are from distinct + -- addresses. + let nkeys = + fromMaybe + (estimateTransactionKeyWitnessCount txbodycontent1) + mnkeys + fee = + obtainShimConstraints bEraOnwards $ + L.calcMinFeeTx (toLedgerUTxO sbe utxo) pp txbody1 (fromIntegral nkeys) + (retColl, reqCol) = + caseShelleyToAlonzoOrBabbageEraOnwards + (const (TxReturnCollateralNone, TxTotalCollateralNone)) + ( \w -> + let collIns = case txInsCollateral txbodycontent of + TxInsCollateral _ collIns' -> collIns' + TxInsCollateralNone -> mempty + collateralOuts = catMaybes [Map.lookup txin (unUTxO utxo) | txin <- collIns] + totalPotentialCollateral = mconcat $ map (\(TxOut _ txOutVal _ _) -> txOutValueToLovelace txOutVal) collateralOuts + in calcReturnAndTotalCollateral + w + fee + pp + (txInsCollateral txbodycontent) + (txReturnCollateral txbodycontent) + (txTotalCollateral txbodycontent) + changeaddr + totalPotentialCollateral + ) + sbe + + -- Make a txbody for calculating the balance. For this the size of the tx + -- does not matter, instead it's just the values of the fee and outputs. + -- Here we do not want to start with any change output, since that's what + -- we need to calculate. + UnsignedTx txbody2 <- + first TxBodyError + $ makeUnsignedTx -- TODO: impossible to fail now + availableEra + $ obtainShimConstraints bEraOnwards + $ txbodycontent1 + { txFee = TxFeeExplicit sbe fee + , txReturnCollateral = retColl + , txTotalCollateral = reqCol + } + let balance = + TxOutValueShelleyBased sbe $ + obtainShimConstraints bEraOnwards $ + L.evalBalanceTxBody pp - (txInsCollateral txbodycontent) - (txReturnCollateral txbodycontent) - (txTotalCollateral txbodycontent) - changeaddr - totalPotentialCollateral + (lookupDelegDeposit stakeDelegDeposits) + (lookupDRepDeposit drepDelegDeposits) + (isRegPool poolids) + (toLedgerUTxO sbe utxo) + (txbody2 ^. L.bodyTxL) + + forM_ (txOuts txbodycontent1) $ \txout -> checkMinUTxOValue sbe txout pp + + -- check if the balance is positive or negative + -- in one case we can produce change, in the other the inputs are insufficient + balanceCheck sbe pp changeaddr balance + + -- TODO: we could add the extra fee for the CBOR encoding of the change, + -- now that we know the magnitude of the change: i.e. 1-8 bytes extra. + + -- The txbody with the final fee and change output. This should work + -- provided that the fee and change are less than 2^32-1, and so will + -- fit within the encoding size we picked above when calculating the fee. + -- Yes this could be an over-estimate by a few bytes if the fee or change + -- would fit within 2^16-1. That's a possible optimisation. + let finalTxBodyContent = + txbodycontent1 + { txFee = TxFeeExplicit sbe fee + , txOuts = + accountForNoChange + (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) + (txOuts txbodycontent) + , txReturnCollateral = retColl + , txTotalCollateral = reqCol + } + txbody3 <- + first TxBodyError $ -- TODO: impossible to fail now. We need to implement a function + -- that simply creates a transaction body because we have already + -- validated the transaction body earlier within makeTransactionBodyAutoBalance + makeUnsignedTx availableEra $ + obtainShimConstraints bEraOnwards finalTxBodyContent + return + ( BalancedTxBody + finalTxBodyContent + txbody3 + (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) + fee ) - sbe - - -- Make a txbody for calculating the balance. For this the size of the tx - -- does not matter, instead it's just the values of the fee and outputs. - -- Here we do not want to start with any change output, since that's what - -- we need to calculate. - txbody2 <- - first TxBodyError $ -- TODO: impossible to fail now - createAndValidateTransactionBody - sbe - txbodycontent1 - { txFee = TxFeeExplicit sbe fee - , txReturnCollateral = retColl - , txTotalCollateral = reqCol - } - let balance = evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits utxo txbody2 - - forM_ (txOuts txbodycontent1) $ \txout -> checkMinUTxOValue sbe txout pp - - -- check if the balance is positive or negative - -- in one case we can produce change, in the other the inputs are insufficient - balanceCheck sbe pp changeaddr balance - - -- TODO: we could add the extra fee for the CBOR encoding of the change, - -- now that we know the magnitude of the change: i.e. 1-8 bytes extra. - - -- The txbody with the final fee and change output. This should work - -- provided that the fee and change are less than 2^32-1, and so will - -- fit within the encoding size we picked above when calculating the fee. - -- Yes this could be an over-estimate by a few bytes if the fee or change - -- would fit within 2^16-1. That's a possible optimisation. - let finalTxBodyContent = - txbodycontent1 - { txFee = TxFeeExplicit sbe fee - , txOuts = - accountForNoChange - (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) - (txOuts txbodycontent) - , txReturnCollateral = retColl - , txTotalCollateral = reqCol - } - txbody3 <- - first TxBodyError $ -- TODO: impossible to fail now. We need to implement a function - -- that simply creates a transaction body because we have already - -- validated the transaction body earlier within makeTransactionBodyAutoBalance - createAndValidateTransactionBody sbe finalTxBodyContent - return - ( BalancedTxBody - finalTxBodyContent - txbody3 - (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) - fee - ) - where - era :: CardanoEra era - era = toCardanoEra sbe + ) + sbe -- | In the event of spending the exact amount of lovelace in -- the specified input(s), this function excludes the change diff --git a/cardano-api/internal/Cardano/Api/Protocol/Version.hs b/cardano-api/internal/Cardano/Api/Protocol/Version.hs deleted file mode 100644 index 21af782d96..0000000000 --- a/cardano-api/internal/Cardano/Api/Protocol/Version.hs +++ /dev/null @@ -1,155 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilyDependencies #-} --- UndecidableInstances needed for 9.2.7 and 8.10.7 -{-# LANGUAGE UndecidableInstances #-} --- Only for UninhabitableType -{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} - --- | This module defines the protocol versions corresponding to the eras in the Cardano blockchain. -module Cardano.Api.Protocol.Version - ( BabbageEra - , ConwayEra - , pattern CurrentEra - , pattern UpcomingEra - , Era (..) - , UseEra - , VersionToSbe - , useEra - , protocolVersionToSbe - ) -where - -import Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..)) -import qualified Cardano.Api.Eras.Core as Api - -import GHC.TypeLits - --- | Users typically interact with the latest features on the mainnet or experiment with features --- from the upcoming era. Hence, the protocol versions are limited to the current mainnet era --- and the next era (upcoming era). -data BabbageEra - -data ConwayEra - --- Allows us to gradually change the api without breaking things. --- This will eventually be removed. -type family VersionToSbe version where - VersionToSbe BabbageEra = Api.BabbageEra - VersionToSbe ConwayEra = Api.ConwayEra - --- | Represents the eras in Cardano's blockchain. --- --- Instead of enumerating every possible era, we use two constructors: --- 'CurrentEra' and 'UpcomingEra'. This design simplifies the handling --- of eras, especially for 'cardano-api' consumers who are primarily concerned --- with the current mainnet era and the next era for an upcoming hardfork. --- --- Usage: --- - 'CurrentEra': Reflects the era currently active on mainnet. --- - 'UpcomingEra': Represents the era planned for the next hardfork. --- --- After a hardfork, 'cardano-api' should be updated promptly to reflect --- the new mainnet era in 'CurrentEra'. -data Era version where - -- | The era currently active on Cardano's mainnet. - CurrentEraInternal :: Era BabbageEra - -- | The era planned for the next hardfork on Cardano's mainnet. - UpcomingEraInternal :: Era ConwayEra - --- | How to deprecate an era --- --- 1. Add DEPRECATED pragma to the era type tag. --- @ --- {-# DEPRECATED BabbageEra "BabbageEra no longer supported, use ConwayEra" #-} --- data BabbageEra --- @ --- --- 2. Add a new era type tag. --- @ --- data Era version where --- -- | The era currently active on Cardano's mainnet. --- CurrentEraInternal :: Era ConwayEra --- -- | The era planned for the next hardfork on Cardano's mainnet. --- UpcomingEraInternal :: Era (UninhabitableType EraCurrentlyNonExistent) --- @ --- --- 3. Update pattern synonyms. --- @ --- pattern CurrentEra :: Era ConwayEra --- pattern CurrentEra = CurrentEraInternal --- --- pattern UpcomingEra :: Era (UninhabitableType EraCurrentlyNonExistent) --- pattern UpcomingEra = UpcomingEraInternal --- @ --- --- 4. Add new 'UseEra' instance and keep the deprecated era's instance. --- @ --- instance UseEra BabbageEra where --- useEra = error "useEra: BabbageEra no longer supported, use ConwayEra" --- --- instance UseEra ConwayEra where --- useEra = CurrentEra --- @ --- --- 5. Update 'protocolVersionToSbe' as follows: --- @ --- protocolVersionToSbe --- :: Era version --- -> Maybe (ShelleyBasedEra (VersionToSbe version)) --- protocolVersionToSbe CurrentEraInternal = Just ShelleyBasedEraBabbage --- protocolVersionToSbe UpcomingEraInternal = Nothing --- @ - --- | 'CurrentEraInternal' and 'UpcomingEraInternal' are for internal use only. --- The above restriction combined with the following pattern synonyms --- prevents a user from pattern matching on 'Era era' and --- avoids the following situation: --- --- @ --- doThing :: Era era -> () --- doThing = \case --- CurrentEraInternal -> enableFeature --- UpcomingEraInternal -> disableFeature --- @ --- --- Consumers of this library must pick one of the two eras while --- this library is responsibile for what happens at the boundary of the eras. -pattern CurrentEra :: Era BabbageEra -pattern CurrentEra = CurrentEraInternal - -pattern UpcomingEra :: Era ConwayEra -pattern UpcomingEra = UpcomingEraInternal - -{-# COMPLETE CurrentEra, UpcomingEra #-} - -protocolVersionToSbe - :: Era version - -> Maybe (ShelleyBasedEra (VersionToSbe version)) -protocolVersionToSbe CurrentEraInternal = Just ShelleyBasedEraBabbage -protocolVersionToSbe UpcomingEraInternal = Nothing - -------------------------------------------------------------------------- - --- | Type class interface for the 'Era' type. -class UseEra version where - useEra :: Era version - -instance UseEra BabbageEra where - useEra = CurrentEra - -instance UseEra ConwayEra where - useEra = UpcomingEra - --- | After a hardfork there is usually no planned upcoming era --- that we are able to experiment with. We force a type era --- in this instance. See docs above. -data EraCurrentlyNonExistent - -type family UninhabitableType a where - UninhabitableType EraCurrentlyNonExistent = - TypeError ('Text "There is currently no planned upcoming era. Use CurrentEra instead.") diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index a872aa8fee..3663882edf 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -134,6 +134,27 @@ module Cardano.Api.Tx.Body , scriptDataToInlineDatum -- * Internal conversion functions & types + , convCertificates + , convCollateralTxIns + , convExtraKeyWitnesses + , convLanguages + , convMintValue + , convReferenceInputs + , convReturnCollateral + , convScripts + , convScriptData + , convTotalCollateral + , convTransactionFee + , convTxIns + , convTxOuts + , convTxUpdateProposal + , convValidityLowerBound + , convValidityUpperBound + , convVotingProcedures + , convWithdrawals + , getScriptIntegrityHash + , mkCommonTxBody + , toAuxiliaryData , toByronTxId , toShelleyTxId , toShelleyTxIn diff --git a/cardano-api/src/Cardano/Api/Experimental.hs b/cardano-api/src/Cardano/Api/Experimental.hs index 9a7d4d3989..3a4716fe58 100644 --- a/cardano-api/src/Cardano/Api/Experimental.hs +++ b/cardano-api/src/Cardano/Api/Experimental.hs @@ -1,17 +1,36 @@ -{-# LANGUAGE PatternSynonyms #-} - +-- | This module provides an experimental library interface that is intended +-- to replace the existing api. It is subject to dramatic changes so use with caution. module Cardano.Api.Experimental - ( -- * New Era interface - BabbageEra + ( -- * Tx related + UnsignedTx (..) + , UnsignedTxError (..) + , makeUnsignedTx + , makeKeyWitness + , signTx + , convertTxBodyToUnsignedTx + , EraCommonConstraints + , EraShimConstraints + , obtainShimConstraints + , obtainCommonConstraints + , hashTxBody + , evaluateTransactionExecutionUnitsShelley + -- Era related + , BabbageEra , ConwayEra - , Era - , pattern CurrentEra - , pattern UpcomingEra - , UseEra - , VersionToSbe + , Era (..) + , LedgerEra + , IsEra + , ApiEraToLedgerEra + , ExperimentalEraToApiEra + , ApiEraToExperimentalEra + , DeprecatedEra (..) , useEra - , protocolVersionToSbe + , eraToSbe + , babbageEraOnwardsToEra + , sbeToEra ) where -import Cardano.Api.Protocol.Version +import Cardano.Api.Experimental.Eras +import Cardano.Api.Experimental.Tx +import Cardano.Api.Fees (evaluateTransactionExecutionUnitsShelley) diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 5d0cefa25a..6ae36572f7 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -269,6 +269,7 @@ module Cardano.Api.Shelley -- ** Various calculations , LeadershipError (..) , currentEpochEligibleLeadershipSlots + , evaluateTransactionExecutionUnitsShelley , nextEpochEligibleLeadershipSlots -- ** Conversions @@ -293,6 +294,7 @@ import Cardano.Api.Block import Cardano.Api.Certificate import Cardano.Api.DRepMetadata import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Fees import Cardano.Api.Genesis import Cardano.Api.Governance.Actions.ProposalProcedure import Cardano.Api.Governance.Actions.VotingProcedure