{-# 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 x. ConwayGovState era -> Rep (ConwayGovState era) x)
-> (forall x. Rep (ConwayGovState era) x -> ConwayGovState era)
-> Generic (ConwayGovState era)
forall x. Rep (ConwayGovState era) x -> ConwayGovState era
forall x. ConwayGovState era -> Rep (ConwayGovState era) x
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
$cfrom :: forall era x. ConwayGovState era -> Rep (ConwayGovState era) x
from :: forall x. ConwayGovState era -> Rep (ConwayGovState era) x
$cto :: forall era x. Rep (ConwayGovState era) x -> ConwayGovState era
to :: forall x. Rep (ConwayGovState era) x -> ConwayGovState era
Generic, Int -> ConwayGovState era -> ShowS
[ConwayGovState era] -> ShowS
ConwayGovState era -> String
(Int -> ConwayGovState era -> ShowS)
-> (ConwayGovState era -> String)
-> ([ConwayGovState era] -> ShowS)
-> Show (ConwayGovState era)
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
$cshowsPrec :: forall era.
(EraPParams era, EraStake era) =>
Int -> ConwayGovState era -> ShowS
showsPrec :: Int -> ConwayGovState era -> ShowS
$cshow :: forall era.
(EraPParams era, EraStake era) =>
ConwayGovState era -> String
show :: ConwayGovState era -> String
$cshowList :: forall era.
(EraPParams era, EraStake era) =>
[ConwayGovState era] -> ShowS
showList :: [ConwayGovState era] -> ShowS
Show)

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

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

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

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

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

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

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

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

govStatePrevGovActionIds :: ConwayEraGov era => GovState era -> GovRelation StrictMaybe era
govStatePrevGovActionIds :: forall era.
ConwayEraGov era =>
GovState era -> GovRelation StrictMaybe era
govStatePrevGovActionIds = Getting
  (GovRelation StrictMaybe era)
  (GovState era)
  (GovRelation StrictMaybe era)
-> GovState era -> GovRelation StrictMaybe era
forall a s. Getting a s a -> s -> a
view (Getting
   (GovRelation StrictMaybe era)
   (GovState era)
   (GovRelation StrictMaybe era)
 -> GovState era -> GovRelation StrictMaybe era)
-> Getting
     (GovRelation StrictMaybe era)
     (GovState era)
     (GovRelation StrictMaybe era)
-> GovState era
-> GovRelation StrictMaybe era
forall a b. (a -> b) -> a -> b
$ (Proposals era
 -> Const (GovRelation StrictMaybe era) (Proposals era))
-> GovState era
-> Const (GovRelation StrictMaybe era) (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
Lens' (GovState era) (Proposals era)
proposalsGovStateL ((Proposals era
  -> Const (GovRelation StrictMaybe era) (Proposals era))
 -> GovState era
 -> Const (GovRelation StrictMaybe era) (GovState era))
-> ((GovRelation StrictMaybe era
     -> Const
          (GovRelation StrictMaybe era) (GovRelation StrictMaybe era))
    -> Proposals era
    -> Const (GovRelation StrictMaybe era) (Proposals era))
-> Getting
     (GovRelation StrictMaybe era)
     (GovState era)
     (GovRelation StrictMaybe era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovRelation PRoot era
 -> Const (GovRelation StrictMaybe era) (GovRelation PRoot era))
-> Proposals era
-> Const (GovRelation StrictMaybe era) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot era -> f (GovRelation PRoot era))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot era
  -> Const (GovRelation StrictMaybe era) (GovRelation PRoot era))
 -> Proposals era
 -> Const (GovRelation StrictMaybe era) (Proposals era))
-> ((GovRelation StrictMaybe era
     -> Const
          (GovRelation StrictMaybe era) (GovRelation StrictMaybe era))
    -> GovRelation PRoot era
    -> Const (GovRelation StrictMaybe era) (GovRelation PRoot era))
-> (GovRelation StrictMaybe era
    -> Const
         (GovRelation StrictMaybe era) (GovRelation StrictMaybe era))
-> Proposals era
-> Const (GovRelation StrictMaybe era) (Proposals era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovRelation PRoot era -> GovRelation StrictMaybe era)
-> SimpleGetter
     (GovRelation PRoot era) (GovRelation StrictMaybe era)
