Skip to content

Commit

Permalink
Merge pull request #275 from input-output-hk/newhoggy/replace-TxTotal…
Browse files Browse the repository at this point in the history
…AndReturnCollateralSupportedInEra

Replace `TxTotalAndReturnCollateralSupportedInEra`
  • Loading branch information
newhoggy authored Sep 28, 2023
2 parents e355232 + dc30381 commit 70e8f37
Show file tree
Hide file tree
Showing 5 changed files with 70 additions and 106 deletions.
16 changes: 7 additions & 9 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
1 change: 1 addition & 0 deletions cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
75 changes: 36 additions & 39 deletions cardano-api/internal/Cardano/Api/Fees.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
82 changes: 26 additions & 56 deletions cardano-api/internal/Cardano/Api/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -120,7 +120,6 @@ module Cardano.Api.TxBody (
ValidityLowerBoundSupportedInEra(..),
AuxScriptsSupportedInEra(..),
TxExtraKeyWitnessesSupportedInEra(..),
TxTotalAndReturnCollateralSupportedInEra(..),

-- ** Feature availability functions
collateralSupportedInEra,
Expand All @@ -131,7 +130,6 @@ module Cardano.Api.TxBody (
extraKeyWitnessesSupportedInEra,
txScriptValiditySupportedInShelleyBasedEra,
txScriptValiditySupportedInCardanoEra,
totalAndReturnCollateralSupportedInEra,

-- * Inspecting 'ScriptWitness'es
AnyScriptWitness(..),
Expand Down Expand Up @@ -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)
--
Expand Down Expand Up @@ -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
Expand Down
2 changes: 0 additions & 2 deletions cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -393,7 +393,6 @@ module Cardano.Api (
ValidityLowerBoundSupportedInEra(..),
AuxScriptsSupportedInEra(..),
TxExtraKeyWitnessesSupportedInEra(..),
TxTotalAndReturnCollateralSupportedInEra(..),

-- ** Feature availability functions
collateralSupportedInEra,
Expand All @@ -402,7 +401,6 @@ module Cardano.Api (
validityLowerBoundSupportedInEra,
auxScriptsSupportedInEra,
extraKeyWitnessesSupportedInEra,
totalAndReturnCollateralSupportedInEra,

-- ** Era-dependent protocol features
ProtocolUTxOCostPerByteFeature(..),
Expand Down

0 comments on commit 70e8f37

Please sign in to comment.