From b39fca83340a925feae23f305706bc61974ad160 Mon Sep 17 00:00:00 2001 From: Aniket Deshpande Date: Thu, 16 Oct 2025 16:22:35 +0530 Subject: [PATCH 1/2] Move withdrawals-draining from DELEGS to LEDGER. * Remove `WIthdrawalsNotInRewardsDELEGS` pred-failure. * Add `ShelleyWithdrawalsMissingAccounts` and `ShelleyIncompleteWithdrawals` to `ShelleyLedgerPredFailure`. --- .../src/Cardano/Ledger/Alonzo/Rules/Ledger.hs | 15 ++++- .../src/Test/Cardano/Ledger/Alonzo/Trace.hs | 3 + .../Cardano/Ledger/Babbage/Rules/Ledger.hs | 3 + .../src/Cardano/Ledger/Conway/Rules/Ledger.hs | 46 ++++++++------ .../Cardano/Ledger/Conway/Rules/Mempool.hs | 8 ++- .../Cardano/Ledger/Dijkstra/Rules/Ledger.hs | 5 ++ .../Cardano/Ledger/Shelley/Rules/Delegs.hs | 35 ++--------- .../Cardano/Ledger/Shelley/Rules/Ledger.hs | 61 +++++++++++++++++-- .../Ledger/Shelley/Generator/Trace/Ledger.hs | 1 + .../Test/Cardano/Ledger/Shelley/UnitTests.hs | 5 +- 10 files changed, 121 insertions(+), 61 deletions(-) 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 086d4f62556..0b7bea211b4 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs @@ -43,6 +43,7 @@ import Cardano.Ledger.Shelley.Rules ( ShelleyUtxowPredFailure, UtxoEnv (..), shelleyLedgerAssertions, + testIncompleteAndMissingWithdrawals, ) import Cardano.Ledger.Shelley.Rules as Shelley ( LedgerEnv (..), @@ -53,7 +54,7 @@ import Cardano.Ledger.Shelley.Rules as Shelley ( renderDepositEqualsObligationViolation, ) import Cardano.Ledger.Slot (epochFromSlot) -import Cardano.Ledger.State (EraCertState) +import Cardano.Ledger.State (EraCertState, accountsL, certDStateL, drainAccounts) import Control.State.Transition ( Embed (..), STS (..), @@ -125,6 +126,9 @@ ledgerTransition :: , State (EraRule "UTXOW" era) ~ UTxOState era , Signal (EraRule "UTXOW" era) ~ Tx era , AlonzoEraTx era + , EraCertState era + , EraRule "LEDGER" era ~ someLEDGER era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => TransitionRule (someLEDGER era) ledgerTransition = do @@ -136,11 +140,13 @@ ledgerTransition = do certState' <- if tx ^. isValidTxL == IsValid True - then + then do + let withdrawals = tx ^. bodyTxL . withdrawalsTxBodyL + testIncompleteAndMissingWithdrawals (certState ^. certDStateL . accountsL) withdrawals trans @(EraRule "DELEGS" era) $ TRC ( DelegsEnv slot curEpochNo txIx pp tx account - , certState + , certState & certDStateL . accountsL %~ drainAccounts withdrawals , StrictSeq.fromStrict $ txBody ^. certsTxBodyL ) else pure certState @@ -166,6 +172,9 @@ instance , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) , AtMostEra "Babbage" era + , EraRule "LEDGER" era ~ AlonzoLEDGER era + , EraRuleFailure "LEDGER" era ~ ShelleyLedgerPredFailure era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era , EraCertState era ) => STS (AlonzoLEDGER era) 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 3320bab8d30..a5e19c4ef2f 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 @@ -23,6 +23,7 @@ import Cardano.Ledger.Shelley.Rules ( DelplEnv, LedgerEnv (..), ShelleyDelplPredFailure, + ShelleyLedgerPredFailure, UtxoEnv, ) import Cardano.Ledger.Shelley.State @@ -66,6 +67,8 @@ instance , AtMostEra "Babbage" era , EraCertState era , Crypto c + , EraRuleFailure "LEDGER" era ~ ShelleyLedgerPredFailure era + , EraRule "LEDGER" era ~ AlonzoLEDGER era ) => TQC.HasTrace (AlonzoLEDGER era) (GenEnv c era) where 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 452baac27e9..44fb649a2d6 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Ledger.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Ledger.hs @@ -119,6 +119,9 @@ instance , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) , AtMostEra "Babbage" era , EraCertState era + , EraRule "LEDGER" era ~ BabbageLEDGER era + , EraRuleFailure "LEDGER" era ~ ShelleyLedgerPredFailure era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => STS (BabbageLEDGER era) where 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 ea1a6727d69..dd6313ad9bc 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs @@ -18,6 +18,7 @@ module Cardano.Ledger.Conway.Rules.Ledger ( ConwayLEDGER, ConwayLedgerPredFailure (..), ConwayLedgerEvent (..), + shelleyToConwayLedgerPredFailure, ) where import Cardano.Ledger.Address (RewardAccount (..)) @@ -40,7 +41,6 @@ import Cardano.Ledger.BaseTypes ( Relation (..), ShelleyBase, StrictMaybe (..), - networkId, swapMismatch, unswapMismatch, ) @@ -98,6 +98,7 @@ import Cardano.Ledger.Shelley.LedgerState ( import Cardano.Ledger.Shelley.Rules ( LedgerEnv (..), ShelleyLEDGERS, + ShelleyLedgerPredFailure (..), ShelleyLedgersEvent (..), ShelleyLedgersPredFailure (..), ShelleyPoolPredFailure, @@ -106,17 +107,16 @@ import Cardano.Ledger.Shelley.Rules ( UtxoEnv (..), renderDepositEqualsObligationViolation, shelleyLedgerAssertions, + testIncompleteAndMissingWithdrawals, ) import Cardano.Ledger.Slot (epochFromSlot) import Control.DeepSeq (NFData) import Control.Monad (unless) -import Control.Monad.Trans.Reader (asks) import Control.State.Transition.Extended ( Embed (..), STS (..), TRC (..), TransitionRule, - failOnJust, failOnNonEmpty, judgmentContext, liftSTS, @@ -153,6 +153,9 @@ type instance EraRuleEvent "LEDGER" ConwayEra = ConwayLedgerEvent ConwayEra instance InjectRuleFailure "LEDGER" ConwayLedgerPredFailure ConwayEra +instance InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure ConwayEra where + injectFailure = shelleyToConwayLedgerPredFailure + instance InjectRuleFailure "LEDGER" ConwayUtxowPredFailure ConwayEra where injectFailure = ConwayUtxowFailure @@ -204,6 +207,14 @@ instance InjectRuleFailure "LEDGER" ConwayGovPredFailure ConwayEra where instance InjectRuleFailure "LEDGER" ConwayUtxosPredFailure ConwayEra where injectFailure = ConwayUtxowFailure . injectFailure +shelleyToConwayLedgerPredFailure :: + forall era. ShelleyLedgerPredFailure era -> ConwayLedgerPredFailure era +shelleyToConwayLedgerPredFailure = \case + UtxowFailure x -> ConwayUtxowFailure x + DelegsFailure _ -> error "Impossible: DELEGS has ben removed in Conway" + ShelleyWithdrawalsMissingAccounts x -> ConwayWithdrawalsMissingAccounts x + ShelleyIncompleteWithdrawals x -> ConwayIncompleteWithdrawals x + deriving instance ( Era era , Eq (PredicateFailure (EraRule "UTXOW" era)) @@ -316,6 +327,9 @@ instance , Signal (EraRule "GOV" era) ~ GovSignal era , ConwayEraCertState era , EraCertState era + , EraRuleFailure "LEDGER" era ~ ConwayLedgerPredFailure era + , EraRule "LEDGER" era ~ ConwayLEDGER era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => STS (ConwayLEDGER era) where @@ -341,25 +355,27 @@ ledgerTransition :: , ConwayEraTxBody era , ConwayEraGov era , GovState era ~ ConwayGovState era - , Signal (someLEDGER era) ~ Tx era - , State (someLEDGER era) ~ LedgerState era - , Environment (someLEDGER era) ~ LedgerEnv era - , PredicateFailure (someLEDGER era) ~ ConwayLedgerPredFailure era , Embed (EraRule "UTXOW" era) (someLEDGER era) , Embed (EraRule "GOV" era) (someLEDGER era) , Embed (EraRule "CERTS" era) (someLEDGER era) , State (EraRule "UTXOW" era) ~ UTxOState era , State (EraRule "CERTS" era) ~ CertState era , State (EraRule "GOV" era) ~ Proposals era + , State (someLEDGER era) ~ LedgerState era , Environment (EraRule "UTXOW" era) ~ UtxoEnv era , Environment (EraRule "GOV" era) ~ GovEnv era , Environment (EraRule "CERTS" era) ~ CertsEnv era + , Environment (someLEDGER era) ~ LedgerEnv era , Signal (EraRule "UTXOW" era) ~ Tx era , Signal (EraRule "CERTS" era) ~ Seq (TxCert era) , Signal (EraRule "GOV" era) ~ GovSignal era + , Signal (someLEDGER era) ~ Tx era , BaseM (someLEDGER era) ~ ShelleyBase , STS (someLEDGER era) , ConwayEraCertState era + , EraRule "LEDGER" era ~ someLEDGER era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era + , PredicateFailure (someLEDGER era) ~ ConwayLedgerPredFailure era ) => TransitionRule (someLEDGER era) ledgerTransition = do @@ -427,18 +443,8 @@ ledgerTransition = do certState' <- if hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule $ pp ^. ppProtocolVersionL then do - network <- liftSTS $ asks networkId - let accounts = certState ^. certDStateL . accountsL - withdrawals = tx ^. bodyTxL . withdrawalsTxBodyL - (invalidWithdrawals, incompleteWithdrawals) = - case withdrawalsThatDoNotDrainAccounts withdrawals network accounts of - Nothing -> (Nothing, Nothing) - Just (invalid, incomplete) -> - ( if null (unWithdrawals invalid) then Nothing else Just invalid - , if null (unWithdrawals incomplete) then Nothing else Just incomplete - ) - failOnJust invalidWithdrawals ConwayWithdrawalsMissingAccounts - failOnJust incompleteWithdrawals ConwayIncompleteWithdrawals + let withdrawals = tx ^. bodyTxL . withdrawalsTxBodyL + testIncompleteAndMissingWithdrawals (certState ^. certDStateL . accountsL) withdrawals pure $ certState & updateDormantDRepExpiries tx curEpochNo @@ -564,6 +570,8 @@ instance , Event (EraRule "LEDGER" era) ~ ConwayLedgerEvent era , EraGov era , ConwayEraCertState era + , EraRule "LEDGER" era ~ ConwayLEDGER era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => Embed (ConwayLEDGER era) (ShelleyLEDGERS era) where 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 498658836eb..8f470288917 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Mempool.hs @@ -34,7 +34,7 @@ import Cardano.Ledger.Conway.Rules.Gov (GovEnv, GovSignal, unelectedCommitteeVot import Cardano.Ledger.Conway.Rules.Ledger (ConwayLedgerEvent, ConwayLedgerPredFailure (..)) import Cardano.Ledger.Conway.State import Cardano.Ledger.Shelley.LedgerState -import Cardano.Ledger.Shelley.Rules (LedgerEnv (..), UtxoEnv, ledgerPpL) +import Cardano.Ledger.Shelley.Rules (LedgerEnv (..), ShelleyLedgerPredFailure, UtxoEnv, ledgerPpL) import Control.Monad (unless) import Control.State.Transition ( BaseM, @@ -149,14 +149,20 @@ instance , Environment (EraRule "CERTS" era) ~ CertsEnv era , Environment (EraRule "GOV" era) ~ GovEnv era , Environment (EraRule "UTXOW" era) ~ UtxoEnv era + , Environment (EraRule "LEDGER" era) ~ LedgerEnv era , State (EraRule "CERTS" era) ~ CertState era , State (EraRule "GOV" era) ~ Proposals era , State (EraRule "UTXOW" era) ~ UTxOState era + , State (EraRule "LEDGER" era) ~ LedgerState era , GovState era ~ ConwayGovState era , Signal (EraRule "CERTS" era) ~ Seq (TxCert era) , Signal (EraRule "GOV" era) ~ GovSignal era , Signal (EraRule "UTXOW" era) ~ Tx era + , Signal (EraRule "LEDGER" era) ~ Tx era , ConwayEraCertState era + , EraRule "LEDGER" era ~ ConwayLEDGER era + , EraRuleFailure "LEDGER" era ~ ConwayLedgerPredFailure era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => Embed (ConwayLEDGER era) (ConwayMEMPOOL era) where 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 5ebfd6c93cc..340d60e6c8e 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Ledger.hs @@ -23,12 +23,14 @@ import Cardano.Ledger.Conway.Rules ( ConwayUtxoPredFailure, ConwayUtxosPredFailure, ConwayUtxowPredFailure, + shelleyToConwayLedgerPredFailure, ) import Cardano.Ledger.Dijkstra.Core (EraRuleEvent, EraRuleFailure, InjectRuleFailure (..)) import Cardano.Ledger.Dijkstra.Era (DijkstraEra) import Cardano.Ledger.Dijkstra.Rules.Certs () import Cardano.Ledger.Dijkstra.Rules.Utxow () import Cardano.Ledger.Shelley.Rules ( + ShelleyLedgerPredFailure, ShelleyPoolPredFailure, ShelleyUtxoPredFailure, ShelleyUtxowPredFailure, @@ -40,6 +42,9 @@ type instance EraRuleEvent "LEDGER" DijkstraEra = ConwayLedgerEvent DijkstraEra instance InjectRuleFailure "LEDGER" ConwayLedgerPredFailure DijkstraEra +instance InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure DijkstraEra where + injectFailure = shelleyToConwayLedgerPredFailure + instance InjectRuleFailure "LEDGER" ConwayUtxowPredFailure DijkstraEra where injectFailure = ConwayUtxowFailure 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 5cc456c451b..2ef72ad354a 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs @@ -7,7 +7,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} @@ -31,7 +30,6 @@ import Cardano.Ledger.BaseTypes ( ShelleyBase, TxIx (..), invalidKey, - networkId, ) import Cardano.Ledger.Binary ( DecCBOR (..), @@ -55,16 +53,13 @@ import Cardano.Ledger.Shelley.Rules.Pool (ShelleyPoolPredFailure) import Cardano.Ledger.Shelley.State import Cardano.Ledger.Slot (SlotNo (..)) import Control.DeepSeq -import Control.Monad.Trans.Reader (asks) import Control.SetAlgebra (dom, eval, (∈)) import Control.State.Transition ( Embed (..), STS (..), TRC (..), TransitionRule, - failOnJust, judgmentContext, - liftSTS, trans, validateTrans, ) @@ -96,9 +91,6 @@ data ShelleyDelegsPredFailure era = -- | Target pool which is not registered DelegateeNotRegisteredDELEG (KeyHash 'StakePool) - | -- | Withdrawals that are missing or do not withdrawal the entire amount - WithdrawalsNotInRewardsDELEGS - Withdrawals | -- | Subtransition Failures DelplFailure (PredicateFailure (EraRule "DELPL" era)) deriving (Generic) @@ -173,13 +165,9 @@ instance encodeListLen 2 <> encCBOR (0 :: Word8) <> encCBOR kh - WithdrawalsNotInRewardsDELEGS ws -> - encodeListLen 2 - <> encCBOR (1 :: Word8) - <> encCBOR ws (DelplFailure a) -> encodeListLen 2 - <> encCBOR (2 :: Word8) + <> encCBOR (1 :: Word8) <> encCBOR a instance @@ -196,9 +184,6 @@ instance kh <- decCBOR pure (2, DelegateeNotRegisteredDELEG kh) 1 -> do - ws <- decCBOR - pure (2, WithdrawalsNotInRewardsDELEGS ws) - 2 -> do a <- decCBOR pure (2, DelplFailure a) k -> invalidKey k @@ -217,21 +202,13 @@ delegsTransition :: TransitionRule (ShelleyDELEGS era) delegsTransition = do TRC - (env@(DelegsEnv slot@(SlotNo slot64) epochNo txIx pp tx chainAccountState), certState, certificates) <- + ( env@(DelegsEnv slot@(SlotNo slot64) epochNo txIx pp _tx chainAccountState) + , certState + , certificates + ) <- judgmentContext - network <- liftSTS $ asks networkId - case certificates of - Empty -> do - let dState = certState ^. certDStateL - withdrawals = tx ^. bodyTxL . withdrawalsTxBodyL - accounts = dState ^. accountsL - failOnJust - (withdrawalsThatDoNotDrainAccounts withdrawals network accounts) - ( \(invalid, incomplete) -> - WithdrawalsNotInRewardsDELEGS $ Withdrawals $ unWithdrawals invalid <> unWithdrawals incomplete - ) - pure $ certState & certDStateL . accountsL %~ drainAccounts withdrawals + Empty -> pure certState gamma :|> txCert -> do certState' <- trans @(ShelleyDELEGS era) $ TRC (env, certState, gamma) 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 8c127be4cb3..bad82603a96 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs @@ -31,9 +31,10 @@ module Cardano.Ledger.Shelley.Rules.Ledger ( epochFromSlot, renderDepositEqualsObligationViolation, shelleyLedgerAssertions, + testIncompleteAndMissingWithdrawals, ) where -import Cardano.Ledger.BaseTypes (ShelleyBase, TxIx, invalidKey) +import Cardano.Ledger.BaseTypes (ShelleyBase, TxIx, invalidKey, networkId) import Cardano.Ledger.Binary ( DecCBOR (..), EncCBOR (..), @@ -65,15 +66,25 @@ 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.Slot (EpochNo (..), SlotNo, epochFromSlot) -import Cardano.Ledger.State (EraCertState (..)) +import Cardano.Ledger.State ( + Accounts, + EraAccounts, + EraCertState (..), + accountsL, + drainAccounts, + withdrawalsThatDoNotDrainAccounts, + ) import Control.DeepSeq (NFData (..)) +import Control.Monad.Trans.Reader (asks) import Control.State.Transition ( Assertion (PostCondition), AssertionViolation (..), Embed (..), + Rule, STS (..), TRC (..), TransitionRule, + failOnJust, judgmentContext, liftSTS, trans, @@ -116,6 +127,8 @@ instance EraPParams era => EncCBOR (LedgerEnv era) where data ShelleyLedgerPredFailure era = UtxowFailure (PredicateFailure (EraRule "UTXOW" era)) -- Subtransition Failures | DelegsFailure (PredicateFailure (EraRule "DELEGS" era)) -- Subtransition Failures + | ShelleyWithdrawalsMissingAccounts Withdrawals + | ShelleyIncompleteWithdrawals Withdrawals deriving (Generic) ledgerSlotNoL :: Lens' (LedgerEnv era) SlotNo @@ -213,8 +226,10 @@ instance EncCBOR (ShelleyLedgerPredFailure era) where encCBOR = \case - (UtxowFailure a) -> encodeListLen 2 <> encCBOR (0 :: Word8) <> encCBOR a - (DelegsFailure a) -> encodeListLen 2 <> encCBOR (1 :: Word8) <> encCBOR a + UtxowFailure a -> encodeListLen 2 <> encCBOR (0 :: Word8) <> encCBOR a + DelegsFailure a -> encodeListLen 2 <> encCBOR (1 :: Word8) <> encCBOR a + ShelleyWithdrawalsMissingAccounts w -> encodeListLen 2 <> encCBOR (2 :: Word8) <> encCBOR w + ShelleyIncompleteWithdrawals w -> encodeListLen 2 <> encCBOR (3 :: Word8) <> encCBOR w instance ( DecCBOR (PredicateFailure (EraRule "DELEGS" era)) @@ -232,6 +247,12 @@ instance 1 -> do a <- decCBOR pure (2, DelegsFailure a) + 2 -> do + w <- decCBOR + pure (2, ShelleyWithdrawalsMissingAccounts w) + 3 -> do + w <- decCBOR + pure (2, ShelleyIncompleteWithdrawals w) k -> invalidKey k shelleyLedgerAssertions :: @@ -261,6 +282,9 @@ instance , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) , AtMostEra "Babbage" era + , EraRule "LEDGER" era ~ ShelleyLEDGER era + , EraRuleFailure "LEDGER" era ~ ShelleyLedgerPredFailure era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => STS (ShelleyLEDGER era) where @@ -281,6 +305,7 @@ instance ledgerTransition :: forall era. ( EraTx era + , EraCertState era , STS (ShelleyLEDGER era) , Embed (EraRule "DELEGS" era) (ShelleyLEDGER era) , Environment (EraRule "DELEGS" era) ~ DelegsEnv era @@ -290,17 +315,21 @@ ledgerTransition :: , Environment (EraRule "UTXOW" era) ~ UtxoEnv era , State (EraRule "UTXOW" era) ~ UTxOState era , Signal (EraRule "UTXOW" era) ~ Tx era + , EraRule "LEDGER" era ~ ShelleyLEDGER era + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era ) => TransitionRule (ShelleyLEDGER era) ledgerTransition = do TRC (LedgerEnv slot mbCurEpochNo txIx pp account, LedgerState utxoSt certState, tx) <- judgmentContext curEpochNo <- maybe (liftSTS $ epochFromSlot slot) pure mbCurEpochNo + let withdrawals = tx ^. bodyTxL . withdrawalsTxBodyL + testIncompleteAndMissingWithdrawals (certState ^. certDStateL . accountsL) withdrawals certState' <- trans @(EraRule "DELEGS" era) $ TRC ( DelegsEnv slot curEpochNo txIx pp tx account - , certState + , certState & certDStateL . accountsL %~ drainAccounts withdrawals , StrictSeq.fromStrict $ tx ^. bodyTxL . certsTxBodyL ) @@ -313,6 +342,28 @@ ledgerTransition = do ) pure (LedgerState utxoSt' certState') +testIncompleteAndMissingWithdrawals :: + ( EraAccounts era + , STS sts + , BaseM sts ~ ShelleyBase + , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era + , sts ~ EraRule "LEDGER" era + ) => + Accounts era -> + Withdrawals -> + Rule sts ctx () +testIncompleteAndMissingWithdrawals accounts withdrawals = do + network <- liftSTS $ asks networkId + let (missingWithdrawals, incompleteWithdrawals) = + case withdrawalsThatDoNotDrainAccounts withdrawals network accounts of + Nothing -> (Nothing, Nothing) + Just (missing, incomplete) -> + ( if null (unWithdrawals missing) then Nothing else Just missing + , if null (unWithdrawals incomplete) then Nothing else Just incomplete + ) + failOnJust missingWithdrawals $ injectFailure . ShelleyWithdrawalsMissingAccounts + failOnJust incompleteWithdrawals $ injectFailure . ShelleyIncompleteWithdrawals + instance ( Era era , STS (ShelleyDELEGS era) 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 39d372ad229..233ef0bc776 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 @@ -92,6 +92,7 @@ instance , State (EraRule "DELEGS" era) ~ CertState era , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era) , AtMostEra "Babbage" era + , EraRule "LEDGER" era ~ ShelleyLEDGER era , Crypto c ) => TQC.HasTrace (ShelleyLEDGER era) (GenEnv c era) diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs index efeae172ddf..2e0a17583ba 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 @@ -558,10 +558,7 @@ testWithdrawalWrongAmt = rAccount = mkVKeyRewardAccount Testnet bobStake dpState' = addReward dpState (raCredential rAccount) (Coin 10) tx = MkShelleyTx $ ShelleyTx @ShelleyEra txb txwits SNothing - errs = - [ DelegsFailure - (WithdrawalsNotInRewardsDELEGS (Withdrawals (Map.singleton rAccount (Coin 11)))) - ] + errs = [ShelleyIncompleteWithdrawals $ Withdrawals $ Map.singleton rAccount $ Coin 11] in testLEDGER (LedgerState utxoState dpState') tx ledgerEnv (Left errs) testOutputTooSmall :: Assertion From 59cf13b751daa04a028abe434be05dd3c9f00e73 Mon Sep 17 00:00:00 2001 From: Aniket Deshpande Date: Fri, 17 Oct 2025 19:21:33 +0530 Subject: [PATCH 2/2] Shelley: Update changelog, version and bounds --- eras/allegra/impl/cardano-ledger-allegra.cabal | 2 +- eras/alonzo/impl/cardano-ledger-alonzo.cabal | 2 +- eras/babbage/impl/cardano-ledger-babbage.cabal | 4 ++-- eras/conway/impl/CHANGELOG.md | 1 + eras/conway/impl/cardano-ledger-conway.cabal | 2 +- eras/mary/impl/cardano-ledger-mary.cabal | 2 +- eras/shelley/impl/CHANGELOG.md | 10 ++++++++-- eras/shelley/impl/cardano-ledger-shelley.cabal | 2 +- .../test-suite/cardano-ledger-shelley-test.cabal | 2 +- libs/cardano-ledger-api/cardano-ledger-api.cabal | 2 +- 10 files changed, 18 insertions(+), 11 deletions(-) diff --git a/eras/allegra/impl/cardano-ledger-allegra.cabal b/eras/allegra/impl/cardano-ledger-allegra.cabal index f7d58fc9176..62bf7fe40d7 100644 --- a/eras/allegra/impl/cardano-ledger-allegra.cabal +++ b/eras/allegra/impl/cardano-ledger-allegra.cabal @@ -71,7 +71,7 @@ library bytestring, cardano-ledger-binary >=1.4, cardano-ledger-core:{cardano-ledger-core, internal} >=1.19, - cardano-ledger-shelley ^>=1.17, + cardano-ledger-shelley ^>=1.18, cardano-slotting, cardano-strict-containers, cborg, diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal index 8a5665fa781..41d35d8a6c9 100644 --- a/eras/alonzo/impl/cardano-ledger-alonzo.cabal +++ b/eras/alonzo/impl/cardano-ledger-alonzo.cabal @@ -89,7 +89,7 @@ library cardano-ledger-binary ^>=1.8, cardano-ledger-core:{cardano-ledger-core, internal} ^>=1.19, cardano-ledger-mary ^>=1.9, - cardano-ledger-shelley ^>=1.17, + cardano-ledger-shelley ^>=1.18, cardano-slotting, cardano-strict-containers, containers, diff --git a/eras/babbage/impl/cardano-ledger-babbage.cabal b/eras/babbage/impl/cardano-ledger-babbage.cabal index 7f58fce9368..19561f523de 100644 --- a/eras/babbage/impl/cardano-ledger-babbage.cabal +++ b/eras/babbage/impl/cardano-ledger-babbage.cabal @@ -85,7 +85,7 @@ library cardano-ledger-binary >=1.6, cardano-ledger-core:{cardano-ledger-core, internal} >=1.19, cardano-ledger-mary ^>=1.9, - cardano-ledger-shelley ^>=1.17, + cardano-ledger-shelley ^>=1.18, cardano-strict-containers, containers, deepseq, @@ -141,7 +141,7 @@ library testlib cardano-ledger-binary:{cardano-ledger-binary, testlib}, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.13.2, cardano-ledger-mary:{cardano-ledger-mary, testlib}, - cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.17, + cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.18, cardano-slotting, cardano-strict-containers, containers, diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index f1d5a2029ee..b6900c1253e 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.21.0.0 +* Add `shelleyToConwayLedgerPredFailure`. * Move withdrawal-validation and DRep expiry updates from `CERTS` to `LEDGER` starting protocol version 11. - Add `ConwayWithdrawalsMissingAccounts` and `ConwayIncompleteWithdrawals` to `ConwayLedgerPredFailure`. - Add `hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule` to `Conway.Era`. diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 25c35ac69e0..dac4846b0c6 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -102,7 +102,7 @@ library cardano-ledger-binary ^>=1.8, cardano-ledger-core:{cardano-ledger-core, internal} ^>=1.19, cardano-ledger-mary ^>=1.9, - cardano-ledger-shelley ^>=1.17, + cardano-ledger-shelley ^>=1.18, cardano-slotting, cardano-strict-containers, containers, diff --git a/eras/mary/impl/cardano-ledger-mary.cabal b/eras/mary/impl/cardano-ledger-mary.cabal index 52da5b506f5..f0c3f4bf044 100644 --- a/eras/mary/impl/cardano-ledger-mary.cabal +++ b/eras/mary/impl/cardano-ledger-mary.cabal @@ -81,7 +81,7 @@ library cardano-ledger-allegra ^>=1.9, cardano-ledger-binary >=1.4, cardano-ledger-core:{cardano-ledger-core, internal} >=1.19, - cardano-ledger-shelley ^>=1.17, + cardano-ledger-shelley ^>=1.18, cardano-strict-containers, containers, deepseq, diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index ef372e552fc..7744bc9ecc0 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -1,7 +1,13 @@ # Version history for `cardano-ledger-shelley` -## 1.17.1.0 - +## 1.18.0.0 + +* Move withdrawals-draining from `DELEGS` to `LEDGER` + - Remove `WithdrawalsNotInRewardsDELEGS` + - Add to `ShelleyLedgerPredFailure` + + `ShelleyWithdrawalsMissingAccounts` + + `ShelleyIncompleteWithdrawals` + - Add `testIncompleteAndMissingWithdrawals` * Added `Generic` instance to `ShelleyTxOut` ### `testlib` diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index 640ee4d34be..2cc560f2ffd 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-shelley -version: 1.17.1.0 +version: 1.18.0.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK diff --git a/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal b/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal index bfd99efb760..286fbb04db4 100644 --- a/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal +++ b/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal @@ -81,7 +81,7 @@ library cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.7, cardano-ledger-byron, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.19, - cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.17, + cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.18, cardano-protocol-tpraos:{cardano-protocol-tpraos, testlib} >=1.4, cardano-slotting:{cardano-slotting, testlib}, cardano-strict-containers, diff --git a/libs/cardano-ledger-api/cardano-ledger-api.cabal b/libs/cardano-ledger-api/cardano-ledger-api.cabal index 949d1a7fe8a..be80b3da8c7 100644 --- a/libs/cardano-ledger-api/cardano-ledger-api.cabal +++ b/libs/cardano-ledger-api/cardano-ledger-api.cabal @@ -68,7 +68,7 @@ library cardano-ledger-core:{cardano-ledger-core, internal} >=1.17, cardano-ledger-dijkstra >=0.2, cardano-ledger-mary ^>=1.9, - cardano-ledger-shelley ^>=1.17, + cardano-ledger-shelley ^>=1.18, cardano-strict-containers, containers, data-default,