{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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,
  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,
  epochStateIncrStakeDistrL,
  epochStateRegDrepL,
  epochStateUMapL,
  pulseDRepPulsingState,
  completeDRepPulsingState,
  extractDRepPulsingState,
  forceDRepPulsingState,
  finishDRepPulser,
  computeDRepDistr,
  getRatifyState,
  conwayGovStateDRepDistrG,
  psDRepDistrG,
  PulsingSnapshot (..),
  setCompleteDRepPulsingState,
  setFreshDRepPulsingState,
  psProposalsL,
  psDRepDistrL,
  psDRepStateL,
  psPoolDistrL,
  RunConwayRatify (..),
  govStatePrevGovActionIds,
  mkEnactState,
  ratifySignalL,
  reStakeDistrL,
  reStakePoolDistrL,
  reDRepDistrL,
  reDRepStateL,
  reCurrentEpochL,
  reCommitteeStateL,

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

import Cardano.Ledger.BaseTypes (
  EpochNo (..),
  Globals (..),
  StrictMaybe (..),
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  decNoShareCBOR,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.CertState (Obligations (..))
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.Core
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.DRep (DRep (..))
import Cardano.Ledger.PoolDistr (PoolDistr (..))
import Cardano.Ledger.Shelley.Governance
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  NewEpochState (..),
  certDState,
  certVState,
  credMap,
  dsUnified,
  epochStateGovStateL,
  epochStatePoolParamsL,
  epochStateTreasuryL,
  esLStateL,
  lsCertState,
  lsUTxOState,
  newEpochStateGovStateL,
  utxosStakeDistr,
  vsCommitteeState,
  vsDReps,
 )
import Cardano.Ledger.UMap
import Cardano.Ledger.Val (Val (..))
import Control.DeepSeq (NFData (..))
import Control.Monad (guard)
import Control.Monad.Trans.Reader (ReaderT, ask)
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Default.Class (Default (..))
import Data.Foldable (Foldable (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Word (Word64)
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 => Int -> ConwayGovState era -> ShowS
forall era. EraPParams era => [ConwayGovState era] -> ShowS
forall era. EraPParams era => ConwayGovState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayGovState era] -> ShowS
$cshowList :: forall era. EraPParams era => [ConwayGovState era] -> ShowS
show :: ConwayGovState era -> String
$cshow :: forall era. EraPParams era => ConwayGovState era -> String
showsPrec :: Int -> ConwayGovState era -> ShowS
$cshowsPrec :: forall era. EraPParams era => Int -> ConwayGovState era -> ShowS
Show)

deriving instance EraPParams 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 ::
  SimpleGetter (ConwayGovState era) (Map (DRep (EraCrypto era)) (CompactForm Coin))
conwayGovStateDRepDistrG :: forall era.
SimpleGetter
  (ConwayGovState era)
  (Map (DRep (EraCrypto era)) (CompactForm Coin))
conwayGovStateDRepDistrG = forall s a. (s -> a) -> SimpleGetter s a
to (forall era.
PulsingSnapshot era
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
psDRepDistr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall 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 :: ConwayGovState era -> RatifyState era
getRatifyState :: forall 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.
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 :: ConwayGovState era -> ConwayGovState era
predictFuturePParams :: forall 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. 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 (EraCrypto era)) 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
    }

-- TODO: Implement Sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
instance EraPParams era => DecShareCBOR (ConwayGovState era) where
  decShareCBOR :: forall s.
Share (ConwayGovState era) -> Decoder s (ConwayGovState era)
decShareCBOR Share (ConwayGovState era)
_ =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
Proposals era
-> StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> FuturePParams era
-> DRepPulsingState era
-> ConwayGovState era
ConwayGovState
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From

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 => EncCBOR (ConwayGovState era) where
  encCBOR :: ConwayGovState era -> Encoding