forall s a. (s -> a) -> SimpleGetter s a
to GovRelation PRoot era -> GovRelation StrictMaybe era
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 = (ConwayGovState era -> Map DRep (CompactForm Coin))
-> SimpleGetter (ConwayGovState era) (Map DRep (CompactForm Coin))
forall s a. (s -> a) -> SimpleGetter s a
to (PulsingSnapshot era -> Map DRep (CompactForm Coin)
forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepDistr (PulsingSnapshot era -> Map DRep (CompactForm Coin))
-> (ConwayGovState era -> PulsingSnapshot era)
-> ConwayGovState era
-> Map DRep (CompactForm Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PulsingSnapshot era, RatifyState era) -> PulsingSnapshot era
forall a b. (a, b) -> a
fst ((PulsingSnapshot era, RatifyState era) -> PulsingSnapshot era)
-> (ConwayGovState era -> (PulsingSnapshot era, RatifyState era))
-> ConwayGovState era
-> PulsingSnapshot era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (DRepPulsingState era -> (PulsingSnapshot era, RatifyState era))
-> (ConwayGovState era -> DRepPulsingState era)
-> ConwayGovState era
-> (PulsingSnapshot era, RatifyState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovState era -> DRepPulsingState era
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 :: forall era. ConwayGovState era -> DRepPulsingState era
cgsDRepPulsingState :: DRepPulsingState era
cgsDRepPulsingState}) = (PulsingSnapshot era, RatifyState era) -> RatifyState era
forall a b. (a, b) -> b
snd ((PulsingSnapshot era, RatifyState era) -> RatifyState era)
-> (PulsingSnapshot era, RatifyState era) -> RatifyState era
forall a b. (a -> b) -> a -> b
$ DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
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 ConwayGovState era -> FuturePParams era
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 = PotentialPParamsUpdate 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
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((GovActionState era -> Bool) -> Seq (GovActionState era) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GovActionState era -> Bool
forall {era}. GovActionState era -> Bool
hasChangesToPParams (RatifyState era -> Seq (GovActionState era)
forall era. RatifyState era -> Seq (GovActionState era)
rsEnacted RatifyState era
ratifyState))
      PParams era -> Maybe (PParams era)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EnactState era -> PParams era
forall era. EnactState era -> PParams era
ensCurPParams (RatifyState era -> EnactState era
forall era. RatifyState era -> EnactState era
rsEnactState RatifyState era
ratifyState))
    ratifyState :: RatifyState era
ratifyState = DRepPulsingState era -> RatifyState era
forall era. EraStake era => DRepPulsingState era -> RatifyState era
extractDRepPulsingState (ConwayGovState era -> DRepPulsingState era
forall era. ConwayGovState era -> DRepPulsingState era
cgsDRepPulsingState ConwayGovState era
govState)
    hasChangesToPParams :: GovActionState era -> Bool
hasChangesToPParams GovActionState era
gas =
      case ProposalProcedure era -> GovAction era
forall era. ProposalProcedure era -> GovAction era
pProcGovAction (GovActionState era -> ProposalProcedure era
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 GovState era
-> Getting
     (StrictMaybe (Committee era))
     (GovState era)
     (StrictMaybe (Committee era))
-> StrictMaybe (Committee era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Committee era))
  (GovState era)
  (StrictMaybe (Committee era))
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
    , ensConstitution :: Constitution era
ensConstitution = GovState era
gs GovState era
-> Getting (Constitution era) (GovState era) (Constitution era)
-> Constitution era
forall s a. s -> Getting a s a -> a
^. Getting (Constitution era) (GovState era) (Constitution era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Constitution era)
Lens' (GovState era) (Constitution era)
constitutionGovStateL
    , ensCurPParams :: PParams era
