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.

Sign up for GitHub

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

Replace UpdateProposalSupportedInEra with ShelleyToBabbageEra #258

Merged
merged 2 commits into from
Sep 26, 2023
Merged

Replace UpdateProposalSupportedInEra with ShelleyToBabbageEra #258

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
6218c84
Delete UpdateProposalSupportedInEra. Use ShelleyToBabbageEra instead
newhoggy Sep 22, 2023
ce4af0a
Rename fromLedgerTxUpdateProposal to maybeFromLedgerTxUpdateProposal …
newhoggy Sep 22, 2023
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
15 changes: 7 additions & 8 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -150,6 +150,7 @@ import qualified Data.ByteString.Short as SBS
import Data.Coerce
import Data.Int (Int64)
import Data.Map.Strict (Map)
import Data.Maybe
import Data.Ratio (Ratio, (%))
import Data.String
import Data.Word (Word64)
Expand Down Expand Up @@ -624,14 +625,12 @@ genStakeAddressRequirements =
<*> genStakeCredential)

genTxUpdateProposal :: CardanoEra era -> Gen (TxUpdateProposal era)
genTxUpdateProposal era =
case updateProposalSupportedInEra era of
Nothing -> pure TxUpdateProposalNone
Just supported ->
Gen.choice
[ pure TxUpdateProposalNone
, TxUpdateProposal supported <$> genUpdateProposal era
]
genTxUpdateProposal sbe =
Gen.choice $ catMaybes
[ Just $ pure TxUpdateProposalNone
, forEraInEon sbe Nothing $ \w ->
Just $ TxUpdateProposal w <$> genUpdateProposal (toCardanoEra w)
]

