Shelley: Move withdrawals draining from DELEGS to LEDGER

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,

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,

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)

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

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,

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

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`.

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,

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

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

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
 

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,

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`

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