From 2520bcc142020ffc317b4bcff9b0cab190e49485 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 31 Jul 2025 11:06:28 -0600 Subject: [PATCH 1/3] Remove no longer required constraint --- libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs index 3c47281e8b9..51114ada16f 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs @@ -75,9 +75,6 @@ class -- protocol version for the era, otherwise we can never upgrade to the next version: CmpNat (ProtVerLow era) MaxVersion ~ 'LT , CmpNat (ProtVerHigh era) MaxVersion ~ 'LT - , -- These two are redundant and can be removed once support for GHC-8.10 is dropped: - ProtVerLow era <= MaxVersion - , ProtVerHigh era <= MaxVersion ) => Era era where From 4e2fed136f42fe2fcc00ecceafd714cf98a2b31c Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 31 Jul 2025 20:30:09 -0600 Subject: [PATCH 2/3] Switch to using era names for constraints instead of protocol versions --- .../impl/src/Cardano/Ledger/Allegra/Era.hs | 7 - .../src/Cardano/Ledger/Allegra/Rules/Utxo.hs | 2 +- .../impl/src/Cardano/Ledger/Alonzo/Era.hs | 9 +- .../Cardano/Ledger/Alonzo/Plutus/TxInfo.hs | 2 +- .../src/Cardano/Ledger/Alonzo/Rules/Ledger.hs | 2 +- .../src/Cardano/Ledger/Alonzo/Rules/Utxo.hs | 4 +- .../impl/src/Cardano/Ledger/Alonzo/TxBody.hs | 4 +- .../src/Test/Cardano/Ledger/Alonzo/Trace.hs | 2 +- .../impl/src/Cardano/Ledger/Babbage/Era.hs | 8 - .../Cardano/Ledger/Babbage/Rules/Ledger.hs | 2 +- .../impl/src/Cardano/Ledger/Conway/Era.hs | 8 - .../src/Cardano/Ledger/Dijkstra/Era.hs | 17 +- eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs | 7 - .../impl/src/Cardano/Ledger/Shelley/Era.hs | 8 +- .../src/Cardano/Ledger/Shelley/PParams.hs | 16 +- .../src/Cardano/Ledger/Shelley/Rules/Deleg.hs | 6 +- .../src/Cardano/Ledger/Shelley/Rules/Delpl.hs | 2 +- .../Cardano/Ledger/Shelley/Rules/Ledger.hs | 2 +- .../src/Cardano/Ledger/Shelley/Rules/Newpp.hs | 6 +- .../src/Cardano/Ledger/Shelley/Rules/Ppup.hs | 5 +- .../src/Cardano/Ledger/Shelley/Rules/Upec.hs | 2 +- .../impl/src/Cardano/Ledger/Shelley/TxBody.hs | 2 +- .../impl/src/Cardano/Ledger/Shelley/TxCert.hs | 20 +-- .../Test/Cardano/Ledger/Shelley/Examples.hs | 6 +- .../bench/Cardano/Ledger/Shelley/Bench/Gen.hs | 4 +- .../Ledger/Shelley/BenchmarkFunctions.hs | 4 +- .../Ledger/Shelley/Generator/Trace/Ledger.hs | 4 +- .../Ledger/Shelley/Generator/Trace/TxCert.hs | 2 +- .../Ledger/Shelley/Generator/TxCert.hs | 10 +- .../Ledger/Shelley/Generator/Update.hs | 4 +- .../Cardano/Ledger/Shelley/PropertyTests.hs | 2 +- .../Test/Cardano/Ledger/Shelley/Rewards.hs | 4 +- .../Cardano/Ledger/Shelley/Rules/Chain.hs | 4 +- .../Cardano/Ledger/Shelley/Rules/Deleg.hs | 2 +- .../Ledger/Shelley/Examples/Combinators.hs | 2 +- .../Ledger/Shelley/Examples/EmptyBlock.hs | 20 +-- .../Shelley/Examples/GenesisDelegation.hs | 4 +- .../Cardano/Ledger/Shelley/Examples/Init.hs | 6 +- .../Test/Cardano/Ledger/Shelley/UnitTests.hs | 2 +- libs/cardano-ledger-api/CHANGELOG.md | 1 + .../cardano-ledger-api.cabal | 2 +- .../src/Cardano/Ledger/Api/Era.hs | 7 + .../test/Test/Cardano/Ledger/Api/Tx/Out.hs | 4 +- libs/cardano-ledger-core/CHANGELOG.md | 3 + .../cardano-ledger-core.cabal | 5 + .../Cardano/Ledger/Internal/Definition/Era.hs | 160 +++++++++++++++++- .../src/Cardano/Ledger/Core/Era.hs | 75 ++------ .../src/Cardano/Ledger/Core/PParams.hs | 29 ++-- .../Cardano/Ledger/Constrained/Conway/Cert.hs | 10 +- .../Constrained/Conway/Instances/PParams.hs | 9 +- .../src/Test/Cardano/Ledger/Generic/Proof.hs | 8 +- .../src/Cardano/Protocol/TPraos/API.hs | 8 +- .../Test/Cardano/Protocol/Binary/CddlSpec.hs | 5 +- .../Test/Cardano/Protocol/Binary/Cddl.hs | 10 +- 54 files changed, 312 insertions(+), 247 deletions(-) diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs index daf694a267e..511203e23b5 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs @@ -19,16 +19,9 @@ module Cardano.Ledger.Allegra.Era ( import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Genesis (EraGenesis, NoGenesis) import Cardano.Ledger.Internal.Era (AllegraEra) -import Cardano.Ledger.Shelley (ShelleyEra) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.Rules -instance Era AllegraEra where - type PreviousEra AllegraEra = ShelleyEra - type ProtVerLow AllegraEra = 3 - - eraName = "Allegra" - instance EraGenesis AllegraEra -------------------------------------------------------------------------------- diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs index 1d7ea2fb825..200b86becd4 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs @@ -302,7 +302,7 @@ instance , Environment (EraRule "PPUP" era) ~ PpupEnv era , State (EraRule "PPUP" era) ~ ShelleyGovState era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , Eq (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) , EraRule "UTXO" era ~ AllegraUTXO era diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs index 77dad027be3..ae6f8179be2 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs @@ -17,19 +17,12 @@ module Cardano.Ledger.Alonzo.Era ( ) where import Cardano.Ledger.Internal.Era (AlonzoEra) -import Cardano.Ledger.Mary (MaryEra, MaryValue) +import Cardano.Ledger.Mary (MaryValue) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.Rules -- ===================================================== -instance Era AlonzoEra where - type PreviousEra AlonzoEra = MaryEra - type ProtVerLow AlonzoEra = 5 - type ProtVerHigh AlonzoEra = 6 - - eraName = "Alonzo" - type instance Value AlonzoEra = MaryValue ------------------------------------------------------------------------------- diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs index 7da3008c33a..bd8628304ff 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Plutus/TxInfo.hs @@ -320,7 +320,7 @@ transValue (MaryValue c m) = transCoinToValue c <> transMultiAsset m -- ============================================= -- translate fields like TxCert, Withdrawals, and similar -transTxCert :: (ShelleyEraTxCert era, ProtVerAtMost era 8) => TxCert era -> PV1.DCert +transTxCert :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> PV1.DCert transTxCert txCert = case transTxCertCommon txCert of Just cert -> cert diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs index 4ed6a4dfe88..086d4f62556 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs @@ -165,7 +165,7 @@ instance , Environment (EraRule "DELEGS" era) ~ DelegsEnv era , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , EraCertState era ) => STS (AlonzoLEDGER era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs index 92f8a001e65..b8e679e3b47 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs @@ -474,7 +474,7 @@ utxoTransition :: forall era. ( EraUTxO era , AlonzoEraTx era - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , EraRule "UTXO" era ~ AlonzoUTXO era , InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era , InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era @@ -571,7 +571,7 @@ instance , InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era , InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , EraCertState era , SafeToHash (TxWits era) ) => diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs index 1c1edad6f56..80b60e11916 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs @@ -141,12 +141,12 @@ type ScriptIntegrityHash = SafeHash EraIndependentScriptIntegrity class (MaryEraTxBody era, AlonzoEraTxOut era) => AlonzoEraTxBody era where collateralInputsTxBodyL :: Lens' (TxBody era) (Set TxIn) - reqSignerHashesTxBodyL :: ProtVerAtMost era 11 => Lens' (TxBody era) (Set (KeyHash 'Witness)) + reqSignerHashesTxBodyL :: AtMostEra "Conway" era => Lens' (TxBody era) (Set (KeyHash 'Witness)) reqSignerHashesTxBodyG :: SimpleGetter (TxBody era) (Set (KeyHash Witness)) default reqSignerHashesTxBodyG :: - ProtVerAtMost era 11 => SimpleGetter (TxBody era) (Set (KeyHash Witness)) + AtMostEra "Conway" era => SimpleGetter (TxBody era) (Set (KeyHash Witness)) reqSignerHashesTxBodyG = reqSignerHashesTxBodyL scriptIntegrityHashTxBodyL :: diff --git a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Trace.hs b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Trace.hs index 244fc634cf8..3320bab8d30 100644 --- a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Trace.hs +++ b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Trace.hs @@ -63,7 +63,7 @@ instance , Environment (EraRule "DELEGS" era) ~ DelegsEnv era , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , EraCertState era , Crypto c ) => diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Era.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Era.hs index c8fd4caaacc..086e4a3a1b3 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Era.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Era.hs @@ -14,7 +14,6 @@ module Cardano.Ledger.Babbage.Era ( BabbageLEDGER, ) where -import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Rules (AlonzoBBODY) import Cardano.Ledger.Core import Cardano.Ledger.Genesis (EraGenesis, NoGenesis) @@ -34,13 +33,6 @@ import Cardano.Ledger.Shelley.Rules ( -- ===================================================== -instance Era BabbageEra where - type PreviousEra BabbageEra = AlonzoEra - type ProtVerLow BabbageEra = 7 - type ProtVerHigh BabbageEra = 8 - - eraName = "Babbage" - instance EraGenesis BabbageEra type instance TranslationContext BabbageEra = NoGenesis BabbageEra diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Ledger.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Ledger.hs index d4de0470c11..452baac27e9 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Ledger.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Ledger.hs @@ -117,7 +117,7 @@ instance , Environment (EraRule "DELEGS" era) ~ DelegsEnv era , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , EraCertState era ) => STS (BabbageLEDGER era) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs index dcbd9049dd3..d9b3ff06c64 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs @@ -31,7 +31,6 @@ module Cardano.Ledger.Conway.Era ( hardforkConwayDELEGIncorrectDepositsAndRefunds, ) where -import Cardano.Ledger.Babbage (BabbageEra) import Cardano.Ledger.BaseTypes (ProtVer (pvMajor), natVersion) import Cardano.Ledger.Core import Cardano.Ledger.Internal.Era (ConwayEra) @@ -46,13 +45,6 @@ import Cardano.Ledger.Shelley.Rules ( -- ===================================================== -instance Era ConwayEra where - type PreviousEra ConwayEra = BabbageEra - type ProtVerLow ConwayEra = 9 - type ProtVerHigh ConwayEra = 11 - - eraName = "Conway" - type instance Value ConwayEra = MaryValue ------------------------------------------------------------------------------- diff --git a/eras/dijkstra/src/Cardano/Ledger/Dijkstra/Era.hs b/eras/dijkstra/src/Cardano/Ledger/Dijkstra/Era.hs index 5ad65391602..29a4976b0bc 100644 --- a/eras/dijkstra/src/Cardano/Ledger/Dijkstra/Era.hs +++ b/eras/dijkstra/src/Cardano/Ledger/Dijkstra/Era.hs @@ -11,28 +11,13 @@ module Cardano.Ledger.Dijkstra.Era ( DijkstraCERT, ) where -import Cardano.Ledger.Conway (ConwayEra) -import Cardano.Ledger.Conway.Core ( - Era (..), - EraRule, - EraRuleEvent, - EraRuleFailure, - Value, - VoidEraRule, - ) +import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Rules import Cardano.Ledger.Internal.Era (DijkstraEra) import Cardano.Ledger.Mary (MaryValue) import qualified Cardano.Ledger.Shelley.API as API import Cardano.Ledger.Shelley.Rules -instance Era DijkstraEra where - type PreviousEra DijkstraEra = ConwayEra - type ProtVerLow DijkstraEra = 12 - type ProtVerHigh DijkstraEra = 12 - - eraName = "Dijkstra" - ------------------------------------------------------------------------------- -- Deprecated rules ------------------------------------------------------------------------------- diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs index e866234d185..53c0662dfe5 100644 --- a/eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs +++ b/eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs @@ -12,7 +12,6 @@ module Cardano.Ledger.Mary.Era (MaryEra) where -import Cardano.Ledger.Allegra (AllegraEra) import Cardano.Ledger.Allegra.Rules (AllegraUTXO, AllegraUTXOW) import Cardano.Ledger.Genesis (EraGenesis, NoGenesis) import Cardano.Ledger.Internal.Era (MaryEra) @@ -20,12 +19,6 @@ import Cardano.Ledger.Mary.Value (MaryValue) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.Rules -instance Era MaryEra where - type PreviousEra MaryEra = AllegraEra - type ProtVerLow MaryEra = 4 - - eraName = "Mary" - instance EraGenesis MaryEra -------------------------------------------------------------------------------- diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Era.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Era.hs index 42fc1b91a13..dd725e8739b 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Era.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Era.hs @@ -38,15 +38,9 @@ module Cardano.Ledger.Shelley.Era ( import Cardano.Ledger.BaseTypes (ProtVer (pvMajor), natVersion) import Cardano.Ledger.Coin (Coin) -import Cardano.Ledger.Core (ByronEra, Era (..), EraRule, Value) +import Cardano.Ledger.Core (EraRule, Value) import Cardano.Ledger.Internal.Era (ShelleyEra) -instance Era ShelleyEra where - type PreviousEra ShelleyEra = ByronEra - type ProtVerLow ShelleyEra = 2 - - eraName = "Shelley" - type instance Value ShelleyEra = Coin data ShelleyBBODY era diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs index fc872749df3..303c5f4427b 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs @@ -304,7 +304,7 @@ pvCanFollow (ProtVer curMajor curMinor) (ProtVer newMajor newMinor) = -- | Check whether `PParamsUpdate` contains a valid `ProtVer` update. When a protocol version -- update is not included in `PParamsUpdate` it is considered a legal update. hasLegalProtVerUpdate :: - (ProtVerAtMost era 8, EraPParams era) => PParams era -> PParamsUpdate era -> Bool + (AtMostEra "Babbage" era, EraPParams era) => PParams era -> PParamsUpdate era -> Bool hasLegalProtVerUpdate pp ppu = case ppu ^. ppuProtocolVersionL of SNothing -> True @@ -426,7 +426,7 @@ ppTau = , ppUpdate = Just $ PParamUpdate 11 ppuTauL } -ppD :: (EraPParams era, ProtVerAtMost era 6) => PParam era +ppD :: (EraPParams era, AtMostEra "Alonzo" era) => PParam era ppD = PParam { ppName = "decentralization" @@ -434,7 +434,7 @@ ppD = , ppUpdate = Just $ PParamUpdate 12 ppuDL } -ppExtraEntropy :: (EraPParams era, ProtVerAtMost era 6) => PParam era +ppExtraEntropy :: (EraPParams era, AtMostEra "Alonzo" era) => PParam era ppExtraEntropy = PParam { ppName = "extraPraosEntropy" @@ -442,7 +442,7 @@ ppExtraEntropy = , ppUpdate = Just $ PParamUpdate 13 ppuExtraEntropyL } -ppProtocolVersion :: (EraPParams era, ProtVerAtMost era 8) => PParam era +ppProtocolVersion :: (EraPParams era, AtMostEra "Babbage" era) => PParam era ppProtocolVersion = PParam { ppName = "protocolVersion" @@ -450,7 +450,7 @@ ppProtocolVersion = , ppUpdate = Just $ PParamUpdate 14 ppuProtocolVersionL } -ppMinUTxOValue :: (EraPParams era, ProtVerAtMost era 4) => PParam era +ppMinUTxOValue :: (EraPParams era, AtMostEra "Mary" era) => PParam era ppMinUTxOValue = PParam { ppName = "minUTxOValue" @@ -468,9 +468,9 @@ ppMinPoolCost = shelleyPParams :: ( EraPParams era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 - , ProtVerAtMost era 8 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era + , AtMostEra "Babbage" era ) => [PParam era] shelleyPParams = diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs index e3f06af20d3..7a9dd5dcec8 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs @@ -131,7 +131,7 @@ newtype ShelleyDelegEvent era = DelegNewEpoch EpochNo instance NFData (ShelleyDelegEvent era) instance - (EraPParams era, ShelleyEraAccounts era, ShelleyEraTxCert era, ProtVerAtMost era 8) => + (EraPParams era, ShelleyEraAccounts era, ShelleyEraTxCert era, AtMostEra "Babbage" era) => STS (ShelleyDELEG era) where type State (ShelleyDELEG era) = DState era @@ -245,7 +245,7 @@ instance k -> invalidKey k delegationTransition :: - (ShelleyEraAccounts era, ShelleyEraTxCert era, EraPParams era, ProtVerAtMost era 8) => + (ShelleyEraAccounts era, ShelleyEraTxCert era, EraPParams era, AtMostEra "Babbage" era) => TransitionRule (ShelleyDELEG era) delegationTransition = do TRC (DelegEnv slot epochNo ptr chainAccountState pp, ds, c) <- judgmentContext @@ -369,7 +369,7 @@ delegationTransition = do pure ds checkSlotNotTooLate :: - (ShelleyEraAccounts era, ShelleyEraTxCert era, EraPParams era, ProtVerAtMost era 8) => + (ShelleyEraAccounts era, ShelleyEraTxCert era, EraPParams era, AtMostEra "Babbage" era) => SlotNo -> EpochNo -> Rule (ShelleyDELEG era) 'Transition () diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs index a4300ebd96b..6c646784e2e 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs @@ -232,7 +232,7 @@ instance ( ShelleyEraAccounts era , ShelleyEraTxCert era , EraPParams era - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , PredicateFailure (EraRule "DELEG" era) ~ ShelleyDelegPredFailure era , Event (EraRule "DELEG" era) ~ ShelleyDelegEvent era ) => diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs index aae0ad2b3c4..8c127be4cb3 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs @@ -260,7 +260,7 @@ instance , Environment (EraRule "DELEGS" era) ~ DelegsEnv era , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era ) => STS (ShelleyLEDGER era) where diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs index 4188fd826ce..100ea6611ee 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs @@ -52,7 +52,7 @@ data NewppEnv era = NewppEnv instance ( EraGov era , GovState era ~ ShelleyGovState era - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era ) => STS (ShelleyNEWPP era) where @@ -70,7 +70,7 @@ newPpTransition :: forall era. ( GovState era ~ ShelleyGovState era , EraGov era - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era ) => TransitionRule (ShelleyNEWPP era) newPpTransition = do @@ -89,7 +89,7 @@ newPpTransition = do updatePpup :: ( EraPParams era , GovState era ~ ShelleyGovState era - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era ) => Word64 -> GovState era -> diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs index eb5ecef29c8..1cba0f53955 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs @@ -121,7 +121,7 @@ newtype PpupEvent era = PpupNewEpoch EpochNo instance NFData (PpupEvent era) -instance (EraPParams era, ProtVerAtMost era 8) => STS (ShelleyPPUP era) where +instance (EraPParams era, AtMostEra "Babbage" era) => STS (ShelleyPPUP era) where type State (ShelleyPPUP era) = ShelleyGovState era type Signal (ShelleyPPUP era) = StrictMaybe (Update era) type Environment (ShelleyPPUP era) = PpupEnv era @@ -147,7 +147,8 @@ instance Era era => DecCBOR (ShelleyPpupPredFailure era) where 2 -> SumD PVCannotFollowPPUP Invalid k -ppupTransitionNonEmpty :: (EraPParams era, ProtVerAtMost era 8) => TransitionRule (ShelleyPPUP era) +ppupTransitionNonEmpty :: + (EraPParams era, AtMostEra "Babbage" era) => TransitionRule (ShelleyPPUP era) ppupTransitionNonEmpty = do TRC ( PPUPEnv slot pp (GenDelegs genDelegs) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs index 74b7a3122d1..0d9062a7c76 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs @@ -61,7 +61,7 @@ instance ( EraGov era , Default (PParams era) , GovState era ~ ShelleyGovState era - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era ) => STS (ShelleyUPEC era) where diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs index f87dae0e9c4..43992bdb97a 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs @@ -89,7 +89,7 @@ import GHC.Generics (Generic) import Lens.Micro import NoThunks.Class (NoThunks (..)) -class (ShelleyEraTxCert era, EraTxBody era, ProtVerAtMost era 8) => ShelleyEraTxBody era where +class (ShelleyEraTxCert era, EraTxBody era, AtMostEra "Babbage" era) => ShelleyEraTxBody era where ttlTxBodyL :: ExactEra ShelleyEra era => Lens' (TxBody era) SlotNo updateTxBodyL :: Lens' (TxBody era) (StrictMaybe (Update era)) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs index 1b162bbb007..7698e905533 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs @@ -160,11 +160,11 @@ class EraTxCert era => ShelleyEraTxCert era where mkDelegStakeTxCert :: StakeCredential -> KeyHash 'StakePool -> TxCert era getDelegStakeTxCert :: TxCert era -> Maybe (StakeCredential, KeyHash 'StakePool) - mkGenesisDelegTxCert :: ProtVerAtMost era 8 => GenesisDelegCert -> TxCert era - getGenesisDelegTxCert :: ProtVerAtMost era 8 => TxCert era -> Maybe GenesisDelegCert + mkGenesisDelegTxCert :: AtMostEra "Babbage" era => GenesisDelegCert -> TxCert era + getGenesisDelegTxCert :: AtMostEra "Babbage" era => TxCert era -> Maybe GenesisDelegCert - mkMirTxCert :: ProtVerAtMost era 8 => MIRCert -> TxCert era - getMirTxCert :: ProtVerAtMost era 8 => TxCert era -> Maybe MIRCert + mkMirTxCert :: AtMostEra "Babbage" era => MIRCert -> TxCert era + getMirTxCert :: AtMostEra "Babbage" era => TxCert era -> Maybe MIRCert instance ShelleyEraTxCert ShelleyEra where mkRegTxCert = ShelleyTxCertDelegCert . ShelleyRegCert @@ -212,13 +212,13 @@ pattern DelegStakeTxCert c kh <- (getDelegStakeTxCert -> Just (c, kh)) DelegStakeTxCert c kh = mkDelegStakeTxCert c kh pattern MirTxCert :: - (ShelleyEraTxCert era, ProtVerAtMost era 8) => MIRCert -> TxCert era + (ShelleyEraTxCert era, AtMostEra "Babbage" era) => MIRCert -> TxCert era pattern MirTxCert d <- (getMirTxCert -> Just d) where MirTxCert d = mkMirTxCert d pattern GenesisDelegTxCert :: - (ShelleyEraTxCert era, ProtVerAtMost era 8) => + (ShelleyEraTxCert era, AtMostEra "Babbage" era) => KeyHash 'Genesis -> KeyHash 'GenesisDelegate -> VRFVerKeyHash 'GenDelegVRF -> @@ -543,7 +543,7 @@ isDelegation (DelegStakeTxCert _ _) = True isDelegation _ = False -- | Check for 'GenesisDelegate' constructor -isGenesisDelegation :: (ShelleyEraTxCert era, ProtVerAtMost era 8) => TxCert era -> Bool +isGenesisDelegation :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> Bool isGenesisDelegation = isJust . getGenesisDelegTxCert -- | Check for 'RegPool' constructor @@ -556,15 +556,15 @@ isRetirePool :: EraTxCert era => TxCert era -> Bool isRetirePool (RetirePoolTxCert _ _) = True isRetirePool _ = False -isInstantaneousRewards :: (ShelleyEraTxCert era, ProtVerAtMost era 8) => TxCert era -> Bool +isInstantaneousRewards :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> Bool isInstantaneousRewards = isJust . getMirTxCert -isReservesMIRCert :: (ShelleyEraTxCert era, ProtVerAtMost era 8) => TxCert era -> Bool +isReservesMIRCert :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> Bool isReservesMIRCert x = case getMirTxCert x of Just (MIRCert ReservesMIR _) -> True _ -> False -isTreasuryMIRCert :: (ShelleyEraTxCert era, ProtVerAtMost era 8) => TxCert era -> Bool +isTreasuryMIRCert :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCert era -> Bool isTreasuryMIRCert x = case getMirTxCert x of Just (MIRCert TreasuryMIR _) -> True _ -> False diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Examples.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Examples.hs index 01bb18c0749..d9aa313ddcd 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Examples.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Examples.hs @@ -129,7 +129,7 @@ mkLedgerExamples :: , PredicateFailure (EraRule "DELEGS" era) ~ ShelleyDelegsPredFailure era , PredicateFailure (EraRule "LEDGER" era) ~ ShelleyLedgerPredFailure era , Default (StashedAVVMAddresses era) - , ProtVerAtMost era 4 + , AtMostEra "Mary" era ) => (TxBody era -> [KeyPair 'Witness] -> TxWits era) -> Value era -> @@ -358,9 +358,7 @@ exampleTxIns = [ TxIn (TxId (mkDummySafeHash @EraIndependentTxBody 1)) minBound ] -exampleCerts :: - (ShelleyEraTxCert era, ProtVerAtMost era 8) => - StrictSeq (TxCert era) +exampleCerts :: (ShelleyEraTxCert era, AtMostEra "Babbage" era) => StrictSeq (TxCert era) exampleCerts = StrictSeq.fromList [ RegTxCert (keyToCredential exampleStakeKey) diff --git a/eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Gen.hs b/eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Gen.hs index 404553ae052..5612114f8d4 100644 --- a/eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Gen.hs +++ b/eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Gen.hs @@ -108,8 +108,8 @@ genTriple :: , Environment (EraRule "DELPL" era) ~ DelplEnv era , State (EraRule "DELPL" era) ~ CertState era , Signal (EraRule "DELPL" era) ~ TxCert era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era ) => Proxy era -> Int -> diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs index bd6035d4cde..01c82b876ff 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs @@ -108,7 +108,7 @@ initUTxO n = -- Protocal Parameters used for the benchmarknig tests. -- Note that the fees and deposits are set to zero for -- ease of creating transactions. -ppsBench :: (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) => PParams era +ppsBench :: (EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) => PParams era ppsBench = emptyPParams & ppMaxBBSizeL .~ 50000 @@ -124,7 +124,7 @@ ppsBench = & ppRhoL .~ unsafeBoundRational 0.0021 & ppTauL .~ unsafeBoundRational 0.2 -ledgerEnv :: (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) => LedgerEnv era +ledgerEnv :: (EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) => LedgerEnv era ledgerEnv = LedgerEnv (SlotNo 0) Nothing minBound ppsBench (ChainAccountState (Coin 0) (Coin 0)) testLEDGER :: diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Ledger.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Ledger.hs index 6614fb1c5bc..39d372ad229 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Ledger.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Ledger.hs @@ -91,7 +91,7 @@ instance , Environment (EraRule "DELEGS" era) ~ DelegsEnv era , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , Crypto c ) => TQC.HasTrace (ShelleyLEDGER era) (GenEnv c era) @@ -124,7 +124,7 @@ instance , PredicateFailure (EraRule "DELPL" era) ~ ShelleyDelplPredFailure era , Embed (EraRule "DELEG" era) (ShelleyDELPL era) , Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era) - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era ) => TQC.HasTrace (ShelleyLEDGERS era) (GenEnv c era) where diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs index c99107c54cb..e066a8a156a 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs @@ -153,7 +153,7 @@ instance , Environment (Core.EraRule "DELPL" era) ~ DelplEnv era , State (Core.EraRule "DELPL" era) ~ CertState era , Signal (Core.EraRule "DELPL" era) ~ TxCert era - , ProtVerAtMost era 8 + , AtMostEra "Babbage" era , EraCertState era , Crypto c ) => diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/TxCert.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/TxCert.hs index 924f1f03f12..b83070b6d68 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/TxCert.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/TxCert.hs @@ -87,7 +87,7 @@ deriving instance (Era era, Show (Script era)) => Show (CertCred era) -- and we generate more delegations than registrations of keys/pools. genTxCert :: forall era c. - (EraGen era, ProtVerAtMost era 8, EraCertState era, Crypto c) => + (EraGen era, AtMostEra "Babbage" era, EraCertState era, Crypto c) => Constants -> KeySpace c era -> PParams era -> @@ -304,7 +304,7 @@ genDelegation genGenesisDelegation :: forall era c. - (Era era, ShelleyEraTxCert era, ProtVerAtMost era 8, EraCertState era, Crypto c) => + (Era era, ShelleyEraTxCert era, AtMostEra "Babbage" era, EraCertState era, Crypto c) => -- | Core nodes [(GenesisKeyPair c, AllIssuerKeys c 'GenesisDelegate)] -> -- | All potential genesis delegate keys @@ -447,7 +447,7 @@ genRetirePool _pp poolKeys pState slot = -- | Generate an InstantaneousRewards Transfer certificate genInstantaneousRewardsAccounts :: - (EraPParams era, EraAccounts era, ShelleyEraTxCert era, ProtVerAtMost era 8) => + (EraPParams era, EraAccounts era, ShelleyEraTxCert era, AtMostEra "Babbage" era) => SlotNo -> -- | Index over the cold key hashes of all possible Genesis Delegates Map (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate) -> @@ -497,7 +497,7 @@ genInstantaneousRewardsAccounts s genesisDelegatesByHash pparams accountState de -- | Generate an InstantaneousRewards Transfer genInstantaneousRewardsTransfer :: - (EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) => + (EraPParams era, ShelleyEraTxCert era, AtMostEra "Babbage" era) => SlotNo -> -- | Index over the cold key hashes of all possible Genesis Delegates Map (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate) -> @@ -534,7 +534,7 @@ genInstantaneousRewardsTransfer s genesisDelegatesByHash pparams accountState de ) genInstantaneousRewards :: - (EraPParams era, EraAccounts era, ShelleyEraTxCert era, ProtVerAtMost era 8) => + (EraPParams era, EraAccounts era, ShelleyEraTxCert era, AtMostEra "Babbage" era) => SlotNo -> -- | Index over the cold key hashes of all possible Genesis Delegates Map (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate) -> diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs index 68f0e405f0a..39cdac9697c 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs @@ -103,7 +103,7 @@ genIntervalInThousands lower upper = genPParams :: forall era. - (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) => + (EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) => Constants -> Gen (PParams era) genPParams c@Constants {maxMinFeeA, maxMinFeeB} = do @@ -238,7 +238,7 @@ genM gen = frequency [(1, SJust <$> gen), (2, pure SNothing)] -- | This is only good in the Shelley Era, used to define the genShelleyEraPParamsUpdate method for (EraGen (ShelleyEra c)) genShelleyPParamsUpdate :: forall era. - (ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8, EraPParams era) => + (AtMostEra "Mary" era, AtMostEra "Alonzo" era, AtMostEra "Babbage" era, EraPParams era) => Constants -> PParams era -> Gen (PParamsUpdate era) diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/PropertyTests.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/PropertyTests.hs index aacf15568ba..764738a1295 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/PropertyTests.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/PropertyTests.hs @@ -71,7 +71,7 @@ commonTests :: , Signal (EraRule "LEDGERS" era) ~ Seq (Tx era) , Signal (EraRule "TICKN" era) ~ Bool , BaseM (EraRule "LEDGERS" era) ~ ShelleyBase - , ProtVerAtMost era 6 + , AtMostEra "Alonzo" era , GovState era ~ ShelleyGovState era , InstantStake era ~ ShelleyInstantStake era , QC.BaseEnv (EraRule "LEDGER" era) ~ Globals diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs index 70511508f49..c9fbdb44994 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs @@ -279,7 +279,7 @@ genPoolInfo PoolSetUpArgs {poolPledge, poolCost, poolMargin, poolMembers} = do } pure $ PoolInfo {params, coldKey, ownerKey, ownerStake, rewardKey, members} -genRewardPPs :: (EraPParams era, ProtVerAtMost era 6) => Gen (PParams era) +genRewardPPs :: (EraPParams era, AtMostEra "Alonzo" era) => Gen (PParams era) genRewardPPs = do d <- g decentralizationRange tau <- g tauRange @@ -305,7 +305,7 @@ toCompactCoinError c = rewardsBoundedByPot :: forall era. - (EraPParams era, ProtVerAtMost era 6) => + (EraPParams era, AtMostEra "Alonzo" era) => Proxy era -> Property rewardsBoundedByPot _ = property $ do diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs index 454c9799dc9..96c8b7d9ca1 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs @@ -265,7 +265,7 @@ instance , Signal (EraRule "TICK" era) ~ SlotNo , Embed (PRTCL MockCrypto) (CHAIN era) , EncCBORGroup (BlockBody era) - , ProtVerAtMost era 6 + , AtMostEra "Alonzo" era , State (EraRule "LEDGERS" era) ~ LedgerState era , EraCertState era ) => @@ -299,7 +299,7 @@ chainTransition :: , State (EraRule "TICK" era) ~ NewEpochState era , Signal (EraRule "TICK" era) ~ SlotNo , Embed (PRTCL MockCrypto) (CHAIN era) - , ProtVerAtMost era 6 + , AtMostEra "Alonzo" era , State (EraRule "LEDGERS" era) ~ LedgerState era , EraGov era , EraCertState era diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deleg.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deleg.hs index 33e9f74c670..4feddbaac07 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deleg.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deleg.hs @@ -171,7 +171,7 @@ balancesSumInvariant ] checkInstantaneousRewards :: - (EraPParams era, ShelleyEraTxCert era, ProtVerAtMost era 8) => + (EraPParams era, ShelleyEraTxCert era, AtMostEra "Babbage" era) => DelegEnv era -> SourceSignalTarget (ShelleyDELEG era) -> Property diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs index 93f706df74a..2810c9c264e 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs @@ -563,7 +563,7 @@ incrBlockCount kh cs = cs {chainNes = nes'} -- 'newLab', 'evolveNonceUnfrozen', and 'evolveNonceFrozen'. newEpoch :: forall era. - (ProtVerAtMost era 6, EraGov era) => + (AtMostEra "Alonzo" era, EraGov era) => Block (BHeader MockCrypto) era -> ChainState era -> ChainState era diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/EmptyBlock.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/EmptyBlock.hs index 4249992f895..22d43a3e450 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/EmptyBlock.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/EmptyBlock.hs @@ -47,8 +47,8 @@ initStEx1 :: , EraGov era , EraStake era , EraCertState era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era , Default (StashedAVVMAddresses era) ) => ChainState era @@ -58,8 +58,8 @@ blockEx1 :: forall era. ( HasCallStack , EraBlockBody era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era ) => Block (BHeader MockCrypto) era blockEx1 = @@ -80,8 +80,8 @@ blockNonce :: forall era. ( HasCallStack , EraBlockBody era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era ) => Nonce blockNonce = getBlockNonce (blockEx1 @era) @@ -92,8 +92,8 @@ expectedStEx1 :: , EraGov era , EraStake era , EraCertState era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era , Default (StashedAVVMAddresses era) ) => ChainState era @@ -111,8 +111,8 @@ exEmptyBlock :: , EraGov era , EraStake era , EraCertState era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era , Default (StashedAVVMAddresses era) ) => CHAINExample era diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs index 477e9b4dac5..927e4a6c095 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs @@ -84,8 +84,8 @@ initStGenesisDeleg :: , EraGov era , EraStake era , EraCertState era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era , Default (StashedAVVMAddresses era) ) => ChainState era diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs index 674aebaad6b..1ca28c64df5 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs @@ -39,7 +39,7 @@ import Test.Cardano.Ledger.Shelley.Rules.Chain ( import Test.Cardano.Ledger.Shelley.Utils (maxLLSupply, mkHash, unsafeBoundRational) -- | Initial Protocol Parameters -ppEx :: (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) => PParams era +ppEx :: (EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) => PParams era ppEx = emptyPParams & ppMaxBBSizeL .~ 50000 @@ -80,8 +80,8 @@ initSt :: , EraGov era , EraStake era , EraCertState era - , ProtVerAtMost era 4 - , ProtVerAtMost era 6 + , AtMostEra "Mary" era + , AtMostEra "Alonzo" era , Default (StashedAVVMAddresses era) ) => UTxO era -> diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs index a0c216ba370..efeae172ddf 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs @@ -119,7 +119,7 @@ bobAddr = mkGenesisTxIn :: HasCallStack => Integer -> TxIn mkGenesisTxIn = TxIn genesisId . mkTxIxPartial -pp :: forall era. (EraPParams era, ProtVerAtMost era 4) => PParams era +pp :: forall era. (EraPParams era, AtMostEra "Mary" era) => PParams era pp = emptyPParams & ppMinFeeAL .~ Coin 1 diff --git a/libs/cardano-ledger-api/CHANGELOG.md b/libs/cardano-ledger-api/CHANGELOG.md index 0b1b405bbc8..627c9bbb81b 100644 --- a/libs/cardano-ledger-api/CHANGELOG.md +++ b/libs/cardano-ledger-api/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.12.0.0 +* Add `EraHasName` type class and add `EraName` type family to the `Era` type class. * Add `queryPoolState` and bring back `queryPoolParameters` state query. * Add `queryDRepDelegations` state query * Remove `filterStakePoolDelegsAndRewards` as unnecessary. Use `queryStakePoolDelegsAndRewards` instead diff --git a/libs/cardano-ledger-api/cardano-ledger-api.cabal b/libs/cardano-ledger-api/cardano-ledger-api.cabal index cd75f5ead49..e7b710cf33e 100644 --- a/libs/cardano-ledger-api/cardano-ledger-api.cabal +++ b/libs/cardano-ledger-api/cardano-ledger-api.cabal @@ -65,7 +65,7 @@ library cardano-ledger-babbage >=1.11, cardano-ledger-binary >=1.4, cardano-ledger-conway >=1.19, - cardano-ledger-core >=1.17, + cardano-ledger-core:{cardano-ledger-core, internal} >=1.17, cardano-ledger-dijkstra >=0.1, cardano-ledger-mary ^>=1.9, cardano-ledger-shelley ^>=1.17, diff --git a/libs/cardano-ledger-api/src/Cardano/Ledger/Api/Era.hs b/libs/cardano-ledger-api/src/Cardano/Ledger/Api/Era.hs index 202f335a1f4..8f24727e7c0 100644 --- a/libs/cardano-ledger-api/src/Cardano/Ledger/Api/Era.hs +++ b/libs/cardano-ledger-api/src/Cardano/Ledger/Api/Era.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} @@ -7,16 +8,21 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} +#if __GLASGOW_HASKELL__ >= 908 +{-# OPTIONS_GHC -Wno-x-unsafe-ledger-internal #-} +#endif module Cardano.Ledger.Api.Era ( -- * Eras Era ( + EraName, PreviousEra, ProtVerLow, ProtVerHigh ), EraApi (..), eraName, + EraHasName (EraFromName), -- ** Byron ByronEra, @@ -89,6 +95,7 @@ import Cardano.Ledger.Dijkstra (DijkstraEra) import Cardano.Ledger.Dijkstra.Tx (Tx (..)) import Cardano.Ledger.Dijkstra.TxBody (TxBody (..), upgradeProposals) import Cardano.Ledger.Dijkstra.TxCert (DijkstraTxCertUpgradeError) +import Cardano.Ledger.Internal.Era (EraHasName (..)) import Cardano.Ledger.Keys (HasKeyRole (..)) import Cardano.Ledger.Mary (MaryEra, TxBody (..)) import Cardano.Ledger.Mary.TxBody (MaryEraTxBody (..)) diff --git a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Out.hs b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Out.hs index 9e4978227e0..9c245662043 100644 --- a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Out.hs +++ b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Out.hs @@ -25,7 +25,7 @@ propSetShelleyMinTxOut :: ( EraTxOut era , Arbitrary (PParamsHKD Identity era) , Arbitrary (TxOut era) - , AtMostEra MaryEra era + , AtMostEra "Mary" era ) => Spec propSetShelleyMinTxOut = @@ -39,7 +39,7 @@ propSetShelleyMinTxOut = | otherwise = (27 + Val.size val) * (minUTxOValue `quot` 27) in Val.coin val `shouldBe` Coin (max minVal minUTxOValue) where - _atMostMary = atMostEra @MaryEra @era + _atMostMary = atMostEra @"Mary" @era propSetAlonzoMinTxOut :: Spec propSetAlonzoMinTxOut = diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index 284b4385cc0..bddfedc7371 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -2,6 +2,9 @@ ## 1.18.0.0 +* Changed the type of `AtMostEra` and `AtLeastEra` to accept a type level string instead of an actual era type. +* Add `EraName` type family to the `Era` type class and use it for default implementation of + `eraName` type class function. * Changed `sizeTxF` and `sizeTxForFeeCalculation` to use `Word32` * Move pool deposits from `PState` into `StakePoolState`. #5234 * Add `spsDeposit` field to `StakePoolState` diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index 56ad5f9dc26..44c7a91283d 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -114,6 +114,7 @@ library cardano-data ^>=1.2, cardano-ledger-binary ^>=1.7, cardano-ledger-byron, + cardano-ledger-core:internal, cardano-slotting, cardano-strict-containers, containers, @@ -148,6 +149,10 @@ library ghc-options: -fno-ignore-asserts library internal + build-depends: + base, + cardano-ledger-binary, + exposed-modules: Cardano.Ledger.Internal.Era diff --git a/libs/cardano-ledger-core/internal/Cardano/Ledger/Internal/Definition/Era.hs b/libs/cardano-ledger-core/internal/Cardano/Ledger/Internal/Definition/Era.hs index 11086d90a9b..13e557a5570 100644 --- a/libs/cardano-ledger-core/internal/Cardano/Ledger/Internal/Definition/Era.hs +++ b/libs/cardano-ledger-core/internal/Cardano/Ledger/Internal/Definition/Era.hs @@ -1,6 +1,18 @@ -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} module Cardano.Ledger.Internal.Definition.Era ( + Era (..), + EraHasName (..), + ByronEra, ShelleyEra, AllegraEra, MaryEra, @@ -10,16 +22,162 @@ module Cardano.Ledger.Internal.Definition.Era ( DijkstraEra, ) where +import Cardano.Ledger.Binary (MaxVersion, MinVersion) +import Data.Kind (Type) +import Data.Typeable (Typeable) +import GHC.Exts (Proxy#, proxy#) +import GHC.TypeLits + +-------------------------------------------------------------------------------- +-- Era +-------------------------------------------------------------------------------- + +class + ( Typeable era + , KnownNat (ProtVerLow era) + , KnownNat (ProtVerHigh era) + , ProtVerLow era <= ProtVerHigh era + , MinVersion <= ProtVerLow era + , MinVersion <= ProtVerHigh era + , -- We need to make sure that there is never a case that MaxVersion equals to the highest + -- protocol version for the era, otherwise we can never upgrade to the next version: + CmpNat (ProtVerLow era) MaxVersion ~ 'LT + , CmpNat (ProtVerHigh era) MaxVersion ~ 'LT + ) => + Era era + where + type EraName era :: Symbol + + -- | Map an era to its predecessor. + -- + -- For example: + -- + -- > type instance PreviousEra AllegraEra = ShelleyEra + type PreviousEra era = (r :: Type) | r -> era + + -- | Lowest major protocol version for this era + type ProtVerLow era :: Nat + + -- | Highest major protocol version for this era. By default se to `ProtVerLow` + type ProtVerHigh era :: Nat + + type ProtVerHigh era = ProtVerLow era + + -- | Textual name of the current era. + -- + -- Designed to be used with @TypeApplications@: + -- + -- >>> eraName @ByronEra + -- "Byron" + eraName :: String + default eraName :: KnownSymbol (EraName era) => String + eraName = symbolVal' (proxy# :: Proxy# (EraName era)) + +-- | This is a non-existent era and is defined for satisfying the `PreviousEra` type family injectivity +data VoidEra + +-- | This is the era that preceded Shelley era. It cannot have any other class instances, +-- except for `Era` type class. +data ByronEra + +instance Era ByronEra where + type EraName ByronEra = "Byron" + type PreviousEra ByronEra = VoidEra + type ProtVerLow ByronEra = 0 + type ProtVerHigh ByronEra = 1 + data ShelleyEra +instance Era ShelleyEra where + type EraName ShelleyEra = "Shelley" + type PreviousEra ShelleyEra = ByronEra + type ProtVerLow ShelleyEra = 2 + data AllegraEra +instance Era AllegraEra where + type EraName AllegraEra = "Allegra" + type PreviousEra AllegraEra = ShelleyEra + type ProtVerLow AllegraEra = 3 + data MaryEra +instance Era MaryEra where + type EraName MaryEra = "Mary" + type PreviousEra MaryEra = AllegraEra + type ProtVerLow MaryEra = 4 + data AlonzoEra +instance Era AlonzoEra where + type EraName AlonzoEra = "Alonzo" + type PreviousEra AlonzoEra = MaryEra + type ProtVerLow AlonzoEra = 5 + type ProtVerHigh AlonzoEra = 6 + data BabbageEra +instance Era BabbageEra where + type EraName BabbageEra = "Babbage" + type PreviousEra BabbageEra = AlonzoEra + type ProtVerLow BabbageEra = 7 + type ProtVerHigh BabbageEra = 8 + data ConwayEra +instance Era ConwayEra where + type EraName ConwayEra = "Conway" + type PreviousEra ConwayEra = BabbageEra + type ProtVerLow ConwayEra = 9 + type ProtVerHigh ConwayEra = 11 + data DijkstraEra + +instance Era DijkstraEra where + type EraName DijkstraEra = "Dijkstra" + type PreviousEra DijkstraEra = ConwayEra + type ProtVerLow DijkstraEra = 12 + type ProtVerHigh DijkstraEra = 12 + +-- `EraHasName` type class must not be exported from any of the era packages and is only safe to +-- export from `cardano-ledger-api`, or any other package that can depend on all of the +-- cardano-ledegr-[era] packages. + +-- | This class exists in order to be able to derive the protocol version range for an era from its +-- name. It is achieved by the means of injective definition of an era type from its name. This +-- effectively closes the world for eras to only the ones that are deined in this module, however it +-- does have to be that way. In other words, if there is ever a need to define custom eras that +-- build on top of existing ledger eras, then we will need to remove injectivity from this type +-- class as well as from the @PreviousEra@ type family. +class + ( KnownSymbol eraName + , Era (EraFromName eraName) + , EraName (EraFromName eraName) ~ eraName + ) => + EraHasName eraName + where + type EraFromName eraName = (era :: Type) | era -> eraName + +instance EraHasName "Byron" where + type EraFromName "Byron" = ByronEra + +instance EraHasName "Shelley" where + type EraFromName "Shelley" = ShelleyEra + +instance EraHasName "Allegra" where + type EraFromName "Allegra" = AllegraEra + +instance EraHasName "Mary" where + type EraFromName "Mary" = MaryEra + +instance EraHasName "Alonzo" where + type EraFromName "Alonzo" = AlonzoEra + +instance EraHasName "Babbage" where + type EraFromName "Babbage" = BabbageEra + +instance EraHasName "Conway" where + type EraFromName "Conway" = ConwayEra + +instance EraHasName "Dijkstra" where + type EraFromName "Dijkstra" = DijkstraEra diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs index 51114ada16f..d76ef48c7ba 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/Era.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} @@ -13,6 +14,9 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} +#if __GLASGOW_HASKELL__ >= 908 +{-# OPTIONS_GHC -Wno-x-unsafe-ledger-internal #-} +#endif module Cardano.Ledger.Core.Era ( -- * Era @@ -51,70 +55,15 @@ module Cardano.Ledger.Core.Era ( import Cardano.Ledger.Binary import qualified Cardano.Ledger.Binary.Plain as Plain +import Cardano.Ledger.Internal.Era (ByronEra, Era (..), EraFromName) import Control.DeepSeq (NFData (..)) import Control.State.Transition.Extended (PredicateFailure, STS (..)) import qualified Data.ByteString.Lazy as BSL import Data.Kind (Constraint, Type) -import Data.Typeable (Typeable) import GHC.Stack (HasCallStack) import GHC.TypeLits import Lens.Micro --------------------------------------------------------------------------------- --- Era --------------------------------------------------------------------------------- - -class - ( Typeable era - , KnownNat (ProtVerLow era) - , KnownNat (ProtVerHigh era) - , ProtVerLow era <= ProtVerHigh era - , MinVersion <= ProtVerLow era - , MinVersion <= ProtVerHigh era - , -- We need to make sure that there is never a case that MaxVersion equals to the highest - -- protocol version for the era, otherwise we can never upgrade to the next version: - CmpNat (ProtVerLow era) MaxVersion ~ 'LT - , CmpNat (ProtVerHigh era) MaxVersion ~ 'LT - ) => - Era era - where - -- | Map an era to its predecessor. - -- - -- For example: - -- - -- > type instance PreviousEra (AllegraEra c) = ShelleyEra c - type PreviousEra era = (r :: Type) | r -> era - - -- | Lowest major protocol version for this era - type ProtVerLow era :: Nat - - -- | Highest major protocol version for this era. By default se to `ProtVerLow` - type ProtVerHigh era :: Nat - - type ProtVerHigh era = ProtVerLow era - - -- | Textual name of the current era. - -- - -- Designed to be used with @TypeApplications@: - -- - -- >>> eraName @ByronEra - -- "Byron" - eraName :: String - --- | This is the era that preceded Shelley era. It cannot have any other class instances, --- except for `Era` type class. -data ByronEra - --- | This is a non-existent era and is defined for satisfying the `PreviousEra` type family injectivity -data VoidEra - -instance Era ByronEra where - type PreviousEra ByronEra = VoidEra - type ProtVerLow ByronEra = 0 - type ProtVerHigh ByronEra = 1 - - eraName = "Byron" - ----------------------------- -- Rules -------------------- ----------------------------- @@ -225,12 +174,12 @@ type ExactEra inEra era = ProtVerInBounds era (ProtVerLow inEra) (ProtVerHigh inEra) -- | Restrict the @era@ to equal to @atLeastEra@ or come after it -type AtLeastEra atLeastEra era = - ProtVerAtLeast era (ProtVerLow atLeastEra) +type AtLeastEra (atLeastEra :: Symbol) era = + ProtVerAtLeast era (ProtVerLow (EraFromName atLeastEra)) -- | Restrict the @era@ to equal to @eraName@ or come before it. -type AtMostEra eraMostEra era = - ProtVerAtMost era (ProtVerHigh eraMostEra) +type AtMostEra (eraMostEra :: Symbol) era = + ProtVerAtMost era (ProtVerHigh (EraFromName eraMostEra)) -- | Get the value level `Version` of the lowest major protocol version for the supplied @era@. eraProtVerLow :: forall era. Era era => Version @@ -250,12 +199,12 @@ eraProtVersions = [eraProtVerLow @era .. eraProtVerHigh @era] -- -- For example these will type check -- --- > atLeastEra @BabbageEra @ConwayEra --- > atLeastEra @BabbageEra @BabbageEra +-- > atLeastEra @"Babbage" @ConwayEra +-- > atLeastEra @"Babbage" @BabbageEra -- -- However this will result in a type error -- --- > atLeastEra @BabbageEra @AlonzoEra +-- > atLeastEra @"Babbage" @AlonzoEra atLeastEra :: AtLeastEra eraName era => () atLeastEra = () diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs index 1eee6c02453..56b7f4a3954 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs @@ -9,7 +9,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} @@ -104,7 +103,7 @@ import Cardano.Ledger.Binary ( import Cardano.Ledger.Binary.Coders (Decode (..), Field, decode, field, invalidField) import Cardano.Ledger.Coin (Coin (..), partialCompactCoinL) import Cardano.Ledger.Compactible (Compactible (..), partialCompactFL) -import Cardano.Ledger.Core.Era (Era (..), PreviousEra, ProtVerAtMost, fromEraCBOR, toEraCBOR) +import Cardano.Ledger.Core.Era (AtMostEra, Era (..), PreviousEra, fromEraCBOR, toEraCBOR) import Cardano.Ledger.HKD (HKD, HKDApplicative, HKDFunctor (..), NoUpdate (..)) import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..)) import Control.DeepSeq (NFData) @@ -392,30 +391,30 @@ class hkdTauL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f UnitInterval) -- | Decentralization parameter - hkdDL :: (HKDFunctor f, ProtVerAtMost era 6) => Lens' (PParamsHKD f era) (HKD f UnitInterval) + hkdDL :: (HKDFunctor f, AtMostEra "Alonzo" era) => Lens' (PParamsHKD f era) (HKD f UnitInterval) -- | Decentralization parameter getter ppDG :: SimpleGetter (PParams era) UnitInterval - default ppDG :: ProtVerAtMost era 6 => SimpleGetter (PParams era) UnitInterval + default ppDG :: AtMostEra "Alonzo" era => SimpleGetter (PParams era) UnitInterval ppDG = ppLensHKD . hkdDL @era @Identity -- | Extra entropy - hkdExtraEntropyL :: (HKDFunctor f, ProtVerAtMost era 6) => Lens' (PParamsHKD f era) (HKD f Nonce) + hkdExtraEntropyL :: (HKDFunctor f, AtMostEra "Alonzo" era) => Lens' (PParamsHKD f era) (HKD f Nonce) -- | Protocol version hkdProtocolVersionL :: - (HKDFunctor f, ProtVerAtMost era 8) => Lens' (PParamsHKD f era) (HKD f ProtVer) + (HKDFunctor f, AtMostEra "Babbage" era) => Lens' (PParamsHKD f era) (HKD f ProtVer) ppProtocolVersionL :: Lens' (PParams era) ProtVer - default ppProtocolVersionL :: ProtVerAtMost era 8 => Lens' (PParams era) ProtVer + default ppProtocolVersionL :: AtMostEra "Babbage" era => Lens' (PParams era) ProtVer ppProtocolVersionL = ppLensHKD . hkdProtocolVersionL @era @Identity -- | PParamsUpdate Protocol version - ppuProtocolVersionL :: ProtVerAtMost era 8 => Lens' (PParamsUpdate era) (StrictMaybe ProtVer) + ppuProtocolVersionL :: AtMostEra "Babbage" era => Lens' (PParamsUpdate era) (StrictMaybe ProtVer) ppuProtocolVersionL = ppuLensHKD . hkdProtocolVersionL @era @StrictMaybe -- | Minimum UTxO value - hkdMinUTxOValueL :: HKDFunctor f => ProtVerAtMost era 4 => Lens' (PParamsHKD f era) (HKD f Coin) + hkdMinUTxOValueL :: (HKDFunctor f, AtMostEra "Mary" era) => Lens' (PParamsHKD f era) (HKD f Coin) -- | Minimum Stake Pool Cost hkdMinPoolCostL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f Coin) @@ -489,15 +488,15 @@ ppTauL :: forall era. EraPParams era => Lens' (PParams era) UnitInterval ppTauL = ppLensHKD . hkdTauL @era @Identity -- | Decentralization parameter -ppDL :: forall era. (EraPParams era, ProtVerAtMost era 6) => Lens' (PParams era) UnitInterval +ppDL :: forall era. (EraPParams era, AtMostEra "Alonzo" era) => Lens' (PParams era) UnitInterval ppDL = ppLensHKD . hkdDL @era @Identity -- | Extra entropy -ppExtraEntropyL :: forall era. (EraPParams era, ProtVerAtMost era 6) => Lens' (PParams era) Nonce +ppExtraEntropyL :: forall era. (EraPParams era, AtMostEra "Alonzo" era) => Lens' (PParams era) Nonce ppExtraEntropyL = ppLensHKD . hkdExtraEntropyL @era @Identity -- | Minimum UTxO value -ppMinUTxOValueL :: forall era. (EraPParams era, ProtVerAtMost era 4) => Lens' (PParams era) Coin +ppMinUTxOValueL :: forall era. (EraPParams era, AtMostEra "Mary" era) => Lens' (PParams era) Coin ppMinUTxOValueL = ppLensHKD . hkdMinUTxOValueL @era @Identity -- | Minimum Stake Pool Cost @@ -564,21 +563,21 @@ ppuTauL = ppuLensHKD . hkdTauL @era @StrictMaybe -- | Decentralization parameter ppuDL :: forall era. - (EraPParams era, ProtVerAtMost era 6) => + (EraPParams era, AtMostEra "Alonzo" era) => Lens' (PParamsUpdate era) (StrictMaybe UnitInterval) ppuDL = ppuLensHKD . hkdDL @era @StrictMaybe -- | Extra entropy ppuExtraEntropyL :: forall era. - (EraPParams era, ProtVerAtMost era 6) => + (EraPParams era, AtMostEra "Alonzo" era) => Lens' (PParamsUpdate era) (StrictMaybe Nonce) ppuExtraEntropyL = ppuLensHKD . hkdExtraEntropyL @era @StrictMaybe -- | Minimum UTxO value ppuMinUTxOValueL :: forall era. - (EraPParams era, ProtVerAtMost era 4) => + (EraPParams era, AtMostEra "Mary" era) => Lens' (PParamsUpdate era) (StrictMaybe Coin) ppuMinUTxOValueL = ppuLensHKD . hkdMinUTxOValueL @era @StrictMaybe diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Cert.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Cert.hs index 61c87560d91..f3a47c9ea03 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Cert.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Cert.hs @@ -118,10 +118,10 @@ conwayTxCertSpec univ (CertEnv pp ce cc cp) certState = -- ============================================================== -- Shelley Certs --- | Genesis delegations only work through the Babbage era. Hence the (AtMostEra BabbageEra era) +-- | Genesis delegations only work through the Babbage era. Hence the (AtMostEra "Babbage" era) genesisDelegCertSpec :: forall era. - (AtMostEra BabbageEra era, Era era) => + (AtMostEra "Babbage" era, Era era) => DState era -> Specification GenesisDelegCert genesisDelegCertSpec ds = let (vrfKeyHashes, coldKeyHashes) = computeSets ds @@ -159,7 +159,7 @@ computeSets ds = shelleyTxCertSpec :: forall era. - (AtMostEra BabbageEra era, EraSpecPParams era, EraAccounts era) => + (AtMostEra "Babbage" era, EraSpecPParams era, EraAccounts era) => WitUniv era -> CertEnv era -> ShelleyCertState era -> @@ -269,7 +269,7 @@ shelleyTxCertKey (ShelleyTxCertMir (MIRCert p _)) = MirKey p testGenesisCert :: forall era. - (AtMostEra BabbageEra era, EraSpecDeleg era, EraSpecPParams era, GenScript era) => Gen Property + (AtMostEra "Babbage" era, EraSpecDeleg era, EraSpecPParams era, GenScript era) => Gen Property testGenesisCert = do univ <- genWitUniv @era 200 wdrls <- genFromSpec (constrained $ \x -> witness univ x) @@ -281,7 +281,7 @@ testGenesisCert = do testShelleyCert :: forall era. ( Era era - , AtMostEra BabbageEra era + , AtMostEra "Babbage" era , EraSpecPParams era , EraSpecDeleg era , GenScript era diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/PParams.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/PParams.hs index dafcf2fd786..3933bbce25d 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/PParams.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Instances/PParams.hs @@ -138,11 +138,11 @@ unitI :: UnitInterval unitI = makeUnitInterval 0 1 dropAtMost6 :: - (EraPParams era, ProtVerAtMost era 6) => PParams era -> SimplePParams era -> SimplePParams era + (EraPParams era, AtMostEra "Alonzo" era) => PParams era -> SimplePParams era -> SimplePParams era dropAtMost6 pp x = x {decentral = pp ^. ppDL} dropAtMost4 :: - (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) => + (EraPParams era, AtMostEra "Mary" era, AtMostEra "Alonzo" era) => PParams era -> SimplePParams era -> SimplePParams era @@ -318,7 +318,7 @@ uDropShelley pp = } uDropProtVer :: - (EraPParams era, ProtVerAtMost era 8) => PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate + (EraPParams era, AtMostEra "Babbage" era) => PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate uDropProtVer pp psub = psub {uprotocolVersion = pp ^. ppuProtocolVersionL} uDropAlonzo :: AlonzoEraPParams era => PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate @@ -371,7 +371,8 @@ uLiftShelley pps = & ppuMinPoolCostL .~ (uminPoolCost pps) uLiftProtVer :: - (EraPParams era, ProtVerAtMost era 8) => SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era + (EraPParams era, AtMostEra "Babbage" era) => + SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era uLiftProtVer pps pp = pp & ppuProtocolVersionL .~ (uprotocolVersion pps) uLiftAlonzo :: AlonzoEraPParams era => SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs index ff96e777b51..950423e2a4b 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs @@ -80,6 +80,7 @@ import Cardano.Ledger.Conway.PParams (ConwayEraPParams (..), ConwayPParams (..)) import Cardano.Ledger.Conway.State (ConwayCertState, ConwayEraCertState) import Cardano.Ledger.Conway.TxCert (ConwayEraTxCert, ConwayTxCert (..)) import Cardano.Ledger.Core ( + AtMostEra, EraPParams, EraRule, EraScript, @@ -87,7 +88,6 @@ import Cardano.Ledger.Core ( EraTxAuxData, EraTxOut, PParamsHKD, - ProtVerAtMost, Script, TxCert, TxOut, @@ -336,9 +336,9 @@ instance Shaped Proof any where data TxOutWit era where TxOutShelleyToMary :: - (TxOut era ~ ShelleyTxOut era, EraTxOut era, ProtVerAtMost era 8) => TxOutWit era + (TxOut era ~ ShelleyTxOut era, EraTxOut era, AtMostEra "Babbage" era) => TxOutWit era TxOutAlonzoToAlonzo :: - (TxOut era ~ AlonzoTxOut era, AlonzoEraTxOut era, ProtVerAtMost era 8) => TxOutWit era + (TxOut era ~ AlonzoTxOut era, AlonzoEraTxOut era, AtMostEra "Babbage" era) => TxOutWit era TxOutBabbageToConway :: (TxOut era ~ BabbageTxOut era, BabbageEraTxOut era) => TxOutWit era whichTxOut :: Proof era -> TxOutWit era @@ -351,7 +351,7 @@ whichTxOut Conway = TxOutBabbageToConway data TxCertWit era where TxCertShelleyToBabbage :: - (TxCert era ~ ShelleyTxCert era, ShelleyEraTxCert era, ProtVerAtMost era 8) => TxCertWit era + (TxCert era ~ ShelleyTxCert era, ShelleyEraTxCert era, AtMostEra "Babbage" era) => TxCertWit era TxCertConwayToConway :: (TxCert era ~ ConwayTxCert era, ConwayEraTxCert era, ConwayEraPParams era) => TxCertWit era diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs index 0212e6b9aa9..54727886698 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs @@ -140,7 +140,7 @@ class NewEpochState era -> LedgerView default currentLedgerView :: - ProtVerAtMost era 6 => + AtMostEra "Alonzo" era => NewEpochState era -> LedgerView currentLedgerView = view @@ -154,7 +154,7 @@ class m LedgerView default futureLedgerView :: ( MonadError (FutureLedgerViewError era) m - , ProtVerAtMost era 6 + , AtMostEra "Alonzo" era ) => Globals -> NewEpochState era -> @@ -279,7 +279,7 @@ mkPrtclEnv lvGenDelegs view :: - (ProtVerAtMost era 6, EraGov era, EraCertState era) => + (AtMostEra "Alonzo" era, EraGov era, EraCertState era) => NewEpochState era -> LedgerView view @@ -348,7 +348,7 @@ futureView :: , Environment (EraRule "TICKF" era) ~ () , State (EraRule "TICKF" era) ~ NewEpochState era , Signal (EraRule "TICKF" era) ~ SlotNo - , ProtVerAtMost era 6 + , AtMostEra "Alonzo" era , EraGov era , EraCertState era ) => diff --git a/libs/cardano-protocol-tpraos/test/Test/Cardano/Protocol/Binary/CddlSpec.hs b/libs/cardano-protocol-tpraos/test/Test/Cardano/Protocol/Binary/CddlSpec.hs index bb9d378049e..4768cfe5688 100644 --- a/libs/cardano-protocol-tpraos/test/Test/Cardano/Protocol/Binary/CddlSpec.hs +++ b/libs/cardano-protocol-tpraos/test/Test/Cardano/Protocol/Binary/CddlSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -45,7 +46,7 @@ spec = specForEra :: forall era. - (Era era, AtMostEra AlonzoEra era) => + (Era era, AtMostEra "Alonzo" era) => IO [BSL.ByteString] -> Huddle -> Int -> @@ -67,4 +68,4 @@ specForEra readCddlFiles cddlFiles n = do (eraProtVerLow @era) "[ operational_cert ]" where - _atMostAlonzo = atMostEra @AlonzoEra @era + _atMostAlonzo = atMostEra @"Alonzo" @era diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Binary/Cddl.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Binary/Cddl.hs index 6797e6b7c99..fc131f3a96a 100644 --- a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Binary/Cddl.hs +++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Binary/Cddl.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -11,7 +12,6 @@ module Test.Cardano.Protocol.Binary.Cddl ( praosBlockHuddleSpec, ) where -import Cardano.Ledger.Babbage (BabbageEra) import Cardano.Ledger.Binary (Annotator, DecCBOR, EncCBOR) import Cardano.Ledger.Core import Cardano.Protocol.Crypto (StandardCrypto) @@ -51,7 +51,7 @@ cddlBlockSpec = do praosBlockCddlSpec :: forall era c bh bhbody. ( Era era - , AtLeastEra BabbageEra era + , AtLeastEra "Babbage" era , Eq (bh c) , Show (bh c) , DecCBOR (bh c) @@ -68,7 +68,7 @@ praosBlockCddlSpec = do cddlBlockSpec @era @c @bh @bhbody cddlRoundTripCborSpec @(OCert StandardCrypto) v "operational_cert" where - _atLeastBabbage = atLeastEra @BabbageEra @era + _atLeastBabbage = atLeastEra @"Babbage" @era huddleBlockSpec :: forall era c bh bhbody. @@ -96,7 +96,7 @@ huddleBlockSpec = do praosBlockHuddleSpec :: forall era c bh bhbody. ( Era era - , AtLeastEra BabbageEra era + , AtLeastEra "Babbage" era , Eq (bh c) , Show (bh c) , DecCBOR (bh c) @@ -113,4 +113,4 @@ praosBlockHuddleSpec = do huddleBlockSpec @era @c @bh @bhbody huddleRoundTripCborSpec @(OCert StandardCrypto) v "operational_cert" where - _atLeastBabbage = atLeastEra @BabbageEra @era + _atLeastBabbage = atLeastEra @"Babbage" @era From dfa8acee93d573364a6c5779be0de0bd23ad96e4 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Wed, 3 Sep 2025 19:32:38 -0600 Subject: [PATCH 3/3] Remove another redundant constraint --- libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal | 1 - .../testlib/Test/Cardano/Protocol/TPraos/Examples.hs | 4 +--- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal index e0c053b7f45..414ae8d1bac 100644 --- a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal +++ b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal @@ -90,7 +90,6 @@ library testlib cardano-crypto-class >=2.1.1, cardano-ledger-allegra:{cardano-ledger-allegra, testlib}, cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib}, - cardano-ledger-babbage, cardano-ledger-binary:{cardano-ledger-binary, testlib}, cardano-ledger-conway:testlib, cardano-ledger-core:{cardano-ledger-core, testlib}, diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Examples.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Examples.hs index 6152210ca68..c32da3b8c84 100644 --- a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Examples.hs +++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Examples.hs @@ -111,15 +111,13 @@ ledgerExamplesTPraos :: ledgerExamplesTPraos = mkProtocolLedgerExamples exampleHashHeader - (exampleBlockHeader @era) + exampleBlockHeader (exampleChainDepState 1) exampleHashHeader :: HashHeader exampleHashHeader = coerce $ mkDummyHash @HASH (0 :: Int) exampleBlockHeader :: - forall era. - EraBlockBody era => Hash HASH EraIndependentBlockBody -> BHeader StandardCrypto exampleBlockHeader blockBodyHash = BHeader blockHeaderBody (unsoundPureSignedKES () 0 blockHeaderBody hotKey)