{-# 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,

  -- * @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)
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,
  psDRepDistr,
  psPoolDistr,
  psProposalsL,
  rsEnactStateL,
 )
import Cardano.Ledger.Conway.Rules (updateDormantDRepExpiry)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Cardano.Ledger.SafeHash (SafeHash)
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 (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 c ->
  Set (Credential 'Staking c) ->
  (Map (Credential 'Staking c) (KeyHash 'StakePool c), Map (Credential 'Staking c) Coin)
filterStakePoolDelegsAndRewards :: forall c.
UMap c
-> Set (Credential 'Staking c)
-> (Map (Credential 'Staking c) (KeyHash 'StakePool c),
    Map (Credential 'Staking c) Coin)
filterStakePoolDelegsAndRewards UMap c
umap Set (Credential 'Staking c)
creds =
  (forall c.
StakeCredentials c
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
scSPools StakeCredentials c
stakeCredentials, forall c. StakeCredentials c -> Map (Credential 'Staking c) Coin
scRewards StakeCredentials c
stakeCredentials)
  where
    stakeCredentials :: StakeCredentials c
stakeCredentials = forall c.
Set (Credential 'Staking c) -> UMap c -> StakeCredentials c
domRestrictedStakeCredentials Set (Credential 'Staking c)
creds UMap c
umap

-- | Uses `filterStakePoolDelegsAndRewards` to get the same information from the `NewEpochState`
--
-- Implementation for @GetFilteredDelegationsAndRewardAccounts@ query.
queryStakePoolDelegsAndRewards ::
  NewEpochState era ->
  Set (Credential 'Staking (EraCrypto era)) ->
  ( Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era))
  , Map (Credential 'Staking (EraCrypto era)) Coin
  )
queryStakePoolDelegsAndRewards :: forall era.
NewEpochState era
-> Set (Credential 'Staking (EraCrypto era))
-> (Map
      (Credential 'Staking (EraCrypto era))
      (KeyHash 'StakePool (EraCrypto era)),
    Map (Credential 'Staking (EraCrypto era)) Coin)
queryStakePoolDelegsAndRewards NewEpochState era
nes = forall c.
UMap c
-> Set (Credential 'Staking c)
-> (Map (Credential 'Staking c) (KeyHash 'StakePool c),
    Map (Credential 'Staking c) Coin)
filterStakePoolDelegsAndRewards (forall era. DState era -> UMap (EraCrypto era)
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 (EraCrypto era) AnchorData
queryConstitutionHash :: forall era.
ConwayEraGov era =>
NewEpochState era -> SafeHash (EraCrypto era) AnchorData
queryConstitutionHash NewEpochState era
nes =
  forall c. Anchor c -> SafeHash c AnchorData
anchorDataHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Constitution era -> Anchor (EraCrypto era)
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 (EraCrypto era)) ->
  Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
queryDRepState :: forall era.
NewEpochState era
-> Set (Credential 'DRepRole (EraCrypto era))
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
queryDRepState NewEpochState era
nes Set (Credential 'DRepRole (EraCrypto era))
creds
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (Credential 'DRepRole (EraCrypto era))
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 (EraCrypto era)) (DRepState (EraCrypto era)))
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 (EraCrypto era)) (DRepState (EraCrypto era)))
vsDRepsL
  where
    vStateFiltered :: VState era
vStateFiltered = VState era
vState forall a b. a -> (a -> b) -> b
& forall era.
Lens'
  (VState era)
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
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 (EraCrypto era))
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 (EraCrypto era)) ->
  Map (DRep (EraCrypto era)) Coin
queryDRepStakeDistr :: forall era.
ConwayEraGov era =>
NewEpochState era
-> Set (DRep (EraCrypto era)) -> Map (DRep (EraCrypto era)) Coin
queryDRepStakeDistr NewEpochState era
nes Set (DRep (EraCrypto era))
creds
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (DRep (EraCrypto era))
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 (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
distr forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set (DRep (EraCrypto era))
creds
  where
    distr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
distr = forall era.
PulsingSnapshot era
-> Map (DRep (EraCrypto era)) (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 pool stake distribution.
querySPOStakeDistr ::
  ConwayEraGov era =>
  NewEpochState era ->
  Set (KeyHash 'StakePool (EraCrypto era)) ->
  -- | 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 (EraCrypto era)) Coin
querySPOStakeDistr :: forall era.
ConwayEraGov era =>
NewEpochState era
-> Set (KeyHash 'StakePool (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) Coin
querySPOStakeDistr NewEpochState era
nes Set (KeyHash 'StakePool (EraCrypto era))
keys
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (KeyHash 'StakePool (EraCrypto era))
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 (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
distr forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set (KeyHash 'StakePool (EraCrypto era))
keys
  where
    distr :: Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
distr = forall era.
PulsingSnapshot era
-> Map (KeyHash 'StakePool (EraCrypto era)) (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 (EraCrypto era)) ->
  -- | filter by hot credentials (don't filter when empty)
  Set (Credential 'HotCommitteeRole (EraCrypto era)) ->
  -- | filter by status (don't filter when empty)
  -- (useful, for discovering, for example, only active members)
  Set MemberStatus ->
  NewEpochState era ->
  CommitteeMembersState (EraCrypto era)
queryCommitteeMembersState :: forall era.
ConwayEraGov era =>
Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Set (Credential 'HotCommitteeRole (EraCrypto era))
-> Set MemberStatus
-> NewEpochState era
-> CommitteeMembersState (EraCrypto era)
queryCommitteeMembersState Set (Credential 'ColdCommitteeRole (EraCrypto era))
coldCredsFilter Set (Credential 'HotCommitteeRole (EraCrypto era))
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 (EraCrypto era)) EpochNo
comMembers = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' forall era.
Committee era
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
committeeMembers StrictMaybe (Committee era)
committee
    nextComMembers :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
nextComMembers = forall era.
ConwayEraGov era =>
NewEpochState era
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
getNextEpochCommitteeMembers NewEpochState era
nes
    comStateMembers :: Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
comStateMembers =
      forall era.
CommitteeState era
-> Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era))
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 (EraCrypto era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
withFilteredColdCreds Set (Credential 'ColdCommitteeRole (EraCrypto era))
s
      | forall a. Set a -> Bool
Set.null Set (Credential 'ColdCommitteeRole (EraCrypto era))
coldCredsFilter = Set (Credential 'ColdCommitteeRole (EraCrypto era))
s
      | Bool
otherwise = Set (Credential 'ColdCommitteeRole (EraCrypto era))
s forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set (Credential 'ColdCommitteeRole (EraCrypto era))
coldCredsFilter

    relevantColdKeys :: Set (Credential 'ColdCommitteeRole (EraCrypto era))
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 (EraCrypto era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
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 (EraCrypto era)) EpochNo
comMembers
              , forall k a. Map k a -> Set k
Map.keysSet Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
comStateMembers
              , forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
nextComMembers
              ]
      | Bool
otherwise = Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
withFilteredColdCreds forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
comMembers

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

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

    cms :: Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeMemberState (EraCrypto era))
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 (EraCrypto era)
-> Maybe (CommitteeMemberState (EraCrypto era))
mkMaybeMemberState Set (Credential 'ColdCommitteeRole (EraCrypto era))
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 (EraCrypto era) ->
      Maybe (CommitteeMemberState (EraCrypto era))
    mkMaybeMemberState :: Credential 'ColdCommitteeRole (EraCrypto era)
-> Maybe (CommitteeMemberState (EraCrypto era))
mkMaybeMemberState Credential 'ColdCommitteeRole (EraCrypto era)
coldCred = do
      let mbExpiry :: Maybe EpochNo
mbExpiry = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole (EraCrypto era)
coldCred Map (Credential 'ColdCommitteeRole (EraCrypto era)) 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 (EraCrypto era)
hkStatus =
            case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole (EraCrypto era)
coldCred Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
comStateMembers of
              Maybe (CommitteeAuthorization (EraCrypto era))
Nothing -> forall c. HotCredAuthStatus c
MemberNotAuthorized
              Just (CommitteeMemberResigned StrictMaybe (Anchor (EraCrypto era))
anchor) -> forall c. Maybe (Anchor c) -> HotCredAuthStatus c
MemberResigned (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (Anchor (EraCrypto era))
anchor)
              Just (CommitteeHotCredential Credential 'HotCommitteeRole (EraCrypto era)
hk) -> forall c. Credential 'HotCommitteeRole c -> HotCredAuthStatus c
MemberAuthorized Credential 'HotCommitteeRole (EraCrypto era)
hk
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall c.
HotCredAuthStatus c
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState c
CommitteeMemberState HotCredAuthStatus (EraCrypto era)
hkStatus MemberStatus
status Maybe EpochNo
mbExpiry (Credential 'ColdCommitteeRole (EraCrypto era) -> NextEpochChange
nextEpochChange Credential 'ColdCommitteeRole (EraCrypto era)
coldCred)

    nextEpochChange :: Credential 'ColdCommitteeRole (EraCrypto era) -> NextEpochChange
    nextEpochChange :: Credential 'ColdCommitteeRole (EraCrypto era) -> NextEpochChange
nextEpochChange Credential 'ColdCommitteeRole (EraCrypto era)
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 (EraCrypto era)
ck Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
comMembers
        lookupNext :: Maybe EpochNo
lookupNext = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole (EraCrypto era)
ck Map (Credential 'ColdCommitteeRole (EraCrypto era)) 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 (EraCrypto era))
  (CommitteeMemberState (EraCrypto era))
csCommittee = Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeMemberState (EraCrypto era))
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 (EraCrypto era)) EpochNo
getNextEpochCommitteeMembers :: forall era.
ConwayEraGov era =>
NewEpochState era
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) 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 (EraCrypto era)) 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 (EraCrypto era)) ->
  Seq (GovActionState era)
queryProposals :: forall era.
ConwayEraGov era =>
NewEpochState era
-> Set (GovActionId (EraCrypto era)) -> Seq (GovActionState era)
queryProposals NewEpochState era
nes Set (GovActionId (EraCrypto era))
gids
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (GovActionId (EraCrypto era))
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 (Credential 'HotCommitteeRole (EraCrypto era)) Vote
Map (Credential 'DRepRole (EraCrypto era)) Vote
Map (KeyHash 'StakePool (EraCrypto era)) Vote
GovActionId (EraCrypto era)
ProposalProcedure era
EpochNo
gasId :: forall era. GovActionState era -> GovActionId (EraCrypto era)
gasCommitteeVotes :: forall era.
GovActionState era
-> Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
gasDRepVotes :: forall era.
GovActionState era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
gasStakePoolVotes :: forall era.
GovActionState era -> Map (KeyHash 'StakePool (EraCrypto era)) 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 (EraCrypto era)) Vote
gasDRepVotes :: Map (Credential 'DRepRole (EraCrypto era)) Vote
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
gasId :: GovActionId (EraCrypto era)
..} -> GovActionId (EraCrypto era)
gasId forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (GovActionId (EraCrypto era))
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 (DRep (EraCrypto era)) (CompactForm Coin)
Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
StrictSeq (GovActionState era)
EnactState era
CommitteeState era
UMap (EraCrypto era)
PoolDistr (EraCrypto era)
Globals
EpochNo
dpPulseSize :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpUMap :: forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpStakeDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpStakePoolDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans -> PoolDistr (EraCrypto era)
dpDRepDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
dpDRepState :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
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 (EraCrypto era)) (CompactForm Coin)
dpGlobals :: forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpPoolParams :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpPoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpGlobals :: Globals
dpProposalDeposits :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpProposals :: StrictSeq (GovActionState era)
dpEnactState :: EnactState era
dpCommitteeState :: CommitteeState era
dpCurrentEpoch :: EpochNo
dpDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
dpStakePoolDistr :: PoolDistr (EraCrypto era)
dpStakeDistr :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpIndex :: Int
dpUMap :: UMap (EraCrypto era)
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 (EraCrypto era) ->
  DefaultVote
queryStakePoolDefaultVote :: forall era.
NewEpochState era
-> KeyHash 'StakePool (EraCrypto era) -> DefaultVote
queryStakePoolDefaultVote NewEpochState era
nes KeyHash 'StakePool (EraCrypto era)
poolId =
  forall c.
KeyHash 'StakePool c
-> Map (KeyHash 'StakePool c) (PoolParams c)
-> Map (Credential 'Staking c) (DRep c)
-> DefaultVote
defaultStakePoolVote KeyHash 'StakePool (EraCrypto era)
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 (EraCrypto era)) (PoolParams (EraCrypto era)))
epochStatePoolParamsL) (forall c. UMap c -> Map (Credential 'Staking c) (DRep c)
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 (EraCrypto era))
unifiedL)