at major PV 5, script stake creds can earn rewards

IntersectMBO · Jul 29, 2021 · e88c317 · e88c317
1 parent 30eca73
commit e88c317
Show file tree

Hide file tree

Showing 7 changed files with 33 additions and 15 deletions.
diff --git a/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Pretty.hs b/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Pretty.hs
@@ -515,7 +515,7 @@ ppRewardSnapShot (RewardSnapShot snaps a0 nopt ver non deltaR1 rR deltaT1 total
     ]
 
 ppFreeVars :: FreeVars crypto -> PDoc
-ppFreeVars (FreeVars b1 del stake1 addrs total active asc1 blocks r1 slots d a0 nOpt) =
+ppFreeVars (FreeVars b1 del stake1 addrs total active asc1 blocks r1 slots d a0 nOpt mv) =
   ppRecord
     "FreeVars"
     [ ("b", ppMap ppKeyHash ppNatural b1),
@@ -530,7 +530,8 @@ ppFreeVars (FreeVars b1 del stake1 addrs total active asc1 blocks r1 slots d a0
       ("slotserEpoch", ppEpochSize slots),
       ("d", ppUnitInterval d),
       ("a0", ppRational $ unboundRational a0),
-      ("nOpt", ppNatural nOpt)
+      ("nOpt", ppNatural nOpt),
+      ("mv", ppNatural mv)
     ]
 
 ppAns :: RewardAns crypto -> PDoc

diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/HardForks.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/HardForks.hs
@@ -6,10 +6,12 @@ module Shelley.Spec.Ledger.HardForks
   ( aggregatedRewards,
     allowMIRTransfer,
     validatePoolRewardAccountNetID,
+    allowScriptStakeCredsToEarnRewards,
   )
 where
 
 import GHC.Records
+import Numeric.Natural (Natural)
 import Shelley.Spec.Ledger.PParams (ProtVer (..))
 
 aggregatedRewards ::
@@ -38,3 +40,10 @@ validatePoolRewardAccountNetID ::
   pp ->
   Bool
 validatePoolRewardAccountNetID pp = pvMajor (getField @"_protocolVersion" pp) > 4
+
+-- | Starting with protocol version 5, Stake Credentials bound by scripts
+-- will be eligibile for staking rewards.
+allowScriptStakeCredsToEarnRewards ::
+  Natural ->
+  Bool
+allowScriptStakeCredsToEarnRewards pvM = pvM > 4
diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/LedgerState.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/LedgerState.hs
@@ -1187,6 +1187,7 @@ startStep slotsPerEpoch b@(BlocksMade b') es@(EpochState acnt ss ls pr _ nm) max
           (getField @"_d" pr)
           (getField @"_a0" pr)
           (getField @"_nOpt" pr)
+          (pvMajor $ getField @"_protocolVersion" pr)
       pulser :: Pulser (Crypto era)
       pulser =
         RSLP

diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/RewardUpdate.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/RewardUpdate.hs
@@ -223,7 +223,8 @@ data FreeVars crypto = FreeVars
     slotsPerEpoch :: !EpochSize,
     pp_d :: !UnitInterval, -- The last three fields come from some version of PParams
     pp_a0 :: !NonNegativeInterval,
-    pp_nOpt :: !Natural
+    pp_nOpt :: !Natural,
+    pp_mv :: !Natural
   }
   deriving (Eq, Show, Generic)
   deriving (NoThunks)
@@ -245,7 +246,8 @@ instance (CC.Crypto crypto) => ToCBOR (FreeVars crypto) where
           slotsPerEpoch,
           pp_d,
           pp_a0,
-          pp_nOpt
+          pp_nOpt,
+          pp_mv
         }
       ) =
       encode
@@ -259,6 +261,7 @@ instance (CC.Crypto crypto) => ToCBOR (FreeVars crypto) where
             !> To pp_d
             !> E boundedRationalToCBOR pp_a0
             !> To pp_nOpt
+            !> To pp_mv
         )
 
 instance (CC.Crypto crypto) => FromCBOR (FreeVars crypto) where
@@ -274,6 +277,7 @@ instance (CC.Crypto crypto) => FromCBOR (FreeVars crypto) where
           <! From {- pp_d -}
           <! D boundedRationalFromCBOR {- pp_a0 -}
           <! From {- pp_nOpt -}
+          <! From {- pp_mv -}
       )
 
 -- =====================================================================
@@ -299,7 +303,8 @@ rewardStakePool
         slotsPerEpoch,
         pp_d,
         pp_a0,
-        pp_nOpt
+        pp_nOpt,
+        pp_mv
       }
     )
   (RewardAns m1 m2)
@@ -318,7 +323,7 @@ rewardStakePool
     case blocksProduced of
       Nothing -> pure $ RewardAns m1 (Map.insert hk ls m2)
       Just n -> do
