total stake should exclude certain buckets of ada

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Wallet.hs

@@ -12,14 +12,13 @@ import           Data.Ratio ((%))
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Shelley.Spec.Ledger.Address (Addr (..))
-import           Shelley.Spec.Ledger.Credential (Credential (..))
 import           Shelley.Spec.Ledger.API.Validation (ShelleyState)
-import           Shelley.Spec.Ledger.BaseTypes (Globals (..))
 import           Shelley.Spec.Ledger.Coin (Coin (..))
+import           Shelley.Spec.Ledger.Credential (Credential (..))
 import           Shelley.Spec.Ledger.EpochBoundary (SnapShot (..), Stake (..), poolStake)
-import           Shelley.Spec.Ledger.Keys (KeyHash, KeyRole(..))
-import           Shelley.Spec.Ledger.LedgerState (esLState, esNonMyopic, esPp, nesEs, _utxo,
-                     _utxoState)
+import           Shelley.Spec.Ledger.Keys (KeyHash, KeyRole (..))
+import           Shelley.Spec.Ledger.LedgerState (esLState, esNonMyopic, esPp, nesEs, totalStake,
+                     _utxo, _utxoState)
 import           Shelley.Spec.Ledger.Rewards (NonMyopic (..), StakeShare (..), getTopRankedPools,
                      nonMyopicMemberRew, nonMyopicStake)
 import           Shelley.Spec.Ledger.TxData (PoolParams (..), TxOut (..))
@@ -31,20 +30,19 @@ import           Shelley.Spec.Ledger.UTxO (UTxO (..))
 -- pool (identified by the key hash of the pool operator) to the
 -- non-myopic pool member reward for that stake pool.
 getNonMyopicMemberRewards
-  :: Globals
-  -> ShelleyState crypto
+  :: ShelleyState crypto
   -> Set (Credential 'Staking crypto)
   -> Map (Credential 'Staking crypto) (Map (KeyHash 'StakePool crypto) Coin)
-getNonMyopicMemberRewards globals ss creds = Map.fromList $
+getNonMyopicMemberRewards ss creds = Map.fromList $
   fmap
     (\cred -> (cred, Map.mapWithKey (mkNMMRewards $ memShare cred) poolData))
     (Set.toList creds)
   where
-    total = fromIntegral $ maxLovelaceSupply globals
+    es = nesEs ss
+    Coin total = totalStake $ esLState es
     toShare (Coin x) = StakeShare (x % total)
     memShare cred = toShare $ Map.findWithDefault (Coin 0) cred (unStake stake)
 