genTxMintValue :: CardanoEra era -> Gen (TxMintValue BuildTx era)
genTxMintValue =
Expand Down
113 changes: 25 additions & 88 deletions cardano-api/internal/Cardano/Api/TxBody.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -123,7 +123,6 @@ module Cardano.Api.TxBody (
TxExtraKeyWitnessesSupportedInEra(..),
AlonzoEraOnwards(..),
WithdrawalsSupportedInEra(..),
UpdateProposalSupportedInEra(..),
TxTotalAndReturnCollateralSupportedInEra(..),

-- ** Feature availability functions
Expand All @@ -135,7 +134,6 @@ module Cardano.Api.TxBody (
auxScriptsSupportedInEra,
extraKeyWitnessesSupportedInEra,
withdrawalsSupportedInEra,
updateProposalSupportedInEra,
txScriptValiditySupportedInShelleyBasedEra,
txScriptValiditySupportedInCardanoEra,
totalAndReturnCollateralSupportedInEra,
Expand Down Expand Up @@ -184,6 +182,7 @@ import Cardano.Api.Eon.ByronToAllegraEra
import Cardano.Api.Eon.ConwayEraOnwards
import Cardano.Api.Eon.MaryEraOnwards
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eon.ShelleyToBabbageEra
import Cardano.Api.EraCast
import Cardano.Api.Eras.Case
import Cardano.Api.Eras.Constraints
Expand Down Expand Up @@ -1114,35 +1113,6 @@ withdrawalsSupportedInEra AlonzoEra = Just WithdrawalsInAlonzoEra
withdrawalsSupportedInEra BabbageEra = Just WithdrawalsInBabbageEra
withdrawalsSupportedInEra ConwayEra = Just WithdrawalsInConwayEra

-- | A representation of whether the era supports 'UpdateProposal's embedded in
-- transactions.
--
-- The Shelley and subsequent eras support such update proposals. They Byron
-- era has a notion of an update proposal, but it is a standalone chain object
-- and not embedded in a transaction.
--
data UpdateProposalSupportedInEra era where

UpdateProposalInShelleyEra :: UpdateProposalSupportedInEra ShelleyEra
UpdateProposalInAllegraEra :: UpdateProposalSupportedInEra AllegraEra
UpdateProposalInMaryEra :: UpdateProposalSupportedInEra MaryEra
UpdateProposalInAlonzoEra :: UpdateProposalSupportedInEra AlonzoEra
UpdateProposalInBabbageEra :: UpdateProposalSupportedInEra BabbageEra
UpdateProposalInConwayEra :: UpdateProposalSupportedInEra ConwayEra

deriving instance Eq (UpdateProposalSupportedInEra era)
deriving instance Show (UpdateProposalSupportedInEra era)

updateProposalSupportedInEra :: CardanoEra era
-> Maybe (UpdateProposalSupportedInEra era)
updateProposalSupportedInEra ByronEra = Nothing
updateProposalSupportedInEra ShelleyEra = Just UpdateProposalInShelleyEra
updateProposalSupportedInEra AllegraEra = Just UpdateProposalInAllegraEra
updateProposalSupportedInEra MaryEra = Just UpdateProposalInMaryEra
updateProposalSupportedInEra AlonzoEra = Just UpdateProposalInAlonzoEra
updateProposalSupportedInEra BabbageEra = Just UpdateProposalInBabbageEra
updateProposalSupportedInEra ConwayEra = Just UpdateProposalInConwayEra

-- ----------------------------------------------------------------------------
-- Building vs viewing transactions
--
Expand Down Expand Up @@ -1542,12 +1512,8 @@ deriving instance Show (TxCertificates build era)
--

data TxUpdateProposal era where

TxUpdateProposalNone :: TxUpdateProposal era

TxUpdateProposal :: UpdateProposalSupportedInEra era
-> UpdateProposal
-> TxUpdateProposal era
TxUpdateProposalNone :: TxUpdateProposal era
TxUpdateProposal :: ShelleyToBabbageEra era -> UpdateProposal -> TxUpdateProposal era

deriving instance Eq (TxUpdateProposal era)
deriving instance Show (TxUpdateProposal era)
Expand Down Expand Up @@ -2530,19 +2496,19 @@ fromLedgerTxBody
-> TxBodyContent ViewTx era
fromLedgerTxBody sbe scriptValidity body scriptdata mAux =
TxBodyContent
{ txIns = fromLedgerTxIns sbe body
, txInsCollateral = fromLedgerTxInsCollateral sbe body
, txInsReference = fromLedgerTxInsReference sbe body
, txOuts = fromLedgerTxOuts sbe body scriptdata
, txTotalCollateral = fromLedgerTxTotalCollateral sbe body
, txReturnCollateral = fromLedgerTxReturnCollateral sbe body
, txFee = fromLedgerTxFee sbe body
, txValidityRange = fromLedgerTxValidityRange sbe body
, txWithdrawals = fromLedgerTxWithdrawals sbe body
, txCertificates = fromLedgerTxCertificates sbe body
, txUpdateProposal = fromLedgerTxUpdateProposal sbe body
, txMintValue = fromLedgerTxMintValue sbe body
, txExtraKeyWits = fromLedgerTxExtraKeyWitnesses sbe body
{ txIns = fromLedgerTxIns sbe body
, txInsCollateral = fromLedgerTxInsCollateral sbe body
, txInsReference = fromLedgerTxInsReference sbe body
, txOuts = fromLedgerTxOuts sbe body scriptdata
, txTotalCollateral = fromLedgerTxTotalCollateral sbe body
, txReturnCollateral = fromLedgerTxReturnCollateral sbe body
, txFee = fromLedgerTxFee sbe body
, txValidityRange = fromLedgerTxValidityRange sbe body
, txWithdrawals = fromLedgerTxWithdrawals sbe body
, txCertificates = fromLedgerTxCertificates sbe body
, txUpdateProposal = maybeFromLedgerTxUpdateProposal sbe body
, txMintValue = fromLedgerTxMintValue sbe body
, txExtraKeyWits = fromLedgerTxExtraKeyWitnesses sbe body
, txProtocolParams = ViewTx
, txMetadata
, txAuxScripts
Expand Down Expand Up @@ -3044,48 +3010,19 @@ fromLedgerTxCertificates sbe body =
then TxCertificatesNone
else TxCertificates sbe (map (fromShelleyCertificate sbe) $ toList certificates) ViewTx

fromLedgerTxUpdateProposal
:: ShelleyBasedEra era
maybeFromLedgerTxUpdateProposal :: ()
=> ShelleyBasedEra era
-> Ledger.TxBody (ShelleyLedgerEra era)
-> TxUpdateProposal era
fromLedgerTxUpdateProposal sbe body =
case sbe of
ShelleyBasedEraShelley ->
case body ^. L.updateTxBodyL of
SNothing -> TxUpdateProposalNone
SJust p ->
TxUpdateProposal UpdateProposalInShelleyEra
(fromLedgerUpdate sbe p)

ShelleyBasedEraAllegra ->
case body ^. L.updateTxBodyL of
SNothing -> TxUpdateProposalNone
SJust p ->
TxUpdateProposal UpdateProposalInAllegraEra
(fromLedgerUpdate sbe p)

ShelleyBasedEraMary ->
case body ^. L.updateTxBodyL of
SNothing -> TxUpdateProposalNone
SJust p ->
TxUpdateProposal UpdateProposalInMaryEra
(fromLedgerUpdate sbe p)

ShelleyBasedEraAlonzo ->
case body ^. L.updateTxBodyL of
SNothing -> TxUpdateProposalNone
SJust p ->
TxUpdateProposal UpdateProposalInAlonzoEra
(fromLedgerUpdate sbe p)

ShelleyBasedEraBabbage ->
maybeFromLedgerTxUpdateProposal sbe body =
caseShelleyToBabbageOrConwayEraOnwards
(\w ->
case body ^. L.updateTxBodyL of
SNothing -> TxUpdateProposalNone
SJust p ->
TxUpdateProposal UpdateProposalInBabbageEra
(fromLedgerUpdate sbe p)

ShelleyBasedEraConway -> TxUpdateProposalNone
Copy link
Collaborator Author

@newhoggy newhoggy Sep 22, 2023 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Conway is not supported, but our types don't reflect that. This PR encodes this fact in the types and simplifies the code.

SJust p -> TxUpdateProposal w (fromLedgerUpdate sbe p)
)
(const TxUpdateProposalNone)
sbe

fromLedgerTxMintValue
:: ShelleyBasedEra era
Expand Down
2 changes: 0 additions & 2 deletions cardano-api/src/Cardano/Api.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -390,7 +390,6 @@ module Cardano.Api (
AuxScriptsSupportedInEra(..),
TxExtraKeyWitnessesSupportedInEra(..),
WithdrawalsSupportedInEra(..),
UpdateProposalSupportedInEra(..),
TxTotalAndReturnCollateralSupportedInEra(..),

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

-- ** Era-dependent protocol features
Expand Down