From 92c59dd529a8ea609caf1655895275a7295b4daa Mon Sep 17 00:00:00 2001 From: Aniket Deshpande Date: Wed, 23 Apr 2025 20:23:27 +0530 Subject: [PATCH 1/3] Replace ConwayNewEpochPredFailure with Void. Replace the corresponding check with an assertion. --- eras/conway/impl/CHANGELOG.md | 1 + .../Cardano/Ledger/Conway/Rules/NewEpoch.hs | 28 ++++++------------- .../Test/Cardano/Ledger/Conway/TreeDiff.hs | 2 -- .../Conformance/SpecTranslate/Conway/Cert.hs | 4 --- .../Test/Cardano/Ledger/Generic/PrettyCore.hs | 10 +------ 5 files changed, 11 insertions(+), 34 deletions(-) diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index a22ebf8d293..6f064cf5fc5 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.20.0.0 +- Remove `ConwayNewEpochPredFailure` and replace it with `Void`. #5007 * Added to `PParams`: `ppCommitteeMaxTermLength`,`ppCommitteeMinSize`,`ppDRepActivity`,`ppDRepDeposit`,`ppDRepVotingThresholds`,`ppGovActionDeposit`,`ppGovActionLifetime`,`ppGovProtocolVersion`,`ppMinFeeRefScriptCostPerByte`,`ppPoolVotingThresholds` * Moved `ConwayEraPlutusTxInfo` class from `Context` module to `TxInfo` * Removed `Cardano.Ledger.Conway.Plutus.Context` module 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 d5fa7fc8a0a..eb1bd580932 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs @@ -17,7 +17,6 @@ module Cardano.Ledger.Conway.Rules.NewEpoch ( ConwayNEWEPOCH, - ConwayNewEpochPredFailure (..), ConwayNewEpochEvent (..), ) where @@ -54,28 +53,15 @@ import Cardano.Ledger.Slot (EpochNo (EpochNo)) import Cardano.Ledger.State import qualified Cardano.Ledger.Val as Val import Control.DeepSeq (NFData) +import Control.Exception (assert) import Control.State.Transition import Data.Default (Default (..)) import qualified Data.Map.Strict as Map import Data.Set (Set) +import Data.Void (Void) import GHC.Generics (Generic) import Lens.Micro ((%~), (&), (^.)) -newtype ConwayNewEpochPredFailure era - = CorruptRewardUpdate - RewardUpdate -- The reward update which violates an invariant - deriving (Generic) - -deriving instance Eq (ConwayNewEpochPredFailure era) - -deriving instance - ( Show (PredicateFailure (EraRule "EPOCH" era)) - , Show (PredicateFailure (EraRule "RATIFY" era)) - ) => - Show (ConwayNewEpochPredFailure era) - -instance NFData (ConwayNewEpochPredFailure era) - data ConwayNewEpochEvent era = DeltaRewardEvent !(Event (EraRule "RUPD" era)) | RestrainedRewards @@ -121,6 +107,8 @@ instance , GovState era ~ ConwayGovState era , Eq (PredicateFailure (EraRule "RATIFY" era)) , Show (PredicateFailure (EraRule "RATIFY" era)) + , Eq (PredicateFailure (ConwayNEWEPOCH era)) + , Show (PredicateFailure (ConwayNEWEPOCH era)) ) => STS (ConwayNEWEPOCH era) where @@ -128,7 +116,7 @@ instance type Signal (ConwayNEWEPOCH era) = EpochNo type Environment (ConwayNEWEPOCH era) = () type BaseM (ConwayNEWEPOCH era) = ShelleyBase - type PredicateFailure (ConwayNEWEPOCH era) = ConwayNewEpochPredFailure era + type PredicateFailure (ConwayNEWEPOCH era) = Void type Event (ConwayNEWEPOCH era) = ConwayNewEpochEvent era initialRules = @@ -162,6 +150,8 @@ newEpochTransition :: , GovState era ~ ConwayGovState era , Eq (PredicateFailure (EraRule "RATIFY" era)) , Show (PredicateFailure (EraRule "RATIFY" era)) + , Eq (PredicateFailure (ConwayNEWEPOCH era)) + , Show (PredicateFailure (ConwayNEWEPOCH era)) ) => TransitionRule (ConwayNEWEPOCH era) newEpochTransition = do @@ -216,7 +206,7 @@ updateRewards :: Rule (ConwayNEWEPOCH era) 'Transition (EpochState era) updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do let totRs = sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_ - Val.isZero (dt <> dr <> toDeltaCoin totRs <> df) ?! CorruptRewardUpdate ru' + in assert (Val.isZero (dt <> dr <> toDeltaCoin totRs <> df)) (pure ()) let !(!es', filtered) = applyRUpdFiltered ru' es tellEvent $ RestrainedRewards e (frShelleyIgnored filtered) (frUnregistered filtered) -- This event (which is only generated once per epoch) must be generated even if the @@ -226,8 +216,8 @@ updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do instance ( STS (ConwayNEWEPOCH era) - , PredicateFailure (EraRule "NEWEPOCH" era) ~ ConwayNewEpochPredFailure era , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era + , PredicateFailure (EraRule "NEWEPOCH" era) ~ PredicateFailure (ConwayNEWEPOCH era) ) => Embed (ConwayNEWEPOCH era) (ShelleyTICK era) where diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/TreeDiff.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/TreeDiff.hs index a5b99cd1bbd..5a70698e828 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/TreeDiff.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/TreeDiff.hs @@ -281,8 +281,6 @@ instance ToExpr (PParamsHKD StrictMaybe era) => ToExpr (RatifySignal era) instance ToExpr (PParamsHKD StrictMaybe era) => ToExpr (EnactSignal era) -instance ToExpr (ConwayNewEpochPredFailure era) - instance ( ToExpr (PParamsHKD Identity era) , ToExpr (PParamsHKD StrictMaybe era) diff --git a/libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/SpecTranslate/Conway/Cert.hs b/libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/SpecTranslate/Conway/Cert.hs index a47e924bc4b..95ace1413bf 100644 --- a/libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/SpecTranslate/Conway/Cert.hs +++ b/libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/SpecTranslate/Conway/Cert.hs @@ -223,7 +223,3 @@ instance <$> toSpecRep nesEL <*> toSpecRep nesEs <*> toSpecRep nesRu - -instance SpecTranslate ctx (ConwayNewEpochPredFailure era) where - type SpecRep (ConwayNewEpochPredFailure era) = OpaqueErrorString - toSpecRep = pure . showOpaqueErrorString diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs index 158dddeb99e..c34975fca13 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs @@ -134,7 +134,6 @@ import Cardano.Ledger.Conway.Rules ( ConwayGovCertPredFailure (..), ConwayGovPredFailure (..), ConwayLedgerPredFailure (..), - ConwayNewEpochPredFailure, ConwayUtxosPredFailure, EnactSignal (..), GovEnv (..), @@ -1265,7 +1264,7 @@ ppNEWEPOCH Allegra x = ppShelleyNewEpochPredicateFailure x ppNEWEPOCH Mary x = ppShelleyNewEpochPredicateFailure x ppNEWEPOCH Alonzo x = ppShelleyNewEpochPredicateFailure x ppNEWEPOCH Babbage x = ppShelleyNewEpochPredicateFailure x -ppNEWEPOCH Conway x = ppConwayNewEpochPredFailure x +ppNEWEPOCH Conway x = absurd x ppEPOCH :: Proof era -> PredicateFailure (EraRule "EPOCH" era) -> PDoc ppEPOCH Shelley x = ppShelleyEpochPredFailure x @@ -1710,13 +1709,6 @@ ppShelleyNewEpochPredicateFailure (MirFailure _) = instance Reflect era => PrettyA (ShelleyNewEpochPredFailure era) where prettyA = ppShelleyNewEpochPredicateFailure -ppConwayNewEpochPredFailure :: ConwayNewEpochPredFailure era -> PDoc -ppConwayNewEpochPredFailure (ConwayRules.CorruptRewardUpdate x) = - ppSexp "CorruptRewardUpdate" [ppRewardUpdate x] - -instance PrettyA (ConwayNewEpochPredFailure era) where - prettyA = ppConwayNewEpochPredFailure - -- =============== ppShelleyEpochPredFailure :: forall era. ShelleyEpochPredFailure era -> PDoc From 224b3c8205637b3198b4a73a3d021a9f86104f65 Mon Sep 17 00:00:00 2001 From: Aniket Deshpande Date: Fri, 2 May 2025 19:57:10 +0530 Subject: [PATCH 2/3] Remove CorruptRewardUpdate from ShelleyNewEpochPredFailure. Replace the corresponding check with an assertion. --- eras/shelley/impl/CHANGELOG.md | 1 + .../impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs | 5 ++--- .../src/Test/Cardano/Ledger/Generic/PrettyCore.hs | 2 -- 3 files changed, 3 insertions(+), 5 deletions(-) diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 18e10e98d51..ce872a84323 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.17.0.0 +- Remove `CorruptRewardUpdate` predicate failure and replace that check with an assertion. #5007 * Added to `PParams`: `shelleyPParams`, `ppA0`,`ppD`,`ppEMax`,`ppExtraEntropy`,`ppMaxBBSize`,`ppKeyDeposit`,`ppMinFeeA`,`ppMinFeeB`,`ppMinPoolCost` `ppMaxBHSize`,`ppMaxTxSize`,`ppNOpt`,`ppProtocolVersion`,`ppPoolDeposit`,`ppRho`,`ppTau` * Removed from `PParams`: `shelleyCommonPParamsHKDPairs`,`shelleyCommonPParamsHKDPairsV6`,`shelleyCommonPParamsHKDPairsV8` * Replace export from `Cardano.Ledger.Shelley.UTxO` of deprecated `balance` and `coinBalance` with `sumUTxO` and `sumCoinUTxO` respectively 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 0d119decbaf..a1dd3b7827a 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs @@ -42,6 +42,7 @@ import Cardano.Ledger.Slot (EpochNo (..)) import Cardano.Ledger.State import qualified Cardano.Ledger.Val as Val import Control.DeepSeq (NFData) +import Control.Exception (assert) import Control.State.Transition import Data.Default (Default, def) import qualified Data.Map.Strict as Map @@ -52,8 +53,6 @@ import NoThunks.Class (NoThunks (..)) data ShelleyNewEpochPredFailure era = EpochFailure (PredicateFailure (EraRule "EPOCH" era)) -- Subtransition Failures - | CorruptRewardUpdate - RewardUpdate -- The reward update which violates an invariant | MirFailure (PredicateFailure (EraRule "MIR" era)) -- Subtransition Failures deriving (Generic) @@ -265,7 +264,7 @@ updateRewards :: Rule (ShelleyNEWEPOCH era) 'Transition (EpochState era) updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do let totRs = sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_ - Val.isZero (dt <> (dr <> toDeltaCoin totRs <> df)) ?! CorruptRewardUpdate ru' + in assert (Val.isZero (dt <> (dr <> toDeltaCoin totRs <> df))) (pure ()) let !(!es', filtered) = applyRUpdFiltered ru' es tellEvent $ RestrainedRewards e (frShelleyIgnored filtered) (frUnregistered filtered) -- This event (which is only generated once per epoch) must be generated even if the diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs index c34975fca13..16ab5e2758d 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs @@ -1701,8 +1701,6 @@ instance Reflect era => PrettyA (ShelleyTickPredFailure era) where ppShelleyNewEpochPredicateFailure :: forall era. Reflect era => ShelleyNewEpochPredFailure era -> PDoc ppShelleyNewEpochPredicateFailure (EpochFailure x) = ppEPOCH @era reify x -ppShelleyNewEpochPredicateFailure (CorruptRewardUpdate x) = - ppSexp "CorruptRewardUpdate" [ppRewardUpdate x] ppShelleyNewEpochPredicateFailure (MirFailure _) = error "In the Conway era, there is no (EraRule MIR) type instance." From 5a932797a399b715e729ddb7624f0dbf7588c13e Mon Sep 17 00:00:00 2001 From: Aniket Deshpande Date: Thu, 15 May 2025 18:08:43 +0530 Subject: [PATCH 3/3] Remove the failing test --- .../Test/Cardano/Ledger/Shelley/RulesTests.hs | 71 +------------------ eras/shelley/test-suite/test/Tests.hs | 2 - 2 files changed, 1 insertion(+), 72 deletions(-) diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/RulesTests.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/RulesTests.hs index 53716ee3372..b039f1db900 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/RulesTests.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/RulesTests.hs @@ -9,35 +9,19 @@ module Test.Cardano.Ledger.Shelley.RulesTests ( chainExamples, multisigExamples, - testTickF, ) where -import Cardano.Ledger.BaseTypes (Network (..), StrictMaybe (..)) +import Cardano.Ledger.BaseTypes (Network (..)) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core (hashScript) import Cardano.Ledger.Credential (pattern ScriptHashObj) import Cardano.Ledger.Keys (asWitness, hashKey) import Cardano.Ledger.Shelley (ShelleyEra) -import Cardano.Ledger.Shelley.API (ShelleyTICK, ShelleyTICKF) -import Cardano.Ledger.Shelley.LedgerState ( - EpochState (..), - LedgerState (..), - NewEpochState (..), - UTxOState (..), - totalObligation, - utxosGovStateL, - ) -import Cardano.Ledger.Shelley.RewardUpdate (PulsingRewUpdate (..), RewardUpdate (..)) import Cardano.Ledger.Shelley.Rules (ShelleyUtxowPredFailure (..)) import Cardano.Ledger.Shelley.TxBody (RewardAccount (..), Withdrawals (..)) -import Cardano.Ledger.Slot (EpochNo (..)) -import Cardano.Protocol.TPraos.API (GetLedgerView (..)) -import Control.State.Transition.Extended (TRC (..)) import Data.Either (isRight) import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe) import qualified Data.Set as Set -import Lens.Micro ((^.)) import Test.Cardano.Ledger.Core.KeyPair (vKey) import Test.Cardano.Ledger.Shelley.Examples (testCHAINExample) import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast @@ -62,10 +46,8 @@ import Test.Cardano.Ledger.Shelley.MultiSigExamples ( ) import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators () import Test.Cardano.Ledger.Shelley.Serialisation.Generators () -import Test.Cardano.Ledger.Shelley.Utils import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, testCase, (@?=)) -import Test.Tasty.QuickCheck (Property, discard, testProperty, (===)) chainExamples :: TestTree chainExamples = @@ -488,54 +470,3 @@ testRwdAliceSignsAlone''' = (Coin 0) [asWitness Cast.alicePay, asWitness Cast.bobPay] wits = Set.singleton $ hashScript @ShelleyEra bobOnly - --- | The reward aggregation bug described in the Shelley ledger spec in --- section 17.4 (in the Errata) resulted in needing to use 'aggregatedRewards' to change --- the behavior of how rewards are collected starting at protocol version 3. --- Instead of collecting a `Coin` for each stake credential, we collect 'Set Reward'. --- In major protocol version 2, it is impossible for this set to be empty, but sadly this --- property is not enforced in the types. For this reason, the property test --- 'propTickfPerservesLedgerView' removes these empty sets from an otherwise arbitrary --- 'NewEpochState'. -filterEmptyRewards :: NewEpochState ShelleyEra -> NewEpochState ShelleyEra -filterEmptyRewards (NewEpochState el bprev bcur es ru pd stash) = - NewEpochState el bprev bcur es ru' pd stash - where - removeEmptyRewards = Map.filter $ not . Set.null - ru' = case ru of - SNothing -> SNothing - SJust (Pulsing _ _) -> SNothing - SJust (Complete rewardUpdate) -> - SJust . Complete $ rewardUpdate {rs = removeEmptyRewards (rs rewardUpdate)} - -setDepositsToObligation :: NewEpochState ShelleyEra -> NewEpochState ShelleyEra -setDepositsToObligation nes = nes {nesEs = es {esLState = ls {lsUTxOState = utxoState}}} - where - es = nesEs nes - ls = esLState es - utxoState = - (lsUTxOState ls) - { utxosDeposited = - totalObligation - (lsCertState ls) - (utxoState ^. utxosGovStateL) - } - --- | This property test checks the correctness of the TICKF transation. --- TICKF is used by the consensus layer to get a ledger view in a computationally --- cheaper way than using the TICK rule. --- Therefore TICKF and TICK need to compute the same ledger view. -propTickfPerservesLedgerView :: NewEpochState ShelleyEra -> Property -propTickfPerservesLedgerView nes = - let (EpochNo e) = nesEL nes - slot = slotFromEpoch (EpochNo $ e + 1) - nes' = setDepositsToObligation (filterEmptyRewards nes) - tickNes = runShelleyBase $ applySTSTest @(ShelleyTICK ShelleyEra) (TRC ((), nes', slot)) - tickFNes = runShelleyBase $ applySTSTest @(ShelleyTICKF ShelleyEra) (TRC ((), nes', slot)) - in fromMaybe discard $ do - Right tickNes' <- pure tickNes - Right tickFNes' <- pure tickFNes - pure $ currentLedgerView tickNes' === currentLedgerView tickFNes' - -testTickF :: TestTree -testTickF = testProperty "TICKF properties" propTickfPerservesLedgerView diff --git a/eras/shelley/test-suite/test/Tests.hs b/eras/shelley/test-suite/test/Tests.hs index 3d4d94c5903..e2af6aed3f0 100644 --- a/eras/shelley/test-suite/test/Tests.hs +++ b/eras/shelley/test-suite/test/Tests.hs @@ -16,7 +16,6 @@ import qualified Test.Cardano.Ledger.Shelley.Rules.Deposits as Deposits (tests) import qualified Test.Cardano.Ledger.Shelley.RulesTests as RulesTests ( chainExamples, multisigExamples, - testTickF, ) import qualified Test.Cardano.Ledger.Shelley.SafeHash as SafeHash (safeHashTest) import qualified Test.Cardano.Ledger.Shelley.Serialisation as Serialisation @@ -52,7 +51,6 @@ defaultTests = , Serialisation.tests , RulesTests.chainExamples , RulesTests.multisigExamples - , RulesTests.testTickF , UnitTests.unitTests , SafeHash.safeHashTest ]