diff --git a/libs/cardano-ledger-api/CHANGELOG.md b/libs/cardano-ledger-api/CHANGELOG.md index a71f66e4669..4aff661289f 100644 --- a/libs/cardano-ledger-api/CHANGELOG.md +++ b/libs/cardano-ledger-api/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.12.0.0 +* Add `queryDRepDelegations` state query * Remove `filterStakePoolDelegsAndRewards` as unnecessary. Use `queryStakePoolDelegsAndRewards` instead * Expose `binaryUpgradeTx`, `binaryUpgradeTxBody`, `binaryUpgradeTxWits`, `binaryUpgradeTxAuxData`, `upgradeTx`, `upgradeTxBody`, `upgradeTxWits`, `upgradeTxAuxData` * Add `EraApi` class diff --git a/libs/cardano-ledger-api/src/Cardano/Ledger/Api/State/Query.hs b/libs/cardano-ledger-api/src/Cardano/Ledger/Api/State/Query.hs index 8134010f0da..0654ae0831b 100644 --- a/libs/cardano-ledger-api/src/Cardano/Ledger/Api/State/Query.hs +++ b/libs/cardano-ledger-api/src/Cardano/Ledger/Api/State/Query.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -19,6 +20,9 @@ module Cardano.Ledger.Api.State.Query ( -- * @GetDRepState@ queryDRepState, + -- * @GetDRepDelegations@ + queryDRepDelegations, + -- * @GetDRepStakeDistr@ queryDRepStakeDistr, @@ -96,7 +100,8 @@ import Cardano.Ledger.Conway.Governance ( import Cardano.Ledger.Conway.Rules (updateDormantDRepExpiry) import Cardano.Ledger.Conway.State import Cardano.Ledger.Core -import Cardano.Ledger.Credential (Credential) +import Cardano.Ledger.Credential (Credential (..)) +import Cardano.Ledger.DRep (credToDRep, dRepToCred) import Cardano.Ledger.Shelley.LedgerState import Control.Monad (guard) import Data.Foldable (foldMap') @@ -156,6 +161,45 @@ queryDRepState nes creds vState = nes ^. nesEsL . esLStateL . lsCertStateL . certVStateL updateDormantDRepExpiry' = updateDormantDRepExpiry (nes ^. nesELL) +-- | Query the delegators delegated to each DRep, including +-- @AlwaysAbstain@ and @NoConfidence@. +queryDRepDelegations :: + forall era. + ConwayEraCertState era => + NewEpochState era -> + -- | Specify a set of DReps whose state should be returned. When this set is + -- empty, states for all of the DReps will be returned. + Set DRep -> + Map DRep (Set (Credential 'Staking)) +queryDRepDelegations nes dreps = + case getDRepCreds dreps of + Just creds -> + Map.map drepDelegs $ + Map.mapKeys credToDRep ((vState ^. vsDRepsL) `Map.restrictKeys` creds) + Nothing -> + -- Whenever predefined `AlwaysAbstain` or `AlwaysNoConfidence` are + -- requested we are forced to iterate over all accounts and find those + -- delegations. + Map.foldlWithKey' + ( \m cred cas -> + case cas ^. dRepDelegationAccountStateL of + Just drep + | Set.null dreps || drep `Set.member` dreps -> + Map.insertWith (<>) drep (Set.singleton cred) m + _ -> + m + ) + Map.empty + (dState ^. accountsL . accountsMapL) + where + dState = nes ^. nesEsL . esLStateL . lsCertStateL . certDStateL + vState = nes ^. nesEsL . esLStateL . lsCertStateL . certVStateL + -- Find all credentials for requested DReps, but only when we don't care + -- about predefined DReps + getDRepCreds ds = do + guard $ not $ Set.null ds + Set.fromList <$> traverse dRepToCred (Set.elems ds) + -- | Query DRep stake distribution. Note that this can be an expensive query because there -- is a chance that current distribution has not been fully computed yet. queryDRepStakeDistr :: diff --git a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs index e81eb54b818..4d5f3eebdb2 100644 --- a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs +++ b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/State/Imp/QuerySpec.hs @@ -14,6 +14,7 @@ import Cardano.Ledger.Api.State.Query ( MemberStatus (..), NextEpochChange (..), queryCommitteeMembersState, + queryDRepDelegations, queryDRepState, ) import Cardano.Ledger.BaseTypes @@ -198,6 +199,39 @@ spec = do expectQueryResult (Set.singleton c1) mempty mempty $ [(c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1Expiry) NoChangeExpected)] + it "queryDRepDelegationState" $ do + (credDrep, delegator, _) <- setupSingleDRep 1_000_000 + + kh <- freshKeyHash + let cred = KeyHashObj kh + _ <- registerStakeCredential cred + _ <- delegateToDRep cred (Coin 2_000_000) DRepAlwaysAbstain + + kh2 <- freshKeyHash + let cred2 = KeyHashObj kh2 + _ <- registerStakeCredential cred2 + _ <- delegateToDRep cred2 (Coin 3_000_000) DRepAlwaysNoConfidence + + let realDRepCred = DRepCredential credDrep + + nes <- getsNES id + let abstainDelegations = + Map.singleton DRepAlwaysAbstain (Set.fromList [cred]) + noConfidenceDelegations = + Map.singleton DRepAlwaysNoConfidence (Set.fromList [cred2]) + realDRepDelegations = Map.singleton realDRepCred (Set.fromList [delegator]) + expectedAllDelegations = + realDRepDelegations + <> abstainDelegations + <> noConfidenceDelegations + queryDRepDelegations nes mempty `shouldBe` expectedAllDelegations + queryDRepDelegations nes (Set.singleton DRepAlwaysAbstain) + `shouldBe` abstainDelegations + queryDRepDelegations nes (Set.singleton DRepAlwaysNoConfidence) + `shouldBe` noConfidenceDelegations + queryDRepDelegations nes (Set.singleton realDRepCred) + `shouldBe` realDRepDelegations + it "Committee queries" $ whenPostBootstrap $ do (drep, _, _) <- setupSingleDRep 1_000_000 (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000 diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index 846c99ce8a6..3723cbce825 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.18.0.0 +* Export `credToDRep` and `dRepToCred` * Deprecate `PoolParams` in favor of `StakePoolState`. #5196 * Move the `PoolParams` module to `Cardano.Ledger.State.StakePool` and export from there. * Add the `StakePoolState` data type to the new module. diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/DRep.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/DRep.hs index dbc16750920..907bf3d5e26 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/DRep.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/DRep.hs @@ -11,6 +11,8 @@ module Cardano.Ledger.DRep ( DRep (DRepCredential, DRepKeyHash, DRepScriptHash, DRepAlwaysAbstain, DRepAlwaysNoConfidence), DRepState (..), + credToDRep, + dRepToCred, drepExpiryL, drepAnchorL, drepDepositL,