-    es = nesEs ss
     pp = esPp es
     NonMyopic
       { apparentPerformances = aps

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/LedgerState.hs

@@ -67,6 +67,7 @@ module Shelley.Spec.Ledger.LedgerState
   -- epoch boundary
   , stakeDistr
   , applyRUpd
+  , totalStake
   , createRUpd
   --
   , NewEpochState(..)
@@ -93,7 +94,7 @@ import           Data.Set (Set)
 import qualified Data.Set as Set
 import           GHC.Generics (Generic)
 import           Shelley.Spec.Ledger.Address (Addr (..))
-import           Shelley.Spec.Ledger.Credential (Credential (..))
+import           Shelley.Spec.Ledger.Credential (Credential (..), StakeReference (..))
 import           Shelley.Spec.Ledger.Coin (Coin (..))
 import           Shelley.Spec.Ledger.Crypto (Crypto)
 import           Shelley.Spec.Ledger.EpochBoundary (BlocksMade (..), SnapShot (..), SnapShots (..),
@@ -1001,21 +1002,36 @@ updateNonMypopic nm rPot aps ss = nm
     aps' = Map.mapWithKey performance (aps `Map.union` performanceZero)
 
 
+-- | Compute the total stake
+totalStake
+  :: LedgerState crypto
+  -> Coin
+totalStake ls = totalUtxoStake + totalRewardStake
+  where
+    outputStake (TxOut (Addr _ (StakeRefBase _)) c) = c
+    outputStake (TxOut (Addr _ (StakeRefPtr _ )) c) = c
+    outputStake (TxOut (Addr _ (StakeRefNull  )) _) = 0
+    outputStake (TxOut (AddrBootstrap _)         _) = 0
+    (UTxO utxo) = _utxo . _utxoState $ ls
+    totalUtxoStake = Map.foldl' (\acc out -> outputStake out + acc) 0 utxo
+    totalRewardStake = sum $ _rewards . _dstate . _delegationState $ ls
+
 -- | Create a reward update
 createRUpd
   :: EpochNo
   -> BlocksMade crypto
   -> EpochState crypto
-  -> Coin
   -> ShelleyBase (RewardUpdate crypto)
-createRUpd e b@(BlocksMade b') (EpochState acnt ss ls pr _ nm) total = do
+createRUpd e b@(BlocksMade b') (EpochState acnt ss ls pr _ nm) = do
     ei <- asks epochInfo
     slotsPerEpoch <- epochInfoSize ei e
     asc <- asks activeSlotCoeff
     let SnapShot stake' delegs' poolParams = _pstakeGo ss
         Coin reserves = _reserves acnt
         ds = _dstate $ _delegationState ls
 
+        total = totalStake ls
+
         -- reserves and rewards change
         deltaR_ = (floor $ min 1 eta * intervalValue (_rho pr) * fromIntegral reserves)
         expectedBlocks =

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Rupd.hs

@@ -18,8 +18,7 @@ import           Control.State.Transition (STS (..), TRC (..), TransitionRule, j
 import           Data.Functor ((<&>))
 import           GHC.Generics (Generic)
 import           Shelley.Spec.Ledger.BaseTypes (ShelleyBase, StrictMaybe (..), epochInfo,
-                     maxLovelaceSupply, randomnessStabilisationWindow)
-import           Shelley.Spec.Ledger.Coin (Coin (..))
+                     randomnessStabilisationWindow)
 import           Shelley.Spec.Ledger.EpochBoundary (BlocksMade)
 import           Shelley.Spec.Ledger.LedgerState (EpochState, RewardUpdate, createRUpd)
 import           Shelley.Spec.Ledger.Slot (Duration (..), SlotNo, epochInfoEpoch, epochInfoFirst,
@@ -46,15 +45,14 @@ instance NoUnexpectedThunks (PredicateFailure (RUPD crypto))
 rupdTransition :: TransitionRule (RUPD crypto)
 rupdTransition = do
   TRC (RupdEnv b es, ru, s) <- judgmentContext
-  (epoch, slot, maxLL) <- liftSTS $ do
+  (epoch, slot) <- liftSTS $ do
     ei <- asks epochInfo
     sr <- asks randomnessStabilisationWindow
     e <- epochInfoEpoch ei s
     slot <- epochInfoFirst ei e <&> (+* (Duration sr))
-    maxLL <- asks maxLovelaceSupply
-    return (e, slot, maxLL)
+    return (e, slot)
   if s <= slot
     then pure ru
     else case ru of
-      SNothing -> SJust <$> (liftSTS $ createRUpd epoch b es (Coin $ fromIntegral maxLL))
+      SNothing -> SJust <$> (liftSTS $ createRUpd epoch b es)
       SJust _  -> pure ru

shelley/chain-and-ledger/executable-spec/test/Test/Shelley/Spec/Ledger/Examples/Examples.hs

@@ -131,7 +131,7 @@ import           Shelley.Spec.Ledger.LedgerState (AccountState (..), pattern Act
                      genesisCoins, genesisId, nesEs, nonMyopic, overlaySchedule, rs,
                      _delegationState, _delegations, _dstate, _fGenDelegs, _genDelegs, _irwd,
                      _pParams, _ptrs, _reserves, _retiring, _rewards, _stPools, _stkCreds,
-                     _treasury)
+                     _treasury, totalStake)
 import           Shelley.Spec.Ledger.OCert (KESPeriod (..))
 import           Shelley.Spec.Ledger.PParams (PParams, PParams' (PParams), PParamsUpdate,
                      pattern ProposedPPUpdates, pattern Update, emptyPPPUpdates, emptyPParams, _a0,
@@ -1271,10 +1271,10 @@ blockEx2HHash :: HashHeader
 blockEx2HHash = bhHash (bheader blockEx2H)
 
 aliceRAcnt2H :: Coin
-aliceRAcnt2H = Coin 23839338840
+aliceRAcnt2H = Coin 5827393939
 
 bobRAcnt2H :: Coin
-bobRAcnt2H = Coin 2124297519
+bobRAcnt2H = Coin 519272726
 
 rewardsEx2H :: Map RewardAcnt Coin
 rewardsEx2H = Map.fromList [ (RewardAcnt aliceSHK, aliceRAcnt2H)
@@ -1287,11 +1287,14 @@ oCertIssueNosEx2H =
     2
     oCertIssueNosEx2G
 
+totalStakeEx2H :: Coin
+totalStakeEx2H = totalStake expectedLSEx2G
+
 alicePerfEx2H :: ApparentPerformance
 alicePerfEx2H = ApparentPerformance (beta / sigma)
   where
     beta = 1 -- Alice produced the only decentralized block this epoch
-    sigma = fromRational (fromIntegral stake % fromIntegral maxLLSupply)
+    sigma = fromRational (fromIntegral stake % fromIntegral totalStakeEx2H)
     stake = aliceCoinEx2BBase + aliceCoinEx2BPtr + bobInitCoin
 
 expectedStEx2H :: ChainState
@@ -1301,7 +1304,7 @@ expectedStEx2H = ChainState
      (BlocksMade $ Map.singleton (hk alicePool) 1)
      (BlocksMade Map.empty)
      (EpochState acntEx2G snapsEx2G expectedLSEx2G ppsEx1 ppsEx1 emptyNonMyopic)
-     (SJust RewardUpdate { deltaT        = Coin 767369696984
+     (SJust RewardUpdate { deltaT        = Coin 786986666678
                          , deltaR        = Coin (-793333333333)
                          , rs            = rewardsEx2H
                          , deltaF        = Coin (-10)
@@ -1354,7 +1357,7 @@ epoch1OSchedEx2I = runShelleyBase $ overlaySchedule
 
 acntEx2I :: AccountState
 acntEx2I = AccountState
-            { _treasury = Coin 767369697024
+            { _treasury = Coin 786986666718
             , _reserves = Coin 33999206666666557
             }
 

shelley/chain-and-ledger/formal-spec/chain.tex

@@ -797,7 +797,7 @@ \subsection{Reward Update Transition}
       &
       ru = \Nothing
       \\~\\
-      ru' \leteq \createRUpd{b}{es}{\MaxLovelaceSupply}
+      ru' \leteq \createRUpd{b}{es}
     }
     {
       {\begin{array}{c}

shelley/chain-and-ledger/formal-spec/epoch.tex

@@ -28,7 +28,7 @@ \section{Rewards and the Epoch Boundary}
 \newcommand{\lReward}[4]{\fun{r_{operator}}~ \var{#1}~ \var{#2}~ \var{#3}~ {#4}}
 \newcommand{\mReward}[4]{\fun{r_{member}}~ \var{#1}~ \var{#2}~ \var{#3}~ {#4}}
 \newcommand{\poolReward}[5]{\fun{poolReward}~\var{#1}~{#2}~\var{#3}~\var{#4}~\var{#5}}
-\newcommand{\createRUpd}[3]{\fun{createRUpd}~\var{#1}~\var{#2}~\var{#3}}
+\newcommand{\createRUpd}[2]{\fun{createRUpd}~\var{#1}~\var{#2}}
 \newcommand{\getIR}[1]{\fun{getIR}~\var{#1}}
 
 This chapter introduces the epoch boundary transition system and the related reward calculation.
@@ -1314,7 +1314,8 @@ \subsection{Reward Update Calculation}
   \item Note that for all the calculations below, we use the previous protocol parameters
     $\var{prevPp}$, which corresponds to the parameters during the epoch for which we
     are creating rewards.
-  \item First we calculate the change to the reserves,
+  \item First we calculate the total stake.
+  \item Then we calculate the change to the reserves,
     as determined by the $\rho$ protocol parameter.
   \item Next we calculate $\var{rewardPot}$, the total amount of coin available for rewards this
     epoch, as described in section 6.4 of \cite{delegation_design}. It consists of four pots:
@@ -1359,11 +1360,25 @@ \subsection{Reward Update Calculation}
   \emph{Calculation to create a reward update}
   %
   \begin{align*}
-    & \fun{createRUpd} \in \BlocksMade \to \EpochState \to \Coin \to \RewardUpdate \\
-    & \createRUpd{b}{es}{total} = \left(
+    & \fun{totalStake} \in \LState \to \Coin \\
+    & \fun{totalStake}~\var{ls} = \var{totalUtxoStake} + \var{totalRewardStake} \\
+    & ~~~\where \\
+    & ~~~~~~~((\var{utxo},\wcard,\wcard,\wcard),
+    ~((\wcard,~\var{rewards},\wcard,\wcard,\wcard,\wcard,\wcard),~\wcard))
+    = \var{ls} \\
+    & ~~~~~~~totalUtxoStake =
+    \sum \{c~\mid~\wcard\mapsto(a,~c)\in\var{utxo},~a\in\AddrB\uniondistinct\AddrP\} \\
+    & ~~~~~~~totalRewardStake =
+    \sum \{c~\mid~\wcard\mapsto c\in\var{rewards}\}
+  \end{align*}
+  %
+  \begin{align*}
+    & \fun{createRUpd} \in \BlocksMade \to \EpochState \to \RewardUpdate \\
+    & \createRUpd{b}{es} = \left(
       \Delta t_1+\Delta t_2,-~\Delta r,~\var{rs},~-\var{feeSS}\right) \\
     & ~~~\where \\
     & ~~~~~~~(\var{acnt},~\var{ss},~\var{ls},~\var{prevPp},~\wcard) = \var{es} \\
+    & ~~~~~~~\var{total} = \fun{totalStake}~\var{ls} \\
     & ~~~~~~~(\wcard,~\wcard,~\var{pstake_{go}},~\var{poolsSS},~\var{feeSS}) = \var{ss}\\
     & ~~~~~~~(\var{stake},~\var{delegs}) = \var{pstate_{go}} \\
     & ~~~~~~~(\wcard,~\var{reserves}) = \var{acnt} \\