Merge pull request #4735 from IntersectMBO/ldan/spo-delegation-query

Add `queryStakePoolDefaultVote` state query

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.18.0.0
 
+* Add `DefaultVote` and `defaultStakePoolVote`
 * Add new event `GovRemovedVotes` for invalidated votes.
 
 ### `testlib`

eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -161,6 +162,8 @@ module Cardano.Ledger.Conway.Governance (
   reDRepStateL,
   reCurrentEpochL,
   reCommitteeStateL,
+  DefaultVote (..),
+  defaultStakePoolVote,
 
   -- * Exported for testing
   pparamsUpdateThreshold,
@@ -170,6 +173,7 @@ module Cardano.Ledger.Conway.Governance (
   showGovActionType,
 ) where
 
+import Cardano.Ledger.Address (RewardAccount (raCredential))
 import Cardano.Ledger.BaseTypes (
   EpochNo (..),
   Globals (..),
@@ -199,9 +203,12 @@ import Cardano.Ledger.Conway.Governance.Internal
 import Cardano.Ledger.Conway.Governance.Procedures
 import Cardano.Ledger.Conway.Governance.Proposals
 import Cardano.Ledger.Core
+import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.DRep (DRep (..))
+import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
 import Cardano.Ledger.PoolDistr (PoolDistr (..))
+import Cardano.Ledger.PoolParams (PoolParams (ppRewardAccount))
 import Cardano.Ledger.Shelley.Governance
 import Cardano.Ledger.Shelley.LedgerState (
   EpochState (..),
@@ -504,3 +511,33 @@ setFreshDRepPulsingState epochNo stakePoolDistr epochState = do
 -- point. Whenever pulser is already in computed state this will be a noop.
 forceDRepPulsingState :: ConwayEraGov era => NewEpochState era -> NewEpochState era
 forceDRepPulsingState nes = nes & newEpochStateDRepPulsingStateL %~ completeDRepPulsingState
+
+-- | Default vote that will be used for Stake Pool.
+data DefaultVote
+  = -- | Reward account is delegated to a @DRepKeyHash@, @DRepScriptHash@ or undelegated:
+    --   default vote is @No@.
+    DefaultNo
+  | -- | Reward account is delegated to @DRepAlwaysAbstain@:
+    --   default vote is @Abstain@, except for @HardForkInitiation@ actions.
+    DefaultAbstain
+  | -- | Reward account is delegated to @DRepAlwaysNoConfidence@:
+    --   default vote is @Yes@ in case of a @NoConfidence@ action, otherwise @No@.
+    DefaultNoConfidence
+  deriving (Eq, Show)
+
+defaultStakePoolVote ::
+  -- | Specify the key hash of the pool whose default vote should be returned.
+  KeyHash 'StakePool c ->
+  -- | Registered Stake Pools
+  Map (KeyHash 'StakePool c) (PoolParams c) ->
+  -- | Delegations of staking credneitals to a DRep
+  Map (Credential 'Staking c) (DRep c) ->
+  DefaultVote
+defaultStakePoolVote poolId poolParams dRepDelegations =
+  toDefaultVote $
+    Map.lookup poolId poolParams >>= \d ->
+      Map.lookup (raCredential $ ppRewardAccount d) dRepDelegations
+  where
+    toDefaultVote (Just DRepAlwaysAbstain) = DefaultAbstain
+    toDefaultVote (Just DRepAlwaysNoConfidence) = DefaultNoConfidence
+    toDefaultVote _ = DefaultNo

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs

@@ -27,7 +27,6 @@ module Cardano.Ledger.Conway.Rules.Ratify (
   withdrawalCanWithdraw,
 ) where
 
-import Cardano.Ledger.Address (RewardAccount (..))
 import Cardano.Ledger.BaseTypes (
   BoundedRational (..),
   ProtVer,
@@ -46,6 +45,7 @@ import Cardano.Ledger.Conway.Core (
 import Cardano.Ledger.Conway.Era (ConwayENACT, ConwayRATIFY)
 import Cardano.Ledger.Conway.Governance (
   Committee (..),
+  DefaultVote (..),
   GovAction (..),
   GovActionState (..),
   GovRelation,
@@ -54,6 +54,7 @@ import Cardano.Ledger.Conway.Governance (
   RatifySignal (..),
   RatifyState (..),
   Vote (..),
+  defaultStakePoolVote,
   ensCommitteeL,
   ensProtVerL,
   ensTreasuryL,
@@ -76,7 +77,6 @@ import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.DRep (DRep (..), DRepState (..))
 import Cardano.Ledger.Keys (KeyRole (..))
 import Cardano.Ledger.PoolDistr (PoolDistr (..), individualTotalPoolStake)
-import Cardano.Ledger.PoolParams (PoolParams (..))
 import Cardano.Ledger.Shelley.HardForks (bootstrapPhase)
 import Cardano.Ledger.Slot (EpochNo (..))
 import Cardano.Ledger.Val (Val (..), (<+>))
@@ -218,18 +218,15 @@ spoAcceptedRatio
       accumStake (!yes, !abstain) poolId distr =
         let CompactCoin stake = individualTotalPoolStake distr
             vote = Map.lookup poolId gasStakePoolVotes
-            drep =
-              Map.lookup poolId rePoolParams >>= \d ->
-                Map.lookup (raCredential $ ppRewardAccount d) reDelegatees
          in case vote of
               Nothing
                 | HardForkInitiation {} <- pProcGovAction -> (yes, abstain)
                 | bootstrapPhase pv -> (yes, abstain + stake)
-                | otherwise -> case drep of
-                    Just DRepAlwaysNoConfidence
+                | otherwise -> case defaultStakePoolVote poolId rePoolParams reDelegatees of
+                    DefaultNoConfidence
                       | NoConfidence {} <- pProcGovAction -> (yes + stake, abstain)
-                    Just DRepAlwaysAbstain -> (yes, abstain + stake)
-                    _ -> (yes, abstain)
+                    DefaultAbstain -> (yes, abstain + stake)
+                    _ -> (yes, abstain) -- Default is No, unless overridden by one of the above cases
               Just Abstain -> (yes, abstain + stake)
               Just VoteNo -> (yes, abstain)
               Just VoteYes -> (yes + stake, abstain)

libs/cardano-ledger-api/CHANGELOG.md

@@ -1,8 +1,8 @@
 # Version history for `cardano-ledger-api`
 
-## 1.9.4.1
+## 1.9.5.0
 
-*
+* Added `queryStakePoolDefaultVote` state query and its return type `DefaultVote`
 
 ## 1.9.4.0
 

libs/cardano-ledger-api/cardano-ledger-api.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               cardano-ledger-api
-version:            1.9.4.0
+version:            1.9.5.0
 license:            Apache-2.0
 maintainer:         operations@iohk.io
 author:             IOHK

libs/cardano-ledger-api/src/Cardano/Ledger/Api/State/Query.hs

@@ -52,6 +52,10 @@ module Cardano.Ledger.Api.State.Query (
   -- * @GetRatifyState@
   queryRatifyState,
 
+  -- * @GetStakePoolDefaultVote
+  queryStakePoolDefaultVote,
+  DefaultVote (..),
+
   -- * For testing
   getNextEpochCommitteeMembers,
 ) where
@@ -73,11 +77,13 @@ import Cardano.Ledger.Conway.Governance (
   ConwayEraGov (..),
   DRepPulser (..),
   DRepPulsingState (..),
+  DefaultVote (..),
   GovActionId,
   GovActionState (..),
   PulsingSnapshot,
   RatifyState,
   committeeThresholdL,
+  defaultStakePoolVote,
   ensCommitteeL,
   finishDRepPulser,
   psDRepDistr,
@@ -95,6 +101,7 @@ import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.UMap (
   StakeCredentials (scRewards, scSPools),
   UMap,
+  dRepMap,
   domRestrictedStakeCredentials,
  )
 import Control.Monad (guard)
@@ -351,3 +358,14 @@ finishedPulserState ::
   NewEpochState era ->
   (PulsingSnapshot era, RatifyState era)
 finishedPulserState nes = finishDRepPulser (nes ^. newEpochStateGovStateL . drepPulsingStateGovStateL)
+
+-- | Query a stake pool's reward account delegatee which determines the pool's default vote
+-- in absence of an explicit vote. Note that this is different from the delegatee determined
+-- by the credential of the stake pool itself.
+queryStakePoolDefaultVote ::
+  NewEpochState era ->
+  -- | Specify the key hash of the pool whose default vote should be returned.
+  KeyHash 'StakePool (EraCrypto era) ->
+  DefaultVote
+queryStakePoolDefaultVote nes poolId =
+  defaultStakePoolVote poolId (nes ^. nesEsL . epochStatePoolParamsL) (dRepMap $ nes ^. unifiedL)