{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Ledger.Api.State.Query (
  -- * @GetFilteredDelegationsAndRewardAccounts@
  filterStakePoolDelegsAndRewards,
  queryStakePoolDelegsAndRewards,

  -- * @GetGovState@
  queryGovState,

  -- * @GetConstitution@
  queryConstitution,

  -- * @GetConstitutionHash@
  queryConstitutionHash,

  -- * @GetDRepState@
  queryDRepState,

  -- * @GetDRepStakeDistr@
  queryDRepStakeDistr,

  -- * @GetRegisteredDRepStakeDistr@
  queryRegisteredDRepStakeDistr,

  -- * @GetSPOStakeDistr@
  querySPOStakeDistr,

  -- * @GetCommitteeState@
  queryCommitteeState,

  -- * @GetCommitteeMembersState@
  queryCommitteeMembersState,

  -- * @GetAccountState@
  queryAccountState,
  CommitteeMemberState (..),
  CommitteeMembersState (..),
  HotCredAuthStatus (..),
  MemberStatus (..),
  NextEpochChange (..),

  -- * @GetCurrentPParams@
  queryCurrentPParams,

  -- * @GetFuturePParams@
  queryFuturePParams,

  -- * @GetProposals@
  queryProposals,

  -- * @GetRatifyState@
  queryRatifyState,

  -- * @GetStakePoolDefaultVote
  queryStakePoolDefaultVote,
  DefaultVote (..),

  -- * For testing
  getNextEpochCommitteeMembers,
) where

import Cardano.Ledger.Api.State.Query.CommitteeMembersState (
  CommitteeMemberState (..),
  CommitteeMembersState (..),
  HotCredAuthStatus (..),
  MemberStatus (..),
  NextEpochChange (..),
 )
import Cardano.Ledger.BaseTypes (EpochNo, strictMaybeToMaybe)
import Cardano.Ledger.CertState
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Conway.Governance (
  Committee (committeeMembers),
  Constitution (constitutionAnchor),
  ConwayEraGov (..),
  DRepPulser (..),
  DRepPulsingState (..),
  DefaultVote (..),
  GovActionId,
  GovActionState (..),
  PulsingSnapshot,
  RatifyState,
  committeeThresholdL,
  defaultStakePoolVote,
  ensCommitteeL,
  finishDRepPulser,
  proposalsDeposits,
  psDRepDistr,
  psPoolDistr,
  psProposalsL,
  rsEnactStateL,
 )
import Cardano.Ledger.Conway.Rules (updateDormantDRepExpiry)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Shelley.Governance (EraGov (..), FuturePParams (..))
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.UMap (
  StakeCredentials (scRewards, scSPools),
  UMap,
  dRepMap,
  domRestrictedStakeCredentials,
 )
import Control.Monad (guard)
import Data.Foldable (foldMap')
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isJust)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Sequence.Strict (StrictSeq (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Lens.Micro
import Lens.Micro.Extras (view)

-- | Filter out stake pool delegations and rewards for a set of stake credentials
filterStakePoolDelegsAndRewards ::
  UMap ->
  Set (Credential 'Staking) ->
  (Map (Credential 'Staking) (KeyHash 'StakePool), Map (Credential 'Staking) Coin)
filterStakePoolDelegsAndRewards :: UMap
-> Set (Credential 'Staking)
-> (Map (Credential 'Staking) (KeyHash 'StakePool),
    Map (Credential 'Staking) Coin)
filterStakePoolDelegsAndRewards UMap
umap Set (Credential 'Staking)
creds =
  (StakeCredentials -> Map (Credential 'Staking) (KeyHash 'StakePool)
scSPools StakeCredentials
stakeCredentials, StakeCredentials -> Map (Credential 'Staking) Coin
scRewards StakeCredentials
stakeCredentials)
  where
    stakeCredentials :: StakeCredentials
stakeCredentials = Set (Credential 'Staking) -> UMap -> StakeCredentials
domRestrictedStakeCredentials Set (Credential 'Staking)
creds UMap
umap

-- | Uses `filterStakePoolDelegsAndRewards` to get the same information from the `NewEpochState`
--
-- Implementation for @GetFilteredDelegationsAndRewardAccounts@ query.
queryStakePoolDelegsAndRewards ::
  NewEpochState era ->
  Set (Credential 'Staking) ->
  ( Map (Credential 'Staking) (KeyHash 'StakePool)
  , Map (Credential 'Staking) Coin
  )
queryStakePoolDelegsAndRewards :: forall era.
NewEpochState era
-> Set (Credential 'Staking)
-> (Map (Credential 'Staking) (KeyHash 'StakePool),
    Map (Credential 'Staking) Coin)
queryStakePoolDelegsAndRewards NewEpochState era
nes = UMap
-> Set (Credential 'Staking)
-> (Map (Credential 'Staking) (KeyHash 'StakePool),
    Map (Credential 'Staking) Coin)
filterStakePoolDelegsAndRewards (forall era. DState era -> UMap
dsUnified (forall era. NewEpochState era -> DState era
getDState NewEpochState era
nes))

getDState :: NewEpochState era -> DState era
getDState :: forall era. NewEpochState era -> DState era
getDState = forall era. CertState era -> DState era
certDState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. LedgerState era -> CertState era
lsCertState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EpochState era -> LedgerState era
esLState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. NewEpochState era -> EpochState era
nesEs

queryConstitution :: ConwayEraGov era => NewEpochState era -> Constitution era
queryConstitution :: forall era.
ConwayEraGov era =>
NewEpochState era -> Constitution era
queryConstitution = (forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. NewEpochState era -> GovState era
queryGovState

queryConstitutionHash ::
  ConwayEraGov era =>
  NewEpochState era ->
  SafeHash AnchorData
queryConstitutionHash :: forall era.
ConwayEraGov era =>
NewEpochState era -> SafeHash AnchorData
queryConstitutionHash NewEpochState era
nes =
  Anchor -> SafeHash AnchorData
anchorDataHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Constitution era -> Anchor
constitutionAnchor forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
NewEpochState era -> Constitution era
queryConstitution NewEpochState era
nes

-- | This query returns all of the state related to governance
queryGovState :: NewEpochState era -> GovState era
queryGovState :: forall era. NewEpochState era -> GovState era
queryGovState NewEpochState era
nes = NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (EpochState era)
nesEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL

-- | Query DRep state.
queryDRepState ::
  NewEpochState era ->
  -- | Specify a set of DRep credentials whose state should be returned. When this set is
  -- empty, states for all of the DReps will be returned.
  Set (Credential 'DRepRole) ->
  Map (Credential 'DRepRole) DRepState
queryDRepState :: forall era.
NewEpochState era
-> Set (Credential 'DRepRole)
-> Map (Credential 'DRepRole) DRepState
queryDRepState NewEpochState era
nes Set (Credential 'DRepRole)
creds
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (Credential 'DRepRole)
creds = VState era -> VState era
updateDormantDRepExpiry' VState era
vState forall s a. s -> Getting a s a -> a
^. forall era.
Lens' (VState era) (Map (Credential 'DRepRole) DRepState)
vsDRepsL
  | Bool
otherwise = VState era -> VState era
updateDormantDRepExpiry' VState era
vStateFiltered forall s a. s -> Getting a s a -> a
^. forall era.
Lens' (VState era) (Map (Credential 'DRepRole) DRepState)
vsDRepsL
  where
    vStateFiltered :: VState era
vStateFiltered = VState era
vState forall a b. a -> (a -> b) -> b
& forall era.
Lens' (VState era) (Map (Credential 'DRepRole) DRepState)
vsDRepsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set (Credential 'DRepRole)
creds)
    vState :: VState era
vState = forall era. CertState era -> VState era
certVState forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> CertState era
lsCertState forall a b. (a -> b) -> a -> b
$ forall era. EpochState era -> LedgerState era
esLState forall a b. (a -> b) -> a -> b
$ forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    updateDormantDRepExpiry' :: VState era -> VState era
updateDormantDRepExpiry' = forall era. EpochNo -> VState era -> VState era
updateDormantDRepExpiry (NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) EpochNo
nesELL)

-- | 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 ::
  ConwayEraGov era =>
  NewEpochState era ->
  -- | Specify DRep Ids whose stake distribution should be returned. When this set is
  -- empty, distributions for all of the DReps will be returned.
  Set DRep ->
  Map DRep Coin
queryDRepStakeDistr :: forall era.
ConwayEraGov era =>
NewEpochState era -> Set DRep -> Map DRep Coin
queryDRepStakeDistr NewEpochState era
nes Set DRep
creds
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set DRep
creds = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Compactible a => CompactForm a -> a
fromCompact Map DRep (CompactForm Coin)
distr
  | Bool
otherwise = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Compactible a => CompactForm a -> a
fromCompact forall a b. (a -> b) -> a -> b
$ Map DRep (CompactForm Coin)
distr forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set DRep
creds
  where
    distr :: Map DRep (CompactForm Coin)
distr = forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepDistr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
NewEpochState era -> (PulsingSnapshot era, RatifyState era)
finishedPulserState NewEpochState era
nes

-- | Query the stake distribution of the registered DReps. This does not
-- include the @AlwaysAbstain@ and @NoConfidence@ DReps.
queryRegisteredDRepStakeDistr ::
  ConwayEraGov era =>
  NewEpochState era ->
  -- | Specify DRep Ids whose stake distribution should be returned. When this set is
  -- empty, distributions for all of the registered DReps will be returned.
  Set (Credential 'DRepRole) ->
  Map (Credential 'DRepRole) Coin
queryRegisteredDRepStakeDistr :: forall era.
ConwayEraGov era =>
NewEpochState era
-> Set (Credential 'DRepRole) -> Map (Credential 'DRepRole) Coin
queryRegisteredDRepStakeDistr NewEpochState era
nes Set (Credential 'DRepRole)
creds =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'DRepRole) Coin
-> Credential 'DRepRole
-> DRepState
-> Map (Credential 'DRepRole) Coin
computeDistr forall a. Monoid a => a
mempty Map (Credential 'DRepRole) DRepState
selectedDReps
  where
    selectedDReps :: Map (Credential 'DRepRole) DRepState
selectedDReps
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (Credential 'DRepRole)
creds = Map (Credential 'DRepRole) DRepState
registeredDReps
      | Bool
otherwise = Map (Credential 'DRepRole) DRepState
registeredDReps forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set (Credential 'DRepRole)
creds
    registeredDReps :: Map (Credential 'DRepRole) DRepState
registeredDReps = NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (VState era)
certVStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (VState era) (Map (Credential 'DRepRole) DRepState)
vsDRepsL
    computeDistr :: Map (Credential 'DRepRole) Coin
-> Credential 'DRepRole
-> DRepState
-> Map (Credential 'DRepRole) Coin
computeDistr Map (Credential 'DRepRole) Coin
distrAcc Credential 'DRepRole
dRepCred (DRepState {Set (Credential 'Staking)
StrictMaybe Anchor
Coin
EpochNo
drepExpiry :: DRepState -> EpochNo
drepAnchor :: DRepState -> StrictMaybe Anchor
drepDeposit :: DRepState -> Coin
drepDelegs :: DRepState -> Set (Credential 'Staking)
drepDelegs :: Set (Credential 'Staking)
drepDeposit :: Coin
drepAnchor :: StrictMaybe Anchor
drepExpiry :: EpochNo
..}) =
      forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'DRepRole
dRepCred (Set (Credential 'Staking) -> Coin
totalDelegations Set (Credential 'Staking)
drepDelegs) Map (Credential 'DRepRole) Coin
distrAcc
    totalDelegations :: Set (Credential 'Staking) -> Coin
totalDelegations =
      forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Credential 'Staking -> CompactForm Coin
stakeAndDeposits
    stakeDistr :: Map (Credential 'Staking) (CompactForm Coin)
stakeDistr = NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (EpochState era) (Map (Credential 'Staking) (CompactForm Coin))
epochStateIncrStakeDistrL
    proposalDeposits :: Map (Credential 'Staking) (CompactForm Coin)
proposalDeposits = forall era.
Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
proposalsDeposits forall a b. (a -> b) -> a -> b
$ NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
proposalsGovStateL
    stakeAndDeposits :: Credential 'Staking -> CompactForm Coin
stakeAndDeposits Credential 'Staking
stakeCred =
      forall a. a -> Maybe a -> a
fromMaybe (Word64 -> CompactForm Coin
CompactCoin Word64
0) forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
stakeCred Map (Credential 'Staking) (CompactForm Coin)
stakeDistr forall a. Semigroup a => a -> a -> a
<> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
stakeCred Map (Credential 'Staking) (CompactForm Coin)
proposalDeposits

-- | Query pool stake distribution.
querySPOStakeDistr ::
  ConwayEraGov era =>
  NewEpochState era ->
  Set (KeyHash 'StakePool) ->
  -- | Specify pool key hashes whose stake distribution should be returned. When this set is
  -- empty, distributions for all of the pools will be returned.
  Map (KeyHash 'StakePool) Coin
querySPOStakeDistr :: forall era.
ConwayEraGov era =>
NewEpochState era
-> Set (KeyHash 'StakePool) -> Map (KeyHash 'StakePool) Coin
querySPOStakeDistr NewEpochState era
nes Set (KeyHash 'StakePool)
keys
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (KeyHash 'StakePool)
keys = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Compactible a => CompactForm a -> a
fromCompact Map (KeyHash 'StakePool) (CompactForm Coin)
distr
  | Bool
otherwise = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Compactible a => CompactForm a -> a
fromCompact forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'StakePool) (CompactForm Coin)
distr forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set (KeyHash 'StakePool)
keys
  where
    distr :: Map (KeyHash 'StakePool) (CompactForm Coin)
distr = forall era.
PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
NewEpochState era -> (PulsingSnapshot era, RatifyState era)
finishedPulserState NewEpochState era
nes

-- | Query committee members
queryCommitteeState :: NewEpochState era -> CommitteeState era
queryCommitteeState :: forall era. NewEpochState era -> CommitteeState era
queryCommitteeState NewEpochState era
nes =
  forall era. VState era -> CommitteeState era
vsCommitteeState forall a b. (a -> b) -> a -> b
$ forall era. CertState era -> VState era
certVState forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> CertState era
lsCertState forall a b. (a -> b) -> a -> b
$ forall era. EpochState era -> LedgerState era
esLState forall a b. (a -> b) -> a -> b
$ forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
{-# DEPRECATED queryCommitteeState "In favor of `queryCommitteeMembersState`" #-}

-- | Query committee members. Whenever the system is in No Confidence mode this query will
-- return `Nothing`.
queryCommitteeMembersState ::
  forall era.
  ConwayEraGov era =>
  -- | filter by cold credentials (don't filter when empty)
  Set (Credential 'ColdCommitteeRole) ->
  -- | filter by hot credentials (don't filter when empty)
  Set (Credential 'HotCommitteeRole) ->
  -- | filter by status (don't filter when empty)
  -- (useful, for discovering, for example, only active members)
  Set MemberStatus ->
  NewEpochState era ->
  CommitteeMembersState
queryCommitteeMembersState :: forall era.
ConwayEraGov era =>
Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> CommitteeMembersState
queryCommitteeMembersState Set (Credential 'ColdCommitteeRole)
coldCredsFilter Set (Credential 'HotCommitteeRole)
hotCredsFilter Set MemberStatus
statusFilter NewEpochState era
nes =
  let
    committee :: StrictMaybe (Committee era)
committee = forall era. NewEpochState era -> GovState era
queryGovState NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
    comMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
comMembers = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers StrictMaybe (Committee era)
committee
    nextComMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers = forall era.
ConwayEraGov era =>
NewEpochState era -> Map (Credential 'ColdCommitteeRole) EpochNo
getNextEpochCommitteeMembers NewEpochState era
nes
    comStateMembers :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers =
      forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds forall a b. (a -> b) -> a -> b
$
        NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (EpochState era)
nesEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (VState era)
certVStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (VState era) (CommitteeState era)
vsCommitteeStateL

    withFilteredColdCreds :: Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
withFilteredColdCreds Set (Credential 'ColdCommitteeRole)
s
      | forall a. Set a -> Bool
Set.null Set (Credential 'ColdCommitteeRole)
coldCredsFilter = Set (Credential 'ColdCommitteeRole)
s
      | Bool
otherwise = Set (Credential 'ColdCommitteeRole)
s forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set (Credential 'ColdCommitteeRole)
coldCredsFilter

    relevantColdKeys :: Set (Credential 'ColdCommitteeRole)
relevantColdKeys
      | forall a. Set a -> Bool
Set.null Set MemberStatus
statusFilter Bool -> Bool -> Bool
|| forall a. Ord a => a -> Set a -> Bool
Set.member MemberStatus
Unrecognized Set MemberStatus
statusFilter =
          Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
withFilteredColdCreds forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
              [ forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
comMembers
              , forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers
              , forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers
              ]
      | Bool
otherwise = Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'ColdCommitteeRole)
withFilteredColdCreds forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
comMembers

    relevantHotKeys :: Set (Credential 'ColdCommitteeRole)
relevantHotKeys =
      forall a. Ord a => [a] -> Set a
Set.fromList
        [ Credential 'ColdCommitteeRole
ck
        | (Credential 'ColdCommitteeRole
ck, CommitteeHotCredential Credential 'HotCommitteeRole
hk) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers
        , Credential 'HotCommitteeRole
hk forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Credential 'HotCommitteeRole)
hotCredsFilter
        ]

    relevant :: Set (Credential 'ColdCommitteeRole)
relevant
      | forall a. Set a -> Bool
Set.null Set (Credential 'HotCommitteeRole)
hotCredsFilter = Set (Credential 'ColdCommitteeRole)
relevantColdKeys
      | Bool
otherwise = Set (Credential 'ColdCommitteeRole)
relevantColdKeys forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set (Credential 'ColdCommitteeRole)
relevantHotKeys

    cms :: Map (Credential 'ColdCommitteeRole) CommitteeMemberState
cms = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet Credential 'ColdCommitteeRole -> Maybe CommitteeMemberState
mkMaybeMemberState Set (Credential 'ColdCommitteeRole)
relevant
    currentEpoch :: EpochNo
currentEpoch = NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) EpochNo
nesELL

    mkMaybeMemberState ::
      Credential 'ColdCommitteeRole ->
      Maybe CommitteeMemberState
    mkMaybeMemberState :: Credential 'ColdCommitteeRole -> Maybe CommitteeMemberState
mkMaybeMemberState Credential 'ColdCommitteeRole
coldCred = do
      let mbExpiry :: Maybe EpochNo
mbExpiry = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldCred Map (Credential 'ColdCommitteeRole) EpochNo
comMembers
      let status :: MemberStatus
status = case Maybe EpochNo
mbExpiry of
            Maybe EpochNo
Nothing -> MemberStatus
Unrecognized
            Just EpochNo
expiry
              | EpochNo
currentEpoch forall a. Ord a => a -> a -> Bool
> EpochNo
expiry -> MemberStatus
Expired
              | Bool
otherwise -> MemberStatus
Active
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set MemberStatus
statusFilter Bool -> Bool -> Bool
|| MemberStatus
status forall a. Ord a => a -> Set a -> Bool
`Set.member` Set MemberStatus
statusFilter)
      let hkStatus :: HotCredAuthStatus
hkStatus =
            case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldCred Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers of
              Maybe CommitteeAuthorization
Nothing -> HotCredAuthStatus
MemberNotAuthorized
              Just (CommitteeMemberResigned StrictMaybe Anchor
anchor) -> Maybe Anchor -> HotCredAuthStatus
MemberResigned (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Anchor
anchor)
              Just (CommitteeHotCredential Credential 'HotCommitteeRole
hk) -> Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
hkStatus MemberStatus
status Maybe EpochNo
mbExpiry (Credential 'ColdCommitteeRole -> NextEpochChange
nextEpochChange Credential 'ColdCommitteeRole
coldCred)

    nextEpochChange :: Credential 'ColdCommitteeRole -> NextEpochChange
    nextEpochChange :: Credential 'ColdCommitteeRole -> NextEpochChange
nextEpochChange Credential 'ColdCommitteeRole
ck
      | Bool -> Bool
not Bool
inCurrent Bool -> Bool -> Bool
&& Bool
inNext = NextEpochChange
ToBeEnacted
      | Bool -> Bool
not Bool
inNext = NextEpochChange
ToBeRemoved
      | Just EpochNo
curTerm <- Maybe EpochNo
lookupCurrent
      , Just EpochNo
nextTerm <- Maybe EpochNo
lookupNext
      , EpochNo
curTerm forall a. Eq a => a -> a -> Bool
/= EpochNo
nextTerm
      , -- if the term is adjusted such that it expires in the next epoch,
        -- we set it to ToBeExpired instead of TermAdjusted
        Bool -> Bool
not Bool
expiringNext =
          EpochNo -> NextEpochChange
TermAdjusted EpochNo
nextTerm
      | Bool
expiringCurrent Bool -> Bool -> Bool
|| Bool
expiringNext = NextEpochChange
ToBeExpired
      | Bool
otherwise = NextEpochChange
NoChangeExpected
      where
        lookupCurrent :: Maybe EpochNo
lookupCurrent = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
ck Map (Credential 'ColdCommitteeRole) EpochNo
comMembers
        lookupNext :: Maybe EpochNo
lookupNext = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
ck Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers
        inCurrent :: Bool
inCurrent = forall a. Maybe a -> Bool
isJust Maybe EpochNo
lookupCurrent
        inNext :: Bool
inNext = forall a. Maybe a -> Bool
isJust Maybe EpochNo
lookupNext
        expiringCurrent :: Bool
expiringCurrent = Maybe EpochNo
lookupCurrent forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EpochNo
currentEpoch
        expiringNext :: Bool
expiringNext = Maybe EpochNo
lookupNext forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EpochNo
currentEpoch
   in
    CommitteeMembersState
      { csCommittee :: Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee = Map (Credential 'ColdCommitteeRole) CommitteeMemberState
cms
      , csThreshold :: Maybe UnitInterval
csThreshold = forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe forall a b. (a -> b) -> a -> b
$ (forall s a. s -> Getting a s a -> a
^. forall era. Lens' (Committee era) UnitInterval
committeeThresholdL) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (Committee era)
committee
      , csEpochNo :: EpochNo
csEpochNo = EpochNo
currentEpoch
      }

queryAccountState ::
  NewEpochState era ->
  AccountState
queryAccountState :: forall era. NewEpochState era -> AccountState
queryAccountState = forall a s. Getting a s a -> s -> a
view forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL

getNextEpochCommitteeMembers ::
  ConwayEraGov era =>
  NewEpochState era ->
  Map (Credential 'ColdCommitteeRole) EpochNo
getNextEpochCommitteeMembers :: forall era.
ConwayEraGov era =>
NewEpochState era -> Map (Credential 'ColdCommitteeRole) EpochNo
getNextEpochCommitteeMembers NewEpochState era
nes =
  let ratifyState :: RatifyState era
ratifyState = forall era.
ConwayEraGov era =>
NewEpochState era -> RatifyState era
queryRatifyState NewEpochState era
nes
      committee :: StrictMaybe (Committee era)
committee = RatifyState era
ratifyState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EnactState era) (StrictMaybe (Committee era))
ensCommitteeL
   in forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers StrictMaybe (Committee era)
committee

-- | This is a simple lookup into the state for the values of current protocol
-- parameters. These values can change on the epoch boundary. Use `queryFuturePParams` to
-- see if we are aware of any upcoming changes.
queryCurrentPParams :: EraGov era => NewEpochState era -> PParams era
queryCurrentPParams :: forall era. EraGov era => NewEpochState era -> PParams era
queryCurrentPParams NewEpochState era
nes = forall era. NewEpochState era -> GovState era
queryGovState NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (PParams era)
curPParamsGovStateL

-- | This query will return values for protocol parameters that are likely to be adopted
-- at the next epoch boundary. It is only when we passed 2 stability windows before the
-- end of the epoch that users can rely on this query to produce stable results.
queryFuturePParams :: EraGov era => NewEpochState era -> Maybe (PParams era)
queryFuturePParams :: forall era. EraGov era => NewEpochState era -> Maybe (PParams era)
queryFuturePParams NewEpochState era
nes =
  case forall era. NewEpochState era -> GovState era
queryGovState NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (FuturePParams era)
futurePParamsGovStateL of
    FuturePParams era
NoPParamsUpdate -> forall a. Maybe a
Nothing
    PotentialPParamsUpdate Maybe (PParams era)
mpp -> Maybe (PParams era)
mpp
    DefinitePParamsUpdate PParams era
pp -> forall a. a -> Maybe a
Just PParams era
pp

-- | Query proposals that are considered for ratification.
queryProposals ::
  ConwayEraGov era =>
  NewEpochState era ->
  -- | Specify a set of Governance Action IDs to filter the proposals. When this set is
  -- empty, all the proposals considered for ratification will be returned.
  Set GovActionId ->
  Seq (GovActionState era)
queryProposals :: forall era.
ConwayEraGov era =>
NewEpochState era -> Set GovActionId -> Seq (GovActionState era)
queryProposals NewEpochState era
nes Set GovActionId
gids
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set GovActionId
gids = Seq (GovActionState era)
proposals
  -- TODO: Add `filter` to `cardano-strict-containers`
  | Bool
otherwise =
      forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\GovActionState {Map (KeyHash 'StakePool) Vote
Map (Credential 'DRepRole) Vote
Map (Credential 'HotCommitteeRole) Vote
GovActionId
ProposalProcedure era
EpochNo
gasId :: forall era. GovActionState era -> GovActionId
gasCommitteeVotes :: forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: forall era. GovActionState era -> Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposedIn :: forall era. GovActionState era -> EpochNo
gasExpiresAfter :: forall era. GovActionState era -> EpochNo
gasExpiresAfter :: EpochNo
gasProposedIn :: EpochNo
gasProposalProcedure :: ProposalProcedure era
gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasId :: GovActionId
..} -> GovActionId
gasId forall a. Ord a => a -> Set a -> Bool
`Set.member` Set GovActionId
gids) Seq (GovActionState era)
proposals
  where
    proposals :: Seq (GovActionState era)
proposals = forall a. StrictSeq a -> Seq a
fromStrict forall a b. (a -> b) -> a -> b
$ case NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState era)
drepPulsingStateGovStateL of
      DRComplete PulsingSnapshot era
snap RatifyState era
_rs -> PulsingSnapshot era
snap forall s a. s -> Getting a s a -> a
^. forall era.
Lens' (PulsingSnapshot era) (StrictSeq (GovActionState era))
psProposalsL
      DRPulsing DRepPulser {Int
Map (KeyHash 'StakePool) PoolParams
Map DRep (CompactForm Coin)
Map (Credential 'Staking) (CompactForm Coin)
Map (Credential 'DRepRole) DRepState
StrictSeq (GovActionState era)
EnactState era
CommitteeState era
UMap
PoolDistr
Globals
EpochNo
dpPulseSize :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpUMap :: forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpStakeDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpStakePoolDistr :: forall era ans (m :: * -> *). DRepPulser era m ans -> PoolDistr
dpDRepDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpDRepState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpCurrentEpoch :: forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCommitteeState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpEnactState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpProposals :: forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposalDeposits :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpGlobals :: forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpPoolParams :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (KeyHash 'StakePool) PoolParams
dpPoolParams :: Map (KeyHash 'StakePool) PoolParams
dpGlobals :: Globals
dpProposalDeposits :: Map (Credential 'Staking) (CompactForm Coin)
dpProposals :: StrictSeq (GovActionState era)
dpEnactState :: EnactState era
dpCommitteeState :: CommitteeState era
dpCurrentEpoch :: EpochNo
dpDRepState :: Map (Credential 'DRepRole) DRepState
dpDRepDistr :: Map DRep (CompactForm Coin)
dpStakePoolDistr :: PoolDistr
dpStakeDistr :: Map (Credential 'Staking) (CompactForm Coin)
dpIndex :: Int
dpUMap :: UMap
dpPulseSize :: Int
..} -> StrictSeq (GovActionState era)
dpProposals

-- | Query ratification state.
queryRatifyState :: ConwayEraGov era => NewEpochState era -> RatifyState era
queryRatifyState :: forall era.
ConwayEraGov era =>
NewEpochState era -> RatifyState era
queryRatifyState = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
NewEpochState era -> (PulsingSnapshot era, RatifyState era)
finishedPulserState

finishedPulserState ::
  ConwayEraGov era =>
  NewEpochState era ->
  (PulsingSnapshot era, RatifyState era)
finishedPulserState :: forall era.
ConwayEraGov era =>
NewEpochState era -> (PulsingSnapshot era, RatifyState era)
finishedPulserState NewEpochState era
nes = forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (GovState era)
newEpochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState era)
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 ->
  DefaultVote
queryStakePoolDefaultVote :: forall era. NewEpochState era -> KeyHash 'StakePool -> DefaultVote
queryStakePoolDefaultVote NewEpochState era
nes KeyHash 'StakePool
poolId =
  KeyHash 'StakePool
-> Map (KeyHash 'StakePool) PoolParams
-> Map (Credential 'Staking) DRep
-> DefaultVote
defaultStakePoolVote KeyHash 'StakePool
poolId (NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
epochStatePoolParamsL) (UMap -> Map (Credential 'Staking) DRep
dRepMap forall a b. (a -> b) -> a -> b
$ NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) UMap
unifiedL)