{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Governance (
  EraGov (..),
  EnactState (..),
  RatifyState (..),
  RatifyEnv (..),
  RatifySignal (..),
  ConwayGovState (..),
  predictFuturePParams,
  Committee (..),
  committeeMembersL,
  committeeThresholdL,
  authorizedElectedHotCommitteeCredentials,
  GovAction (..),
  GovActionState (..),
  GovActionIx (..),
  GovActionId (..),
  GovActionPurpose (..),
  ToGovActionPurpose,
  isGovActionWithPurpose,
  DRepPulsingState (..),
  DRepPulser (..),
  govActionIdToText,
  Voter (..),
  Vote (..),
  VotingProcedure (..),
  VotingProcedures (..),
  foldlVotingProcedures,
  foldrVotingProcedures,
  ProposalProcedure (..),
  Anchor (..),
  AnchorData (..),
  indexedGovProps,
  Constitution (..),
  ConwayEraGov (..),
  votingStakePoolThreshold,
  votingDRepThreshold,
  votingCommitteeThreshold,
  isStakePoolVotingAllowed,
  isDRepVotingAllowed,
  isCommitteeVotingAllowed,
  reorderActions,
  actionPriority,
  Proposals,
  mkProposals,
  unsafeMkProposals,
  GovPurposeId (..),
  PRoot (..),
  PEdges (..),
  PGraph (..),
  pRootsL,
  pPropsL,
  prRootL,
  prChildrenL,
  peChildrenL,
  pGraphL,
  pGraphNodesL,
  GovRelation (..),
  hoistGovRelation,
  withGovActionParent,
  toPrevGovActionIds,
  fromPrevGovActionIds,
  grPParamUpdateL,
  grHardForkL,
  grCommitteeL,
  grConstitutionL,
  proposalsActions,
  proposalsDeposits,
  proposalsAddAction,
  proposalsRemoveWithDescendants,
  proposalsAddVote,
  proposalsIds,
  proposalsApplyEnactment,
  proposalsSize,
  proposalsLookupId,
  proposalsActionsMap,
  proposalsWithPurpose,
  cgsProposalsL,
  cgsDRepPulsingStateL,
  cgsCurPParamsL,
  cgsPrevPParamsL,
  cgsFuturePParamsL,
  cgsCommitteeL,
  cgsConstitutionL,
  ensCommitteeL,
  ensConstitutionL,
  ensCurPParamsL,
  ensPrevPParamsL,
  ensWithdrawalsL,
  ensTreasuryL,
  ensPrevGovActionIdsL,
  ensPrevPParamUpdateL,
  ensPrevHardForkL,
  ensPrevCommitteeL,
  ensPrevConstitutionL,
  ensProtVerL,
  rsEnactStateL,
  rsExpiredL,
  rsEnactedL,
  rsDelayedL,
  constitutionScriptL,
  constitutionAnchorL,
  gasIdL,
  gasDepositL,
  gasCommitteeVotesL,
  gasDRepVotesL,
  gasStakePoolVotesL,
  gasExpiresAfterL,
  gasActionL,
  gasReturnAddrL,
  gasProposedInL,
  gasProposalProcedureL,
  gasDeposit,
  gasAction,
  gasReturnAddr,
  pProcDepositL,
  pProcGovActionL,
  pProcReturnAddrL,
  pProcAnchorL,
  newEpochStateDRepPulsingStateL,
  epochStateDRepPulsingStateL,
  epochStateStakeDistrL,
  epochStateRegDrepL,
  epochStateUMapL,
  pulseDRepPulsingState,
  completeDRepPulsingState,
  extractDRepPulsingState,
  forceDRepPulsingState,
  finishDRepPulser,
  computeDRepDistr,
  getRatifyState,
  conwayGovStateDRepDistrG,
  psDRepDistrG,
  PulsingSnapshot (..),
  setCompleteDRepPulsingState,
  setFreshDRepPulsingState,
  psProposalsL,
  psDRepDistrL,
  psDRepStateL,
  psPoolDistrL,
  RunConwayRatify (..),
  govStatePrevGovActionIds,
  mkEnactState,
  ratifySignalL,
  reDRepDistrL,
  reDRepStateL,
  reCurrentEpochL,
  reCommitteeStateL,
  DefaultVote (..),
  defaultStakePoolVote,

  -- * Exported for testing
  pparamsUpdateThreshold,
  TreeMaybe (..),
  toGovRelationTree,
  toGovRelationTreeEither,
  showGovActionType,
) where

import Cardano.Ledger.Address (RewardAccount (raCredential))
import Cardano.Ledger.BaseTypes (
  EpochNo (..),
  Globals (..),
  StrictMaybe (..),
  knownNonZero,
  mulNonZero,
  toIntegerNonZero,
  (%.),
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  Interns,
  ToCBOR (..),
  decNoShareCBOR,
  decodeRecordNamedT,
 )
import Cardano.Ledger.Binary.Coders (
  Encode (..),
  encode,
  (!>),
 )
import Cardano.Ledger.Binary.Plain (
  decodeWord8,
  encodeWord8,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Era (ConwayEra)
import Cardano.Ledger.Conway.Governance.DRepPulser
import Cardano.Ledger.Conway.Governance.Internal
import Cardano.Ledger.Conway.Governance.Procedures
import Cardano.Ledger.Conway.Governance.Proposals
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.PoolParams (PoolParams (ppRewardAccount))
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  LedgerState,
  NewEpochState (..),
  epochStateGovStateL,
  epochStatePoolParamsL,
  esLStateL,
  lsCertState,
  lsCertStateL,
  lsUTxOState,
  lsUTxOStateL,
  newEpochStateGovStateL,
  utxosGovStateL,
 )
import Cardano.Ledger.UMap
import Cardano.Ledger.Val (Val (..))
import Control.DeepSeq (NFData (..))
import Control.Monad (guard)
import Control.Monad.Trans
import Control.Monad.Trans.Reader (ReaderT, ask)
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Default (Default (..))
import Data.Foldable (Foldable (..))
import qualified Data.Foldable as F (foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Lens.Micro
import Lens.Micro.Extras (view)
import NoThunks.Class (NoThunks (..))

-- | Conway governance state
data ConwayGovState era = ConwayGovState
  { forall era. ConwayGovState era -> Proposals era
cgsProposals :: !(Proposals era)
  , forall era. ConwayGovState era -> StrictMaybe (Committee era)
cgsCommittee :: !(StrictMaybe (Committee era))
  , forall era. ConwayGovState era -> Constitution era
cgsConstitution :: !(Constitution era)
  , forall era. ConwayGovState era -> PParams era
cgsCurPParams :: !(PParams era)
  , forall era. ConwayGovState era -> PParams era
cgsPrevPParams :: !(PParams era)
  , forall era. ConwayGovState era -> FuturePParams era
cgsFuturePParams :: !(FuturePParams era)
  , forall era. ConwayGovState era -> DRepPulsingState era
cgsDRepPulsingState :: !(DRepPulsingState era)
  -- ^ The 'cgsDRepPulsingState' field is a pulser that incrementally computes the stake
  -- distribution of the DReps over the Epoch following the close of voting at end of
  -- the previous Epoch. It assembles this with some of its other internal components
  -- into a (RatifyEnv era) when it completes, and then calls the RATIFY rule and
  -- eventually returns the updated RatifyState. The pulser is created at the Epoch
  -- boundary, but does no work until it is pulsed in the 'NEWEPOCH' rule, whenever the
  -- system is NOT at the epoch boundary.
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayGovState era) x -> ConwayGovState era
forall era x. ConwayGovState era -> Rep (ConwayGovState era) x
$cto :: forall era x. Rep (ConwayGovState era) x -> ConwayGovState era
$cfrom :: forall era x. ConwayGovState era -> Rep (ConwayGovState era) x
Generic, Int -> ConwayGovState era -> ShowS
forall era.
(EraPParams era, EraStake era) =>
Int -> ConwayGovState era -> ShowS
forall era.
(EraPParams era, EraStake era) =>
[ConwayGovState era] -> ShowS
forall era.
(EraPParams era, EraStake era) =>
ConwayGovState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayGovState era] -> ShowS
$cshowList :: forall era.
(EraPParams era, EraStake era) =>
[ConwayGovState era] -> ShowS
show :: ConwayGovState era -> String
$cshow :: forall era.
(EraPParams era, EraStake era) =>
ConwayGovState era -> String
showsPrec :: Int -> ConwayGovState era -> ShowS
$cshowsPrec :: forall era.
(EraPParams era, EraStake era) =>
Int -> ConwayGovState era -> ShowS
Show)