-        m <- rewardOnePool (pp_d, pp_a0, pp_nOpt) r n totalBlocks pparams actgr sigma sigmaA (Coin totalStake) addrsRew
+        m <- rewardOnePool (pp_d, pp_a0, pp_nOpt, pp_mv) r n totalBlocks pparams actgr sigma sigmaA (Coin totalStake) addrsRew
         pure $ RewardAns (Map.unionWith Set.union m m1) (Map.insert hk ls m2)
 
 -- ================================================================

diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Rewards.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/Rewards.hs
@@ -464,7 +464,7 @@ aggregateRewards pp rewards =
 rewardOnePool ::
   forall c m.
   Monad m =>
-  (UnitInterval, NonNegativeInterval, Natural) ->
+  (UnitInterval, NonNegativeInterval, Natural, Natural) ->
   Coin ->
   Natural ->
   Natural ->
@@ -479,7 +479,8 @@ rewardOnePool ::
     m
     (Map (Credential 'Staking c) (Set (Reward c)))
 rewardOnePool
-  (pp_d, pp_a0, pp_nOpt) -- (Decentralization parameter, Pool influence, Desired number of pools)
+  (pp_d, pp_a0, pp_nOpt, pp_mv)
+  -- (Decentralization parameter, Pool influence, Desired number of pools, major version)
   r
   blocksN
   blocksTotal
@@ -523,7 +524,7 @@ rewardOnePool
               hk `Set.member` addrsRew
           ]
       notPoolOwner (KeyHashObj hk) = hk `Set.notMember` _poolOwners pool
-      notPoolOwner (ScriptHashObj _) = False
+      notPoolOwner (ScriptHashObj _) = HardForks.allowScriptStakeCredsToEarnRewards pp_mv
       lReward =
         leaderRew
           poolR

diff --git a/...shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Serialisation/EraIndepGenerators.hs b/...shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Serialisation/EraIndepGenerators.hs
@@ -993,6 +993,7 @@ instance
       <*> arbitrary {- pp_d -}
       <*> arbitrary {- pp_a0 -}
       <*> arbitrary {- pp_nOpt -}
+      <*> arbitrary {- pp_mv -}
 
 instance
   Mock crypto =>

diff --git a/shelley/chain-and-ledger/shelley-spec-ledger-test/test/Test/Shelley/Spec/Ledger/Rewards.hs b/shelley/chain-and-ledger/shelley-spec-ledger-test/test/Test/Shelley/Spec/Ledger/Rewards.hs
@@ -323,7 +323,7 @@ rewardsBoundedByPot _ = property $ do
         runShelleyBase $
           runProvM $
             reward
-              (_d pp, _a0 pp, _nOpt pp)
+              (_d pp, _a0 pp, _nOpt pp, pvMajor (_protocolVersion pp))
               bs
               rewardPot
               rewardAcnts
@@ -391,7 +391,7 @@ rewardsProvenance _ = generate $ do
         runShelleyBase $
           runWithProvM def $
             reward
-              (_d pp, _a0 pp, _nOpt pp)
+              (_d pp, _a0 pp, _nOpt pp, pvMajor (_protocolVersion pp))
               bs
               rewardPot
               rewardAcnts
@@ -749,7 +749,7 @@ newEpochProp tracelen propf = withMaxSuccess 100 $
 
 reward ::
   forall crypto.
-  (UnitInterval, NonNegativeInterval, Natural) ->
+  (UnitInterval, NonNegativeInterval, Natural, Natural) ->
   BlocksMade crypto ->
   Coin ->
   Set (Credential 'Staking crypto) ->
@@ -765,7 +765,7 @@ reward pp bm r addrsRew poolParams stake delegs tot asc slotsPerEpoch =
 
 rewardPulser ::
   forall c.
-  (UnitInterval, NonNegativeInterval, Natural) ->
+  (UnitInterval, NonNegativeInterval, Natural, Natural) ->
   BlocksMade c ->
   Coin ->
   Set (Credential 'Staking c) ->
@@ -777,7 +777,7 @@ rewardPulser ::
   EpochSize ->
   Pulser c
 rewardPulser
-  (pp_d, pp_a0, pp_nOpt)
+  (pp_d, pp_a0, pp_nOpt, pp_mv)
   (BlocksMade b)
   r
   addrsRew
@@ -790,7 +790,7 @@ rewardPulser
     where
       totalBlocks = sum b
       Coin activeStake = fold . unStake $ stake
-      free = (FreeVars b delegs stake addrsRew totalStake activeStake asc totalBlocks r slotsPerEpoch pp_d pp_a0 pp_nOpt)
+      free = (FreeVars b delegs stake addrsRew totalStake activeStake asc totalBlocks r slotsPerEpoch pp_d pp_a0 pp_nOpt pp_mv)
       pulser :: Pulser c
       pulser = RSLP 2 free (StrictSeq.fromList $ Map.elems poolParams) (RewardAns Map.empty Map.empty)