WIP

Author: aniketd

eras/conway/impl/src/Cardano/Ledger/Conway/State/Stake.hs

@@ -124,7 +124,7 @@ resolveConwayInstantStake ::
   (EraStake era, InstantStake era ~ ConwayInstantStake era) =>
   ConwayInstantStake era ->
   Accounts era ->
-  Stake
+  ActiveStake
 resolveConwayInstantStake instantStake accounts =
-  Stake $ VMap.fromMap $ resolveActiveInstantStakeCredentials instantStake accounts
+  ActiveStake $ VMap.fromMap $ resolveActiveInstantStakeCredentials instantStake accounts
 {-# INLINE resolveConwayInstantStake #-}

eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs

@@ -228,12 +228,14 @@ getNonMyopicMemberRewards globals ss = Map.fromSet nmmRewards
     totalStakeCoin@(Coin totalStake) = circulation es maxSupply
     toShare (Coin x) = StakeShare $ x %? totalStake
     memShare (Right cred) =
-      toShare $ maybe mempty fromCompact $ VMap.lookup cred (EB.unStake stake)
+      toShare $
+        maybe mempty (fromCompact . unNonZero . EB.swdStake) $
+          VMap.lookup cred (EB.unActiveStake activeStake)
     memShare (Left coin) = toShare coin
     es = nesEs ss
     pp = es ^. curPParamsEpochStateL
     NonMyopic {likelihoodsNM = ls, rewardPotNM = rPot} = esNonMyopic es
-    EB.SnapShot stake _ _ stakePoolsSnapShot = currentSnapshot ss
+    EB.SnapShot activeStake _ stakePoolsSnapShot = currentSnapshot ss
     calcNMMRewards t poolId spss
       | spssPledge <= spssSelfDelegatedOwnersStake =
           calcNonMyopicMemberReward pp rPot poolId spssCost spssMargin s sigma t topPools hitRateEst

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

@@ -115,8 +115,6 @@ module Cardano.Ledger.Shelley.LedgerState (
   ssStakeGoL,
   ssFeeL,
   ssStakeL,
-  ssStakeDistrL,
-  ssDelegationsL,
 ) where
 
 import Cardano.Ledger.Shelley.LedgerState.IncrementalStake

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

@@ -97,8 +97,8 @@ startStep ::
   NonZero Word64 ->
   PulsingRewUpdate
 startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ls ss nm) maxSupply asc secparam =
-  let SnapShot stake totalActiveStake delegs stakePoolSnapShots = ssStakeGo ss
-      numStakeCreds = fromIntegral (VMap.size $ unStake stake)
+  let SnapShot activeStake totalActiveStake stakePoolSnapShots = ssStakeGo ss
+      numStakeCreds = fromIntegral (VMap.size $ unActiveStake activeStake)
       k = toIntegerNonZero secparam
       -- We expect approximately 10k-many blocks to be produced each epoch.
       -- The reward calculation begins (4k/f)-many slots into the epoch,
@@ -198,7 +198,6 @@ startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ls ss nm) maxSuppl
       -- the neccessary information to compute their individual rewards.
       free =
         FreeVars
-          delegs
           (Map.keysSet (accounts ^. accountsMapL)) -- TODO optimize. This is an expensive operation
           totalStake
           (pr ^. ppProtocolVersionL)
@@ -208,7 +207,7 @@ startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ls ss nm) maxSuppl
         RSLP
           pulseSize
           free
-          (unStake stake)
+          (unActiveStake activeStake)
           (RewardAns Map.empty Map.empty)
    in Pulsing rewsnap pulser
 

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

@@ -43,7 +43,7 @@ import Cardano.Ledger.Binary (
   encodeMemPack,
  )
 import Cardano.Ledger.Binary.Coders (Decode (From, RecD), Encode (..), decode, encode, (!>), (<!))
-import Cardano.Ledger.Coin (Coin (..), CompactForm)
+import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Shelley.Era (ShelleyEra)
@@ -56,7 +56,6 @@ import Control.Monad.Trans (MonadTrans (lift))
 import Data.Aeson (ToJSON (..), (.=))
 import Data.Default (Default, def)
 import Data.Map.Strict (Map)
-import Data.VMap (VB, VMap, VP)
 import GHC.Generics (Generic)
 import Lens.Micro
 import NoThunks.Class (NoThunks (..))
@@ -671,8 +670,8 @@ epochStateStakePoolsL ::
 epochStateStakePoolsL = esLStateL . lsCertStateL . certPStateL . psStakePoolsL
 
 epochStateStakeDistrL ::