ensCurPParams = GovState era
gs GovState era
-> Getting (PParams era) (GovState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (GovState era) (PParams era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
curPParamsGovStateL
    , ensPrevPParams :: PParams era
ensPrevPParams = GovState era
gs GovState era
-> Getting (PParams era) (GovState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (GovState era) (PParams era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
prevPParamsGovStateL
    , ensTreasury :: Coin
ensTreasury = Coin
forall t. Val t => t
zero
    , ensWithdrawals :: Map (Credential 'Staking) Coin
ensWithdrawals = Map (Credential 'Staking) Coin
forall a. Monoid a => a
mempty
    , ensPrevGovActionIds :: GovRelation StrictMaybe era
ensPrevGovActionIds = GovState era -> GovRelation StrictMaybe era
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 =
    Text
-> (ConwayGovState era -> Int)
-> StateT
     (Share (ConwayGovState era)) (Decoder s) (ConwayGovState era)
-> StateT
     (Share (ConwayGovState era)) (Decoder s) (ConwayGovState era)
forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"ConwayGovState" (Int -> ConwayGovState era -> Int
forall a b. a -> b -> a
const Int
7) (StateT
   (Share (ConwayGovState era)) (Decoder s) (ConwayGovState era)
 -> StateT
      (Share (ConwayGovState era)) (Decoder s) (ConwayGovState era))
-> StateT
     (Share (ConwayGovState era)) (Decoder s) (ConwayGovState era)
-> StateT
     (Share (ConwayGovState era)) (Decoder s) (ConwayGovState era)
forall a b. (a -> b) -> a -> b
$ do
      Proposals era
cgsProposals <- StateT
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Decoder s)
  (Proposals era)
StateT (Share (Proposals era)) (Decoder s) (Proposals era)
forall s.
StateT (Share (Proposals era)) (Decoder s) (Proposals era)
forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
      StrictMaybe (Committee era)
cgsCommittee <- Decoder s (StrictMaybe (Committee era))
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (StrictMaybe (Committee era))
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s (StrictMaybe (Committee era))
forall s. Decoder s (StrictMaybe (Committee era))
forall a s. DecCBOR a => Decoder s a
decCBOR
      Constitution era
cgsConstitution <- Decoder s (Constitution era)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (Constitution era)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s (Constitution era)
forall s. Decoder s (Constitution era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      PParams era
cgsCurPParams <- Decoder s (PParams era)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (PParams era)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s (PParams era)
forall s. Decoder s (PParams era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      PParams era
cgsPrevPParams <- Decoder s (PParams era)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (PParams era)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s (PParams era)
forall s. Decoder s (PParams era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      FuturePParams era
cgsFuturePParams <- Decoder s (FuturePParams era)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (FuturePParams era)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s (FuturePParams era)
forall s. Decoder s (FuturePParams era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      DRepPulsingState era
cgsDRepPulsingState <- StateT
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Decoder s)
  (DRepPulsingState era)
StateT
  (Share (DRepPulsingState era)) (Decoder s) (DRepPulsingState era)
forall s.
StateT
  (Share (DRepPulsingState era)) (Decoder s) (DRepPulsingState era)
forall a s. DecShareCBOR a => StateT (Share a) (Decoder s) a
decSharePlusCBOR
      ConwayGovState era
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (ConwayGovState era)
forall a.
a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConwayGovState {StrictMaybe (Committee era)
PParams era
FuturePParams era
Constitution era
Proposals era
DRepPulsingState era
cgsProposals :: Proposals era
cgsCommittee :: StrictMaybe (Committee era)
cgsConstitution :: Constitution era
cgsCurPParams :: PParams era
cgsPrevPParams :: PParams era
cgsFuturePParams :: FuturePParams era
cgsDRepPulsingState :: DRepPulsingState era
cgsProposals :: Proposals era
cgsCommittee :: StrictMaybe (Committee era)
cgsConstitution :: Constitution era
cgsCurPParams :: PParams era
cgsPrevPParams :: PParams era
cgsFuturePParams :: FuturePParams era
cgsDRepPulsingState :: DRepPulsingState era
..}

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

instance (EraPParams era, EraStake era) => EncCBOR (ConwayGovState era) where
  encCBOR :: ConwayGovState era -> Encoding
encCBOR ConwayGovState {StrictMaybe (Committee era)
PParams era
FuturePParams era
Constitution era
Proposals era
DRepPulsingState era
cgsProposals :: forall era. ConwayGovState era -> Proposals era
cgsCommittee :: forall era. ConwayGovState era -> StrictMaybe (Committee era)
cgsConstitution :: forall era. ConwayGovState era -> Constitution era
cgsCurPParams :: forall era. ConwayGovState era -> PParams era
cgsPrevPParams :: forall era. ConwayGovState era -> PParams era
cgsFuturePParams :: forall era. ConwayGovState era -> FuturePParams era
cgsDRepPulsingState :: forall era. ConwayGovState era -> DRepPulsingState era
cgsProposals :: Proposals era
cgsCommittee :: StrictMaybe (Committee era)
cgsConstitution :: Constitution era
cgsCurPParams :: PParams era
cgsPrevPParams :: PParams era
cgsFuturePParams :: FuturePParams era
cgsDRepPulsingState :: DRepPulsingState era
..} =
    Encode ('Closed 'Dense) (ConwayGovState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (ConwayGovState era) -> Encoding)
-> Encode ('Closed 'Dense) (ConwayGovState era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Proposals era
 -> StrictMaybe (Committee era)
 -> Constitution era
 -> PParams era
 -> PParams era
 -> FuturePParams era
 -> DRepPulsingState era
 -> ConwayGovState era)
-> Encode
     ('Closed 'Dense)
     (Proposals era
      -> StrictMaybe (Committee era)
      -> Constitution era
      -> PParams era
      -> PParams era
      -> FuturePParams era
      -> DRepPulsingState era
      -> ConwayGovState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec Proposals era
-> StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> FuturePParams era
-> DRepPulsingState era
-> ConwayGovState era
forall era.
Proposals era
-> StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> FuturePParams era
-> DRepPulsingState era
-> ConwayGovState era
ConwayGovState
        Encode
  ('Closed 'Dense)
  (Proposals era
   -> StrictMaybe (Committee era)
   -> Constitution era
   -> PParams era
   -> PParams era
   -> FuturePParams era
   -> DRepPulsingState era
   -> ConwayGovState era)
-> Encode ('Closed 'Dense) (Proposals era)
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (Committee era)
      -> Constitution era
      -> PParams era
      -> PParams era
      -> FuturePParams era
      -> DRepPulsingState era
      -> ConwayGovState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Proposals era -> Encode ('Closed 'Dense) (Proposals era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Proposals era
cgsProposals
        Encode
  ('Closed 'Dense)
  (StrictMaybe (Committee era)
   -> Constitution era
   -> PParams era
   -> PParams era
   -> FuturePParams era
   -> DRepPulsingState era
   -> ConwayGovState era)
-> Encode ('Closed 'Dense) (StrictMaybe (Committee era))
-> Encode
     ('Closed 'Dense)
     (Constitution era
      -> PParams era
      -> PParams era
      -> FuturePParams era
      -> DRepPulsingState era
      -> ConwayGovState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictMaybe (Committee era)
-> Encode ('Closed 'Dense) (StrictMaybe (Committee era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (Committee era)
cgsCommittee
        Encode
  ('Closed 'Dense)
  (Constitution era
   -> PParams era
   -> PParams era
   -> FuturePParams era
   -> DRepPulsingState era
   -> ConwayGovState era)
-> Encode ('Closed 'Dense) (Constitution era)
-> Encode
     ('Closed 'Dense)
     (PParams era
      -> PParams era
      -> FuturePParams era
      -> DRepPulsingState era
      -> ConwayGovState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Constitution era -> Encode ('Closed 'Dense) (Constitution era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Constitution era
cgsConstitution
        Encode
  ('Closed 'Dense)
  (PParams era
   -> PParams era
   -> FuturePParams era
   -> DRepPulsingState era
   -> ConwayGovState era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
     ('Closed 'Dense)
     (PParams era
      -> FuturePParams era -> DRepPulsingState era -> ConwayGovState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PParams era -> Encode ('Closed 'Dense) (PParams era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
cgsCurPParams
        Encode
  ('Closed 'Dense)
  (PParams era
   -> FuturePParams era -> DRepPulsingState era -> ConwayGovState era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
     ('Closed 'Dense)
     (FuturePParams era -> DRepPulsingState era -> ConwayGovState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PParams era -> Encode ('Closed 'Dense) (PParams era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
cgsPrevPParams
        Encode
  ('Closed 'Dense)
  (FuturePParams era -> DRepPulsingState era -> ConwayGovState era)
-> Encode ('Closed 'Dense) (FuturePParams era)
-> Encode
     ('Closed 'Dense) (DRepPulsingState era -> ConwayGovState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> FuturePParams era -> Encode ('Closed 'Dense) (FuturePParams era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To FuturePParams era
cgsFuturePParams
        Encode
  ('Closed 'Dense) (DRepPulsingState era -> ConwayGovState era)
-> Encode ('Closed 'Dense) (DRepPulsingState era)
-> Encode ('Closed 'Dense) (ConwayGovState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> DRepPulsingState era
-> Encode ('Closed 'Dense) (DRepPulsingState era)
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 = Proposals era
-> StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> FuturePParams era
-> DRepPulsingState era
-> ConwayGovState era
forall era.
Proposals era
-> StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> FuturePParams era
-> DRepPulsingState era
-> ConwayGovState era
ConwayGovState Proposals era
forall a. Default a => a
def StrictMaybe (Committee era)
forall a. Default a => a
def Constitution era
forall a. Default a => a
def PParams era
forall a. Default a => a
def PParams era
forall a. Default a => a
def FuturePParams era
forall a. Default a => a
def (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
forall a. Default a => a
def RatifyState era
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 ([Pair] -> Value)
-> (ConwayGovState era -> [Pair]) -> ConwayGovState era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovState era -> [Pair]
forall era e a.
(EraStake era, KeyValue e a, EraPParams era) =>
ConwayGovState era -> [a]
toConwayGovPairs
  toEncoding :: ConwayGovState era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (ConwayGovState era -> Series) -> ConwayGovState era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (ConwayGovState era -> [Series]) -> ConwayGovState era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayGovState era -> [Series]
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 {StrictMaybe (Committee era)
PParams era
FuturePParams era
Constitution era
Proposals era
DRepPulsingState era
cgsProposals :: forall era. ConwayGovState era -> Proposals era
cgsCommittee :: forall era. ConwayGovState era -> StrictMaybe (Committee era)
cgsConstitution :: forall era. ConwayGovState era -> Constitution era
cgsCurPParams :: forall era. ConwayGovState era -> PParams era
cgsPrevPParams :: forall era. ConwayGovState era -> PParams era
cgsFuturePParams :: forall era. ConwayGovState era -> FuturePParams era
cgsDRepPulsingState :: forall era. ConwayGovState era -> DRepPulsingState era
cgsProposals :: Proposals era
cgsCommittee :: StrictMaybe (Committee era)
cgsConstitution :: Constitution era
cgsCurPParams :: PParams era
cgsPrevPParams :: PParams era
cgsFuturePParams :: FuturePParams era
cgsDRepPulsingState :: DRepPulsingState era
..} = ConwayGovState era
cg
   in [ Key
"proposals" Key -> Proposals era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Proposals era
cgsProposals
      , Key
"nextRatifyState" Key -> RatifyState era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DRepPulsingState era -> RatifyState era
forall era. EraStake era => DRepPulsingState era -> RatifyState era
extractDRepPulsingState DRepPulsingState era
cgsDRepPulsingState
      , Key
"committee" Key -> StrictMaybe (Committee era) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (Committee era)
cgsCommittee
      , Key
"constitution" Key -> Constitution era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Constitution era
cgsConstitution
      , Key
"currentPParams" Key -> PParams era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
cgsCurPParams
      , Key
"previousPParams" Key -> PParams era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams era
cgsPrevPParams
      , Key
"futurePParams" Key -> FuturePParams era -> a
forall v. ToJSON v => Key -> v -> a
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 = (PParams ConwayEra -> f (PParams ConwayEra))
-> GovState ConwayEra -> f (GovState ConwayEra)
(PParams ConwayEra -> f (PParams ConwayEra))
-> ConwayGovState ConwayEra -> f (ConwayGovState ConwayEra)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsCurPParamsL

  prevPParamsGovStateL :: Lens' (GovState ConwayEra) (PParams ConwayEra)
prevPParamsGovStateL = (PParams ConwayEra -> f (PParams ConwayEra))
-> GovState ConwayEra -> f (GovState ConwayEra)
(PParams ConwayEra -> f (PParams ConwayEra))
-> ConwayGovState ConwayEra -> f (ConwayGovState ConwayEra)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsPrevPParamsL

  futurePParamsGovStateL :: Lens' (GovState ConwayEra) (FuturePParams ConwayEra)
futurePParamsGovStateL = (FuturePParams ConwayEra -> f (FuturePParams ConwayEra))
-> GovState ConwayEra -> f (GovState ConwayEra)
(FuturePParams ConwayEra -> f (FuturePParams ConwayEra))
-> ConwayGovState ConwayEra -> f (ConwayGovState ConwayEra)
forall era (f :: * -> *).
Functor f =>
(FuturePParams era -> f (FuturePParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsFuturePParamsL

  obligationGovState :: GovState ConwayEra -> Obligations
obligationGovState GovState ConwayEra
st =
    Obligations
      { oblProposal :: Coin
oblProposal = (GovActionState ConwayEra -> Coin)
-> StrictSeq (GovActionState ConwayEra) -> Coin
forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' GovActionState ConwayEra -> Coin
forall era. GovActionState era -> Coin
gasDeposit (StrictSeq (GovActionState ConwayEra) -> Coin)
-> StrictSeq (GovActionState ConwayEra) -> Coin
forall a b. (a -> b) -> a -> b
$ Proposals ConwayEra -> StrictSeq (GovActionState ConwayEra)
forall era. Proposals era -> StrictSeq (GovActionState era)
proposalsActions (GovState ConwayEra
ConwayGovState ConwayEra
st ConwayGovState ConwayEra
-> Getting
     (Proposals ConwayEra)
     (ConwayGovState ConwayEra)
     (Proposals ConwayEra)
-> Proposals ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting
  (Proposals ConwayEra)
  (ConwayGovState ConwayEra)
  (Proposals ConwayEra)
forall era (f :: * -> *).
Functor f =>
(Proposals era -> f (Proposals era))
-> ConwayGovState era -> f (ConwayGovState 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 = (Constitution ConwayEra -> f (Constitution ConwayEra))
-> GovState ConwayEra -> f (GovState ConwayEra)
(Constitution ConwayEra -> f (Constitution ConwayEra))
-> ConwayGovState ConwayEra -> f (ConwayGovState ConwayEra)
forall era (f :: * -> *).
Functor f =>
(Constitution era -> f (Constitution era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsConstitutionL
  proposalsGovStateL :: Lens' (GovState ConwayEra) (Proposals ConwayEra)
proposalsGovStateL = (Proposals ConwayEra -> f (Proposals ConwayEra))
-> GovState ConwayEra -> f (GovState ConwayEra)
(Proposals ConwayEra -> f (Proposals ConwayEra))
-> ConwayGovState ConwayEra -> f (ConwayGovState ConwayEra)
forall era (f :: * -> *).
Functor f =>
(Proposals era -> f (Proposals era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsProposalsL
  drepPulsingStateGovStateL :: Lens' (GovState ConwayEra) (DRepPulsingState ConwayEra)
drepPulsingStateGovStateL = (DRepPulsingState ConwayEra -> f (DRepPulsingState ConwayEra))
-> GovState ConwayEra -> f (GovState ConwayEra)
(DRepPulsingState ConwayEra -> f (DRepPulsingState ConwayEra))
-> ConwayGovState ConwayEra -> f (ConwayGovState ConwayEra)
forall era (f :: * -> *).
Functor f =>
(DRepPulsingState era -> f (DRepPulsingState era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsDRepPulsingStateL
  committeeGovStateL :: Lens' (GovState ConwayEra) (StrictMaybe (Committee ConwayEra))
committeeGovStateL = (StrictMaybe (Committee ConwayEra)
 -> f (StrictMaybe (Committee ConwayEra)))
-> GovState ConwayEra -> f (GovState ConwayEra)
(StrictMaybe (Committee ConwayEra)
 -> f (StrictMaybe (Committee ConwayEra)))
-> ConwayGovState ConwayEra -> f (ConwayGovState ConwayEra)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> ConwayGovState era -> f (ConwayGovState 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 =
  (GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
newEpochStateGovStateL ((GovState era -> f (GovState era))
 -> NewEpochState era -> f (NewEpochState era))
-> ((DRepPulsingState era -> f (DRepPulsingState era))
    -> GovState era -> f (GovState era))
-> (DRepPulsingState era -> f (DRepPulsingState era))
-> NewEpochState era
-> f (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRepPulsingState era -> f (DRepPulsingState era))
-> GovState era -> f (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState 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 = (GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((GovState era -> f (GovState era))
 -> EpochState era -> f (EpochState era))
-> ((DRepPulsingState era -> f (DRepPulsingState era))
    -> GovState era -> f (GovState era))
-> (DRepPulsingState era -> f (DRepPulsingState era))
-> EpochState era
-> f (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRepPulsingState era -> f (DRepPulsingState era))
-> GovState era -> f (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (DRepPulsingState 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
    EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (GovState era -> Identity (GovState era))
-> EpochState era -> Identity (EpochState era)
(ConwayGovState era -> Identity (ConwayGovState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((ConwayGovState era -> Identity (ConwayGovState era))
 -> EpochState era -> Identity (EpochState era))
-> ((DRepPulsingState era -> Identity (DRepPulsingState era))
    -> ConwayGovState era -> Identity (ConwayGovState era))
-> (DRepPulsingState era -> Identity (DRepPulsingState era))
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DRepPulsingState era -> Identity (DRepPulsingState era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(DRepPulsingState era -> f (DRepPulsingState era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsDRepPulsingStateL
      ((DRepPulsingState era -> Identity (DRepPulsingState era))
 -> EpochState era -> Identity (EpochState era))
-> DRepPulsingState era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
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 <- ReaderT Globals m Globals
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let ledgerState :: LedgerState era
ledgerState = EpochState era
epochState EpochState era
-> Getting (LedgerState era) (EpochState era) (LedgerState era)
-> LedgerState era
forall s a. s -> Getting a s a -> a
^. Getting (LedgerState era) (EpochState era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL
      utxoState :: UTxOState era
utxoState = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ledgerState
      instantStake :: InstantStake era
instantStake = UTxOState era
utxoState UTxOState era
-> Getting (InstantStake era) (UTxOState era) (InstantStake era)
-> InstantStake era
forall s a. s -> Getting a s a -> a
^. Getting (InstantStake era) (UTxOState era) (InstantStake era)
forall era. SimpleGetter (UTxOState era) (InstantStake era)
forall (t :: * -> *) era.
CanGetInstantStake t =>
SimpleGetter (t era) (InstantStake era)
instantStakeG
      certState :: CertState era
certState = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ledgerState
      dState :: DState era
dState = CertState era
certState CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
      vState :: VState era
vState = CertState era
certState CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL
      govState :: ConwayGovState era
govState = EpochState era
epochState EpochState era
-> Getting
     (ConwayGovState era) (EpochState era) (ConwayGovState era)
-> ConwayGovState era
forall s a. s -> Getting a s a -> a
^. (GovState era -> Const (ConwayGovState era) (GovState era))
-> EpochState era -> Const (ConwayGovState era) (EpochState era)
Getting (ConwayGovState era) (EpochState era) (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL
      props :: Proposals era
props = ConwayGovState era
govState ConwayGovState era
-> Getting (Proposals era) (ConwayGovState era) (Proposals era)
-> Proposals era
forall s a. s -> Getting a s a -> a
^. Getting (Proposals era) (ConwayGovState era) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(Proposals era -> f (Proposals era))
-> ConwayGovState era -> f (ConwayGovState 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 = DState era -> UMap
forall era. DState era -> UMap
dsUnified DState era
dState
      umapSize :: Int
umapSize = Map (Credential 'Staking) UMElem -> Int
forall k a. Map k a -> Int
Map.size (Map (Credential 'Staking) UMElem -> Int)
-> Map (Credential 'Staking) UMElem -> Int
forall a b. (a -> b) -> a -> b
$ UMap -> Map (Credential 'Staking) UMElem
umElems UMap
umap
      pulseSize :: Ratio Integer
pulseSize = Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Ord a => a -> a -> a
max Ratio Integer
1 (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
umapSize Integer -> NonZero Integer -> Ratio Integer
forall a. Integral a => a -> NonZero a -> Ratio a
%. (forall (n :: Natural). (KnownNat n, 1 <= n) => NonZero Integer
knownNonZero @4 NonZero Integer -> NonZero Integer -> NonZero Integer
forall a b.
(Integral a, Integral b) =>
NonZero a -> NonZero b -> NonZero Integer
`mulNonZero` NonZero Word64 -> NonZero Integer
forall a. Integral a => NonZero a -> NonZero Integer
toIntegerNonZero NonZero Word64
k))
      govState' :: ConwayGovState era
govState' =
        ConwayGovState era -> ConwayGovState era
forall era.
EraStake era =>
ConwayGovState era -> ConwayGovState era
predictFuturePParams (ConwayGovState era -> ConwayGovState era)
-> ConwayGovState era -> ConwayGovState era
forall a b. (a -> b) -> a -> b
$
          ConwayGovState era
govState
            ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (DRepPulsingState era -> Identity (DRepPulsingState era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(DRepPulsingState era -> f (DRepPulsingState era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsDRepPulsingStateL
              ((DRepPulsingState era -> Identity (DRepPulsingState era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> DRepPulsingState era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing
                ( DRepPulser
                    { dpPulseSize :: Int
dpPulseSize = Ratio Integer -> Int
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Ratio Integer
pulseSize
                    , dpUMap :: UMap
dpUMap = DState era -> UMap
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 = Map DRep (CompactForm Coin)
forall k a. Map k a
Map.empty -- The partial result starts as the empty map
                    , dpDRepState :: Map (Credential 'DRepRole) DRepState
dpDRepState = VState era -> Map (Credential 'DRepRole) DRepState
forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps VState era
vState
                    , dpCurrentEpoch :: EpochNo
dpCurrentEpoch = EpochNo
epochNo
                    , dpCommitteeState :: CommitteeState era
dpCommitteeState = VState era -> CommitteeState era
forall era. VState era -> CommitteeState era
vsCommitteeState VState era
vState
                    , dpEnactState :: EnactState era
dpEnactState =
                        GovState era -> EnactState era
forall era. ConwayEraGov era => GovState era -> EnactState era
mkEnactState GovState era
ConwayGovState era
govState
                          EnactState era
-> (EnactState era -> EnactState era) -> EnactState era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> EnactState era -> Identity (EnactState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> EnactState era -> f (EnactState era)
ensTreasuryL ((Coin -> Identity Coin)
 -> EnactState era -> Identity (EnactState era))
-> Coin -> EnactState era -> EnactState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochState era
epochState EpochState era -> Getting Coin (EpochState era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (EpochState era) Coin
Lens' (EpochState era) Coin
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) Coin
treasuryL
                    , dpProposals :: StrictSeq (GovActionState era)
dpProposals = Proposals era -> StrictSeq (GovActionState era)
forall era. Proposals era -> StrictSeq (GovActionState era)
proposalsActions Proposals era
props
                    , dpProposalDeposits :: Map (Credential 'Staking) (CompactForm Coin)
dpProposalDeposits = Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
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 EpochState era
-> Getting
     (Map (KeyHash 'StakePool) PoolParams)
     (EpochState era)
     (Map (KeyHash 'StakePool) PoolParams)
-> Map (KeyHash 'StakePool) PoolParams
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (KeyHash 'StakePool) PoolParams)
  (EpochState era)
  (Map (KeyHash 'StakePool) PoolParams)
forall era.
EraCertState era =>
Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
Lens' (EpochState era) (Map (KeyHash 'StakePool) PoolParams)
epochStatePoolParamsL
                    }
                )
  EpochState era -> ReaderT Globals m (EpochState era)
forall a. a -> ReaderT Globals m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochState era -> ReaderT Globals m (EpochState era))
-> EpochState era -> ReaderT Globals m (EpochState era)
forall a b. (a -> b) -> a -> b
$ EpochState era
epochState EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (GovState era -> Identity (GovState era))
-> EpochState era -> Identity (EpochState era)
(ConwayGovState era -> Identity (ConwayGovState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> EpochState era -> f (EpochState era)
epochStateGovStateL ((ConwayGovState era -> Identity (ConwayGovState era))
 -> EpochState era -> Identity (EpochState era))
-> ConwayGovState era -> EpochState era -> EpochState era
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 NewEpochState era
-> (NewEpochState era -> NewEpochState era) -> NewEpochState era
forall a b. a -> (a -> b) -> b
& (DRepPulsingState era -> Identity (DRepPulsingState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL ((DRepPulsingState era -> Identity (DRepPulsingState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> (DRepPulsingState era -> DRepPulsingState era)
-> NewEpochState era
-> NewEpochState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DRepPulsingState era -> DRepPulsingState era
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
(DefaultVote -> DefaultVote -> Bool)
-> (DefaultVote -> DefaultVote -> Bool) -> Eq DefaultVote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultVote -> DefaultVote -> Bool
== :: DefaultVote -> DefaultVote -> Bool
$c/= :: DefaultVote -> DefaultVote -> Bool
/= :: DefaultVote -> DefaultVote -> Bool
Eq, Int -> DefaultVote -> ShowS
[DefaultVote] -> ShowS
DefaultVote -> String
(Int -> DefaultVote -> ShowS)
-> (DefaultVote -> String)
-> ([DefaultVote] -> ShowS)
-> Show DefaultVote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefaultVote -> ShowS
showsPrec :: Int -> DefaultVote -> ShowS
$cshow :: DefaultVote -> String
show :: DefaultVote -> String
$cshowList :: [DefaultVote] -> ShowS
showList :: [DefaultVote] -> ShowS
Show)

instance FromCBOR DefaultVote where
  fromCBOR :: forall s. Decoder s DefaultVote
fromCBOR = do
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> DefaultVote -> Decoder s DefaultVote
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultVote
DefaultNo
      Word8
1 -> DefaultVote -> Decoder s DefaultVote
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultVote
DefaultAbstain
      Word8
2 -> DefaultVote -> Decoder s DefaultVote
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefaultVote
DefaultNoConfidence
      Word8
_ -> String -> Decoder s DefaultVote
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s DefaultVote)
-> String -> Decoder s DefaultVote
forall a b. (a -> b) -> a -> b
$ String
"Invalid DefaultVote tag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
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 (Maybe DRep -> DefaultVote) -> Maybe DRep -> DefaultVote
forall a b. (a -> b) -> a -> b
$
    KeyHash 'StakePool
-> Map (KeyHash 'StakePool) PoolParams -> Maybe PoolParams
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) PoolParams
poolParams Maybe PoolParams -> (PoolParams -> Maybe DRep) -> Maybe DRep
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PoolParams
d ->
      Credential 'Staking -> Map (Credential 'Staking) DRep -> Maybe DRep
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (RewardAccount -> Credential 'Staking
raCredential (RewardAccount -> Credential 'Staking)
-> RewardAccount -> Credential 'Staking
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 LedgerState era
-> Getting
     (StrictMaybe (Committee era))
     (LedgerState era)
     (StrictMaybe (Committee era))
-> StrictMaybe (Committee era)
forall s a. s -> Getting a s a -> a
^. (UTxOState era
 -> Const (StrictMaybe (Committee era)) (UTxOState era))
-> LedgerState era
-> Const (StrictMaybe (Committee era)) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era
  -> Const (StrictMaybe (Committee era)) (UTxOState era))
 -> LedgerState era
 -> Const (StrictMaybe (Committee era)) (LedgerState era))
-> ((StrictMaybe (Committee era)
     -> Const
          (StrictMaybe (Committee era)) (StrictMaybe (Committee era)))
    -> UTxOState era
    -> Const (StrictMaybe (Committee era)) (UTxOState era))
-> Getting
     (StrictMaybe (Committee era))
     (LedgerState era)
     (StrictMaybe (Committee era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era
 -> Const (StrictMaybe (Committee era)) (GovState era))
-> UTxOState era
-> Const (StrictMaybe (Committee era)) (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL ((GovState era
  -> Const (StrictMaybe (Committee era)) (GovState era))
 -> UTxOState era
 -> Const (StrictMaybe (Committee era)) (UTxOState era))
-> ((StrictMaybe (Committee era)
     -> Const
          (StrictMaybe (Committee era)) (StrictMaybe (Committee era)))
    -> GovState era
    -> Const (StrictMaybe (Committee era)) (GovState era))
-> (StrictMaybe (Committee era)
    -> Const
         (StrictMaybe (Committee era)) (StrictMaybe (Committee era)))
-> UTxOState era
-> Const (StrictMaybe (Committee era)) (UTxOState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (Committee era)
 -> Const
      (StrictMaybe (Committee era)) (StrictMaybe (Committee era)))
-> GovState era
-> Const (StrictMaybe (Committee era)) (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL of
    StrictMaybe (Committee era)
SNothing -> Set (Credential 'HotCommitteeRole)
forall a. Set a
Set.empty
    SJust Committee era
electedCommiteee ->
      Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Set (Credential 'HotCommitteeRole)
collectAuthorizedHotCreds (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> Set (Credential 'HotCommitteeRole))
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Set (Credential 'HotCommitteeRole)
forall a b. (a -> b) -> a -> b
$
        CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
forall era.
CommitteeState era
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds CommitteeState era
committeeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers Committee era
electedCommiteee
  where
    committeeState :: CommitteeState era
committeeState = LedgerState era
ledgerState LedgerState era
-> Getting
     (CommitteeState era) (LedgerState era) (CommitteeState era)
-> CommitteeState era
forall s a. s -> Getting a s a -> a
^. (CertState era -> Const (CommitteeState era) (CertState era))
-> LedgerState era -> Const (CommitteeState era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const (CommitteeState era) (CertState era))
 -> LedgerState era -> Const (CommitteeState era) (LedgerState era))
-> ((CommitteeState era
     -> Const (CommitteeState era) (CommitteeState era))
    -> CertState era -> Const (CommitteeState era) (CertState era))
-> Getting
     (CommitteeState era) (LedgerState era) (CommitteeState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VState era -> Const (CommitteeState era) (VState era))
-> CertState era -> Const (CommitteeState era) (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const (CommitteeState era) (VState era))
 -> CertState era -> Const (CommitteeState era) (CertState era))
-> ((CommitteeState era
     -> Const (CommitteeState era) (CommitteeState era))
    -> VState era -> Const (CommitteeState era) (VState era))
-> (CommitteeState era
    -> Const (CommitteeState era) (CommitteeState era))
-> CertState era
-> Const (CommitteeState era) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommitteeState era
 -> Const (CommitteeState era) (CommitteeState era))
-> VState era -> Const (CommitteeState era) (VState era)
forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState 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 -> Credential 'HotCommitteeRole
-> Set (Credential 'HotCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential 'HotCommitteeRole
hotCred Set (Credential 'HotCommitteeRole)
acc
            CommitteeMemberResigned {} -> Set (Credential 'HotCommitteeRole)
acc
       in (Set (Credential 'HotCommitteeRole)
 -> CommitteeAuthorization -> Set (Credential 'HotCommitteeRole))
-> Set (Credential 'HotCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Set (Credential 'HotCommitteeRole)
forall b a.
(b -> a -> b) -> b -> Map (Credential 'ColdCommitteeRole) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Set (Credential 'HotCommitteeRole)
-> CommitteeAuthorization -> Set (Credential 'HotCommitteeRole)
toHotCredSet Set (Credential 'HotCommitteeRole)
forall a. Set a
Set.empty