deriving instance (EraPParams era, EraStake era) => Eq (ConwayGovState era)

cgsProposalsL :: Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL :: forall era. Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ConwayGovState era -> Proposals era
cgsProposals (\ConwayGovState era
x Proposals era
y -> ConwayGovState era
x {cgsProposals :: Proposals era
cgsProposals = Proposals era
y})

cgsDRepPulsingStateL :: Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL :: forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ConwayGovState era -> DRepPulsingState era
cgsDRepPulsingState (\ConwayGovState era
x DRepPulsingState era
y -> ConwayGovState era
x {cgsDRepPulsingState :: DRepPulsingState era
cgsDRepPulsingState = DRepPulsingState era
y})

cgsCommitteeL :: Lens' (ConwayGovState era) (StrictMaybe (Committee era))
cgsCommitteeL :: forall era.
Lens' (ConwayGovState era) (StrictMaybe (Committee era))
cgsCommitteeL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ConwayGovState era -> StrictMaybe (Committee era)
cgsCommittee (\ConwayGovState era
x StrictMaybe (Committee era)
y -> ConwayGovState era
x {cgsCommittee :: StrictMaybe (Committee era)
cgsCommittee = StrictMaybe (Committee era)
y})

cgsConstitutionL :: Lens' (ConwayGovState era) (Constitution era)
cgsConstitutionL :: forall era. Lens' (ConwayGovState era) (Constitution era)
cgsConstitutionL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ConwayGovState era -> Constitution era
cgsConstitution (\ConwayGovState era
x Constitution era
y -> ConwayGovState era
x {cgsConstitution :: Constitution era
cgsConstitution = Constitution era
y})

