Now computing both stake distrbution and incemental stake distribution.

eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs

@@ -15,6 +15,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE BangPatterns #-}
 
 -- |
 -- Module      : LedgerState
@@ -125,7 +126,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(StakeRefPtr,StakeRefBase))
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Era (Crypto, Era)
 import Cardano.Ledger.Keys
@@ -237,7 +238,7 @@ import Data.Coders
 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
@@ -533,7 +534,7 @@ pvCanFollow (ProtVer m n) (SJust (ProtVer m' n')) =
   (m + 1, 0) == (m', n') || (m, n + 1) == (m', n')
 
 -- =============================
--- | Incremental Stake, Take along with possible missed coins from danging Ptrs
+-- | Incremental Stake, Stake along with possible missed coins from danging Ptrs
 data IncrementalStake crypto = IStake
   { getStake :: !(Map (Credential 'Staking crypto) Coin),
     dangling :: !(Map Ptr Coin)
@@ -550,6 +551,16 @@ instance CC.Crypto crypto => FromCBOR (IncrementalStake crypto) where
       stake <- mapFromCBOR
       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)
+
 -- =============================      
 
 
@@ -833,6 +844,8 @@ consumed pp u tx =
     refunds = keyRefunds pp tx
     withdrawals = fold . unWdrl $ getField @"wdrls" tx
 
+
+-- | Incrementally add the inserts 'utxoAdd' and the deletes 'utxoDel' to the IncrementalStake.
 updateStakeDistribution ::
   (Era era,
    HasField "address" (Core.TxOut era) (Addr (Crypto era))
@@ -842,13 +855,36 @@ updateStakeDistribution ::
   UTxO era ->
   Map Ptr (Credential 'Staking (Crypto era)) ->
   IncrementalStake (Crypto era)
-updateStakeDistribution (IStake stake dangle) utxoDel utxoAdd ptrs =
-  IStake (stake `combine` stakeAdded `combine` stakeDeletedInv) dangle
+updateStakeDistribution incStake utxoDel utxoAdd ptrs = finalStake
   where
-    combine = Map.unionWith (<>)
-    stakeDeleted = aggregateUtxoCoinByCredential ptrs utxoDel mempty
-    stakeDeletedInv = Map.map invert stakeDeleted
-    stakeAdded = aggregateUtxoCoinByCredential ptrs utxoAdd mempty
+    addStake = incrementalAggregateUtxoCoinByCredential ptrs utxoAdd incStake
+    delStake = incrementalAggregateUtxoCoinByCredential ptrs utxoDel mempty
+    finalStake = addStake <> (invert delStake)
+
+-- | Incrementally sum up all the Coin for each staking Credential
+incrementalAggregateUtxoCoinByCredential ::
+  forall era.
+  ( Era era,
+    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+  ) =>
+  Map Ptr (Credential 'Staking (Crypto era)) ->
+  UTxO era ->
+  IncrementalStake (Crypto era) ->
+  IncrementalStake (Crypto era)
+incrementalAggregateUtxoCoinByCredential ptrs (UTxO u) initial =
+  Map.foldl' accum initial u
+  where
+    accum ans@(!(IStake stake dangle)) out =
+      case (getField @"address" out, getField @"value" out) of
+        (Addr _ _ (StakeRefPtr p), c) ->
+          case Map.lookup p ptrs of
+            Just cred -> IStake (Map.insertWith (<>) cred (Val.coin c) stake) dangle
+            Nothing -> IStake stake (Map.insertWith (<>) p (Val.coin c) dangle)
+        (Addr _ _ (StakeRefBase hk), c) ->
+            IStake (Map.insertWith (<>) hk (Val.coin c) stake) dangle
+        _other -> ans
+
+
 
 
 newtype WitHashes crypto = WitHashes

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs

@@ -64,7 +64,7 @@ snapTransition ::
 snapTransition = do
   TRC (lstate, s, _) <- judgmentContext
 
-  let LedgerState (UTxOState utxo _ fees _ (IStake sd _)) (DPState dstate pstate) = lstate
+  let LedgerState (UTxOState utxo _ fees _ (IStake sd dangle)) (DPState dstate pstate) = lstate
       stake = stakeDistr utxo dstate pstate
       -- ^ The stake distribution calculation done on the epoch boundary, which we
       -- would like to replace with an incremental one.
@@ -76,12 +76,19 @@ snapTransition = do
       -- filter the delegation mapping by the registered stake pools
       ds' = Map.filter (\pid -> pid `Map.member` ps) ds
 
-      -- add the incremental stake distribution calculation to the existing rewards
-      sd' = Map.unionWith (<>) sd rws
+      -- check if dangling ptrs are no-longer dangling, so we adjust by adding them back to 'sd'
+      ptrs = forwards (_ptrs dstate)
+      sd1 = Map.foldlWithKey' accum sd dangle
+             where accum incstake p coin = 
+                      case Map.lookup p ptrs of
+                         Just cred -> Map.insertWith (<>) cred coin incstake
+                         Nothing -> incstake
+      -- add the incremental stake distribution calculation to the existing rewards                         
+      sd2 = Map.unionWith (<>) sd1 rws
 
       -- filter the incremental stake distribution calculation to the credentials which
       -- are both registered and delegating to a registered pool
-      sd'' = Stake $ Map.filterWithKey (\cred _ -> cred `Map.member` ds') sd'
+      sd3 = Stake $ Map.filterWithKey (\cred _ -> cred `Map.member` ds') sd2
 
       -- for debugging, this is what the epoch boundary calculation would look like
       -- if there were no rewards
@@ -93,14 +100,14 @@ snapTransition = do
             , "snapshotted stake\n"
             , show (_stake stake)
             , "\nincremental stake (filtered & w/ rewards)\n"
-            , show sd''
+            , show sd3
             , "\nagged in spot\n"
             , show bigAggNoRewards
             , "\nrewards\n"
             , show rws
             ]
       newMarkSnapshot =
-        if doExplode && (_stake stake) /= sd''
+        if doExplode && (_stake stake) /= sd3
           then (error $ mconcat msg)
           else stake
   pure $

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs

@@ -367,7 +367,7 @@ utxoInductive ::
   TransitionRule (utxo era)
 utxoInductive = do
   TRC (UtxoEnv slot pp stakepools genDelegs ptrs, u, tx) <- judgmentContext
-  let UTxOState utxo deposits' fees ppup stake = u
+  let UTxOState utxo deposits' fees ppup incStake = u
   let txb = getField @"body" tx
 
   getField @"ttl" txb >= slot ?! ExpiredUTxO (getField @"ttl" txb) slot
@@ -436,18 +436,18 @@ utxoInductive = do
   let totalDeposits' = totalDeposits pp (`Map.notMember` stakepools) txCerts
   tellEvent $ TotalDeposits totalDeposits'
   let depositChange = totalDeposits' <-> refunded
-  let utxoAdd = txouts txb
-  let utxoDel = eval (txins @era txb ◁ utxo)
-  let newUTxO = eval ((txins @era txb ⋪ utxo) ∪ utxoAdd)
-  let newStakeDistro = updateStakeDistribution @era stake utxoDel utxoAdd ptrs
+  let utxoAdd = txouts txb                                 -- These will be inserted into the UTxO
+  let utxoDel = eval (txins @era txb ◁ utxo)              -- These will be deleted fromthe UTxO
+  let newUTxO = eval ((txins @era txb ⋪ utxo) ∪ utxoAdd)  -- Domain exclusion (a ⋪ b) deletes 'a' from 'b'
+  let newIncStakeDistro = updateStakeDistribution @era incStake utxoDel utxoAdd ptrs
 
   pure
     UTxOState
       { _utxo = newUTxO,
         _deposited = deposits' <> depositChange,
         _fees = fees <> getField @"txfee" txb,
         _ppups = ppup',
-        _stakeDistro = newStakeDistro
+        _stakeDistro = newIncStakeDistro
       }
 
 instance