encCBOR ConwayGovState {FuturePParams era
PParams 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 => 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 (ConwayGovState era)

instance EraPParams era => NoThunks (ConwayGovState era)

instance EraPParams era => ToJSON (ConwayGovState era) where
  toJSON :: ConwayGovState era -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a 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 e a era.
(KeyValue e a, EraPParams era) =>
ConwayGovState era -> [a]
toConwayGovPairs

toConwayGovPairs :: (KeyValue e a, EraPParams era) => ConwayGovState era -> [a]
toConwayGovPairs :: forall e a 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 {FuturePParams era
PParams 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. 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 c) => EraGov (ConwayEra c) where
  type GovState (ConwayEra c) = ConwayGovState (ConwayEra c)

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

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

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

  obligationGovState :: GovState (ConwayEra c) -> Obligations
obligationGovState GovState (ConwayEra c)
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 c)
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 => 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 Crypto c => ConwayEraGov (ConwayEra c) where
  constitutionGovStateL :: Lens' (GovState (ConwayEra c)) (Constitution (ConwayEra c))
constitutionGovStateL = forall era. Lens' (ConwayGovState era) (Constitution era)
cgsConstitutionL
  proposalsGovStateL :: Lens' (GovState (ConwayEra c)) (Proposals (ConwayEra c))
proposalsGovStateL = forall era. Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL
  drepPulsingStateGovStateL :: Lens' (GovState (ConwayEra c)) (DRepPulsingState (ConwayEra c))
drepPulsingStateGovStateL = forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL
  committeeGovStateL :: Lens'
  (GovState (ConwayEra c)) (StrictMaybe (Committee (ConwayEra c)))
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
  ) =>
  EpochNo ->
  PoolDistr (EraCrypto era) ->
  EpochState era ->
  ReaderT Globals m (EpochState era)
setFreshDRepPulsingState :: forall era (m :: * -> *).
(GovState era ~ ConwayGovState era, Monad m, RunConwayRatify era,
 ConwayEraGov era) =>
EpochNo
-> PoolDistr (EraCrypto era)
-> EpochState era
-> ReaderT Globals m (EpochState era)
setFreshDRepPulsingState EpochNo
epochNo PoolDistr (EraCrypto era)
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
      stakeDistr :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stakeDistr = forall c.
IncrementalStake c
-> Map (Credential 'Staking c) (CompactForm Coin)
credMap forall a b. (a -> b) -> a -> b
$ forall era. UTxOState era -> IncrementalStake (EraCrypto era)
utxosStakeDistr UTxOState era
utxoState
      certState :: CertState era
certState = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ledgerState
      dState :: DState era
dState = forall era. CertState era -> DState era
certDState CertState era
certState
      vState :: VState era
vState = forall era. CertState era -> VState era
certVState CertState era
certState
      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 :: Word64
k = Globals -> Word64
securityParameter Globals
globals -- On mainnet set to 2160
      umap :: UMap (EraCrypto era)
umap = forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
dState
      umapSize :: Int
umapSize = forall k a. Map k a -> Int
Map.size forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems UMap (EraCrypto era)
umap
      pulseSize :: Int
pulseSize = forall a. Ord a => a -> a -> a
max Int
1 (Int
umapSize forall a. Integral a => a -> a -> a
`div` (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Int) (Word64
4 forall a. Num a => a -> a -> a
* Word64
k))
      govState' :: ConwayGovState era
govState' =
        forall 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 = Int
pulseSize
                    , dpUMap :: UMap (EraCrypto era)
dpUMap = forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
dState
                    , dpIndex :: Int
dpIndex = Int
0 -- used as the index of the remaining UMap
                    , dpStakeDistr :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpStakeDistr = Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stakeDistr -- used as part of the snapshot
                    , dpStakePoolDistr :: PoolDistr (EraCrypto era)
dpStakePoolDistr = PoolDistr (EraCrypto era)
stakePoolDistr
                    , dpDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
dpDRepDistr = forall k a. Map k a
Map.empty -- The partial result starts as the empty map
                    , dpDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState = forall era.
VState era
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
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 era. Lens' (EpochState era) Coin
epochStateTreasuryL
                    , dpProposals :: StrictSeq (GovActionState era)
dpProposals = forall era. Proposals era -> StrictSeq (GovActionState era)
proposalsActions Proposals era
props
                    , dpProposalDeposits :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpProposalDeposits = forall era.
Proposals era
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
proposalsDeposits Proposals era
props
                    , dpGlobals :: Globals
dpGlobals = Globals
globals
                    , dpPoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpPoolParams = EpochState era
epochState forall s a. s -> Getting a s a -> a
^. forall era.
Lens'
  (EpochState era)
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
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. DRepPulsingState era -> DRepPulsingState era
completeDRepPulsingState