cgsCurPParamsL :: Lens' (ConwayGovState era) (PParams era)
cgsCurPParamsL :: forall era. Lens' (ConwayGovState era) (PParams era)
cgsCurPParamsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ConwayGovState era -> PParams era
cgsCurPParams (\ConwayGovState era
x PParams era
y -> ConwayGovState era
x {cgsCurPParams :: PParams era
cgsCurPParams = PParams era
y})

cgsPrevPParamsL :: Lens' (ConwayGovState era) (PParams era)
cgsPrevPParamsL :: forall era. Lens' (ConwayGovState era) (PParams era)
cgsPrevPParamsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ConwayGovState era -> PParams era
cgsPrevPParams (\ConwayGovState era
x PParams era
y -> ConwayGovState era
x {cgsPrevPParams :: PParams era
cgsPrevPParams = PParams era
y})

cgsFuturePParamsL :: Lens' (ConwayGovState era) (FuturePParams era)
cgsFuturePParamsL :: forall era. Lens' (ConwayGovState era) (FuturePParams era)
cgsFuturePParamsL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ConwayGovState era -> FuturePParams era
cgsFuturePParams (\ConwayGovState era
cgs FuturePParams era
futurePParams -> ConwayGovState era
cgs {cgsFuturePParams :: FuturePParams era
cgsFuturePParams = FuturePParams era
futurePParams})

govStatePrevGovActionIds :: ConwayEraGov era => GovState era -> GovRelation StrictMaybe era
govStatePrevGovActionIds :: forall era.
ConwayEraGov era =>
GovState era -> GovRelation StrictMaybe era
govStatePrevGovActionIds = forall a s. Getting a s a -> s -> a
view forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
proposalsGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (Proposals era) (GovRelation PRoot era)
pRootsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to forall era. GovRelation PRoot era -> GovRelation StrictMaybe era
toPrevGovActionIds

conwayGovStateDRepDistrG ::
  EraStake era => SimpleGetter (ConwayGovState era) (Map DRep (CompactForm Coin))
conwayGovStateDRepDistrG :: forall era.
EraStake era =>
SimpleGetter (ConwayGovState era) (Map DRep (CompactForm Coin))
conwayGovStateDRepDistrG = forall s a. (s -> a) -> SimpleGetter s a
to (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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayGovState era -> DRepPulsingState era
cgsDRepPulsingState)

getRatifyState :: EraStake era => ConwayGovState era -> RatifyState era
getRatifyState :: forall era. EraStake era => ConwayGovState era -> RatifyState era
getRatifyState (ConwayGovState {DRepPulsingState era
cgsDRepPulsingState :: DRepPulsingState era
cgsDRepPulsingState :: forall era. ConwayGovState era -> DRepPulsingState era
cgsDRepPulsingState}) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
cgsDRepPulsingState

-- | This function updates the thunk, which will contain new PParams once evaluated or
-- Nothing when there was no update. At the same time if we already know the future of
-- PParams, then it will act as an identity function.
predictFuturePParams :: EraStake era => ConwayGovState era -> ConwayGovState era
predictFuturePParams :: forall era.
EraStake era =>
ConwayGovState era -> ConwayGovState era
predictFuturePParams ConwayGovState era
govState =
  case forall era. ConwayGovState era -> FuturePParams era
cgsFuturePParams ConwayGovState era
govState of
    FuturePParams era
NoPParamsUpdate -> ConwayGovState era
govState
    DefinitePParamsUpdate PParams era
_ -> ConwayGovState era
govState
    FuturePParams era
_ ->
      ConwayGovState era
govState
        { cgsFuturePParams :: FuturePParams era
cgsFuturePParams = forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate Maybe (PParams era)
newFuturePParams
        }
  where
    -- This binding is not forced until a call to `solidifyNextEpochPParams` in the TICK
    -- rule two stability windows before the end of the epoch, therefore it is safe to
    -- create thunks here throughout the epoch
    newFuturePParams :: Maybe (PParams era)
newFuturePParams = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {era}. GovActionState era -> Bool
hasChangesToPParams (forall era. RatifyState era -> Seq (GovActionState era)
rsEnacted RatifyState era
ratifyState))
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. EnactState era -> PParams era
ensCurPParams (forall era. RatifyState era -> EnactState era
rsEnactState RatifyState era
ratifyState))
    ratifyState :: RatifyState era
