diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index b8bee0b5dc..8371be1248 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -707,17 +707,15 @@ genTxInsReference = genTxReturnCollateral :: CardanoEra era -> Gen (TxReturnCollateral CtxTx era) genTxReturnCollateral era = - case totalAndReturnCollateralSupportedInEra era of - Nothing -> return TxReturnCollateralNone - Just supp -> - TxReturnCollateral supp <$> genTxOutTxContext era + forEraInEon era + (pure TxReturnCollateralNone) + (\w -> TxReturnCollateral w <$> genTxOutTxContext era) genTxTotalCollateral :: CardanoEra era -> Gen (TxTotalCollateral era) -genTxTotalCollateral era = - case totalAndReturnCollateralSupportedInEra era of - Nothing -> return TxTotalCollateralNone - Just supp -> - TxTotalCollateral supp <$> genPositiveLovelace +genTxTotalCollateral = + inEonForEra + (pure TxTotalCollateralNone) + (\w -> TxTotalCollateral w <$> genPositiveLovelace) genTxFee :: CardanoEra era -> Gen (TxFee era) genTxFee = diff --git a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs index c68061d343..a0da443b29 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs @@ -71,6 +71,7 @@ type ConwayEraOnwardsConstraints era = , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224 + , L.BabbageEraTxBody (ShelleyLedgerEra era) , L.ConwayEraGov (ShelleyLedgerEra era) , L.ConwayEraPParams (ShelleyLedgerEra era) , L.ConwayEraTxBody (ShelleyLedgerEra era) diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 8039a1a5ce..d033ee8c14 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -46,6 +46,7 @@ module Cardano.Api.Fees ( import Cardano.Api.Address import Cardano.Api.Certificate +import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra @@ -1000,14 +1001,14 @@ makeTransactionBodyAutoBalance systemstart history lpp@(LedgerProtocolParameters mnkeys fee = evaluateTransactionFee pp txbody1 nkeys 0 --TODO: byron keys (retColl, reqCol) = - case totalAndReturnCollateralSupportedInEra era' of - Just supInEra -> - obtainAlonzoEraPParams supInEra $ - calcReturnAndTotalCollateral supInEra - fee pp (txInsCollateral txbodycontent) - (txReturnCollateral txbodycontent) - (txTotalCollateral txbodycontent) changeaddr utxo - Nothing -> (TxReturnCollateralNone, TxTotalCollateralNone) + caseShelleyToAlonzoOrBabbageEraOnwards + (const (TxReturnCollateralNone, TxTotalCollateralNone)) + (\w -> + calcReturnAndTotalCollateral w + fee pp (txInsCollateral txbodycontent) (txReturnCollateral txbodycontent) + (txTotalCollateral txbodycontent) changeaddr utxo + ) + 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. @@ -1059,32 +1060,35 @@ makeTransactionBodyAutoBalance systemstart history lpp@(LedgerProtocolParameters case txInsCollateral of TxInsCollateralNone -> (TxReturnCollateralNone, TxTotalCollateralNone) TxInsCollateral{} -> - case totalAndReturnCollateralSupportedInEra era' of - Nothing -> (TxReturnCollateralNone, TxTotalCollateralNone) - Just retColSup -> - let dummyRetCol = TxReturnCollateral - retColSup - (TxOut cAddr (lovelaceToTxOutValue $ Lovelace (2^(64 :: Integer)) - 1) - TxOutDatumNone ReferenceScriptNone) - dummyTotCol = TxTotalCollateral retColSup (Lovelace (2^(32 :: Integer) - 1)) - in case (txReturnCollateral, txTotalCollateral) of - (rc@TxReturnCollateral{}, tc@TxTotalCollateral{}) -> (rc, tc) - (rc@TxReturnCollateral{},TxTotalCollateralNone) -> (rc, dummyTotCol) - (TxReturnCollateralNone,tc@TxTotalCollateral{}) -> (dummyRetCol, tc) - (TxReturnCollateralNone, TxTotalCollateralNone) -> (dummyRetCol, dummyTotCol) + forEraInEon era' + (TxReturnCollateralNone, TxTotalCollateralNone) + (\w -> + let dummyRetCol = + TxReturnCollateral w + ( TxOut cAddr + (lovelaceToTxOutValue $ Lovelace (2^(64 :: Integer)) - 1) + TxOutDatumNone ReferenceScriptNone + ) + dummyTotCol = TxTotalCollateral w (Lovelace (2^(32 :: Integer) - 1)) + in case (txReturnCollateral, txTotalCollateral) of + (rc@TxReturnCollateral{}, tc@TxTotalCollateral{}) -> (rc, tc) + (rc@TxReturnCollateral{},TxTotalCollateralNone) -> (rc, dummyTotCol) + (TxReturnCollateralNone,tc@TxTotalCollateral{}) -> (dummyRetCol, tc) + (TxReturnCollateralNone, TxTotalCollateralNone) -> (dummyRetCol, dummyTotCol) + ) -- Calculation taken from validateInsufficientCollateral: https://github.com/input-output-hk/cardano-ledger/blob/389b266d6226dedf3d2aec7af640b3ca4984c5ea/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs#L335 -- TODO: Bug Jared to expose a function from the ledger that returns total and return collateral. - calcReturnAndTotalCollateral - :: Ledger.AlonzoEraPParams (ShelleyLedgerEra era) - => TxTotalAndReturnCollateralSupportedInEra era - -> Lovelace -- ^ Fee - -> Ledger.PParams (ShelleyLedgerEra era) - -> TxInsCollateral era -- ^ From the initial TxBodyContent - -> TxReturnCollateral CtxTx era -- ^ From the initial TxBodyContent - -> TxTotalCollateral era -- ^ From the initial TxBodyContent - -> AddressInEra era -- ^ Change address - -> UTxO era - -> (TxReturnCollateral CtxTx era, TxTotalCollateral era) + calcReturnAndTotalCollateral :: () + => Ledger.AlonzoEraPParams (ShelleyLedgerEra era) + => BabbageEraOnwards era + -> Lovelace -- ^ Fee + -> Ledger.PParams (ShelleyLedgerEra era) + -> TxInsCollateral era -- ^ From the initial TxBodyContent + -> TxReturnCollateral CtxTx era -- ^ From the initial TxBodyContent + -> TxTotalCollateral era -- ^ From the initial TxBodyContent + -> AddressInEra era -- ^ Change address + -> UTxO era + -> (TxReturnCollateral CtxTx era, TxTotalCollateral era) calcReturnAndTotalCollateral _ _ _ TxInsCollateralNone _ _ _ _= (TxReturnCollateralNone, TxTotalCollateralNone) calcReturnAndTotalCollateral _ _ _ _ rc@TxReturnCollateral{} tc@TxTotalCollateral{} _ _ = (rc,tc) calcReturnAndTotalCollateral retColSup fee pp' (TxInsCollateral _ collIns) txReturnCollateral txTotalCollateral cAddr (UTxO utxo') = do @@ -1335,10 +1339,3 @@ calculateMinimumUTxO sbe txout pp = calcMinUTxO pp' txOut = let txOutWithMinCoin = L.setMinCoinTxOut pp' txOut in fromShelleyLovelace (txOutWithMinCoin ^. L.coinTxOutL) - -obtainAlonzoEraPParams - :: TxTotalAndReturnCollateralSupportedInEra era - -> (Ledger.AlonzoEraPParams (ShelleyLedgerEra era) => a ) - -> a -obtainAlonzoEraPParams TxTotalAndReturnCollateralInBabbageEra f = f -obtainAlonzoEraPParams TxTotalAndReturnCollateralInConwayEra f = f diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 5c347077c5..a9586510d2 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -120,7 +120,6 @@ module Cardano.Api.TxBody ( ValidityLowerBoundSupportedInEra(..), AuxScriptsSupportedInEra(..), TxExtraKeyWitnessesSupportedInEra(..), - TxTotalAndReturnCollateralSupportedInEra(..), -- ** Feature availability functions collateralSupportedInEra, @@ -131,7 +130,6 @@ module Cardano.Api.TxBody ( extraKeyWitnessesSupportedInEra, txScriptValiditySupportedInShelleyBasedEra, txScriptValiditySupportedInCardanoEra, - totalAndReturnCollateralSupportedInEra, -- * Inspecting 'ScriptWitness'es AnyScriptWitness(..), @@ -1203,44 +1201,30 @@ prettyRenderTxOut (TxOutInAnyEra _ (TxOut (AddressInEra _ addr) txOutVal _ _)) = data TxReturnCollateral ctx era where - TxReturnCollateralNone :: TxReturnCollateral ctx era + TxReturnCollateralNone + :: TxReturnCollateral ctx era - TxReturnCollateral :: TxTotalAndReturnCollateralSupportedInEra era - -> TxOut ctx era - -> TxReturnCollateral ctx era + TxReturnCollateral + :: BabbageEraOnwards era + -> TxOut ctx era + -> TxReturnCollateral ctx era deriving instance Eq (TxReturnCollateral ctx era) deriving instance Show (TxReturnCollateral ctx era) data TxTotalCollateral era where - TxTotalCollateralNone :: TxTotalCollateral era + TxTotalCollateralNone + :: TxTotalCollateral era - TxTotalCollateral :: TxTotalAndReturnCollateralSupportedInEra era - -> Lovelace - -> TxTotalCollateral era + TxTotalCollateral + :: BabbageEraOnwards era + -> Lovelace + -> TxTotalCollateral era deriving instance Eq (TxTotalCollateral era) deriving instance Show (TxTotalCollateral era) -data TxTotalAndReturnCollateralSupportedInEra era where - - TxTotalAndReturnCollateralInBabbageEra :: TxTotalAndReturnCollateralSupportedInEra BabbageEra - TxTotalAndReturnCollateralInConwayEra :: TxTotalAndReturnCollateralSupportedInEra ConwayEra - -deriving instance Eq (TxTotalAndReturnCollateralSupportedInEra era) -deriving instance Show (TxTotalAndReturnCollateralSupportedInEra era) - -totalAndReturnCollateralSupportedInEra - :: CardanoEra era -> Maybe (TxTotalAndReturnCollateralSupportedInEra era) -totalAndReturnCollateralSupportedInEra ByronEra = Nothing -totalAndReturnCollateralSupportedInEra ShelleyEra = Nothing -totalAndReturnCollateralSupportedInEra AllegraEra = Nothing -totalAndReturnCollateralSupportedInEra MaryEra = Nothing -totalAndReturnCollateralSupportedInEra AlonzoEra = Nothing -totalAndReturnCollateralSupportedInEra BabbageEra = Just TxTotalAndReturnCollateralInBabbageEra -totalAndReturnCollateralSupportedInEra ConwayEra = Just TxTotalAndReturnCollateralInConwayEra - -- ---------------------------------------------------------------------------- -- Transaction output datum (era-dependent) -- @@ -2659,42 +2643,28 @@ fromLedgerTxTotalCollateral -> Ledger.TxBody (ShelleyLedgerEra era) -> TxTotalCollateral era fromLedgerTxTotalCollateral sbe txbody = - case totalAndReturnCollateralSupportedInEra $ shelleyBasedToCardanoEra sbe of - Nothing -> TxTotalCollateralNone - Just supp -> - case obtainTotalCollateralHasFieldConstraint supp $ txbody ^. L.totalCollateralTxBodyL of + caseShelleyToAlonzoOrBabbageEraOnwards + (const TxTotalCollateralNone) + (\w -> + case txbody ^. L.totalCollateralTxBodyL of SNothing -> TxTotalCollateralNone - SJust totColl -> TxTotalCollateral supp $ fromShelleyLovelace totColl - where - obtainTotalCollateralHasFieldConstraint - :: TxTotalAndReturnCollateralSupportedInEra era - -> (L.BabbageEraTxBody (ShelleyLedgerEra era) => a) - -> a - obtainTotalCollateralHasFieldConstraint TxTotalAndReturnCollateralInBabbageEra f = f - obtainTotalCollateralHasFieldConstraint TxTotalAndReturnCollateralInConwayEra f = f + SJust totColl -> TxTotalCollateral w $ fromShelleyLovelace totColl + ) + sbe fromLedgerTxReturnCollateral :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxReturnCollateral CtxTx era fromLedgerTxReturnCollateral sbe txbody = - case totalAndReturnCollateralSupportedInEra $ shelleyBasedToCardanoEra sbe of - Nothing -> TxReturnCollateralNone - Just supp -> - case obtainBabbageEraTxOutConstraint supp $ txbody ^. L.collateralReturnTxBodyL of + caseShelleyToAlonzoOrBabbageEraOnwards + (const TxReturnCollateralNone) + (\w -> + case txbody ^. L.collateralReturnTxBodyL of SNothing -> TxReturnCollateralNone - SJust collReturnOut -> - TxReturnCollateral supp $ fromShelleyTxOut sbe collReturnOut - where - obtainBabbageEraTxOutConstraint - :: TxTotalAndReturnCollateralSupportedInEra era - -> ((L.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto - , L.BabbageEraTxBody (ShelleyLedgerEra era) - ) => a) - -> a - obtainBabbageEraTxOutConstraint TxTotalAndReturnCollateralInBabbageEra f = f - obtainBabbageEraTxOutConstraint TxTotalAndReturnCollateralInConwayEra f = f - + SJust collReturnOut -> TxReturnCollateral w $ fromShelleyTxOut sbe collReturnOut + ) + sbe fromLedgerTxFee :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxFee era diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 2f0b98172d..0ba05c86b1 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -393,7 +393,6 @@ module Cardano.Api ( ValidityLowerBoundSupportedInEra(..), AuxScriptsSupportedInEra(..), TxExtraKeyWitnessesSupportedInEra(..), - TxTotalAndReturnCollateralSupportedInEra(..), -- ** Feature availability functions collateralSupportedInEra, @@ -402,7 +401,6 @@ module Cardano.Api ( validityLowerBoundSupportedInEra, auxScriptsSupportedInEra, extraKeyWitnessesSupportedInEra, - totalAndReturnCollateralSupportedInEra, -- ** Era-dependent protocol features ProtocolUTxOCostPerByteFeature(..),