Skip to content

Remove BabbageEra from experimental Era type #828

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.

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

Merged
merged 1 commit into from
Apr 25, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
1 change: 0 additions & 1 deletion cardano-api/src/Cardano/Api/Experimental.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,6 @@ module Cardano.Api.Experimental
, LedgerEra
, DeprecatedEra (..)
, eraToSbe
, babbageEraOnwardsToEra
, eraToBabbageEraOnwards
, sbeToEra

Expand Down
39 changes: 4 additions & 35 deletions cardano-api/src/Cardano/Api/Internal/Experimental/Eras.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ module Cardano.Api.Internal.Experimental.Eras
, EraCommonConstraints
, obtainCommonConstraints
, eraToSbe
, babbageEraOnwardsToEra
, eraToBabbageEraOnwards
, sbeToEra
)
Expand All @@ -42,7 +41,6 @@ import Cardano.Api.Internal.ReexposeLedger qualified as L
import Cardano.Api.Internal.Via.ShowOf

import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Babbage qualified as Ledger
import Cardano.Ledger.BaseTypes (Inject (..))
import Cardano.Ledger.Conway qualified as Ledger
import Cardano.Ledger.Core qualified as Ledger
Expand All @@ -64,7 +62,6 @@ import Prettyprinter
-- from the upcoming era. Therefore, protocol versions are limited to the current mainnet era
-- and the next (upcoming) era.
type family LedgerEra era = (r :: Type) | r -> era where
LedgerEra BabbageEra = Ledger.BabbageEra
LedgerEra ConwayEra = Ledger.ConwayEra

-- | An existential wrapper for types of kind @k -> Type@. It can hold any
Expand Down Expand Up @@ -93,8 +90,6 @@ data Some (f :: k -> Type) where
-- codebase to the new mainnet era.
data Era era where
-- | The currently active era on the Cardano mainnet.
BabbageEra :: Era BabbageEra
-- | The upcoming era in development.
ConwayEra :: Era ConwayEra

deriving instance Show (Era era)
Expand All @@ -105,10 +100,7 @@ instance Pretty (Era era) where
pretty = eraToStringLike

instance TestEquality Era where
testEquality BabbageEra BabbageEra = Just Refl
testEquality BabbageEra _ = Nothing
testEquality ConwayEra ConwayEra = Just Refl
testEquality ConwayEra _ = Nothing

instance ToJSON (Era era) where
toJSON = eraToStringLike
Expand All @@ -120,15 +112,13 @@ instance Eq (Some Era) where
Some era1 == Some era2 = isJust $ testEquality era1 era2

instance Bounded (Some Era) where
minBound = Some BabbageEra
minBound = Some ConwayEra
maxBound = Some ConwayEra

instance Enum (Some Era) where
toEnum 0 = Some BabbageEra
toEnum 1 = Some ConwayEra
toEnum 0 = Some ConwayEra
toEnum i = error $ "Enum.toEnum: invalid argument " <> show i <> " - does not correspond to any era"
fromEnum (Some BabbageEra) = 0
fromEnum (Some ConwayEra) = 1
fromEnum (Some ConwayEra) = 0

instance Ord (Some Era) where
compare e1 e2 = compare (fromEnum e1) (fromEnum e2)
Expand All @@ -152,25 +142,21 @@ instance FromJSON (Some Era) where
instance Eon Era where
inEonForEra v f = \case
Api.ConwayEra -> f ConwayEra
Api.BabbageEra -> f BabbageEra
_ -> v

-- | A temporary compatibility instance for easier conversion between the experimental and old APIs.
instance Api.ToCardanoEra Era where
toCardanoEra = \case
BabbageEra -> Api.BabbageEra
ConwayEra -> Api.ConwayEra

