diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs
index 7d8ca7f4b71..657e1817573 100644
--- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs
+++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs
@@ -68,6 +68,7 @@ import Cardano.Ledger.Shelley.LedgerState
   ( AccountState (..),
     DPState (..),
     EpochState (..),
+    IncrementalStake (..),
     LedgerState (..),
     NewEpochState (..),
     UTxOState (..),
@@ -156,6 +157,7 @@ instance
                   (Coin 0)
                   (Coin 0)
                   def
+                  (IStake mempty mempty)
               )
               (DPState (def {_genDelegs = GenDelegs genDelegs}) def)
           )
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs
index fe1aa9eeead..5e598d24997 100644
--- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs
+++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs
@@ -22,7 +22,6 @@ module Cardano.Ledger.Alonzo.PlutusScriptApi
 where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..))
-import Cardano.Ledger.Address (Addr)
 import Cardano.Ledger.Alonzo.Data (getPlutusData)
 import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.Scripts (CostModel (..), ExUnits (..))
@@ -268,7 +267,6 @@ scriptsNeeded ::
     HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
     HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
-    HasField "address" (Core.TxOut era) (Addr (Crypto era)),
     HasField "body" tx (Core.TxBody era)
   ) =>
   UTxO era ->
@@ -293,8 +291,7 @@ scriptsNeededFromBody ::
   ( Era era,
     HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
     HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
-    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era)))
   ) =>
   UTxO era ->
   Core.TxBody era ->
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs
index 29acc03fcea..ab52d5d8ba1 100644
--- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs
+++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs
@@ -319,7 +319,7 @@ utxoTransition ::
   TransitionRule (AlonzoUTXO era)
 utxoTransition = do
   TRC (Shelley.UtxoEnv slot pp stakepools _genDelegs, u, tx) <- judgmentContext
-  let Shelley.UTxOState utxo _deposits _fees _ppup = u
+  let Shelley.UTxOState utxo _deposits _fees _ppup _ = u
 
   {-   txb := txbody tx   -}
   {-   (,i_f) := txvldttx   -}
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 7542226edb0..9d5f15b9080 100644
--- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs
+++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs
@@ -53,13 +53,13 @@ import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era (Crypto, Era, ValidateScript)
 import Cardano.Ledger.Mary.Value (Value)
 import Cardano.Ledger.Rules.ValidationMode (lblStatic)
-import Cardano.Ledger.Shelley.LedgerState (PPUPState (..), UTxOState (..), keyRefunds)
+import Cardano.Ledger.Shelley.LedgerState (PPUPState (..), UTxOState (..), keyRefunds, updateStakeDistribution)
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
 import Cardano.Ledger.Shelley.PParams (Update)
 import Cardano.Ledger.Shelley.Rules.Ppup (PPUP, PPUPEnv (..), PpupPredicateFailure)
 import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv (..))
 import Cardano.Ledger.Shelley.TxBody (DCert, Wdrl)
-import Cardano.Ledger.Shelley.UTxO (balance, totalDeposits)
+import Cardano.Ledger.Shelley.UTxO (UTxO (..), balance, totalDeposits)
 import Cardano.Ledger.TxIn (TxIn (..))
 import Cardano.Ledger.Val as Val
 import Control.Monad.Except (MonadError (throwError))
@@ -174,7 +174,7 @@ scriptsValidateTransition ::
 scriptsValidateTransition = do
   TRC
     ( UtxoEnv slot pp poolParams genDelegs,
-      UTxOState utxo deposited fees pup,
+      UTxOState utxo deposited fees pup incStake,
       tx
       ) <-
     judgmentContext
@@ -217,12 +217,18 @@ scriptsValidateTransition = do
     trans @(Core.EraRule "PPUP" era) $
       TRC
         (PPUPEnv slot pp genDelegs, pup, strictMaybeToMaybe $ getField @"update" txb)
+
+  let utxoAdd = txouts @era txb -- These will be inserted into the UTxO
+  let utxoDel = eval (getField @"inputs" txb ◁ utxo) -- These will be deleted fromthe UTxO
+  let newIncStakeDistro = updateStakeDistribution @era incStake utxoDel utxoAdd
+
   pure $
     UTxOState
-      { _utxo = eval ((getField @"inputs" txb ⋪ utxo) ∪ txouts @era txb),
+      { _utxo = eval ((getField @"inputs" txb ⋪ utxo) ∪ utxoAdd),
         _deposited = deposited <> depositChange,
         _fees = fees <> getField @"txfee" txb,
-        _ppups = pup'
+        _ppups = pup',
+        _stakeDistro = newIncStakeDistro
       }
 
 scriptsNotValidateTransition ::
@@ -249,7 +255,7 @@ scriptsNotValidateTransition ::
   ) =>
   TransitionRule (UTXOS era)
 scriptsNotValidateTransition = do
-  TRC (UtxoEnv _ pp _ _, us@(UTxOState utxo _ fees _), tx) <- judgmentContext
+  TRC (UtxoEnv _ pp _ _, us@(UTxOState utxo _ fees _ _), tx) <- judgmentContext
   let txb = body tx
   sysSt <- liftSTS $ asks systemStart
   ei <- liftSTS $ asks epochInfo
@@ -280,7 +286,12 @@ scriptsNotValidateTransition = do
   pure $
     us
       { _utxo = eval (getField @"collateral" txb ⋪ utxo),
-        _fees = fees <> Val.coin (balance @era (eval (getField @"collateral" txb ◁ utxo)))
+        _fees = fees <> Val.coin (balance @era (eval (getField @"collateral" txb ◁ utxo))),
+        _stakeDistro =
+          updateStakeDistribution @era
+            (_stakeDistro us)
+            (eval (getField @"collateral" txb ◁ utxo))
+            (UTxO Map.empty)
       }
 
 data TagMismatchDescription
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 175d19f464c..04b37a61524 100644
--- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs
+++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs
@@ -360,8 +360,7 @@ witsVKeyNeeded ::
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
     HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
     HasField "collateral" (Core.TxBody era) (Set (TxIn (Crypto era))),
-    HasField "update" (Core.TxBody era) (StrictMaybe (Update era)),
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "update" (Core.TxBody era) (StrictMaybe (Update era))
   ) =>
   UTxO era ->
   tx ->
diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs
index abdd728eea2..847f7ba07a3 100644
--- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs
+++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs
@@ -161,7 +161,8 @@ instance Crypto c => TranslateEra (AlonzoEra c) API.UTxOState where
         { API._utxo = translateEra' ctxt $ API._utxo us,
           API._deposited = API._deposited us,
           API._fees = API._fees us,
-          API._ppups = translateEra' ctxt $ API._ppups us
+          API._ppups = translateEra' ctxt $ API._ppups us,
+          API._stakeDistro = API._stakeDistro us
         }
 
 instance Crypto c => TranslateEra (AlonzoEra c) API.UTxO where
diff --git a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs
index 71a4ce654c7..14adaeb740b 100644
--- a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs
+++ b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs
@@ -460,7 +460,7 @@ instance Mock c => EraGen (AlonzoEra c) where
         minimumFee = minfee @(AlonzoEra c) pp tx
      in if (minimumFee <= theFee)
           then (pure tx)
-          else myDiscard "MinFeee violation: genEraDne: AlonzoEraGem.hs"
+          else myDiscard "MinFeee violation: genEraDne: AlonzoEraGen.hs"
 
   genEraTweakBlock pp txns =
     let txTotal, ppMax :: ExUnits
@@ -468,7 +468,7 @@ instance Mock c => EraGen (AlonzoEra c) where
         ppMax = getField @"_maxBlockExUnits" pp
      in if pointWiseExUnits (<=) txTotal ppMax
           then pure txns
-          else myDiscard "TotExUnits violation: genEraTweakBlock: AlonzoEraGem.hs"
+          else myDiscard "TotExUnits violation: genEraTweakBlock: AlonzoEraGen.hs"
 
   hasFailedScripts = (== IsValid False) . (getField @"isValid")
 
diff --git a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs
index 65e1f2d95c2..2d0dd41f1e1 100644
--- a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs
+++ b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs
@@ -136,6 +136,7 @@ import Test.Cardano.Ledger.Shelley.PropertyTests
     removedAfterPoolreap,
   )
 import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
+import Test.Cardano.Ledger.Shelley.Rules.TestChain (incrementalStakeProp)
 import Test.Tasty
 import Test.Tasty.QuickCheck
 
@@ -147,7 +148,9 @@ import Test.Tasty.QuickCheck
 --     versions of all these inputs, and lets the user select which of these inputs he needs to make a generator.
 --     See genAlonzoTx and genAlonzoBlock as examples of its use.
 genstuff ::
-  (EraGen era, Default (State (Core.EraRule "PPUP" era))) =>
+  ( EraGen era,
+    Default (State (Core.EraRule "PPUP" era))
+  ) =>
   Proxy era ->
   ( GenEnv era ->
     ChainState era ->
@@ -304,7 +307,10 @@ alonzoPropertyTests =
   testGroup
     "Alonzo property tests"
     [ propertyTests @A @L,
-      Alonzo.propertyTests
+      Alonzo.propertyTests,
+      testProperty
+        "Incremental stake distribution at epoch boundaries agrees"
+        (incrementalStakeProp (Proxy :: Proxy A))
     ]
 
 -- | A select subset of all the property tests
diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs
index c662666f499..dc5cabec8f1 100644
--- a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs
+++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs
@@ -64,6 +64,7 @@ instance
                   (Coin 0)
                   (Coin 0)
                   def
+                  (IStake mempty mempty)
               )
               (DPState (def {_genDelegs = GenDelegs genDelegs}) def)
           )
diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs
index f2eecfa3606..17532f18a3f 100644
--- a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs
+++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs
@@ -146,7 +146,8 @@ instance Crypto c => TranslateEra (AllegraEra c) UTxOState where
         { _utxo = translateEra' ctxt $ _utxo us,
           _deposited = _deposited us,
           _fees = _fees us,
-          _ppups = translateEra' ctxt $ _ppups us
+          _ppups = translateEra' ctxt $ _ppups us,
+          _stakeDistro = _stakeDistro us
         }
 
 instance Crypto c => TranslateEra (AllegraEra c) LedgerState where
diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs
index f94f022f9e3..f94aabba2ee 100644
--- a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs
+++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs
@@ -57,6 +57,7 @@ instance Crypto c => CanStartFromGenesis (MaryEra c) where
                   (Coin 0)
                   (Coin 0)
                   def
+                  (IStake mempty mempty)
               )
               (DPState (def {_genDelegs = GenDelegs genDelegs}) def)
           )
diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs
index 8f58458494e..35cd965f83b 100644
--- a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs
+++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs
@@ -145,7 +145,8 @@ instance Crypto c => TranslateEra (MaryEra c) UTxOState where
         { _utxo = translateEra' ctxt $ _utxo us,
           _deposited = _deposited us,
           _fees = _fees us,
-          _ppups = translateEra' ctxt $ _ppups us
+          _ppups = translateEra' ctxt $ _ppups us,
+          _stakeDistro = _stakeDistro us
         }
 
 instance Crypto c => TranslateEra (MaryEra c) TxOut where
diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs
index 9aae31d7a3e..22aa5a10699 100644
--- a/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs
+++ b/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs
@@ -39,7 +39,7 @@ import Cardano.Ledger.Shelley.Constraints
     UsesTxOut,
     UsesValue,
   )
