diff --git a/eras/allegra/impl/CHANGELOG.md b/eras/allegra/impl/CHANGELOG.md index 56ad79b4b58..480a063a960 100644 --- a/eras/allegra/impl/CHANGELOG.md +++ b/eras/allegra/impl/CHANGELOG.md @@ -2,6 +2,9 @@ ## 1.10.0.0 +* Rename rule types and deprecate the old names: + - `AllegraUTXO` -> `UTXO` + - `AllegraUTXOW` -> `UTXOW` * Change `Signal` to `StAnnTx TopTx era` for: `AllegraUTXOW`, `AllegraUTXO` * Add `FromJSON` instance for `ValidityInterval` * Add `ApplyTick` instance for `AllegraEra` diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs index 896cf0eada2..d9127742c30 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Era.hs @@ -12,6 +12,10 @@ module Cardano.Ledger.Allegra.Era ( AllegraEra, + UTXO, + UTXOW, + + -- * Deprecated AllegraUTXO, AllegraUTXOW, ) where @@ -38,48 +42,56 @@ type instance Value AllegraEra = Coin -- These rules are all inherited from Shelley -type instance EraRule "BBODY" AllegraEra = Shelley.ShelleyBBODY AllegraEra +type instance EraRule "BBODY" AllegraEra = Shelley.BBODY AllegraEra -type instance EraRule "DELEG" AllegraEra = Shelley.ShelleyDELEG AllegraEra +type instance EraRule "DELEG" AllegraEra = Shelley.DELEG AllegraEra -type instance EraRule "DELEGS" AllegraEra = Shelley.ShelleyDELEGS AllegraEra +type instance EraRule "DELEGS" AllegraEra = Shelley.DELEGS AllegraEra -type instance EraRule "DELPL" AllegraEra = Shelley.ShelleyDELPL AllegraEra +type instance EraRule "DELPL" AllegraEra = Shelley.DELPL AllegraEra -type instance EraRule "EPOCH" AllegraEra = Shelley.ShelleyEPOCH AllegraEra +type instance EraRule "EPOCH" AllegraEra = Shelley.EPOCH AllegraEra -type instance EraRule "LEDGER" AllegraEra = Shelley.ShelleyLEDGER AllegraEra +type instance EraRule "LEDGER" AllegraEra = Shelley.LEDGER AllegraEra -type instance EraRule "LEDGERS" AllegraEra = Shelley.ShelleyLEDGERS AllegraEra +type instance EraRule "LEDGERS" AllegraEra = Shelley.LEDGERS AllegraEra -type instance EraRule "MIR" AllegraEra = Shelley.ShelleyMIR AllegraEra +type instance EraRule "MIR" AllegraEra = Shelley.MIR AllegraEra -type instance EraRule "NEWEPOCH" AllegraEra = Shelley.ShelleyNEWEPOCH AllegraEra +type instance EraRule "NEWEPOCH" AllegraEra = Shelley.NEWEPOCH AllegraEra -type instance EraRule "NEWPP" AllegraEra = Shelley.ShelleyNEWPP AllegraEra +type instance EraRule "NEWPP" AllegraEra = Shelley.NEWPP AllegraEra -type instance EraRule "POOL" AllegraEra = Shelley.ShelleyPOOL AllegraEra +type instance EraRule "POOL" AllegraEra = Shelley.POOL AllegraEra -type instance EraRule "POOLREAP" AllegraEra = Shelley.ShelleyPOOLREAP AllegraEra +type instance EraRule "POOLREAP" AllegraEra = Shelley.POOLREAP AllegraEra -type instance EraRule "PPUP" AllegraEra = Shelley.ShelleyPPUP AllegraEra +type instance EraRule "PPUP" AllegraEra = Shelley.PPUP AllegraEra -type instance EraRule "RUPD" AllegraEra = Shelley.ShelleyRUPD AllegraEra +type instance EraRule "RUPD" AllegraEra = Shelley.RUPD AllegraEra -type instance EraRule "SNAP" AllegraEra = Shelley.ShelleySNAP AllegraEra +type instance EraRule "SNAP" AllegraEra = Shelley.SNAP AllegraEra -type instance EraRule "TICK" AllegraEra = Shelley.ShelleyTICK AllegraEra +type instance EraRule "TICK" AllegraEra = Shelley.TICK AllegraEra -type instance EraRule "TICKF" AllegraEra = Shelley.ShelleyTICKF AllegraEra +type instance EraRule "TICKF" AllegraEra = Shelley.TICKF AllegraEra -type instance EraRule "UPEC" AllegraEra = Shelley.ShelleyUPEC AllegraEra +type instance EraRule "UPEC" AllegraEra = Shelley.UPEC AllegraEra -- These rules are defined anew in the Allegra era -data AllegraUTXO era +data UTXO era + +type AllegraUTXO = UTXO + +{-# DEPRECATED AllegraUTXO "In favor of `UTXO`" #-} + +type instance EraRule "UTXO" AllegraEra = UTXO AllegraEra + +data UTXOW era -type instance EraRule "UTXO" AllegraEra = AllegraUTXO AllegraEra +type AllegraUTXOW = UTXOW -data AllegraUTXOW era +{-# DEPRECATED AllegraUTXOW "In favor of `UTXOW`" #-} -type instance EraRule "UTXOW" AllegraEra = AllegraUTXOW AllegraEra +type instance EraRule "UTXOW" AllegraEra = UTXOW 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 0ece3e8aadc..436728b8923 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Allegra.Rules.Utxo ( - AllegraUTXO, + UTXO, AllegraUtxoEvent (..), AllegraUtxoPredFailure (..), validateOutsideValidityIntervalUTxO, @@ -23,7 +23,7 @@ module Cardano.Ledger.Allegra.Rules.Utxo ( ) where import Cardano.Ledger.Allegra.Core -import Cardano.Ledger.Allegra.Era (AllegraEra, AllegraUTXO) +import Cardano.Ledger.Allegra.Era (AllegraEra, UTXO) import Cardano.Ledger.Allegra.Rules.Ppup () import Cardano.Ledger.Allegra.Scripts (inInterval) import Cardano.Ledger.BaseTypes ( @@ -160,7 +160,7 @@ utxoTransition :: , GovState era ~ ShelleyGovState era , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era - , EraRule "UTXO" era ~ AllegraUTXO era + , EraRule "UTXO" era ~ UTXO era , SafeToHash (TxWits era) ) => TransitionRule (EraRule "UTXO" era) @@ -286,27 +286,27 @@ instance , EraCertState era , ShelleyEraTxBody era , AllegraEraTxBody era - , Embed (EraRule "PPUP" era) (AllegraUTXO era) + , Embed (EraRule "PPUP" era) (UTXO era) , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era , State (EraRule "PPUP" era) ~ ShelleyGovState era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) , AtMostEra "Babbage" era , Eq (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) - , EraRule "UTXO" era ~ AllegraUTXO era + , EraRule "UTXO" era ~ UTXO era , GovState era ~ ShelleyGovState era , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era , SafeToHash (TxWits era) ) => - STS (AllegraUTXO era) + STS (UTXO era) where - type State (AllegraUTXO era) = Shelley.UTxOState era - type Signal (AllegraUTXO era) = StAnnTx TopTx era - type Environment (AllegraUTXO era) = Shelley.UtxoEnv era - type BaseM (AllegraUTXO era) = ShelleyBase - type PredicateFailure (AllegraUTXO era) = AllegraUtxoPredFailure era - type Event (AllegraUTXO era) = AllegraUtxoEvent era + type State (UTXO era) = Shelley.UTxOState era + type Signal (UTXO era) = StAnnTx TopTx era + type Environment (UTXO era) = Shelley.UtxoEnv era + type BaseM (UTXO era) = ShelleyBase + type PredicateFailure (UTXO era) = AllegraUtxoPredFailure era + type Event (UTXO era) = AllegraUtxoEvent era initialRules = [] transitionRules = [utxoTransition] @@ -314,11 +314,11 @@ instance instance ( Era era - , STS (Shelley.ShelleyPPUP era) + , STS (Shelley.PPUP era) , EraRuleFailure "PPUP" era ~ Shelley.ShelleyPpupPredFailure era - , Event (EraRule "PPUP" era) ~ Event (Shelley.ShelleyPPUP era) + , Event (EraRule "PPUP" era) ~ Event (Shelley.PPUP era) ) => - Embed (Shelley.ShelleyPPUP era) (AllegraUTXO era) + Embed (Shelley.PPUP era) (UTXO era) where wrapFailed = UpdateFailure wrapEvent = UpdateEvent diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxow.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxow.hs index 7ab12f2f670..5c32deaafcf 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxow.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxow.hs @@ -8,11 +8,11 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Cardano.Ledger.Allegra.Rules.Utxow (AllegraUTXOW) where +module Cardano.Ledger.Allegra.Rules.Utxow (UTXOW) where import Cardano.Ledger.Allegra.Core -import Cardano.Ledger.Allegra.Era (AllegraEra, AllegraUTXOW) -import Cardano.Ledger.Allegra.Rules.Utxo (AllegraUTXO, AllegraUtxoPredFailure) +import Cardano.Ledger.Allegra.Era (AllegraEra, UTXOW) +import Cardano.Ledger.Allegra.Rules.Utxo (AllegraUtxoPredFailure, UTXO) import Cardano.Ledger.BaseTypes import Cardano.Ledger.Shelley.LedgerState (UTxOState) import qualified Cardano.Ledger.Shelley.Rules as Shelley @@ -47,22 +47,22 @@ instance , ShelleyEraTxBody era , ScriptsNeeded era ~ ShelleyScriptsNeeded era , -- Allow UTXOW to call UTXO - Embed (EraRule "UTXO" era) (AllegraUTXOW era) + Embed (EraRule "UTXO" era) (UTXOW era) , Environment (EraRule "UTXO" era) ~ Shelley.UtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era - , EraRule "UTXOW" era ~ AllegraUTXOW era + , EraRule "UTXOW" era ~ UTXOW era , InjectRuleFailure "UTXOW" Shelley.ShelleyUtxowPredFailure era , EraCertState era ) => - STS (AllegraUTXOW era) + STS (UTXOW era) where - type State (AllegraUTXOW era) = UTxOState era - type Signal (AllegraUTXOW era) = StAnnTx TopTx era - type Environment (AllegraUTXOW era) = Shelley.UtxoEnv era - type BaseM (AllegraUTXOW era) = ShelleyBase - type PredicateFailure (AllegraUTXOW era) = Shelley.ShelleyUtxowPredFailure era - type Event (AllegraUTXOW era) = Shelley.ShelleyUtxowEvent era + type State (UTXOW era) = UTxOState era + type Signal (UTXOW era) = StAnnTx TopTx era + type Environment (UTXOW era) = Shelley.UtxoEnv era + type BaseM (UTXOW era) = ShelleyBase + type PredicateFailure (UTXOW era) = Shelley.ShelleyUtxowPredFailure era + type Event (UTXOW era) = Shelley.ShelleyUtxowEvent era transitionRules = [Shelley.transitionRulesUTXOW] @@ -72,22 +72,22 @@ instance instance ( Era era - , STS (AllegraUTXO era) + , STS (UTXO era) , PredicateFailure (EraRule "UTXO" era) ~ AllegraUtxoPredFailure era - , Event (EraRule "UTXO" era) ~ Event (AllegraUTXO era) + , Event (EraRule "UTXO" era) ~ Event (UTXO era) ) => - Embed (AllegraUTXO era) (AllegraUTXOW era) + Embed (UTXO era) (UTXOW era) where wrapFailed = Shelley.UtxoFailure wrapEvent = Shelley.UtxoEvent instance ( Era era - , STS (AllegraUTXOW era) + , STS (UTXOW era) , PredicateFailure (EraRule "UTXOW" era) ~ Shelley.ShelleyUtxowPredFailure era - , Event (EraRule "UTXOW" era) ~ Event (AllegraUTXOW era) + , Event (EraRule "UTXOW" era) ~ Event (UTXOW era) ) => - Embed (AllegraUTXOW era) (Shelley.ShelleyLEDGER era) + Embed (UTXOW era) (Shelley.LEDGER era) where wrapFailed = Shelley.UtxowFailure wrapEvent = Shelley.UtxowEvent diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md index dea32fad1eb..bcc6ede50f8 100644 --- a/eras/alonzo/impl/CHANGELOG.md +++ b/eras/alonzo/impl/CHANGELOG.md @@ -2,6 +2,12 @@ ## 1.16.0.0 +* Rename rule types and deprecate the old names: + - `AlonzoBBODY` -> `BBODY` + - `AlonzoLEDGER` -> `LEDGER` + - `AlonzoUTXO` -> `UTXO` + - `AlonzoUTXOS` -> `UTXOS` + - `AlonzoUTXOW` -> `UTXOW` * Replace `scriptsProvided` and `scriptsNeeded` in `mkScriptIntegrity` signature with `Set Language` * Add `plutusLanguagesUsedStAnnTx` to `AlonzoEraUTxO` and a helper to implement it `plutusLanguagesUsedAlonzoStAnnTx` * Add `plutusScriptsWithContextStAnnTx` to `AlonzoEraUTxO` and a helper to implement it `plutusScriptsWithContextAlonzoStAnnTx` diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs index 4cbdfe80f24..9d7ce10954b 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Era.hs @@ -9,6 +9,13 @@ module Cardano.Ledger.Alonzo.Era ( AlonzoEra, + UTXO, + UTXOS, + UTXOW, + BBODY, + LEDGER, + + -- * Deprecated AlonzoUTXO, AlonzoUTXOS, AlonzoUTXOW, @@ -34,56 +41,76 @@ type instance Value AlonzoEra = MaryValue -- These rules are new or changed in Alonzo -data AlonzoUTXOS era +data UTXOS era + +type AlonzoUTXOS = UTXOS + +{-# DEPRECATED AlonzoUTXOS "In favor of `UTXOS`" #-} + +type instance EraRule "UTXOS" AlonzoEra = UTXOS AlonzoEra + +data UTXO era + +type AlonzoUTXO = UTXO + +{-# DEPRECATED AlonzoUTXO "In favor of `UTXO`" #-} + +type instance EraRule "UTXO" AlonzoEra = UTXO AlonzoEra + +data UTXOW era + +type AlonzoUTXOW = UTXOW + +{-# DEPRECATED AlonzoUTXOW "In favor of `UTXOW`" #-} -type instance EraRule "UTXOS" AlonzoEra = AlonzoUTXOS AlonzoEra +type instance EraRule "UTXOW" AlonzoEra = UTXOW AlonzoEra -data AlonzoUTXO era +data LEDGER era -type instance EraRule "UTXO" AlonzoEra = AlonzoUTXO AlonzoEra +type AlonzoLEDGER = LEDGER -data AlonzoUTXOW era +{-# DEPRECATED AlonzoLEDGER "In favor of `LEDGER`" #-} -type instance EraRule "UTXOW" AlonzoEra = AlonzoUTXOW AlonzoEra +type instance EraRule "LEDGER" AlonzoEra = LEDGER AlonzoEra -data AlonzoLEDGER era +data BBODY era -type instance EraRule "LEDGER" AlonzoEra = AlonzoLEDGER AlonzoEra +type AlonzoBBODY = BBODY -data AlonzoBBODY era +{-# DEPRECATED AlonzoBBODY "In favor of `BBODY`" #-} -type instance EraRule "BBODY" AlonzoEra = AlonzoBBODY AlonzoEra +type instance EraRule "BBODY" AlonzoEra = BBODY AlonzoEra -- Rules inherited from Shelley -type instance EraRule "DELEG" AlonzoEra = Shelley.ShelleyDELEG AlonzoEra +type instance EraRule "DELEG" AlonzoEra = Shelley.DELEG AlonzoEra -type instance EraRule "DELEGS" AlonzoEra = Shelley.ShelleyDELEGS AlonzoEra +type instance EraRule "DELEGS" AlonzoEra = Shelley.DELEGS AlonzoEra -type instance EraRule "DELPL" AlonzoEra = Shelley.ShelleyDELPL AlonzoEra +type instance EraRule "DELPL" AlonzoEra = Shelley.DELPL AlonzoEra -type instance EraRule "EPOCH" AlonzoEra = Shelley.ShelleyEPOCH AlonzoEra +type instance EraRule "EPOCH" AlonzoEra = Shelley.EPOCH AlonzoEra -type instance EraRule "LEDGERS" AlonzoEra = Shelley.ShelleyLEDGERS AlonzoEra +type instance EraRule "LEDGERS" AlonzoEra = Shelley.LEDGERS AlonzoEra -type instance EraRule "MIR" AlonzoEra = Shelley.ShelleyMIR AlonzoEra +type instance EraRule "MIR" AlonzoEra = Shelley.MIR AlonzoEra -type instance EraRule "NEWEPOCH" AlonzoEra = Shelley.ShelleyNEWEPOCH AlonzoEra +type instance EraRule "NEWEPOCH" AlonzoEra = Shelley.NEWEPOCH AlonzoEra -type instance EraRule "NEWPP" AlonzoEra = Shelley.ShelleyNEWPP AlonzoEra +type instance EraRule "NEWPP" AlonzoEra = Shelley.NEWPP AlonzoEra -type instance EraRule "POOL" AlonzoEra = Shelley.ShelleyPOOL AlonzoEra +type instance EraRule "POOL" AlonzoEra = Shelley.POOL AlonzoEra -type instance EraRule "POOLREAP" AlonzoEra = Shelley.ShelleyPOOLREAP AlonzoEra +type instance EraRule "POOLREAP" AlonzoEra = Shelley.POOLREAP AlonzoEra -type instance EraRule "PPUP" AlonzoEra = Shelley.ShelleyPPUP AlonzoEra +type instance EraRule "PPUP" AlonzoEra = Shelley.PPUP AlonzoEra -type instance EraRule "RUPD" AlonzoEra = Shelley.ShelleyRUPD AlonzoEra +type instance EraRule "RUPD" AlonzoEra = Shelley.RUPD AlonzoEra -type instance EraRule "SNAP" AlonzoEra = Shelley.ShelleySNAP AlonzoEra +type instance EraRule "SNAP" AlonzoEra = Shelley.SNAP AlonzoEra -type instance EraRule "TICK" AlonzoEra = Shelley.ShelleyTICK AlonzoEra +type instance EraRule "TICK" AlonzoEra = Shelley.TICK AlonzoEra -type instance EraRule "TICKF" AlonzoEra = Shelley.ShelleyTICKF AlonzoEra +type instance EraRule "TICKF" AlonzoEra = Shelley.TICKF AlonzoEra -type instance EraRule "UPEC" AlonzoEra = Shelley.ShelleyUPEC AlonzoEra +type instance EraRule "UPEC" AlonzoEra = Shelley.UPEC AlonzoEra diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs index a59006d0d52..09cdbb97791 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Rules.Bbody ( - AlonzoBBODY, + BBODY, AlonzoBbodyPredFailure (..), AlonzoBbodyEvent (..), alonzoBbodyTransition, @@ -25,7 +25,7 @@ module Cardano.Ledger.Alonzo.Rules.Bbody ( import qualified Cardano.Ledger.Allegra.Rules as Allegra import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Era (AlonzoBBODY, AlonzoEra) +import Cardano.Ledger.Alonzo.Era (AlonzoEra, BBODY) import Cardano.Ledger.Alonzo.Rules.Ledgers () import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUtxoPredFailure) import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure) @@ -214,10 +214,10 @@ alonzoBbodyTransition = do pure $ Shelley.BbodyState ls' $ incrBlocks block firstSlot (pp ^. ppDG) blocksMade instance - ( EraRule "BBODY" era ~ AlonzoBBODY era + ( EraRule "BBODY" era ~ BBODY era , InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era , InjectRuleFailure "BBODY" Shelley.ShelleyBbodyPredFailure era - , Embed (EraRule "LEDGERS" era) (AlonzoBBODY era) + , Embed (EraRule "LEDGERS" era) (BBODY era) , Environment (EraRule "LEDGERS" era) ~ Shelley.ShelleyLedgersEnv era , State (EraRule "LEDGERS" era) ~ LedgerState era , Signal (EraRule "LEDGERS" era) ~ Seq (Tx TopTx era) @@ -226,18 +226,18 @@ instance , AlonzoEraPParams era , AlonzoEraTx era ) => - STS (AlonzoBBODY era) + STS (BBODY era) where - type State (AlonzoBBODY era) = Shelley.ShelleyBbodyState era + type State (BBODY era) = Shelley.ShelleyBbodyState era - type Signal (AlonzoBBODY era) = Shelley.BbodySignal era + type Signal (BBODY era) = Shelley.BbodySignal era - type Environment (AlonzoBBODY era) = Shelley.BbodyEnv era + type Environment (BBODY era) = Shelley.BbodyEnv era - type BaseM (AlonzoBBODY era) = ShelleyBase + type BaseM (BBODY era) = ShelleyBase - type PredicateFailure (AlonzoBBODY era) = AlonzoBbodyPredFailure era - type Event (AlonzoBBODY era) = AlonzoBbodyEvent era + type PredicateFailure (BBODY era) = AlonzoBbodyPredFailure era + type Event (BBODY era) = AlonzoBbodyEvent era initialRules = [] transitionRules = [alonzoBbodyTransition @era] @@ -249,7 +249,7 @@ instance , STS ledgers , Era era ) => - Embed ledgers (AlonzoBBODY era) + Embed ledgers (BBODY era) where wrapFailed = ShelleyInAlonzoBbodyPredFailure . Shelley.LedgersFailure wrapEvent = ShelleyInAlonzoEvent . Shelley.LedgersEvent 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 10a15e12bf1..7d66966e22b 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs @@ -11,16 +11,16 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Rules.Ledger ( - AlonzoLEDGER, + LEDGER, ledgerTransition, ) where import qualified Cardano.Ledger.Allegra.Rules as Allegra -import Cardano.Ledger.Alonzo.Era (AlonzoEra, AlonzoLEDGER) +import Cardano.Ledger.Alonzo.Era (AlonzoEra, LEDGER) import Cardano.Ledger.Alonzo.Rules.Delegs () import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUtxoPredFailure) import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure) -import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUTXOW, AlonzoUtxowEvent, AlonzoUtxowPredFailure) +import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUtxowEvent, AlonzoUtxowPredFailure, UTXOW) import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..)) import Cardano.Ledger.BaseTypes (ShelleyBase) import Cardano.Ledger.Shelley.Core @@ -141,8 +141,8 @@ ledgerTransition = do instance ( AlonzoEraTx era , EraGov era - , Embed (EraRule "DELEGS" era) (AlonzoLEDGER era) - , Embed (EraRule "UTXOW" era) (AlonzoLEDGER era) + , Embed (EraRule "DELEGS" era) (LEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) , Environment (EraRule "UTXOW" era) ~ Shelley.UtxoEnv era , State (EraRule "UTXOW" era) ~ UTxOState era , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era @@ -150,22 +150,22 @@ instance , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) , AtMostEra "Babbage" era - , EraRule "LEDGER" era ~ AlonzoLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , EraRuleFailure "LEDGER" era ~ Shelley.ShelleyLedgerPredFailure era , InjectRuleFailure "LEDGER" Shelley.ShelleyLedgerPredFailure era , EraCertState era ) => - STS (AlonzoLEDGER era) + STS (LEDGER era) where - type State (AlonzoLEDGER era) = LedgerState era - type Signal (AlonzoLEDGER era) = StAnnTx TopTx era - type Environment (AlonzoLEDGER era) = Shelley.LedgerEnv era - type BaseM (AlonzoLEDGER era) = ShelleyBase - type PredicateFailure (AlonzoLEDGER era) = Shelley.ShelleyLedgerPredFailure era - type Event (AlonzoLEDGER era) = Shelley.ShelleyLedgerEvent era + type State (LEDGER era) = LedgerState era + type Signal (LEDGER era) = StAnnTx TopTx era + type Environment (LEDGER era) = Shelley.LedgerEnv era + type BaseM (LEDGER era) = ShelleyBase + type PredicateFailure (LEDGER era) = Shelley.ShelleyLedgerPredFailure era + type Event (LEDGER era) = Shelley.ShelleyLedgerEvent era initialRules = [] - transitionRules = [ledgerTransition @AlonzoLEDGER] + transitionRules = [ledgerTransition @LEDGER] renderAssertionViolation = Shelley.renderDepositEqualsObligationViolation @@ -173,33 +173,33 @@ instance instance ( Era era - , STS (Shelley.ShelleyDELEGS era) + , STS (Shelley.DELEGS era) , PredicateFailure (EraRule "DELEGS" era) ~ Shelley.ShelleyDelegsPredFailure era , Event (EraRule "DELEGS" era) ~ Shelley.ShelleyDelegsEvent era ) => - Embed (Shelley.ShelleyDELEGS era) (AlonzoLEDGER era) + Embed (Shelley.DELEGS era) (LEDGER era) where wrapFailed = Shelley.DelegsFailure wrapEvent = Shelley.DelegsEvent instance ( Era era - , STS (AlonzoUTXOW era) + , STS (UTXOW era) , PredicateFailure (EraRule "UTXOW" era) ~ AlonzoUtxowPredFailure era , Event (EraRule "UTXOW" era) ~ AlonzoUtxowEvent era ) => - Embed (AlonzoUTXOW era) (AlonzoLEDGER era) + Embed (UTXOW era) (LEDGER era) where wrapFailed = Shelley.UtxowFailure wrapEvent = Shelley.UtxowEvent instance ( Era era - , STS (AlonzoLEDGER era) + , STS (LEDGER era) , PredicateFailure (EraRule "LEDGER" era) ~ Shelley.ShelleyLedgerPredFailure era , Event (EraRule "LEDGER" era) ~ Shelley.ShelleyLedgerEvent era ) => - Embed (AlonzoLEDGER era) (Shelley.ShelleyLEDGERS era) + Embed (LEDGER era) (Shelley.LEDGERS era) where wrapFailed = Shelley.LedgerFailure wrapEvent = Shelley.LedgerEvent 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 9acee522793..1040659295d 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Rules.Utxo ( - AlonzoUTXO, + UTXO, AlonzoUtxoPredFailure (..), allegraToAlonzoUtxoPredFailure, AlonzoUtxoEvent (..), @@ -40,12 +40,12 @@ import Cardano.Ledger.Address ( ) import qualified Cardano.Ledger.Allegra.Rules as Allegra import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..)) -import Cardano.Ledger.Alonzo.Era (AlonzoEra, AlonzoUTXO) +import Cardano.Ledger.Alonzo.Era (AlonzoEra, UTXO) import Cardano.Ledger.Alonzo.PParams import Cardano.Ledger.Alonzo.Rules.Ppup () import Cardano.Ledger.Alonzo.Rules.Utxos ( - AlonzoUTXOS, AlonzoUtxosPredFailure, + UTXOS, UtxosEnv (..), ) import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), pointWiseExUnits) @@ -488,11 +488,11 @@ utxoTransition :: ( EraUTxO era , AlonzoEraTx era , AtMostEra "Babbage" era - , EraRule "UTXO" era ~ AlonzoUTXO era + , EraRule "UTXO" era ~ UTXO era , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era , InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era , InjectRuleFailure "UTXO" Allegra.AllegraUtxoPredFailure era - , Embed (EraRule "UTXOS" era) (AlonzoUTXO era) + , Embed (EraRule "UTXOS" era) (UTXO era) , Environment (EraRule "UTXOS" era) ~ UtxosEnv era , State (EraRule "UTXOS" era) ~ ShelleyGovState era , Signal (EraRule "UTXOS" era) ~ StAnnTx TopTx era @@ -595,18 +595,18 @@ utxoTransition = do } -------------------------------------------------------------------------------- --- AlonzoUTXO STS +-- UTXO STS -------------------------------------------------------------------------------- instance forall era. ( EraUTxO era , AlonzoEraTx era - , Embed (EraRule "UTXOS" era) (AlonzoUTXO era) + , Embed (EraRule "UTXOS" era) (UTXO era) , Environment (EraRule "UTXOS" era) ~ UtxosEnv era , State (EraRule "UTXOS" era) ~ ShelleyGovState era , Signal (EraRule "UTXOS" era) ~ StAnnTx TopTx era - , EraRule "UTXO" era ~ AlonzoUTXO era + , EraRule "UTXO" era ~ UTXO era , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era , InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era , InjectRuleFailure "UTXO" Allegra.AllegraUtxoPredFailure era @@ -616,14 +616,14 @@ instance , SafeToHash (TxWits era) , GovState era ~ ShelleyGovState era ) => - STS (AlonzoUTXO era) + STS (UTXO era) where - type State (AlonzoUTXO era) = UTxOState era - type Signal (AlonzoUTXO era) = StAnnTx TopTx era - type Environment (AlonzoUTXO era) = Shelley.UtxoEnv era - type BaseM (AlonzoUTXO era) = ShelleyBase - type PredicateFailure (AlonzoUTXO era) = AlonzoUtxoPredFailure era - type Event (AlonzoUTXO era) = AlonzoUtxoEvent era + type State (UTXO era) = UTxOState era + type Signal (UTXO era) = StAnnTx TopTx era + type Environment (UTXO era) = Shelley.UtxoEnv era + type BaseM (UTXO era) = ShelleyBase + type PredicateFailure (UTXO era) = AlonzoUtxoPredFailure era + type Event (UTXO era) = AlonzoUtxoEvent era initialRules = [] transitionRules = [utxoTransition] @@ -631,11 +631,11 @@ instance instance ( Era era - , STS (AlonzoUTXOS era) + , STS (UTXOS era) , PredicateFailure (EraRule "UTXOS" era) ~ AlonzoUtxosPredFailure era - , Event (EraRule "UTXOS" era) ~ Event (AlonzoUTXOS era) + , Event (EraRule "UTXOS" era) ~ Event (UTXOS era) ) => - Embed (AlonzoUTXOS era) (AlonzoUTXO era) + Embed (UTXOS era) (UTXO era) where wrapFailed = UtxosFailure wrapEvent = UtxosEvent diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs index 73392730581..c1213526c56 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Rules.Utxos ( - AlonzoUTXOS, + UTXOS, AlonzoUtxosPredFailure (..), lbl2Phase, TagMismatchDescription (..), @@ -34,7 +34,7 @@ module Cardano.Ledger.Alonzo.Rules.Utxos ( ) where import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Era (AlonzoEra, AlonzoUTXOS) +import Cardano.Ledger.Alonzo.Era (AlonzoEra, UTXOS) import Cardano.Ledger.Alonzo.Plutus.Context (ContextError, EraPlutusContext) import Cardano.Ledger.Alonzo.Plutus.Evaluate ( CollectError (..), @@ -88,7 +88,7 @@ import Lens.Micro import NoThunks.Class (NoThunks) -------------------------------------------------------------------------------- --- The AlonzoUTXOS transition system +-- The UTXOS transition system -------------------------------------------------------------------------------- instance @@ -102,7 +102,7 @@ instance , EraGov era , GovState era ~ ShelleyGovState era , State (EraRule "PPUP" era) ~ ShelleyGovState era - , Embed (EraRule "PPUP" era) (AlonzoUTXOS era) + , Embed (EraRule "PPUP" era) (UTXOS era) , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) , EncCBOR (PredicateFailure (EraRule "PPUP" era)) -- Serializing the PredicateFailure, @@ -112,14 +112,14 @@ instance , EraCertState era , EraStake era ) => - STS (AlonzoUTXOS era) + STS (UTXOS era) where - type BaseM (AlonzoUTXOS era) = ShelleyBase - type Environment (AlonzoUTXOS era) = UtxosEnv era - type State (AlonzoUTXOS era) = ShelleyGovState era - type Signal (AlonzoUTXOS era) = StAnnTx TopTx era - type PredicateFailure (AlonzoUTXOS era) = AlonzoUtxosPredFailure era - type Event (AlonzoUTXOS era) = AlonzoUtxosEvent era + type BaseM (UTXOS era) = ShelleyBase + type Environment (UTXOS era) = UtxosEnv era + type State (UTXOS era) = ShelleyGovState era + type Signal (UTXOS era) = StAnnTx TopTx era + type PredicateFailure (UTXOS era) = AlonzoUtxosPredFailure era + type Event (UTXOS era) = AlonzoUtxosEvent era transitionRules = [utxosTransition] data UtxosEnv era = UtxosEnv @@ -142,12 +142,12 @@ instance NFData (EraRuleEvent "PPUP" era) => NFData (AlonzoUtxosEvent era) instance ( Era era - , STS (Shelley.ShelleyPPUP era) + , STS (Shelley.PPUP era) , EraRuleFailure "PPUP" era ~ Shelley.ShelleyPpupPredFailure era - , Event (EraRule "PPUP" era) ~ Event (Shelley.ShelleyPPUP era) + , Event (EraRule "PPUP" era) ~ Event (Shelley.PPUP era) , EraRuleEvent "PPUP" era ~ Shelley.PpupEvent era ) => - Embed (Shelley.ShelleyPPUP era) (AlonzoUTXOS era) + Embed (Shelley.PPUP era) (UTXOS era) where wrapFailed = UpdateFailure wrapEvent = AlonzoPpupToUtxosEvent @@ -164,7 +164,7 @@ utxosTransition :: , State (EraRule "PPUP" era) ~ ShelleyGovState era , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) - , Embed (EraRule "PPUP" era) (AlonzoUTXOS era) + , Embed (EraRule "PPUP" era) (UTXOS era) , EncCBOR (PredicateFailure (EraRule "PPUP" era)) -- Serializing the PredicateFailure , Eq (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) @@ -172,7 +172,7 @@ utxosTransition :: , EraCertState era , EraStake era ) => - TransitionRule (AlonzoUTXOS era) + TransitionRule (UTXOS era) utxosTransition = judgmentContext >>= \(TRC (_, _, stAnnTx)) -> do let tx = stAnnTx ^. txStAnnTxG @@ -223,15 +223,15 @@ alonzoEvalScriptsTxValid :: , AlonzoEraUTxO era , ShelleyEraTxBody era , ScriptsNeeded era ~ AlonzoScriptsNeeded era - , STS (AlonzoUTXOS era) + , STS (UTXOS era) , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) - , Embed (EraRule "PPUP" era) (AlonzoUTXOS era) + , Embed (EraRule "PPUP" era) (UTXOS era) , State (EraRule "PPUP" era) ~ ShelleyGovState era , EraPlutusContext era , EraCertState era ) => - TransitionRule (AlonzoUTXOS era) + TransitionRule (UTXOS era) alonzoEvalScriptsTxValid = do TRC (UtxosEnv slot pp certState utxo, pup, stAnnTx) <- judgmentContext @@ -259,10 +259,10 @@ alonzoEvalScriptsTxInvalid :: ( AlonzoEraTx era , AlonzoEraUTxO era , ScriptsNeeded era ~ AlonzoScriptsNeeded era - , STS (AlonzoUTXOS era) + , STS (UTXOS era) , EraPlutusContext era ) => - TransitionRule (AlonzoUTXOS era) + TransitionRule (UTXOS era) alonzoEvalScriptsTxInvalid = do TRC (UtxosEnv slot pp _ utxo, pup, stAnnTx) <- judgmentContext let tx = stAnnTx ^. txStAnnTxG @@ -291,7 +291,7 @@ invalidBegin = intercalate "," ["[LEDGER][SCRIPTS_NOT_VALIDATE_TRANSITION]", "BE invalidEnd = intercalate "," ["[LEDGER][SCRIPTS_NOT_VALIDATE_TRANSITION]", "END"] -- ============================================= --- PredicateFailure data type for AlonzoUTXOS +-- PredicateFailure data type for UTXOS data FailureDescription = PlutusFailure Text BS.ByteString diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs index 7e090ec3a6b..214a64f2f4f 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs @@ -17,7 +17,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Rules.Utxow ( - AlonzoUTXOW, + UTXOW, AlonzoUtxowEvent (WrappedShelleyEraEvent), AlonzoUtxowPredFailure (..), hasExactSetOfRedeemers, @@ -27,11 +27,11 @@ module Cardano.Ledger.Alonzo.Rules.Utxow ( import qualified Cardano.Ledger.Allegra.Rules as Allegra import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Era (AlonzoEra, AlonzoUTXOW) +import Cardano.Ledger.Alonzo.Era (AlonzoEra, UTXOW) import Cardano.Ledger.Alonzo.Rules.Utxo ( - AlonzoUTXO, AlonzoUtxoEvent, AlonzoUtxoPredFailure (..), + UTXO, ) import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure) import Cardano.Ledger.Alonzo.Scripts (toAsItem, toAsIx) @@ -297,11 +297,11 @@ alonzoStyleWitness :: , ShelleyEraTxBody era , AlonzoEraUTxO era , ScriptsNeeded era ~ AlonzoScriptsNeeded era - , EraRule "UTXOW" era ~ AlonzoUTXOW era + , EraRule "UTXOW" era ~ UTXOW era , InjectRuleFailure "UTXOW" Shelley.ShelleyUtxowPredFailure era , InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era , -- Allow UTXOW to call UTXO - Embed (EraRule "UTXO" era) (AlonzoUTXOW era) + Embed (EraRule "UTXO" era) (UTXOW era) , Environment (EraRule "UTXO" era) ~ Shelley.UtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era @@ -392,37 +392,37 @@ instance , AlonzoEraUTxO era , ShelleyEraTxBody era , ScriptsNeeded era ~ AlonzoScriptsNeeded era - , EraRule "UTXOW" era ~ AlonzoUTXOW era + , EraRule "UTXOW" era ~ UTXOW era , InjectRuleFailure "UTXOW" Shelley.ShelleyUtxowPredFailure era , InjectRuleFailure "UTXOW" AlonzoUtxowPredFailure era , -- Allow UTXOW to call UTXO - Embed (EraRule "UTXO" era) (AlonzoUTXOW era) + Embed (EraRule "UTXO" era) (UTXOW era) , Environment (EraRule "UTXO" era) ~ Shelley.UtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era , EraCertState era ) => - STS (AlonzoUTXOW era) + STS (UTXOW era) where - type State (AlonzoUTXOW era) = UTxOState era - type Signal (AlonzoUTXOW era) = StAnnTx TopTx era - type Environment (AlonzoUTXOW era) = Shelley.UtxoEnv era - type BaseM (AlonzoUTXOW era) = ShelleyBase - type PredicateFailure (AlonzoUTXOW era) = AlonzoUtxowPredFailure era - type Event (AlonzoUTXOW era) = AlonzoUtxowEvent era + type State (UTXOW era) = UTxOState era + type Signal (UTXOW era) = StAnnTx TopTx era + type Environment (UTXOW era) = Shelley.UtxoEnv era + type BaseM (UTXOW era) = ShelleyBase + type PredicateFailure (UTXOW era) = AlonzoUtxowPredFailure era + type Event (UTXOW era) = AlonzoUtxowEvent era transitionRules = [alonzoStyleWitness @era] initialRules = [] instance ( Era era - , STS (AlonzoUTXO era) + , STS (UTXO era) , PredicateFailure (EraRule "UTXO" era) ~ AlonzoUtxoPredFailure era , Event (EraRule "UTXO" era) ~ AlonzoUtxoEvent era - , BaseM (AlonzoUTXOW era) ~ ShelleyBase - , PredicateFailure (AlonzoUTXOW era) ~ AlonzoUtxowPredFailure era - , Event (AlonzoUTXOW era) ~ AlonzoUtxowEvent era + , BaseM (UTXOW era) ~ ShelleyBase + , PredicateFailure (UTXOW era) ~ AlonzoUtxowPredFailure era + , Event (UTXOW era) ~ AlonzoUtxowEvent era ) => - Embed (AlonzoUTXO era) (AlonzoUTXOW era) + Embed (UTXO era) (UTXOW era) where wrapFailed = ShelleyInAlonzoUtxowPredFailure . Shelley.UtxoFailure wrapEvent = WrappedShelleyEraEvent . Shelley.UtxoEvent 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 afc7fe162ca..d22025b967f 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 @@ -15,7 +15,7 @@ module Test.Cardano.Ledger.Alonzo.Trace () where import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Rules (AlonzoLEDGER) +import Cardano.Ledger.Alonzo.Rules (LEDGER) import Cardano.Ledger.BaseTypes (Globals, epochInfo, systemStart) import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..)) import Cardano.Ledger.Shelley.LedgerState (UTxOState, lsUTxOState, utxosUtxo) @@ -37,7 +37,7 @@ import Test.Cardano.Ledger.Shelley.Generator.Utxo (genTx) import Test.Cardano.Ledger.Shelley.Utils (testGlobals) import qualified Test.Control.State.Transition.Trace.Generator.QuickCheck as TQC --- The AlonzoLEDGER STS combines utxo and delegation rules and allows for generating transactions +-- The LEDGER STS combines utxo and delegation rules and allows for generating transactions -- with meaningful delegation certificates. instance ( ApplyTx era @@ -52,8 +52,8 @@ instance , State (EraRule "DELPL" era) ~ CertState era , Signal (EraRule "DELPL" era) ~ TxCert era , PredicateFailure (EraRule "DELPL" era) ~ Shelley.ShelleyDelplPredFailure era - , Embed (EraRule "DELEGS" era) (AlonzoLEDGER era) - , Embed (EraRule "UTXOW" era) (AlonzoLEDGER era) + , Embed (EraRule "DELEGS" era) (LEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) , Environment (EraRule "UTXOW" era) ~ Shelley.UtxoEnv era , State (EraRule "UTXOW" era) ~ UTxOState era , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era @@ -64,9 +64,9 @@ instance , EraCertState era , Crypto c , EraRuleFailure "LEDGER" era ~ Shelley.ShelleyLedgerPredFailure era - , EraRule "LEDGER" era ~ AlonzoLEDGER era + , EraRule "LEDGER" era ~ LEDGER era ) => - TQC.HasTrace (AlonzoLEDGER era) (GenEnv c era) + TQC.HasTrace (LEDGER era) (GenEnv c era) where envGen GenEnv {geConstants} = Shelley.LedgerEnv (SlotNo 0) Nothing minBound @@ -85,5 +85,5 @@ instance shrinkSignal _ = [] -- TODO add some kind of Shrinker? - type BaseEnv (AlonzoLEDGER era) = Globals + type BaseEnv (LEDGER era) = Globals interpretSTS globals act = runIdentity $ runReaderT act globals diff --git a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/ChainTrace.hs b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/ChainTrace.hs index 57db71e78e9..d6bbf29840c 100644 --- a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/ChainTrace.hs +++ b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/ChainTrace.hs @@ -19,7 +19,7 @@ import Cardano.Ledger.Alonzo.Plutus.Evaluate ( collectPlutusScriptsWithContext, evalPlutusScripts, ) -import Cardano.Ledger.Alonzo.Rules (AlonzoBBODY, AlonzoLEDGER) +import Cardano.Ledger.Alonzo.Rules (BBODY, LEDGER) import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..), ExUnits (..), mkPlutusScript) import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), IsValid (..), totExUnits) import Cardano.Ledger.Core @@ -53,7 +53,7 @@ import Test.Cardano.Ledger.Shelley.Rules.TestChain ( ) import Test.Control.State.Transition.Trace (SourceSignalTarget (..), sourceSignalTargets) -instance Embed (AlonzoBBODY AlonzoEra) (CHAIN AlonzoEra) where +instance Embed (BBODY AlonzoEra) (CHAIN AlonzoEra) where wrapFailed = BbodyFailure wrapEvent = BbodyEvent @@ -79,7 +79,7 @@ alonzoSpecificProps SourceSignalTarget {source = chainSt, signal = block} = where (tickedChainSt, ledgerTr) = ledgerTraceFromBlock chainSt block pp = (view curPParamsEpochStateL . nesEs . chainNes) tickedChainSt - alonzoSpecificPropsLEDGER :: SourceSignalTarget (AlonzoLEDGER AlonzoEra) -> Property + alonzoSpecificPropsLEDGER :: SourceSignalTarget (LEDGER AlonzoEra) -> Property alonzoSpecificPropsLEDGER SourceSignalTarget { source = LedgerState UTxOState {utxosUtxo = UTxO u, utxosDeposited = dp, utxosFees = f} ds diff --git a/eras/babbage/impl/CHANGELOG.md b/eras/babbage/impl/CHANGELOG.md index 11bc748f261..51a2d856ce7 100644 --- a/eras/babbage/impl/CHANGELOG.md +++ b/eras/babbage/impl/CHANGELOG.md @@ -2,6 +2,11 @@ ## 1.14.0.0 +* Rename rule types and deprecate the old names: + - `BabbageLEDGER` -> `LEDGER` + - `BabbageUTXO` -> `UTXO` + - `BabbageUTXOS` -> `UTXOS` + - `BabbageUTXOW` -> `UTXOW` * Replace arguments of `babbageEvalScriptsTxInvalid` with `StAnnTx` * Replace arguments of `expectScriptsToPass` with `StAnnTx` * Change `Signal` to `StAnnTx TopTx era` for: `BabbageLEDGER`, `BabbageUTXOW`, `BabbageUTXO`, `BabbageUTXOS` diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Era.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Era.hs index 332d4aae8f2..fc24a69e208 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Era.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Era.hs @@ -8,6 +8,12 @@ module Cardano.Ledger.Babbage.Era ( BabbageEra, + UTXO, + UTXOS, + UTXOW, + LEDGER, + + -- * Deprecated BabbageUTXO, BabbageUTXOS, BabbageUTXOW, @@ -37,58 +43,74 @@ type instance Value BabbageEra = MaryValue -- Era Mapping ------------------------------------------------------------------------------- -data BabbageUTXOS era +data UTXOS era + +type BabbageUTXOS = UTXOS + +{-# DEPRECATED BabbageUTXOS "In favor of `UTXOS`" #-} + +type instance EraRule "UTXOS" BabbageEra = UTXOS BabbageEra + +data UTXO era + +type BabbageUTXO = UTXO + +{-# DEPRECATED BabbageUTXO "In favor of `UTXO`" #-} + +type instance EraRule "UTXO" BabbageEra = UTXO BabbageEra + +data UTXOW era -type instance EraRule "UTXOS" BabbageEra = BabbageUTXOS BabbageEra +type BabbageUTXOW = UTXOW -data BabbageUTXO era +{-# DEPRECATED BabbageUTXOW "In favor of `UTXOW`" #-} -type instance EraRule "UTXO" BabbageEra = BabbageUTXO BabbageEra +type instance EraRule "UTXOW" BabbageEra = UTXOW BabbageEra -data BabbageUTXOW era +data LEDGER c -type instance EraRule "UTXOW" BabbageEra = BabbageUTXOW BabbageEra +type BabbageLEDGER = LEDGER -data BabbageLEDGER c +{-# DEPRECATED BabbageLEDGER "In favor of `LEDGER`" #-} -type instance EraRule "LEDGER" BabbageEra = BabbageLEDGER BabbageEra +type instance EraRule "LEDGER" BabbageEra = LEDGER BabbageEra -- Rules inherited from Alonzo -type instance EraRule "BBODY" BabbageEra = Alonzo.AlonzoBBODY BabbageEra +type instance EraRule "BBODY" BabbageEra = Alonzo.BBODY BabbageEra -- Rules inherited from Shelley -type instance EraRule "DELEG" BabbageEra = API.ShelleyDELEG BabbageEra +type instance EraRule "DELEG" BabbageEra = API.DELEG BabbageEra -type instance EraRule "DELEGS" BabbageEra = API.ShelleyDELEGS BabbageEra +type instance EraRule "DELEGS" BabbageEra = API.DELEGS BabbageEra -type instance EraRule "DELPL" BabbageEra = API.ShelleyDELPL BabbageEra +type instance EraRule "DELPL" BabbageEra = API.DELPL BabbageEra -type instance EraRule "EPOCH" BabbageEra = Shelley.ShelleyEPOCH BabbageEra +type instance EraRule "EPOCH" BabbageEra = Shelley.EPOCH BabbageEra -type instance EraRule "LEDGERS" BabbageEra = API.ShelleyLEDGERS BabbageEra +type instance EraRule "LEDGERS" BabbageEra = API.LEDGERS BabbageEra -type instance EraRule "MIR" BabbageEra = Shelley.ShelleyMIR BabbageEra +type instance EraRule "MIR" BabbageEra = Shelley.MIR BabbageEra -type instance EraRule "NEWEPOCH" BabbageEra = API.ShelleyNEWEPOCH BabbageEra +type instance EraRule "NEWEPOCH" BabbageEra = API.NEWEPOCH BabbageEra -type instance EraRule "NEWPP" BabbageEra = Shelley.ShelleyNEWPP BabbageEra +type instance EraRule "NEWPP" BabbageEra = Shelley.NEWPP BabbageEra -type instance EraRule "POOL" BabbageEra = API.ShelleyPOOL BabbageEra +type instance EraRule "POOL" BabbageEra = API.POOL BabbageEra -type instance EraRule "POOLREAP" BabbageEra = API.ShelleyPOOLREAP BabbageEra +type instance EraRule "POOLREAP" BabbageEra = API.POOLREAP BabbageEra -type instance EraRule "PPUP" BabbageEra = API.ShelleyPPUP BabbageEra +type instance EraRule "PPUP" BabbageEra = API.PPUP BabbageEra -type instance EraRule "RUPD" BabbageEra = Shelley.ShelleyRUPD BabbageEra +type instance EraRule "RUPD" BabbageEra = Shelley.RUPD BabbageEra -type instance EraRule "SNAP" BabbageEra = Shelley.ShelleySNAP BabbageEra +type instance EraRule "SNAP" BabbageEra = Shelley.SNAP BabbageEra -type instance EraRule "TICK" BabbageEra = Shelley.ShelleyTICK BabbageEra +type instance EraRule "TICK" BabbageEra = Shelley.TICK BabbageEra -type instance EraRule "TICKF" BabbageEra = Shelley.ShelleyTICKF BabbageEra +type instance EraRule "TICKF" BabbageEra = Shelley.TICKF BabbageEra -type instance EraRule "UPEC" BabbageEra = Shelley.ShelleyUPEC BabbageEra +type instance EraRule "UPEC" BabbageEra = Shelley.UPEC 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 3adfd20f2e7..66d47ebd6cb 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Ledger.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Ledger.hs @@ -10,15 +10,15 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Cardano.Ledger.Babbage.Rules.Ledger (BabbageLEDGER) where +module Cardano.Ledger.Babbage.Rules.Ledger (LEDGER) where import qualified Cardano.Ledger.Allegra.Rules as Allegra import qualified Cardano.Ledger.Alonzo.Rules as Alonzo import Cardano.Ledger.Babbage.Core -import Cardano.Ledger.Babbage.Era (BabbageEra, BabbageLEDGER) +import Cardano.Ledger.Babbage.Era (BabbageEra, LEDGER) import Cardano.Ledger.Babbage.Rules.Delegs () import Cardano.Ledger.Babbage.Rules.Utxo (BabbageUtxoPredFailure) -import Cardano.Ledger.Babbage.Rules.Utxow (BabbageUTXOW, BabbageUtxowPredFailure) +import Cardano.Ledger.Babbage.Rules.Utxow (BabbageUtxowPredFailure, UTXOW) import Cardano.Ledger.BaseTypes (ShelleyBase) import Cardano.Ledger.Shelley.LedgerState ( CertState, @@ -81,8 +81,8 @@ instance InjectRuleFailure "LEDGER" Shelley.ShelleyDelegPredFailure BabbageEra w instance ( AlonzoEraTx era , EraGov era - , Embed (EraRule "DELEGS" era) (BabbageLEDGER era) - , Embed (EraRule "UTXOW" era) (BabbageLEDGER era) + , Embed (EraRule "DELEGS" era) (LEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) , Environment (EraRule "UTXOW" era) ~ Shelley.UtxoEnv era , State (EraRule "UTXOW" era) ~ UTxOState era , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era @@ -91,21 +91,21 @@ instance , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) , AtMostEra "Babbage" era , EraCertState era - , EraRule "LEDGER" era ~ BabbageLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , EraRuleFailure "LEDGER" era ~ Shelley.ShelleyLedgerPredFailure era , InjectRuleFailure "LEDGER" Shelley.ShelleyLedgerPredFailure era ) => - STS (BabbageLEDGER era) + STS (LEDGER era) where - type State (BabbageLEDGER era) = LedgerState era - type Signal (BabbageLEDGER era) = StAnnTx TopTx era - type Environment (BabbageLEDGER era) = Shelley.LedgerEnv era - type BaseM (BabbageLEDGER era) = ShelleyBase - type PredicateFailure (BabbageLEDGER era) = Shelley.ShelleyLedgerPredFailure era - type Event (BabbageLEDGER era) = Shelley.ShelleyLedgerEvent era + type State (LEDGER era) = LedgerState era + type Signal (LEDGER era) = StAnnTx TopTx era + type Environment (LEDGER era) = Shelley.LedgerEnv era + type BaseM (LEDGER era) = ShelleyBase + type PredicateFailure (LEDGER era) = Shelley.ShelleyLedgerPredFailure era + type Event (LEDGER era) = Shelley.ShelleyLedgerEvent era initialRules = [] - transitionRules = [Alonzo.ledgerTransition @BabbageLEDGER] + transitionRules = [Alonzo.ledgerTransition @LEDGER] renderAssertionViolation = Shelley.renderDepositEqualsObligationViolation @@ -113,33 +113,33 @@ instance instance ( Era era - , STS (Shelley.ShelleyDELEGS era) + , STS (Shelley.DELEGS era) , PredicateFailure (EraRule "DELEGS" era) ~ Shelley.ShelleyDelegsPredFailure era , Event (EraRule "DELEGS" era) ~ Shelley.ShelleyDelegsEvent era ) => - Embed (Shelley.ShelleyDELEGS era) (BabbageLEDGER era) + Embed (Shelley.DELEGS era) (LEDGER era) where wrapFailed = Shelley.DelegsFailure wrapEvent = Shelley.DelegsEvent instance ( Era era - , STS (BabbageUTXOW era) + , STS (UTXOW era) , Event (EraRule "UTXOW" era) ~ Alonzo.AlonzoUtxowEvent era , PredicateFailure (EraRule "UTXOW" era) ~ BabbageUtxowPredFailure era ) => - Embed (BabbageUTXOW era) (BabbageLEDGER era) + Embed (UTXOW era) (LEDGER era) where wrapFailed = Shelley.UtxowFailure wrapEvent = Shelley.UtxowEvent instance ( Era era - , STS (BabbageLEDGER era) + , STS (LEDGER era) , PredicateFailure (EraRule "LEDGER" era) ~ Shelley.ShelleyLedgerPredFailure era , Event (EraRule "LEDGER" era) ~ Shelley.ShelleyLedgerEvent era ) => - Embed (BabbageLEDGER era) (Shelley.ShelleyLEDGERS era) + Embed (LEDGER era) (Shelley.LEDGERS era) where wrapFailed = Shelley.LedgerFailure wrapEvent = Shelley.LedgerEvent diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs index e02e117c278..7b0e1dd2465 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Babbage.Rules.Utxo ( - BabbageUTXO, + UTXO, BabbageUtxoPredFailure (..), babbageUtxoValidation, utxoTransition, @@ -35,9 +35,9 @@ import qualified Cardano.Ledger.Alonzo.Rules as Alonzo import Cardano.Ledger.Alonzo.TxWits (unRedeemersL) import Cardano.Ledger.Babbage.Collateral (collAdaBalance, collOuts) import Cardano.Ledger.Babbage.Core -import Cardano.Ledger.Babbage.Era (BabbageEra, BabbageUTXO) +import Cardano.Ledger.Babbage.Era (BabbageEra, UTXO) import Cardano.Ledger.Babbage.Rules.Ppup () -import Cardano.Ledger.Babbage.Rules.Utxos (BabbageUTXOS) +import Cardano.Ledger.Babbage.Rules.Utxos (UTXOS) import Cardano.Ledger.BaseTypes ( Mismatch (..), ProtVer (..), @@ -489,7 +489,7 @@ updateUTxOStateByTxValidity pp certState govState tx utxoState = } -------------------------------------------------------------------------------- --- BabbageUTXO STS +-- UTXO STS -------------------------------------------------------------------------------- instance @@ -502,26 +502,26 @@ instance , EraCertState era , EraStake era , GovState era ~ ShelleyGovState era - , EraRule "UTXO" era ~ BabbageUTXO era + , EraRule "UTXO" era ~ UTXO era , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era , InjectRuleFailure "UTXO" Allegra.AllegraUtxoPredFailure era , InjectRuleFailure "UTXO" Alonzo.AlonzoUtxoPredFailure era , InjectRuleFailure "UTXO" BabbageUtxoPredFailure era - , -- instructions for calling UTXOS from BabbageUTXO - Embed (EraRule "UTXOS" era) (BabbageUTXO era) + , -- instructions for calling UTXOS from UTXO + Embed (EraRule "UTXOS" era) (UTXO era) , Environment (EraRule "UTXOS" era) ~ Alonzo.UtxosEnv era , State (EraRule "UTXOS" era) ~ ShelleyGovState era , Signal (EraRule "UTXOS" era) ~ StAnnTx TopTx era , SafeToHash (TxWits era) ) => - STS (BabbageUTXO era) + STS (UTXO era) where - type State (BabbageUTXO era) = UTxOState era - type Signal (BabbageUTXO era) = StAnnTx TopTx era - type Environment (BabbageUTXO era) = Shelley.UtxoEnv era - type BaseM (BabbageUTXO era) = ShelleyBase - type PredicateFailure (BabbageUTXO era) = BabbageUtxoPredFailure era - type Event (BabbageUTXO era) = Alonzo.AlonzoUtxoEvent era + type State (UTXO era) = UTxOState era + type Signal (UTXO era) = StAnnTx TopTx era + type Environment (UTXO era) = Shelley.UtxoEnv era + type BaseM (UTXO era) = ShelleyBase + type PredicateFailure (UTXO era) = BabbageUtxoPredFailure era + type Event (UTXO era) = Alonzo.AlonzoUtxoEvent era initialRules = [] transitionRules = [utxoTransition @era] @@ -529,11 +529,11 @@ instance instance ( Era era - , STS (BabbageUTXOS era) + , STS (UTXOS era) , PredicateFailure (EraRule "UTXOS" era) ~ Alonzo.AlonzoUtxosPredFailure era - , Event (EraRule "UTXOS" era) ~ Event (BabbageUTXOS era) + , Event (EraRule "UTXOS" era) ~ Event (UTXOS era) ) => - Embed (BabbageUTXOS era) (BabbageUTXO era) + Embed (UTXOS era) (UTXO era) where wrapFailed = AlonzoInBabbageUtxoPredFailure . Alonzo.UtxosFailure wrapEvent = Alonzo.UtxosEvent diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs index f2f12550b9e..6a17c9fc81e 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxos.hs @@ -12,7 +12,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Babbage.Rules.Utxos ( - BabbageUTXOS, + UTXOS, utxosTransition, expectScriptsToPass, babbageEvalScriptsTxInvalid, @@ -26,7 +26,7 @@ import Cardano.Ledger.Alonzo.UTxO ( AlonzoScriptsNeeded, ) import Cardano.Ledger.Babbage.Core -import Cardano.Ledger.Babbage.Era (BabbageEra, BabbageUTXOS) +import Cardano.Ledger.Babbage.Era (BabbageEra, UTXOS) import Cardano.Ledger.Babbage.Rules.Ppup () import Cardano.Ledger.Babbage.State import Cardano.Ledger.BaseTypes (ShelleyBase, StrictMaybe) @@ -68,35 +68,35 @@ instance , ScriptsNeeded era ~ AlonzoScriptsNeeded era , EraGov era , GovState era ~ ShelleyGovState era - , Embed (EraRule "PPUP" era) (BabbageUTXOS era) + , Embed (EraRule "PPUP" era) (UTXOS era) , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) , State (EraRule "PPUP" era) ~ ShelleyGovState era - , Signal (BabbageUTXOS era) ~ StAnnTx TopTx era + , Signal (UTXOS era) ~ StAnnTx TopTx era , EncCBOR (EraRuleFailure "PPUP" era) , Eq (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) , InjectRuleFailure "UTXOS" Alonzo.AlonzoUtxosPredFailure era , InjectRuleEvent "UTXOS" Alonzo.AlonzoUtxosEvent era - , EraRule "UTXOS" era ~ BabbageUTXOS era + , EraRule "UTXOS" era ~ UTXOS era ) => - STS (BabbageUTXOS era) + STS (UTXOS era) where - type BaseM (BabbageUTXOS era) = ShelleyBase - type Environment (BabbageUTXOS era) = Alonzo.UtxosEnv era - type State (BabbageUTXOS era) = ShelleyGovState era - type Signal (BabbageUTXOS era) = StAnnTx TopTx era - type PredicateFailure (BabbageUTXOS era) = Alonzo.AlonzoUtxosPredFailure era - type Event (BabbageUTXOS era) = Alonzo.AlonzoUtxosEvent era + type BaseM (UTXOS era) = ShelleyBase + type Environment (UTXOS era) = Alonzo.UtxosEnv era + type State (UTXOS era) = ShelleyGovState era + type Signal (UTXOS era) = StAnnTx TopTx era + type PredicateFailure (UTXOS era) = Alonzo.AlonzoUtxosPredFailure era + type Event (UTXOS era) = Alonzo.AlonzoUtxosEvent era transitionRules = [utxosTransition] instance ( Era era - , STS (Shelley.ShelleyPPUP era) + , STS (Shelley.PPUP era) , EraRuleFailure "PPUP" era ~ Shelley.ShelleyPpupPredFailure era , EraRuleEvent "PPUP" era ~ Shelley.PpupEvent era ) => - Embed (Shelley.ShelleyPPUP era) (BabbageUTXOS era) + Embed (Shelley.PPUP era) (UTXOS era) where wrapFailed = Alonzo.UpdateFailure wrapEvent = Alonzo.AlonzoPpupToUtxosEvent @@ -109,13 +109,13 @@ utxosTransition :: , EraCertState era , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) - , Embed (EraRule "PPUP" era) (BabbageUTXOS era) + , Embed (EraRule "PPUP" era) (UTXOS era) , State (EraRule "PPUP" era) ~ ShelleyGovState era - , EraRule "UTXOS" era ~ BabbageUTXOS era + , EraRule "UTXOS" era ~ UTXOS era , InjectRuleFailure "UTXOS" Alonzo.AlonzoUtxosPredFailure era , InjectRuleEvent "UTXOS" Alonzo.AlonzoUtxosEvent era ) => - TransitionRule (BabbageUTXOS era) + TransitionRule (UTXOS era) utxosTransition = judgmentContext >>= \(TRC (_, pup, stAnnTx)) -> do let tx = stAnnTx ^. txStAnnTxG @@ -162,13 +162,13 @@ babbageEvalScriptsTxValid :: , EraCertState era , Environment (EraRule "PPUP" era) ~ Shelley.PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) - , Embed (EraRule "PPUP" era) (BabbageUTXOS era) + , Embed (EraRule "PPUP" era) (UTXOS era) , State (EraRule "PPUP" era) ~ ShelleyGovState era , InjectRuleFailure "UTXOS" Alonzo.AlonzoUtxosPredFailure era - , EraRule "UTXOS" era ~ BabbageUTXOS era + , EraRule "UTXOS" era ~ UTXOS era , InjectRuleEvent "UTXOS" Alonzo.AlonzoUtxosEvent era ) => - TransitionRule (BabbageUTXOS era) + TransitionRule (UTXOS era) babbageEvalScriptsTxValid = do TRC (Alonzo.UtxosEnv slot pp certState _utxo, pup, stAnnTx) <- judgmentContext diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs index 8477db17435..6f6c7a2e14b 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Babbage.Rules.Utxow ( - BabbageUTXOW, + UTXOW, BabbageUtxowPredFailure (..), babbageMissingScripts, validateFailedBabbageScripts, @@ -29,8 +29,8 @@ import qualified Cardano.Ledger.Alonzo.Rules as Alonzo import Cardano.Ledger.Alonzo.Scripts (validScript) import Cardano.Ledger.Alonzo.UTxO (AlonzoEraUTxO (..), AlonzoScriptsNeeded) import Cardano.Ledger.Babbage.Core -import Cardano.Ledger.Babbage.Era (BabbageEra, BabbageUTXOW) -import Cardano.Ledger.Babbage.Rules.Utxo (BabbageUTXO, BabbageUtxoPredFailure (..)) +import Cardano.Ledger.Babbage.Era (BabbageEra, UTXOW) +import Cardano.Ledger.Babbage.Rules.Utxo (BabbageUtxoPredFailure (..), UTXO) import Cardano.Ledger.Babbage.Tx (mkScriptIntegrity) import Cardano.Ledger.Babbage.UTxO (getReferenceScripts) import Cardano.Ledger.BaseTypes (Mismatch, Relation (..), ShelleyBase, quorum, strictMaybeToMaybe) @@ -389,12 +389,12 @@ instance , ShelleyEraTxBody era , ScriptsNeeded era ~ AlonzoScriptsNeeded era , BabbageEraTxBody era - , EraRule "UTXOW" era ~ BabbageUTXOW era + , EraRule "UTXOW" era ~ UTXOW era , InjectRuleFailure "UTXOW" Shelley.ShelleyUtxowPredFailure era , InjectRuleFailure "UTXOW" Alonzo.AlonzoUtxowPredFailure era , InjectRuleFailure "UTXOW" BabbageUtxowPredFailure era , -- Allow UTXOW to call UTXO - Embed (EraRule "UTXO" era) (BabbageUTXOW era) + Embed (EraRule "UTXO" era) (UTXOW era) , Environment (EraRule "UTXO" era) ~ Shelley.UtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era @@ -402,27 +402,27 @@ instance , Show (PredicateFailure (EraRule "UTXOS" era)) , EraCertState era ) => - STS (BabbageUTXOW era) + STS (UTXOW era) where - type State (BabbageUTXOW era) = UTxOState era - type Signal (BabbageUTXOW era) = StAnnTx TopTx era - type Environment (BabbageUTXOW era) = Shelley.UtxoEnv era - type BaseM (BabbageUTXOW era) = ShelleyBase - type PredicateFailure (BabbageUTXOW era) = BabbageUtxowPredFailure era - type Event (BabbageUTXOW era) = Alonzo.AlonzoUtxowEvent era + type State (UTXOW era) = UTxOState era + type Signal (UTXOW era) = StAnnTx TopTx era + type Environment (UTXOW era) = Shelley.UtxoEnv era + type BaseM (UTXOW era) = ShelleyBase + type PredicateFailure (UTXOW era) = BabbageUtxowPredFailure era + type Event (UTXOW era) = Alonzo.AlonzoUtxowEvent era transitionRules = [babbageUtxowMirTransition @era >> babbageUtxowTransition @era] initialRules = [] instance ( Era era - , STS (BabbageUTXO era) + , STS (UTXO era) , PredicateFailure (EraRule "UTXO" era) ~ BabbageUtxoPredFailure era , Event (EraRule "UTXO" era) ~ Alonzo.AlonzoUtxoEvent era - , BaseM (BabbageUTXOW era) ~ ShelleyBase - , PredicateFailure (BabbageUTXOW era) ~ BabbageUtxowPredFailure era - , Event (BabbageUTXOW era) ~ Alonzo.AlonzoUtxowEvent era + , BaseM (UTXOW era) ~ ShelleyBase + , PredicateFailure (UTXOW era) ~ BabbageUtxowPredFailure era + , Event (UTXOW era) ~ Alonzo.AlonzoUtxowEvent era ) => - Embed (BabbageUTXO era) (BabbageUTXOW era) + Embed (UTXO era) (UTXOW era) where wrapFailed = UtxoFailure wrapEvent = Alonzo.WrappedShelleyEraEvent . Shelley.UtxoEvent diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index f5b12384b78..61a0caa7bd4 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -2,6 +2,24 @@ ## 1.23.0.0 +* Rename rule types and deprecate the old names: + - `ConwayBBODY` -> `BBODY` + - `ConwayCERT` -> `CERT` + - `ConwayCERTS` -> `CERTS` + - `ConwayDELEG` -> `DELEG` + - `ConwayENACT` -> `ENACT` + - `ConwayEPOCH` -> `EPOCH` + - `ConwayGOV` -> `GOV` + - `ConwayGOVCERT` -> `GOVCERT` + - `ConwayHARDFORK` -> `HARDFORK` + - `ConwayLEDGER` -> `LEDGER` + - `ConwayMEMPOOL` -> `MEMPOOL` + - `ConwayNEWEPOCH` -> `NEWEPOCH` + - `ConwayRATIFY` -> `RATIFY` + - `ConwayTICKF` -> `TICKF` + - `ConwayUTXO` -> `UTXO` + - `ConwayUTXOS` -> `UTXOS` + - `ConwayUTXOW` -> `UTXOW` * Add `ToJSON` instance for `DefaultVote`. * Add `injectStakeCredentials`, `injectDRepsThenDelegs` to `Cardano.Ledger.Conway.Transition` * Add `ConwayExtraConfig` type and `cgExtraConfig` field to `ConwayGenesis` diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs index b44cc48a80a..3b31d4801d5 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs @@ -9,6 +9,29 @@ module Cardano.Ledger.Conway.Era ( ConwayEra, + BBODY, + CERT, + DELEG, + GOVCERT, + CERTS, + GOV, + HARDFORK, + MEMPOOL, + NEWEPOCH, + EPOCH, + ENACT, + UTXO, + UTXOS, + UTXOW, + TICKF, + LEDGER, + RATIFY, + hardforkConwayBootstrapPhase, + hardforkConwayDisallowUnelectedCommitteeFromVoting, + hardforkConwayDELEGIncorrectDepositsAndRefunds, + hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule, + + -- * Deprecated ConwayBBODY, ConwayCERT, ConwayDELEG, @@ -26,10 +49,6 @@ module Cardano.Ledger.Conway.Era ( ConwayTICKF, ConwayLEDGER, ConwayRATIFY, - hardforkConwayBootstrapPhase, - hardforkConwayDisallowUnelectedCommitteeFromVoting, - hardforkConwayDELEGIncorrectDepositsAndRefunds, - hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule, ) where import Cardano.Ledger.BaseTypes (ProtVer (pvMajor), natVersion) @@ -84,87 +103,155 @@ type instance EraRuleEvent "DELEGS" ConwayEra = VoidEraRule "DELEGS" ConwayEra -- Era Mapping ------------------------------------------------------------------------------- -data ConwayGOV era +data GOV era + +type ConwayGOV = GOV + +{-# DEPRECATED ConwayGOV "In favor of `GOV`" #-} + +type instance EraRule "GOV" ConwayEra = GOV ConwayEra + +data NEWEPOCH era + +type ConwayNEWEPOCH = NEWEPOCH + +{-# DEPRECATED ConwayNEWEPOCH "In favor of `NEWEPOCH`" #-} + +type instance EraRule "NEWEPOCH" ConwayEra = NEWEPOCH ConwayEra + +data EPOCH era + +type ConwayEPOCH = EPOCH + +{-# DEPRECATED ConwayEPOCH "In favor of `EPOCH`" #-} + +type instance EraRule "EPOCH" ConwayEra = EPOCH ConwayEra + +data ENACT era + +type ConwayENACT = ENACT + +{-# DEPRECATED ConwayENACT "In favor of `ENACT`" #-} + +type instance EraRule "ENACT" ConwayEra = ENACT ConwayEra + +data UTXOS era + +type ConwayUTXOS = UTXOS + +{-# DEPRECATED ConwayUTXOS "In favor of `UTXOS`" #-} + +type instance EraRule "UTXOS" ConwayEra = UTXOS ConwayEra + +data LEDGER era + +type ConwayLEDGER = LEDGER + +{-# DEPRECATED ConwayLEDGER "In favor of `LEDGER`" #-} + +type instance EraRule "LEDGER" ConwayEra = LEDGER ConwayEra + +data TICKF era + +type ConwayTICKF = TICKF + +{-# DEPRECATED ConwayTICKF "In favor of `TICKF`" #-} + +type instance EraRule "TICKF" ConwayEra = TICKF ConwayEra + +data RATIFY era + +type ConwayRATIFY = RATIFY + +{-# DEPRECATED ConwayRATIFY "In favor of `RATIFY`" #-} + +type instance EraRule "RATIFY" ConwayEra = RATIFY ConwayEra + +data CERTS era + +type ConwayCERTS = CERTS + +{-# DEPRECATED ConwayCERTS "In favor of `CERTS`" #-} -type instance EraRule "GOV" ConwayEra = ConwayGOV ConwayEra +type instance EraRule "CERTS" ConwayEra = CERTS ConwayEra -data ConwayNEWEPOCH era +data CERT era -type instance EraRule "NEWEPOCH" ConwayEra = ConwayNEWEPOCH ConwayEra +type ConwayCERT = CERT -data ConwayEPOCH era +{-# DEPRECATED ConwayCERT "In favor of `CERT`" #-} -type instance EraRule "EPOCH" ConwayEra = ConwayEPOCH ConwayEra +type instance EraRule "CERT" ConwayEra = CERT ConwayEra -data ConwayENACT era +data DELEG era -type instance EraRule "ENACT" ConwayEra = ConwayENACT ConwayEra +type ConwayDELEG = DELEG -data ConwayUTXOS era +{-# DEPRECATED ConwayDELEG "In favor of `DELEG`" #-} -type instance EraRule "UTXOS" ConwayEra = ConwayUTXOS ConwayEra +type instance EraRule "DELEG" ConwayEra = DELEG ConwayEra -data ConwayLEDGER era +data GOVCERT era -type instance EraRule "LEDGER" ConwayEra = ConwayLEDGER ConwayEra +type ConwayGOVCERT = GOVCERT -data ConwayTICKF era +{-# DEPRECATED ConwayGOVCERT "In favor of `GOVCERT`" #-} -type instance EraRule "TICKF" ConwayEra = ConwayTICKF ConwayEra +type instance EraRule "GOVCERT" ConwayEra = GOVCERT ConwayEra -data ConwayRATIFY era +data UTXOW era -type instance EraRule "RATIFY" ConwayEra = ConwayRATIFY ConwayEra +type ConwayUTXOW = UTXOW -data ConwayCERTS era +{-# DEPRECATED ConwayUTXOW "In favor of `UTXOW`" #-} -type instance EraRule "CERTS" ConwayEra = ConwayCERTS ConwayEra +type instance EraRule "UTXOW" ConwayEra = UTXOW ConwayEra -data ConwayCERT era +data UTXO era -type instance EraRule "CERT" ConwayEra = ConwayCERT ConwayEra +type ConwayUTXO = UTXO -data ConwayDELEG era +{-# DEPRECATED ConwayUTXO "In favor of `UTXO`" #-} -type instance EraRule "DELEG" ConwayEra = ConwayDELEG ConwayEra +type instance EraRule "UTXO" ConwayEra = UTXO ConwayEra -data ConwayGOVCERT era +data BBODY era -type instance EraRule "GOVCERT" ConwayEra = ConwayGOVCERT ConwayEra +type ConwayBBODY = BBODY -data ConwayUTXOW era +{-# DEPRECATED ConwayBBODY "In favor of `BBODY`" #-} -type instance EraRule "UTXOW" ConwayEra = ConwayUTXOW ConwayEra +type instance EraRule "BBODY" ConwayEra = BBODY ConwayEra -data ConwayUTXO era +data MEMPOOL era -type instance EraRule "UTXO" ConwayEra = ConwayUTXO ConwayEra +type ConwayMEMPOOL = MEMPOOL -data ConwayBBODY era +{-# DEPRECATED ConwayMEMPOOL "In favor of `MEMPOOL`" #-} -type instance EraRule "BBODY" ConwayEra = ConwayBBODY ConwayEra +type instance EraRule "MEMPOOL" ConwayEra = MEMPOOL ConwayEra -data ConwayMEMPOOL era +data HARDFORK era -type instance EraRule "MEMPOOL" ConwayEra = ConwayMEMPOOL ConwayEra +type ConwayHARDFORK = HARDFORK -data ConwayHARDFORK era +{-# DEPRECATED ConwayHARDFORK "In favor of `HARDFORK`" #-} -type instance EraRule "HARDFORK" ConwayEra = ConwayHARDFORK ConwayEra +type instance EraRule "HARDFORK" ConwayEra = HARDFORK ConwayEra -- Rules inherited from Shelley -type instance EraRule "LEDGERS" ConwayEra = API.ShelleyLEDGERS ConwayEra +type instance EraRule "LEDGERS" ConwayEra = API.LEDGERS ConwayEra -type instance EraRule "POOLREAP" ConwayEra = API.ShelleyPOOLREAP ConwayEra +type instance EraRule "POOLREAP" ConwayEra = API.POOLREAP ConwayEra -type instance EraRule "RUPD" ConwayEra = Shelley.ShelleyRUPD ConwayEra +type instance EraRule "RUPD" ConwayEra = Shelley.RUPD ConwayEra -type instance EraRule "SNAP" ConwayEra = Shelley.ShelleySNAP ConwayEra +type instance EraRule "SNAP" ConwayEra = Shelley.SNAP ConwayEra -type instance EraRule "TICK" ConwayEra = Shelley.ShelleyTICK ConwayEra +type instance EraRule "TICK" ConwayEra = Shelley.TICK ConwayEra -type instance EraRule "POOL" ConwayEra = Shelley.ShelleyPOOL ConwayEra +type instance EraRule "POOL" ConwayEra = Shelley.POOL ConwayEra -- | Bootstrap phase hardforkConwayBootstrapPhase :: ProtVer -> Bool diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/DRepPulser.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/DRepPulser.hs index c7d177997bb..b5a37754e82 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/DRepPulser.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/DRepPulser.hs @@ -65,7 +65,7 @@ import Cardano.Ledger.Binary.Coders ( ) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Compactible -import Cardano.Ledger.Conway.Era (ConwayRATIFY) +import Cardano.Ledger.Conway.Era (RATIFY) import Cardano.Ledger.Conway.Governance.Internal import Cardano.Ledger.Conway.Governance.Procedures (GovActionState) import Cardano.Ledger.Conway.State @@ -356,12 +356,12 @@ instance rnf poolps class - ( STS (ConwayRATIFY era) - , Signal (ConwayRATIFY era) ~ RatifySignal era - , BaseM (ConwayRATIFY era) ~ Reader Globals - , Environment (ConwayRATIFY era) ~ RatifyEnv era - , State (ConwayRATIFY era) ~ RatifyState era - , PredicateFailure (ConwayRATIFY era) ~ Void + ( STS (RATIFY era) + , Signal (RATIFY era) ~ RatifySignal era + , BaseM (RATIFY era) ~ Reader Globals + , Environment (RATIFY era) ~ RatifyEnv era + , State (RATIFY era) ~ RatifyState era + , PredicateFailure (RATIFY era) ~ Void ) => RunConwayRatify era where @@ -370,7 +370,7 @@ class runConwayRatify globals ratifyEnv ratifyState (RatifySignal ratifySig) = let ratifyResult = runReader - ( applySTS @(ConwayRATIFY era) $ + ( applySTS @(RATIFY era) $ TRC (ratifyEnv, ratifyState, RatifySignal $ reorderActions ratifySig) ) globals diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs index 56b8391b677..bbb4f2b8e0e 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Bbody.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Bbody ( - ConwayBBODY, + BBODY, ConwayBbodyPredFailure (..), alonzoToConwayBbodyPredFailure, shelleyToConwayBbodyPredFailure, @@ -51,7 +51,7 @@ import Cardano.Ledger.BaseTypes ( import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..)) import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), ( - STS (ConwayBBODY era) + STS (BBODY era) where - type State (ConwayBBODY era) = Shelley.ShelleyBbodyState era + type State (BBODY era) = Shelley.ShelleyBbodyState era - type Signal (ConwayBBODY era) = Shelley.BbodySignal era + type Signal (BBODY era) = Shelley.BbodySignal era - type Environment (ConwayBBODY era) = Shelley.BbodyEnv era + type Environment (BBODY era) = Shelley.BbodyEnv era - type BaseM (ConwayBBODY era) = ShelleyBase + type BaseM (BBODY era) = ShelleyBase - type PredicateFailure (ConwayBBODY era) = ConwayBbodyPredFailure era + type PredicateFailure (BBODY era) = ConwayBbodyPredFailure era - type Event (ConwayBBODY era) = Alonzo.AlonzoBbodyEvent era + type Event (BBODY era) = Alonzo.AlonzoBbodyEvent era initialRules = [] transitionRules = [conwayBbodyTransition @era >> Alonzo.alonzoBbodyTransition @era] @@ -321,7 +321,7 @@ instance , ledgers ~ EraRule "LEDGERS" era , STS ledgers ) => - Embed ledgers (ConwayBBODY era) + Embed ledgers (BBODY era) where wrapFailed = LedgersFailure wrapEvent = Alonzo.ShelleyInAlonzoEvent . Shelley.LedgersEvent diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs index 0a568850460..d5ad125d829 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Cert ( - ConwayCERT, + CERT, ConwayCertPredFailure (..), ConwayCertEvent (..), CertEnv (..), @@ -27,10 +27,10 @@ import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..)) import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Era ( - ConwayCERT, - ConwayDELEG, + CERT, ConwayEra, - ConwayGOVCERT, + DELEG, + GOVCERT, ) import Cardano.Ledger.Conway.Governance ( Committee, @@ -173,20 +173,20 @@ instance , Signal (EraRule "DELEG" era) ~ ConwayDelegCert , Signal (EraRule "POOL" era) ~ PoolCert , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert - , Embed (EraRule "DELEG" era) (ConwayCERT era) - , Embed (EraRule "POOL" era) (ConwayCERT era) - , Embed (EraRule "GOVCERT" era) (ConwayCERT era) + , Embed (EraRule "DELEG" era) (CERT era) + , Embed (EraRule "POOL" era) (CERT era) + , Embed (EraRule "GOVCERT" era) (CERT era) , TxCert era ~ ConwayTxCert era , EraCertState era ) => - STS (ConwayCERT era) + STS (CERT era) where - type State (ConwayCERT era) = CertState era - type Signal (ConwayCERT era) = TxCert era - type Environment (ConwayCERT era) = CertEnv era - type BaseM (ConwayCERT era) = ShelleyBase - type PredicateFailure (ConwayCERT era) = ConwayCertPredFailure era - type Event (ConwayCERT era) = ConwayCertEvent era + type State (CERT era) = CertState era + type Signal (CERT era) = TxCert era + type Environment (CERT era) = CertEnv era + type BaseM (CERT era) = ShelleyBase + type PredicateFailure (CERT era) = ConwayCertPredFailure era + type Event (CERT era) = ConwayCertEvent era transitionRules = [certTransition @era] @@ -201,13 +201,13 @@ certTransition :: , Signal (EraRule "DELEG" era) ~ ConwayDelegCert , Signal (EraRule "POOL" era) ~ PoolCert , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert - , Embed (EraRule "DELEG" era) (ConwayCERT era) - , Embed (EraRule "POOL" era) (ConwayCERT era) - , Embed (EraRule "GOVCERT" era) (ConwayCERT era) + , Embed (EraRule "DELEG" era) (CERT era) + , Embed (EraRule "POOL" era) (CERT era) + , Embed (EraRule "GOVCERT" era) (CERT era) , TxCert era ~ ConwayTxCert era , EraCertState era ) => - TransitionRule (ConwayCERT era) + TransitionRule (CERT era) certTransition = do TRC (CertEnv pp currentEpoch committee committeeProposals, certState, c) <- judgmentContext let @@ -225,33 +225,33 @@ certTransition = do instance ( Era era - , STS (ConwayDELEG era) + , STS (DELEG era) , PredicateFailure (EraRule "DELEG" era) ~ ConwayDelegPredFailure era ) => - Embed (ConwayDELEG era) (ConwayCERT era) + Embed (DELEG era) (CERT era) where wrapFailed = DelegFailure wrapEvent = absurd instance ( Era era - , STS (Shelley.ShelleyPOOL era) + , STS (Shelley.POOL era) , Event (EraRule "POOL" era) ~ Shelley.PoolEvent era , PredicateFailure (EraRule "POOL" era) ~ Shelley.ShelleyPoolPredFailure era - , PredicateFailure (Shelley.ShelleyPOOL era) ~ Shelley.ShelleyPoolPredFailure era - , BaseM (Shelley.ShelleyPOOL era) ~ ShelleyBase + , PredicateFailure (Shelley.POOL era) ~ Shelley.ShelleyPoolPredFailure era + , BaseM (Shelley.POOL era) ~ ShelleyBase ) => - Embed (Shelley.ShelleyPOOL era) (ConwayCERT era) + Embed (Shelley.POOL era) (CERT era) where wrapFailed = PoolFailure wrapEvent = PoolEvent instance ( Era era - , STS (ConwayGOVCERT era) + , STS (GOVCERT era) , PredicateFailure (EraRule "GOVCERT" era) ~ ConwayGovCertPredFailure era ) => - Embed (ConwayGOVCERT era) (ConwayCERT era) + Embed (GOVCERT era) (CERT era) where wrapFailed = GovCertFailure wrapEvent = absurd diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs index 7992d4e59de..1701fedbe0a 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Certs ( - ConwayCERTS, + CERTS, ConwayCertsPredFailure (..), ConwayCertsEvent (..), CertsEnv (..), @@ -47,8 +47,8 @@ import Cardano.Ledger.Binary.Coders ( ) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Era ( - ConwayCERT, - ConwayCERTS, + CERT, + CERTS, ConwayEra, hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule, ) @@ -184,19 +184,19 @@ instance , State (EraRule "CERT" era) ~ CertState era , Signal (EraRule "CERT" era) ~ TxCert era , Environment (EraRule "CERT" era) ~ CertEnv era - , Embed (EraRule "CERT" era) (ConwayCERTS era) + , Embed (EraRule "CERT" era) (CERTS era) , EraCertState era , ConwayEraCertState era , EraRuleFailure "CERT" era ~ PredicateFailure (EraRule "CERT" era) ) => - STS (ConwayCERTS era) + STS (CERTS era) where - type State (ConwayCERTS era) = CertState era - type Signal (ConwayCERTS era) = Seq (TxCert era) - type Environment (ConwayCERTS era) = CertsEnv era - type BaseM (ConwayCERTS era) = ShelleyBase - type PredicateFailure (ConwayCERTS era) = ConwayCertsPredFailure era - type Event (ConwayCERTS era) = ConwayCertsEvent era + type State (CERTS era) = CertState era + type Signal (CERTS era) = Seq (TxCert era) + type Environment (CERTS era) = CertsEnv era + type BaseM (CERTS era) = ShelleyBase + type PredicateFailure (CERTS era) = ConwayCertsPredFailure era + type Event (CERTS era) = ConwayCertsEvent era transitionRules = [conwayCertsTransition @era] @@ -206,12 +206,12 @@ conwayCertsTransition :: , ConwayEraTxBody era , ConwayEraCertState era , State (EraRule "CERT" era) ~ CertState era - , Embed (EraRule "CERT" era) (ConwayCERTS era) + , Embed (EraRule "CERT" era) (CERTS era) , Environment (EraRule "CERT" era) ~ CertEnv era , Signal (EraRule "CERT" era) ~ TxCert era , EraRuleFailure "CERT" era ~ PredicateFailure (EraRule "CERT" era) ) => - TransitionRule (ConwayCERTS era) + TransitionRule (CERTS era) conwayCertsTransition = do TRC ( env@(CertsEnv tx pp currentEpoch committee committeeProposals) @@ -241,7 +241,7 @@ conwayCertsTransition = do & certDStateL . accountsL %~ drainAccounts withdrawals gamma :|> txCert -> do certState' <- - trans @(ConwayCERTS era) $ TRC (env, certState, gamma) + trans @(CERTS era) $ TRC (env, certState, gamma) trans @(EraRule "CERT" era) $ TRC (CertEnv pp currentEpoch committee committeeProposals, certState', txCert) @@ -293,12 +293,12 @@ updateVotingDRepExpiries tx currentEpoch drepActivity certState = instance ( Era era - , STS (ConwayCERT era) + , STS (CERT era) , BaseM (EraRule "CERT" era) ~ ShelleyBase , Event (EraRule "CERT" era) ~ ConwayCertEvent era , PredicateFailure (EraRule "CERT" era) ~ ConwayCertPredFailure era ) => - Embed (ConwayCERT era) (ConwayCERTS era) + Embed (CERT era) (CERTS era) where wrapFailed = CertFailure wrapEvent = CertEvent diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index 0a0bde00aa8..19ab37b320f 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Deleg ( - ConwayDELEG, + DELEG, ConwayDelegPredFailure (..), ConwayDelegEnv (..), conwayDelegTransition, @@ -44,8 +44,8 @@ import Cardano.Ledger.Coin (Coin, compactCoinOrError) import Cardano.Ledger.Compactible (fromCompact) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Era ( - ConwayDELEG, ConwayEra, + DELEG, hardforkConwayBootstrapPhase, hardforkConwayDELEGIncorrectDepositsAndRefunds, ) @@ -160,17 +160,17 @@ instance , State (EraRule "DELEG" era) ~ CertState era , Signal (EraRule "DELEG" era) ~ ConwayDelegCert , Environment (EraRule "DELEG" era) ~ ConwayDelegEnv era - , EraRule "DELEG" era ~ ConwayDELEG era + , EraRule "DELEG" era ~ DELEG era , InjectRuleFailure "DELEG" ConwayDelegPredFailure era ) => - STS (ConwayDELEG era) + STS (DELEG era) where - type State (ConwayDELEG era) = CertState era - type Signal (ConwayDELEG era) = ConwayDelegCert - type Environment (ConwayDELEG era) = ConwayDelegEnv era - type BaseM (ConwayDELEG era) = ShelleyBase - type PredicateFailure (ConwayDELEG era) = ConwayDelegPredFailure era - type Event (ConwayDELEG era) = Void + type State (DELEG era) = CertState era + type Signal (DELEG era) = ConwayDelegCert + type Environment (DELEG era) = ConwayDelegEnv era + type BaseM (DELEG era) = ShelleyBase + type PredicateFailure (DELEG era) = ConwayDelegPredFailure era + type Event (DELEG era) = Void transitionRules = [conwayDelegTransition] diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Enact.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Enact.hs index 5a762718551..d49c6b433c3 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Enact.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Enact.hs @@ -10,7 +10,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Enact ( - ConwayENACT, + ENACT, EnactSignal (..), EnactState (..), ) where @@ -20,7 +20,7 @@ import Cardano.Ledger.BaseTypes import Cardano.Ledger.Binary (EncCBOR (..)) import Cardano.Ledger.Binary.Coders (Encode (..), encode, (!>)) import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayENACT, ConwayEra) +import Cardano.Ledger.Conway.Era (ConwayEra, ENACT) import Cardano.Ledger.Conway.Governance ( Committee (..), EnactState (..), @@ -70,17 +70,17 @@ instance EraPParams era => EncCBOR (EnactSignal era) where instance EraPParams era => NFData (EnactSignal era) -instance EraGov era => STS (ConwayENACT era) where - type Environment (ConwayENACT era) = () - type PredicateFailure (ConwayENACT era) = Void - type Signal (ConwayENACT era) = EnactSignal era - type State (ConwayENACT era) = EnactState era - type BaseM (ConwayENACT era) = ShelleyBase +instance EraGov era => STS (ENACT era) where + type Environment (ENACT era) = () + type PredicateFailure (ENACT era) = Void + type Signal (ENACT era) = EnactSignal era + type State (ENACT era) = EnactState era + type BaseM (ENACT era) = ShelleyBase initialRules = [] transitionRules = [enactmentTransition] -enactmentTransition :: forall era. EraPParams era => TransitionRule (ConwayENACT era) +enactmentTransition :: forall era. EraPParams era => TransitionRule (ENACT era) enactmentTransition = do TRC ((), st, EnactSignal govActionId act) <- judgmentContext diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Epoch.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Epoch.hs index 2eb88ff21e5..467cf1581ce 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Epoch.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Epoch.hs @@ -19,7 +19,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Epoch ( - ConwayEPOCH, + EPOCH, PredicateFailure, ConwayEpochEvent (..), ) where @@ -29,7 +29,7 @@ import Cardano.Ledger.BaseTypes (ProtVer, ShelleyBase) import Cardano.Ledger.Coin (Coin, compactCoinOrError) import Cardano.Ledger.Compactible (fromCompact) import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayEPOCH, ConwayEra, ConwayHARDFORK, ConwayRATIFY) +import Cardano.Ledger.Conway.Era (ConwayEra, EPOCH, HARDFORK, RATIFY) import Cardano.Ledger.Conway.Governance ( Committee, ConwayEraGov (..), @@ -146,34 +146,34 @@ instance , ConwayEraGov era , EraStake era , EraCertState era - , Embed (EraRule "SNAP" era) (ConwayEPOCH era) + , Embed (EraRule "SNAP" era) (EPOCH era) , Environment (EraRule "SNAP" era) ~ Shelley.SnapEnv era , State (EraRule "SNAP" era) ~ SnapShots , Signal (EraRule "SNAP" era) ~ () - , Embed (EraRule "POOLREAP" era) (ConwayEPOCH era) + , Embed (EraRule "POOLREAP" era) (EPOCH era) , Environment (EraRule "POOLREAP" era) ~ () , State (EraRule "POOLREAP" era) ~ Shelley.ShelleyPoolreapState era , Signal (EraRule "POOLREAP" era) ~ EpochNo - , Embed (EraRule "RATIFY" era) (ConwayEPOCH era) + , Embed (EraRule "RATIFY" era) (EPOCH era) , Environment (EraRule "RATIFY" era) ~ RatifyEnv era , GovState era ~ ConwayGovState era , State (EraRule "RATIFY" era) ~ RatifyState era , Signal (EraRule "RATIFY" era) ~ RatifySignal era - , Embed (EraRule "HARDFORK" era) (ConwayEPOCH era) + , Embed (EraRule "HARDFORK" era) (EPOCH era) , Environment (EraRule "HARDFORK" era) ~ () , State (EraRule "HARDFORK" era) ~ EpochState era , Signal (EraRule "HARDFORK" era) ~ ProtVer ) => - STS (ConwayEPOCH era) + STS (EPOCH era) where - type State (ConwayEPOCH era) = EpochState era - type Signal (ConwayEPOCH era) = EpochNo - type Environment (ConwayEPOCH era) = () - type BaseM (ConwayEPOCH era) = ShelleyBase + type State (EPOCH era) = EpochState era + type Signal (EPOCH era) = EpochNo + type Environment (EPOCH era) = () + type BaseM (EPOCH era) = ShelleyBase -- EPOCH rule can never fail - type PredicateFailure (ConwayEPOCH era) = Void - type Event (ConwayEPOCH era) = ConwayEpochEvent era + type PredicateFailure (EPOCH era) = Void + type Event (EPOCH era) = ConwayEpochEvent era transitionRules = [epochTransition] returnProposalDeposits :: @@ -249,23 +249,23 @@ epochTransition :: , Environment (EraRule "SNAP" era) ~ Shelley.SnapEnv era , State (EraRule "SNAP" era) ~ SnapShots , Signal (EraRule "SNAP" era) ~ () - , Embed (EraRule "SNAP" era) (ConwayEPOCH era) - , Embed (EraRule "POOLREAP" era) (ConwayEPOCH era) + , Embed (EraRule "SNAP" era) (EPOCH era) + , Embed (EraRule "POOLREAP" era) (EPOCH era) , Environment (EraRule "POOLREAP" era) ~ () , State (EraRule "POOLREAP" era) ~ Shelley.ShelleyPoolreapState era , Signal (EraRule "POOLREAP" era) ~ EpochNo - , Embed (EraRule "RATIFY" era) (ConwayEPOCH era) + , Embed (EraRule "RATIFY" era) (EPOCH era) , Environment (EraRule "RATIFY" era) ~ RatifyEnv era , State (EraRule "RATIFY" era) ~ RatifyState era , GovState era ~ ConwayGovState era , Signal (EraRule "RATIFY" era) ~ RatifySignal era , ConwayEraGov era - , Embed (EraRule "HARDFORK" era) (ConwayEPOCH era) + , Embed (EraRule "HARDFORK" era) (EPOCH era) , Environment (EraRule "HARDFORK" era) ~ () , State (EraRule "HARDFORK" era) ~ EpochState era , Signal (EraRule "HARDFORK" era) ~ ProtVer ) => - TransitionRule (ConwayEPOCH era) + TransitionRule (EPOCH era) epochTransition = do TRC ( () @@ -373,10 +373,10 @@ epochTransition = do instance ( Era era - , STS (Shelley.ShelleyPOOLREAP era) + , STS (Shelley.POOLREAP era) , Event (EraRule "POOLREAP" era) ~ Shelley.ShelleyPoolreapEvent era ) => - Embed (Shelley.ShelleyPOOLREAP era) (ConwayEPOCH era) + Embed (Shelley.POOLREAP era) (EPOCH era) where wrapFailed = \case {} wrapEvent = PoolReapEvent @@ -387,31 +387,31 @@ instance , EraCertState era , Event (EraRule "SNAP" era) ~ Shelley.SnapEvent era ) => - Embed (Shelley.ShelleySNAP era) (ConwayEPOCH era) + Embed (Shelley.SNAP era) (EPOCH era) where wrapFailed = \case {} wrapEvent = SnapEvent instance ( EraGov era - , PredicateFailure (ConwayRATIFY era) ~ Void - , STS (ConwayRATIFY era) - , BaseM (ConwayRATIFY era) ~ ShelleyBase - , Event (ConwayRATIFY era) ~ Void + , PredicateFailure (RATIFY era) ~ Void + , STS (RATIFY era) + , BaseM (RATIFY era) ~ ShelleyBase + , Event (RATIFY era) ~ Void ) => - Embed (ConwayRATIFY era) (ConwayEPOCH era) + Embed (RATIFY era) (EPOCH era) where wrapFailed = absurd wrapEvent = absurd instance ( EraGov era - , PredicateFailure (ConwayHARDFORK era) ~ Void - , STS (ConwayHARDFORK era) - , BaseM (ConwayHARDFORK era) ~ ShelleyBase + , PredicateFailure (HARDFORK era) ~ Void + , STS (HARDFORK era) + , BaseM (HARDFORK era) ~ ShelleyBase , Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era ) => - Embed (ConwayHARDFORK era) (ConwayEPOCH era) + Embed (HARDFORK era) (EPOCH era) where wrapFailed = absurd wrapEvent = HardForkEvent diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs index 057f5f19cc3..512bbd90ea2 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs @@ -22,7 +22,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Gov ( - ConwayGOV, + GOV, GovEnv (..), GovSignal (..), ConwayGovEvent (..), @@ -66,7 +66,7 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Core (ppGovActionDepositL, ppGovActionLifetimeL) import Cardano.Ledger.Conway.Era ( ConwayEra, - ConwayGOV, + GOV, hardforkConwayBootstrapPhase, hardforkConwayDisallowUnelectedCommitteeFromVoting, ) @@ -336,18 +336,18 @@ instance , ConwayEraTxCert era , ConwayEraPParams era , ConwayEraGov era - , EraRule "GOV" era ~ ConwayGOV era + , EraRule "GOV" era ~ GOV era , InjectRuleFailure "GOV" ConwayGovPredFailure era , InjectRuleEvent "GOV" ConwayGovEvent era ) => - STS (ConwayGOV era) + STS (GOV era) where - type State (ConwayGOV era) = Proposals era - type Signal (ConwayGOV era) = GovSignal era - type Environment (ConwayGOV era) = GovEnv era - type BaseM (ConwayGOV era) = ShelleyBase - type PredicateFailure (ConwayGOV era) = ConwayGovPredFailure era - type Event (ConwayGOV era) = ConwayGovEvent era + type State (GOV era) = Proposals era + type Signal (GOV era) = GovSignal era + type Environment (GOV era) = GovEnv era + type BaseM (GOV era) = ShelleyBase + type PredicateFailure (GOV era) = ConwayGovPredFailure era + type Event (GOV era) = ConwayGovEvent era initialRules = [] diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs index 9e56f906095..99ac21b7b0f 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.GovCert ( - ConwayGOVCERT, + GOVCERT, ConwayGovCertPredFailure (..), ConwayGovCertEnv (..), computeDRepExpiry, @@ -40,7 +40,7 @@ import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Compactible (Compactible (..)) import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOVCERT, hardforkConwayBootstrapPhase) +import Cardano.Ledger.Conway.Era (ConwayEra, GOVCERT, hardforkConwayBootstrapPhase) import Cardano.Ledger.Conway.Governance ( Committee (..), GovAction (..), @@ -150,20 +150,20 @@ instance , State (EraRule "GOVCERT" era) ~ CertState era , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert , Environment (EraRule "GOVCERT" era) ~ ConwayGovCertEnv era - , EraRule "GOVCERT" era ~ ConwayGOVCERT era + , EraRule "GOVCERT" era ~ GOVCERT era , InjectRuleFailure "GOVCERT" ConwayGovCertPredFailure era , Eq (PredicateFailure (EraRule "GOVCERT" era)) , Show (PredicateFailure (EraRule "GOVCERT" era)) , ConwayEraCertState era ) => - STS (ConwayGOVCERT era) + STS (GOVCERT era) where - type State (ConwayGOVCERT era) = CertState era - type Signal (ConwayGOVCERT era) = ConwayGovCert - type Environment (ConwayGOVCERT era) = ConwayGovCertEnv era - type BaseM (ConwayGOVCERT era) = ShelleyBase - type PredicateFailure (ConwayGOVCERT era) = ConwayGovCertPredFailure era - type Event (ConwayGOVCERT era) = Void + type State (GOVCERT era) = CertState era + type Signal (GOVCERT era) = ConwayGovCert + type Environment (GOVCERT era) = ConwayGovCertEnv era + type BaseM (GOVCERT era) = ShelleyBase + type PredicateFailure (GOVCERT era) = ConwayGovCertPredFailure era + type Event (GOVCERT era) = Void transitionRules = [conwayGovCertTransition] diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/HardFork.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/HardFork.hs index a51d4cd19ba..6575e32ed98 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/HardFork.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/HardFork.hs @@ -13,13 +13,13 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.HardFork ( - ConwayHARDFORK, + HARDFORK, ConwayHardForkEvent (..), ) where import Cardano.Ledger.BaseTypes import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayEra, ConwayHARDFORK) +import Cardano.Ledger.Conway.Era (ConwayEra, HARDFORK) import Cardano.Ledger.Conway.State import Cardano.Ledger.Shelley.LedgerState import Control.DeepSeq (NFData) @@ -54,19 +54,19 @@ type instance EraRuleEvent "HARDFORK" ConwayEra = ConwayHardForkEvent ConwayEra instance (EraGov era, EraStake era, EraCertState era, ConwayEraCertState era) => - STS (ConwayHARDFORK era) + STS (HARDFORK era) where - type State (ConwayHARDFORK era) = EpochState era - type Signal (ConwayHARDFORK era) = ProtVer - type Environment (ConwayHARDFORK era) = () - type BaseM (ConwayHARDFORK era) = ShelleyBase - type PredicateFailure (ConwayHARDFORK era) = Void - type Event (ConwayHARDFORK era) = ConwayHardForkEvent era + type State (HARDFORK era) = EpochState era + type Signal (HARDFORK era) = ProtVer + type Environment (HARDFORK era) = () + type BaseM (HARDFORK era) = ShelleyBase + type PredicateFailure (HARDFORK era) = Void + type Event (HARDFORK era) = ConwayHardForkEvent era transitionRules = [hardforkTransition @era] hardforkTransition :: - ConwayEraCertState era => TransitionRule (ConwayHARDFORK era) + ConwayEraCertState era => TransitionRule (HARDFORK era) hardforkTransition = do TRC (_, epochState, newPv) <- judgmentContext diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs index 757df277a6b..43d8731c164 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Ledger ( - ConwayLEDGER, + LEDGER, ConwayLedgerPredFailure (..), ConwayLedgerEvent (..), shelleyToConwayLedgerPredFailure, @@ -48,11 +48,11 @@ import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Era ( - ConwayCERTS, + CERTS, ConwayEra, - ConwayGOV, - ConwayLEDGER, - ConwayUTXOW, + GOV, + LEDGER, + UTXOW, hardforkConwayBootstrapPhase, hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule, ) @@ -284,9 +284,9 @@ instance , ConwayEraTxBody era , ConwayEraGov era , GovState era ~ ConwayGovState era - , Embed (EraRule "UTXOW" era) (ConwayLEDGER era) - , Embed (EraRule "GOV" era) (ConwayLEDGER era) - , Embed (EraRule "CERTS" era) (ConwayLEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) + , Embed (EraRule "GOV" era) (LEDGER era) + , Embed (EraRule "CERTS" era) (LEDGER era) , State (EraRule "UTXOW" era) ~ UTxOState era , State (EraRule "CERTS" era) ~ CertState era , State (EraRule "GOV" era) ~ Proposals era @@ -297,25 +297,25 @@ instance , Signal (EraRule "CERTS" era) ~ Seq (TxCert era) , Signal (EraRule "GOV" era) ~ GovSignal era , ConwayEraCertState era - , EraRule "LEDGER" era ~ ConwayLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , InjectRuleFailure "LEDGER" Shelley.ShelleyLedgerPredFailure era , InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era ) => - STS (ConwayLEDGER era) + STS (LEDGER era) where - type State (ConwayLEDGER era) = LedgerState era - type Signal (ConwayLEDGER era) = StAnnTx TopTx era - type Environment (ConwayLEDGER era) = Shelley.LedgerEnv era - type BaseM (ConwayLEDGER era) = ShelleyBase - type PredicateFailure (ConwayLEDGER era) = ConwayLedgerPredFailure era - type Event (ConwayLEDGER era) = ConwayLedgerEvent era + type State (LEDGER era) = LedgerState era + type Signal (LEDGER era) = StAnnTx TopTx era + type Environment (LEDGER era) = Shelley.LedgerEnv era + type BaseM (LEDGER era) = ShelleyBase + type PredicateFailure (LEDGER era) = ConwayLedgerPredFailure era + type Event (LEDGER era) = ConwayLedgerEvent era initialRules = [] - transitionRules = [conwayLedgerTransition @ConwayLEDGER] + transitionRules = [conwayLedgerTransition @LEDGER] renderAssertionViolation = Shelley.renderDepositEqualsObligationViolation - assertions = Shelley.shelleyLedgerAssertions @era @ConwayLEDGER + assertions = Shelley.shelleyLedgerAssertions @era @LEDGER conwayLedgerTransitionTRC :: forall (someLEDGER :: Type -> Type) era. @@ -522,7 +522,7 @@ instance ( AlonzoEraTx era , EraUTxO era , BabbageEraTxBody era - , Embed (EraRule "UTXO" era) (ConwayUTXOW era) + , Embed (EraRule "UTXO" era) (UTXOW era) , State (EraRule "UTXO" era) ~ UTxOState era , Environment (EraRule "UTXO" era) ~ Shelley.UtxoEnv era , Script era ~ AlonzoScript era @@ -531,11 +531,11 @@ instance , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era , PredicateFailure (EraRule "UTXOW" era) ~ ConwayUtxowPredFailure era , Event (EraRule "UTXOW" era) ~ Alonzo.AlonzoUtxowEvent era - , STS (ConwayUTXOW era) - , PredicateFailure (ConwayUTXOW era) ~ ConwayUtxowPredFailure era - , Event (ConwayUTXOW era) ~ Alonzo.AlonzoUtxowEvent era + , STS (UTXOW era) + , PredicateFailure (UTXOW era) ~ ConwayUtxowPredFailure era + , Event (UTXOW era) ~ Alonzo.AlonzoUtxowEvent era ) => - Embed (ConwayUTXOW era) (ConwayLEDGER era) + Embed (UTXOW era) (LEDGER era) where wrapFailed = ConwayUtxowFailure wrapEvent = UtxowEvent @@ -545,24 +545,24 @@ instance , ConwayEraTxBody era , ConwayEraPParams era , ConwayEraGov era - , Embed (EraRule "CERT" era) (ConwayCERTS era) + , Embed (EraRule "CERT" era) (CERTS era) , State (EraRule "CERT" era) ~ CertState era , Environment (EraRule "CERT" era) ~ CertEnv era , Signal (EraRule "CERT" era) ~ TxCert era , PredicateFailure (EraRule "CERT" era) ~ ConwayCertPredFailure era , EraRuleFailure "CERT" era ~ ConwayCertPredFailure era - , EraRule "CERTS" era ~ ConwayCERTS era + , EraRule "CERTS" era ~ CERTS era , ConwayEraCertState era ) => - Embed (ConwayCERTS era) (ConwayLEDGER era) + Embed (CERTS era) (LEDGER era) where wrapFailed = ConwayCertsFailure wrapEvent = CertsEvent instance - ( Embed (EraRule "UTXOW" era) (ConwayLEDGER era) - , Embed (EraRule "CERTS" era) (ConwayLEDGER era) - , Embed (EraRule "GOV" era) (ConwayLEDGER era) + ( Embed (EraRule "UTXOW" era) (LEDGER era) + , Embed (EraRule "CERTS" era) (LEDGER era) + , Embed (EraRule "GOV" era) (LEDGER era) , ConwayEraGov era , AlonzoEraTx era , ConwayEraTxBody era @@ -574,14 +574,14 @@ instance , Signal (EraRule "CERTS" era) ~ Seq (TxCert era) , State (EraRule "UTXOW" era) ~ UTxOState era , State (EraRule "CERTS" era) ~ CertState era - , EraRule "GOV" era ~ ConwayGOV era + , EraRule "GOV" era ~ GOV era , ConwayEraCertState era - , EraRule "LEDGER" era ~ ConwayLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , InjectRuleFailure "LEDGER" Shelley.ShelleyLedgerPredFailure era , InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era , InjectRuleFailure "LEDGER" ConwayCertsPredFailure era ) => - Embed (ConwayLEDGER era) (Shelley.ShelleyLEDGERS era) + Embed (LEDGER era) (Shelley.LEDGERS era) where wrapFailed = Shelley.LedgerFailure wrapEvent = Shelley.LedgerEvent @@ -591,11 +591,11 @@ instance , ConwayEraTxCert era , ConwayEraPParams era , ConwayEraGov era - , EraRule "GOV" era ~ ConwayGOV era + , EraRule "GOV" era ~ GOV era , InjectRuleFailure "GOV" ConwayGovPredFailure era , InjectRuleEvent "GOV" ConwayGovEvent era ) => - Embed (ConwayGOV era) (ConwayLEDGER era) + Embed (GOV era) (LEDGER era) where wrapFailed = ConwayGovFailure wrapEvent = GovEvent diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs index 9ba6412a567..804eb7582c7 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs @@ -13,14 +13,14 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Mempool ( - ConwayMEMPOOL, + MEMPOOL, ) where import Cardano.Ledger.BaseTypes (ShelleyBase) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Era ( - ConwayLEDGER, - ConwayMEMPOOL, + LEDGER, + MEMPOOL, hardforkConwayDisallowUnelectedCommitteeFromVoting, ) import Cardano.Ledger.Conway.Governance ( @@ -66,7 +66,7 @@ instance , ConwayEraCertState era , EraStake era , EraCertState era - , Embed (EraRule "LEDGER" era) (ConwayMEMPOOL era) + , Embed (EraRule "LEDGER" era) (MEMPOOL era) , State (EraRule "LEDGER" era) ~ LedgerState era , Eq (PredicateFailure (EraRule "CERTS" era)) , Eq (PredicateFailure (EraRule "GOV" era)) @@ -77,14 +77,14 @@ instance , Environment (EraRule "LEDGER" era) ~ Shelley.LedgerEnv era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era ) => - STS (ConwayMEMPOOL era) + STS (MEMPOOL era) where - type State (ConwayMEMPOOL era) = LedgerState era - type Signal (ConwayMEMPOOL era) = StAnnTx TopTx era - type Environment (ConwayMEMPOOL era) = Shelley.LedgerEnv era - type BaseM (ConwayMEMPOOL era) = ShelleyBase - type PredicateFailure (ConwayMEMPOOL era) = ConwayLedgerPredFailure era - type Event (ConwayMEMPOOL era) = ConwayLedgerEvent era + type State (MEMPOOL era) = LedgerState era + type Signal (MEMPOOL era) = StAnnTx TopTx era + type Environment (MEMPOOL era) = Shelley.LedgerEnv era + type BaseM (MEMPOOL era) = ShelleyBase + type PredicateFailure (MEMPOOL era) = ConwayLedgerPredFailure era + type Event (MEMPOOL era) = ConwayLedgerEvent era transitionRules = [mempoolTransition @era] @@ -94,12 +94,12 @@ mempoolTransition :: , ConwayEraTxBody era , ConwayEraGov era , ConwayEraCertState era - , Embed (EraRule "LEDGER" era) (ConwayMEMPOOL era) + , Embed (EraRule "LEDGER" era) (MEMPOOL era) , State (EraRule "LEDGER" era) ~ LedgerState era , Environment (EraRule "LEDGER" era) ~ Shelley.LedgerEnv era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era ) => - TransitionRule (ConwayMEMPOOL era) + TransitionRule (MEMPOOL era) mempoolTransition = do TRC trc@(ledgerEnv, ledgerState, stAnnTx) <- judgmentContext @@ -144,9 +144,9 @@ instance , BaseM (EraRule "CERTS" era) ~ ShelleyBase , BaseM (EraRule "GOV" era) ~ ShelleyBase , BaseM (EraRule "UTXOW" era) ~ ShelleyBase - , Embed (EraRule "CERTS" era) (ConwayLEDGER era) - , Embed (EraRule "GOV" era) (ConwayLEDGER era) - , Embed (EraRule "UTXOW" era) (ConwayLEDGER era) + , Embed (EraRule "CERTS" era) (LEDGER era) + , Embed (EraRule "GOV" era) (LEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) , Environment (EraRule "CERTS" era) ~ CertsEnv era , Environment (EraRule "GOV" era) ~ GovEnv era , Environment (EraRule "UTXOW" era) ~ Shelley.UtxoEnv era @@ -161,12 +161,12 @@ instance , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era , ConwayEraCertState era - , EraRule "LEDGER" era ~ ConwayLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , EraRuleFailure "LEDGER" era ~ ConwayLedgerPredFailure era , InjectRuleFailure "LEDGER" Shelley.ShelleyLedgerPredFailure era , InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era ) => - Embed (ConwayLEDGER era) (ConwayMEMPOOL era) + Embed (LEDGER era) (MEMPOOL era) where wrapFailed = id wrapEvent = id diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs index c384b7c893c..c0ff7015e35 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.NewEpoch ( - ConwayNEWEPOCH, + NEWEPOCH, ConwayNewEpochEvent (..), ) where @@ -27,7 +27,7 @@ import Cardano.Ledger.BaseTypes ( ) import Cardano.Ledger.Coin (toDeltaCoin) import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayEPOCH, ConwayEra, ConwayNEWEPOCH) +import Cardano.Ledger.Conway.Era (ConwayEra, EPOCH, NEWEPOCH) import Cardano.Ledger.Conway.Governance ( ConwayEraGov, ConwayGovState, @@ -91,7 +91,7 @@ instance , ConwayEraGov era , EraStake era , EraCertState era - , Embed (EraRule "EPOCH" era) (ConwayNEWEPOCH era) + , Embed (EraRule "EPOCH" era) (NEWEPOCH era) , Event (EraRule "RUPD" era) ~ Shelley.RupdEvent , Environment (EraRule "EPOCH" era) ~ () , State (EraRule "EPOCH" era) ~ EpochState era @@ -104,17 +104,17 @@ instance , GovState era ~ ConwayGovState era , Eq (PredicateFailure (EraRule "RATIFY" era)) , Show (PredicateFailure (EraRule "RATIFY" era)) - , Eq (PredicateFailure (ConwayNEWEPOCH era)) - , Show (PredicateFailure (ConwayNEWEPOCH era)) + , Eq (PredicateFailure (NEWEPOCH era)) + , Show (PredicateFailure (NEWEPOCH era)) ) => - STS (ConwayNEWEPOCH era) + STS (NEWEPOCH era) where - type State (ConwayNEWEPOCH era) = NewEpochState era - type Signal (ConwayNEWEPOCH era) = EpochNo - type Environment (ConwayNEWEPOCH era) = () - type BaseM (ConwayNEWEPOCH era) = ShelleyBase - type PredicateFailure (ConwayNEWEPOCH era) = Void - type Event (ConwayNEWEPOCH era) = ConwayNewEpochEvent era + type State (NEWEPOCH era) = NewEpochState era + type Signal (NEWEPOCH era) = EpochNo + type Environment (NEWEPOCH era) = () + type BaseM (NEWEPOCH era) = ShelleyBase + type PredicateFailure (NEWEPOCH era) = Void + type Event (NEWEPOCH era) = ConwayNewEpochEvent era initialRules = [ pure $ @@ -135,7 +135,7 @@ newEpochTransition :: ( EraTxOut era , ConwayEraGov era , EraCertState era - , Embed (EraRule "EPOCH" era) (ConwayNEWEPOCH era) + , Embed (EraRule "EPOCH" era) (NEWEPOCH era) , Environment (EraRule "EPOCH" era) ~ () , State (EraRule "EPOCH" era) ~ EpochState era , Signal (EraRule "EPOCH" era) ~ EpochNo @@ -147,10 +147,10 @@ newEpochTransition :: , GovState era ~ ConwayGovState era , Eq (PredicateFailure (EraRule "RATIFY" era)) , Show (PredicateFailure (EraRule "RATIFY" era)) - , Eq (PredicateFailure (ConwayNEWEPOCH era)) - , Show (PredicateFailure (ConwayNEWEPOCH era)) + , Eq (PredicateFailure (NEWEPOCH era)) + , Show (PredicateFailure (NEWEPOCH era)) ) => - TransitionRule (ConwayNEWEPOCH era) + TransitionRule (NEWEPOCH era) newEpochTransition = do TRC ( _ @@ -176,7 +176,7 @@ newEpochTransition = do let adaPots = totalAdaPotsES es2 tellEvent $ TotalAdaPotsEvent adaPots let pd' = ssStakeMarkPoolDistr (esSnapshots es0) - -- See `ShelleyNEWEPOCH` for details on the implementation + -- See `NEWEPOCH` for details on the implementation pure $ nes { nesEL = eNo @@ -191,7 +191,7 @@ newEpochTransition = do tellReward :: Event (EraRule "RUPD" era) ~ Shelley.RupdEvent => ConwayNewEpochEvent era -> - Rule (ConwayNEWEPOCH era) rtype () + Rule (NEWEPOCH era) rtype () tellReward (DeltaRewardEvent (Shelley.RupdEvent _ m)) | Map.null m = pure () tellReward x = tellEvent x @@ -200,7 +200,7 @@ updateRewards :: EpochState era -> EpochNo -> RewardUpdate -> - Rule (ConwayNEWEPOCH era) 'Transition (EpochState era) + Rule (NEWEPOCH era) 'Transition (EpochState era) updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do let totRs = sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_ in assert (Val.isZero (dt <> dr <> toDeltaCoin totRs <> df)) (pure ()) @@ -212,20 +212,20 @@ updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do pure es' instance - ( STS (ConwayNEWEPOCH era) + ( STS (NEWEPOCH era) , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era - , PredicateFailure (EraRule "NEWEPOCH" era) ~ PredicateFailure (ConwayNEWEPOCH era) + , PredicateFailure (EraRule "NEWEPOCH" era) ~ PredicateFailure (NEWEPOCH era) ) => - Embed (ConwayNEWEPOCH era) (Shelley.ShelleyTICK era) + Embed (NEWEPOCH era) (Shelley.TICK era) where wrapFailed = \case {} wrapEvent = Shelley.TickNewEpochEvent instance - ( STS (ConwayEPOCH era) + ( STS (EPOCH era) , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era ) => - Embed (ConwayEPOCH era) (ConwayNEWEPOCH era) + Embed (EPOCH era) (NEWEPOCH era) where wrapFailed = \case {} wrapEvent = EpochEvent diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs index 059b3b94c58..450b5bd3b95 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs @@ -13,7 +13,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Ratify ( - ConwayRATIFY, + RATIFY, RatifyState (..), committeeAccepted, committeeAcceptedRatio, @@ -39,7 +39,7 @@ import Cardano.Ledger.BaseTypes ( ) import Cardano.Ledger.Coin (Coin (..), CompactForm (..)) import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayENACT, ConwayRATIFY, hardforkConwayBootstrapPhase) +import Cardano.Ledger.Conway.Era (ENACT, RATIFY, hardforkConwayBootstrapPhase) import Cardano.Ledger.Conway.Governance ( Committee (..), DefaultVote (..), @@ -90,18 +90,18 @@ import Lens.Micro instance ( ConwayEraPParams era , ConwayEraAccounts era - , Embed (EraRule "ENACT" era) (ConwayRATIFY era) + , Embed (EraRule "ENACT" era) (RATIFY era) , State (EraRule "ENACT" era) ~ EnactState era , Environment (EraRule "ENACT" era) ~ () , Signal (EraRule "ENACT" era) ~ EnactSignal era ) => - STS (ConwayRATIFY era) + STS (RATIFY era) where - type Environment (ConwayRATIFY era) = RatifyEnv era - type PredicateFailure (ConwayRATIFY era) = Void - type Signal (ConwayRATIFY era) = RatifySignal era - type State (ConwayRATIFY era) = RatifyState era - type BaseM (ConwayRATIFY era) = ShelleyBase + type Environment (RATIFY era) = RatifyEnv era + type PredicateFailure (RATIFY era) = Void + type Signal (RATIFY era) = RatifySignal era + type State (RATIFY era) = RatifyState era + type BaseM (RATIFY era) = ShelleyBase initialRules = [] transitionRules = [ratifyTransition] @@ -307,14 +307,14 @@ acceptedByEveryone env st gas = ratifyTransition :: forall era. - ( Embed (EraRule "ENACT" era) (ConwayRATIFY era) + ( Embed (EraRule "ENACT" era) (RATIFY era) , State (EraRule "ENACT" era) ~ EnactState era , Environment (EraRule "ENACT" era) ~ () , Signal (EraRule "ENACT" era) ~ EnactSignal era , ConwayEraPParams era , ConwayEraAccounts era ) => - TransitionRule (ConwayRATIFY era) + TransitionRule (RATIFY era) ratifyTransition = do TRC ( env@RatifyEnv {reCurrentEpoch} @@ -349,10 +349,10 @@ ratifyTransition = do & rsEnactStateL .~ newEnactState & rsDelayedL .~ delayingAction govAction & rsEnactedL %~ (Seq.:|> gas) - trans @(ConwayRATIFY era) $ TRC (env, st', RatifySignal sigs) + trans @(RATIFY era) $ TRC (env, st', RatifySignal sigs) else do -- This action hasn't been ratified yet. Process the remaining actions. - st' <- trans @(ConwayRATIFY era) $ TRC (env, st, RatifySignal sigs) + st' <- trans @(RATIFY era) $ TRC (env, st, RatifySignal sigs) -- Finally, filter out actions that have expired. if gasExpiresAfter < reCurrentEpoch then pure $ st' & rsExpiredL %~ Set.insert gasId @@ -380,6 +380,6 @@ validCommitteeTerm govAction pp currentEpoch = committeeMaxTermLength = pp ^. ppCommitteeMaxTermLengthL withinMaxTermLength = all (<= addEpochInterval currentEpoch committeeMaxTermLength) -instance EraGov era => Embed (ConwayENACT era) (ConwayRATIFY era) where +instance EraGov era => Embed (ENACT era) (RATIFY era) where wrapFailed = absurd wrapEvent = absurd diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Tickf.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Tickf.hs index 9450da602e5..b6aaceb6bb3 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Tickf.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Tickf.hs @@ -3,7 +3,7 @@ -- | Like TICK, called only by consensus. But, ticks ledger state to a __future__ slot. module Cardano.Ledger.Conway.Rules.Tickf ( - ConwayTICKF, + TICKF, ConwayTickfEvent, ) where @@ -21,14 +21,14 @@ data ConwayTickfEvent era instance EraGov era => - STS (ConwayTICKF era) + STS (TICKF era) where - type State (ConwayTICKF era) = NewEpochState era - type Signal (ConwayTICKF era) = SlotNo - type Environment (ConwayTICKF era) = () - type BaseM (ConwayTICKF era) = ShelleyBase - type PredicateFailure (ConwayTICKF era) = Void - type Event (ConwayTICKF era) = ConwayTickfEvent era + type State (TICKF era) = NewEpochState era + type Signal (TICKF era) = SlotNo + type Environment (TICKF era) = () + type BaseM (TICKF era) = ShelleyBase + type PredicateFailure (TICKF era) = Void + type Event (TICKF era) = ConwayTickfEvent era initialRules = [] transitionRules = pure $ do diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs index 00956430927..85684d3acb7 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxo.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Utxo ( - ConwayUTXO, + UTXO, allegraToConwayUtxoPredFailure, babbageToConwayUtxoPredFailure, alonzoToConwayUtxoPredFailure, @@ -48,7 +48,7 @@ import Cardano.Ledger.Binary.Coders ( ) import Cardano.Ledger.Coin (Coin, DeltaCoin) import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayEra, ConwayUTXO, ConwayUTXOS) +import Cardano.Ledger.Conway.Era (ConwayEra, UTXO, UTXOS) import Cardano.Ledger.Conway.Rules.Utxos ( ConwayUtxosPredFailure (..), ) @@ -245,7 +245,7 @@ conwayUtxoTransition = do (updateTreasuryDonation tx utxos) -------------------------------------------------------------------------------- --- ConwayUTXO STS +-- UTXO STS -------------------------------------------------------------------------------- instance @@ -255,13 +255,13 @@ instance , ConwayEraTxBody era , AlonzoEraTx era , EraStake era - , EraRule "UTXO" era ~ ConwayUTXO era + , EraRule "UTXO" era ~ UTXO era , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era , InjectRuleFailure "UTXO" Allegra.AllegraUtxoPredFailure era , InjectRuleFailure "UTXO" Alonzo.AlonzoUtxoPredFailure era , InjectRuleFailure "UTXO" Babbage.BabbageUtxoPredFailure era , InjectRuleFailure "UTXO" ConwayUtxoPredFailure era - , Embed (EraRule "UTXOS" era) (ConwayUTXO era) + , Embed (EraRule "UTXOS" era) (UTXO era) , Environment (EraRule "UTXOS" era) ~ () , State (EraRule "UTXOS" era) ~ () , Signal (EraRule "UTXOS" era) ~ StAnnTx TopTx era @@ -269,14 +269,14 @@ instance , EraCertState era , SafeToHash (TxWits era) ) => - STS (ConwayUTXO era) + STS (UTXO era) where - type State (ConwayUTXO era) = UTxOState era - type Signal (ConwayUTXO era) = StAnnTx TopTx era - type Environment (ConwayUTXO era) = Shelley.UtxoEnv era - type BaseM (ConwayUTXO era) = ShelleyBase - type PredicateFailure (ConwayUTXO era) = ConwayUtxoPredFailure era - type Event (ConwayUTXO era) = Alonzo.AlonzoUtxoEvent era + type State (UTXO era) = UTxOState era + type Signal (UTXO era) = StAnnTx TopTx era + type Environment (UTXO era) = Shelley.UtxoEnv era + type BaseM (UTXO era) = ShelleyBase + type PredicateFailure (UTXO era) = ConwayUtxoPredFailure era + type Event (UTXO era) = Alonzo.AlonzoUtxoEvent era initialRules = [] @@ -286,11 +286,11 @@ instance instance ( Era era - , STS (ConwayUTXOS era) + , STS (UTXOS era) , PredicateFailure (EraRule "UTXOS" era) ~ ConwayUtxosPredFailure era - , Event (EraRule "UTXOS" era) ~ Event (ConwayUTXOS era) + , Event (EraRule "UTXOS" era) ~ Event (UTXOS era) ) => - Embed (ConwayUTXOS era) (ConwayUTXO era) + Embed (UTXOS era) (UTXO era) where wrapFailed = UtxosFailure wrapEvent = Alonzo.UtxosEvent diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs index 288b356e4e0..6d7123cf237 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxos.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Utxos ( - ConwayUTXOS, + UTXOS, ConwayUtxosPredFailure (..), ConwayUtxosEvent (..), alonzoToConwayUtxosPredFailure, @@ -43,8 +43,8 @@ import Cardano.Ledger.Alonzo.UTxO ( AlonzoScriptsNeeded, ) import Cardano.Ledger.Babbage.Rules ( - BabbageUTXO, BabbageUtxoPredFailure (..), + UTXO, babbageEvalScriptsTxInvalid, expectScriptsToPass, ) @@ -56,7 +56,7 @@ import Cardano.Ledger.Binary ( ) import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayEra, ConwayUTXOS) +import Cardano.Ledger.Conway.Era (ConwayEra, UTXOS) import Cardano.Ledger.Conway.Governance (ConwayGovState) import Cardano.Ledger.Conway.State import Cardano.Ledger.Plutus (PlutusWithContext) @@ -181,20 +181,20 @@ instance , EraPlutusContext era , GovState era ~ ConwayGovState era , ScriptsNeeded era ~ AlonzoScriptsNeeded era - , Signal (ConwayUTXOS era) ~ StAnnTx TopTx era - , EraRule "UTXOS" era ~ ConwayUTXOS era + , Signal (UTXOS era) ~ StAnnTx TopTx era + , EraRule "UTXOS" era ~ UTXOS era , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era , InjectRuleEvent "UTXOS" ConwayUtxosEvent era ) => - STS (ConwayUTXOS era) + STS (UTXOS era) where - type BaseM (ConwayUTXOS era) = Cardano.Ledger.BaseTypes.ShelleyBase - type Environment (ConwayUTXOS era) = () - type State (ConwayUTXOS era) = () - type Signal (ConwayUTXOS era) = StAnnTx TopTx era - type PredicateFailure (ConwayUTXOS era) = ConwayUtxosPredFailure era - type Event (ConwayUTXOS era) = ConwayUtxosEvent era + type BaseM (UTXOS era) = Cardano.Ledger.BaseTypes.ShelleyBase + type Environment (UTXOS era) = () + type State (UTXOS era) = () + type Signal (UTXOS era) = StAnnTx TopTx era + type PredicateFailure (UTXOS era) = ConwayUtxosPredFailure era + type Event (UTXOS era) = ConwayUtxosEvent era transitionRules = [utxosTransition] @@ -210,13 +210,13 @@ instance , GovState era ~ ConwayGovState era , PredicateFailure (EraRule "UTXOS" era) ~ ConwayUtxosPredFailure era , ScriptsNeeded era ~ AlonzoScriptsNeeded era - , Signal (ConwayUTXOS era) ~ StAnnTx TopTx era - , EraRule "UTXOS" era ~ ConwayUTXOS era + , Signal (UTXOS era) ~ StAnnTx TopTx era + , EraRule "UTXOS" era ~ UTXOS era , InjectRuleFailure "UTXOS" AlonzoUtxosPredFailure era , InjectRuleEvent "UTXOS" AlonzoUtxosEvent era , InjectRuleEvent "UTXOS" ConwayUtxosEvent era ) => - Embed (ConwayUTXOS era) (BabbageUTXO era) + Embed (UTXOS era) (UTXO era) where wrapFailed = AlonzoInBabbageUtxoPredFailure . UtxosFailure wrapEvent = UtxosEvent diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxow.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxow.hs index f596587ce23..8f35e7217cd 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxow.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Utxow.hs @@ -18,7 +18,7 @@ module Cardano.Ledger.Conway.Rules.Utxow ( alonzoToConwayUtxowPredFailure, babbageToConwayUtxowPredFailure, - ConwayUTXOW, + UTXOW, ConwayUtxowPredFailure (..), shelleyToConwayUtxowPredFailure, ) where @@ -32,7 +32,7 @@ import Cardano.Ledger.BaseTypes (Mismatch (..), Relation (..), ShelleyBase, Stri import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..)) import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), ( - STS (ConwayUTXOW era) + STS (UTXOW era) where - type State (ConwayUTXOW era) = Shelley.UTxOState era - type Signal (ConwayUTXOW era) = StAnnTx TopTx era - type Environment (ConwayUTXOW era) = Shelley.UtxoEnv era - type BaseM (ConwayUTXOW era) = ShelleyBase - type PredicateFailure (ConwayUTXOW era) = ConwayUtxowPredFailure era - type Event (ConwayUTXOW era) = Alonzo.AlonzoUtxowEvent era + type State (UTXOW era) = Shelley.UTxOState era + type Signal (UTXOW era) = StAnnTx TopTx era + type Environment (UTXOW era) = Shelley.UtxoEnv era + type BaseM (UTXOW era) = ShelleyBase + type PredicateFailure (UTXOW era) = ConwayUtxowPredFailure era + type Event (UTXOW era) = Alonzo.AlonzoUtxowEvent era transitionRules = [Babbage.babbageUtxowTransition @era] initialRules = [] instance ( Era era - , STS (ConwayUTXO era) + , STS (UTXO era) , PredicateFailure (EraRule "UTXO" era) ~ ConwayUtxoPredFailure era , Event (EraRule "UTXO" era) ~ Alonzo.AlonzoUtxoEvent era - , BaseM (ConwayUTXOW era) ~ ShelleyBase - , PredicateFailure (ConwayUTXOW era) ~ ConwayUtxowPredFailure era - , Event (ConwayUTXOW era) ~ Alonzo.AlonzoUtxowEvent era + , BaseM (UTXOW era) ~ ShelleyBase + , PredicateFailure (UTXOW era) ~ ConwayUtxowPredFailure era + , Event (UTXOW era) ~ Alonzo.AlonzoUtxowEvent era ) => - Embed (ConwayUTXO era) (ConwayUTXOW era) + Embed (UTXO era) (UTXOW era) where wrapFailed = UtxoFailure wrapEvent = Alonzo.WrappedShelleyEraEvent . Shelley.UtxoEvent diff --git a/eras/dijkstra/impl/CHANGELOG.md b/eras/dijkstra/impl/CHANGELOG.md index a31cc69b1e4..f362613ea96 100644 --- a/eras/dijkstra/impl/CHANGELOG.md +++ b/eras/dijkstra/impl/CHANGELOG.md @@ -2,6 +2,25 @@ ## 0.3.0.0 +* Rename rule types and deprecate the old names: + - `DijkstraBBODY` -> `BBODY` + - `DijkstraCERT` -> `CERT` + - `DijkstraGOV` -> `GOV` + - `DijkstraGOVCERT` -> `GOVCERT` + - `DijkstraLEDGER` -> `LEDGER` + - `DijkstraMEMPOOL` -> `MEMPOOL` + - `DijkstraSUBCERT` -> `SUBCERT` + - `DijkstraSUBCERTS` -> `SUBCERTS` + - `DijkstraSUBDELEG` -> `SUBDELEG` + - `DijkstraSUBGOV` -> `SUBGOV` + - `DijkstraSUBGOVCERT` -> `SUBGOVCERT` + - `DijkstraSUBLEDGER` -> `SUBLEDGER` + - `DijkstraSUBLEDGERS` -> `SUBLEDGERS` + - `DijkstraSUBPOOL` -> `SUBPOOL` + - `DijkstraSUBUTXO` -> `SUBUTXO` + - `DijkstraSUBUTXOW` -> `SUBUTXOW` + - `DijkstraUTXO` -> `UTXO` + - `DijkstraUTXOW` -> `UTXOW` * Add `DijkstraEraUTxO` type class with `subTransactionsStAnnTx` method * Add `TranslateEra` instance for `DijkstraEra VState` * Fix `TranslateEra` instance for `DijkstraEra CertState` diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Era.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Era.hs index e1f2a8ead0c..9fc1d1987ea 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Era.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Era.hs @@ -11,6 +11,28 @@ module Cardano.Ledger.Dijkstra.Era ( DijkstraEra, + BBODY, + CERT, + GOV, + GOVCERT, + LEDGER, + MEMPOOL, + SUBCERT, + SUBCERTS, + SUBDELEG, + SUBGOV, + SUBGOVCERT, + SUBLEDGER, + SUBLEDGERS, + SUBPOOL, + SUBUTXOW, + SUBUTXO, + UTXO, + UTXOW, + DijkstraEraBlockHeader (..), + DijkstraBbodySignal (..), + + -- * Deprecated DijkstraBBODY, DijkstraCERT, DijkstraGOV, @@ -29,8 +51,6 @@ module Cardano.Ledger.Dijkstra.Era ( DijkstraSUBUTXO, DijkstraUTXO, DijkstraUTXOW, - DijkstraEraBlockHeader (..), - DijkstraBbodySignal (..), ) where import Cardano.Ledger.BaseTypes (Nonce) @@ -92,106 +112,178 @@ type instance EraRuleEvent "DELEGS" DijkstraEra = VoidEraRule "DELEGS" DijkstraE type instance Value DijkstraEra = MaryValue -data DijkstraSUBLEDGERS era +data SUBLEDGERS era + +type DijkstraSUBLEDGERS = SUBLEDGERS + +{-# DEPRECATED DijkstraSUBLEDGERS "In favor of `SUBLEDGERS`" #-} + +type instance EraRule "SUBLEDGERS" DijkstraEra = SUBLEDGERS DijkstraEra + +data SUBLEDGER era + +type DijkstraSUBLEDGER = SUBLEDGER + +{-# DEPRECATED DijkstraSUBLEDGER "In favor of `SUBLEDGER`" #-} + +type instance EraRule "SUBLEDGER" DijkstraEra = SUBLEDGER DijkstraEra + +data SUBCERTS era + +type DijkstraSUBCERTS = SUBCERTS + +{-# DEPRECATED DijkstraSUBCERTS "In favor of `SUBCERTS`" #-} + +type instance EraRule "SUBCERTS" DijkstraEra = SUBCERTS DijkstraEra + +data SUBCERT era + +type DijkstraSUBCERT = SUBCERT + +{-# DEPRECATED DijkstraSUBCERT "In favor of `SUBCERT`" #-} + +type instance EraRule "SUBCERT" DijkstraEra = SUBCERT DijkstraEra + +data SUBDELEG era + +type DijkstraSUBDELEG = SUBDELEG + +{-# DEPRECATED DijkstraSUBDELEG "In favor of `SUBDELEG`" #-} + +type instance EraRule "SUBDELEG" DijkstraEra = SUBDELEG DijkstraEra + +data SUBGOV era + +type DijkstraSUBGOV = SUBGOV + +{-# DEPRECATED DijkstraSUBGOV "In favor of `SUBGOV`" #-} + +type instance EraRule "SUBGOV" DijkstraEra = SUBGOV DijkstraEra + +data SUBGOVCERT era + +type DijkstraSUBGOVCERT = SUBGOVCERT + +{-# DEPRECATED DijkstraSUBGOVCERT "In favor of `SUBGOVCERT`" #-} + +type instance EraRule "SUBGOVCERT" DijkstraEra = SUBGOVCERT DijkstraEra + +data SUBPOOL era + +type DijkstraSUBPOOL = SUBPOOL + +{-# DEPRECATED DijkstraSUBPOOL "In favor of `SUBPOOL`" #-} + +type instance EraRule "SUBPOOL" DijkstraEra = SUBPOOL DijkstraEra + +data SUBUTXO era + +type DijkstraSUBUTXO = SUBUTXO + +{-# DEPRECATED DijkstraSUBUTXO "In favor of `SUBUTXO`" #-} + +type instance EraRule "SUBUTXO" DijkstraEra = SUBUTXO DijkstraEra + +data SUBUTXOW era -type instance EraRule "SUBLEDGERS" DijkstraEra = DijkstraSUBLEDGERS DijkstraEra +type DijkstraSUBUTXOW = SUBUTXOW -data DijkstraSUBLEDGER era +{-# DEPRECATED DijkstraSUBUTXOW "In favor of `SUBUTXOW`" #-} -type instance EraRule "SUBLEDGER" DijkstraEra = DijkstraSUBLEDGER DijkstraEra +type instance EraRule "SUBUTXOW" DijkstraEra = SUBUTXOW DijkstraEra -data DijkstraSUBCERTS era +data GOV era -type instance EraRule "SUBCERTS" DijkstraEra = DijkstraSUBCERTS DijkstraEra +type DijkstraGOV = GOV -data DijkstraSUBCERT era +{-# DEPRECATED DijkstraGOV "In favor of `GOV`" #-} -type instance EraRule "SUBCERT" DijkstraEra = DijkstraSUBCERT DijkstraEra +type instance EraRule "GOV" DijkstraEra = GOV DijkstraEra -data DijkstraSUBDELEG era +type instance EraRule "NEWEPOCH" DijkstraEra = Conway.NEWEPOCH DijkstraEra -type instance EraRule "SUBDELEG" DijkstraEra = DijkstraSUBDELEG DijkstraEra +type instance EraRule "EPOCH" DijkstraEra = Conway.EPOCH DijkstraEra -data DijkstraSUBGOV era +type instance EraRule "ENACT" DijkstraEra = Conway.ENACT DijkstraEra -type instance EraRule "SUBGOV" DijkstraEra = DijkstraSUBGOV DijkstraEra +type instance EraRule "UTXOS" DijkstraEra = Conway.UTXOS DijkstraEra -data DijkstraSUBGOVCERT era +data LEDGER era -type instance EraRule "SUBGOVCERT" DijkstraEra = DijkstraSUBGOVCERT DijkstraEra +type DijkstraLEDGER = LEDGER -data DijkstraSUBPOOL era +{-# DEPRECATED DijkstraLEDGER "In favor of `LEDGER`" #-} -type instance EraRule "SUBPOOL" DijkstraEra = DijkstraSUBPOOL DijkstraEra +type instance EraRule "LEDGER" DijkstraEra = LEDGER DijkstraEra -data DijkstraSUBUTXO era +type instance EraRule "TICKF" DijkstraEra = Conway.TICKF DijkstraEra -type instance EraRule "SUBUTXO" DijkstraEra = DijkstraSUBUTXO DijkstraEra +type instance EraRule "RATIFY" DijkstraEra = Conway.RATIFY DijkstraEra -data DijkstraSUBUTXOW era +type instance EraRule "CERTS" DijkstraEra = Conway.CERTS DijkstraEra -type instance EraRule "SUBUTXOW" DijkstraEra = DijkstraSUBUTXOW DijkstraEra +data CERT era -data DijkstraGOV era +type DijkstraCERT = CERT -type instance EraRule "GOV" DijkstraEra = DijkstraGOV DijkstraEra +{-# DEPRECATED DijkstraCERT "In favor of `CERT`" #-} -type instance EraRule "NEWEPOCH" DijkstraEra = Conway.ConwayNEWEPOCH DijkstraEra +type instance EraRule "CERT" DijkstraEra = CERT DijkstraEra -type instance EraRule "EPOCH" DijkstraEra = Conway.ConwayEPOCH DijkstraEra +type instance EraRule "DELEG" DijkstraEra = Conway.DELEG DijkstraEra -type instance EraRule "ENACT" DijkstraEra = Conway.ConwayENACT DijkstraEra +data GOVCERT era -type instance EraRule "UTXOS" DijkstraEra = Conway.ConwayUTXOS DijkstraEra +type DijkstraGOVCERT = GOVCERT -data DijkstraLEDGER era +{-# DEPRECATED DijkstraGOVCERT "In favor of `GOVCERT`" #-} -type instance EraRule "LEDGER" DijkstraEra = DijkstraLEDGER DijkstraEra +type instance EraRule "GOVCERT" DijkstraEra = GOVCERT DijkstraEra -type instance EraRule "TICKF" DijkstraEra = Conway.ConwayTICKF DijkstraEra +data UTXOW era -type instance EraRule "RATIFY" DijkstraEra = Conway.ConwayRATIFY DijkstraEra +type DijkstraUTXOW = UTXOW -type instance EraRule "CERTS" DijkstraEra = Conway.ConwayCERTS DijkstraEra +{-# DEPRECATED DijkstraUTXOW "In favor of `UTXOW`" #-} -data DijkstraCERT era +type instance EraRule "UTXOW" DijkstraEra = UTXOW DijkstraEra -type instance EraRule "CERT" DijkstraEra = DijkstraCERT DijkstraEra +data UTXO era -type instance EraRule "DELEG" DijkstraEra = Conway.ConwayDELEG DijkstraEra +type DijkstraUTXO = UTXO -data DijkstraGOVCERT era +{-# DEPRECATED DijkstraUTXO "In favor of `UTXO`" #-} -type instance EraRule "GOVCERT" DijkstraEra = DijkstraGOVCERT DijkstraEra +type instance EraRule "UTXO" DijkstraEra = UTXO DijkstraEra -data DijkstraUTXOW era +data BBODY era -type instance EraRule "UTXOW" DijkstraEra = DijkstraUTXOW DijkstraEra +type DijkstraBBODY = BBODY -data DijkstraUTXO era +{-# DEPRECATED DijkstraBBODY "In favor of `BBODY`" #-} -type instance EraRule "UTXO" DijkstraEra = DijkstraUTXO DijkstraEra +type instance EraRule "BBODY" DijkstraEra = BBODY DijkstraEra -data DijkstraBBODY era +data MEMPOOL era -type instance EraRule "BBODY" DijkstraEra = DijkstraBBODY DijkstraEra +type DijkstraMEMPOOL = MEMPOOL -data DijkstraMEMPOOL era +{-# DEPRECATED DijkstraMEMPOOL "In favor of `MEMPOOL`" #-} -type instance EraRule "MEMPOOL" DijkstraEra = DijkstraMEMPOOL DijkstraEra +type instance EraRule "MEMPOOL" DijkstraEra = MEMPOOL DijkstraEra -type instance EraRule "HARDFORK" DijkstraEra = Conway.ConwayHARDFORK DijkstraEra +type instance EraRule "HARDFORK" DijkstraEra = Conway.HARDFORK DijkstraEra -- Rules inherited from Shelley -type instance EraRule "LEDGERS" DijkstraEra = API.ShelleyLEDGERS DijkstraEra +type instance EraRule "LEDGERS" DijkstraEra = API.LEDGERS DijkstraEra -type instance EraRule "POOLREAP" DijkstraEra = API.ShelleyPOOLREAP DijkstraEra +type instance EraRule "POOLREAP" DijkstraEra = API.POOLREAP DijkstraEra -type instance EraRule "RUPD" DijkstraEra = Shelley.ShelleyRUPD DijkstraEra +type instance EraRule "RUPD" DijkstraEra = Shelley.RUPD DijkstraEra -type instance EraRule "SNAP" DijkstraEra = Shelley.ShelleySNAP DijkstraEra +type instance EraRule "SNAP" DijkstraEra = Shelley.SNAP DijkstraEra -type instance EraRule "TICK" DijkstraEra = Shelley.ShelleyTICK DijkstraEra +type instance EraRule "TICK" DijkstraEra = Shelley.TICK DijkstraEra -type instance EraRule "POOL" DijkstraEra = Shelley.ShelleyPOOL DijkstraEra +type instance EraRule "POOL" DijkstraEra = Shelley.POOL DijkstraEra diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs index 34d7107a003..3884c54b82e 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.Bbody ( - DijkstraBBODY, + BBODY, DijkstraBbodyPredFailure (..), conwayToDijkstraBbodyPredFailure, ) where @@ -51,7 +51,7 @@ import Cardano.Ledger.Dijkstra.BlockBody ( validatePerasCert, ) import Cardano.Ledger.Dijkstra.Era ( - DijkstraBBODY, + BBODY, DijkstraBbodySignal (..), DijkstraEra, DijkstraEraBlockHeader (..), @@ -288,25 +288,25 @@ instance , InjectRuleFailure "BBODY" Conway.ConwayBbodyPredFailure era , InjectRuleFailure "BBODY" DijkstraBbodyPredFailure era , InjectRuleFailure "BBODY" Shelley.ShelleyBbodyPredFailure era - , EraRule "BBODY" era ~ DijkstraBBODY era + , EraRule "BBODY" era ~ BBODY era , AlonzoEraTx era , BabbageEraTxBody era , ConwayEraPParams era , DijkstraEraBlockBody era ) => - STS (DijkstraBBODY era) + STS (BBODY era) where - type State (DijkstraBBODY era) = Shelley.ShelleyBbodyState era + type State (BBODY era) = Shelley.ShelleyBbodyState era - type Signal (DijkstraBBODY era) = DijkstraBbodySignal era + type Signal (BBODY era) = DijkstraBbodySignal era - type Environment (DijkstraBBODY era) = Shelley.BbodyEnv era + type Environment (BBODY era) = Shelley.BbodyEnv era - type BaseM (DijkstraBBODY era) = ShelleyBase + type BaseM (BBODY era) = ShelleyBase - type PredicateFailure (DijkstraBBODY era) = DijkstraBbodyPredFailure era + type PredicateFailure (BBODY era) = DijkstraBbodyPredFailure era - type Event (DijkstraBBODY era) = Alonzo.AlonzoBbodyEvent era + type Event (BBODY era) = Alonzo.AlonzoBbodyEvent era initialRules = [] transitionRules = [dijkstraBbodyTransition @era] @@ -386,7 +386,7 @@ instance , ledgers ~ EraRule "LEDGERS" era , STS ledgers ) => - Embed ledgers (DijkstraBBODY era) + Embed ledgers (BBODY era) where wrapFailed = LedgersFailure wrapEvent = Alonzo.ShelleyInAlonzoEvent . Shelley.LedgersEvent diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Cert.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Cert.hs index 559dfea8a8d..8c4dfa7f8b8 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Cert.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Cert.hs @@ -11,7 +11,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.Cert ( - DijkstraCERT, + CERT, ) where import Cardano.Ledger.BaseTypes (ShelleyBase) @@ -56,20 +56,20 @@ instance , Signal (EraRule "DELEG" era) ~ ConwayDelegCert , Signal (EraRule "POOL" era) ~ PoolCert , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert - , Embed (EraRule "DELEG" era) (DijkstraCERT era) - , Embed (EraRule "POOL" era) (DijkstraCERT era) - , Embed (EraRule "GOVCERT" era) (DijkstraCERT era) + , Embed (EraRule "DELEG" era) (CERT era) + , Embed (EraRule "POOL" era) (CERT era) + , Embed (EraRule "GOVCERT" era) (CERT era) , TxCert era ~ DijkstraTxCert era , EraCertState era ) => - STS (DijkstraCERT era) + STS (CERT era) where - type State (DijkstraCERT era) = CertState era - type Signal (DijkstraCERT era) = TxCert era - type Environment (DijkstraCERT era) = Conway.CertEnv era - type BaseM (DijkstraCERT era) = ShelleyBase - type PredicateFailure (DijkstraCERT era) = Conway.ConwayCertPredFailure era - type Event (DijkstraCERT era) = Conway.ConwayCertEvent era + type State (CERT era) = CertState era + type Signal (CERT era) = TxCert era + type Environment (CERT era) = Conway.CertEnv era + type BaseM (CERT era) = ShelleyBase + type PredicateFailure (CERT era) = Conway.ConwayCertPredFailure era + type Event (CERT era) = Conway.ConwayCertEvent era transitionRules = [certTransition @era] @@ -84,13 +84,13 @@ certTransition :: , Signal (EraRule "DELEG" era) ~ ConwayDelegCert , Signal (EraRule "POOL" era) ~ PoolCert , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert - , Embed (EraRule "DELEG" era) (DijkstraCERT era) - , Embed (EraRule "POOL" era) (DijkstraCERT era) - , Embed (EraRule "GOVCERT" era) (DijkstraCERT era) + , Embed (EraRule "DELEG" era) (CERT era) + , Embed (EraRule "POOL" era) (CERT era) + , Embed (EraRule "GOVCERT" era) (CERT era) , TxCert era ~ DijkstraTxCert era , EraCertState era ) => - TransitionRule (DijkstraCERT era) + TransitionRule (CERT era) certTransition = do TRC (Conway.CertEnv pp currentEpoch committee committeeProposals, certState, c) <- judgmentContext let @@ -109,10 +109,10 @@ certTransition = do TRC (Conway.ConwayGovCertEnv pp currentEpoch committee committeeProposals, certState, govCert) instance - ( STS (DijkstraGOVCERT era) + ( STS (GOVCERT era) , PredicateFailure (EraRule "GOVCERT" era) ~ DijkstraGovCertPredFailure era ) => - Embed (DijkstraGOVCERT era) (DijkstraCERT era) + Embed (GOVCERT era) (CERT era) where wrapFailed = Conway.GovCertFailure wrapEvent = absurd diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Certs.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Certs.hs index a381103dbcc..232daf932e9 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Certs.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Certs.hs @@ -39,39 +39,39 @@ instance InjectRuleFailure "CERTS" Conway.ConwayGovCertPredFailure DijkstraEra w instance ( Era era - , STS (DijkstraCERT era) + , STS (CERT era) , Event (EraRule "CERT" era) ~ Conway.ConwayCertEvent era , PredicateFailure (EraRule "CERT" era) ~ Conway.ConwayCertPredFailure era ) => - Embed (DijkstraCERT era) (Conway.ConwayCERTS era) + Embed (CERT era) (Conway.CERTS era) where wrapFailed = Conway.CertFailure wrapEvent = Conway.CertEvent instance - ( STS (Conway.ConwayDELEG era) + ( STS (Conway.DELEG era) , PredicateFailure (EraRule "DELEG" era) ~ Conway.ConwayDelegPredFailure era ) => - Embed (Conway.ConwayDELEG era) (DijkstraCERT era) + Embed (Conway.DELEG era) (CERT era) where wrapFailed = Conway.DelegFailure wrapEvent = absurd instance - ( STS (Shelley.ShelleyPOOL era) + ( STS (Shelley.POOL era) , PredicateFailure (EraRule "POOL" era) ~ Shelley.ShelleyPoolPredFailure era , Event (EraRule "POOL" era) ~ Shelley.PoolEvent era ) => - Embed (Shelley.ShelleyPOOL era) (DijkstraCERT era) + Embed (Shelley.POOL era) (CERT era) where wrapFailed = Conway.PoolFailure wrapEvent = Conway.PoolEvent instance - ( STS (Conway.ConwayGOVCERT era) + ( STS (Conway.GOVCERT era) , PredicateFailure (EraRule "GOVCERT" era) ~ Conway.ConwayGovCertPredFailure era ) => - Embed (Conway.ConwayGOVCERT era) (DijkstraCERT era) + Embed (Conway.GOVCERT era) (CERT era) where wrapFailed = Conway.GovCertFailure wrapEvent = absurd diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs index 8d7a279e511..94e6073166b 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Gov.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.Gov ( - DijkstraGOV, + GOV, DijkstraGovPredFailure (..), pattern InvalidPolicyHash, conwayToDijkstraGovPredFailure, @@ -60,7 +60,7 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State import Cardano.Ledger.Credential (Credential) import Cardano.Ledger.Dijkstra.Core -import Cardano.Ledger.Dijkstra.Era (DijkstraEra, DijkstraGOV) +import Cardano.Ledger.Dijkstra.Era (DijkstraEra, GOV) import Control.DeepSeq (NFData) import Control.State.Transition.Extended ( STS (..), @@ -200,20 +200,20 @@ instance ( ConwayEraTxCert era , ConwayEraPParams era , ConwayEraGov era - , EraRule "GOV" era ~ DijkstraGOV era + , EraRule "GOV" era ~ GOV era , InjectRuleFailure "GOV" Conway.ConwayGovPredFailure era , InjectRuleEvent "GOV" Conway.ConwayGovEvent era , EraCertState era , ConwayEraCertState era ) => - STS (DijkstraGOV era) + STS (GOV era) where - type State (DijkstraGOV era) = Proposals era - type Signal (DijkstraGOV era) = Conway.GovSignal era - type Environment (DijkstraGOV era) = Conway.GovEnv era - type BaseM (DijkstraGOV era) = ShelleyBase - type PredicateFailure (DijkstraGOV era) = DijkstraGovPredFailure era - type Event (DijkstraGOV era) = Conway.ConwayGovEvent era + type State (GOV era) = Proposals era + type Signal (GOV era) = Conway.GovSignal era + type Environment (GOV era) = Conway.GovEnv era + type BaseM (GOV era) = ShelleyBase + type PredicateFailure (GOV era) = DijkstraGovPredFailure era + type Event (GOV era) = Conway.ConwayGovEvent era initialRules = [] diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/GovCert.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/GovCert.hs index 0dfe43c4b25..f4a9c31ba46 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/GovCert.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/GovCert.hs @@ -13,7 +13,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.GovCert ( - DijkstraGOVCERT, + GOVCERT, DijkstraGovCertPredFailure (..), conwayToDijkstraGovCertPredFailure, ) where @@ -34,7 +34,7 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State import Cardano.Ledger.Conway.TxCert (ConwayGovCert (..)) import Cardano.Ledger.Credential (Credential) -import Cardano.Ledger.Dijkstra.Era (DijkstraEra, DijkstraGOVCERT) +import Cardano.Ledger.Dijkstra.Era (DijkstraEra, GOVCERT) import Control.DeepSeq (NFData) import Control.State.Transition.Extended ( BaseM, @@ -100,18 +100,18 @@ instance , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert , Environment (EraRule "GOVCERT" era) ~ Conway.ConwayGovCertEnv era , InjectRuleFailure "GOVCERT" Conway.ConwayGovCertPredFailure era - , EraRule "GOVCERT" era ~ DijkstraGOVCERT era + , EraRule "GOVCERT" era ~ GOVCERT era , Eq (PredicateFailure (EraRule "GOVCERT" era)) , Show (PredicateFailure (EraRule "GOVCERT" era)) ) => - STS (DijkstraGOVCERT era) + STS (GOVCERT era) where - type State (DijkstraGOVCERT era) = CertState era - type Signal (DijkstraGOVCERT era) = ConwayGovCert - type Environment (DijkstraGOVCERT era) = Conway.ConwayGovCertEnv era - type BaseM (DijkstraGOVCERT era) = ShelleyBase - type PredicateFailure (DijkstraGOVCERT era) = DijkstraGovCertPredFailure era - type Event (DijkstraGOVCERT era) = Void + type State (GOVCERT era) = CertState era + type Signal (GOVCERT era) = ConwayGovCert + type Environment (GOVCERT era) = Conway.ConwayGovCertEnv era + type BaseM (GOVCERT era) = ShelleyBase + type PredicateFailure (GOVCERT era) = DijkstraGovCertPredFailure era + type Event (GOVCERT era) = Void transitionRules = [Conway.conwayGovCertTransition] diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs index d0f6fc2c74e..3b234899659 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.Ledger ( - DijkstraLEDGER, + LEDGER, DijkstraLedgerPredFailure (..), DijkstraLedgerEvent (..), shelleyToDijkstraLedgerPredFailure, @@ -50,9 +50,9 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraGOV, - DijkstraLEDGER, - DijkstraUTXOW, + GOV, + LEDGER, + UTXOW, ) import Cardano.Ledger.Dijkstra.Rules.Certs () import Cardano.Ledger.Dijkstra.Rules.Gov (DijkstraGovPredFailure) @@ -275,10 +275,10 @@ instance , DijkstraEraTxBody era , DijkstraEraUTxO era , GovState era ~ ConwayGovState era - , Embed (EraRule "UTXOW" era) (DijkstraLEDGER era) - , Embed (EraRule "GOV" era) (DijkstraLEDGER era) - , Embed (EraRule "CERTS" era) (DijkstraLEDGER era) - , Embed (EraRule "SUBLEDGERS" era) (DijkstraLEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) + , Embed (EraRule "GOV" era) (LEDGER era) + , Embed (EraRule "CERTS" era) (LEDGER era) + , Embed (EraRule "SUBLEDGERS" era) (LEDGER era) , State (EraRule "UTXOW" era) ~ UTxOState era , State (EraRule "CERTS" era) ~ CertState era , State (EraRule "GOV" era) ~ Proposals era @@ -290,27 +290,27 @@ instance , Signal (EraRule "GOV" era) ~ Conway.GovSignal era , Signal (EraRule "SUBLEDGERS" era) ~ [StAnnTx SubTx era] , ConwayEraCertState era - , EraRule "LEDGER" era ~ DijkstraLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , InjectRuleFailure "LEDGER" Shelley.ShelleyLedgerPredFailure era , InjectRuleFailure "LEDGER" Conway.ConwayLedgerPredFailure era , InjectRuleFailure "LEDGER" DijkstraLedgerPredFailure era - , EraRule "SUBLEDGERS" era ~ DijkstraSUBLEDGERS era + , EraRule "SUBLEDGERS" era ~ SUBLEDGERS era ) => - STS (DijkstraLEDGER era) + STS (LEDGER era) where - type State (DijkstraLEDGER era) = LedgerState era - type Signal (DijkstraLEDGER era) = StAnnTx TopTx era - type Environment (DijkstraLEDGER era) = Shelley.LedgerEnv era - type BaseM (DijkstraLEDGER era) = ShelleyBase - type PredicateFailure (DijkstraLEDGER era) = DijkstraLedgerPredFailure era - type Event (DijkstraLEDGER era) = DijkstraLedgerEvent era + type State (LEDGER era) = LedgerState era + type Signal (LEDGER era) = StAnnTx TopTx era + type Environment (LEDGER era) = Shelley.LedgerEnv era + type BaseM (LEDGER era) = ShelleyBase + type PredicateFailure (LEDGER era) = DijkstraLedgerPredFailure era + type Event (LEDGER era) = DijkstraLedgerEvent era initialRules = [] transitionRules = [dijkstraLedgerTransition] renderAssertionViolation = Shelley.renderDepositEqualsObligationViolation - assertions = Shelley.shelleyLedgerAssertions @era @DijkstraLEDGER + assertions = Shelley.shelleyLedgerAssertions @era @LEDGER validateAllRefScriptSize :: ( EraTx era @@ -338,10 +338,10 @@ dijkstraLedgerTransition :: , DijkstraEraTxBody era , DijkstraEraUTxO era , GovState era ~ ConwayGovState era - , Embed (EraRule "UTXOW" era) (DijkstraLEDGER era) - , Embed (EraRule "GOV" era) (DijkstraLEDGER era) - , Embed (EraRule "CERTS" era) (DijkstraLEDGER era) - , Embed (EraRule "SUBLEDGERS" era) (DijkstraLEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) + , Embed (EraRule "GOV" era) (LEDGER era) + , Embed (EraRule "CERTS" era) (LEDGER era) + , Embed (EraRule "SUBLEDGERS" era) (LEDGER era) , State (EraRule "UTXOW" era) ~ UTxOState era , State (EraRule "CERTS" era) ~ CertState era , State (EraRule "GOV" era) ~ Proposals era @@ -351,14 +351,14 @@ dijkstraLedgerTransition :: , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era , Signal (EraRule "CERTS" era) ~ Seq (TxCert era) , Signal (EraRule "GOV" era) ~ Conway.GovSignal era - , STS (DijkstraLEDGER era) - , EraRule "LEDGER" era ~ DijkstraLEDGER era - , EraRule "SUBLEDGERS" era ~ DijkstraSUBLEDGERS era + , STS (LEDGER era) + , EraRule "LEDGER" era ~ LEDGER era + , EraRule "SUBLEDGERS" era ~ SUBLEDGERS era , InjectRuleFailure "LEDGER" Shelley.ShelleyLedgerPredFailure era , InjectRuleFailure "LEDGER" Conway.ConwayLedgerPredFailure era , InjectRuleFailure "LEDGER" DijkstraLedgerPredFailure era ) => - TransitionRule (DijkstraLEDGER era) + TransitionRule (LEDGER era) dijkstraLedgerTransition = do TRC (Shelley.LedgerEnv slot mbCurEpochNo txIx pp chainAccountState, ledgerState, stAnnTx) <- judgmentContext @@ -458,7 +458,7 @@ instance ( AlonzoEraTx era , EraUTxO era , BabbageEraTxBody era - , Embed (EraRule "UTXO" era) (DijkstraUTXOW era) + , Embed (EraRule "UTXO" era) (UTXOW era) , State (EraRule "UTXO" era) ~ UTxOState era , Environment (EraRule "UTXO" era) ~ DijkstraUtxoEnv era , Script era ~ AlonzoScript era @@ -467,30 +467,30 @@ instance , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era , PredicateFailure (EraRule "UTXOW" era) ~ DijkstraUtxowPredFailure era , Event (EraRule "UTXOW" era) ~ Alonzo.AlonzoUtxowEvent era - , STS (DijkstraUTXOW era) - , Event (DijkstraUTXOW era) ~ Alonzo.AlonzoUtxowEvent era + , STS (UTXOW era) + , Event (UTXOW era) ~ Alonzo.AlonzoUtxowEvent era ) => - Embed (DijkstraUTXOW era) (DijkstraLEDGER era) + Embed (UTXOW era) (LEDGER era) where wrapFailed = DijkstraUtxowFailure wrapEvent = UtxowEvent instance - ( STS (DijkstraLEDGER era) + ( STS (LEDGER era) , PredicateFailure (EraRule "LEDGER" era) ~ DijkstraLedgerPredFailure era , Event (EraRule "LEDGER" era) ~ DijkstraLedgerEvent era ) => - Embed (DijkstraLEDGER era) (Shelley.ShelleyLEDGERS era) + Embed (LEDGER era) (Shelley.LEDGERS era) where wrapFailed = Shelley.LedgerFailure wrapEvent = Shelley.LedgerEvent instance - ( STS (DijkstraGOV era) + ( STS (GOV era) , PredicateFailure (EraRule "GOV" era) ~ DijkstraGovPredFailure era , Event (EraRule "GOV" era) ~ Conway.ConwayGovEvent era ) => - Embed (DijkstraGOV era) (DijkstraLEDGER era) + Embed (GOV era) (LEDGER era) where wrapFailed = DijkstraGovFailure wrapEvent = GovEvent @@ -517,21 +517,21 @@ shelleyToDijkstraLedgerPredFailure = \case Shelley.ShelleyIncompleteWithdrawals x -> DijkstraIncompleteWithdrawals x instance - ( STS (Conway.ConwayCERTS era) + ( STS (Conway.CERTS era) , PredicateFailure (EraRule "CERTS" era) ~ Conway.ConwayCertsPredFailure era , Event (EraRule "CERTS" era) ~ Conway.ConwayCertsEvent era ) => - Embed (Conway.ConwayCERTS era) (DijkstraLEDGER era) + Embed (Conway.CERTS era) (LEDGER era) where wrapFailed = DijkstraCertsFailure wrapEvent = CertsEvent instance - ( STS (DijkstraSUBLEDGERS era) + ( STS (SUBLEDGERS era) , PredicateFailure (EraRule "SUBLEDGERS" era) ~ DijkstraSubLedgersPredFailure era , Event (EraRule "SUBLEDGERS" era) ~ DijkstraSubLedgersEvent era ) => - Embed (DijkstraSUBLEDGERS era) (DijkstraLEDGER era) + Embed (SUBLEDGERS era) (LEDGER era) where wrapFailed = DijkstraSubLedgersFailure wrapEvent = SubLedgersEvent diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Mempool.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Mempool.hs index 32628206b32..986c0102d9d 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Mempool.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Mempool.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.Mempool ( - DijkstraMEMPOOL, + MEMPOOL, DijkstraMempoolPredFailure (..), DijkstraMempoolEvent (..), ) where @@ -36,8 +36,8 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Dijkstra.Core import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraLEDGER, - DijkstraMEMPOOL, + LEDGER, + MEMPOOL, ) import Cardano.Ledger.Dijkstra.Rules.Ledger ( DijkstraLedgerEvent, @@ -143,7 +143,7 @@ instance , ConwayEraCertState era , EraStake era , EraCertState era - , Embed (EraRule "LEDGER" era) (DijkstraMEMPOOL era) + , Embed (EraRule "LEDGER" era) (MEMPOOL era) , State (EraRule "LEDGER" era) ~ LedgerState era , Eq (PredicateFailure (EraRule "CERTS" era)) , Eq (PredicateFailure (EraRule "GOV" era)) @@ -157,26 +157,26 @@ instance , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era , EraRuleFailure "SUBLEDGERS" era ~ DijkstraSubLedgersPredFailure era ) => - STS (DijkstraMEMPOOL era) + STS (MEMPOOL era) where - type State (DijkstraMEMPOOL era) = LedgerState era - type Signal (DijkstraMEMPOOL era) = StAnnTx TopTx era - type Environment (DijkstraMEMPOOL era) = Shelley.LedgerEnv era - type BaseM (DijkstraMEMPOOL era) = ShelleyBase - type PredicateFailure (DijkstraMEMPOOL era) = DijkstraMempoolPredFailure era - type Event (DijkstraMEMPOOL era) = DijkstraMempoolEvent era + type State (MEMPOOL era) = LedgerState era + type Signal (MEMPOOL era) = StAnnTx TopTx era + type Environment (MEMPOOL era) = Shelley.LedgerEnv era + type BaseM (MEMPOOL era) = ShelleyBase + type PredicateFailure (MEMPOOL era) = DijkstraMempoolPredFailure era + type Event (MEMPOOL era) = DijkstraMempoolEvent era transitionRules = [mempoolTransition @era] mempoolTransition :: forall era. ( EraTx era - , Embed (EraRule "LEDGER" era) (DijkstraMEMPOOL era) + , Embed (EraRule "LEDGER" era) (MEMPOOL era) , State (EraRule "LEDGER" era) ~ LedgerState era , Environment (EraRule "LEDGER" era) ~ Shelley.LedgerEnv era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era ) => - TransitionRule (DijkstraMEMPOOL era) + TransitionRule (MEMPOOL era) mempoolTransition = do TRC trc@(_ledgerEnv, ledgerState, stAnnTx) <- judgmentContext @@ -198,11 +198,11 @@ mempoolTransition = do trans @(EraRule "LEDGER" era) $ TRC trc instance - ( STS (DijkstraLEDGER era) + ( STS (LEDGER era) , PredicateFailure (EraRule "LEDGER" era) ~ DijkstraLedgerPredFailure era , Event (EraRule "LEDGER" era) ~ DijkstraLedgerEvent era ) => - Embed (DijkstraLEDGER era) (DijkstraMEMPOOL era) + Embed (LEDGER era) (MEMPOOL era) where wrapFailed = LedgerFailure wrapEvent = LedgerEvent diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCert.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCert.hs index bcefe09fcb7..1a10e694d4b 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCert.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCert.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubCert ( - DijkstraSUBCERT, + SUBCERT, DijkstraSubCertPredFailure (..), DijkstraSubCertEvent (..), ) where @@ -35,10 +35,10 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBCERT, - DijkstraSUBDELEG, - DijkstraSUBGOVCERT, - DijkstraSUBPOOL, + SUBCERT, + SUBDELEG, + SUBGOVCERT, + SUBPOOL, ) import Cardano.Ledger.Dijkstra.Rules.GovCert (DijkstraGovCertPredFailure) import Cardano.Ledger.Dijkstra.Rules.SubDeleg (DijkstraSubDelegPredFailure) @@ -138,36 +138,36 @@ instance NFData (Event (EraRule "SUBPOOL" era)) => NFData (DijkstraSubCertEvent instance ( ConwayEraGov era , ConwayEraCertState era - , EraRule "SUBCERT" era ~ DijkstraSUBCERT era - , EraRule "SUBDELEG" era ~ DijkstraSUBDELEG era - , EraRule "SUBPOOL" era ~ DijkstraSUBPOOL era - , EraRule "SUBGOVCERT" era ~ DijkstraSUBGOVCERT era - , Embed (EraRule "SUBDELEG" era) (DijkstraSUBCERT era) - , Embed (EraRule "SUBPOOL" era) (DijkstraSUBCERT era) - , Embed (EraRule "SUBGOVCERT" era) (DijkstraSUBCERT era) + , EraRule "SUBCERT" era ~ SUBCERT era + , EraRule "SUBDELEG" era ~ SUBDELEG era + , EraRule "SUBPOOL" era ~ SUBPOOL era + , EraRule "SUBGOVCERT" era ~ SUBGOVCERT era + , Embed (EraRule "SUBDELEG" era) (SUBCERT era) + , Embed (EraRule "SUBPOOL" era) (SUBCERT era) + , Embed (EraRule "SUBGOVCERT" era) (SUBCERT era) , TxCert era ~ DijkstraTxCert era ) => - STS (DijkstraSUBCERT era) + STS (SUBCERT era) where - type State (DijkstraSUBCERT era) = CertState era - type Signal (DijkstraSUBCERT era) = TxCert era - type Environment (DijkstraSUBCERT era) = Conway.CertEnv era - type BaseM (DijkstraSUBCERT era) = ShelleyBase - type PredicateFailure (DijkstraSUBCERT era) = DijkstraSubCertPredFailure era - type Event (DijkstraSUBCERT era) = DijkstraSubCertEvent era + type State (SUBCERT era) = CertState era + type Signal (SUBCERT era) = TxCert era + type Environment (SUBCERT era) = Conway.CertEnv era + type BaseM (SUBCERT era) = ShelleyBase + type PredicateFailure (SUBCERT era) = DijkstraSubCertPredFailure era + type Event (SUBCERT era) = DijkstraSubCertEvent era transitionRules = [dijkstraSubCertTransition @era] dijkstraSubCertTransition :: forall era. ( ConwayEraCertState era - , EraRule "SUBCERT" era ~ DijkstraSUBCERT era - , EraRule "SUBDELEG" era ~ DijkstraSUBDELEG era - , EraRule "SUBPOOL" era ~ DijkstraSUBPOOL era - , EraRule "SUBGOVCERT" era ~ DijkstraSUBGOVCERT era - , Embed (EraRule "SUBDELEG" era) (DijkstraSUBCERT era) - , Embed (EraRule "SUBPOOL" era) (DijkstraSUBCERT era) - , Embed (EraRule "SUBGOVCERT" era) (DijkstraSUBCERT era) + , EraRule "SUBCERT" era ~ SUBCERT era + , EraRule "SUBDELEG" era ~ SUBDELEG era + , EraRule "SUBPOOL" era ~ SUBPOOL era + , EraRule "SUBGOVCERT" era ~ SUBGOVCERT era + , Embed (EraRule "SUBDELEG" era) (SUBCERT era) + , Embed (EraRule "SUBPOOL" era) (SUBCERT era) + , Embed (EraRule "SUBGOVCERT" era) (SUBCERT era) , TxCert era ~ DijkstraTxCert era ) => TransitionRule (EraRule "SUBCERT" era) @@ -189,30 +189,30 @@ dijkstraSubCertTransition = do TRC (Conway.ConwayGovCertEnv pp currentEpoch committee committeeProposals, certState, govCert) instance - ( STS (DijkstraSUBDELEG era) + ( STS (SUBDELEG era) , PredicateFailure (EraRule "SUBDELEG" era) ~ DijkstraSubDelegPredFailure era ) => - Embed (DijkstraSUBDELEG era) (DijkstraSUBCERT era) + Embed (SUBDELEG era) (SUBCERT era) where wrapFailed = SubDelegFailure wrapEvent = absurd instance - ( STS (DijkstraSUBPOOL era) + ( STS (SUBPOOL era) , PredicateFailure (EraRule "SUBPOOL" era) ~ DijkstraSubPoolPredFailure era , Event (EraRule "SUBPOOL" era) ~ DijkstraSubPoolEvent era ) => - Embed (DijkstraSUBPOOL era) (DijkstraSUBCERT era) + Embed (SUBPOOL era) (SUBCERT era) where wrapFailed = SubPoolFailure wrapEvent = SubPoolEvent instance ( Era era - , STS (DijkstraSUBGOVCERT era) + , STS (SUBGOVCERT era) , PredicateFailure (EraRule "SUBGOVCERT" era) ~ DijkstraSubGovCertPredFailure era ) => - Embed (DijkstraSUBGOVCERT era) (DijkstraSUBCERT era) + Embed (SUBGOVCERT era) (SUBCERT era) where wrapFailed = SubGovCertFailure wrapEvent = absurd diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCerts.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCerts.hs index 407b080c71f..654ed0c65c0 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCerts.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubCerts.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubCerts ( - DijkstraSUBCERTS, + SUBCERTS, SubCertsEnv (..), DijkstraSubCertsPredFailure (..), DijkstraSubCertsEvent (..), @@ -36,8 +36,8 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBCERT, - DijkstraSUBCERTS, + SUBCERT, + SUBCERTS, ) import Cardano.Ledger.Dijkstra.Rules.Cert () import Cardano.Ledger.Dijkstra.Rules.SubCert (DijkstraSubCertEvent, DijkstraSubCertPredFailure) @@ -96,18 +96,18 @@ instance NFData (Event (EraRule "SUBCERT" era)) => NFData (DijkstraSubCertsEvent instance ( ConwayEraGov era , ConwayEraCertState era - , EraRule "SUBCERTS" era ~ DijkstraSUBCERTS era - , EraRule "SUBCERT" era ~ DijkstraSUBCERT era - , Embed (EraRule "SUBCERT" era) (DijkstraSUBCERTS era) + , EraRule "SUBCERTS" era ~ SUBCERTS era + , EraRule "SUBCERT" era ~ SUBCERT era + , Embed (EraRule "SUBCERT" era) (SUBCERTS era) ) => - STS (DijkstraSUBCERTS era) + STS (SUBCERTS era) where - type State (DijkstraSUBCERTS era) = CertState era - type Signal (DijkstraSUBCERTS era) = Seq (TxCert era) - type Environment (DijkstraSUBCERTS era) = SubCertsEnv era - type BaseM (DijkstraSUBCERTS era) = ShelleyBase - type PredicateFailure (DijkstraSUBCERTS era) = DijkstraSubCertsPredFailure era - type Event (DijkstraSUBCERTS era) = DijkstraSubCertsEvent era + type State (SUBCERTS era) = CertState era + type Signal (SUBCERTS era) = Seq (TxCert era) + type Environment (SUBCERTS era) = SubCertsEnv era + type BaseM (SUBCERTS era) = ShelleyBase + type PredicateFailure (SUBCERTS era) = DijkstraSubCertsPredFailure era + type Event (SUBCERTS era) = DijkstraSubCertsEvent era transitionRules = [dijkstraSubCertsTransition @era] @@ -115,9 +115,9 @@ dijkstraSubCertsTransition :: forall era. ( ConwayEraGov era , ConwayEraCertState era - , EraRule "SUBCERTS" era ~ DijkstraSUBCERTS era - , EraRule "SUBCERT" era ~ DijkstraSUBCERT era - , Embed (EraRule "SUBCERT" era) (DijkstraSUBCERTS era) + , EraRule "SUBCERTS" era ~ SUBCERTS era + , EraRule "SUBCERT" era ~ SUBCERT era + , Embed (EraRule "SUBCERT" era) (SUBCERTS era) ) => TransitionRule (EraRule "SUBCERTS" era) dijkstraSubCertsTransition = do @@ -131,16 +131,16 @@ dijkstraSubCertsTransition = do Empty -> pure certState gamma :|> txCert -> do certStateRest <- - trans @(DijkstraSUBCERTS era) $ TRC (env, certState, gamma) + trans @(SUBCERTS era) $ TRC (env, certState, gamma) trans @(EraRule "SUBCERT" era) $ TRC (Conway.CertEnv pp currentEpoch committee committeeProposals, certStateRest, txCert) instance - ( STS (DijkstraSUBCERT era) + ( STS (SUBCERT era) , PredicateFailure (EraRule "SUBCERT" era) ~ DijkstraSubCertPredFailure era , Event (EraRule "SUBCERT" era) ~ DijkstraSubCertEvent era ) => - Embed (DijkstraSUBCERT era) (DijkstraSUBCERTS era) + Embed (SUBCERT era) (SUBCERTS era) where wrapFailed = SubCertFailure wrapEvent = SubCertEvent diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs index f6d6e8a634e..882c1405b4d 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubDeleg.hs @@ -13,7 +13,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubDeleg ( - DijkstraSUBDELEG, + SUBDELEG, DijkstraSubDelegPredFailure (..), ) where @@ -29,7 +29,7 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.TxCert (ConwayDelegCert) import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBDELEG, + SUBDELEG, ) import Cardano.Ledger.Dijkstra.State import Control.DeepSeq (NFData) @@ -61,16 +61,16 @@ instance InjectRuleFailure "SUBDELEG" Conway.ConwayDelegPredFailure DijkstraEra instance ( EraGov era , ConwayEraCertState era - , EraRule "SUBDELEG" era ~ DijkstraSUBDELEG era + , EraRule "SUBDELEG" era ~ SUBDELEG era , InjectRuleFailure "SUBDELEG" Conway.ConwayDelegPredFailure era ) => - STS (DijkstraSUBDELEG era) + STS (SUBDELEG era) where - type State (DijkstraSUBDELEG era) = CertState era - type Signal (DijkstraSUBDELEG era) = ConwayDelegCert - type Environment (DijkstraSUBDELEG era) = Conway.ConwayDelegEnv era - type BaseM (DijkstraSUBDELEG era) = ShelleyBase - type PredicateFailure (DijkstraSUBDELEG era) = DijkstraSubDelegPredFailure era - type Event (DijkstraSUBDELEG era) = Void + type State (SUBDELEG era) = CertState era + type Signal (SUBDELEG era) = ConwayDelegCert + type Environment (SUBDELEG era) = Conway.ConwayDelegEnv era + type BaseM (SUBDELEG era) = ShelleyBase + type PredicateFailure (SUBDELEG era) = DijkstraSubDelegPredFailure era + type Event (SUBDELEG era) = Void transitionRules = [Conway.conwayDelegTransition] diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGov.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGov.hs index 0d452980f58..205aadf4724 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGov.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGov.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubGov ( - DijkstraSUBGOV, + SUBGOV, DijkstraSubGovPredFailure (..), DijkstraSubGovEvent (..), ) where @@ -33,7 +33,7 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State (ConwayEraCertState) import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBGOV, + SUBGOV, ) import Cardano.Ledger.Dijkstra.Rules.Gov (DijkstraGovPredFailure, conwayToDijkstraGovPredFailure) import Control.DeepSeq (NFData) @@ -68,19 +68,19 @@ instance , ConwayEraTxCert era , ConwayEraPParams era , ConwayEraGov era - , EraRule "SUBGOV" era ~ DijkstraSUBGOV era + , EraRule "SUBGOV" era ~ SUBGOV era , InjectRuleEvent "SUBGOV" DijkstraSubGovEvent era , InjectRuleEvent "SUBGOV" Conway.ConwayGovEvent era , InjectRuleFailure "SUBGOV" DijkstraSubGovPredFailure era , InjectRuleFailure "SUBGOV" Conway.ConwayGovPredFailure era ) => - STS (DijkstraSUBGOV era) + STS (SUBGOV era) where - type State (DijkstraSUBGOV era) = Proposals era - type Signal (DijkstraSUBGOV era) = Conway.GovSignal era - type Environment (DijkstraSUBGOV era) = Conway.GovEnv era - type BaseM (DijkstraSUBGOV era) = ShelleyBase - type PredicateFailure (DijkstraSUBGOV era) = DijkstraSubGovPredFailure era - type Event (DijkstraSUBGOV era) = DijkstraSubGovEvent era + type State (SUBGOV era) = Proposals era + type Signal (SUBGOV era) = Conway.GovSignal era + type Environment (SUBGOV era) = Conway.GovEnv era + type BaseM (SUBGOV era) = ShelleyBase + type PredicateFailure (SUBGOV era) = DijkstraSubGovPredFailure era + type Event (SUBGOV era) = DijkstraSubGovEvent era transitionRules = [Conway.conwayGovTransition] diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGovCert.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGovCert.hs index 10f680627a0..ff6160cb587 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGovCert.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubGovCert.hs @@ -13,7 +13,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubGovCert ( - DijkstraSUBGOVCERT, + SUBGOVCERT, DijkstraSubGovCertPredFailure (..), ) where @@ -30,7 +30,7 @@ import Cardano.Ledger.Conway.State import Cardano.Ledger.Conway.TxCert (ConwayGovCert) import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBGOVCERT, + SUBGOVCERT, ) import Cardano.Ledger.Dijkstra.Rules.GovCert ( DijkstraGovCertPredFailure, @@ -70,17 +70,17 @@ instance ( EraGov era , ConwayEraPParams era , ConwayEraCertState era - , EraRule "SUBGOVCERT" era ~ DijkstraSUBGOVCERT era + , EraRule "SUBGOVCERT" era ~ SUBGOVCERT era , InjectRuleFailure "SUBGOVCERT" Conway.ConwayGovCertPredFailure era , InjectRuleFailure "SUBGOVCERT" DijkstraSubGovCertPredFailure era ) => - STS (DijkstraSUBGOVCERT era) + STS (SUBGOVCERT era) where - type State (DijkstraSUBGOVCERT era) = CertState era - type Signal (DijkstraSUBGOVCERT era) = ConwayGovCert - type Environment (DijkstraSUBGOVCERT era) = Conway.ConwayGovCertEnv era - type BaseM (DijkstraSUBGOVCERT era) = ShelleyBase - type PredicateFailure (DijkstraSUBGOVCERT era) = DijkstraSubGovCertPredFailure era - type Event (DijkstraSUBGOVCERT era) = Void + type State (SUBGOVCERT era) = CertState era + type Signal (SUBGOVCERT era) = ConwayGovCert + type Environment (SUBGOVCERT era) = Conway.ConwayGovCertEnv era + type BaseM (SUBGOVCERT era) = ShelleyBase + type PredicateFailure (SUBGOVCERT era) = DijkstraSubGovCertPredFailure era + type Event (SUBGOVCERT era) = Void transitionRules = [Conway.conwayGovCertTransition] diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedger.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedger.hs index a0e9aa398eb..87c68d7fe52 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedger.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedger.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubLedger ( - DijkstraSUBLEDGER, + SUBLEDGER, DijkstraSubLedgerPredFailure (..), DijkstraSubLedgerEvent (..), SubLedgerEnv (..), @@ -36,15 +36,15 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBCERT, - DijkstraSUBCERTS, - DijkstraSUBDELEG, - DijkstraSUBGOV, - DijkstraSUBGOVCERT, - DijkstraSUBLEDGER, - DijkstraSUBPOOL, - DijkstraSUBUTXO, - DijkstraSUBUTXOW, + SUBCERT, + SUBCERTS, + SUBDELEG, + SUBGOV, + SUBGOVCERT, + SUBLEDGER, + SUBPOOL, + SUBUTXO, + SUBUTXOW, ) import Cardano.Ledger.Dijkstra.Rules.Gov (DijkstraGovPredFailure (..)) import Cardano.Ledger.Dijkstra.Rules.SubCerts ( @@ -173,18 +173,18 @@ instance , ConwayEraTxBody era , ConwayEraGov era , ConwayEraCertState era - , EraRule "SUBLEDGER" era ~ DijkstraSUBLEDGER era - , EraRule "SUBGOV" era ~ DijkstraSUBGOV era - , EraRule "SUBUTXO" era ~ DijkstraSUBUTXO era - , EraRule "SUBUTXOW" era ~ DijkstraSUBUTXOW era - , EraRule "SUBCERTS" era ~ DijkstraSUBCERTS era - , EraRule "SUBCERT" era ~ DijkstraSUBCERT era - , EraRule "SUBDELEG" era ~ DijkstraSUBDELEG era - , EraRule "SUBPOOL" era ~ DijkstraSUBPOOL era - , EraRule "SUBGOVCERT" era ~ DijkstraSUBGOVCERT era - , Embed (EraRule "SUBGOV" era) (DijkstraSUBLEDGER era) - , Embed (EraRule "SUBUTXOW" era) (DijkstraSUBLEDGER era) - , Embed (EraRule "SUBCERTS" era) (DijkstraSUBCERTS era) + , EraRule "SUBLEDGER" era ~ SUBLEDGER era + , EraRule "SUBGOV" era ~ SUBGOV era + , EraRule "SUBUTXO" era ~ SUBUTXO era + , EraRule "SUBUTXOW" era ~ SUBUTXOW era + , EraRule "SUBCERTS" era ~ SUBCERTS era + , EraRule "SUBCERT" era ~ SUBCERT era + , EraRule "SUBDELEG" era ~ SUBDELEG era + , EraRule "SUBPOOL" era ~ SUBPOOL era + , EraRule "SUBGOVCERT" era ~ SUBGOVCERT era + , Embed (EraRule "SUBGOV" era) (SUBLEDGER era) + , Embed (EraRule "SUBUTXOW" era) (SUBLEDGER era) + , Embed (EraRule "SUBCERTS" era) (SUBCERTS era) , InjectRuleEvent "SUBPOOL" Shelley.PoolEvent era , InjectRuleEvent "SUBPOOL" DijkstraSubPoolEvent era , InjectRuleFailure "SUBPOOL" Shelley.ShelleyPoolPredFailure era @@ -197,14 +197,14 @@ instance , InjectRuleFailure "SUBUTXOW" Alonzo.AlonzoUtxowPredFailure era , TxCert era ~ DijkstraTxCert era ) => - STS (DijkstraSUBLEDGER era) + STS (SUBLEDGER era) where - type State (DijkstraSUBLEDGER era) = LedgerState era - type Signal (DijkstraSUBLEDGER era) = StAnnTx SubTx era - type Environment (DijkstraSUBLEDGER era) = SubLedgerEnv era - type BaseM (DijkstraSUBLEDGER era) = ShelleyBase - type PredicateFailure (DijkstraSUBLEDGER era) = DijkstraSubLedgerPredFailure era - type Event (DijkstraSUBLEDGER era) = DijkstraSubLedgerEvent era + type State (SUBLEDGER era) = LedgerState era + type Signal (SUBLEDGER era) = StAnnTx SubTx era + type Environment (SUBLEDGER era) = SubLedgerEnv era + type BaseM (SUBLEDGER era) = ShelleyBase + type PredicateFailure (SUBLEDGER era) = DijkstraSubLedgerPredFailure era + type Event (SUBLEDGER era) = DijkstraSubLedgerEvent era transitionRules = [dijkstraSubLedgersTransition @era] @@ -214,16 +214,16 @@ dijkstraSubLedgersTransition :: , ConwayEraTxBody era , ConwayEraGov era , ConwayEraCertState era - , EraRule "SUBLEDGER" era ~ DijkstraSUBLEDGER era - , EraRule "SUBGOV" era ~ DijkstraSUBGOV era - , EraRule "SUBUTXOW" era ~ DijkstraSUBUTXOW era - , EraRule "SUBCERTS" era ~ DijkstraSUBCERTS era - , EraRule "SUBCERT" era ~ DijkstraSUBCERT era - , EraRule "SUBDELEG" era ~ DijkstraSUBDELEG era - , EraRule "SUBPOOL" era ~ DijkstraSUBPOOL era - , EraRule "SUBGOVCERT" era ~ DijkstraSUBGOVCERT era - , Embed (EraRule "SUBGOV" era) (DijkstraSUBLEDGER era) - , Embed (EraRule "SUBUTXOW" era) (DijkstraSUBLEDGER era) + , EraRule "SUBLEDGER" era ~ SUBLEDGER era + , EraRule "SUBGOV" era ~ SUBGOV era + , EraRule "SUBUTXOW" era ~ SUBUTXOW era + , EraRule "SUBCERTS" era ~ SUBCERTS era + , EraRule "SUBCERT" era ~ SUBCERT era + , EraRule "SUBDELEG" era ~ SUBDELEG era + , EraRule "SUBPOOL" era ~ SUBPOOL era + , EraRule "SUBGOVCERT" era ~ SUBGOVCERT era + , Embed (EraRule "SUBGOV" era) (SUBLEDGER era) + , Embed (EraRule "SUBUTXOW" era) (SUBLEDGER era) , InjectRuleFailure "SUBLEDGER" Conway.ConwayLedgerPredFailure era , InjectRuleEvent "SUBPOOL" Shelley.PoolEvent era , InjectRuleEvent "SUBPOOL" DijkstraSubPoolEvent era @@ -299,31 +299,31 @@ dijkstraSubLedgersTransition = do & lsCertStateL .~ certStateAfterSubCerts instance - ( STS (DijkstraSUBGOV era) + ( STS (SUBGOV era) , PredicateFailure (EraRule "SUBGOV" era) ~ DijkstraSubGovPredFailure era , Event (EraRule "SUBGOV" era) ~ DijkstraSubGovEvent era ) => - Embed (DijkstraSUBGOV era) (DijkstraSUBLEDGER era) + Embed (SUBGOV era) (SUBLEDGER era) where wrapFailed = SubGovFailure wrapEvent = SubGovEvent instance - ( STS (DijkstraSUBUTXOW era) + ( STS (SUBUTXOW era) , PredicateFailure (EraRule "SUBUTXOW" era) ~ DijkstraSubUtxowPredFailure era , Event (EraRule "SUBUTXOW" era) ~ DijkstraSubUtxowEvent era ) => - Embed (DijkstraSUBUTXOW era) (DijkstraSUBLEDGER era) + Embed (SUBUTXOW era) (SUBLEDGER era) where wrapFailed = SubUtxowFailure wrapEvent = SubUtxowEvent instance - ( STS (DijkstraSUBCERTS era) + ( STS (SUBCERTS era) , PredicateFailure (EraRule "SUBCERTS" era) ~ DijkstraSubCertsPredFailure era , Event (EraRule "SUBCERTS" era) ~ DijkstraSubCertsEvent era ) => - Embed (DijkstraSUBCERTS era) (DijkstraSUBLEDGER era) + Embed (SUBCERTS era) (SUBLEDGER era) where wrapFailed = SubCertsFailure wrapEvent = SubCertsEvent diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedgers.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedgers.hs index 3b2d59db38d..b5d146683f4 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedgers.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubLedgers.hs @@ -14,7 +14,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubLedgers ( - DijkstraSUBLEDGERS, + SUBLEDGERS, DijkstraSubLedgersPredFailure (..), DijkstraSubLedgersEvent (..), ) where @@ -32,8 +32,8 @@ import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Conway.State import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBLEDGER, - DijkstraSUBLEDGERS, + SUBLEDGER, + SUBLEDGERS, ) import Cardano.Ledger.Dijkstra.Rules.SubLedger ( DijkstraSubLedgerEvent, @@ -99,30 +99,30 @@ instance ( ConwayEraGov era , ConwayEraCertState era , EraPlutusContext era - , EraRule "SUBLEDGERS" era ~ DijkstraSUBLEDGERS era - , EraRule "SUBLEDGER" era ~ DijkstraSUBLEDGER era - , Embed (EraRule "SUBLEDGER" era) (DijkstraSUBLEDGERS era) + , EraRule "SUBLEDGERS" era ~ SUBLEDGERS era + , EraRule "SUBLEDGER" era ~ SUBLEDGER era + , Embed (EraRule "SUBLEDGER" era) (SUBLEDGERS era) , InjectRuleEvent "SUBPOOL" Shelley.PoolEvent era , InjectRuleEvent "SUBPOOL" DijkstraSubPoolEvent era , InjectRuleFailure "SUBPOOL" Shelley.ShelleyPoolPredFailure era , InjectRuleFailure "SUBPOOL" DijkstraSubPoolPredFailure era ) => - STS (DijkstraSUBLEDGERS era) + STS (SUBLEDGERS era) where - type State (DijkstraSUBLEDGERS era) = LedgerState era - type Signal (DijkstraSUBLEDGERS era) = [StAnnTx SubTx era] - type Environment (DijkstraSUBLEDGERS era) = SubLedgerEnv era - type BaseM (DijkstraSUBLEDGERS era) = ShelleyBase - type PredicateFailure (DijkstraSUBLEDGERS era) = DijkstraSubLedgersPredFailure era - type Event (DijkstraSUBLEDGERS era) = DijkstraSubLedgersEvent era + type State (SUBLEDGERS era) = LedgerState era + type Signal (SUBLEDGERS era) = [StAnnTx SubTx era] + type Environment (SUBLEDGERS era) = SubLedgerEnv era + type BaseM (SUBLEDGERS era) = ShelleyBase + type PredicateFailure (SUBLEDGERS era) = DijkstraSubLedgersPredFailure era + type Event (SUBLEDGERS era) = DijkstraSubLedgersEvent era transitionRules = [dijkstraSubLedgersTransition @era] dijkstraSubLedgersTransition :: forall era. - ( EraRule "SUBLEDGERS" era ~ DijkstraSUBLEDGERS era - , EraRule "SUBLEDGER" era ~ DijkstraSUBLEDGER era - , Embed (EraRule "SUBLEDGER" era) (DijkstraSUBLEDGERS era) + ( EraRule "SUBLEDGERS" era ~ SUBLEDGERS era + , EraRule "SUBLEDGER" era ~ SUBLEDGER era + , Embed (EraRule "SUBLEDGER" era) (SUBLEDGERS era) ) => TransitionRule (EraRule "SUBLEDGERS" era) dijkstraSubLedgersTransition = do @@ -135,11 +135,11 @@ dijkstraSubLedgersTransition = do subTxs instance - ( STS (DijkstraSUBLEDGER era) + ( STS (SUBLEDGER era) , PredicateFailure (EraRule "SUBLEDGER" era) ~ DijkstraSubLedgerPredFailure era , Event (EraRule "SUBLEDGER" era) ~ DijkstraSubLedgerEvent era ) => - Embed (DijkstraSUBLEDGER era) (DijkstraSUBLEDGERS era) + Embed (SUBLEDGER era) (SUBLEDGERS era) where wrapFailed = SubLedgerFailure wrapEvent = SubLedgerEvent diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubPool.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubPool.hs index bb6b8855042..28f5b670bfd 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubPool.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubPool.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubPool ( - DijkstraSUBPOOL, + SUBPOOL, DijkstraSubPoolPredFailure (..), DijkstraSubPoolEvent (..), ) where @@ -30,7 +30,7 @@ import Cardano.Ledger.Binary ( import Cardano.Ledger.Conway.Core import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBPOOL, + SUBPOOL, ) import Cardano.Ledger.Dijkstra.State import qualified Cardano.Ledger.Shelley.Rules as Shelley @@ -69,19 +69,19 @@ newtype DijkstraSubPoolEvent era = DijkstraSubPoolEvent (Shelley.PoolEvent era) instance ( EraGov era - , EraRule "SUBPOOL" era ~ DijkstraSUBPOOL era + , EraRule "SUBPOOL" era ~ SUBPOOL era , InjectRuleEvent "SUBPOOL" DijkstraSubPoolEvent era , InjectRuleEvent "SUBPOOL" Shelley.PoolEvent era , InjectRuleFailure "SUBPOOL" DijkstraSubPoolPredFailure era , InjectRuleFailure "SUBPOOL" Shelley.ShelleyPoolPredFailure era ) => - STS (DijkstraSUBPOOL era) + STS (SUBPOOL era) where - type State (DijkstraSUBPOOL era) = PState era - type Signal (DijkstraSUBPOOL era) = PoolCert - type Environment (DijkstraSUBPOOL era) = Shelley.PoolEnv era - type BaseM (DijkstraSUBPOOL era) = ShelleyBase - type PredicateFailure (DijkstraSUBPOOL era) = DijkstraSubPoolPredFailure era - type Event (DijkstraSUBPOOL era) = DijkstraSubPoolEvent era + type State (SUBPOOL era) = PState era + type Signal (SUBPOOL era) = PoolCert + type Environment (SUBPOOL era) = Shelley.PoolEnv era + type BaseM (SUBPOOL era) = ShelleyBase + type PredicateFailure (SUBPOOL era) = DijkstraSubPoolPredFailure era + type Event (SUBPOOL era) = DijkstraSubPoolEvent era transitionRules = [Shelley.poolTransition] diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs index ec63c09721c..beb2257c9ca 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxo.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubUtxo ( - DijkstraSUBUTXO, + SUBUTXO, DijkstraSubUtxoPredFailure (..), DijkstraSubUtxoEvent (..), SubUtxoEnv (..), @@ -38,7 +38,7 @@ import Cardano.Ledger.Conway.Governance import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBUTXO, + SUBUTXO, ) import Cardano.Ledger.Dijkstra.Rules.Utxo ( DijkstraUtxoPredFailure (..), @@ -194,21 +194,21 @@ instance , DijkstraEraTxBody era , AlonzoEraTxWits era , ConwayEraGov era - , EraRule "SUBUTXO" era ~ DijkstraSUBUTXO era + , EraRule "SUBUTXO" era ~ SUBUTXO era , InjectRuleFailure "SUBUTXO" Shelley.ShelleyUtxoPredFailure era , InjectRuleFailure "SUBUTXO" Allegra.AllegraUtxoPredFailure era , InjectRuleFailure "SUBUTXO" Alonzo.AlonzoUtxoPredFailure era , InjectRuleFailure "SUBUTXO" Babbage.BabbageUtxoPredFailure era , InjectRuleFailure "SUBUTXO" DijkstraUtxoPredFailure era ) => - STS (DijkstraSUBUTXO era) + STS (SUBUTXO era) where - type State (DijkstraSUBUTXO era) = UTxOState era - type Signal (DijkstraSUBUTXO era) = StAnnTx SubTx era - type Environment (DijkstraSUBUTXO era) = SubUtxoEnv era - type BaseM (DijkstraSUBUTXO era) = ShelleyBase - type PredicateFailure (DijkstraSUBUTXO era) = DijkstraSubUtxoPredFailure era - type Event (DijkstraSUBUTXO era) = DijkstraSubUtxoEvent era + type State (SUBUTXO era) = UTxOState era + type Signal (SUBUTXO era) = StAnnTx SubTx era + type Environment (SUBUTXO era) = SubUtxoEnv era + type BaseM (SUBUTXO era) = ShelleyBase + type PredicateFailure (SUBUTXO era) = DijkstraSubUtxoPredFailure era + type Event (SUBUTXO era) = DijkstraSubUtxoEvent era transitionRules = [dijkstraSubUtxoTransition @era] @@ -220,7 +220,7 @@ dijkstraSubUtxoTransition :: , DijkstraEraTxBody era , AlonzoEraTxWits era , STS (EraRule "SUBUTXO" era) - , EraRule "SUBUTXO" era ~ DijkstraSUBUTXO era + , EraRule "SUBUTXO" era ~ SUBUTXO era , InjectRuleFailure "SUBUTXO" Shelley.ShelleyUtxoPredFailure era , InjectRuleFailure "SUBUTXO" Allegra.AllegraUtxoPredFailure era , InjectRuleFailure "SUBUTXO" Alonzo.AlonzoUtxoPredFailure era diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs index 57ced4ebc84..d973cafd3a5 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/SubUtxow.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubUtxow ( - DijkstraSUBUTXOW, + SUBUTXOW, DijkstraSubUtxowPredFailure (..), DijkstraSubUtxowEvent (..), ) where @@ -39,7 +39,7 @@ import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Credential (Credential, credScriptHash) import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, - DijkstraSUBUTXOW, + SUBUTXOW, ) import Cardano.Ledger.Dijkstra.Rules.SubUtxo import Cardano.Ledger.Dijkstra.Rules.Utxo (DijkstraUtxoPredFailure (..)) @@ -179,23 +179,23 @@ instance , ConwayEraTxBody era , DijkstraEraTxBody era , EraPlutusContext era - , EraRule "SUBUTXO" era ~ DijkstraSUBUTXO era - , EraRule "SUBUTXOW" era ~ DijkstraSUBUTXOW era - , Embed (EraRule "SUBUTXO" era) (DijkstraSUBUTXOW era) + , EraRule "SUBUTXO" era ~ SUBUTXO era + , EraRule "SUBUTXOW" era ~ SUBUTXOW era + , Embed (EraRule "SUBUTXO" era) (SUBUTXOW era) , InjectRuleFailure "SUBUTXOW" Alonzo.AlonzoUtxowPredFailure era , InjectRuleFailure "SUBUTXOW" Shelley.ShelleyUtxowPredFailure era , InjectRuleFailure "SUBUTXOW" Babbage.BabbageUtxowPredFailure era , InjectRuleFailure "SUBUTXOW" DijkstraSubUtxowPredFailure era , ScriptsNeeded era ~ AlonzoScriptsNeeded era ) => - STS (DijkstraSUBUTXOW era) + STS (SUBUTXOW era) where - type State (DijkstraSUBUTXOW era) = UTxOState era - type Signal (DijkstraSUBUTXOW era) = StAnnTx SubTx era - type Environment (DijkstraSUBUTXOW era) = SubUtxoEnv era - type BaseM (DijkstraSUBUTXOW era) = ShelleyBase - type PredicateFailure (DijkstraSUBUTXOW era) = DijkstraSubUtxowPredFailure era - type Event (DijkstraSUBUTXOW era) = DijkstraSubUtxowEvent era + type State (SUBUTXOW era) = UTxOState era + type Signal (SUBUTXOW era) = StAnnTx SubTx era + type Environment (SUBUTXOW era) = SubUtxoEnv era + type BaseM (SUBUTXOW era) = ShelleyBase + type PredicateFailure (SUBUTXOW era) = DijkstraSubUtxowPredFailure era + type Event (SUBUTXOW era) = DijkstraSubUtxowEvent era transitionRules = [dijkstraSubUtxowTransition @era] @@ -239,9 +239,9 @@ dijkstraSubUtxowTransition :: ( AlonzoEraTx era , AlonzoEraUTxO era , DijkstraEraTxBody era - , EraRule "SUBUTXO" era ~ DijkstraSUBUTXO era - , EraRule "SUBUTXOW" era ~ DijkstraSUBUTXOW era - , Embed (EraRule "SUBUTXO" era) (DijkstraSUBUTXOW era) + , EraRule "SUBUTXO" era ~ SUBUTXO era + , EraRule "SUBUTXOW" era ~ SUBUTXOW era + , Embed (EraRule "SUBUTXO" era) (SUBUTXOW era) , InjectRuleFailure "SUBUTXOW" Alonzo.AlonzoUtxowPredFailure era , InjectRuleFailure "SUBUTXOW" Shelley.ShelleyUtxowPredFailure era , InjectRuleFailure "SUBUTXOW" Babbage.BabbageUtxowPredFailure era @@ -291,11 +291,11 @@ dijkstraSubUtxowTransition = do trans @(EraRule "SUBUTXO" era) $ TRC (env, utxoState, stAnnTx) instance - ( STS (DijkstraSUBUTXO era) + ( STS (SUBUTXO era) , PredicateFailure (EraRule "SUBUTXO" era) ~ DijkstraSubUtxoPredFailure era , Event (EraRule "SUBUTXO" era) ~ DijkstraSubUtxoEvent era ) => - Embed (DijkstraSUBUTXO era) (DijkstraSUBUTXOW era) + Embed (SUBUTXO era) (SUBUTXOW era) where wrapFailed = SubUtxoFailure wrapEvent = SubUtxo diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs index ff2517d8113..30f52e233f4 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxo.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.Utxo ( - DijkstraUTXO, + UTXO, DijkstraUtxoEnv (..), DijkstraUtxoPredFailure (..), conwayToDijkstraUtxoPredFailure, @@ -58,7 +58,7 @@ import Cardano.Ledger.Conway.Core import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State import Cardano.Ledger.Credential (StakeReference (..)) -import Cardano.Ledger.Dijkstra.Era (DijkstraEra, DijkstraUTXO) +import Cardano.Ledger.Dijkstra.Era (DijkstraEra, UTXO) import Cardano.Ledger.Dijkstra.Rules.Utxos () import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..)) import Cardano.Ledger.Plutus (ExUnits) @@ -426,7 +426,7 @@ dijkstraUtxoTransition = do (Conway.updateTreasuryDonation tx utxos) -------------------------------------------------------------------------------- --- DijkstraUTXO STS +-- UTXO STS -------------------------------------------------------------------------------- instance @@ -436,7 +436,7 @@ instance , EraStake era , DijkstraEraTxBody era , AlonzoEraTx era - , EraRule "UTXO" era ~ DijkstraUTXO era + , EraRule "UTXO" era ~ UTXO era , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era , InjectRuleFailure "UTXO" Allegra.AllegraUtxoPredFailure era , InjectRuleFailure "UTXO" Alonzo.AlonzoUtxoPredFailure era @@ -449,22 +449,22 @@ instance , BaseM (EraRule "UTXO" era) ~ ShelleyBase , STS (EraRule "UTXO" era) , -- In this function we we call the UTXOS rule, so we need some assumptions - Embed (EraRule "UTXOS" era) (DijkstraUTXO era) + Embed (EraRule "UTXOS" era) (UTXO era) , Environment (EraRule "UTXOS" era) ~ () , State (EraRule "UTXOS" era) ~ () , Signal (EraRule "UTXOS" era) ~ StAnnTx TopTx era , EraCertState era - , EraRule "UTXO" era ~ DijkstraUTXO era + , EraRule "UTXO" era ~ UTXO era , SafeToHash (TxWits era) ) => - STS (DijkstraUTXO era) + STS (UTXO era) where - type State (DijkstraUTXO era) = UTxOState era - type Signal (DijkstraUTXO era) = StAnnTx TopTx era - type Environment (DijkstraUTXO era) = DijkstraUtxoEnv era - type BaseM (DijkstraUTXO era) = ShelleyBase - type PredicateFailure (DijkstraUTXO era) = DijkstraUtxoPredFailure era - type Event (DijkstraUTXO era) = Alonzo.AlonzoUtxoEvent era + type State (UTXO era) = UTxOState era + type Signal (UTXO era) = StAnnTx TopTx era + type Environment (UTXO era) = DijkstraUtxoEnv era + type BaseM (UTXO era) = ShelleyBase + type PredicateFailure (UTXO era) = DijkstraUtxoPredFailure era + type Event (UTXO era) = Alonzo.AlonzoUtxoEvent era initialRules = [] @@ -473,11 +473,11 @@ instance assertions = [Shelley.validSizeComputationCheck] instance - ( STS (Conway.ConwayUTXOS era) + ( STS (Conway.UTXOS era) , PredicateFailure (EraRule "UTXOS" era) ~ Conway.ConwayUtxosPredFailure era - , Event (EraRule "UTXOS" era) ~ Event (Conway.ConwayUTXOS era) + , Event (EraRule "UTXOS" era) ~ Event (Conway.UTXOS era) ) => - Embed (Conway.ConwayUTXOS era) (DijkstraUTXO era) + Embed (Conway.UTXOS era) (UTXO era) where wrapFailed = UtxosFailure wrapEvent = Alonzo.UtxosEvent @@ -575,7 +575,7 @@ conwayToDijkstraUtxoPredFailure = \case Conway.ValueNotConservedUTxO m -> ValueNotConservedUTxO m Conway.WrongNetwork x y -> WrongNetwork x y Conway.WrongNetworkWithdrawal x y -> WrongNetworkWithdrawal x y - Conway.OutputTooSmallUTxO _ -> error "Impossible: `OutputTooSmallUTxO` for DijkstraUTXO" + Conway.OutputTooSmallUTxO _ -> error "Impossible: `OutputTooSmallUTxO` for UTXO" Conway.UtxosFailure x -> UtxosFailure x Conway.OutputBootAddrAttrsTooBig xs -> OutputBootAddrAttrsTooBig xs Conway.OutputTooBigUTxO xs -> OutputTooBigUTxO xs diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxow.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxow.hs index af18b16be06..ed402132d62 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxow.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Utxow.hs @@ -17,7 +17,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.Utxow ( - DijkstraUTXOW, + UTXOW, DijkstraUtxowPredFailure (..), conwayToDijkstraUtxowPredFailure, ) where @@ -50,7 +50,7 @@ import Cardano.Ledger.Binary.Coders ( import Cardano.Ledger.Conway.Core import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Credential (Credential) -import Cardano.Ledger.Dijkstra.Era (DijkstraEra, DijkstraUTXO, DijkstraUTXOW) +import Cardano.Ledger.Dijkstra.Era (DijkstraEra, UTXO, UTXOW) import Cardano.Ledger.Dijkstra.Rules.Utxo (DijkstraUtxoEnv (..), DijkstraUtxoPredFailure) import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..)) import Cardano.Ledger.Dijkstra.UTxO (DijkstraEraUTxO (..)) @@ -195,7 +195,7 @@ instance NFData (DijkstraUtxowPredFailure era) -------------------------------------------------------------------------------- --- DijkstraUTXOW STS +-- UTXOW STS -------------------------------------------------------------------------------- dijkstraUtxowTransition :: @@ -204,13 +204,13 @@ dijkstraUtxowTransition :: , DijkstraEraUTxO era , ScriptsNeeded era ~ AlonzoScriptsNeeded era , DijkstraEraTxBody era - , EraRule "UTXOW" era ~ DijkstraUTXOW era + , EraRule "UTXOW" era ~ UTXOW era , InjectRuleFailure "UTXOW" Shelley.ShelleyUtxowPredFailure era , InjectRuleFailure "UTXOW" Alonzo.AlonzoUtxowPredFailure era , InjectRuleFailure "UTXOW" Babbage.BabbageUtxowPredFailure era , InjectRuleFailure "UTXOW" DijkstraUtxowPredFailure era , -- Allow UTXOW to call UTXO - Embed (EraRule "UTXO" era) (DijkstraUTXOW era) + Embed (EraRule "UTXO" era) (UTXOW era) , Environment (EraRule "UTXO" era) ~ DijkstraUtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era @@ -306,37 +306,37 @@ instance , DijkstraEraUTxO era , ScriptsNeeded era ~ AlonzoScriptsNeeded era , DijkstraEraTxBody era - , EraRule "UTXOW" era ~ DijkstraUTXOW era + , EraRule "UTXOW" era ~ UTXOW era , InjectRuleFailure "UTXOW" Shelley.ShelleyUtxowPredFailure era , InjectRuleFailure "UTXOW" Alonzo.AlonzoUtxowPredFailure era , InjectRuleFailure "UTXOW" Babbage.BabbageUtxowPredFailure era , InjectRuleFailure "UTXOW" Conway.ConwayUtxowPredFailure era , InjectRuleFailure "UTXOW" DijkstraUtxowPredFailure era , -- Allow UTXOW to call UTXO - Embed (EraRule "UTXO" era) (DijkstraUTXOW era) + Embed (EraRule "UTXO" era) (UTXOW era) , Environment (EraRule "UTXO" era) ~ DijkstraUtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era , Eq (PredicateFailure (EraRule "UTXOS" era)) , Show (PredicateFailure (EraRule "UTXOS" era)) ) => - STS (DijkstraUTXOW era) + STS (UTXOW era) where - type State (DijkstraUTXOW era) = UTxOState era - type Signal (DijkstraUTXOW era) = StAnnTx TopTx era - type Environment (DijkstraUTXOW era) = DijkstraUtxoEnv era - type BaseM (DijkstraUTXOW era) = ShelleyBase - type PredicateFailure (DijkstraUTXOW era) = DijkstraUtxowPredFailure era - type Event (DijkstraUTXOW era) = Alonzo.AlonzoUtxowEvent era + type State (UTXOW era) = UTxOState era + type Signal (UTXOW era) = StAnnTx TopTx era + type Environment (UTXOW era) = DijkstraUtxoEnv era + type BaseM (UTXOW era) = ShelleyBase + type PredicateFailure (UTXOW era) = DijkstraUtxowPredFailure era + type Event (UTXOW era) = Alonzo.AlonzoUtxowEvent era transitionRules = [dijkstraUtxowTransition @era] initialRules = [] instance - ( STS (DijkstraUTXO era) + ( STS (UTXO era) , PredicateFailure (EraRule "UTXO" era) ~ DijkstraUtxoPredFailure era , Event (EraRule "UTXO" era) ~ Alonzo.AlonzoUtxoEvent era ) => - Embed (DijkstraUTXO era) (DijkstraUTXOW era) + Embed (UTXO era) (UTXOW era) where wrapFailed = UtxoFailure wrapEvent = Alonzo.WrappedShelleyEraEvent . Shelley.UtxoEvent diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs index 2aa36c5bf27..35b197065bb 100644 --- a/eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs +++ b/eras/mary/impl/src/Cardano/Ledger/Mary/Era.hs @@ -32,42 +32,42 @@ type instance Value MaryEra = MaryValue -- These rules are all inherited from Shelley -type instance EraRule "BBODY" MaryEra = Shelley.ShelleyBBODY MaryEra +type instance EraRule "BBODY" MaryEra = Shelley.BBODY MaryEra -type instance EraRule "DELEG" MaryEra = Shelley.ShelleyDELEG MaryEra +type instance EraRule "DELEG" MaryEra = Shelley.DELEG MaryEra -type instance EraRule "DELEGS" MaryEra = Shelley.ShelleyDELEGS MaryEra +type instance EraRule "DELEGS" MaryEra = Shelley.DELEGS MaryEra -type instance EraRule "DELPL" MaryEra = Shelley.ShelleyDELPL MaryEra +type instance EraRule "DELPL" MaryEra = Shelley.DELPL MaryEra -type instance EraRule "EPOCH" MaryEra = Shelley.ShelleyEPOCH MaryEra +type instance EraRule "EPOCH" MaryEra = Shelley.EPOCH MaryEra -type instance EraRule "LEDGER" MaryEra = Shelley.ShelleyLEDGER MaryEra +type instance EraRule "LEDGER" MaryEra = Shelley.LEDGER MaryEra -type instance EraRule "LEDGERS" MaryEra = Shelley.ShelleyLEDGERS MaryEra +type instance EraRule "LEDGERS" MaryEra = Shelley.LEDGERS MaryEra -type instance EraRule "MIR" MaryEra = Shelley.ShelleyMIR MaryEra +type instance EraRule "MIR" MaryEra = Shelley.MIR MaryEra -type instance EraRule "NEWEPOCH" MaryEra = Shelley.ShelleyNEWEPOCH MaryEra +type instance EraRule "NEWEPOCH" MaryEra = Shelley.NEWEPOCH MaryEra -type instance EraRule "NEWPP" MaryEra = Shelley.ShelleyNEWPP MaryEra +type instance EraRule "NEWPP" MaryEra = Shelley.NEWPP MaryEra -type instance EraRule "POOL" MaryEra = Shelley.ShelleyPOOL MaryEra +type instance EraRule "POOL" MaryEra = Shelley.POOL MaryEra -type instance EraRule "POOLREAP" MaryEra = Shelley.ShelleyPOOLREAP MaryEra +type instance EraRule "POOLREAP" MaryEra = Shelley.POOLREAP MaryEra -type instance EraRule "PPUP" MaryEra = Shelley.ShelleyPPUP MaryEra +type instance EraRule "PPUP" MaryEra = Shelley.PPUP MaryEra -type instance EraRule "RUPD" MaryEra = Shelley.ShelleyRUPD MaryEra +type instance EraRule "RUPD" MaryEra = Shelley.RUPD MaryEra -type instance EraRule "SNAP" MaryEra = Shelley.ShelleySNAP MaryEra +type instance EraRule "SNAP" MaryEra = Shelley.SNAP MaryEra -type instance EraRule "TICK" MaryEra = Shelley.ShelleyTICK MaryEra +type instance EraRule "TICK" MaryEra = Shelley.TICK MaryEra -type instance EraRule "TICKF" MaryEra = Shelley.ShelleyTICKF MaryEra +type instance EraRule "TICKF" MaryEra = Shelley.TICKF MaryEra -type instance EraRule "UPEC" MaryEra = Shelley.ShelleyUPEC MaryEra +type instance EraRule "UPEC" MaryEra = Shelley.UPEC MaryEra -type instance EraRule "UTXO" MaryEra = Allegra.AllegraUTXO MaryEra +type instance EraRule "UTXO" MaryEra = Allegra.UTXO MaryEra -type instance EraRule "UTXOW" MaryEra = Allegra.AllegraUTXOW MaryEra +type instance EraRule "UTXOW" MaryEra = Allegra.UTXOW MaryEra diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Allegra/ScriptTranslation.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Allegra/ScriptTranslation.hs index 642a0c97890..3189f642b42 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Allegra/ScriptTranslation.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Allegra/ScriptTranslation.hs @@ -75,7 +75,7 @@ testScriptPostTranslation = txa = fromRight . runExcept $ translateEra @AllegraEra NoGenesis txs result = runShelleyBase $ - applySTSTest @(S.ShelleyLEDGER AllegraEra) + applySTSTest @(S.LEDGER AllegraEra) (TRC (env, LedgerState utxoStAllegra def, txa)) in case result of Left e -> error $ show e diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples.hs index 2ac956bb784..80632480c64 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples.hs @@ -7,7 +7,7 @@ module Test.Cardano.Ledger.Mary.Examples ( import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Mary (MaryEra) -import Cardano.Ledger.Shelley.API (LedgerEnv (..), ShelleyLEDGER) +import Cardano.Ledger.Shelley.API (LEDGER, LedgerEnv (..)) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.LedgerState (LedgerState (..), UTxOState (..), smartUTxOState) import Cardano.Ledger.State (UTxO) @@ -22,8 +22,8 @@ import Test.Control.State.Transition.Trace (checkTrace, (.-), (.->>)) import Test.Tasty.HUnit (Assertion, (@?=)) ignoreAllButUTxO :: - Either (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra))) (LedgerState MaryEra) -> - Either (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra))) (UTxO MaryEra) + Either (NonEmpty (PredicateFailure (LEDGER MaryEra))) (LedgerState MaryEra) -> + Either (NonEmpty (PredicateFailure (LEDGER MaryEra))) (UTxO MaryEra) ignoreAllButUTxO = fmap (\(LedgerState (UTxOState utxo _ _ _ _ _) _) -> utxo) testMaryNoDelegLEDGER :: @@ -31,10 +31,10 @@ testMaryNoDelegLEDGER :: UTxO MaryEra -> Tx TopTx MaryEra -> LedgerEnv MaryEra -> - Either (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra))) (UTxO MaryEra) -> + Either (NonEmpty (PredicateFailure (LEDGER MaryEra))) (UTxO MaryEra) -> Assertion testMaryNoDelegLEDGER utxo tx env (Right expectedUTxO) = do - checkTrace @(ShelleyLEDGER MaryEra) runShelleyBase env $ + checkTrace @(LEDGER MaryEra) runShelleyBase env $ pure (LedgerState (smartUTxOState (ledgerPp env) utxo (Coin 0) (Coin 0) def mempty) def) .- tx .->> expectedSt' @@ -44,7 +44,7 @@ testMaryNoDelegLEDGER utxo tx env (Right expectedUTxO) = do testMaryNoDelegLEDGER utxo tx env predicateFailure@(Left _) = do let st = runShelleyBase $ - applySTSTest @(ShelleyLEDGER MaryEra) + applySTSTest @(LEDGER MaryEra) ( TRC ( env , LedgerState (smartUTxOState (ledgerPp env) utxo (Coin 0) (Coin 0) def mempty) def diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs index a1167d9f4d9..81e771634d4 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/MultiAssets.hs @@ -30,7 +30,7 @@ import Cardano.Ledger.Mary.Value ( MultiAsset (..), PolicyID (..), ) -import Cardano.Ledger.Shelley.API (LedgerEnv (..), ShelleyLEDGER) +import Cardano.Ledger.Shelley.API (LEDGER, LedgerEnv (..)) import qualified Cardano.Ledger.Shelley.Rules as Shelley import Cardano.Ledger.Shelley.Scripts ( pattern RequireAllOf, @@ -113,13 +113,13 @@ makeMaryTxBody ins outs interval minted = & mintTxBodyL .~ minted policyFailure :: - PolicyID -> Either (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra))) (UTxO MaryEra) + PolicyID -> Either (NonEmpty (PredicateFailure (LEDGER MaryEra))) (UTxO MaryEra) policyFailure p = Left . pure . Shelley.UtxowFailure . Shelley.ScriptWitnessNotValidatingUTXOW $ NES.singleton (policyID p) outTooBigFailure :: - TxOut MaryEra -> Either (NonEmpty (PredicateFailure (ShelleyLEDGER MaryEra))) (UTxO MaryEra) + TxOut MaryEra -> Either (NonEmpty (PredicateFailure (LEDGER MaryEra))) (UTxO MaryEra) outTooBigFailure out = Left . pure . Shelley.UtxowFailure . Shelley.UtxoFailure $ Allegra.OutputTooBigUTxO $ pure out diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 7761c55bd4b..0996f7ad453 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -2,6 +2,27 @@ ## 1.19.0.0 +* Rename rule types and deprecate the old names: + - `ShelleyBBODY` -> `BBODY` + - `ShelleyDELEG` -> `DELEG` + - `ShelleyDELEGS` -> `DELEGS` + - `ShelleyDELPL` -> `DELPL` + - `ShelleyEPOCH` -> `EPOCH` + - `ShelleyLEDGER` -> `LEDGER` + - `ShelleyLEDGERS` -> `LEDGERS` + - `ShelleyMIR` -> `MIR` + - `ShelleyNEWEPOCH` -> `NEWEPOCH` + - `ShelleyNEWPP` -> `NEWPP` + - `ShelleyPOOL` -> `POOL` + - `ShelleyPOOLREAP` -> `POOLREAP` + - `ShelleyPPUP` -> `PPUP` + - `ShelleyRUPD` -> `RUPD` + - `ShelleySNAP` -> `SNAP` + - `ShelleyTICK` -> `TICK` + - `ShelleyTICKF` -> `TICKF` + - `ShelleyUPEC` -> `UPEC` + - `ShelleyUTXO` -> `UTXO` + - `ShelleyUTXOW` -> `UTXOW` * Remove re-exports from `Rules.*` modules: - `PredicateFailure` - `Event` diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Types.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Types.hs index 3be62bfe6d9..3e136a3b799 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Types.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Types.hs @@ -78,22 +78,22 @@ import Cardano.Ledger.Shelley.PParams as X ( import Cardano.Ledger.Shelley.PoolRank as X ( NonMyopic, ) -import Cardano.Ledger.Shelley.Rules.Deleg as X (DelegEnv (..), ShelleyDELEG) -import Cardano.Ledger.Shelley.Rules.Delegs as X (DelegsEnv (..), ShelleyDELEGS) -import Cardano.Ledger.Shelley.Rules.Delpl as X (DelplEnv (..), ShelleyDELPL) -import Cardano.Ledger.Shelley.Rules.Ledger as X (LedgerEnv (..), ShelleyLEDGER) -import Cardano.Ledger.Shelley.Rules.Ledgers as X (ShelleyLEDGERS, ShelleyLedgersEnv (..)) -import Cardano.Ledger.Shelley.Rules.NewEpoch as X (ShelleyNEWEPOCH) -import Cardano.Ledger.Shelley.Rules.Pool as X (PoolEnv (..), ShelleyPOOL) -import Cardano.Ledger.Shelley.Rules.PoolReap as X (ShelleyPOOLREAP) -import Cardano.Ledger.Shelley.Rules.Ppup as X (PpupEnv (..), ShelleyPPUP) +import Cardano.Ledger.Shelley.Rules.Deleg as X (DELEG, DelegEnv (..)) +import Cardano.Ledger.Shelley.Rules.Delegs as X (DELEGS, DelegsEnv (..)) +import Cardano.Ledger.Shelley.Rules.Delpl as X (DELPL, DelplEnv (..)) +import Cardano.Ledger.Shelley.Rules.Ledger as X (LEDGER, LedgerEnv (..)) +import Cardano.Ledger.Shelley.Rules.Ledgers as X (LEDGERS, ShelleyLedgersEnv (..)) +import Cardano.Ledger.Shelley.Rules.NewEpoch as X (NEWEPOCH) +import Cardano.Ledger.Shelley.Rules.Pool as X (POOL, PoolEnv (..)) +import Cardano.Ledger.Shelley.Rules.PoolReap as X (POOLREAP) +import Cardano.Ledger.Shelley.Rules.Ppup as X (PPUP, PpupEnv (..)) import Cardano.Ledger.Shelley.Rules.Snap as X (SnapEnv (..)) -import Cardano.Ledger.Shelley.Rules.Tick as X (ShelleyTICK, ShelleyTICKF) +import Cardano.Ledger.Shelley.Rules.Tick as X (TICK, TICKF) import Cardano.Ledger.Shelley.Rules.Utxo as X ( - ShelleyUTXO, + UTXO, UtxoEnv (..), ) -import Cardano.Ledger.Shelley.Rules.Utxow as X (ShelleyUTXOW) +import Cardano.Ledger.Shelley.Rules.Utxow as X (UTXOW) import Cardano.Ledger.Shelley.Scripts as X (MultiSig) import Cardano.Ledger.Shelley.StabilityWindow as X ( computeRandomnessStabilisationWindow, diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Era.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Era.hs index 55ca9964e3c..8cf4857ea90 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Era.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Era.hs @@ -9,6 +9,33 @@ module Cardano.Ledger.Shelley.Era ( ShelleyEra, + BBODY, + DELEG, + DELEGS, + DELPL, + EPOCH, + LEDGER, + LEDGERS, + MIR, + NEWEPOCH, + NEWPP, + POOL, + POOLREAP, + PPUP, + RUPD, + SNAP, + TICK, + TICKF, + UPEC, + UTXO, + UTXOW, + hardforkAllegraAggregatedRewards, + hardforkAlonzoAllowMIRTransfer, + hardforkAlonzoValidatePoolAccountAddressNetID, + hardforkBabbageForgoRewardPrefilter, + hardforkConwayDisallowDuplicatedVRFKeys, + + -- * Deprecated ShelleyBBODY, ShelleyDELEG, ShelleyDELEGS, @@ -29,11 +56,6 @@ module Cardano.Ledger.Shelley.Era ( ShelleyUPEC, ShelleyUTXO, ShelleyUTXOW, - hardforkAllegraAggregatedRewards, - hardforkAlonzoAllowMIRTransfer, - hardforkAlonzoValidatePoolAccountAddressNetID, - hardforkBabbageForgoRewardPrefilter, - hardforkConwayDisallowDuplicatedVRFKeys, ) where import Cardano.Ledger.BaseTypes (ProtVer (pvMajor), natVersion) @@ -46,85 +68,165 @@ instance EraTxLevel ShelleyEra where type instance Value ShelleyEra = Coin -data ShelleyBBODY era +data BBODY era + +type ShelleyBBODY = BBODY + +{-# DEPRECATED ShelleyBBODY "In favor of `BBODY`" #-} + +data DELEG era + +type ShelleyDELEG = DELEG + +{-# DEPRECATED ShelleyDELEG "In favor of `DELEG`" #-} + +data DELEGS era + +type ShelleyDELEGS = DELEGS + +{-# DEPRECATED ShelleyDELEGS "In favor of `DELEGS`" #-} + +data DELPL era + +type ShelleyDELPL = DELPL + +{-# DEPRECATED ShelleyDELPL "In favor of `DELPL`" #-} + +data EPOCH era + +type ShelleyEPOCH = EPOCH + +{-# DEPRECATED ShelleyEPOCH "In favor of `EPOCH`" #-} + +data LEDGER era + +type ShelleyLEDGER = LEDGER + +{-# DEPRECATED ShelleyLEDGER "In favor of `LEDGER`" #-} + +data LEDGERS era + +type ShelleyLEDGERS = LEDGERS + +{-# DEPRECATED ShelleyLEDGERS "In favor of `LEDGERS`" #-} + +data MIR era + +type ShelleyMIR = MIR + +{-# DEPRECATED ShelleyMIR "In favor of `MIR`" #-} + +data NEWEPOCH era + +type ShelleyNEWEPOCH = NEWEPOCH + +{-# DEPRECATED ShelleyNEWEPOCH "In favor of `NEWEPOCH`" #-} + +data NEWPP era + +type ShelleyNEWPP = NEWPP + +{-# DEPRECATED ShelleyNEWPP "In favor of `NEWPP`" #-} + +data POOL era + +type ShelleyPOOL = POOL + +{-# DEPRECATED ShelleyPOOL "In favor of `POOL`" #-} + +data POOLREAP era + +type ShelleyPOOLREAP = POOLREAP + +{-# DEPRECATED ShelleyPOOLREAP "In favor of `POOLREAP`" #-} + +data PPUP era + +type ShelleyPPUP = PPUP + +{-# DEPRECATED ShelleyPPUP "In favor of `PPUP`" #-} + +data RUPD era + +type ShelleyRUPD = RUPD -data ShelleyDELEG era +{-# DEPRECATED ShelleyRUPD "In favor of `RUPD`" #-} -data ShelleyDELEGS era +data SNAP era -data ShelleyDELPL era +type ShelleySNAP = SNAP -data ShelleyEPOCH era +{-# DEPRECATED ShelleySNAP "In favor of `SNAP`" #-} -data ShelleyLEDGER era +data TICK era -data ShelleyLEDGERS era +type ShelleyTICK = TICK -data ShelleyMIR era +{-# DEPRECATED ShelleyTICK "In favor of `TICK`" #-} -data ShelleyNEWEPOCH era +data TICKF era -data ShelleyNEWPP era +type ShelleyTICKF = TICKF -data ShelleyPOOL era +{-# DEPRECATED ShelleyTICKF "In favor of `TICKF`" #-} -data ShelleyPOOLREAP era +data UPEC era -data ShelleyPPUP era +type ShelleyUPEC = UPEC -data ShelleyRUPD era +{-# DEPRECATED ShelleyUPEC "In favor of `UPEC`" #-} -data ShelleySNAP era +data UTXO era -data ShelleyTICK era +type ShelleyUTXO = UTXO -data ShelleyTICKF era +{-# DEPRECATED ShelleyUTXO "In favor of `UTXO`" #-} -data ShelleyUPEC era +data UTXOW era -data ShelleyUTXO era +type ShelleyUTXOW = UTXOW -data ShelleyUTXOW era +{-# DEPRECATED ShelleyUTXOW "In favor of `UTXOW`" #-} -type instance EraRule "BBODY" ShelleyEra = ShelleyBBODY ShelleyEra +type instance EraRule "BBODY" ShelleyEra = BBODY ShelleyEra -type instance EraRule "DELEG" ShelleyEra = ShelleyDELEG ShelleyEra +type instance EraRule "DELEG" ShelleyEra = DELEG ShelleyEra -type instance EraRule "DELEGS" ShelleyEra = ShelleyDELEGS ShelleyEra +type instance EraRule "DELEGS" ShelleyEra = DELEGS ShelleyEra -type instance EraRule "DELPL" ShelleyEra = ShelleyDELPL ShelleyEra +type instance EraRule "DELPL" ShelleyEra = DELPL ShelleyEra -type instance EraRule "EPOCH" ShelleyEra = ShelleyEPOCH ShelleyEra +type instance EraRule "EPOCH" ShelleyEra = EPOCH ShelleyEra -type instance EraRule "LEDGER" ShelleyEra = ShelleyLEDGER ShelleyEra +type instance EraRule "LEDGER" ShelleyEra = LEDGER ShelleyEra -type instance EraRule "LEDGERS" ShelleyEra = ShelleyLEDGERS ShelleyEra +type instance EraRule "LEDGERS" ShelleyEra = LEDGERS ShelleyEra -type instance EraRule "MIR" ShelleyEra = ShelleyMIR ShelleyEra +type instance EraRule "MIR" ShelleyEra = MIR ShelleyEra -type instance EraRule "NEWEPOCH" ShelleyEra = ShelleyNEWEPOCH ShelleyEra +type instance EraRule "NEWEPOCH" ShelleyEra = NEWEPOCH ShelleyEra -type instance EraRule "NEWPP" ShelleyEra = ShelleyNEWPP ShelleyEra +type instance EraRule "NEWPP" ShelleyEra = NEWPP ShelleyEra -type instance EraRule "POOL" ShelleyEra = ShelleyPOOL ShelleyEra +type instance EraRule "POOL" ShelleyEra = POOL ShelleyEra -type instance EraRule "POOLREAP" ShelleyEra = ShelleyPOOLREAP ShelleyEra +type instance EraRule "POOLREAP" ShelleyEra = POOLREAP ShelleyEra -type instance EraRule "PPUP" ShelleyEra = ShelleyPPUP ShelleyEra +type instance EraRule "PPUP" ShelleyEra = PPUP ShelleyEra -type instance EraRule "RUPD" ShelleyEra = ShelleyRUPD ShelleyEra +type instance EraRule "RUPD" ShelleyEra = RUPD ShelleyEra -type instance EraRule "SNAP" ShelleyEra = ShelleySNAP ShelleyEra +type instance EraRule "SNAP" ShelleyEra = SNAP ShelleyEra -type instance EraRule "TICK" ShelleyEra = ShelleyTICK ShelleyEra +type instance EraRule "TICK" ShelleyEra = TICK ShelleyEra -type instance EraRule "TICKF" ShelleyEra = ShelleyTICKF ShelleyEra +type instance EraRule "TICKF" ShelleyEra = TICKF ShelleyEra -type instance EraRule "UPEC" ShelleyEra = ShelleyUPEC ShelleyEra +type instance EraRule "UPEC" ShelleyEra = UPEC ShelleyEra -type instance EraRule "UTXO" ShelleyEra = ShelleyUTXO ShelleyEra +type instance EraRule "UTXO" ShelleyEra = UTXO ShelleyEra -type instance EraRule "UTXOW" ShelleyEra = ShelleyUTXOW ShelleyEra +type instance EraRule "UTXOW" ShelleyEra = UTXOW ShelleyEra hardforkAllegraAggregatedRewards :: ProtVer -> Bool hardforkAllegraAggregatedRewards pv = pvMajor pv > natVersion @2 diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs index c24a32908b4..55a1db4e866 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Bbody ( - ShelleyBBODY, + BBODY, ShelleyBbodyState (..), BbodyEnv (..), BbodySignal (..), @@ -48,7 +48,7 @@ import Cardano.Ledger.Binary.Coders ( import Cardano.Ledger.Block (BbodySignal (..), Block (..), EraBlockHeader (..)) import Cardano.Ledger.Core import Cardano.Ledger.Shelley.BlockBody (incrBlocks) -import Cardano.Ledger.Shelley.Era (ShelleyBBODY, ShelleyEra) +import Cardano.Ledger.Shelley.Era (BBODY, ShelleyEra) import Cardano.Ledger.Shelley.LedgerState (ChainAccountState) import Cardano.Ledger.Shelley.Rules.Deleg (ShelleyDelegPredFailure) import Cardano.Ledger.Shelley.Rules.Delegs (ShelleyDelegsPredFailure) @@ -181,40 +181,40 @@ deriving stock instance instance ( EraBlockBody era - , EraRule "BBODY" era ~ ShelleyBBODY era + , EraRule "BBODY" era ~ BBODY era , InjectRuleFailure "BBODY" ShelleyBbodyPredFailure era - , Embed (EraRule "LEDGERS" era) (ShelleyBBODY era) + , Embed (EraRule "LEDGERS" era) (BBODY era) , Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era , Signal (EraRule "LEDGERS" era) ~ Seq (Tx TopTx era) ) => - STS (ShelleyBBODY era) + STS (BBODY era) where - type State (ShelleyBBODY era) = ShelleyBbodyState era + type State (BBODY era) = ShelleyBbodyState era - type Signal (ShelleyBBODY era) = BbodySignal era + type Signal (BBODY era) = BbodySignal era - type Environment (ShelleyBBODY era) = BbodyEnv era + type Environment (BBODY era) = BbodyEnv era - type BaseM (ShelleyBBODY era) = ShelleyBase + type BaseM (BBODY era) = ShelleyBase - type PredicateFailure (ShelleyBBODY era) = ShelleyBbodyPredFailure era + type PredicateFailure (BBODY era) = ShelleyBbodyPredFailure era - type Event (ShelleyBBODY era) = ShelleyBbodyEvent era + type Event (BBODY era) = ShelleyBbodyEvent era initialRules = [] transitionRules = [bbodyTransition] bbodyTransition :: forall era. - ( STS (ShelleyBBODY era) - , EraRule "BBODY" era ~ ShelleyBBODY era + ( STS (BBODY era) + , EraRule "BBODY" era ~ BBODY era , EraBlockBody era - , Embed (EraRule "LEDGERS" era) (ShelleyBBODY era) + , Embed (EraRule "LEDGERS" era) (BBODY era) , Environment (EraRule "LEDGERS" era) ~ ShelleyLedgersEnv era , Signal (EraRule "LEDGERS" era) ~ Seq (Tx TopTx era) , InjectRuleFailure "BBODY" ShelleyBbodyPredFailure era ) => - TransitionRule (ShelleyBBODY era) + TransitionRule (BBODY era) bbodyTransition = do TRC (BbodyEnv pp account, BbodyState ls blocksMade, BbodySignal block@Block {blockBody}) <- judgmentContext @@ -292,7 +292,7 @@ instance , STS ledgers , Era era ) => - Embed ledgers (ShelleyBBODY era) + Embed ledgers (BBODY era) where wrapFailed = LedgersFailure wrapEvent = LedgersEvent 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 280ec25560e..32bbf622868 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs @@ -12,7 +12,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Deleg ( - ShelleyDELEG, + DELEG, DelegEnv (..), ShelleyDelegPredFailure (..), ShelleyDelegEvent (..), @@ -45,7 +45,7 @@ import Cardano.Ledger.Compactible (fromCompact) import Cardano.Ledger.Credential (Credential, Ptr) import Cardano.Ledger.Hashes (GenDelegPair (..), GenDelegs (..)) import Cardano.Ledger.Shelley.Core -import Cardano.Ledger.Shelley.Era (ShelleyDELEG, ShelleyEra, hardforkAlonzoAllowMIRTransfer) +import Cardano.Ledger.Shelley.Era (DELEG, ShelleyEra, hardforkAlonzoAllowMIRTransfer) import Cardano.Ledger.Shelley.LedgerState (availableAfterMIR) import Cardano.Ledger.Shelley.State import Cardano.Ledger.Slot ( @@ -137,14 +137,14 @@ instance , ShelleyEraTxCert era , AtMostEra "Babbage" era ) => - STS (ShelleyDELEG era) + STS (DELEG era) where - type State (ShelleyDELEG era) = CertState era - type Signal (ShelleyDELEG era) = TxCert era - type Environment (ShelleyDELEG era) = DelegEnv era - type BaseM (ShelleyDELEG era) = ShelleyBase - type PredicateFailure (ShelleyDELEG era) = ShelleyDelegPredFailure era - type Event (ShelleyDELEG era) = ShelleyDelegEvent era + type State (DELEG era) = CertState era + type Signal (DELEG era) = TxCert era + type Environment (DELEG era) = DelegEnv era + type BaseM (DELEG era) = ShelleyBase + type PredicateFailure (DELEG era) = ShelleyDelegPredFailure era + type Event (DELEG era) = ShelleyDelegEvent era transitionRules = [delegationTransition] @@ -256,7 +256,7 @@ delegationTransition :: , EraPParams era , AtMostEra "Babbage" era ) => - TransitionRule (ShelleyDELEG era) + TransitionRule (DELEG era) delegationTransition = do TRC (DelegEnv slot epochNo ptr chainAccountState pp, certState, c) <- judgmentContext let pv = pp ^. ppProtocolVersionL @@ -393,7 +393,7 @@ checkSlotNotTooLate :: ) => SlotNo -> EpochNo -> - Rule (ShelleyDELEG era) 'Transition () + Rule (DELEG era) 'Transition () checkSlotNotTooLate slot curEpochNo = do sp <- liftSTS $ asks stabilityWindow ei <- liftSTS $ asks epochInfoPure @@ -409,7 +409,7 @@ updateReservesAndTreasury :: Map.Map (Credential Staking) Coin -> Coin -> CertState era -> - Rule (ShelleyDELEG era) 'Transition (CertState era) + Rule (DELEG era) 'Transition (CertState era) updateReservesAndTreasury targetPot combinedMap available certState = do let requiredForRewards = fold combinedMap requiredForRewards diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs index 9affcbd181a..8e8facce31a 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Delegs ( - ShelleyDELEGS, + DELEGS, DelegsEnv (..), ShelleyDelegsPredFailure (..), ShelleyDelegsEvent (..), @@ -38,11 +38,11 @@ import Cardano.Ledger.Binary ( import Cardano.Ledger.Core import Cardano.Ledger.Credential (Ptr (..), SlotNo32 (..)) import Cardano.Ledger.Shelley.Core -import Cardano.Ledger.Shelley.Era (ShelleyDELEGS, ShelleyEra) +import Cardano.Ledger.Shelley.Era (DELEGS, ShelleyEra) import Cardano.Ledger.Shelley.Rules.Deleg (ShelleyDelegPredFailure) import Cardano.Ledger.Shelley.Rules.Delpl ( + DELPL, DelplEnv (..), - ShelleyDELPL, ShelleyDelplEvent, ShelleyDelplPredFailure, ) @@ -120,22 +120,22 @@ instance ( EraTx era , EraCertState era , ShelleyEraTxBody era - , Embed (EraRule "DELPL" era) (ShelleyDELEGS era) + , Embed (EraRule "DELPL" era) (DELEGS era) , Environment (EraRule "DELPL" era) ~ DelplEnv era , State (EraRule "DELPL" era) ~ CertState era , Signal (EraRule "DELPL" era) ~ TxCert era - , EraRule "DELEGS" era ~ ShelleyDELEGS era + , EraRule "DELEGS" era ~ DELEGS era ) => - STS (ShelleyDELEGS era) + STS (DELEGS era) where - type State (ShelleyDELEGS era) = CertState era - type Signal (ShelleyDELEGS era) = Seq (TxCert era) - type Environment (ShelleyDELEGS era) = DelegsEnv era - type BaseM (ShelleyDELEGS era) = ShelleyBase + type State (DELEGS era) = CertState era + type Signal (DELEGS era) = Seq (TxCert era) + type Environment (DELEGS era) = DelegsEnv era + type BaseM (DELEGS era) = ShelleyBase type - PredicateFailure (ShelleyDELEGS era) = + PredicateFailure (DELEGS era) = ShelleyDelegsPredFailure era - type Event (ShelleyDELEGS era) = ShelleyDelegsEvent era + type Event (DELEGS era) = ShelleyDelegsEvent era transitionRules = [delegsTransition] @@ -171,13 +171,13 @@ delegsTransition :: ( EraTx era , EraCertState era , ShelleyEraTxBody era - , Embed (EraRule "DELPL" era) (ShelleyDELEGS era) + , Embed (EraRule "DELPL" era) (DELEGS era) , Environment (EraRule "DELPL" era) ~ DelplEnv era , State (EraRule "DELPL" era) ~ CertState era , Signal (EraRule "DELPL" era) ~ TxCert era - , EraRule "DELEGS" era ~ ShelleyDELEGS era + , EraRule "DELEGS" era ~ DELEGS era ) => - TransitionRule (ShelleyDELEGS era) + TransitionRule (DELEGS era) delegsTransition = do TRC ( env@(DelegsEnv slot@(SlotNo slot64) epochNo txIx pp _tx chainAccountState) @@ -189,7 +189,7 @@ delegsTransition = do Empty -> pure certState gamma :|> txCert -> do certState' <- - trans @(ShelleyDELEGS era) $ TRC (env, certState, gamma) + trans @(DELEGS era) $ TRC (env, certState, gamma) -- It is impossible to have 65535 number of certificates in a transaction. let certIx = CertIx (fromIntegral @Int @Word16 $ length gamma) ptr = Ptr (SlotNo32 (fromIntegral @Word64 @Word32 slot64)) txIx certIx @@ -198,11 +198,11 @@ delegsTransition = do instance ( Era era - , STS (ShelleyDELPL era) + , STS (DELPL era) , PredicateFailure (EraRule "DELPL" era) ~ ShelleyDelplPredFailure era , Event (EraRule "DELPL" era) ~ ShelleyDelplEvent era ) => - Embed (ShelleyDELPL era) (ShelleyDELEGS era) + Embed (DELPL era) (DELEGS era) where wrapFailed = DelplFailure wrapEvent = DelplEvent 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 a061b521b20..6df1ab7da26 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Delpl ( - ShelleyDELPL, + DELPL, DelplEnv (..), ShelleyDelplPredFailure (..), ShelleyDelplEvent, @@ -30,14 +30,14 @@ import Cardano.Ledger.Binary ( ) import Cardano.Ledger.Credential (Ptr) import Cardano.Ledger.Shelley.Core -import Cardano.Ledger.Shelley.Era (ShelleyDELPL, ShelleyEra) +import Cardano.Ledger.Shelley.Era (DELPL, ShelleyEra) import Cardano.Ledger.Shelley.Rules.Deleg ( + DELEG, DelegEnv (..), - ShelleyDELEG, ShelleyDelegEvent, ShelleyDelegPredFailure, ) -import Cardano.Ledger.Shelley.Rules.Pool (PoolEnv (..), ShelleyPOOL, ShelleyPoolPredFailure) +import Cardano.Ledger.Shelley.Rules.Pool (POOL, PoolEnv (..), ShelleyPoolPredFailure) import qualified Cardano.Ledger.Shelley.Rules.Pool as Pool import Cardano.Ledger.Shelley.State import Cardano.Ledger.Shelley.TxCert (GenesisDelegCert (..), ShelleyTxCert (..)) @@ -110,26 +110,26 @@ instance instance ( Era era , EraCertState era - , Embed (EraRule "DELEG" era) (ShelleyDELPL era) + , Embed (EraRule "DELEG" era) (DELPL era) , Environment (EraRule "DELEG" era) ~ DelegEnv era , State (EraRule "DELEG" era) ~ CertState era - , Embed (EraRule "POOL" era) (ShelleyDELPL era) + , Embed (EraRule "POOL" era) (DELPL era) , Environment (EraRule "POOL" era) ~ PoolEnv era , State (EraRule "POOL" era) ~ PState era , Signal (EraRule "DELEG" era) ~ TxCert era - , Embed (EraRule "POOL" era) (ShelleyDELPL era) + , Embed (EraRule "POOL" era) (DELPL era) , Environment (EraRule "POOL" era) ~ PoolEnv era , Signal (EraRule "POOL" era) ~ PoolCert , TxCert era ~ ShelleyTxCert era ) => - STS (ShelleyDELPL era) + STS (DELPL era) where - type State (ShelleyDELPL era) = CertState era - type Signal (ShelleyDELPL era) = TxCert era - type Environment (ShelleyDELPL era) = DelplEnv era - type BaseM (ShelleyDELPL era) = ShelleyBase - type PredicateFailure (ShelleyDELPL era) = ShelleyDelplPredFailure era - type Event (ShelleyDELPL era) = ShelleyDelplEvent era + type State (DELPL era) = CertState era + type Signal (DELPL era) = TxCert era + type Environment (DELPL era) = DelplEnv era + type BaseM (DELPL era) = ShelleyBase + type PredicateFailure (DELPL era) = ShelleyDelplPredFailure era + type Event (DELPL era) = ShelleyDelplEvent era transitionRules = [delplTransition] @@ -173,18 +173,18 @@ instance delplTransition :: forall era. - ( Embed (EraRule "DELEG" era) (ShelleyDELPL era) + ( Embed (EraRule "DELEG" era) (DELPL era) , Environment (EraRule "DELEG" era) ~ DelegEnv era , State (EraRule "DELEG" era) ~ CertState era , State (EraRule "POOL" era) ~ PState era , Signal (EraRule "DELEG" era) ~ TxCert era - , Embed (EraRule "POOL" era) (ShelleyDELPL era) + , Embed (EraRule "POOL" era) (DELPL era) , Environment (EraRule "POOL" era) ~ PoolEnv era , Signal (EraRule "POOL" era) ~ PoolCert , TxCert era ~ ShelleyTxCert era , EraCertState era ) => - TransitionRule (ShelleyDELPL era) + TransitionRule (DELPL era) delplTransition = do TRC (DelplEnv slot eNo ptr pp chainAccountState, d, c) <- judgmentContext case c of @@ -204,11 +204,11 @@ delplTransition = do instance ( Era era - , STS (ShelleyPOOL era) + , STS (POOL era) , PredicateFailure (EraRule "POOL" era) ~ ShelleyPoolPredFailure era , Event (EraRule "POOL" era) ~ Pool.PoolEvent era ) => - Embed (ShelleyPOOL era) (ShelleyDELPL era) + Embed (POOL era) (DELPL era) where wrapFailed = PoolFailure wrapEvent = PoolEvent @@ -222,7 +222,7 @@ instance , PredicateFailure (EraRule "DELEG" era) ~ ShelleyDelegPredFailure era , Event (EraRule "DELEG" era) ~ ShelleyDelegEvent era ) => - Embed (ShelleyDELEG era) (ShelleyDELPL era) + Embed (DELEG era) (DELPL era) where wrapFailed = DelegFailure wrapEvent = DelegEvent diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Epoch.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Epoch.hs index 174bcf0d9c2..a640e00e17e 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Epoch.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Epoch.hs @@ -16,13 +16,13 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Epoch ( - ShelleyEPOCH, + EPOCH, ShelleyEpochEvent (..), ) where import Cardano.Ledger.BaseTypes (ShelleyBase) import Cardano.Ledger.Shelley.Core -import Cardano.Ledger.Shelley.Era (ShelleyEPOCH) +import Cardano.Ledger.Shelley.Era (EPOCH) import Cardano.Ledger.Shelley.LedgerState ( EpochState, LedgerState, @@ -44,16 +44,16 @@ import Cardano.Ledger.Shelley.LedgerState ( import Cardano.Ledger.Shelley.LedgerState.Types (prevPParamsEpochStateL) import Cardano.Ledger.Shelley.Rewards () import Cardano.Ledger.Shelley.Rules.PoolReap ( - ShelleyPOOLREAP, + POOLREAP, ShelleyPoolreapEvent, ShelleyPoolreapState (..), ) import Cardano.Ledger.Shelley.Rules.Snap ( - ShelleySNAP, + SNAP, SnapEnv (..), SnapEvent, ) -import Cardano.Ledger.Shelley.Rules.Upec (ShelleyUPEC, UpecState (..)) +import Cardano.Ledger.Shelley.Rules.Upec (UPEC, UpecState (..)) import Cardano.Ledger.Slot (EpochNo) import Cardano.Ledger.State import Control.DeepSeq (NFData) @@ -96,41 +96,41 @@ instance , EraStake era , EraCertState era , GovState era ~ ShelleyGovState era - , Embed (EraRule "SNAP" era) (ShelleyEPOCH era) + , Embed (EraRule "SNAP" era) (EPOCH era) , Environment (EraRule "SNAP" era) ~ SnapEnv era , State (EraRule "SNAP" era) ~ SnapShots , Signal (EraRule "SNAP" era) ~ () - , Embed (EraRule "POOLREAP" era) (ShelleyEPOCH era) + , Embed (EraRule "POOLREAP" era) (EPOCH era) , Environment (EraRule "POOLREAP" era) ~ () , State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era , Signal (EraRule "POOLREAP" era) ~ EpochNo - , Embed (EraRule "UPEC" era) (ShelleyEPOCH era) + , Embed (EraRule "UPEC" era) (EPOCH era) , Environment (EraRule "UPEC" era) ~ LedgerState era , State (EraRule "UPEC" era) ~ UpecState era , Signal (EraRule "UPEC" era) ~ () , Default (PParams era) ) => - STS (ShelleyEPOCH era) + STS (EPOCH era) where - type State (ShelleyEPOCH era) = EpochState era - type Signal (ShelleyEPOCH era) = EpochNo - type Environment (ShelleyEPOCH era) = () - type BaseM (ShelleyEPOCH era) = ShelleyBase - type PredicateFailure (ShelleyEPOCH era) = Void - type Event (ShelleyEPOCH era) = ShelleyEpochEvent era + type State (EPOCH era) = EpochState era + type Signal (EPOCH era) = EpochNo + type Environment (EPOCH era) = () + type BaseM (EPOCH era) = ShelleyBase + type PredicateFailure (EPOCH era) = Void + type Event (EPOCH era) = ShelleyEpochEvent era transitionRules = [epochTransition] epochTransition :: forall era. - ( Embed (EraRule "SNAP" era) (ShelleyEPOCH era) + ( Embed (EraRule "SNAP" era) (EPOCH era) , Environment (EraRule "SNAP" era) ~ SnapEnv era , State (EraRule "SNAP" era) ~ SnapShots , Signal (EraRule "SNAP" era) ~ () - , Embed (EraRule "POOLREAP" era) (ShelleyEPOCH era) + , Embed (EraRule "POOLREAP" era) (EPOCH era) , Environment (EraRule "POOLREAP" era) ~ () , State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era , Signal (EraRule "POOLREAP" era) ~ EpochNo - , Embed (EraRule "UPEC" era) (ShelleyEPOCH era) + , Embed (EraRule "UPEC" era) (EPOCH era) , Environment (EraRule "UPEC" era) ~ LedgerState era , State (EraRule "UPEC" era) ~ UpecState era , Signal (EraRule "UPEC" era) ~ () @@ -138,7 +138,7 @@ epochTransition :: , EraGov era , EraCertState era ) => - TransitionRule (ShelleyEPOCH era) + TransitionRule (EPOCH era) epochTransition = do TRC ( _ @@ -188,27 +188,27 @@ instance , Event (EraRule "SNAP" era) ~ SnapEvent era , EraCertState era ) => - Embed (ShelleySNAP era) (ShelleyEPOCH era) + Embed (SNAP era) (EPOCH era) where wrapFailed = \case {} wrapEvent = SnapEvent instance ( Era era - , STS (ShelleyPOOLREAP era) + , STS (POOLREAP era) , Event (EraRule "POOLREAP" era) ~ ShelleyPoolreapEvent era ) => - Embed (ShelleyPOOLREAP era) (ShelleyEPOCH era) + Embed (POOLREAP era) (EPOCH era) where wrapFailed = \case {} wrapEvent = PoolReapEvent instance ( Era era - , STS (ShelleyUPEC era) + , STS (UPEC era) , Event (EraRule "UPEC" era) ~ Void ) => - Embed (ShelleyUPEC era) (ShelleyEPOCH era) + Embed (UPEC era) (EPOCH era) where wrapFailed = \case {} wrapEvent = UpecEvent 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 1ea6db2354f..2f885759ee9 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs @@ -17,7 +17,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Ledger ( - ShelleyLEDGER, + LEDGER, LedgerEnv (..), ledgerSlotNoL, ledgerEpochNoL, @@ -43,7 +43,7 @@ import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Credential (Credential) import Cardano.Ledger.Shelley.AdaPots (consumedTxBody, producedTxBody) import Cardano.Ledger.Shelley.Core -import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyLEDGER) +import Cardano.Ledger.Shelley.Era (LEDGER, ShelleyEra) import Cardano.Ledger.Shelley.LedgerState ( LedgerState (..), UTxOState (..), @@ -52,8 +52,8 @@ import Cardano.Ledger.Shelley.LedgerState ( import Cardano.Ledger.Shelley.LedgerState.Types (allObligations, potEqualsObligation) import Cardano.Ledger.Shelley.Rules.Deleg (ShelleyDelegPredFailure) import Cardano.Ledger.Shelley.Rules.Delegs ( + DELEGS, DelegsEnv (..), - ShelleyDELEGS, ShelleyDelegsEvent, ShelleyDelegsPredFailure, ) @@ -62,7 +62,7 @@ import Cardano.Ledger.Shelley.Rules.Pool (ShelleyPoolPredFailure) import Cardano.Ledger.Shelley.Rules.Ppup (ShelleyPpupPredFailure) import Cardano.Ledger.Shelley.Rules.Reports (showTxCerts) import Cardano.Ledger.Shelley.Rules.Utxo (ShelleyUtxoPredFailure (..), UtxoEnv (..)) -import Cardano.Ledger.Shelley.Rules.Utxow (ShelleyUTXOW, ShelleyUtxowPredFailure) +import Cardano.Ledger.Shelley.Rules.Utxow (ShelleyUtxowPredFailure, UTXOW) import Cardano.Ledger.Shelley.State import Cardano.Ledger.Slot (EpochNo (..), SlotNo, epochFromSlot) import Control.DeepSeq (NFData (..)) @@ -268,8 +268,8 @@ instance ( EraTx era , EraGov era , EraCertState era - , Embed (EraRule "DELEGS" era) (ShelleyLEDGER era) - , Embed (EraRule "UTXOW" era) (ShelleyLEDGER era) + , Embed (EraRule "DELEGS" era) (LEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) , Environment (EraRule "UTXOW" era) ~ UtxoEnv era , State (EraRule "UTXOW" era) ~ UTxOState era , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era @@ -277,18 +277,18 @@ instance , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) , AtMostEra "Babbage" era - , EraRule "LEDGER" era ~ ShelleyLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , EraRuleFailure "LEDGER" era ~ ShelleyLedgerPredFailure era , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => - STS (ShelleyLEDGER era) + STS (LEDGER era) where - type State (ShelleyLEDGER era) = LedgerState era - type Signal (ShelleyLEDGER era) = StAnnTx TopTx era - type Environment (ShelleyLEDGER era) = LedgerEnv era - type BaseM (ShelleyLEDGER era) = ShelleyBase - type PredicateFailure (ShelleyLEDGER era) = ShelleyLedgerPredFailure era - type Event (ShelleyLEDGER era) = ShelleyLedgerEvent era + type State (LEDGER era) = LedgerState era + type Signal (LEDGER era) = StAnnTx TopTx era + type Environment (LEDGER era) = LedgerEnv era + type BaseM (LEDGER era) = ShelleyBase + type PredicateFailure (LEDGER era) = ShelleyLedgerPredFailure era + type Event (LEDGER era) = ShelleyLedgerEvent era initialRules = [] transitionRules = [ledgerTransition] @@ -301,19 +301,19 @@ ledgerTransition :: forall era. ( EraTx era , EraCertState era - , STS (ShelleyLEDGER era) - , Embed (EraRule "DELEGS" era) (ShelleyLEDGER era) + , STS (LEDGER era) + , Embed (EraRule "DELEGS" era) (LEDGER era) , Environment (EraRule "DELEGS" era) ~ DelegsEnv era , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) - , Embed (EraRule "UTXOW" era) (ShelleyLEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) , Environment (EraRule "UTXOW" era) ~ UtxoEnv era , State (EraRule "UTXOW" era) ~ UTxOState era , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era - , EraRule "LEDGER" era ~ ShelleyLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => - TransitionRule (ShelleyLEDGER era) + TransitionRule (LEDGER era) ledgerTransition = do TRC (LedgerEnv slot mbCurEpochNo txIx pp account, LedgerState utxoSt certState, stAnnTx) <- judgmentContext @@ -360,21 +360,21 @@ testIncompleteAndMissingWithdrawals accounts withdrawals = do instance ( Era era - , STS (ShelleyDELEGS era) + , STS (DELEGS era) , PredicateFailure (EraRule "DELEGS" era) ~ ShelleyDelegsPredFailure era , Event (EraRule "DELEGS" era) ~ ShelleyDelegsEvent era ) => - Embed (ShelleyDELEGS era) (ShelleyLEDGER era) + Embed (DELEGS era) (LEDGER era) where wrapFailed = DelegsFailure wrapEvent = DelegsEvent instance - ( STS (ShelleyUTXOW era) + ( STS (UTXOW era) , PredicateFailure (EraRule "UTXOW" era) ~ ShelleyUtxowPredFailure era - , Event (EraRule "UTXOW" era) ~ Event (ShelleyUTXOW era) + , Event (EraRule "UTXOW" era) ~ Event (UTXOW era) ) => - Embed (ShelleyUTXOW era) (ShelleyLEDGER era) + Embed (UTXOW era) (LEDGER era) where wrapFailed = UtxowFailure wrapEvent = UtxowEvent diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledgers.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledgers.hs index 4e6bc9e9596..673caec7aa1 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledgers.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledgers.hs @@ -15,7 +15,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Ledgers ( - ShelleyLEDGERS, + LEDGERS, ShelleyLedgersEnv (..), ShelleyLedgersPredFailure (..), ShelleyLedgersEvent (..), @@ -27,14 +27,14 @@ import Cardano.Ledger.Binary.Coders (Encode (..), encode, (!>)) import Cardano.Ledger.Core import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..)) import Cardano.Ledger.Shelley.Core (EraGov) -import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyLEDGERS) +import Cardano.Ledger.Shelley.Era (LEDGERS, ShelleyEra) import Cardano.Ledger.Shelley.LedgerState (ChainAccountState, LedgerState (..), UTxOState (..)) import Cardano.Ledger.Shelley.Rules.Deleg (ShelleyDelegPredFailure) import Cardano.Ledger.Shelley.Rules.Delegs (ShelleyDelegsPredFailure) import Cardano.Ledger.Shelley.Rules.Delpl (ShelleyDelplPredFailure) import Cardano.Ledger.Shelley.Rules.Ledger ( + LEDGER, LedgerEnv (..), - ShelleyLEDGER, ShelleyLedgerEvent, ShelleyLedgerPredFailure, ) @@ -165,20 +165,20 @@ instance , EraGov era , EraStake era , Default (CertState era) - , Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era) + , Embed (EraRule "LEDGER" era) (LEDGERS era) , Environment (EraRule "LEDGER" era) ~ LedgerEnv era , State (EraRule "LEDGER" era) ~ LedgerState era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era , Default (LedgerState era) ) => - STS (ShelleyLEDGERS era) + STS (LEDGERS era) where - type State (ShelleyLEDGERS era) = LedgerState era - type Signal (ShelleyLEDGERS era) = Seq (Tx TopTx era) - type Environment (ShelleyLEDGERS era) = ShelleyLedgersEnv era - type BaseM (ShelleyLEDGERS era) = ShelleyBase - type PredicateFailure (ShelleyLEDGERS era) = ShelleyLedgersPredFailure era - type Event (ShelleyLEDGERS era) = ShelleyLedgersEvent era + type State (LEDGERS era) = LedgerState era + type Signal (LEDGERS era) = Seq (Tx TopTx era) + type Environment (LEDGERS era) = ShelleyLedgersEnv era + type BaseM (LEDGERS era) = ShelleyBase + type PredicateFailure (LEDGERS era) = ShelleyLedgersPredFailure era + type Event (LEDGERS era) = ShelleyLedgersEvent era transitionRules = [ledgersTransition] @@ -188,12 +188,12 @@ ledgersTransition :: , EraGov era , EraStake era , Default (CertState era) - , Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era) + , Embed (EraRule "LEDGER" era) (LEDGERS era) , Environment (EraRule "LEDGER" era) ~ LedgerEnv era , State (EraRule "LEDGER" era) ~ LedgerState era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era ) => - TransitionRule (ShelleyLEDGERS era) + TransitionRule (LEDGERS era) ledgersTransition = do TRC (LedgersEnv slot epochNo pp account, ls, txs) <- judgmentContext ei <- liftSTS $ asks epochInfo @@ -212,11 +212,11 @@ ledgersTransition = do instance ( Era era - , STS (ShelleyLEDGER era) + , STS (LEDGER era) , PredicateFailure (EraRule "LEDGER" era) ~ ShelleyLedgerPredFailure era , Event (EraRule "LEDGER" era) ~ ShelleyLedgerEvent era ) => - Embed (ShelleyLEDGER era) (ShelleyLEDGERS era) + Embed (LEDGER era) (LEDGERS era) where wrapFailed = LedgerFailure wrapEvent = LedgerEvent diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Mir.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Mir.hs index b26a3abef22..21ccbd2872b 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Mir.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Mir.hs @@ -12,7 +12,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Mir ( - ShelleyMIR, + MIR, ShelleyMirEvent (..), emptyInstantaneousRewards, ) where @@ -21,7 +21,7 @@ import Cardano.Ledger.BaseTypes (ShelleyBase) import Cardano.Ledger.Coin (Coin, addDeltaCoin, compactCoinOrError) import Cardano.Ledger.Credential (Credential) import Cardano.Ledger.Keys (KeyRole (..)) -import Cardano.Ledger.Shelley.Era (ShelleyMIR) +import Cardano.Ledger.Shelley.Era (MIR) import Cardano.Ledger.Shelley.LedgerState ( EpochState, curPParamsEpochStateL, @@ -69,14 +69,14 @@ instance , EraGov era , EraCertState era ) => - STS (ShelleyMIR era) + STS (MIR era) where - type State (ShelleyMIR era) = EpochState era - type Signal (ShelleyMIR era) = () - type Environment (ShelleyMIR era) = () - type BaseM (ShelleyMIR era) = ShelleyBase - type Event (ShelleyMIR era) = ShelleyMirEvent era - type PredicateFailure (ShelleyMIR era) = Void + type State (MIR era) = EpochState era + type Signal (MIR era) = () + type Environment (MIR era) = () + type BaseM (MIR era) = ShelleyBase + type Event (MIR era) = ShelleyMirEvent era + type PredicateFailure (MIR era) = Void transitionRules = [mirTransition] @@ -93,7 +93,7 @@ instance mirTransition :: forall era. (EraGov era, EraCertState era) => - TransitionRule (ShelleyMIR era) + TransitionRule (MIR era) mirTransition = do TRC ( _ diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs index 5ec8c36bf49..88e3592bf47 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.NewEpoch ( - ShelleyNEWEPOCH, + NEWEPOCH, ShelleyNewEpochEvent (..), updateRewards, ) where @@ -31,11 +31,11 @@ import Cardano.Ledger.Credential (Credential) import Cardano.Ledger.Rewards (Reward) import Cardano.Ledger.Shelley.AdaPots (AdaPots, totalAdaPotsES) import Cardano.Ledger.Shelley.Core -import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyNEWEPOCH) +import Cardano.Ledger.Shelley.Era (NEWEPOCH, ShelleyEra) import Cardano.Ledger.Shelley.LedgerState import Cardano.Ledger.Shelley.Rewards (sumRewards) import Cardano.Ledger.Shelley.Rules.Epoch -import Cardano.Ledger.Shelley.Rules.Mir (ShelleyMIR, ShelleyMirEvent) +import Cardano.Ledger.Shelley.Rules.Mir (MIR, ShelleyMirEvent) import Cardano.Ledger.Shelley.Rules.Rupd (RupdEvent (..)) import Cardano.Ledger.Slot (EpochNo (..)) import Cardano.Ledger.State @@ -85,8 +85,8 @@ instance , EraGov era , EraStake era , EraCertState era - , Embed (EraRule "MIR" era) (ShelleyNEWEPOCH era) - , Embed (EraRule "EPOCH" era) (ShelleyNEWEPOCH era) + , Embed (EraRule "MIR" era) (NEWEPOCH era) + , Embed (EraRule "EPOCH" era) (NEWEPOCH era) , Environment (EraRule "MIR" era) ~ () , State (EraRule "MIR" era) ~ EpochState era , Signal (EraRule "MIR" era) ~ () @@ -99,17 +99,17 @@ instance , Default (PParams era) , Default (StashedAVVMAddresses era) ) => - STS (ShelleyNEWEPOCH era) + STS (NEWEPOCH era) where - type State (ShelleyNEWEPOCH era) = NewEpochState era + type State (NEWEPOCH era) = NewEpochState era - type Signal (ShelleyNEWEPOCH era) = EpochNo + type Signal (NEWEPOCH era) = EpochNo - type Environment (ShelleyNEWEPOCH era) = () + type Environment (NEWEPOCH era) = () - type BaseM (ShelleyNEWEPOCH era) = ShelleyBase - type PredicateFailure (ShelleyNEWEPOCH era) = Void - type Event (ShelleyNEWEPOCH era) = ShelleyNewEpochEvent era + type BaseM (NEWEPOCH era) = ShelleyBase + type PredicateFailure (NEWEPOCH era) = Void + type Event (NEWEPOCH era) = ShelleyNewEpochEvent era initialRules = [ pure $ @@ -131,8 +131,8 @@ newEpochTransition :: , EraGov era , EraStake era , EraCertState era - , Embed (EraRule "MIR" era) (ShelleyNEWEPOCH era) - , Embed (EraRule "EPOCH" era) (ShelleyNEWEPOCH era) + , Embed (EraRule "MIR" era) (NEWEPOCH era) + , Embed (EraRule "EPOCH" era) (NEWEPOCH era) , Environment (EraRule "MIR" era) ~ () , State (EraRule "MIR" era) ~ EpochState era , Signal (EraRule "MIR" era) ~ () @@ -144,7 +144,7 @@ newEpochTransition :: , Event (EraRule "RUPD" era) ~ RupdEvent , Default (State (EraRule "PPUP" era)) ) => - TransitionRule (ShelleyNEWEPOCH era) + TransitionRule (NEWEPOCH era) newEpochTransition = do TRC ( _ @@ -198,15 +198,15 @@ newEpochTransition = do tellReward :: Event (EraRule "RUPD" era) ~ RupdEvent => ShelleyNewEpochEvent era -> - Rule (ShelleyNEWEPOCH era) rtype () + Rule (NEWEPOCH era) rtype () tellReward (DeltaRewardEvent (RupdEvent _ m)) | Map.null m = pure () tellReward x = tellEvent x instance - ( STS (ShelleyEPOCH era) + ( STS (EPOCH era) , Event (EraRule "EPOCH" era) ~ ShelleyEpochEvent era ) => - Embed (ShelleyEPOCH era) (ShelleyNEWEPOCH era) + Embed (EPOCH era) (NEWEPOCH era) where wrapFailed = \case {} wrapEvent = EpochEvent @@ -217,7 +217,7 @@ instance , Default (EpochState era) , Event (EraRule "MIR" era) ~ ShelleyMirEvent era ) => - Embed (ShelleyMIR era) (ShelleyNEWEPOCH era) + Embed (MIR era) (NEWEPOCH era) where wrapFailed = \case {} wrapEvent = MirEvent @@ -229,7 +229,7 @@ updateRewards :: EpochState era -> EpochNo -> RewardUpdate -> - Rule (ShelleyNEWEPOCH era) 'Transition (EpochState era) + Rule (NEWEPOCH era) 'Transition (EpochState era) updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do let totRs = sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_ in assert (Val.isZero (dt <> (dr <> toDeltaCoin totRs <> df))) (pure ()) 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 fd249b2d1f0..eddc206ad9d 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs @@ -9,14 +9,14 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Newpp ( - ShelleyNEWPP, + NEWPP, ShelleyNewppState (..), NewppEnv (..), ) where import Cardano.Ledger.BaseTypes (Globals (quorum), ShelleyBase) import Cardano.Ledger.Core -import Cardano.Ledger.Shelley.Era (ShelleyNEWPP) +import Cardano.Ledger.Shelley.Era (NEWPP) import Cardano.Ledger.Shelley.Governance import Cardano.Ledger.Shelley.LedgerState ( CertState, @@ -53,13 +53,13 @@ instance , GovState era ~ ShelleyGovState era , AtMostEra "Babbage" era ) => - STS (ShelleyNEWPP era) + STS (NEWPP era) where - type State (ShelleyNEWPP era) = ShelleyNewppState era - type Signal (ShelleyNEWPP era) = PParams era - type Environment (ShelleyNEWPP era) = NewppEnv era - type BaseM (ShelleyNEWPP era) = ShelleyBase - type PredicateFailure (ShelleyNEWPP era) = Void + type State (NEWPP era) = ShelleyNewppState era + type Signal (NEWPP era) = PParams era + type Environment (NEWPP era) = NewppEnv era + type BaseM (NEWPP era) = ShelleyBase + type PredicateFailure (NEWPP era) = Void transitionRules = [newPpTransition] instance EraPParams era => Default (ShelleyNewppState era) where @@ -71,7 +71,7 @@ newPpTransition :: , EraGov era , AtMostEra "Babbage" era ) => - TransitionRule (ShelleyNEWPP era) + TransitionRule (NEWPP era) newPpTransition = do TRC ( NewppEnv _certState _utxoState diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Pool.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Pool.hs index b54acc7da72..320047a0223 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Pool.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Pool.hs @@ -16,7 +16,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Pool ( - ShelleyPOOL, + POOL, PoolEvent (..), PoolEnv (..), ShelleyPoolPredFailure (..), @@ -46,8 +46,8 @@ import Cardano.Ledger.Binary.Coders (Encode (..), encode, (!>)) import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.Era ( + POOL, ShelleyEra, - ShelleyPOOL, hardforkAlonzoValidatePoolAccountAddressNetID, hardforkConwayDisallowDuplicatedVRFKeys, ) @@ -125,21 +125,21 @@ instance NFData (ShelleyPoolPredFailure era) instance ( EraPParams era - , EraRule "POOL" era ~ ShelleyPOOL era + , EraRule "POOL" era ~ POOL era , InjectRuleFailure "POOL" ShelleyPoolPredFailure era , InjectRuleEvent "POOL" PoolEvent era ) => - STS (ShelleyPOOL era) + STS (POOL era) where - type State (ShelleyPOOL era) = PState era + type State (POOL era) = PState era - type Signal (ShelleyPOOL era) = PoolCert + type Signal (POOL era) = PoolCert - type Environment (ShelleyPOOL era) = PoolEnv era + type Environment (POOL era) = PoolEnv era - type BaseM (ShelleyPOOL era) = ShelleyBase - type PredicateFailure (ShelleyPOOL era) = ShelleyPoolPredFailure era - type Event (ShelleyPOOL era) = PoolEvent era + type BaseM (POOL era) = ShelleyBase + type PredicateFailure (POOL era) = ShelleyPoolPredFailure era + type Event (POOL era) = PoolEvent era transitionRules = [poolTransition] diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/PoolReap.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/PoolReap.hs index bdb6e453334..01c2d02daf5 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/PoolReap.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/PoolReap.hs @@ -13,7 +13,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.PoolReap ( - ShelleyPOOLREAP, + POOLREAP, ShelleyPoolreapEvent (..), ShelleyPoolreapState (..), prCertStateL, @@ -26,7 +26,7 @@ import Cardano.Ledger.Coin (Coin, CompactForm) import Cardano.Ledger.Compactible (fromCompact) import Cardano.Ledger.Core import Cardano.Ledger.Credential (Credential) -import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyPOOLREAP) +import Cardano.Ledger.Shelley.Era (POOLREAP, ShelleyEra) import Cardano.Ledger.Shelley.LedgerState ( UTxOState (..), allObligations, @@ -100,14 +100,14 @@ instance , EraGov era , EraCertState era ) => - STS (ShelleyPOOLREAP era) + STS (POOLREAP era) where - type State (ShelleyPOOLREAP era) = ShelleyPoolreapState era - type Signal (ShelleyPOOLREAP era) = EpochNo - type Environment (ShelleyPOOLREAP era) = () - type BaseM (ShelleyPOOLREAP era) = ShelleyBase - type PredicateFailure (ShelleyPOOLREAP era) = Void - type Event (ShelleyPOOLREAP era) = ShelleyPoolreapEvent era + type State (POOLREAP era) = ShelleyPoolreapState era + type Signal (POOLREAP era) = EpochNo + type Environment (POOLREAP era) = () + type BaseM (POOLREAP era) = ShelleyBase + type PredicateFailure (POOLREAP era) = Void + type Event (POOLREAP era) = ShelleyPoolreapEvent era transitionRules = [poolReapTransition] renderAssertionViolation = renderPoolReapViolation @@ -128,7 +128,7 @@ instance ) ] -poolReapTransition :: forall era. EraCertState era => TransitionRule (ShelleyPOOLREAP era) +poolReapTransition :: forall era. EraCertState era => TransitionRule (POOLREAP era) poolReapTransition = do TRC (_, PoolreapState us a cs0, e) <- judgmentContext let 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 2a189ef39ea..0d1e778193e 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ppup.hs @@ -13,7 +13,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Ppup ( - ShelleyPPUP, + PPUP, PpupEnv (..), ShelleyPpupPredFailure (..), ShelleyGovState (..), @@ -38,7 +38,7 @@ import Cardano.Ledger.Binary ( import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Core import Cardano.Ledger.Hashes (GenDelegs (..)) -import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyPPUP) +import Cardano.Ledger.Shelley.Era (PPUP, ShelleyEra) import Cardano.Ledger.Shelley.Governance import Cardano.Ledger.Shelley.PParams ( ProposedPPUpdates (ProposedPPUpdates), @@ -117,13 +117,13 @@ newtype PpupEvent era = PpupNewEpoch EpochNo instance NFData (PpupEvent era) -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 - type BaseM (ShelleyPPUP era) = ShelleyBase - type PredicateFailure (ShelleyPPUP era) = ShelleyPpupPredFailure era - type Event (ShelleyPPUP era) = PpupEvent era +instance (EraPParams era, AtMostEra "Babbage" era) => STS (PPUP era) where + type State (PPUP era) = ShelleyGovState era + type Signal (PPUP era) = StrictMaybe (Update era) + type Environment (PPUP era) = PpupEnv era + type BaseM (PPUP era) = ShelleyBase + type PredicateFailure (PPUP era) = ShelleyPpupPredFailure era + type Event (PPUP era) = PpupEvent era initialRules = [] @@ -144,7 +144,7 @@ instance Era era => DecCBOR (ShelleyPpupPredFailure era) where k -> Invalid k ppupTransitionNonEmpty :: - (EraPParams era, AtMostEra "Babbage" era) => TransitionRule (ShelleyPPUP era) + (EraPParams era, AtMostEra "Babbage" era) => TransitionRule (PPUP era) ppupTransitionNonEmpty = do TRC ( PPUPEnv slot pp (GenDelegs genDelegs) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs index 9fc61bda29b..2d5357e87ba 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs @@ -8,7 +8,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Rupd ( - ShelleyRUPD, + RUPD, RupdEnv (..), RupdEvent (..), ) where @@ -27,7 +27,7 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core import Cardano.Ledger.Credential (Credential) import Cardano.Ledger.Rewards (Reward) -import Cardano.Ledger.Shelley.Era (ShelleyRUPD) +import Cardano.Ledger.Shelley.Era (RUPD) import Cardano.Ledger.Shelley.Governance (EraGov) import Cardano.Ledger.Shelley.LedgerState ( EpochState, @@ -70,14 +70,14 @@ instance , EraGov era , EraCertState era ) => - STS (ShelleyRUPD era) + STS (RUPD era) where - type State (ShelleyRUPD era) = StrictMaybe PulsingRewUpdate - type Signal (ShelleyRUPD era) = SlotNo - type Environment (ShelleyRUPD era) = RupdEnv era - type BaseM (ShelleyRUPD era) = ShelleyBase - type PredicateFailure (ShelleyRUPD era) = Void - type Event (ShelleyRUPD era) = RupdEvent + type State (RUPD era) = StrictMaybe PulsingRewUpdate + type Signal (RUPD era) = SlotNo + type Environment (RUPD era) = RupdEnv era + type BaseM (RUPD era) = ShelleyBase + type PredicateFailure (RUPD era) = Void + type Event (RUPD era) = RupdEvent initialRules = [pure SNothing] transitionRules = [rupdTransition] @@ -91,7 +91,7 @@ data RupdEvent instance NFData RupdEvent -- | tell a RupdEvent only if the map is non-empty -tellRupd :: String -> RupdEvent -> Rule (ShelleyRUPD era) rtype () +tellRupd :: String -> RupdEvent -> Rule (RUPD era) rtype () tellRupd _ (RupdEvent _ m) | Map.null m = pure () tellRupd _message x = tellEvent x @@ -104,7 +104,7 @@ determineRewardTiming currentSlot startAfterSlot endSlot | currentSlot <= startAfterSlot = RewardsTooEarly | otherwise = RewardsJustRight -rupdTransition :: (EraGov era, EraCertState era) => TransitionRule (ShelleyRUPD era) +rupdTransition :: (EraGov era, EraCertState era) => TransitionRule (RUPD era) rupdTransition = do TRC (RupdEnv b es, ru, s) <- judgmentContext (slotsPerEpoch, slot, slotForce, maxLL, asc, k, e) <- liftSTS $ do diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs index a608dd270d6..6c9ecf32ff9 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs @@ -10,7 +10,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Snap ( - ShelleySNAP, + SNAP, SnapEvent (..), SnapEnv (..), ) where @@ -20,7 +20,7 @@ import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Compactible (fromCompact) import Cardano.Ledger.Core import Cardano.Ledger.Credential (Credential) -import Cardano.Ledger.Shelley.Era (ShelleySNAP) +import Cardano.Ledger.Shelley.Era (SNAP) import Cardano.Ledger.Shelley.LedgerState ( LedgerState (..), UTxOState (..), @@ -54,13 +54,13 @@ instance NFData (SnapEvent era) data SnapEnv era = SnapEnv (LedgerState era) (PParams era) -instance (EraTxOut era, EraStake era, EraCertState era) => STS (ShelleySNAP era) where - type State (ShelleySNAP era) = SnapShots - type Signal (ShelleySNAP era) = () - type Environment (ShelleySNAP era) = SnapEnv era - type BaseM (ShelleySNAP era) = ShelleyBase - type PredicateFailure (ShelleySNAP era) = Void - type Event (ShelleySNAP era) = SnapEvent era +instance (EraTxOut era, EraStake era, EraCertState era) => STS (SNAP era) where + type State (SNAP era) = SnapShots + type Signal (SNAP era) = () + type Environment (SNAP era) = SnapEnv era + type BaseM (SNAP era) = ShelleyBase + type PredicateFailure (SNAP era) = Void + type Event (SNAP era) = SnapEvent era initialRules = [pure emptySnapShots] transitionRules = [snapTransition] @@ -73,7 +73,7 @@ instance (EraTxOut era, EraStake era, EraCertState era) => STS (ShelleySNAP era) -- but is now computed incrementally. We leave the comment as a historical note about -- where important changes were made to the source code. snapTransition :: - (EraStake era, EraCertState era) => TransitionRule (ShelleySNAP era) + (EraStake era, EraCertState era) => TransitionRule (SNAP era) snapTransition = do TRC (snapEnv, s, _) <- judgmentContext diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs index 5376cc5f7e8..00beeac7319 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs @@ -18,11 +18,11 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Tick ( - ShelleyTICK, + TICK, State, ShelleyTickEvent (..), adoptGenesisDelegs, - ShelleyTICKF, + TICKF, validatingTickTransition, validatingTickTransitionFORECAST, solidifyNextEpochPParams, @@ -31,7 +31,7 @@ module Cardano.Ledger.Shelley.Rules.Tick ( import Cardano.Ledger.BaseTypes (ShelleyBase, StrictMaybe (..)) import Cardano.Ledger.Core import Cardano.Ledger.Keys (GenDelegs (..)) -import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyTICK, ShelleyTICKF) +import Cardano.Ledger.Shelley.Era (ShelleyEra, TICK, TICKF) import Cardano.Ledger.Shelley.Governance import Cardano.Ledger.Shelley.LedgerState ( DState (..), @@ -45,13 +45,13 @@ import Cardano.Ledger.Shelley.LedgerState ( lsCertStateL, newEpochStateGovStateL, ) -import Cardano.Ledger.Shelley.Rules.NewEpoch (ShelleyNEWEPOCH, ShelleyNewEpochEvent) +import Cardano.Ledger.Shelley.Rules.NewEpoch (NEWEPOCH, ShelleyNewEpochEvent) import Cardano.Ledger.Shelley.Rules.Rupd ( + RUPD, RupdEnv (..), RupdEvent, - ShelleyRUPD, ) -import Cardano.Ledger.Shelley.Rules.Upec (ShelleyUPEC, UpecState (..)) +import Cardano.Ledger.Shelley.Rules.Upec (UPEC, UpecState (..)) import Cardano.Ledger.Slot (EpochNo, SlotNo, getTheSlotOfNoReturn) import Cardano.Ledger.State (EraCertState (..), SnapShots (ssStakeMark, ssStakeMarkPoolDistr)) import Control.DeepSeq (NFData) @@ -85,10 +85,10 @@ instance instance ( EraGov era , EraCertState era - , Embed (EraRule "NEWEPOCH" era) (ShelleyTICK era) - , Embed (EraRule "RUPD" era) (ShelleyTICK era) - , State (ShelleyTICK era) ~ NewEpochState era - , BaseM (ShelleyTICK era) ~ ShelleyBase + , Embed (EraRule "NEWEPOCH" era) (TICK era) + , Embed (EraRule "RUPD" era) (TICK era) + , State (TICK era) ~ NewEpochState era + , BaseM (TICK era) ~ ShelleyBase , Environment (EraRule "RUPD" era) ~ RupdEnv era , State (EraRule "RUPD" era) ~ StrictMaybe PulsingRewUpdate , Signal (EraRule "RUPD" era) ~ SlotNo @@ -96,14 +96,14 @@ instance , State (EraRule "NEWEPOCH" era) ~ NewEpochState era , Signal (EraRule "NEWEPOCH" era) ~ EpochNo ) => - STS (ShelleyTICK era) + STS (TICK era) where - type State (ShelleyTICK era) = NewEpochState era - type Signal (ShelleyTICK era) = SlotNo - type Environment (ShelleyTICK era) = () - type BaseM (ShelleyTICK era) = ShelleyBase - type PredicateFailure (ShelleyTICK era) = Void - type Event (ShelleyTICK era) = ShelleyTickEvent era + type State (TICK era) = NewEpochState era + type Signal (TICK era) = SlotNo + type Environment (TICK era) = () + type BaseM (TICK era) = ShelleyBase + type PredicateFailure (TICK era) = Void + type Event (TICK era) = ShelleyTickEvent era initialRules = [] transitionRules = [bheadTransition] @@ -245,9 +245,9 @@ bheadTransition :: forall era. ( EraGov era , EraCertState era - , Embed (EraRule "NEWEPOCH" era) (ShelleyTICK era) - , Embed (EraRule "RUPD" era) (ShelleyTICK era) - , STS (ShelleyTICK era) + , Embed (EraRule "NEWEPOCH" era) (TICK era) + , Embed (EraRule "RUPD" era) (TICK era) + , STS (TICK era) , Environment (EraRule "RUPD" era) ~ RupdEnv era , State (EraRule "RUPD" era) ~ StrictMaybe PulsingRewUpdate , Signal (EraRule "RUPD" era) ~ SlotNo @@ -255,12 +255,12 @@ bheadTransition :: , State (EraRule "NEWEPOCH" era) ~ NewEpochState era , Signal (EraRule "NEWEPOCH" era) ~ EpochNo ) => - TransitionRule (ShelleyTICK era) + TransitionRule (TICK era) bheadTransition = do TRC ((), nes0@(NewEpochState _ bprev _ es _ _ _), slot) <- judgmentContext - nes1 <- validatingTickTransition @ShelleyTICK nes0 slot + nes1 <- validatingTickTransition @TICK nes0 slot -- Here we force the evaluation of the mark snapshot -- and the per-pool stake distribution. @@ -278,20 +278,20 @@ bheadTransition = do pure nes2 instance - ( STS (ShelleyNEWEPOCH era) + ( STS (NEWEPOCH era) , Event (EraRule "NEWEPOCH" era) ~ ShelleyNewEpochEvent era ) => - Embed (ShelleyNEWEPOCH era) (ShelleyTICK era) + Embed (NEWEPOCH era) (TICK era) where wrapFailed = \case {} wrapEvent = TickNewEpochEvent instance ( Era era - , STS (ShelleyRUPD era) + , STS (RUPD era) , Event (EraRule "RUPD" era) ~ RupdEvent ) => - Embed (ShelleyRUPD era) (ShelleyTICK era) + Embed (RUPD era) (TICK era) where wrapFailed = \case {} wrapEvent = TickRupdEvent @@ -314,16 +314,16 @@ instance , Signal (EraRule "UPEC" era) ~ () , State (EraRule "UPEC" era) ~ UpecState era , Environment (EraRule "UPEC" era) ~ LedgerState era - , Embed (EraRule "UPEC" era) (ShelleyTICKF era) + , Embed (EraRule "UPEC" era) (TICKF era) ) => - STS (ShelleyTICKF era) + STS (TICKF era) where - type State (ShelleyTICKF era) = NewEpochState era - type Signal (ShelleyTICKF era) = SlotNo - type Environment (ShelleyTICKF era) = () - type BaseM (ShelleyTICKF era) = ShelleyBase - type PredicateFailure (ShelleyTICKF era) = Void - type Event (ShelleyTICKF era) = ShelleyTickfEvent era + type State (TICKF era) = NewEpochState era + type Signal (TICKF era) = SlotNo + type Environment (TICKF era) = () + type BaseM (TICKF era) = ShelleyBase + type PredicateFailure (TICKF era) = Void + type Event (TICKF era) = ShelleyTickfEvent era initialRules = [] transitionRules = @@ -334,10 +334,10 @@ instance instance ( Era era - , STS (ShelleyUPEC era) + , STS (UPEC era) , Event (EraRule "UPEC" era) ~ Void ) => - Embed (ShelleyUPEC era) (ShelleyTICKF era) + Embed (UPEC era) (TICKF era) where wrapFailed = \case {} wrapEvent = TickfUpecEvent 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 0d9062a7c76..53992f52b3f 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs @@ -18,13 +18,13 @@ -- The rules of this module determine how the update subsystem of the ledger -- handles the epoch transitions. module Cardano.Ledger.Shelley.Rules.Upec ( - ShelleyUPEC, + UPEC, UpecState (..), ) where import Cardano.Ledger.BaseTypes (ShelleyBase) import Cardano.Ledger.Core -import Cardano.Ledger.Shelley.Era (ShelleyUPEC) +import Cardano.Ledger.Shelley.Era (UPEC) import Cardano.Ledger.Shelley.Governance import Cardano.Ledger.Shelley.LedgerState ( LedgerState, @@ -32,8 +32,8 @@ import Cardano.Ledger.Shelley.LedgerState ( lsUTxOState, ) import Cardano.Ledger.Shelley.Rules.Newpp ( + NEWPP, NewppEnv (..), - ShelleyNEWPP, ShelleyNewppState (..), ) import Control.State.Transition ( @@ -63,13 +63,13 @@ instance , GovState era ~ ShelleyGovState era , AtMostEra "Babbage" era ) => - STS (ShelleyUPEC era) + STS (UPEC era) where - type State (ShelleyUPEC era) = UpecState era - type Signal (ShelleyUPEC era) = () - type Environment (ShelleyUPEC era) = LedgerState era - type BaseM (ShelleyUPEC era) = ShelleyBase - type PredicateFailure (ShelleyUPEC era) = Void + type State (UPEC era) = UpecState era + type Signal (UPEC era) = () + type Environment (UPEC era) = LedgerState era + type BaseM (UPEC era) = ShelleyBase + type PredicateFailure (UPEC era) = Void initialRules = [] transitionRules = [ do @@ -83,13 +83,13 @@ instance let utxoState = lsUTxOState ls ppNew = nextEpochPParams ppupState NewppState pp' ppupState' <- - trans @(ShelleyNEWPP era) $ + trans @(NEWPP era) $ TRC (NewppEnv (lsCertState ls) utxoState, NewppState pp ppupState, ppNew) pure $! UpecState pp' ppupState' ] instance - (Era era, STS (ShelleyNEWPP era)) => - Embed (ShelleyNEWPP era) (ShelleyUPEC era) + (Era era, STS (NEWPP era)) => + Embed (NEWPP era) (UPEC era) where wrapFailed = \case {} diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs index ddcac5cfdc9..d00eec4aac4 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs @@ -18,7 +18,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Utxo ( - ShelleyUTXO, + UTXO, UtxoEnv (..), ShelleyUtxoPredFailure (..), UtxoEvent (..), @@ -55,13 +55,13 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Rules.ValidationMode (Test, runTest) import Cardano.Ledger.Shelley.AdaPots (consumedTxBody, producedTxBody) import Cardano.Ledger.Shelley.Core -import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyUTXO) +import Cardano.Ledger.Shelley.Era (ShelleyEra, UTXO) import Cardano.Ledger.Shelley.LedgerState (UTxOState (..)) import Cardano.Ledger.Shelley.PParams (Update) import Cardano.Ledger.Shelley.Rules.Ppup ( + PPUP, PpupEnv (..), PpupEvent, - ShelleyPPUP, ShelleyPpupPredFailure, ) import Cardano.Ledger.Shelley.Rules.Reports (showTxCerts) @@ -266,25 +266,25 @@ instance , EraGov era , GovState era ~ ShelleyGovState era , ExactEra ShelleyEra era - , Embed (EraRule "PPUP" era) (ShelleyUTXO era) + , Embed (EraRule "PPUP" era) (UTXO era) , Environment (EraRule "PPUP" era) ~ PpupEnv era , Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era) , State (EraRule "PPUP" era) ~ ShelleyGovState era , Eq (EraRuleFailure "PPUP" era) , Show (EraRuleFailure "PPUP" era) - , EraRule "UTXO" era ~ ShelleyUTXO era + , EraRule "UTXO" era ~ UTXO era , InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era , EraCertState era , SafeToHash (TxWits era) ) => - STS (ShelleyUTXO era) + STS (UTXO era) where - type State (ShelleyUTXO era) = UTxOState era - type Signal (ShelleyUTXO era) = StAnnTx TopTx era - type Environment (ShelleyUTXO era) = UtxoEnv era - type BaseM (ShelleyUTXO era) = ShelleyBase - type PredicateFailure (ShelleyUTXO era) = ShelleyUtxoPredFailure era - type Event (ShelleyUTXO era) = UtxoEvent era + type State (UTXO era) = UTxOState era + type Signal (UTXO era) = StAnnTx TopTx era + type Environment (UTXO era) = UtxoEnv era + type BaseM (UTXO era) = ShelleyBase + type PredicateFailure (UTXO era) = ShelleyUtxoPredFailure era + type Event (UTXO era) = UtxoEvent era transitionRules = [utxoInductive] @@ -642,11 +642,11 @@ updateUTxOStateNoFees pp utxos txBody certState govState depositChangeEvent txUt instance ( Era era - , STS (ShelleyPPUP era) + , STS (PPUP era) , EraRuleFailure "PPUP" era ~ ShelleyPpupPredFailure era , Event (EraRule "PPUP" era) ~ PpupEvent era ) => - Embed (ShelleyPPUP era) (ShelleyUTXO era) + Embed (PPUP era) (UTXO era) where wrapFailed = UpdateFailure wrapEvent = UpdateEvent diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs index add9f7f2d1e..f24674f4cfc 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs @@ -17,7 +17,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Shelley.Rules.Utxow ( - ShelleyUTXOW, + UTXOW, ShelleyUtxowPredFailure (..), ShelleyUtxowEvent (..), transitionRulesUTXOW, @@ -57,12 +57,12 @@ import Cardano.Ledger.Rules.ValidationMode ( runTestOnSignal, ) import Cardano.Ledger.Shelley.Core -import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyUTXOW) +import Cardano.Ledger.Shelley.Era (ShelleyEra, UTXOW) import Cardano.Ledger.Shelley.LedgerState.Types (UTxOState (..)) import Cardano.Ledger.Shelley.Rules.Ppup (ShelleyPpupPredFailure) import Cardano.Ledger.Shelley.Rules.Utxo ( - ShelleyUTXO, ShelleyUtxoPredFailure, + UTXO, UtxoEnv (..), UtxoEvent, ) @@ -255,11 +255,11 @@ instance initialLedgerStateUTXOW :: forall era. - ( Embed (EraRule "UTXO" era) (ShelleyUTXOW era) + ( Embed (EraRule "UTXO" era) (UTXOW era) , Environment (EraRule "UTXO" era) ~ UtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era ) => - InitialRule (ShelleyUTXOW era) + InitialRule (UTXOW era) initialLedgerStateUTXOW = do IRC (UtxoEnv slots pp certState) <- judgmentContext trans @(EraRule "UTXO" era) $ IRC (UtxoEnv slots pp certState) @@ -327,11 +327,11 @@ transitionRulesUTXOW = do instance ( Era era - , STS (ShelleyUTXO era) + , STS (UTXO era) , PredicateFailure (EraRule "UTXO" era) ~ ShelleyUtxoPredFailure era , Event (EraRule "UTXO" era) ~ UtxoEvent era ) => - Embed (ShelleyUTXO era) (ShelleyUTXOW era) + Embed (UTXO era) (UTXOW era) where wrapFailed = UtxoFailure wrapEvent = UtxoEvent @@ -342,23 +342,23 @@ instance , ShelleyEraTxBody era , ScriptsNeeded era ~ ShelleyScriptsNeeded era , -- Allow UTXOW to call UTXO - Embed (EraRule "UTXO" era) (ShelleyUTXOW era) + Embed (EraRule "UTXO" era) (UTXOW era) , Environment (EraRule "UTXO" era) ~ UtxoEnv era , State (EraRule "UTXO" era) ~ UTxOState era , Signal (EraRule "UTXO" era) ~ StAnnTx TopTx era - , EraRule "UTXOW" era ~ ShelleyUTXOW era + , EraRule "UTXOW" era ~ UTXOW era , InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era , EraGov era , EraCertState era ) => - STS (ShelleyUTXOW era) + STS (UTXOW era) where - type State (ShelleyUTXOW era) = UTxOState era - type Signal (ShelleyUTXOW era) = StAnnTx TopTx era - type Environment (ShelleyUTXOW era) = UtxoEnv era - type BaseM (ShelleyUTXOW era) = ShelleyBase - type PredicateFailure (ShelleyUTXOW era) = ShelleyUtxowPredFailure era - type Event (ShelleyUTXOW era) = ShelleyUtxowEvent era + type State (UTXOW era) = UTxOState era + type Signal (UTXOW era) = StAnnTx TopTx era + type Environment (UTXOW era) = UtxoEnv era + type BaseM (UTXOW era) = ShelleyBase + type PredicateFailure (UTXOW era) = ShelleyUtxowPredFailure era + type Event (UTXOW era) = ShelleyUtxowEvent era transitionRules = [transitionRulesUTXOW] initialRules = [initialLedgerStateUTXOW] diff --git a/eras/shelley/test-suite/bench/BenchValidation.hs b/eras/shelley/test-suite/bench/BenchValidation.hs index 03aca49166a..9bbf0f3fefa 100644 --- a/eras/shelley/test-suite/bench/BenchValidation.hs +++ b/eras/shelley/test-suite/bench/BenchValidation.hs @@ -79,8 +79,8 @@ instance NFData (ValidateInput era) where validateInput :: ( EraGen era , EraStake era - , EraRule "LEDGERS" era ~ API.ShelleyLEDGERS era - , QC.HasTrace (API.ShelleyLEDGERS era) (GenEnv MockCrypto era) + , EraRule "LEDGERS" era ~ API.LEDGERS era + , QC.HasTrace (API.LEDGERS era) (GenEnv MockCrypto era) , API.ApplyBlock TestBlockHeader era , API.ShelleyEraForecast era , MinLEDGER_STS era @@ -162,8 +162,8 @@ genUpdateInputs :: , EraStake era , MinLEDGER_STS era , API.ShelleyEraForecast era - , EraRule "LEDGERS" era ~ API.ShelleyLEDGERS era - , QC.HasTrace (API.ShelleyLEDGERS era) (GenEnv MockCrypto era) + , EraRule "LEDGERS" era ~ API.LEDGERS era + , QC.HasTrace (API.LEDGERS era) (GenEnv MockCrypto era) , API.ApplyBlock TestBlockHeader era , EraBlockHeader (BHeader MockCrypto) era ) => 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 6a1d708ff7d..c10a46d72bc 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 @@ -16,8 +16,8 @@ import Cardano.Ledger.Shelley.API ( ApplyBlock, Block, DelplEnv, + LEDGERS, ShelleyEraForecast, - ShelleyLEDGERS, ) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.LedgerState ( @@ -81,8 +81,8 @@ genBlock :: ( EraGen era , MinLEDGER_STS era , ShelleyEraForecast era - , EraRule "LEDGERS" era ~ ShelleyLEDGERS era - , QC.HasTrace (ShelleyLEDGERS era) (GenEnv MockCrypto era) + , EraRule "LEDGERS" era ~ LEDGERS era + , QC.HasTrace (LEDGERS era) (GenEnv MockCrypto era) , ApplyBlock TestBlockHeader era , EraBlockHeader (BHeader MockCrypto) era ) => 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 b632479d387..fd5334c025f 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 @@ -40,7 +40,7 @@ import Cardano.Ledger.Shelley.LedgerState ( LedgerState (..), UTxOState (..), ) -import Cardano.Ledger.Shelley.Rules (LedgerEnv (..), ShelleyLEDGER) +import Cardano.Ledger.Shelley.Rules (LEDGER, LedgerEnv (..)) import Cardano.Ledger.Shelley.State import Cardano.Ledger.Slot (EpochNo (..), SlotNo (..)) import Cardano.Ledger.TxIn (TxIn (..), mkTxInPartial) @@ -130,7 +130,7 @@ testLEDGER :: LedgerEnv ShelleyEra -> () testLEDGER initSt tx env = do - let st = runShelleyBase $ applySTS @(ShelleyLEDGER ShelleyEra) (TRC (env, initSt, tx)) + let st = runShelleyBase $ applySTS @(LEDGER ShelleyEra) (TRC (env, initSt, tx)) case st of Right _ -> () Left e -> error $ show e @@ -218,7 +218,7 @@ initLedgerState n = LedgerState (initUTxO n) def makeLEDGERState :: HasCallStack => LedgerState ShelleyEra -> Tx TopTx ShelleyEra -> LedgerState ShelleyEra makeLEDGERState start tx = - let st = applySTS @(ShelleyLEDGER ShelleyEra) (TRC (ledgerEnv, start, tx)) + let st = applySTS @(LEDGER ShelleyEra) (TRC (ledgerEnv, start, tx)) in case runShelleyBase st of Right st' -> st' Left e -> error $ show e 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 a9661dd3a7c..71046c2bc21 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 @@ -27,13 +27,13 @@ import Cardano.Ledger.Shelley.LedgerState ( utxosUtxo, ) import Cardano.Ledger.Shelley.Rules ( + DELPL, DelegsEnv, DelplEnv, + LEDGER, + LEDGERS, LedgerEnv (..), - ShelleyDELPL, ShelleyDelplPredFailure, - ShelleyLEDGER, - ShelleyLEDGERS, ShelleyLedgersEnv (..), UtxoEnv, ) @@ -88,8 +88,8 @@ instance , State (EraRule "DELPL" era) ~ CertState era , Signal (EraRule "DELPL" era) ~ TxCert era , PredicateFailure (EraRule "DELPL" era) ~ ShelleyDelplPredFailure era - , Embed (EraRule "DELEGS" era) (ShelleyLEDGER era) - , Embed (EraRule "UTXOW" era) (ShelleyLEDGER era) + , Embed (EraRule "DELEGS" era) (LEDGER era) + , Embed (EraRule "UTXOW" era) (LEDGER era) , Environment (EraRule "UTXOW" era) ~ UtxoEnv era , State (EraRule "UTXOW" era) ~ UTxOState era , Signal (EraRule "UTXOW" era) ~ StAnnTx TopTx era @@ -97,10 +97,10 @@ instance , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) , AtMostEra "Babbage" era - , EraRule "LEDGER" era ~ ShelleyLEDGER era + , EraRule "LEDGER" era ~ LEDGER era , Crypto c ) => - TQC.HasTrace (ShelleyLEDGER era) (GenEnv c era) + TQC.HasTrace (LEDGER era) (GenEnv c era) where envGen GenEnv {geConstants} = LedgerEnv (SlotNo 0) Nothing minBound @@ -119,7 +119,7 @@ instance shrinkSignal _ = [] -- TODO add some kind of Shrinker? - type BaseEnv (ShelleyLEDGER era) = Globals + type BaseEnv (LEDGER era) = Globals interpretSTS globals act = runIdentity $ runReaderT act globals instance @@ -137,11 +137,11 @@ instance , State (EraRule "DELPL" era) ~ CertState era , Signal (EraRule "DELPL" era) ~ TxCert era , PredicateFailure (EraRule "DELPL" era) ~ ShelleyDelplPredFailure era - , Embed (EraRule "DELEG" era) (ShelleyDELPL era) - , Embed (EraRule "LEDGER" era) (ShelleyLEDGERS era) + , Embed (EraRule "DELEG" era) (DELPL era) + , Embed (EraRule "LEDGER" era) (LEDGERS era) , AtMostEra "Babbage" era ) => - TQC.HasTrace (ShelleyLEDGERS era) (GenEnv c era) + TQC.HasTrace (LEDGERS era) (GenEnv c era) where envGen GenEnv {geConstants} = LedgersEnv (SlotNo 0) (EpochNo 0) @@ -188,7 +188,7 @@ instance shrinkSignal = const [] - type BaseEnv (ShelleyLEDGERS era) = Globals + type BaseEnv (LEDGERS era) = Globals interpretSTS globals act = runIdentity $ runReaderT act globals -- | Generate initial state for the LEDGER STS using the STS environment. 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 d4f0b002caa..116caf5c279 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 @@ -24,9 +24,9 @@ import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential (SlotNo32 (..)) import Cardano.Ledger.Keys (HasKeyRole (coerceKeyRole), asWitness) import Cardano.Ledger.Shelley.API ( + DELPL, DelplEnv (..), Ptr (..), - ShelleyDELPL, ) import Cardano.Ledger.Shelley.Rules (ShelleyDelplEvent, ShelleyDelplPredFailure) import Cardano.Ledger.State @@ -138,11 +138,11 @@ certsTransition = do instance ( Era era - , STS (ShelleyDELPL era) + , STS (DELPL era) , PredicateFailure (Core.EraRule "DELPL" era) ~ ShelleyDelplPredFailure era , Event (Core.EraRule "DELPL" era) ~ ShelleyDelplEvent era ) => - Embed (ShelleyDELPL era) (CERTS era) + Embed (DELPL era) (CERTS era) where wrapFailed = CertsFailure wrapEvent = CertsEvent 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 bd04760ac20..62393aae868 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 @@ -16,7 +16,7 @@ import Cardano.Ledger.BaseTypes (Globals, ShelleyBase, SlotNo) import Cardano.Ledger.Binary (EncCBORGroup) import Cardano.Ledger.Block (BbodySignal) import Cardano.Ledger.Core -import Cardano.Ledger.Shelley.API (ApplyBlock, ShelleyEraForecast, ShelleyPOOL) +import Cardano.Ledger.Shelley.API (ApplyBlock, POOL, ShelleyEraForecast) import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..)) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.LedgerState (LedgerState, NewEpochState) @@ -96,7 +96,7 @@ commonTests :: , Environment (EraRule "BBODY" era) ~ BbodyEnv era , Signal (EraRule "TICK" era) ~ SlotNo , Signal (EraRule "BBODY" era) ~ BbodySignal era - , EraRule "POOL" era ~ ShelleyPOOL era + , EraRule "POOL" era ~ POOL era , InjectRuleFailure "POOL" ShelleyPoolPredFailure era , InjectRuleEvent "POOL" PoolEvent era , EncCBORGroup (BlockBody era) 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 14829a4e742..9a1ac46b4d5 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 @@ -63,12 +63,12 @@ import Cardano.Ledger.Shelley.LedgerState ( updateNES, ) import Cardano.Ledger.Shelley.Rules ( + BBODY, BbodyEnv (..), - ShelleyBBODY, ShelleyBbodyPredFailure, ShelleyBbodyState (..), - ShelleyTICK, ShelleyTickEvent, + TICK, ) import Cardano.Ledger.Shelley.State import Cardano.Ledger.Slot (EpochNo) @@ -374,11 +374,11 @@ chainTransition = instance ( Era era , Era era - , STS (ShelleyBBODY era) + , STS (BBODY era) , PredicateFailure (EraRule "BBODY" era) ~ ShelleyBbodyPredFailure era - , Event (EraRule "BBODY" era) ~ Event (ShelleyBBODY era) + , Event (EraRule "BBODY" era) ~ Event (BBODY era) ) => - Embed (ShelleyBBODY era) (CHAIN era) + Embed (BBODY era) (CHAIN era) where wrapFailed = BbodyFailure wrapEvent = BbodyEvent @@ -397,10 +397,10 @@ instance instance ( Era era , Era era - , STS (ShelleyTICK era) + , STS (TICK era) , Event (EraRule "TICK" era) ~ ShelleyTickEvent era ) => - Embed (ShelleyTICK era) (CHAIN era) + Embed (TICK era) (CHAIN era) where wrapFailed = \case {} wrapEvent = TickEvent diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs index e8a72f09754..715187212e4 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs @@ -30,7 +30,7 @@ import Cardano.Ledger.Shelley.PParams ( pattern ProposedPPUpdates, pattern Update, ) -import Cardano.Ledger.Shelley.Rules (ShelleyLEDGER) +import Cardano.Ledger.Shelley.Rules (LEDGER) import Cardano.Ledger.Shelley.State import Cardano.Ledger.Shelley.TxCert ( isDelegation, @@ -333,13 +333,13 @@ propAbstractSizeBoundsBytes :: ( EraGen era , EraGov era , EraStake era - , QC.HasTrace (ShelleyLEDGER era) (GenEnv MockCrypto era) + , QC.HasTrace (LEDGER era) (GenEnv MockCrypto era) ) => Property propAbstractSizeBoundsBytes = property $ do let tl = 100 numBytes = toInteger . BS.length . Plain.serialize' - forAllTraceFromInitState @(ShelleyLEDGER era) + forAllTraceFromInitState @(LEDGER era) testGlobals tl (genEnv @era @MockCrypto p defaultConstants) @@ -361,7 +361,7 @@ propAbstractSizeNotTooBig :: ( EraGen era , EraGov era , EraStake era - , QC.HasTrace (ShelleyLEDGER era) (GenEnv MockCrypto era) + , QC.HasTrace (LEDGER era) (GenEnv MockCrypto era) ) => Property propAbstractSizeNotTooBig = property $ do @@ -374,7 +374,7 @@ propAbstractSizeNotTooBig = property $ do acceptableMagnitude = (3 :: Integer) numBytes = toInteger . BS.length . Plain.serialize' notTooBig tx = txSizeBound tx <= acceptableMagnitude * numBytes tx - forAllTraceFromInitState @(ShelleyLEDGER era) + forAllTraceFromInitState @(LEDGER era) testGlobals tl (genEnv @era @MockCrypto p defaultConstants) 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 a6a61b6d3d9..d289511ee7a 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 @@ -13,7 +13,7 @@ module Test.Cardano.Ledger.Shelley.Rules.Deleg ( import Cardano.Ledger.Coin import Cardano.Ledger.Shelley (hardforkAlonzoAllowMIRTransfer) -import Cardano.Ledger.Shelley.API (ShelleyDELEG) +import Cardano.Ledger.Shelley.API (DELEG) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.Rules (DelegEnv (..)) import Cardano.Ledger.Shelley.State @@ -70,7 +70,7 @@ tests = conjoin $ map chainProp (sourceSignalTargets tr) where - delegProp :: DelegEnv era -> SourceSignalTarget (ShelleyDELEG era) -> Property + delegProp :: DelegEnv era -> SourceSignalTarget (DELEG era) -> Property delegProp denv delegSst = conjoin [ keyRegistration delegSst @@ -90,7 +90,7 @@ tests = -- | Check stake key registration keyRegistration :: (EraCertState era, ShelleyEraTxCert era) => - SourceSignalTarget (ShelleyDELEG era) -> + SourceSignalTarget (DELEG era) -> Property keyRegistration SourceSignalTarget @@ -112,7 +112,7 @@ keyRegistration _ = property () -- | Check stake key de-registration keyDeRegistration :: (EraCertState era, ShelleyEraTxCert era) => - SourceSignalTarget (ShelleyDELEG era) -> + SourceSignalTarget (DELEG era) -> Property keyDeRegistration SourceSignalTarget @@ -132,7 +132,7 @@ keyDeRegistration _ = property () -- | Check stake key delegation keyDelegation :: (EraCertState era, ShelleyEraTxCert era) => - SourceSignalTarget (ShelleyDELEG era) -> + SourceSignalTarget (DELEG era) -> Property keyDelegation SourceSignalTarget @@ -151,7 +151,7 @@ keyDelegation _ = property () -- | Check that the sum of balances does not change and that each element -- that is either removed or added has a zero balance. -balancesSumInvariant :: EraCertState era => SourceSignalTarget (ShelleyDELEG era) -> Property +balancesSumInvariant :: EraCertState era => SourceSignalTarget (DELEG era) -> Property balancesSumInvariant SourceSignalTarget {source, target} = let accountsBalances ds = Map.map (^. balanceAccountStateL) (ds ^. accountsL . accountsMapL) @@ -173,7 +173,7 @@ balancesSumInvariant checkInstantaneousRewards :: (EraPParams era, EraCertState era, ShelleyEraTxCert era, AtMostEra "Babbage" era) => DelegEnv era -> - SourceSignalTarget (ShelleyDELEG era) -> + SourceSignalTarget (DELEG era) -> Property checkInstantaneousRewards denv diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Pool.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Pool.hs index f87b73a2205..2ce119bcdc2 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Pool.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Pool.hs @@ -18,7 +18,7 @@ import Cardano.Ledger.Shelley.LedgerState ( NewEpochState (..), curPParamsEpochStateL, ) -import Cardano.Ledger.Shelley.Rules (PoolEvent, ShelleyPOOL, ShelleyPoolPredFailure) +import Cardano.Ledger.Shelley.Rules (POOL, PoolEvent, ShelleyPoolPredFailure) import Cardano.Ledger.Shelley.State import Cardano.Ledger.Slot (EpochNo (..)) import Cardano.Protocol.TPraos.BHeader (bhbody, bheaderSlotNo) @@ -65,7 +65,7 @@ tests :: , EraStake era , ChainProperty era , QC.HasTrace (CHAIN era) (GenEnv MockCrypto era) - , EraRule "POOL" era ~ ShelleyPOOL era + , EraRule "POOL" era ~ POOL era , InjectRuleFailure "POOL" ShelleyPoolPredFailure era , InjectRuleEvent "POOL" PoolEvent era ) => @@ -84,7 +84,7 @@ tests = -- retirement. poolRetirement :: ( ChainProperty era - , EraRule "POOL" era ~ ShelleyPOOL era + , EraRule "POOL" era ~ POOL era , InjectRuleFailure "POOL" ShelleyPoolPredFailure era , InjectRuleEvent "POOL" PoolEvent era ) => @@ -103,7 +103,7 @@ poolRetirement SourceSignalTarget {source = chainSt, signal = block} = -- in the retiring map. poolRegistration :: ( ChainProperty era - , EraRule "POOL" era ~ ShelleyPOOL era + , EraRule "POOL" era ~ POOL era , InjectRuleFailure "POOL" ShelleyPoolPredFailure era , InjectRuleEvent "POOL" PoolEvent era ) => @@ -119,7 +119,7 @@ poolRegistration (SourceSignalTarget {source = chainSt, signal = block}) = -- POOL` transition. poolStateIsInternallyConsistent :: ( ChainProperty era - , EraRule "POOL" era ~ ShelleyPOOL era + , EraRule "POOL" era ~ POOL era , InjectRuleFailure "POOL" ShelleyPoolPredFailure era , InjectRuleEvent "POOL" PoolEvent era ) => @@ -131,7 +131,7 @@ poolStateIsInternallyConsistent (SourceSignalTarget {source = chainSt, signal = where (_, poolTr) = poolTraceFromBlock chainSt block -poolRegistrationProp :: SourceSignalTarget (ShelleyPOOL era) -> Property +poolRegistrationProp :: SourceSignalTarget (POOL era) -> Property poolRegistrationProp SourceSignalTarget { signal = RegPool stakePoolParams @@ -174,7 +174,7 @@ poolRegistrationProp _ = property () poolRetirementProp :: EpochNo -> EpochInterval -> - SourceSignalTarget (ShelleyPOOL era) -> + SourceSignalTarget (POOL era) -> Property poolRetirementProp currentEpoch@(EpochNo ce) diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs index 097c97d726e..f3de70546a1 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs @@ -30,7 +30,7 @@ import Cardano.Ledger.Block ( ) import Cardano.Ledger.Core import Cardano.Ledger.Credential (Ptr (..), SlotNo32 (..)) -import Cardano.Ledger.Shelley.API (ApplyBlock, ShelleyDELEG, ShelleyEraForecast) +import Cardano.Ledger.Shelley.API (ApplyBlock, DELEG, ShelleyEraForecast) import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..)) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.LedgerState ( @@ -45,9 +45,9 @@ import Cardano.Ledger.Shelley.LedgerState ( import Cardano.Ledger.Shelley.Rules ( DelegEnv (..), LedgerEnv (..), + POOL, PoolEnv (..), PoolEvent, - ShelleyPOOL, ShelleyPoolPredFailure, ledgerPpL, ) @@ -218,17 +218,17 @@ ledgerTraceFromBlockWithRestrictedUTxO chainSt block = poolTraceFromBlock :: forall era. ( ChainProperty era - , EraRule "POOL" era ~ ShelleyPOOL era + , EraRule "POOL" era ~ POOL era , InjectRuleFailure "POOL" ShelleyPoolPredFailure era , InjectRuleEvent "POOL" PoolEvent era ) => ChainState era -> Block (BHeader MockCrypto) era -> - (ChainState era, Trace (ShelleyPOOL era)) + (ChainState era, Trace (POOL era)) poolTraceFromBlock chainSt block = ( tickedChainSt , runShelleyBase $ - Trace.closure @(ShelleyPOOL era) poolEnv poolSt0 poolCerts + Trace.closure @(POOL era) poolEnv poolSt0 poolCerts ) where (tickedChainSt, ledgerEnv, ledgerSt0, txs) = ledgerTraceBase chainSt block @@ -249,11 +249,11 @@ delegTraceFromBlock :: ) => ChainState era -> Block (BHeader MockCrypto) era -> - (DelegEnv era, Trace (ShelleyDELEG era)) + (DelegEnv era, Trace (DELEG era)) delegTraceFromBlock chainSt block = ( delegEnv , runShelleyBase $ - Trace.closure @(ShelleyDELEG era) delegEnv (ledgerSt0 ^. lsCertStateL) blockCerts + Trace.closure @(DELEG era) delegEnv (ledgerSt0 ^. lsCertStateL) blockCerts ) where (_tickedChainSt, ledgerEnv, ledgerSt0, txs) = ledgerTraceBase chainSt block diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/MirTransfer.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/MirTransfer.hs index 9a80f5054fd..a2e4511a114 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/MirTransfer.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/MirTransfer.hs @@ -12,9 +12,9 @@ import Cardano.Ledger.Hashes (GenDelegs (..)) import Cardano.Ledger.Shelley (ShelleyEra) import Cardano.Ledger.Shelley.API ( Credential (..), + DELEG, DelegEnv (..), Ptr (..), - ShelleyDELEG, ) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.Rules (ShelleyDelegPredFailure (..)) @@ -39,8 +39,8 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, testCase, (@?=)) ignoreAllButIRWD :: - Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) (CertState ShelleyEra) -> - Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) InstantaneousRewards + Either (NonEmpty (PredicateFailure (DELEG ShelleyEra))) (CertState ShelleyEra) -> + Either (NonEmpty (PredicateFailure (DELEG ShelleyEra))) InstantaneousRewards ignoreAllButIRWD = fmap (dsIRewards . shelleyCertDState) env :: ProtVer -> ChainAccountState -> DelegEnv ShelleyEra @@ -68,15 +68,15 @@ testMirTransfer :: MIRTarget -> InstantaneousRewards -> ChainAccountState -> - Either (NonEmpty (PredicateFailure (ShelleyDELEG ShelleyEra))) InstantaneousRewards -> + Either (NonEmpty (PredicateFailure (DELEG ShelleyEra))) InstantaneousRewards -> Assertion testMirTransfer pv pot target ir acnt (Right expected) = do - checkTrace @(ShelleyDELEG ShelleyEra) runShelleyBase (env pv acnt) $ + checkTrace @(DELEG ShelleyEra) runShelleyBase (env pv acnt) $ pure (certStateWithRewards ir) .- MirTxCert (MIRCert pot target) .->> certStateWithRewards expected testMirTransfer pv pot target ir acnt predicateFailure@(Left _) = do let st = runShelleyBase $ - applySTSTest @(ShelleyDELEG ShelleyEra) + applySTSTest @(DELEG ShelleyEra) (TRC (env pv acnt, certStateWithRewards ir, MirTxCert (MIRCert pot target))) ignoreAllButIRWD st @?= predicateFailure diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/MultiSigExamples.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/MultiSigExamples.hs index 70c8d0b55f2..0a40ae11898 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/MultiSigExamples.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/MultiSigExamples.hs @@ -36,7 +36,7 @@ import Cardano.Ledger.Shelley.LedgerState ( UTxOState, genesisState, ) -import Cardano.Ledger.Shelley.Rules (ShelleyUTXOW, UtxoEnv (..)) +import Cardano.Ledger.Shelley.Rules (UTXOW, UtxoEnv (..)) import Cardano.Ledger.Shelley.Scripts ( MultiSig, ShelleyEraScript, @@ -195,7 +195,7 @@ initialUTxOState :: [(MultiSig ShelleyEra, Coin)] -> ( TxId , Either - (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra))) + (NonEmpty (PredicateFailure (UTXOW ShelleyEra))) (UTxOState ShelleyEra) ) initialUTxOState aliceKeep msigs = @@ -219,7 +219,7 @@ initialUTxOState aliceKeep msigs = Nothing in ( txIdTx tx , runShelleyBase $ - applySTSTest @(ShelleyUTXOW ShelleyEra) + applySTSTest @(UTXOW ShelleyEra) ( TRC ( UtxoEnv (SlotNo 0) @@ -244,7 +244,7 @@ applyTxWithScript :: Withdrawals -> Coin -> [KeyPair Witness] -> - Either (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra))) (UTxOState ShelleyEra) + Either (NonEmpty (PredicateFailure (UTXOW ShelleyEra))) (UTxOState ShelleyEra) applyTxWithScript lockScripts unlockScripts wdrl aliceKeep signers = utxoSt' where (txId, initUtxo) = initialUTxOState aliceKeep lockScripts @@ -270,7 +270,7 @@ applyTxWithScript lockScripts unlockScripts wdrl aliceKeep signers = utxoSt' Nothing utxoSt' = runShelleyBase $ - applySTSTest @(ShelleyUTXOW ShelleyEra) + applySTSTest @(UTXOW ShelleyEra) ( TRC ( UtxoEnv (SlotNo 0) diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Tripping/CBOR.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Tripping/CBOR.hs index 52544ce631c..26d1e4696fc 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Tripping/CBOR.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Tripping/CBOR.hs @@ -58,6 +58,6 @@ tests = (eraProtVerLow @ShelleyEra) (eraProtVerHigh @ShelleyEra) , testProperty "LEDGER Predicate Failures" $ - roundTripExpectation @[PredicateFailure (STS.ShelleyLEDGERS ShelleyEra)] cborTrip + roundTripExpectation @[PredicateFailure (STS.LEDGERS ShelleyEra)] cborTrip , testCoreTypes ] 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 bfcb3ad8552..c8c2026ffe1 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 @@ -20,8 +20,8 @@ import Cardano.Ledger.Credential (Credential (..), Ptr (..), SlotNo32 (..), Stak import Cardano.Ledger.Keys (asWitness) import Cardano.Ledger.Shelley (ShelleyEra) import Cardano.Ledger.Shelley.API ( + LEDGER, LedgerEnv (..), - ShelleyLEDGER, ) import Cardano.Ledger.Shelley.Core import Cardano.Ledger.Shelley.LedgerState ( @@ -227,12 +227,12 @@ testLEDGER :: LedgerState ShelleyEra -> Tx TopTx ShelleyEra -> LedgerEnv ShelleyEra -> - Either (NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra))) (LedgerState ShelleyEra) -> + Either (NonEmpty (PredicateFailure (LEDGER ShelleyEra))) (LedgerState ShelleyEra) -> Assertion testLEDGER initSt tx env (Right expectedSt) = do - checkTrace @(ShelleyLEDGER ShelleyEra) runShelleyBase env $ pure initSt .- tx .->> expectedSt + checkTrace @(LEDGER ShelleyEra) runShelleyBase env $ pure initSt .- tx .->> expectedSt testLEDGER initSt tx env predicateFailure@(Left _) = do - let st = runShelleyBase $ applySTSTest @(ShelleyLEDGER ShelleyEra) (TRC (env, initSt, tx)) + let st = runShelleyBase $ applySTSTest @(LEDGER ShelleyEra) (TRC (env, initSt, tx)) st @?= predicateFailure aliceInitCoin :: Coin @@ -313,7 +313,7 @@ ledgerEnv :: LedgerEnv ShelleyEra ledgerEnv = LedgerEnv (SlotNo 0) Nothing minBound pp (ChainAccountState (Coin 0) (Coin 0)) testInvalidTx :: - NonEmpty (PredicateFailure (ShelleyLEDGER ShelleyEra)) -> + NonEmpty (PredicateFailure (LEDGER ShelleyEra)) -> Tx TopTx ShelleyEra -> Assertion testInvalidTx errs tx = @@ -621,7 +621,7 @@ testProducedOverMaxWord64 = tx = mkBasicTx @ShelleyEra txbody & witsTxL .~ txwits st = runShelleyBase $ - applySTSTest @(ShelleyLEDGER ShelleyEra) (TRC (ledgerEnv, ledgerState, tx)) + applySTSTest @(LEDGER ShelleyEra) (TRC (ledgerEnv, ledgerState, tx)) in -- We test that the predicate failure does not return bottom pure $! rnf st diff --git a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/StakeDistr.hs b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/StakeDistr.hs index 670c6312a40..a9e747685fd 100644 --- a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/StakeDistr.hs +++ b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/StakeDistr.hs @@ -167,16 +167,16 @@ tickfR2 globals slot nes = liftRule globals (TRC ((), nes, slot)) - (Shelley.validatingTickTransitionFORECAST @Shelley.ShelleyTICKF nes slot) + (Shelley.validatingTickTransitionFORECAST @Shelley.TICKF nes slot) mirR :: Globals -> EpochState CurrentEra -> EpochState CurrentEra -mirR globals es' = liftApplySTS globals (applySTS @(Shelley.ShelleyMIR CurrentEra) (TRC ((), es', ()))) +mirR globals es' = liftApplySTS globals (applySTS @(Shelley.MIR CurrentEra) (TRC ((), es', ()))) newEpochR :: Globals -> EpochNo -> NewEpochState CurrentEra -> NewEpochState CurrentEra -newEpochR globals epochNo nes = liftApplySTS globals (applySTS @(Shelley.ShelleyNEWEPOCH CurrentEra) (TRC ((), nes, epochNo))) +newEpochR globals epochNo nes = liftApplySTS globals (applySTS @(Shelley.NEWEPOCH CurrentEra) (TRC ((), nes, epochNo))) epochR :: Globals -> EpochNo -> EpochState CurrentEra -> EpochState CurrentEra -epochR globals epochNo es'' = liftApplySTS globals (applySTS @(Shelley.ShelleyEPOCH CurrentEra) (TRC ((), es'', epochNo))) +epochR globals epochNo es'' = liftApplySTS globals (applySTS @(Shelley.EPOCH CurrentEra) (TRC ((), es'', epochNo))) -- ============================================================ diff --git a/libs/cardano-ledger-test/benchProperty/Main.hs b/libs/cardano-ledger-test/benchProperty/Main.hs index 7da1a5ff7a5..8adab876d02 100644 --- a/libs/cardano-ledger-test/benchProperty/Main.hs +++ b/libs/cardano-ledger-test/benchProperty/Main.hs @@ -51,11 +51,11 @@ import Test.Cardano.Ledger.Shelley.Rules.ClassifyTraces (relevantCasesAreCovered -- =============================================================== -instance Embed (Alonzo.AlonzoBBODY AlonzoEra) (CHAIN AlonzoEra) where +instance Embed (Alonzo.BBODY AlonzoEra) (CHAIN AlonzoEra) where wrapFailed = BbodyFailure wrapEvent = BbodyEvent -instance Embed (Alonzo.AlonzoUTXOW AlonzoEra) (Shelley.ShelleyLEDGER AlonzoEra) where +instance Embed (Alonzo.UTXOW AlonzoEra) (Shelley.LEDGER AlonzoEra) where wrapFailed = Shelley.UtxowFailure wrapEvent = Shelley.UtxowEvent diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/MockChain.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/MockChain.hs index 31ed703a098..399c0ed30be 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/MockChain.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/MockChain.hs @@ -113,7 +113,7 @@ instance (Era era, NoThunks (NewEpochState era)) => NoThunks (MockChainState era instance ( EraGov era - , STS (Shelley.ShelleyTICK era) + , STS (Shelley.TICK era) , State (EraRule "TICK" era) ~ NewEpochState era , Signal (EraRule "TICK" era) ~ SlotNo , Environment (EraRule "TICK" era) ~ () @@ -164,7 +164,7 @@ instance -- Embed instances instance - ( STS (Shelley.ShelleyTICK era) + ( STS (Shelley.TICK era) , Signal (EraRule "RUPD" era) ~ SlotNo , State (EraRule "RUPD" era) ~ StrictMaybe PulsingRewUpdate , Environment (EraRule "RUPD" era) ~ Shelley.RupdEnv era @@ -173,18 +173,18 @@ instance , State (EraRule "NEWEPOCH" era) ~ NewEpochState era , Environment (EraRule "NEWEPOCH" era) ~ () ) => - Embed (Shelley.ShelleyTICK era) (MOCKCHAIN era) + Embed (Shelley.TICK era) (MOCKCHAIN era) where wrapFailed = \case {} wrapEvent = MockChainFromTickEvent instance - ( STS (Shelley.ShelleyLEDGERS era) + ( STS (Shelley.LEDGERS era) , State (EraRule "LEDGER" era) ~ LedgerState era , Environment (EraRule "LEDGER" era) ~ Shelley.LedgerEnv era , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era ) => - Embed (Shelley.ShelleyLEDGERS era) (MOCKCHAIN era) + Embed (Shelley.LEDGERS era) (MOCKCHAIN era) where wrapFailed = MockChainFromLedgersFailure wrapEvent = MockChainFromLedgersEvent diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs index e020b122f40..c5db256948a 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs @@ -276,8 +276,8 @@ adaIsPreservedInEachEpoch :: , Signal (EraRule "LEDGER" era) ~ StAnnTx TopTx era , BaseM (EraRule "NEWEPOCH" era) ~ ShelleyBase , Embed (EraRule "TICK" era) (MOCKCHAIN era) - , Embed (EraRule "NEWEPOCH" era) (Shelley.ShelleyTICK era) - , Embed (EraRule "RUPD" era) (Shelley.ShelleyTICK era) + , Embed (EraRule "NEWEPOCH" era) (Shelley.TICK era) + , Embed (EraRule "RUPD" era) (Shelley.TICK era) , Embed (EraRule "LEDGERS" era) (MOCKCHAIN era) , EraGenericGen era , ToExpr (PredicateFailure (EraRule "NEWEPOCH" era))