eraToStringLike :: IsString a => Era era -> a
{-# INLINE eraToStringLike #-}
eraToStringLike = \case
BabbageEra -> "Babbage"
ConwayEra -> "Conway"

eraFromStringLike :: (IsString a, Eq a) => a -> Either a (Some Era)
{-# INLINE eraFromStringLike #-}
eraFromStringLike = \case
"Babbage" -> pure $ Some BabbageEra
"Conway" -> pure $ Some ConwayEra
wrong -> Left wrong

Expand Down Expand Up @@ -211,29 +197,20 @@ eraToSbe = convert

instance Convert Era Api.CardanoEra where
convert = \case
BabbageEra -> Api.BabbageEra
ConwayEra -> Api.ConwayEra

instance Convert Era ShelleyBasedEra where
convert = \case
BabbageEra -> ShelleyBasedEraBabbage
ConwayEra -> ShelleyBasedEraConway

instance Convert Era AlonzoEraOnwards where
convert = \case
BabbageEra -> AlonzoEraOnwardsBabbage
ConwayEra -> AlonzoEraOnwardsConway

instance Convert Era BabbageEraOnwards where
convert = \case
BabbageEra -> BabbageEraOnwardsBabbage
ConwayEra -> BabbageEraOnwardsConway

instance Convert BabbageEraOnwards Era where
convert = \case
BabbageEraOnwardsBabbage -> BabbageEra
BabbageEraOnwardsConway -> ConwayEra

newtype DeprecatedEra era
= DeprecatedEra (ShelleyBasedEra era)
deriving Show
Expand All @@ -245,16 +222,12 @@ sbeToEra
=> ShelleyBasedEra era
-> m (Era era)
sbeToEra ShelleyBasedEraConway = return ConwayEra
sbeToEra ShelleyBasedEraBabbage = return BabbageEra
sbeToEra e@ShelleyBasedEraBabbage = throwError $ DeprecatedEra e
sbeToEra e@ShelleyBasedEraAlonzo = throwError $ DeprecatedEra e
sbeToEra e@ShelleyBasedEraMary = throwError $ DeprecatedEra e
sbeToEra e@ShelleyBasedEraAllegra = throwError $ DeprecatedEra e
sbeToEra e@ShelleyBasedEraShelley = throwError $ DeprecatedEra e

{-# DEPRECATED babbageEraOnwardsToEra "Use 'convert' instead." #-}
babbageEraOnwardsToEra :: BabbageEraOnwards era -> Era era
babbageEraOnwardsToEra = convert

{-# DEPRECATED eraToBabbageEraOnwards "Use 'convert' instead." #-}
eraToBabbageEraOnwards :: Era era -> BabbageEraOnwards era
eraToBabbageEraOnwards = convert
Expand All @@ -265,17 +238,13 @@ eraToBabbageEraOnwards = convert
class IsEra era where
useEra :: Era era

instance IsEra BabbageEra where
useEra = BabbageEra

instance IsEra ConwayEra where
useEra = ConwayEra

obtainCommonConstraints
:: Era era
-> (EraCommonConstraints era => a)
-> a
obtainCommonConstraints BabbageEra x = x
obtainCommonConstraints ConwayEra x = x

type EraCommonConstraints era =
Expand Down
8 changes: 0 additions & 8 deletions cardano-api/src/Cardano/Api/Internal/Experimental/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -138,7 +138,6 @@ import Cardano.Api.Internal.Tx.Sign
import Cardano.Crypto.Hash qualified as Hash
import Cardano.Ledger.Alonzo.TxBody qualified as L
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Babbage qualified as Ledger
import Cardano.Ledger.Conway qualified as Ledger
import Cardano.Ledger.Conway.TxBody qualified as L
import Cardano.Ledger.Core qualified as Ledger
Expand All @@ -156,7 +155,6 @@ newtype UnsignedTx era

instance IsEra era => Show (UnsignedTx era) where
showsPrec p (UnsignedTx tx) = case useEra @era of
BabbageEra -> showsPrec p (tx :: Ledger.Tx Ledger.BabbageEra)
ConwayEra -> showsPrec p (tx :: Ledger.Tx Ledger.ConwayEra)

newtype UnsignedTxError
Expand Down Expand Up @@ -246,12 +244,6 @@ eraSpecificLedgerTxBody
-> Ledger.TxBody (LedgerEra era)
-> TxBodyContent BuildTx era
-> Either TxBodyError (Ledger.TxBody (LedgerEra era))
eraSpecificLedgerTxBody BabbageEra ledgerbody bc = do
let sbe = convert BabbageEra

setUpdateProposal <- convTxUpdateProposal sbe (txUpdateProposal bc)

return $ ledgerbody & L.updateTxBodyL .~ setUpdateProposal
eraSpecificLedgerTxBody ConwayEra ledgerbody bc =
let propProcedures = txProposalProcedures bc
voteProcedures = txVotingProcedures bc
Expand Down
Loading