-import Cardano.Ledger.Shelley.LedgerState (PPUPState)
+import Cardano.Ledger.Shelley.LedgerState (PPUPState, updateStakeDistribution)
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
 import Cardano.Ledger.Shelley.PParams (PParams, PParams' (..), Update)
 import Cardano.Ledger.Shelley.Rules.Ppup (PPUP, PPUPEnv (..), PpupPredicateFailure)
@@ -248,7 +248,7 @@ utxoTransition ::
   TransitionRule (UTXO era)
 utxoTransition = do
   TRC (Shelley.UtxoEnv slot pp stakepools genDelegs, u, tx) <- judgmentContext
-  let Shelley.UTxOState utxo deposits' fees ppup = u
+  let Shelley.UTxOState utxo deposits' fees ppup incStake = u
   let txb = getField @"body" tx
 
   inInterval slot (getField @"vldt" txb)
@@ -336,13 +336,17 @@ utxoTransition = do
   let refunded = Shelley.keyRefunds pp txb
   let txCerts = toList $ getField @"certs" txb
   let depositChange = totalDeposits pp (`Map.notMember` stakepools) txCerts Val.<-> refunded
+  let utxoAdd = txouts txb -- These will be inserted into the UTxO
+  let utxoDel = eval (txins @era txb ◁ utxo) -- These will be deleted from the UTxO
+  let newIncStakeDistro = updateStakeDistribution @era incStake utxoDel utxoAdd
 
   pure
     Shelley.UTxOState
-      { Shelley._utxo = eval ((txins @era txb ⋪ utxo) ∪ txouts txb),
+      { Shelley._utxo = eval ((txins @era txb ⋪ utxo) ∪ utxoAdd),
         Shelley._deposited = deposits' <> depositChange,
         Shelley._fees = fees <> getField @"txfee" txb,
-        Shelley._ppups = ppup'
+        Shelley._ppups = ppup',
+        Shelley._stakeDistro = newIncStakeDistro
       }
 
 --------------------------------------------------------------------------------
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 740079d89a5..0e3f0167c4d 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
@@ -8,11 +8,13 @@ where
 
 -- obtaining orphan STS (UTXOW (ShelleyMAEra ma c))
 
+import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Mary (MaryEra)
 import Cardano.Ledger.Shelley.API (LEDGER, LedgerEnv (..))
 import Cardano.Ledger.Shelley.LedgerState
   ( DPState (..),
     UTxOState (..),
+    smartUTxOState,
   )
 import Cardano.Ledger.Shelley.PParams (PParams' (..))
 import Cardano.Ledger.Shelley.Tx (Tx (..))
@@ -31,7 +33,7 @@ type MaryTest = MaryEra TestCrypto
 ignoreAllButUTxO ::
   Either [PredicateFailure (LEDGER MaryTest)] (UTxOState MaryTest, DPState TestCrypto) ->
   Either [PredicateFailure (LEDGER MaryTest)] (UTxO MaryTest)
-ignoreAllButUTxO = fmap (\(UTxOState utxo _ _ _, _) -> utxo)
+ignoreAllButUTxO = fmap (\(UTxOState utxo _ _ _ _, _) -> utxo)
 
 testMaryNoDelegLEDGER ::
   UTxO MaryTest ->
@@ -41,10 +43,13 @@ testMaryNoDelegLEDGER ::
   Assertion
 testMaryNoDelegLEDGER utxo tx env (Right expectedUTxO) = do
   checkTrace @(LEDGER MaryTest) runShelleyBase env $
-    pure (def {_utxo = utxo}, def) .- tx .-> expectedSt'
+    pure (smartUTxOState utxo (Coin 0) (Coin 0) def, def) .- tx .-> expectedSt'
   where
     txFee = getField @"txfee" (getField @"body" tx)
-    expectedSt' = (def {_utxo = expectedUTxO, _fees = txFee}, def)
+    expectedSt' = (smartUTxOState expectedUTxO (Coin 0) txFee def, def)
 testMaryNoDelegLEDGER utxo tx env predicateFailure@(Left _) = do
-  let st = runShelleyBase $ applySTSTest @(LEDGER MaryTest) (TRC (env, (def {_utxo = utxo}, def), tx))
+  let st =
+        runShelleyBase $
+          applySTSTest @(LEDGER MaryTest)
+            (TRC (env, (smartUTxOState utxo (Coin 0) (Coin 0) def, def), tx))
   ignoreAllButUTxO st @?= predicateFailure
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs
index 9f4c3a65ba7..7f33213fec1 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs
@@ -148,7 +148,8 @@ translateToShelleyLedgerState genesisShelley epochNo cvs =
               { _utxo = utxoShelley,
                 _deposited = Coin 0,
                 _fees = Coin 0,
-                _ppups = def
+                _ppups = def,
+                _stakeDistro = IStake mempty Map.empty
               },
           _delegationState =
             DPState
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs
index 3b5a6202010..d76eca6bbd8 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs
@@ -27,6 +27,8 @@ import Cardano.Ledger.Shelley.API.Types
     word64ToCoin,
   )
 import Cardano.Ledger.Shelley.EpochBoundary (emptySnapShots)
+import Cardano.Ledger.Shelley.LedgerState (updateStakeDistribution)
+import Cardano.Ledger.Shelley.UTxO (UTxO (..))
 import Cardano.Ledger.Val (Val ((<->)))
 import Control.State.Transition (STS (State))
 import Data.Default.Class (Default, def)
@@ -67,6 +69,7 @@ instance
                   (Coin 0)
                   (Coin 0)
                   def
+                  (updateStakeDistribution mempty (UTxO mempty) initialUtxo)
               )
               (DPState (def {_genDelegs = GenDelegs genDelegs}) def)
           )
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 85905dacbe9..6823b0e8205 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Types.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Types.hs
@@ -79,6 +79,7 @@ import Cardano.Ledger.Shelley.LedgerState as X
     DPState (..),
     DState (..),
     EpochState (..),
+    IncrementalStake (..),
     InstantaneousRewards (..),
     KeyPairs,
     LedgerState (..),
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs
index db101688d1e..7a0f4880cca 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs
@@ -210,7 +210,7 @@ getPoolParameters = Map.restrictKeys . f
 -- This is not based on any snapshot, but uses the current ledger state.
 poolsByTotalStakeFraction ::
   forall era.
-  (UsesValue era, HasField "address" (Core.TxOut era) (Addr (Crypto era))) =>
+  (UsesValue era) =>
   Globals ->
   NewEpochState era ->
   PoolDistr (Crypto era)
@@ -245,8 +245,7 @@ getTotalStake globals ss =
 getNonMyopicMemberRewards ::
   ( UsesValue era,
     HasField "_a0" (Core.PParams era) NonNegativeInterval,
-    HasField "_nOpt" (Core.PParams era) Natural,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "_nOpt" (Core.PParams era) Natural
   ) =>
   Globals ->
   NewEpochState era ->
@@ -307,9 +306,7 @@ sumPoolOwnersStake pool stake =
 -- do not want to use one of the regular snapshots, but rather the most recent
 -- ledger state.
 currentSnapshot ::
-  ( UsesValue era,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
-  ) =>
+  (UsesValue era) =>
   NewEpochState era ->
   EB.SnapShot (Crypto era)
 currentSnapshot ss =
@@ -380,8 +377,7 @@ deriving instance ToJSON RewardParams
 getRewardInfoPools ::
   ( UsesValue era,
     HasField "_a0" (Core.PParams era) NonNegativeInterval,
-    HasField "_nOpt" (Core.PParams era) Natural,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "_nOpt" (Core.PParams era) Natural
   ) =>
   Globals ->
   NewEpochState era ->
@@ -593,7 +589,7 @@ totalAdaPotsES (EpochState (AccountState treasury_ reserves_) _ ls _ _ _) =
       feesAdaPot = fees_
     }
   where
-    (UTxOState u deposits fees_ _) = _utxoState ls
+    (UTxOState u deposits fees_ _ _) = _utxoState ls
     (DPState ds _) = _delegationState ls
     rewards_ = fold (Map.elems (_rewards ds))
     coins = Val.coin $ balance u
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/EpochBoundary.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/EpochBoundary.hs
index cfd28589525..153a87faeb1 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/EpochBoundary.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/EpochBoundary.hs
@@ -26,7 +26,6 @@ module Cardano.Ledger.Shelley.EpochBoundary
     SnapShots (..),
     emptySnapShot,
     emptySnapShots,
-    aggregateUtxoCoinByCredential,
     poolStake,
     obligation,
     maxPool,
@@ -35,7 +34,6 @@ module Cardano.Ledger.Shelley.EpochBoundary
 where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
-import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.BaseTypes (BoundedRational (..), NonNegativeInterval)
 import Cardano.Ledger.Coin
   ( Coin (..),
@@ -43,23 +41,18 @@ import Cardano.Ledger.Coin
     rationalToCoinViaFloor,
   )
 import Cardano.Ledger.Compactible
-import qualified Cardano.Ledger.Core as Core
-import Cardano.Ledger.Credential (Credential, Ptr, StakeReference (..))
+import Cardano.Ledger.Credential (Credential)
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
-import Cardano.Ledger.Era
 import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
 import Cardano.Ledger.Serialization (decodeRecordNamedT)
 import Cardano.Ledger.Shelley.TxBody (PoolParams)
-import Cardano.Ledger.Shelley.UTxO (UTxO (..))
 import Cardano.Ledger.Val ((<+>), (<×>))
-import qualified Cardano.Ledger.Val as Val
 import Control.DeepSeq (NFData)
 import Control.Monad.Trans (lift)
 import Control.SetAlgebra (dom, eval, setSingleton, (▷), (◁))
 import Data.Compact.VMap as VMap
 import Data.Default.Class (Default, def)
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
 import Data.Ratio ((%))
 import Data.Sharing
 import Data.Typeable
@@ -88,40 +81,6 @@ instance CC.Crypto crypto => FromSharedCBOR (Stake crypto) where
 sumAllStake :: Stake crypto -> Coin
 sumAllStake = VMap.foldMap fromCompact . unStake
 