-  Lens' (EpochState era) (VMap VB VP (Credential Staking) (CompactForm Coin))
-epochStateStakeDistrL = esSnapshotsL . ssStakeMarkL . ssStakeDistrL
+  Lens' (EpochState era) ActiveStake
+epochStateStakeDistrL = esSnapshotsL . ssStakeMarkL . ssActiveStakeL
 
 potEqualsObligation ::
   (EraGov era, EraCertState era) =>

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

@@ -37,6 +37,7 @@ import Cardano.Ledger.BaseTypes (
   ProtVer (..),
   ShelleyBase,
   ToKeyValuePairs (..),
+  unNonZero,
  )
 import Cardano.Ledger.Binary (
   DecCBOR (..),
@@ -53,7 +54,7 @@ import Cardano.Ledger.Binary.Coders (
   (!>),
   (<!),
  )
-import Cardano.Ledger.Coin (Coin (..), CompactForm, DeltaCoin (..))
+import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
 import Cardano.Ledger.Compactible (Compactible (fromCompact))
 import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
@@ -63,6 +64,7 @@ import Cardano.Ledger.Shelley.Rewards (
   PoolRewardInfo (..),
   rewardOnePoolMember,
  )
+import Cardano.Ledger.State (StakeWithDelegation (..))
 import Control.DeepSeq (NFData (..))
 import Data.Aeson (ToJSON (..), Value (Null), (.=))
 import Data.Default (def)
@@ -206,8 +208,7 @@ instance DecCBOR RewardSnapShot where
 -- Pulsable function.
 
 data FreeVars = FreeVars
-  { fvDelegs :: !(VMap VB VB (Credential Staking) (KeyHash StakePool))
-  , fvAddrsRew :: !(Set (Credential Staking))
+  { fvAddrsRew :: !(Set (Credential Staking))
   , fvTotalStake :: !Coin
   , fvProtVer :: !ProtVer
   , fvPoolRewardInfo :: !(VMap VB VB (KeyHash StakePool) PoolRewardInfo)
@@ -220,15 +221,13 @@ instance NFData FreeVars
 instance EncCBOR FreeVars where
   encCBOR
     FreeVars
-      { fvDelegs
-      , fvAddrsRew
+      { fvAddrsRew
       , fvTotalStake
       , fvProtVer
       , fvPoolRewardInfo
       } =
       encode
         ( Rec FreeVars
-            !> To fvDelegs
             !> To fvAddrsRew
             !> To fvTotalStake
             !> To fvProtVer
@@ -239,7 +238,6 @@ instance DecCBOR FreeVars where
   decCBOR =
     decode
       ( RecD FreeVars
-          <! From {- fvDelegs -}
           <! From {- fvAddrsRew -}
           <! From {- fvTotalStake -}
           <! From {- fvProtver -}
@@ -253,20 +251,23 @@ rewardStakePoolMember ::
   FreeVars ->
   RewardAns ->
   Credential Staking ->
-  CompactForm Coin ->
+  StakeWithDelegation ->
   RewardAns
-rewardStakePoolMember freeVars inputAnswer@(RewardAns accum recent) cred c =
+rewardStakePoolMember freeVars inputAnswer@(RewardAns accum recent) cred swd =
   fromMaybe inputAnswer $ do
     let FreeVars
-          { fvDelegs
-          , fvAddrsRew
+          { fvAddrsRew
           , fvTotalStake
           , fvPoolRewardInfo
           , fvProtVer
           } = freeVars
-    poolId <- VMap.lookup cred fvDelegs
+        poolId = swdDelegation swd
     poolRI <- VMap.lookup poolId fvPoolRewardInfo
-    r <- rewardOnePoolMember fvProtVer fvTotalStake fvAddrsRew poolRI cred (fromCompact c)
+    r <-
+      rewardOnePoolMember fvProtVer fvTotalStake fvAddrsRew poolRI cred $
+        fromCompact $
+          unNonZero $
+            swdStake swd
     let ans = Reward MemberReward poolId r
     -- There is always just 1 member reward, so Set.singleton is appropriate
     pure $ RewardAns (Map.insert cred ans accum) (Map.insert cred (Set.singleton ans) recent)
@@ -285,7 +286,7 @@ data RewardPulser (m :: Type -> Type) ans where
     (ans ~ RewardAns, m ~ ShelleyBase) =>
     !Int ->
     !FreeVars ->
-    !(VMap.VMap VMap.VB VMap.VP (Credential Staking) (CompactForm Coin)) ->
+    !(VMap.VMap VMap.VB VMap.VB (Credential Staking) StakeWithDelegation) ->
     !ans ->
     RewardPulser m ans
 

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

@@ -16,8 +16,8 @@ module Cardano.Ledger.Shelley.Rules.Snap (
   SnapEnv (..),
 ) where
 
-import Cardano.Ledger.BaseTypes (ShelleyBase)
-import Cardano.Ledger.Coin (Coin, CompactForm)
+import Cardano.Ledger.BaseTypes (ShelleyBase, unNonZero)
+import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Compactible (fromCompact)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential)
@@ -85,17 +85,11 @@ snapTransition = do
         snapShotFromInstantStake instantStake (certState ^. certDStateL) (certState ^. certPStateL)
 
   tellEvent $
-    let stMap :: Map (Credential Staking) (CompactForm Coin)
-        stMap = VMap.toMap . unStake $ ssActiveStake istakeSnap
-
-        stakeCoinMap :: Map (Credential Staking) Coin
-        stakeCoinMap = fmap fromCompact stMap
-
-        stakePoolMap :: Map (Credential Staking) (KeyHash StakePool)
-        stakePoolMap = VMap.toMap $ ssDelegations istakeSnap
-
-        stakeMap :: Map (Credential Staking) (Coin, KeyHash StakePool)
-        stakeMap = Map.intersectionWith (,) stakeCoinMap stakePoolMap
+    let stakeMap :: Map (Credential Staking) (Coin, KeyHash StakePool)
+        stakeMap =
+          Map.map
+            (\swd -> (fromCompact $ unNonZero $ swdStake swd, swdDelegation swd))
+            (VMap.toMap $ unActiveStake $ ssActiveStake istakeSnap)
      in StakeDistEvent stakeMap
 
   pure $

eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Stake.hs

@@ -21,7 +21,12 @@ module Cardano.Ledger.Shelley.State.Stake (
 ) where
 
 import Cardano.Ledger.Address
-import Cardano.Ledger.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..))
+import Cardano.Ledger.BaseTypes (
+  KeyValuePairs (..),
+  NonZero (..),
+  ToKeyValuePairs (..),
+  unsafeNonZero,
+ )
 import Cardano.Ledger.Binary (
   DecShareCBOR (..),
   EncCBOR (..),
@@ -149,19 +154,19 @@ resolveShelleyInstantStake ::
   ) =>
   ShelleyInstantStake era ->
   ShelleyAccounts era ->
-  Stake
+  ActiveStake
 resolveShelleyInstantStake instantStake@ShelleyInstantStake {sisPtrStake} sas =
-  Stake $ VMap.fromMap $ Map.foldlWithKey' addPtrStake credentialStakeMap sisPtrStake
+  ActiveStake $ VMap.fromMap $ Map.foldlWithKey' addPtrStake credentialStakeMap sisPtrStake
   where
     !credentialStakeMap = resolveActiveInstantStakeCredentials instantStake sas
     addPtrStake !acc ptr ptrStake = fromMaybe acc $ do
       cred <- Map.lookup ptr (saPtrs sas)
-      -- Ensure only staking credential that delegates to a pool receive Ptr delegations
       accountState <- lookupAccountState cred sas
-      _ <- accountState ^. stakePoolDelegationAccountStateL
+      poolId <- accountState ^. stakePoolDelegationAccountStateL
       let plusPtrStake =
             Just . \case
-              Nothing -> ptrStake
-              Just curStake -> curStake <> ptrStake
-      -- instant stake is guaranteed to be non-zero due to minUTxO, so no need to guard against mempty
+              -- instant stake is guaranteed to be non-zero due to minUTxO,
+              -- therefore usage of 'unsafeNonZero' here is safe.
+              Nothing -> StakeWithDelegation (unsafeNonZero ptrStake) poolId
+              Just swd -> swd {swdStake = unsafeNonZero $ unNonZero (swdStake swd) <> ptrStake}
       pure $ Map.alter plusPtrStake cred acc

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs

@@ -304,7 +304,6 @@ instance Arbitrary FreeVars where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
   shrink = genericShrink
 
 ------------------------------------------------------------------------------------------

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Binary/Golden.hs

@@ -31,7 +31,6 @@ import Cardano.Ledger.TxIn (TxIn)
 import qualified Data.Map.Strict as Map
 import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
-import qualified Data.VMap as VMap
 import Lens.Micro ((&), (.~))
 import Test.Cardano.Ledger.Binary.Golden
 import Test.Cardano.Ledger.Binary.Plain.Golden
@@ -126,9 +125,8 @@ goldenNewEpochStateExpectation
           me = Em [Ev ver k <> Ev ver v | (k, v) <- Map.toList m]
       snapShotEnc SnapShot {..} =
         Em
-          [ E (TkListLen 3)
-          , mapEnc (VMap.toMap (unStake ssActiveStake))
-          , Ev ver ssDelegations
+          [ E (TkListLen 2)
+          , Ev ver ssActiveStake
           , Ev ver ssStakePoolsSnapShot
           ]