ratifyState = forall era. EraStake era => DRepPulsingState era -> RatifyState era
extractDRepPulsingState (forall era. ConwayGovState era -> DRepPulsingState era
cgsDRepPulsingState ConwayGovState era
govState)
    hasChangesToPParams :: GovActionState era -> Bool
hasChangesToPParams GovActionState era
gas =
      case forall era. ProposalProcedure era -> GovAction era
pProcGovAction (forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure GovActionState era
gas) of
        ParameterChange {} -> Bool
True
        HardForkInitiation {} -> Bool
True
        GovAction era
_ -> Bool
False

mkEnactState :: ConwayEraGov era => GovState era -> EnactState era
mkEnactState :: forall era. ConwayEraGov era => GovState era -> EnactState era
mkEnactState GovState era
gs =
  EnactState
    { ensCommittee :: StrictMaybe (Committee era)
ensCommittee = GovState era
gs forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
    , ensConstitution :: Constitution era
ensConstitution = GovState era
gs forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
constitutionGovStateL
    , ensCurPParams :: PParams era
ensCurPParams = GovState era
gs forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (PParams era)
curPParamsGovStateL
    , ensPrevPParams :: PParams era
ensPrevPParams = GovState era
gs forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (GovState era) (PParams era)
prevPParamsGovStateL
    , ensTreasury :: Coin
ensTreasury = forall t. Val t => t
zero
    , ensWithdrawals :: Map (Credential 'Staking) Coin
ensWithdrawals = forall a. Monoid a => a
mempty
    , ensPrevGovActionIds :: GovRelation StrictMaybe era
ensPrevGovActionIds = forall era.
ConwayEraGov era =>
GovState era -> GovRelation StrictMaybe era
govStatePrevGovActionIds GovState era
gs
    }

instance EraPParams era => DecShareCBOR (ConwayGovState era) where
  type
    Share (ConwayGovState era) =
      ( Interns (Credential 'Staking)
      , Interns (KeyHash 'StakePool)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  decSharePlusCBOR :: forall s.
StateT
  (Share (ConwayGovState era)) (Decoder s) (ConwayGovState era)
decSharePlusCBOR =
    forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"ConwayGovState" (forall a b. a -> b -> a
const Int
7) forall a b. (a -> b) -> a -> b
$ do
      Proposals era
cgsProposals <- forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
      StrictMaybe (Committee era)
cgsCommittee <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a s. DecCBOR a => Decoder s a
decCBOR
      Constitution era
cgsConstitution <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a s. DecCBOR a => Decoder s a
decCBOR
      PParams era
cgsCurPParams <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a s. DecCBOR a => Decoder s a
decCBOR
      PParams era
cgsPrevPParams <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a s. DecCBOR a => Decoder s a
decCBOR
      FuturePParams era
cgsFuturePParams <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a s. DecCBOR a => Decoder s a
decCBOR
      DRepPulsingState era
cgsDRepPulsingState <- forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ConwayGovState {PParams era
FuturePParams era
StrictMaybe (Committee era)
Constitution era
Proposals era
DRepPulsingState era
cgsDRepPulsingState :: DRepPulsingState era
cgsFuturePParams :: FuturePParams era
cgsPrevPParams :: PParams era
cgsCurPParams :: PParams era
cgsConstitution :: Constitution era
cgsCommittee :: StrictMaybe (Committee era)
cgsProposals :: Proposals era
cgsDRepPulsingState :: DRepPulsingState era
cgsFuturePParams :: FuturePParams era
cgsPrevPParams :: PParams era
cgsCurPParams :: PParams era
cgsConstitution :: Constitution era
cgsCommittee :: StrictMaybe (Committee era)
cgsProposals :: Proposals era
..}

instance EraPParams era => DecCBOR (ConwayGovState era) where
  decCBOR :: forall s. Decoder s (ConwayGovState era)
decCBOR = forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

instance (EraPParams era, EraStake era) => EncCBOR (ConwayGovState era) where
  encCBOR :: ConwayGovState era -> Encoding
encCBOR ConwayGovState {PParams era
FuturePParams era
StrictMaybe (Committee era)
Constitution era
Proposals era
DRepPulsingState era
cgsDRepPulsingState :: DRepPulsingState era
cgsFuturePParams :: FuturePParams era
cgsPrevPParams :: PParams era
cgsCurPParams :: PParams era
cgsConstitution :: Constitution era
cgsCommittee :: StrictMaybe (Committee era)
cgsProposals :: Proposals era
cgsDRepPulsingState :: forall era. ConwayGovState era -> DRepPulsingState era
cgsFuturePParams :: forall era. ConwayGovState era -> FuturePParams era
cgsPrevPParams :: forall era. ConwayGovState era -> PParams era
cgsCurPParams :: forall era. ConwayGovState era -> PParams era
cgsConstitution :: forall era. ConwayGovState era -> Constitution era
cgsCommittee :: forall era. ConwayGovState era -> StrictMaybe (Committee era)
cgsProposals :: forall era. ConwayGovState era -> Proposals era
..} =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
Proposals era
-> StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> FuturePParams era
-> DRepPulsingState era
-> ConwayGovState era
ConwayGovState
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Proposals era
cgsProposals
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (Committee era)
cgsCommittee
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Constitution era
cgsConstitution
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
cgsCurPParams
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
cgsPrevPParams
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To FuturePParams era
cgsFuturePParams
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To DRepPulsingState era
cgsDRepPulsingState

instance (EraPParams era, EraStake era) => ToCBOR (ConwayGovState era) where
  toCBOR :: ConwayGovState era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance EraPParams era => FromCBOR (ConwayGovState era) where
  fromCBOR :: forall s. Decoder s (ConwayGovState era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

instance EraPParams era => Default (ConwayGovState era) where
  def :: ConwayGovState era
def = forall era.
Proposals era
-> StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> FuturePParams era
-> DRepPulsingState era
-> ConwayGovState era
ConwayGovState forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def (forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete forall a. Default a => a
def forall a. Default a => a
def)

instance (EraPParams era, NFData (InstantStake era)) => NFData (ConwayGovState era)

instance (EraPParams era, NoThunks (InstantStake era)) => NoThunks (ConwayGovState era)

instance (EraPParams era, EraStake era) => ToJSON (ConwayGovState era) where
  toJSON :: ConwayGovState era -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era e a.
(EraStake era, KeyValue e a, EraPParams era) =>
ConwayGovState era -> [a]
toConwayGovPairs
  toEncoding :: ConwayGovState era -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era e a.
(EraStake era, KeyValue e a, EraPParams era) =>
ConwayGovState era -> [a]
toConwayGovPairs

toConwayGovPairs :: EraStake era => (KeyValue e a, EraPParams era) => ConwayGovState era -> [a]
toConwayGovPairs :: forall era e a.
(EraStake era, KeyValue e a, EraPParams era) =>
ConwayGovState era -> [a]
toConwayGovPairs cg :: ConwayGovState era
cg@(ConwayGovState Proposals era
_ StrictMaybe (Committee era)
_ Constitution era
_ PParams era
_ PParams era
_ FuturePParams era
_ DRepPulsingState era
_) =
  let ConwayGovState {PParams era
FuturePParams era
StrictMaybe (Committee era)
Constitution era
Proposals era
DRepPulsingState era
cgsDRepPulsingState :: DRepPulsingState era
cgsFuturePParams :: FuturePParams era
cgsPrevPParams :: PParams era
cgsCurPParams :: PParams era
cgsConstitution :: Constitution era
cgsCommittee :: StrictMaybe (Committee era)
cgsProposals :: Proposals era
cgsDRepPulsingState :: forall era. ConwayGovState era -> DRepPulsingState era
cgsFuturePParams :: forall era. ConwayGovState era -> FuturePParams era
cgsPrevPParams :: forall era. ConwayGovState era -> PParams era
cgsCurPParams :: forall era. ConwayGovState era -> PParams era
cgsConstitution :: forall era. ConwayGovState era -> Constitution era
cgsCommittee :: forall era. ConwayGovState era -> StrictMaybe (Committee era)
cgsProposals :: forall era. ConwayGovState era -> Proposals era
..} = ConwayGovState era
cg
   in [ Key
"proposals" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Proposals era
cgsProposals
      , Key
"nextRatifyState" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall era. EraStake era => DRepPulsingState era -> RatifyState era
extractDRepPulsingState DRepPulsingState era
cgsDRepPulsingState
      , Key
"committee" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (Committee era)
cgsCommittee
      , Key
"constitution" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Constitution era
cgsConstitution
      , Key
"currentPParams" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
cgsCurPParams
      , Key
"previousPParams" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
cgsPrevPParams
      , Key
"futurePParams" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FuturePParams era
cgsFuturePParams
      ]

instance EraPParams ConwayEra => EraGov ConwayEra where
  type GovState ConwayEra = ConwayGovState ConwayEra

  curPParamsGovStateL :: Lens' (GovState ConwayEra) (PParams ConwayEra)
curPParamsGovStateL = forall era. Lens' (ConwayGovState era) (PParams era)
cgsCurPParamsL

  prevPParamsGovStateL :: Lens' (GovState ConwayEra) (PParams ConwayEra)
prevPParamsGovStateL = forall era. Lens' (ConwayGovState era) (PParams era)
cgsPrevPParamsL

  futurePParamsGovStateL :: Lens' (GovState ConwayEra) (FuturePParams ConwayEra)
futurePParamsGovStateL = forall era. Lens' (ConwayGovState era) (FuturePParams era)
cgsFuturePParamsL

  obligationGovState :: GovState ConwayEra -> Obligations
obligationGovState GovState ConwayEra
st =
    Obligations
      { oblProposal :: Coin
oblProposal = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' forall era. GovActionState era -> Coin
gasDeposit forall a b. (a -> b) -> a -> b
$ forall era. Proposals era -> StrictSeq (GovActionState era)
proposalsActions (GovState ConwayEra
st forall s a. s -> Getting a s a -> a
^. forall era. Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL)
      , oblDRep :: Coin
oblDRep = Integer -> Coin
Coin Integer
0
      , oblStake :: Coin
oblStake = Integer -> Coin
Coin Integer
0
      , oblPool :: Coin
oblPool = Integer -> Coin
Coin Integer
0
      }

class (EraGov era, EraStake era) => ConwayEraGov era where
  constitutionGovStateL :: Lens' (GovState era) (Constitution era)
  proposalsGovStateL :: Lens' (GovState era) (Proposals era)
  drepPulsingStateGovStateL :: Lens' (GovState era) (DRepPulsingState era)
  committeeGovStateL :: Lens' (GovState era) (StrictMaybe (Committee era))

instance ConwayEraGov ConwayEra where
  constitutionGovStateL :: Lens' (GovState ConwayEra) (Constitution ConwayEra)
constitutionGovStateL = forall era. Lens' (ConwayGovState era) (Constitution era)
cgsConstitutionL
  proposalsGovStateL :: Lens' (GovState ConwayEra) (Proposals ConwayEra)
proposalsGovStateL = forall era. Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL
  drepPulsingStateGovStateL :: Lens' (GovState ConwayEra) (DRepPulsingState ConwayEra)
drepPulsingStateGovStateL = forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL
  committeeGovStateL :: Lens' (GovState ConwayEra) (StrictMaybe (Committee ConwayEra))
committeeGovStateL = forall era.
Lens' (ConwayGovState era) (StrictMaybe (Committee era))
cgsCommitteeL

-- ===================================================================
-- Lenses for access to (DRepPulsingState era)

newEpochStateDRepPulsingStateL ::
  ConwayEraGov era => Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL :: forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL =
  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

epochStateDRepPulsingStateL :: ConwayEraGov era => Lens' (EpochState era) (DRepPulsingState era)
epochStateDRepPulsingStateL :: forall era.
ConwayEraGov era =>
Lens' (EpochState era) (DRepPulsingState era)
epochStateDRepPulsingStateL = forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState era)
drepPulsingStateGovStateL

setCompleteDRepPulsingState ::
  GovState era ~ ConwayGovState era =>
  PulsingSnapshot era ->
  RatifyState era ->
  EpochState era ->
  EpochState era
setCompleteDRepPulsingState :: forall era.
(GovState era ~ ConwayGovState era) =>
PulsingSnapshot era
-> RatifyState era -> EpochState era -> EpochState era
setCompleteDRepPulsingState PulsingSnapshot era
snapshot RatifyState era
ratifyState EpochState era
epochState =
  EpochState era
epochState
    forall a b. a -> (a -> b) -> b
& forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL
      forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
snapshot RatifyState era
ratifyState

-- | Refresh the pulser in the EpochState using all the new data that is needed to compute
-- the RatifyState when pulsing completes.
setFreshDRepPulsingState ::
  ( GovState era ~ ConwayGovState era
  , Monad m
  , RunConwayRatify era
  , ConwayEraGov era
  , ConwayEraCertState era
  ) =>
  EpochNo ->
  PoolDistr ->
  EpochState era ->
  ReaderT Globals m (EpochState era)
setFreshDRepPulsingState :: forall era (m :: * -> *).
(GovState era ~ ConwayGovState era, Monad m, RunConwayRatify era,
 ConwayEraGov era, ConwayEraCertState era) =>
EpochNo
-> PoolDistr
-> EpochState era
-> ReaderT Globals m (EpochState era)
setFreshDRepPulsingState EpochNo
epochNo PoolDistr
stakePoolDistr EpochState era
epochState = do
  -- When we are finished with the pulser that was started at the last epoch boundary, we
  -- need to initialize a fresh DRep pulser. We do so by computing the pulse size and
  -- gathering the data, which we will snapshot inside the pulser. We expect approximately
  -- 10*k-many blocks to be produced each epoch, where `k` value is the stability
  -- window. We must ensure for secure operation of the Hard Fork Combinator that we have
  -- the new EnactState available `6k/f` slots before the end of the epoch, while
  -- spreading out stake distribution computation throughout the `4k/f` slots. In this
  -- formula `f` stands for the active slot coefficient, which means that there will be
  -- approximately `4k` blocks created during that period.
  Globals
globals <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let ledgerState :: LedgerState era
ledgerState = EpochState era
epochState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL
      utxoState :: UTxOState era
utxoState = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ledgerState
      instantStake :: InstantStake era
instantStake = UTxOState era
utxoState forall s a. s -> Getting a s a -> a
^. forall (t :: * -> *) era.
CanGetInstantStake t =>
SimpleGetter (t era) (InstantStake era)
instantStakeG
      certState :: CertState era
certState = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ledgerState
      dState :: DState era
dState = CertState era
certState forall s a. s -> Getting a s a -> a
^. forall era. EraCertState era => Lens' (CertState era) (DState era)
certDStateL
      vState :: VState era
vState = CertState era
certState forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
certVStateL
      govState :: ConwayGovState era
govState = EpochState era
epochState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL
      props :: Proposals era
props = ConwayGovState era
govState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL
      -- Maximum number of blocks we are allowed to roll back: usually a small positive number
      k :: NonZero Word64
k = Globals -> NonZero Word64
securityParameter Globals
globals -- On mainnet set to 2160
      umap :: UMap
umap = forall era. DState era -> UMap
dsUnified DState era
dState
      umapSize :: Int
umapSize = forall k a. Map k a -> Int
Map.size forall a b. (a -> b) -> a -> b
$ UMap -> Map (Credential 'Staking) UMElem
umElems UMap
umap
      pulseSize :: Ratio Integer
pulseSize = forall a. Ord a => a -> a -> a
max Ratio Integer
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
umapSize forall a. Integral a => a -> NonZero a -> Ratio a
%. (forall (n :: Natural). (KnownNat n, 1 <= n) => NonZero Integer
knownNonZero @4 forall a b.
(Integral a, Integral b) =>
NonZero a -> NonZero b -> NonZero Integer
`mulNonZero` forall a. Integral a => NonZero a -> NonZero Integer
toIntegerNonZero NonZero Word64
k))
      govState' :: ConwayGovState era
govState' =
        forall era.
EraStake era =>
ConwayGovState era -> ConwayGovState era
predictFuturePParams forall a b. (a -> b) -> a -> b
$
          ConwayGovState era
govState
            forall a b. a -> (a -> b) -> b
& forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing
                ( DRepPulser
                    { dpPulseSize :: Int
dpPulseSize = forall a b. (RealFrac a, Integral b) => a -> b
floor Ratio Integer
pulseSize
                    , dpUMap :: UMap
dpUMap = forall era. DState era -> UMap
dsUnified DState era
dState
                    , dpIndex :: Int
dpIndex = Int
0 -- used as the index of the remaining UMap
                    , dpInstantStake :: InstantStake era
dpInstantStake = InstantStake era
instantStake -- used as part of the snapshot
                    , dpStakePoolDistr :: PoolDistr
dpStakePoolDistr = PoolDistr
stakePoolDistr
                    , dpDRepDistr :: Map DRep (CompactForm Coin)
dpDRepDistr = forall k a. Map k a
Map.empty -- The partial result starts as the empty map
                    , dpDRepState :: Map (Credential 'DRepRole) DRepState
dpDRepState = forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps VState era
vState
                    , dpCurrentEpoch :: EpochNo
dpCurrentEpoch = EpochNo
epochNo
                    , dpCommitteeState :: CommitteeState era
dpCommitteeState = forall era. VState era -> CommitteeState era
vsCommitteeState VState era
vState
                    , dpEnactState :: EnactState era
dpEnactState =
                        forall era. ConwayEraGov era => GovState era -> EnactState era
mkEnactState ConwayGovState era
govState
                          forall a b. a -> (a -> b) -> b
& forall era. Lens' (EnactState era) Coin
ensTreasuryL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochState era
epochState forall s a. s -> Getting a s a -> a
^. forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
                    , dpProposals :: StrictSeq (GovActionState era)
dpProposals = forall era. Proposals era -> StrictSeq (GovActionState era)
proposalsActions Proposals era
props
                    , dpProposalDeposits :: Map (Credential 'Staking) (CompactForm Coin)
dpProposalDeposits = forall era.
Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
proposalsDeposits Proposals era
props
                    , dpGlobals :: Globals
dpGlobals = Globals
globals
                    , dpPoolParams :: Map (KeyHash 'StakePool) PoolParams
dpPoolParams = EpochState era
epochState forall s a. s -> Getting a s a -> a
^. forall era.
EraCertState era =>
Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
epochStatePoolParamsL
                    }
                )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ EpochState era
epochState forall a b. a -> (a -> b) -> b
& forall era. Lens' (EpochState era) (GovState era)
epochStateGovStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayGovState era
govState'

-- | Force computation of DRep stake distribution and figure out the next enact
-- state. This operation is useful in cases when access to new EnactState or DRep stake
-- distribution is needed more than once. It is safe to call this function at any
-- point. Whenever pulser is already in computed state this will be a noop.
forceDRepPulsingState :: ConwayEraGov era => NewEpochState era -> NewEpochState era
forceDRepPulsingState :: forall era.
ConwayEraGov era =>
NewEpochState era -> NewEpochState era
forceDRepPulsingState NewEpochState era
nes = NewEpochState era
nes forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall era.
EraStake era =>
DRepPulsingState era -> DRepPulsingState era
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 (DefaultVote -> DefaultVote -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultVote -> DefaultVote -> Bool
$c/= :: DefaultVote -> DefaultVote -> Bool
== :: DefaultVote -> DefaultVote -> Bool
$c== :: DefaultVote -> DefaultVote -> Bool
Eq, Int -> DefaultVote -> ShowS
[DefaultVote] -> ShowS
DefaultVote -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultVote] -> ShowS
$cshowList :: [DefaultVote] -> ShowS
show :: DefaultVote -> String
$cshow :: DefaultVote -> String
showsPrec :: Int -> DefaultVote -> ShowS
$cshowsPrec :: Int -> DefaultVote -> ShowS
Show)

instance FromCBOR DefaultVote where
  fromCBOR :: forall s. Decoder s DefaultVote
fromCBOR = do
    Word8
tag <- forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultVote
DefaultNo
      Word8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultVote
DefaultAbstain
      Word8
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultVote
DefaultNoConfidence
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid DefaultVote tag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
tag

instance ToCBOR DefaultVote where
  toCBOR :: DefaultVote -> Encoding
toCBOR DefaultVote
DefaultNo = Word8 -> Encoding
encodeWord8 Word8
0
  toCBOR DefaultVote
DefaultAbstain = Word8 -> Encoding
encodeWord8 Word8
1
  toCBOR DefaultVote
DefaultNoConfidence = Word8 -> Encoding
encodeWord8 Word8
2

instance EncCBOR DefaultVote
instance DecCBOR DefaultVote

defaultStakePoolVote ::
  -- | Specify the key hash of the pool whose default vote should be returned.
  KeyHash 'StakePool ->
  -- | Registered Stake Pools
  Map (KeyHash 'StakePool) PoolParams ->
  -- | Delegations of staking credneitals to a DRep
  Map (Credential 'Staking) DRep ->
  DefaultVote
defaultStakePoolVote :: KeyHash 'StakePool
-> Map (KeyHash 'StakePool) PoolParams
-> Map (Credential 'Staking) DRep
-> DefaultVote
defaultStakePoolVote KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) PoolParams
poolParams Map (Credential 'Staking) DRep
dRepDelegations =
  Maybe DRep -> DefaultVote
toDefaultVote forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) PoolParams
poolParams forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PoolParams
d ->
      forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (RewardAccount -> Credential 'Staking
raCredential forall a b. (a -> b) -> a -> b
$ PoolParams -> RewardAccount
ppRewardAccount PoolParams
d) Map (Credential 'Staking) DRep
dRepDelegations
  where
    toDefaultVote :: Maybe DRep -> DefaultVote
toDefaultVote (Just DRep
DRepAlwaysAbstain) = DefaultVote
DefaultAbstain
    toDefaultVote (Just DRep
DRepAlwaysNoConfidence) = DefaultVote
DefaultNoConfidence
    toDefaultVote Maybe DRep
_ = DefaultVote
DefaultNo

authorizedElectedHotCommitteeCredentials ::
  (ConwayEraGov era, ConwayEraCertState era) =>
  LedgerState era ->
  Set.Set (Credential 'HotCommitteeRole)
authorizedElectedHotCommitteeCredentials :: forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
LedgerState era -> Set (Credential 'HotCommitteeRole)
authorizedElectedHotCommitteeCredentials LedgerState era
ledgerState =
  case LedgerState era
ledgerState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL of
    StrictMaybe (Committee era)
SNothing -> forall a. Set a
Set.empty
    SJust Committee era
electedCommiteee ->
      Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Set (Credential 'HotCommitteeRole)
collectAuthorizedHotCreds forall a b. (a -> b) -> a -> b
$
        forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds CommitteeState era
committeeState forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers Committee era
electedCommiteee
  where
    committeeState :: CommitteeState era
committeeState = LedgerState era
ledgerState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraCertState 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
    collectAuthorizedHotCreds :: Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Set (Credential 'HotCommitteeRole)
collectAuthorizedHotCreds =
      let toHotCredSet :: Set (Credential 'HotCommitteeRole)
-> CommitteeAuthorization -> Set (Credential 'HotCommitteeRole)
toHotCredSet !Set (Credential 'HotCommitteeRole)
acc = \case
            CommitteeHotCredential Credential 'HotCommitteeRole
hotCred -> forall a. Ord a => a -> Set a -> Set a
Set.insert Credential 'HotCommitteeRole
hotCred Set (Credential 'HotCommitteeRole)
acc
            CommitteeMemberResigned {} -> Set (Credential 'HotCommitteeRole)
acc
       in forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Set (Credential 'HotCommitteeRole)
-> CommitteeAuthorization -> Set (Credential 'HotCommitteeRole)
toHotCredSet forall a. Set a
Set.empty