--- A TxOut has 4 different shapes, depending on the shape its embedded of Addr.
--- Credentials are stored in only 2 of the 4 cases.
--- 1) TxOut (Addr _ _ (StakeRefBase cred)) coin   -> HERE
--- 2) TxOut (Addr _ _ (StakeRefPtr ptr)) coin     -> HERE
--- 3) TxOut (Addr _ _ StakeRefNull) coin          -> NOT HERE
--- 4) TxOut (AddrBootstrap _) coin                -> NOT HERE
--- Unfortunately TxOut is a pattern, that deserializes the address. This can be expensive, so if
--- we only deserialize the parts that we need, for the 2 cases that count, we can speed
--- things up considerably. That is the role of deserialiseAddrStakeRef. It returns (Just stake)
--- for the two cases that matter, and Nothing for the other two cases.
-
--- | Sum up all the Coin for each staking Credential
-aggregateUtxoCoinByCredential ::
-  forall era.
-  ( Era era,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
-  ) =>
-  Map Ptr (Credential 'Staking (Crypto era)) ->
-  UTxO era ->
-  Map (Credential 'Staking (Crypto era)) Coin ->
-  Map (Credential 'Staking (Crypto era)) Coin
-aggregateUtxoCoinByCredential ptrs (UTxO u) initial =
-  Map.foldl' accum initial u
-  where
-    accum !ans out =
-      case (getField @"address" out, getField @"value" out) of
-        (Addr _ _ (StakeRefPtr p), c) ->
-          case Map.lookup p ptrs of
-            Just cred -> Map.insertWith (<>) cred (Val.coin c) ans
-            Nothing -> ans
-        (Addr _ _ (StakeRefBase hk), c) ->
-          Map.insertWith (<>) hk (Val.coin c) ans
-        _other -> ans
-
 -- | Get stake of one pool
 poolStake ::
   KeyHash 'StakePool crypto ->
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs
index 9bc0b7d4514..10f6d3798f3 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
@@ -29,6 +30,7 @@ module Cardano.Ledger.Shelley.LedgerState
   ( AccountState (..),
     DPState (..),
     DState (..),
+    emptyDState,
     EpochState (..),
     UpecState (..),
     PulsingRewUpdate (..),
@@ -43,6 +45,8 @@ module Cardano.Ledger.Shelley.LedgerState
     RewardUpdate (..),
     RewardSnapShot (..),
     UTxOState (..),
+    smartUTxOState,
+    IncrementalStake (..),
     depositPoolChange,
     emptyRewardUpdate,
     pvCanFollow,
@@ -70,6 +74,9 @@ module Cardano.Ledger.Shelley.LedgerState
 
     -- * Epoch boundary
     stakeDistr,
+    incrementalStakeDistr,
+    updateStakeDistribution,
+    aggregateUtxoCoinByCredential,
     applyRUpd,
     applyRUpd',
     createRUpd,
@@ -123,7 +130,7 @@ import Cardano.Ledger.Coin
 import Cardano.Ledger.Compactible
 import Cardano.Ledger.Core (PParamsDelta)
 import qualified Cardano.Ledger.Core as Core
-import Cardano.Ledger.Credential (Credential (..))
+import Cardano.Ledger.Credential (Credential (..), StakeReference (StakeRefBase, StakeRefPtr))
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Era (Crypto, Era)
 import Cardano.Ledger.Keys
@@ -139,7 +146,7 @@ import Cardano.Ledger.Keys
   )
 import Cardano.Ledger.PoolDistr (PoolDistr (..))
 import Cardano.Ledger.SafeHash (HashAnnotated, extractHash, hashAnnotated)
-import Cardano.Ledger.Serialization (decodeRecordNamedT, mapToCBOR)
+import Cardano.Ledger.Serialization (decodeRecordNamedT, mapFromCBOR, mapToCBOR)
 import Cardano.Ledger.Shelley.Address.Bootstrap
   ( BootstrapWitness (..),
     bootstrapWitKeyHash,
@@ -158,7 +165,6 @@ import Cardano.Ledger.Shelley.EpochBoundary
   ( SnapShot (..),
     SnapShots (..),
     Stake (..),
-    aggregateUtxoCoinByCredential,
     sumAllStake,
   )
 import qualified Cardano.Ledger.Shelley.HardForks as HardForks
@@ -246,7 +252,7 @@ import qualified Data.Compact.VMap as VMap
 import Data.Constraint (Constraint)
 import Data.Default.Class (Default, def)
 import Data.Foldable (fold, toList)
-import Data.Group (invert)
+import Data.Group (Group, invert)
 import Data.Kind (Type)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -567,11 +573,62 @@ pvCanFollow _ SNothing = True
 pvCanFollow (ProtVer m n) (SJust (ProtVer m' n')) =
   (m + 1, 0) == (m', n') || (m, n + 1) == (m', n')
 
+-- =============================
+
+-- | Incremental Stake, Stake along with possible missed coins from danging Ptrs.
+--   Transactions can use Ptrs to refer to a stake credential in a TxOut. The Ptr
+--   does not have to point to anything until the epoch boundary, when we compute
+--   rewards and aggregate staking information for ranking. This is unusual but legal.
+--   In a non incremental system, we use what ever 'legal' Ptrs exist at the epoch
+--   boundary. Here we are computing things incrementally, so we need to remember Ptrs
+--   that might point to something by the time the epoch boundary is reached. When
+--   the epoch boundary is reached we 'resolve' these pointers, to see if any have
+--   become non-dangling since the time they came into the incremental computation.
+data IncrementalStake crypto = IStake
+  { credMap :: !(Map (Credential 'Staking crypto) Coin),
+    ptrMap :: !(Map Ptr Coin)
+  }
+  deriving (Generic, Show, Eq, Ord, NoThunks, NFData)
+
+instance CC.Crypto crypto => ToCBOR (IncrementalStake crypto) where
+  toCBOR (IStake st dangle) =
+    encodeListLen 2 <> mapToCBOR st <> mapToCBOR dangle
+
+instance CC.Crypto crypto => FromSharedCBOR (IncrementalStake crypto) where
+  type Share (IncrementalStake crypto) = Interns (Credential 'Staking crypto)
+  fromSharedCBOR credInterns = do
+    decodeRecordNamed "Stake" (const 2) $ do
+      stake <- fromSharedCBOR (credInterns, mempty)
+      dangle <- mapFromCBOR
+      pure $ IStake stake dangle
+
+instance Semigroup (IncrementalStake c) where
+  (IStake a b) <> (IStake c d) = IStake (Map.unionWith (<>) a c) (Map.unionWith (<>) b d)
+
+instance Monoid (IncrementalStake c) where
+  mempty = (IStake Map.empty Map.empty)
+
+instance Data.Group.Group (IncrementalStake c) where
+  invert (IStake m1 m2) = IStake (Map.map invert m1) (Map.map invert m2)
+
+instance Default (IncrementalStake c) where
+  def = IStake Map.empty Map.empty
+
+-- =============================
+
+-- | There is a serious invariant that we must maintain in the UTxOState.
+--   Given (UTxOState utxo _ _ _ istake) it must be the case that
+--   istake == (updateStakeDistribution (IStake Map.empty Map.empty) (UTxO Map.empty) utxo)
+--   Of course computing the RHS of the above equality can be very expensive, so we only
+--   use this route in the testing function smartUTxO. But we are very carefull, wherever
+--   we update the UTxO, we carefully make INCREMENTAL changes to istake to maintain
+--   this invariant. This happens in the UTxO rule.
 data UTxOState era = UTxOState
   { _utxo :: !(UTxO era),
     _deposited :: !Coin,
     _fees :: !Coin,
-    _ppups :: !(State (Core.EraRule "PPUP" era))
+    _ppups :: !(State (Core.EraRule "PPUP" era)),
+    _stakeDistro :: !(IncrementalStake (Crypto era))
   }
   deriving (Generic)
 
@@ -601,8 +658,8 @@ deriving stock instance
 instance TransUTxOState NoThunks era => NoThunks (UTxOState era)
 
 instance TransUTxOState ToCBOR era => ToCBOR (UTxOState era) where
-  toCBOR (UTxOState ut dp fs us) =
-    encodeListLen 4 <> toCBOR ut <> toCBOR dp <> toCBOR fs <> toCBOR us
+  toCBOR (UTxOState ut dp fs us sd) =
+    encodeListLen 5 <> toCBOR ut <> toCBOR dp <> toCBOR fs <> toCBOR us <> toCBOR sd
 
 instance
   ( TransValue FromCBOR era,
@@ -617,12 +674,13 @@ instance
     Share (UTxOState era) =
       Interns (Credential 'Staking (Crypto era))
   fromSharedCBOR credInterns =
-    decodeRecordNamed "UTxOState" (const 4) $ do
+    decodeRecordNamed "UTxOState" (const 5) $ do
       _utxo <- fromSharedCBOR credInterns
       _deposited <- fromCBOR
       _fees <- fromCBOR
       _ppups <- fromCBOR
-      pure UTxOState {_utxo, _deposited, _fees, _ppups}
+      _stakeDistro <- fromSharedCBOR credInterns
+      pure UTxOState {_utxo, _deposited, _fees, _ppups, _stakeDistro}
 
 -- | New Epoch state and environment
 data NewEpochState era = NewEpochState
@@ -758,6 +816,7 @@ genesisState genDelegs0 utxo0 =
         (Coin 0)
         (Coin 0)
         def
+        (IStake mempty Map.empty)
     )
     (DPState dState def)
   where
@@ -855,6 +914,8 @@ consumed pp u tx =
     refunds = keyRefunds pp tx
     withdrawals = fold . unWdrl $ getField @"wdrls" tx
 
+-- ====================================================
+
 newtype WitHashes crypto = WitHashes
   {unWitHashes :: Set (KeyHash 'Witness crypto)}
   deriving (Eq, Generic)
@@ -897,8 +958,7 @@ witsVKeyNeeded ::
     HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
     HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
-    HasField "update" (Core.TxBody era) (StrictMaybe (Update era)),
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "update" (Core.TxBody era) (StrictMaybe (Update era))
   ) =>
   UTxO era ->
   tx ->
@@ -1037,9 +1097,11 @@ reapRewards dStateRewards withdrawals =
 -- epoch boundary calculations --
 ---------------------------------
 
+-- | Compute the current Stake Distribution. This was called at the Epoch boundary in the Snap Rule.
+--   Now its is called in the tests to see that its incremental analog 'incrementaStakeDistr' agrees.
 stakeDistr ::
   forall era.
-  (Era era, HasField "address" (Core.TxOut era) (Addr (Crypto era))) =>
+  Era era =>
   UTxO era ->
   DState (Crypto era) ->
   PState (Crypto era) ->
@@ -1056,10 +1118,150 @@ stakeDistr u ds ps =
     stakeRelation = aggregateUtxoCoinByCredential (forwards ptrs') u rewards'
     activeDelegs :: Map (Credential 'Staking (Crypto era)) (KeyHash 'StakePool (Crypto era))
     activeDelegs = eval ((dom rewards' ◁ delegs) ▷ dom poolParams)
-    compactCoinOrError c =
-      case toCompact c of
-        Nothing -> error $ "Invalid ADA value in staking: " <> show c
-        Just compactCoin -> compactCoin
+
+compactCoinOrError :: Coin -> CompactForm Coin
+compactCoinOrError c =
+  case toCompact c of
+    Nothing -> error $ "Invalid ADA value in staking: " <> show c
+    Just compactCoin -> compactCoin
+
+-- A TxOut has 4 different shapes, depending on the shape of its embedded Addr.
+-- Credentials are stored in only 2 of the 4 cases.
+-- 1) TxOut (Addr _ _ (StakeRefBase cred)) coin   -> HERE
+-- 2) TxOut (Addr _ _ (StakeRefPtr ptr)) coin     -> HERE
+-- 3) TxOut (Addr _ _ StakeRefNull) coin          -> NOT HERE
+-- 4) TxOut (AddrBootstrap _) coin                -> NOT HERE
+
+-- | Sum up all the Coin for each staking Credential. This function has an
+--   incremental analog. See 'incrementalAggregateUtxoCoinByCredential'
+aggregateUtxoCoinByCredential ::
+  forall era.
+  ( Era era
+  ) =>
+  Map Ptr (Credential 'Staking (Crypto era)) ->
+  UTxO era ->
+  Map (Credential 'Staking (Crypto era)) Coin ->
+  Map (Credential 'Staking (Crypto era)) Coin
+aggregateUtxoCoinByCredential ptrs (UTxO u) initial =
+  Map.foldl' accum initial u
+  where
+    accum !ans out =
+      case (getField @"address" out, getField @"value" out) of
+        (Addr _ _ (StakeRefPtr p), c) ->
+          case Map.lookup p ptrs of
+            Just cred -> Map.insertWith (<>) cred (Val.coin c) ans
+            Nothing -> ans
+        (Addr _ _ (StakeRefBase hk), c) ->
+          Map.insertWith (<>) hk (Val.coin c) ans
+        _other -> ans
+
+-- ==============================
+-- operations on IncrementalStake
+
+-- | Incrementally add the inserts 'utxoAdd' and the deletes 'utxoDel' to the IncrementalStake.
+updateStakeDistribution ::
+  ( Era era
+  ) =>
+  IncrementalStake (Crypto era) ->
+  UTxO era ->
+  UTxO era ->
+  IncrementalStake (Crypto era)
+updateStakeDistribution incStake0 utxoDel utxoAdd = incStake2
+  where
+    incStake1 = incrementalAggregateUtxoCoinByCredential id utxoAdd incStake0
+    incStake2 = incrementalAggregateUtxoCoinByCredential invert utxoDel incStake1
+
+-- | Incrementally sum up all the Coin for each staking Credential, use different 'mode' operations
+--   for inserts (id) and deletes (invert). Never store a (Coin 0) balance, since these do not occur
+--   in the non-incremental stye that works directly from the UTxO. This function has a non-incremental
+--   analog 'aggregateUtxoCoinByCredential'
+incrementalAggregateUtxoCoinByCredential ::
+  forall era.
+  ( Era era
+  ) =>
+  (Coin -> Coin) ->
+  UTxO era ->
+  IncrementalStake (Crypto era) ->
+  IncrementalStake (Crypto era)
+incrementalAggregateUtxoCoinByCredential mode (UTxO u) initial =
+  Map.foldl' accum initial u
+  where
+    keepOrDelete new Nothing =
+      case mode new of
+        Coin 0 -> Nothing
+        final -> Just final
+    keepOrDelete new (Just old) =
+      case mode new <> old of
+        Coin 0 -> Nothing
+        final -> Just final
+    accum ans@(IStake stake ptrs) out =
+      let c = Val.coin (getField @"value" out)
+       in case getField @"address" out of
+            Addr _ _ (StakeRefPtr p) -> IStake stake (Map.alter (keepOrDelete c) p ptrs)
+            Addr _ _ (StakeRefBase hk) -> IStake (Map.alter (keepOrDelete c) hk stake) ptrs
+            _other -> ans
+
+-- | Resolve inserts and deletes which were indexed by Ptrs, by looking them
+--   up in 'ptrs' and combining the result of the lookup with the ordinary stake.
+--   Return just this resolved map with type: Map (Credential 'Staking crypto) Coin
+resolveIncrementalPtrs ::
+  Map Ptr (Credential 'Staking (Crypto era)) ->
+  IncrementalStake (Crypto era) ->
+  Map (Credential 'Staking (Crypto era)) Coin
+resolveIncrementalPtrs ptrs (IStake stake byPtr) = Map.foldlWithKey' accum stake byPtr
+  where
+    accum ans ptr coin =
+      case Map.lookup ptr ptrs of
+        Nothing -> ans
+        Just hash -> Map.insertWith (<>) hash coin ans
+
+-- | Compute the current state distribution by using the IncrementalStake, which is an aggregate
+--   of the current UTxO. This function has a non-incremental analog 'stakeDistr'
+incrementalStakeDistr ::
+  forall era.
+  IncrementalStake (Crypto era) ->
+  DState (Crypto era) ->
+  PState (Crypto era) ->
+  SnapShot (Crypto era)
+incrementalStakeDistr incstake ds ps =
+  SnapShot
+    (Stake $ VMap.fromMap (compactCoinOrError <$> eval (dom activeDelegs ◁ stake1)))
+    (VMap.fromMap delegs)
+    (VMap.fromMap poolParams)
+  where
+    DState rewards' delegs bimap _ _ _ = ds
+    PState poolParams _ _ = ps
+    stake0, stake1 :: Map (Credential 'Staking (Crypto era)) Coin
+    stake0 = resolveIncrementalPtrs @era (forwards bimap) incstake
+    stake1 = Map.unionWith (<>) stake0 rewards'
+    activeDelegs :: Map (Credential 'Staking (Crypto era)) (KeyHash 'StakePool (Crypto era))
+    activeDelegs = eval ((dom rewards' ◁ delegs) ▷ dom poolParams)
+
+-- | A valid (or self-consistent) UTxOState{_utxo, _deposited, _fees, _ppups, _stakeDistro}
+--   maintains an invariant between the _utxo and _stakeDistro fields. the _stakeDistro field is
+--   the aggregation of Coin over the StakeReferences in the UTxO. It can be computed by a pure
+--   function from the _utxo field. In some situations, mostly unit or example tests, or when
+--   initializing a small UTxO, we want to create a UTxOState that computes the _stakeDistro from
+--   the _utxo. This is aways safe to do, but if the _utxo field is big, this can be very expensive,
+--   which defeats the purpose of memoizing the _stakeDistro field. So use of this function should be
+--   restricted to tests and initializations, where the invariant should be maintained.
+smartUTxOState ::
+  ( Era era
+  ) =>
+  UTxO era ->
+  Coin ->
+  Coin ->
+  State (Core.EraRule "PPUP" era) ->
+  UTxOState era
+smartUTxOState utxo c1 c2 st =
+  UTxOState
+    utxo
+    c1
+    c2
+    st
+    (updateStakeDistribution (IStake Map.empty Map.empty) (UTxO Map.empty) utxo)
+
+-- ==============================
 
 -- | Apply a reward update
 applyRUpd ::
@@ -1424,7 +1626,7 @@ updateNES
 
 returnRedeemAddrsToReserves ::
   forall era.
-  (Era era, HasField "address" (Core.TxOut era) (Addr (Crypto era))) =>
+  (Era era) =>
   EpochState era ->
   EpochState era
 returnRedeemAddrsToReserves es = es {esAccountState = acnt', esLState = ls'}
@@ -1456,7 +1658,7 @@ instance
   Default (State (Core.EraRule "PPUP" era)) =>
   Default (UTxOState era)
   where
-  def = UTxOState (UTxO Map.empty) (Coin 0) (Coin 0) def
+  def = UTxOState (UTxO Map.empty) (Coin 0) (Coin 0) def (IStake mempty Map.empty)
 
 instance
   (Default (LedgerState era), Default (Core.PParams era)) =>
@@ -1474,14 +1676,17 @@ instance Default (InstantaneousRewards crypto) where
   def = InstantaneousRewards Map.empty Map.empty mempty mempty
 
 instance Default (DState crypto) where
-  def =
-    DState
-      Map.empty
-      Map.empty
-      biMapEmpty
-      Map.empty
-      (GenDelegs Map.empty)
-      def
+  def = emptyDState
+
+emptyDState :: (DState crypto)
+emptyDState =
+  DState
+    Map.empty
+    Map.empty
+    biMapEmpty
+    Map.empty
+    (GenDelegs Map.empty)
+    def
 
 instance Default (PState crypto) where
   def =
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 62dca37e7ef..750aa654935 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs
@@ -28,8 +28,9 @@ import Cardano.Binary
     ToCBOR (..),
     encodeListLen,
   )
+import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.BaseTypes (ShelleyBase, invalidKey)
-import Cardano.Ledger.Coin (Coin)
+import Cardano.Ledger.Coin (Coin (..))
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era (Crypto, Era)
 import Cardano.Ledger.Keys (DSignable, Hash)
@@ -48,6 +49,7 @@ import Cardano.Ledger.Shelley.Rules.Utxo
   ( UtxoEnv (..),
   )
 import Cardano.Ledger.Shelley.Rules.Utxow (UTXOW, UtxowPredicateFailure)
+import Cardano.Ledger.Shelley.Tx (TxIn)
 import Cardano.Ledger.Shelley.TxBody (DCert, EraIndependentTxBody)
 import Cardano.Ledger.Slot (SlotNo)
 import Control.State.Transition
@@ -63,11 +65,14 @@ import Control.State.Transition
 import Data.Sequence (Seq)
 import Data.Sequence.Strict (StrictSeq)
 import qualified Data.Sequence.Strict as StrictSeq
+import Data.Set (Set)
 import Data.Word (Word8)
 import GHC.Generics (Generic)
 import GHC.Records (HasField, getField)
 import NoThunks.Class (NoThunks (..))
 
+-- ========================================================
+
 data LEDGER era
 
 data LedgerEnv era = LedgerEnv
@@ -141,6 +146,8 @@ instance
 instance
   ( Show (Core.PParams era),
     Show (Core.Tx era),
+    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
+    HasField "address" (Core.TxOut era) (Addr (Crypto era)),
     DSignable (Crypto era) (Hash (Crypto era) EraIndependentTxBody),
     Era era,
     Embed (Core.EraRule "DELEGS" era) (LEDGER era),
@@ -189,7 +196,8 @@ instance
 
 ledgerTransition ::
   forall era.
-  ( Embed (Core.EraRule "DELEGS" era) (LEDGER era),
+  ( Era era,
+    Embed (Core.EraRule "DELEGS" era) (LEDGER era),
     Environment (Core.EraRule "DELEGS" era) ~ DelegsEnv era,
     State (Core.EraRule "DELEGS" era) ~ DPState (Crypto era),
     Signal (Core.EraRule "DELEGS" era) ~ Seq (DCert (Crypto era)),
@@ -197,8 +205,7 @@ ledgerTransition ::
     Environment (Core.EraRule "UTXOW" era) ~ UtxoEnv era,
     State (Core.EraRule "UTXOW" era) ~ UTxOState era,
     Signal (Core.EraRule "UTXOW" era) ~ Core.Tx era,
-    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
-    HasField "body" (Core.Tx era) (Core.TxBody era)
+    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era)))
   ) =>
   TransitionRule (LEDGER era)
 ledgerTransition = do
@@ -246,3 +253,5 @@ instance
   where
   wrapFailed = UtxowFailure
   wrapEvent = UtxowEvent
+
+-- =============================================================
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 6b3a70b812a..d5801a8a60b 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs
@@ -3,6 +3,8 @@
 {-# LANGUAGE EmptyDataDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -13,9 +15,7 @@ module Cardano.Ledger.Shelley.Rules.Snap
   )
 where
 
-import Cardano.Ledger.Address (Addr)
 import Cardano.Ledger.BaseTypes
-import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era (Crypto)
 import Cardano.Ledger.Shelley.Constraints (UsesTxOut, UsesValue)
 import Cardano.Ledger.Shelley.EpochBoundary
@@ -23,7 +23,7 @@ import Cardano.Ledger.Shelley.LedgerState
   ( DPState (..),
     LedgerState (..),
     UTxOState (..),
-    stakeDistr,
+    incrementalStakeDistr,
   )
 import Control.State.Transition
   ( STS (..),
@@ -32,9 +32,10 @@ import Control.State.Transition
     judgmentContext,
   )
 import GHC.Generics (Generic)
-import GHC.Records (HasField)
 import NoThunks.Class (NoThunks (..))
 
+-- ======================================================
+
 data SNAP era
 
 data SnapPredicateFailure era -- No predicate failures
@@ -51,19 +52,27 @@ instance (UsesTxOut era, UsesValue era) => STS (SNAP era) where
   initialRules = [pure emptySnapShots]
   transitionRules = [snapTransition]
 
+-- | The stake distribution was previously computed as in the spec:
+--
+-- @
+--  stakeDistr @era utxo dstate pstate
+-- @
+--
+-- but is now computed incrementally. We leave the comment as a historical note about
+-- where important changes were made to the source code.
 snapTransition ::
-  ( UsesValue era,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
-  ) =>
+  forall era.
   TransitionRule (SNAP era)
 snapTransition = do
   TRC (lstate, s, _) <- judgmentContext
 
-  let LedgerState (UTxOState utxo _ fees _) (DPState dstate pstate) = lstate
-      stake = stakeDistr utxo dstate pstate
+  let LedgerState (UTxOState _utxo _ fees _ incStake) (DPState dstate pstate) = lstate
+      -- stakeSnap = stakeDistr @era utxo dstate pstate  -- HISTORICAL NOTE
+      istakeSnap = incrementalStakeDistr @era incStake dstate pstate
+
   pure $
     s
-      { _pstakeMark = stake,
+      { _pstakeMark = istakeSnap,
         _pstakeSet = _pstakeMark s,
         _pstakeGo = _pstakeSet s,
         _feeSS = fees
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 471a7ebf8c2..0d9e74ff763 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs
@@ -28,7 +28,7 @@ import Cardano.Binary
     encodeListLen,
   )
 import Cardano.Ledger.Address
-  ( Addr (AddrBootstrap),
+  ( Addr (..),
     bootstrapAddressAttrsSize,
     getNetwork,
     getRwdNetwork,
@@ -66,10 +66,11 @@ import Cardano.Ledger.Shelley.LedgerState
     keyRefunds,
     minfee,
     produced,
+    updateStakeDistribution,
   )
 import Cardano.Ledger.Shelley.PParams (PParams, PParams' (..), Update)
 import Cardano.Ledger.Shelley.Rules.Ppup (PPUP, PPUPEnv (..), PpupEvent, PpupPredicateFailure)
-import Cardano.Ledger.Shelley.Tx (Tx (..), TxIn)
+import Cardano.Ledger.Shelley.Tx (Tx (..), TxIn, TxOut (..))
 import Cardano.Ledger.Shelley.TxBody
   ( DCert,
     PoolParams,
@@ -90,7 +91,7 @@ import Cardano.Ledger.Slot (SlotNo)
 import Cardano.Ledger.Val ((<->))
 import qualified Cardano.Ledger.Val as Val
 import Control.Monad.Trans.Reader (asks)
-import Control.SetAlgebra (dom, eval, (∪), (⊆), (⋪), (➖))
+import Control.SetAlgebra (dom, eval, (∪), (⊆), (⋪), (◁), (➖))
 import Control.State.Transition
   ( Assertion (..),
     AssertionViolation (..),
@@ -279,6 +280,7 @@ instance
 
 instance
   ( UsesTxOut era,
+    Core.TxOut era ~ TxOut era,
     UsesValue era,
     UsesScript era,
     UsesAuxiliary era,
@@ -334,7 +336,8 @@ instance
 
 utxoInductive ::
   forall era utxo.
-  ( UsesAuxiliary era,
+  ( Core.TxOut era ~ TxOut era,
+    UsesAuxiliary era,
     UsesTxOut era,
     STS (utxo era),
     Embed (Core.EraRule "PPUP" era) (utxo era),
@@ -362,7 +365,7 @@ utxoInductive ::
   TransitionRule (utxo era)
 utxoInductive = do
   TRC (UtxoEnv slot pp stakepools genDelegs, u, tx) <- judgmentContext
-  let UTxOState utxo deposits' fees ppup = u
+  let UTxOState utxo deposits' fees ppup incStake = u
   let txb = getField @"body" tx
 
   getField @"ttl" txb >= slot ?! ExpiredUTxO (getField @"ttl" txb) slot
@@ -431,13 +434,18 @@ utxoInductive = do
   let totalDeposits' = totalDeposits pp (`Map.notMember` stakepools) txCerts
   tellEvent $ TotalDeposits totalDeposits'
   let depositChange = totalDeposits' <-> refunded
+  let utxoAdd = txouts txb -- These will be inserted into the UTxO
+  let utxoDel = eval (txins @era txb ◁ utxo) -- These will be deleted from the UTxO
+  let newUTxO = eval ((txins @era txb ⋪ utxo) ∪ utxoAdd) -- Domain exclusion (a ⋪ b) deletes 'a' from the domain of 'b'
+  let newIncStakeDistro = updateStakeDistribution @era incStake utxoDel utxoAdd
 
   pure
     UTxOState
-      { _utxo = eval ((txins @era txb ⋪ utxo) ∪ txouts txb),
+      { _utxo = newUTxO,
         _deposited = deposits' <> depositChange,
         _fees = fees <> getField @"txfee" txb,
-        _ppups = ppup'
+        _ppups = ppup',
+        _stakeDistro = newIncStakeDistro
       }
 
 instance
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs
index 0b1bdc611ab..bf75205d1fb 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs
@@ -328,8 +328,7 @@ scriptsNeeded ::
     HasField "body" tx (Core.TxBody era),
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
     HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
-    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era)))
   ) =>
   UTxO era ->
   tx ->
diff --git a/eras/shelley/test-suite/bench/Main.hs b/eras/shelley/test-suite/bench/Main.hs
index 25cfccb49b5..1df54a99664 100644
--- a/eras/shelley/test-suite/bench/Main.hs
+++ b/eras/shelley/test-suite/bench/Main.hs
@@ -169,7 +169,7 @@ touchDPState :: DPState crypto -> Int
 touchDPState (DPState _x _y) = 1
 
 touchUTxOState :: Cardano.Ledger.Shelley.LedgerState.UTxOState cryto -> Int
-touchUTxOState (UTxOState _utxo _deposited _fees _ppups) = 2
+touchUTxOState (UTxOState _utxo _deposited _fees _ppups _) = 2
 
 profileCreateRegKeys :: IO ()
 profileCreateRegKeys = do
diff --git a/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal b/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal
index b5620dc918f..670d0a572b6 100644
--- a/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal
+++ b/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal
@@ -36,6 +36,7 @@ library
   hs-source-dirs:     src
   exposed-modules:
     Test.Cardano.Crypto.VRF.Fake
+    Test.Cardano.Ledger.TerseTools
     Test.Cardano.Ledger.Shelley.Address.Bootstrap
     Test.Cardano.Ledger.Shelley.Address.CompactAddr
     Test.Cardano.Ledger.Shelley.BenchmarkFunctions
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/Bootstrap.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/Bootstrap.hs
index 530f9ba61d7..1d0a30a39c4 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/Bootstrap.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/Bootstrap.hs
@@ -47,7 +47,8 @@ import Cardano.Ledger.SafeHash (extractHash, hashAnnotated)
 import Cardano.Ledger.Shelley (ShelleyEra)
 import Cardano.Ledger.Shelley.Address.Bootstrap
 import Cardano.Ledger.Shelley.LedgerState
-  ( PPUPState (..),
+  ( IncrementalStake (..),
+    PPUPState (..),
     UTxOState (..),
   )
 import Cardano.Ledger.Shelley.PParams
@@ -156,7 +157,8 @@ utxoState0 =
     { _utxo = utxo0,
       _deposited = Coin 0,
       _fees = Coin 0,
-      _ppups = PPUPState (ProposedPPUpdates mempty) (ProposedPPUpdates mempty)
+      _ppups = PPUPState (ProposedPPUpdates mempty) (ProposedPPUpdates mempty),
+      _stakeDistro = mempty
     }
 
 tx :: Tx C
@@ -171,7 +173,8 @@ utxoState1 =
     { _utxo = UTxO $ Map.fromList [bobResult, aliceResult],
       _deposited = Coin 0,
       _fees = Coin 10,
-      _ppups = PPUPState (ProposedPPUpdates mempty) (ProposedPPUpdates mempty)
+      _ppups = PPUPState (ProposedPPUpdates mempty) (ProposedPPUpdates mempty),
+      _stakeDistro = IStake mempty mempty
     }
   where
     txid = TxId $ hashAnnotated txBody
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 224307cb381..37b3caf182c 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
@@ -154,6 +154,7 @@ initUTxO n =
     (Coin 0)
     (Coin 0)
     def
+    mempty
 
 -- Protocal Parameters used for the benchmarknig tests.
 -- Note that the fees and deposits are set to zero for
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs
index e69dbb495e9..fe242f8a2a1 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs
@@ -324,7 +324,8 @@ exampleNewEpochState value ppp pp =
                             ],
                       _deposited = Coin 1000,
                       _fees = Coin 1,
-                      _ppups = def
+                      _ppups = def,
+                      _stakeDistro = mempty
                     },
                 _delegationState = def
               },
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs
index 95756651e3c..96168d81f27 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs
@@ -192,9 +192,7 @@ mkOCertIssueNos (GenDelegs delegs0) =
 -- This allows stake pools to produce blocks from genesis.
 registerGenesisStaking ::
   forall era.
-  ( Era era,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
-  ) =>
+  (Era era) =>
   ShelleyGenesisStaking (Crypto era) ->
   ChainState era ->
   ChainState era
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Utxo.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Utxo.hs
index 6ea3eb98f14..27dab4e6772 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Utxo.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Utxo.hs
@@ -144,7 +144,7 @@ showBalance ::
   String
 showBalance
   (LedgerEnv _ _ pparams _)
-  (UTxOState utxo _ _ _)
+  (UTxOState utxo _ _ _ _)
   (DPState _ (PState stakepools _ _))
   tx =
     "\n\nConsumed: " ++ show (consumed pparams utxo txBody)
@@ -204,7 +204,7 @@ genTx
          constants
        )
   (LedgerEnv slot txIx pparams reserves)
-  (utxoSt@(UTxOState utxo _ _ _), dpState) =
+  (utxoSt@(UTxOState utxo _ _ _ _), dpState) =
     do
       -------------------------------------------------------------------------
       -- Generate the building blocks of a TxBody
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 cc9770749ba..af6f0ce458c 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
@@ -77,6 +77,7 @@ import Test.Cardano.Ledger.Shelley.Rules.TestChain
     delegProperties,
     poolProperties,
     removedAfterPoolreap,
+    stakeIncrTest,
   )
 import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
 import Test.Cardano.Ledger.Shelley.ShelleyTranslation (testGroupShelleyTranslation)
@@ -197,7 +198,10 @@ propertyTests =
             (adaPreservationChain @era @ledger),
           TQC.testProperty
             "inputs are eliminated, outputs added to utxo and TxIds are unique"
-            (collisionFreeComplete @era @ledger)
+            (collisionFreeComplete @era @ledger),
+          TQC.testProperty
+            "incremental stake calc"
+            (stakeIncrTest @era @ledger)
         ],
       testGroup
         "Properties of Trace generators"
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 6405c23c972..3a3907aefdd 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
@@ -65,7 +65,7 @@ import Cardano.Ledger.Shelley.LedgerState
     NewEpochState (..),
     PState (..),
     TransUTxOState,
-    UTxOState (..),
+    smartUTxOState,
     updateNES,
     _genDelegs,
   )
@@ -181,7 +181,8 @@ instance
 
 -- | Creates a valid initial chain state
 initialShelleyState ::
-  ( Default (State (Core.EraRule "PPUP" era))
+  ( Era era,
+    Default (State (Core.EraRule "PPUP" era))
   ) =>
   WithOrigin (LastAppliedBlock (Crypto era)) ->
   EpochNo ->
@@ -201,7 +202,7 @@ initialShelleyState lab e utxo reserves genDelegs pp initNonce =
             (AccountState (Coin 0) reserves)
             emptySnapShots
             ( LedgerState
-                ( UTxOState
+                ( smartUTxOState
                     utxo
                     (Coin 0)
                     (Coin 0)
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 0d84c411787..f94a362adf2 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
@@ -113,7 +113,6 @@ relevantCasesAreCovered ::
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
     HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
     HasField "update" (Core.TxBody era) (StrictMaybe (PParams.Update era))
-    -- HasField "address" (Core.TxOut era) (Addr (Crypto era))
   ) =>
   Property
 relevantCasesAreCovered = do
@@ -133,7 +132,6 @@ relevantCasesAreCoveredForTrace ::
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
     HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
     HasField "update" (Core.TxBody era) (StrictMaybe (PParams.Update era))
-    --  HasField "address" (Core.TxOut era) (Addr (Crypto era))
   ) =>
   Trace (CHAIN era) ->
   Property
@@ -255,7 +253,7 @@ ratioInt x y =
 -- | Transaction has script locked TxOuts
 txScriptOutputsRatio ::
   forall era.
-  HasField "address" (Core.TxOut era) (Addr (Crypto era)) =>
+  Era era =>
   Proxy era ->
   [StrictSeq (Core.TxOut era)] ->
   Double
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 ee3eee446a3..6fafc7d9a50 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
@@ -24,6 +24,9 @@ module Test.Cardano.Ledger.Shelley.Rules.TestChain
     ledgerTraceFromBlock,
     -- Helper Constraints
     TestingLedger,
+    -- Incremental Stake Comp
+    stakeIncrTest,
+    incrementalStakeProp,
   )
 where
 
@@ -35,6 +38,7 @@ import Cardano.Ledger.Block
     neededTxInsForBlock,
   )
 import Cardano.Ledger.Coin
+import Cardano.Ledger.Compactible (fromCompact)
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era (Crypto, Era, SupportsSegWit (fromTxSeq))
 import Cardano.Ledger.Keys (KeyHash, KeyRole (Witness))
@@ -44,7 +48,7 @@ import Cardano.Ledger.Shelley.API
     GetLedgerView,
   )
 import Cardano.Ledger.Shelley.Constraints (UsesPParams, UsesValue)
-import Cardano.Ledger.Shelley.EpochBoundary (obligation)
+import Cardano.Ledger.Shelley.EpochBoundary (SnapShot (..), Stake (..), obligation)
 import Cardano.Ledger.Shelley.LedgerState hiding (circulation)
 import Cardano.Ledger.Shelley.Rewards (sumRewards)
 import Cardano.Ledger.Shelley.Rules.Deleg (DelegEnv (..))
@@ -79,6 +83,7 @@ import Control.State.Transition.Trace
 import qualified Control.State.Transition.Trace as Trace
 import Control.State.Transition.Trace.Generator.QuickCheck (forAllTraceFromInitState)
 import qualified Control.State.Transition.Trace.Generator.QuickCheck as QC
+import qualified Data.Compact.VMap as VMap
 import Data.Default.Class (Default)
 import Data.Foldable (fold, foldl', toList)
 import Data.Functor.Identity (Identity)
@@ -118,6 +123,7 @@ import Test.Cardano.Ledger.Shelley.Utils
     runShelleyBase,
     testGlobals,
   )
+import Test.Cardano.Ledger.TerseTools (tersemapdiffs)
 import Test.QuickCheck
   ( Property,
     Testable (..),
@@ -182,6 +188,74 @@ collisionFreeComplete =
         map (requiredMSigSignaturesSubset @era @ledger) ssts
       ]
 
+-- | STAKE INCR
+stakeIncrTest ::
+  forall era ledger.
+  ( EraGen era,
+    TestingLedger era ledger,
+    State (Core.EraRule "PPUP" era) ~ PPUPState era,
+    ChainProperty era,
+    QC.HasTrace (CHAIN era) (GenEnv era)
+  ) =>
+  Property
+stakeIncrTest =
+  forAllChainTrace @era longTraceLen $ \tr -> do
+    let ssts = sourceSignalTargets tr
+
+    conjoin . concat $
+      [ -- preservation properties
+        map (incrStakeComp @era @ledger) ssts
+      ]
+
+incrStakeComp ::
+  forall era ledger.
+  ( ChainProperty era,
+    TestingLedger era ledger
+  ) =>
+  SourceSignalTarget (CHAIN era) ->
+  Property
+incrStakeComp SourceSignalTarget {source = chainSt, signal = block} =
+  conjoin $
+    map checkIncrStakeComp $
+      sourceSignalTargets ledgerTr
+  where
+    (_, ledgerTr) = ledgerTraceFromBlock @era @ledger chainSt block
+    checkIncrStakeComp :: SourceSignalTarget ledger -> Property
+    checkIncrStakeComp
+      SourceSignalTarget
+        { source = (UTxOState {_utxo = u, _stakeDistro = sd}, dp),
+          signal = tx,
+          target = (UTxOState {_utxo = u', _stakeDistro = sd'}, dp')
+        } =
+        counterexample
+          ( mconcat
+              ( [ "\nDetails:\n",
+                  "\ntx\n",
+                  show tx,
+                  "\nsize original utxo\n",
+                  show (Map.size $ unUTxO u),
+                  "\noriginal utxo\n",
+                  show u,
+                  "\noriginal sd\n",
+                  show sd,
+                  "\nfinal utxo\n",
+                  show u',
+                  "\nfinal sd\n",
+                  show sd',
+                  "\noriginal ptrs\n",
+                  show ptrs,
+                  "\nfinal ptrs\n",
+                  show ptrs'
+                ]
+              )
+          )
+          $ utxoBal === incrStakeBal
+        where
+          utxoBal = Val.coin $ balance u'
+          incrStakeBal = fold (credMap sd') <> fold (ptrMap sd')
+          ptrs = _ptrs . _dstate $ dp
+          ptrs' = _ptrs . _dstate $ dp'
+
 -- | Various preservation propertiesC
 adaPreservationChain ::
   forall era ledger.
@@ -1141,3 +1215,58 @@ sameEpoch SourceSignalTarget {source, target} =
   epoch source == epoch target
   where
     epoch = nesEL . chainNes
+
+-- ============================================================
+-- Properties for Incremental Stake Distribution  Calculation
+
+atEpoch ::
+  forall era prop.
+  ( EraGen era,
+    Testable prop,
+    QC.HasTrace (CHAIN era) (GenEnv era),
+    Default (State (Core.EraRule "PPUP" era))
+  ) =>
+  (LedgerState era -> LedgerState era -> prop) ->
+  Property
+atEpoch f =
+  forAllChainTrace traceLen $ \tr ->
+    conjoin $
+      map g $
+        filter (not . sameEpoch) (sourceSignalTargets tr)
+  where
+    g (SourceSignalTarget s1 s2 _) = f (ledgerStateFromChainState s1) (ledgerStateFromChainState s2)
+
+ledgerStateFromChainState :: ChainState era -> LedgerState era
+ledgerStateFromChainState = esLState . nesEs . chainNes
+
+testIncrementalStake ::
+  forall era.
+  (Era era) =>
+  LedgerState era ->
+  LedgerState era ->
+  Property
+testIncrementalStake _ (LedgerState (UTxOState utxo _ _ _ incStake) (DPState dstate pstate)) =
+  let stake = stakeDistr @era utxo dstate pstate
+
+      istake = incrementalStakeDistr @era incStake dstate pstate
+   in counterexample
+        ( "\nIncremental stake distribution does not match old style stake distribution"
+            ++ tersediffincremental "differences: Old vs Incremental" (_stake stake) (_stake istake)
+        )
+        (stake === istake)
+
+incrementalStakeProp ::
+  forall era.
+  ( EraGen era,
+    QC.HasTrace (CHAIN era) (GenEnv era),
+    Default (State (Core.EraRule "PPUP" era))
+  ) =>
+  Proxy era ->
+  Property
+incrementalStakeProp Proxy = atEpoch @era (testIncrementalStake @era)
+
+tersediffincremental :: String -> Stake crypto -> Stake crypto -> String
+tersediffincremental message (Stake a) (Stake c) =
+  tersemapdiffs (message ++ " " ++ "hashes") (mp a) (mp c)
+  where
+    mp = (Map.map fromCompact) . VMap.toMap
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs
index 394eba5b104..890a91fe5d0 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs
@@ -508,6 +508,10 @@ instance
   arbitrary = genericArbitraryU
   shrink = recursivelyShrink
 
+instance CC.Crypto c => Arbitrary (IncrementalStake c) where
+  arbitrary = IStake <$> arbitrary <*> arbitrary
+  shrink = genericShrink
+
 -- The 'genericShrink' function returns first the immediate subterms of a
 -- value (in case it is a recursive data-type), and then shrinks the value
 -- itself. Since 'UTxOState' is not a recursive data-type, there are no
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/TerseTools.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/TerseTools.hs
new file mode 100644
index 00000000000..8abca02c321
--- /dev/null
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/TerseTools.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | This module suppies tools to tersely describe the differences between 2 values of the same type.
+module Test.Cardano.Ledger.TerseTools where
+
+import Cardano.Ledger.Address (Addr (..))
+import Cardano.Ledger.Coin (Coin (..))
+import qualified Cardano.Ledger.Core as Core
+import Cardano.Ledger.Credential
+  ( Credential (..),
+    Ptr (..),
+    StakeReference (..),
+  )
+import qualified Cardano.Ledger.Crypto as CC
+import Cardano.Ledger.Era (Era)
+import Cardano.Ledger.Hashes (ScriptHash (..))
+import Cardano.Ledger.Keys (KeyHash (..))
+import Cardano.Ledger.SafeHash (extractHash)
+import Cardano.Ledger.Shelley.LedgerState (IncrementalStake (..))
+import Cardano.Ledger.Shelley.UTxO (UTxO (..))
+import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
+import Cardano.Slotting.Slot (SlotNo (..))
+import qualified Data.Map as Map
+
+-- ====================================================
+
+class Terse t where
+  terse :: t -> String
+
+data Case a b = OnLeft !a !b | OnRight !a !b | SameKey !a !b !b
+
+instance (Terse a, Terse b) => Show (Case a b) where
+  show (OnLeft a b) = "Left " ++ terse (a, b)
+  show (OnRight a b) = "Right" ++ terse (a, b)
+  show (SameKey a b c) = "Same " ++ terse (a, b, c)
+
+instance (Terse a, Terse b) => Terse (Case a b) where
+  terse x = show x
+
+instance (Terse a, Terse b) => Terse (a, b) where
+  terse (a, b) = "(" ++ terse a ++ ", " ++ terse b ++ ")"
+
+instance (Terse a, Terse b, Terse c) => Terse (a, b, c) where
+  terse (a, b, c) = "(" ++ terse a ++ ", " ++ terse b ++ ", " ++ terse c ++ ")"
+
+caseKey :: Case p b -> p
+caseKey (OnLeft k _) = k
+caseKey (OnRight k _) = k
+caseKey (SameKey k _ _) = k
+
+-- | we assume the lists are lexigraphically sorted
+differences :: (Ord a, Eq b) => [(a, b)] -> [(a, b)] -> [Case a b]
+differences [] [] = []
+differences xs [] = (map (\(a, b) -> OnLeft a b) xs)
+differences [] ys = (map (\(a, b) -> OnRight a b) ys)
+differences ((a1, b1) : xs) ((a2, b2) : ys) =
+  case compare a1 a2 of
+    EQ -> if b1 == b2 then differences xs ys else (SameKey a1 b1 b2) : differences xs ys
+    LT -> (OnLeft a1 b1) : differences xs ((a2, b2) : ys)
+    GT -> (OnRight a2 b2) : differences ((a1, b1) : xs) ys
+
+mapdiffs :: (Ord a, Eq b) => Map.Map a b -> Map.Map a b -> [Case a b]
+mapdiffs mp1 mp2 = differences (Map.toAscList mp1) (Map.toAscList mp2)
+
+terselist :: Terse a => [Char] -> [a] -> [Char]
+terselist message xs = "\n" ++ message ++ "\n" ++ unlines (map terse xs)
+
+terselistfilter :: Terse a => [Char] -> (a -> Bool) -> [a] -> [Char]
+terselistfilter message p xs = "\n" ++ message ++ "\n" ++ unlines (map terse (filter p xs))
+
+tersemap :: (Terse k, Terse a) => [Char] -> Map.Map k a -> [Char]
+tersemap message mp = terselist message (Map.toAscList mp)
+
+tersemapfilter :: (Terse k, Terse a) => [Char] -> (a -> Bool) -> Map.Map k a -> [Char]
+tersemapfilter message p mp = terselistfilter message (\(_, a) -> p a) (Map.toAscList mp)
+
+tersemapdiffs :: (Terse a, Terse b, Ord a, Eq b) => String -> Map.Map a b -> Map.Map a b -> [Char]
+tersemapdiffs message mp1 mp2 = terselist message (mapdiffs mp1 mp2)
+
+instance Terse (Addr crypto) where
+  terse (Addr _net cred1 (StakeRefBase cred2)) = "Addr (" ++ terse cred1 ++ ") (" ++ terse cred2 ++ ")"
+  terse (Addr _net cred (StakeRefPtr ptr)) = "Addr (" ++ terse cred ++ ") (" ++ terse ptr ++ ")"
+  terse (Addr _net cred StakeRefNull) = "Addr (" ++ terse cred ++ ") Null"
+  terse (AddrBootstrap x) = "BootStrap " ++ show x
+
+instance Terse (Credential keyrole c) where
+  terse (ScriptHashObj (ScriptHash hash)) = "Script " ++ show hash
+  terse (KeyHashObj (KeyHash hash)) = "Key " ++ show hash
+
+instance Terse Ptr where
+  terse (Ptr (SlotNo n) i j) = "Ptr " ++ show n ++ " " ++ show i ++ " " ++ show j
+
+instance Terse (TxId era) where
+  terse (TxId safehash) = show (extractHash safehash)
+
+instance CC.Crypto era => Terse (TxIn era) where
+  terse (TxIn txid n) = "In " ++ terse txid ++ " " ++ show n
+
+instance Terse (Coin) where
+  terse (Coin n) = show n
+
+tersediffincremental :: String -> IncrementalStake crypto -> IncrementalStake crypto -> String
+tersediffincremental message (IStake a b) (IStake c d) =
+  tersemapdiffs (message ++ " " ++ "hashes") a c
+    ++ tersemapdiffs (message ++ " " ++ "ptrs") b d
+
+terseutxo :: (Era era, Terse (Core.TxOut era)) => String -> UTxO era -> String
+terseutxo message (UTxO mp) = terselist message (Map.toList mp)
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs
index 340f943191a..ce7078dcaab 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs
@@ -90,6 +90,7 @@ import Cardano.Ledger.Shelley.LedgerState
     RewardUpdate (..),
     UTxOState (..),
     applyRUpd,
+    updateStakeDistribution,
   )
 import Cardano.Ledger.Shelley.PParams (PParams, PParams' (..), ProposedPPUpdates)
 import Cardano.Ledger.Shelley.Rules.Mir (emptyInstantaneousRewards)
@@ -107,7 +108,7 @@ import Cardano.Protocol.TPraos.BHeader
     prevHashToNonce,
   )
 import Cardano.Slotting.Slot (EpochNo, WithOrigin (..))
-import Control.SetAlgebra (eval, setSingleton, singleton, (∪), (⋪), (⋫))
+import Control.SetAlgebra (eval, setSingleton, singleton, (∪), (⋪), (⋫), (◁))
 import Control.State.Transition (STS (State))
 import Data.Foldable (fold)
 import Data.Map.Strict (Map)
@@ -217,8 +218,11 @@ newUTxO txb cs = cs {chainNes = nes'}
     ls = esLState es
     utxoSt = _utxoState ls
     utxo = _utxo utxoSt
-    utxo' = eval ((txins @era txb ⋪ utxo) ∪ txouts @era txb)
-    utxoSt' = utxoSt {_utxo = utxo'}
+    utxoAdd = txouts @era txb
+    utxoDel = eval (txins @era txb ◁ utxo)
+    utxo' = eval ((txins @era txb ⋪ utxo) ∪ utxoAdd)
+    sd' = updateStakeDistribution @era (_stakeDistro utxoSt) utxoDel utxoAdd
+    utxoSt' = utxoSt {_utxo = utxo', _stakeDistro = sd'}
     ls' = ls {_utxoState = utxoSt'}
     es' = es {esLState = ls'}
     nes' = nes {nesEs = es'}
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 bf2370e7452..c57de9401e8 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
@@ -45,6 +45,7 @@ import Cardano.Ledger.Shelley.Delegation.Certificates (pattern RegPool)
 import Cardano.Ledger.Shelley.LedgerState
   ( AccountState (..),
     DPState (..),
+    IncrementalStake (..),
     UTxOState (..),
     WitHashes (..),
     _dstate,
@@ -375,6 +376,7 @@ utxoState =
     (Coin 0)
     (Coin 0)
     def
+    (IStake mempty mempty)
 
 dpState :: DPState C_Crypto
 dpState = DPState def def
diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs
index f163631d57b..b183a486572 100644
--- a/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs
+++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs
@@ -26,6 +26,7 @@ module Cardano.Ledger.Era
 where
 
 import qualified Cardano.Crypto.Hash as Hash
+import Cardano.Ledger.Address (Addr)
 import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Compactible (Compactible)
@@ -247,6 +248,7 @@ type WellFormed era =
     HasField "scriptWits" (Core.Tx era) (Map (ScriptHash (Crypto era)) (Core.Script era)),
     -- TxOut
     HasField "value" (Core.TxOut era) (Core.Value era),
+    HasField "address" (Core.TxOut era) (Addr (Crypto era)),
     -- HashAnnotated
     HashAnnotated (Core.AuxiliaryData era) EraIndependentAuxiliaryData (Crypto era),
     HashAnnotated (Core.TxBody era) EraIndependentTxBody (Crypto era),
diff --git a/libs/cardano-ledger-example-shelley/src/Cardano/Ledger/Example.hs b/libs/cardano-ledger-example-shelley/src/Cardano/Ledger/Example.hs
index 308d1d77a3f..b9991ed83e4 100644
--- a/libs/cardano-ledger-example-shelley/src/Cardano/Ledger/Example.hs
+++ b/libs/cardano-ledger-example-shelley/src/Cardano/Ledger/Example.hs
@@ -42,7 +42,6 @@ import Cardano.Ledger.Shelley.API
     ShelleyGenesis (sgGenDelegs, sgMaxLovelaceSupply, sgProtocolParams),
     StrictMaybe (SNothing),
     TxOut (..),
-    UTxOState (UTxOState),
     balance,
     genesisUTxO,
     word64ToCoin,
@@ -54,6 +53,7 @@ import qualified Cardano.Ledger.Shelley.BlockChain as Shelley
   )
 import Cardano.Ledger.Shelley.Constraints (UsesPParams (..), UsesTxBody, UsesTxOut (..), UsesValue)
 import Cardano.Ledger.Shelley.EpochBoundary (emptySnapShots)
+import Cardano.Ledger.Shelley.LedgerState (smartUTxOState)
 import Cardano.Ledger.Shelley.Metadata (Metadata (Metadata), validMetadatum)
 import Cardano.Ledger.Shelley.PParams ()
 import Cardano.Ledger.Shelley.PParams as Shelley
@@ -176,7 +176,7 @@ instance (CryptoClass.Crypto c) => CanStartFromGenesis (ExampleEra c) where
           (AccountState (Coin 0) reserves)
           emptySnapShots
           ( LedgerState
-              ( UTxOState
+              ( smartUTxOState
                   initialUtxo
                   (Coin 0)
                   (Coin 0)
diff --git a/libs/cardano-ledger-example-shelley/src/Cardano/Ledger/Example/Translation.hs b/libs/cardano-ledger-example-shelley/src/Cardano/Ledger/Example/Translation.hs
index 46a728153c9..ce6d7c8849e 100644
--- a/libs/cardano-ledger-example-shelley/src/Cardano/Ledger/Example/Translation.hs
+++ b/libs/cardano-ledger-example-shelley/src/Cardano/Ledger/Example/Translation.hs
@@ -152,7 +152,8 @@ instance Crypto c => TranslateEra (ExampleEra c) UTxOState where
         { _utxo = translateEra' ctxt $ _utxo us,
           _deposited = _deposited us,
           _fees = _fees us,
-          _ppups = translateEra' ctxt $ _ppups us
+          _ppups = translateEra' ctxt $ _ppups us,
+          _stakeDistro = (_stakeDistro us)
         }
 
 instance Crypto c => TranslateEra (ExampleEra c) LedgerState where
diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs
index f5bf9b1aebd..832983c1fbe 100644
--- a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs
+++ b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs
@@ -84,6 +84,7 @@ import Cardano.Ledger.Shelley.LedgerState
     DState (..),
     EpochState (..),
     FutureGenDeleg (..),
+    IncrementalStake (..),
     InstantaneousRewards (..),
     Ix,
     LedgerState (..),
@@ -666,17 +667,26 @@ ppLeaderOnlyReward (LeaderOnlyReward pool amt) =
       ("rewardAmount", ppCoin amt)
     ]
 
+ppIncrementalStake :: IncrementalStake crypto -> PDoc
+ppIncrementalStake (IStake st dangle) =
+  ppRecord
+    "IncrementalStake"
+    [ ("credMap", ppMap ppCredential ppCoin st),
+      ("ptrMap", ppMap ppPtr ppCoin dangle)
+    ]
+
 ppUTxOState ::
   CanPrettyPrintLedgerState era =>
   UTxOState era ->
   PDoc
-ppUTxOState (UTxOState u dep fee ppup) =
+ppUTxOState (UTxOState u dep fee ppup sd) =
   ppRecord
     "UTxOState"
     [ ("utxo", ppUTxO u),
       ("deposited", ppCoin dep),
       ("fees", ppCoin fee),
-      ("ppups", prettyA ppup)
+      ("ppups", prettyA ppup),
+      ("stakeDistro", ppIncrementalStake sd)
     ]
 
 ppEpochState :: CanPrettyPrintLedgerState era => EpochState era -> PDoc
@@ -770,6 +780,9 @@ instance
   where
   prettyA = ppUTxOState
 
+instance PrettyA (IncrementalStake c) where
+  prettyA = ppIncrementalStake
+
 -- =================================
 -- Cardano.Ledger.Shelley.Rewards
 
diff --git a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/EpochBoundary.hs b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/EpochBoundary.hs
index 15ef70bff77..c97186cdbd6 100644
--- a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/EpochBoundary.hs
+++ b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/EpochBoundary.hs
@@ -25,7 +25,7 @@ import Cardano.Ledger.SafeHash
     castSafeHash,
   )
 import Cardano.Ledger.Shelley.CompactAddr (compactAddr)
-import Cardano.Ledger.Shelley.EpochBoundary (aggregateUtxoCoinByCredential)
+import Cardano.Ledger.Shelley.LedgerState (aggregateUtxoCoinByCredential)
 import Cardano.Ledger.Shelley.TxBody (TxOut (..))
 import Cardano.Ledger.Shelley.UTxO (UTxO (UTxO))
 import Cardano.Ledger.ShelleyMA ()
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Alonzo/Tools.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Alonzo/Tools.hs
index 99e8890c445..d93333d48fe 100644
--- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Alonzo/Tools.hs
+++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Alonzo/Tools.hs
@@ -20,7 +20,7 @@ import Cardano.Ledger.Coin (Coin (..))
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Keys (GenDelegs (..))
 import Cardano.Ledger.SafeHash (hashAnnotated)
-import Cardano.Ledger.Shelley.LedgerState (UTxOState (..))
+import Cardano.Ledger.Shelley.LedgerState (IncrementalStake (..), UTxOState (..))
 import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv (..))
 import Cardano.Ledger.Shelley.UTxO (UTxO (..), makeWitnessVKey)
 import Cardano.Slotting.EpochInfo (EpochInfo, fixedEpochInfo)
@@ -140,7 +140,8 @@ ustate =
     { _utxo = initUTxO (Alonzo Mock),
       _deposited = Coin 0,
       _fees = Coin 0,
-      _ppups = def
+      _ppups = def,
+      _stakeDistro = IStake mempty mempty
     }
 
 -- Requires ex units, but there are no fees
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs
index ccd8b076327..aef4a0d773b 100644
--- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs
+++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs
@@ -82,7 +82,11 @@ import Cardano.Ledger.Shelley.API
     UTxO (..),
   )
 import Cardano.Ledger.Shelley.BlockChain (bBodySize)
-import Cardano.Ledger.Shelley.LedgerState (UTxOState (..), WitHashes (..))
+import Cardano.Ledger.Shelley.LedgerState
+  ( UTxOState (..),
+    WitHashes (..),
+    smartUTxOState,
+  )
 import Cardano.Ledger.Shelley.Rules.Bbody (BbodyEnv (..), BbodyPredicateFailure (..), BbodyState (..))
 import Cardano.Ledger.Shelley.Rules.Delegs (DelegsPredicateFailure (..))
 import Cardano.Ledger.Shelley.Rules.Delpl (DelplPredicateFailure (..))
@@ -274,7 +278,7 @@ initialUtxoSt ::
   ) =>
   Proof era ->
   UTxOState era
-initialUtxoSt pf = UTxOState (initUTxO pf) (Coin 0) (Coin 0) def
+initialUtxoSt pf = smartUTxOState (initUTxO pf) (Coin 0) (Coin 0) def
 
 -- | This is a helper type for the expectedUTxO function.
 --  ExpectSuccess indicates that we created a valid transaction
@@ -429,7 +433,7 @@ utxoStEx1 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx1 pf = UTxOState (utxoEx1 pf) (Coin 0) (Coin 5) def
+utxoStEx1 pf = smartUTxOState (utxoEx1 pf) (Coin 0) (Coin 5) def
 
 -- ======================================================================
 --  Example 2: Process a SPEND transaction with a failing Plutus script.
@@ -505,7 +509,7 @@ utxoStEx2 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx2 pf = UTxOState (utxoEx2 pf) (Coin 0) (Coin 5) def
+utxoStEx2 pf = smartUTxOState (utxoEx2 pf) (Coin 0) (Coin 5) def
 
 -- =========================================================================
 --  Example 3: Process a CERT transaction with a succeeding Plutus script.
@@ -564,7 +568,7 @@ utxoStEx3 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx3 pf = UTxOState (utxoEx3 pf) (Coin 0) (Coin 5) def
+utxoStEx3 pf = smartUTxOState (utxoEx3 pf) (Coin 0) (Coin 5) def
 
 -- =====================================================================
 --  Example 4: Process a CERT transaction with a failing Plutus script.
@@ -623,7 +627,7 @@ utxoStEx4 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx4 pf = UTxOState (utxoEx4 pf) (Coin 0) (Coin 5) def
+utxoStEx4 pf = smartUTxOState (utxoEx4 pf) (Coin 0) (Coin 5) def
 
 -- ==============================================================================
 --  Example 5: Process a WITHDRAWAL transaction with a succeeding Plutus script.
@@ -684,7 +688,7 @@ utxoStEx5 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx5 pf = UTxOState (utxoEx5 pf) (Coin 0) (Coin 5) def
+utxoStEx5 pf = smartUTxOState (utxoEx5 pf) (Coin 0) (Coin 5) def
 
 -- ===========================================================================
 --  Example 6: Process a WITHDRAWAL transaction with a failing Plutus script.
@@ -745,7 +749,7 @@ utxoStEx6 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx6 pf = UTxOState (utxoEx6 pf) (Coin 0) (Coin 5) def
+utxoStEx6 pf = smartUTxOState (utxoEx6 pf) (Coin 0) (Coin 5) def
 
 -- =============================================================================
 --  Example 7: Process a MINT transaction with a succeeding Plutus script.
@@ -806,7 +810,7 @@ utxoStEx7 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era, HasTokens era) =>
   Proof era ->
   UTxOState era
-utxoStEx7 pf = UTxOState (utxoEx7 pf) (Coin 0) (Coin 5) def
+utxoStEx7 pf = smartUTxOState (utxoEx7 pf) (Coin 0) (Coin 5) def
 
 -- ==============================================================================
 --  Example 8: Process a MINT transaction with a failing Plutus script.
@@ -866,7 +870,7 @@ utxoStEx8 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx8 pf = UTxOState (utxoEx8 pf) (Coin 0) (Coin 5) def
+utxoStEx8 pf = smartUTxOState (utxoEx8 pf) (Coin 0) (Coin 5) def
 
 -- ====================================================================================
 --  Example 9: Process a transaction with a succeeding script in every place possible,
@@ -969,7 +973,7 @@ utxoStEx9 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era, HasTokens era) =>
   Proof era ->
   UTxOState era
-utxoStEx9 pf = UTxOState (utxoEx9 pf) (Coin 0) (Coin 5) def
+utxoStEx9 pf = smartUTxOState (utxoEx9 pf) (Coin 0) (Coin 5) def
 
 -- ====================================================================================
 --  Example 10: A transaction with an acceptable supplimentary datum
@@ -1022,7 +1026,7 @@ utxoStEx10 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx10 pf = UTxOState (utxoEx10 pf) (Coin 0) (Coin 5) def
+utxoStEx10 pf = smartUTxOState (utxoEx10 pf) (Coin 0) (Coin 5) def
 
 -- ====================================================================================
 --  Example 11: A transaction with multiple identical certificates
@@ -1077,7 +1081,7 @@ utxoStEx11 ::
   (Default (State (EraRule "PPUP" era)), PostShelley era) =>
   Proof era ->
   UTxOState era
-utxoStEx11 pf = UTxOState (utxoEx11 pf) (Coin 0) (Coin 5) def
+utxoStEx11 pf = smartUTxOState (utxoEx11 pf) (Coin 0) (Coin 5) def
 
 -- ====================================================================================
 --  Example 12: Attaching a datum (hash) to a non-script output.
@@ -1121,10 +1125,17 @@ utxoEx12 :: PostShelley era => Proof era -> UTxO era
 utxoEx12 pf = expectedUTxO pf (ExpectSuccess (nonScriptOutWithDatumTxBody pf) (outEx12 pf)) 103
 
 utxoStEx12 ::
-  (Default (State (EraRule "PPUP" era)), PostShelley era) =>
+  ( Default (State (EraRule "PPUP" era)),
+    PostShelley era
+  ) =>
   Proof era ->
   UTxOState era
-utxoStEx12 pf = UTxOState (utxoEx12 pf) (Coin 0) (Coin 5) def
+utxoStEx12 pf =
+  smartUTxOState
+    (utxoEx12 pf)
+    (Coin 0)
+    (Coin 5)
+    def
 
 -- =======================
 -- Invalid Transactions
@@ -2121,7 +2132,7 @@ example1UTxO =
     pf = Alonzo Mock
 
 example1UtxoSt :: UTxOState A
-example1UtxoSt = UTxOState example1UTxO (Coin 0) (Coin 40) def
+example1UtxoSt = smartUTxOState example1UTxO (Coin 0) (Coin 40) def
 
 example1BBodyState :: BbodyState A
 example1BBodyState =
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Properties.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Properties.hs
index 1088a34a38e..2f977471798 100644
--- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Properties.hs
+++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Properties.hs
@@ -575,7 +575,7 @@ genUTxOState utxo = do
   GenEnv {gePParams} <- ask
   DPState {_dstate, _pstate} <- gsDPState <$> get
   let deposited = obligation gePParams (_rewards _dstate) (_pParams _pstate)
-  lift (UTxOState utxo deposited <$> arbitrary <*> pure def)
+  lift (UTxOState utxo deposited <$> arbitrary <*> pure def <*> pure def)
 
 genRecipientsFrom :: [TxOut A] -> GenRS [TxOut A]
 genRecipientsFrom txOuts = do
@@ -803,7 +803,7 @@ genTxAndLEDGERState = do
   pure (trc, s)
 
 totalAda :: UTxOState A -> DPState C_Crypto -> Coin
-totalAda (UTxOState utxo f d _) DPState {_dstate} =
+totalAda (UTxOState utxo f d _ _) DPState {_dstate} =
   f <> d <> coin (balance utxo) <> F.fold (_rewards _dstate)
 
 testTxValidForLEDGER :: (TRC (AlonzoLEDGER A), GenState) -> Property
diff --git a/libs/ledger-state/src/Cardano/Ledger/State/Query.hs b/libs/ledger-state/src/Cardano/Ledger/State/Query.hs
index 6a6b94ad7dd..ac5012f0f10 100644
--- a/libs/ledger-state/src/Cardano/Ledger/State/Query.hs
+++ b/libs/ledger-state/src/Cardano/Ledger/State/Query.hs
@@ -517,12 +517,7 @@ getLedgerState utxo LedgerState {..} dstate = do
   pure
     Shelley.LedgerState
       { Shelley._utxoState =
-          Shelley.UTxOState
-            { Shelley._utxo = utxo,
-              Shelley._deposited = utxoStateDeposited,
-              Shelley._fees = utxoStateFees,
-              Shelley._ppups = utxoStatePpups
-            },
+          Shelley.smartUTxOState utxo utxoStateDeposited utxoStateFees utxoStatePpups, -- Maintain invariant
         Shelley._delegationState =
           Shelley.DPState
             { Shelley._dstate = dstate,