{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# 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.DRepPulser (
  DRepPulsingState (..),
  DRepPulser (..),
  pulseDRepPulsingState,
  completeDRepPulsingState,
  extractDRepPulsingState,
  finishDRepPulser,
  computeDRepDistr,
  psDRepDistrG,
  PulsingSnapshot (..),
  psProposalsL,
  psDRepDistrL,
  psDRepStateL,
  psPoolDistrL,
  RunConwayRatify (..),
) where

import Cardano.Ledger.BaseTypes (EpochNo (..), Globals (..))
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.CertState (CommitteeState)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Era (ConwayRATIFY)
import Cardano.Ledger.Conway.Governance.Internal
import Cardano.Ledger.Conway.Governance.Procedures (GovActionState)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.PoolDistr
import Cardano.Ledger.PoolParams (PoolParams)
import Cardano.Ledger.UMap
import qualified Cardano.Ledger.UMap as UMap
import Control.DeepSeq (NFData (..), deepseq)
import Control.Monad (guard)
import Control.Monad.Trans.Reader (Reader, runReader)
import Control.State.Transition.Extended
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Default (Default (..))
import Data.Functor.Identity (Identity)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Pulse (Pulsable (..), pulse)
import Data.Sequence.Strict (StrictSeq (..))
import Data.Void (Void, absurd)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..), allNoThunks)

-- | A snapshot of information from the previous epoch stored inside the Pulser.
--   After the pulser completes, but before the epoch turns, this information
--   is store in the 'DRComplete' constructor of the 'DRepPulsingState'
--   These are the values at the start of the current epoch. This allows the API
--   To access these "previous" values, both during and after pulsing.
data PulsingSnapshot era = PulsingSnapshot
  { forall era. PulsingSnapshot era -> StrictSeq (GovActionState era)
psProposals :: !(StrictSeq (GovActionState era))
  , forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepDistr :: !(Map DRep (CompactForm Coin))
  , forall era.
PulsingSnapshot era -> Map (Credential 'DRepRole) DRepState
psDRepState :: !(Map (Credential 'DRepRole) DRepState)
  , forall era.
PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr :: Map (KeyHash 'StakePool) (CompactForm Coin)
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (PulsingSnapshot era) x -> PulsingSnapshot era
forall era x. PulsingSnapshot era -> Rep (PulsingSnapshot era) x
$cto :: forall era x. Rep (PulsingSnapshot era) x -> PulsingSnapshot era
$cfrom :: forall era x. PulsingSnapshot era -> Rep (PulsingSnapshot era) x
Generic)

psProposalsL :: Lens' (PulsingSnapshot era) (StrictSeq (GovActionState era))
psProposalsL :: forall era.
Lens' (PulsingSnapshot era) (StrictSeq (GovActionState era))
psProposalsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. PulsingSnapshot era -> StrictSeq (GovActionState era)
psProposals (\PulsingSnapshot era
x StrictSeq (GovActionState era)
y -> PulsingSnapshot era
x {psProposals :: StrictSeq (GovActionState era)
psProposals = StrictSeq (GovActionState era)
y})

psDRepDistrL :: Lens' (PulsingSnapshot era) (Map DRep (CompactForm Coin))
psDRepDistrL :: forall era.
Lens' (PulsingSnapshot era) (Map DRep (CompactForm Coin))
psDRepDistrL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepDistr (\PulsingSnapshot era
x Map DRep (CompactForm Coin)
y -> PulsingSnapshot era
x {psDRepDistr :: Map DRep (CompactForm Coin)
psDRepDistr = Map DRep (CompactForm Coin)
y})

psDRepStateL ::
  Lens' (PulsingSnapshot era) (Map (Credential 'DRepRole) DRepState)
psDRepStateL :: forall era.
Lens' (PulsingSnapshot era) (Map (Credential 'DRepRole) DRepState)
psDRepStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era.
PulsingSnapshot era -> Map (Credential 'DRepRole) DRepState
psDRepState (\PulsingSnapshot era
x Map (Credential 'DRepRole) DRepState
y -> PulsingSnapshot era
x {psDRepState :: Map (Credential 'DRepRole) DRepState
psDRepState = Map (Credential 'DRepRole) DRepState
y})

psPoolDistrL ::
  Lens'
    (PulsingSnapshot era)
    (Map (KeyHash 'StakePool) (CompactForm Coin))
psPoolDistrL :: forall era.
Lens'
  (PulsingSnapshot era) (Map (KeyHash 'StakePool) (CompactForm Coin))
psPoolDistrL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era.
PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr (\PulsingSnapshot era
x Map (KeyHash 'StakePool) (CompactForm Coin)
y -> PulsingSnapshot era
x {psPoolDistr :: Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr = Map (KeyHash 'StakePool) (CompactForm Coin)
y})

deriving instance EraPParams era => Eq (PulsingSnapshot era)

deriving instance EraPParams era => Show (PulsingSnapshot era)

instance EraPParams era => NFData (PulsingSnapshot era)

instance EraPParams era => NoThunks (PulsingSnapshot era)

toPulsingSnapshotsPairs :: (KeyValue e a, EraPParams era) => PulsingSnapshot era -> [a]
toPulsingSnapshotsPairs :: forall e a era.
(KeyValue e a, EraPParams era) =>
PulsingSnapshot era -> [a]
toPulsingSnapshotsPairs gas :: PulsingSnapshot era
gas@(PulsingSnapshot StrictSeq (GovActionState era)
_ Map DRep (CompactForm Coin)
_ Map (Credential 'DRepRole) DRepState
_ Map (KeyHash 'StakePool) (CompactForm Coin)
_) =
  let (PulsingSnapshot {Map (KeyHash 'StakePool) (CompactForm Coin)
Map DRep (CompactForm Coin)
Map (Credential 'DRepRole) DRepState
StrictSeq (GovActionState era)
psPoolDistr :: Map (KeyHash 'StakePool) (CompactForm Coin)
psDRepState :: Map (Credential 'DRepRole) DRepState
psDRepDistr :: Map DRep (CompactForm Coin)
psProposals :: StrictSeq (GovActionState era)
psPoolDistr :: forall era.
PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psDRepState :: forall era.
PulsingSnapshot era -> Map (Credential 'DRepRole) DRepState
psDRepDistr :: forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psProposals :: forall era. PulsingSnapshot era -> StrictSeq (GovActionState era)
..}) = PulsingSnapshot era
gas
   in [ Key
"psProposals" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictSeq (GovActionState era)
psProposals
      , Key
"psDRepDistr" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map DRep (CompactForm Coin)
psDRepDistr
      , Key
"psDRepState" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'DRepRole) DRepState
psDRepState
      , Key
"psPoolDistr" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr
      ]

instance EraPParams era => ToJSON (PulsingSnapshot era) where
  toJSON :: PulsingSnapshot 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) =>
PulsingSnapshot era -> [a]
toPulsingSnapshotsPairs
  toEncoding :: PulsingSnapshot 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) =>
PulsingSnapshot era -> [a]
toPulsingSnapshotsPairs

instance Default (PulsingSnapshot era) where
  def :: PulsingSnapshot era
def = forall era.
StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot forall a. Monoid a => a
mempty forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def

instance EraPParams era => EncCBOR (PulsingSnapshot era) where
  encCBOR :: PulsingSnapshot era -> Encoding
encCBOR PulsingSnapshot {Map (KeyHash 'StakePool) (CompactForm Coin)
Map DRep (CompactForm Coin)
Map (Credential 'DRepRole) DRepState
StrictSeq (GovActionState era)
psPoolDistr :: Map (KeyHash 'StakePool) (CompactForm Coin)
psDRepState :: Map (Credential 'DRepRole) DRepState
psDRepDistr :: Map DRep (CompactForm Coin)
psProposals :: StrictSeq (GovActionState era)
psPoolDistr :: forall era.
PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psDRepState :: forall era.
PulsingSnapshot era -> Map (Credential 'DRepRole) DRepState
psDRepDistr :: forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psProposals :: forall era. PulsingSnapshot era -> StrictSeq (GovActionState 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.
StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot
        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 StrictSeq (GovActionState era)
psProposals
        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 Map DRep (CompactForm Coin)
psDRepDistr
        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 Map (Credential 'DRepRole) DRepState
psDRepState
        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 Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr

-- TODO: Implement Sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
instance EraPParams era => DecShareCBOR (PulsingSnapshot era) where
  decShareCBOR :: forall s.
Share (PulsingSnapshot era) -> Decoder s (PulsingSnapshot era)
decShareCBOR Share (PulsingSnapshot 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.
StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot
        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 (PulsingSnapshot era) where
  decCBOR :: forall s. Decoder s (PulsingSnapshot era)
decCBOR =
    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.
StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot
        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 => ToCBOR (PulsingSnapshot era) where
  toCBOR :: PulsingSnapshot era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

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

-- | We iterate over a pulse-sized chunk of the UMap.
--
-- For each staking credential in the chunk that has delegated to a DRep, add
-- the stake distribution, rewards, and proposal deposits for that credential to
-- the DRep distribution, if the DRep is a DRepCredential (also, AlwaysAbstain
-- or AlwaysNoConfidence) and a member of the registered DReps. If the
-- DRepCredential is not a member of the registered DReps, ignore and skip that
-- DRep.
--
-- For each staking credential in the chunk that has delegated to an SPO,
-- add only the proposal deposits for that credential to the stake pool
-- distribution, since the rewards and stake are already added to it by the
-- SNAP rule.
--
-- Give or take, this operation has roughly
-- @
--   O (a * (log(b) + log(c) + log(d) + log(e) + log(f)))
-- @
-- complexity, where,
--   (a) is the size of the chunk of the UMap, which is the pulse-size, iterate over
--   (b) is the size of the StakeDistr, lookup
--   (c) is the size of the DRepDistr, insertWith
--   (d) is the size of the dpProposalDeposits, lookup
--   (e) is the size of the registered DReps, lookup
--   (f) is the size of the PoolDistr, insert
computeDRepDistr ::
  Map (Credential 'Staking) (CompactForm Coin) ->
  Map (Credential 'DRepRole) DRepState ->
  Map (Credential 'Staking) (CompactForm Coin) ->
  PoolDistr ->
  Map DRep (CompactForm Coin) ->
  Map (Credential 'Staking) UMElem ->
  (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr :: Map (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr Map (Credential 'Staking) (CompactForm Coin)
stakeDistr Map (Credential 'DRepRole) DRepState
regDReps Map (Credential 'Staking) (CompactForm Coin)
proposalDeposits PoolDistr
poolDistr Map DRep (CompactForm Coin)
dRepDistr Map (Credential 'Staking) UMElem
uMapChunk =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Map DRep (CompactForm Coin), PoolDistr)
-> Credential 'Staking
-> UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
go (Map DRep (CompactForm Coin)
dRepDistr, PoolDistr
poolDistr) Map (Credential 'Staking) UMElem
uMapChunk
  where
    go :: (Map DRep (CompactForm Coin), PoolDistr)
-> Credential 'Staking
-> UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
go (!Map DRep (CompactForm Coin)
drepAccum, !PoolDistr
poolAccum) Credential 'Staking
stakeCred UMElem
umElem =
      let stake :: CompactForm Coin
stake = forall a. a -> Maybe a -> a
fromMaybe (Word64 -> CompactForm Coin
CompactCoin Word64
0) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
stakeCred Map (Credential 'Staking) (CompactForm Coin)
stakeDistr
          proposalDeposit :: CompactForm Coin
proposalDeposit = forall a. a -> Maybe a -> a
fromMaybe (Word64 -> CompactForm Coin
CompactCoin Word64
0) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
stakeCred Map (Credential 'Staking) (CompactForm Coin)
proposalDeposits
          stakeAndDeposits :: CompactForm Coin
stakeAndDeposits = CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
stake CompactForm Coin
proposalDeposit
       in case UMElem -> Maybe RewardDelegation
umElemDelegations UMElem
umElem of
            Maybe RewardDelegation
Nothing -> (Map DRep (CompactForm Coin)
drepAccum, PoolDistr
poolAccum)
            Just (RewardDelegationSPO KeyHash 'StakePool
spo CompactForm Coin
_r) ->
              ( Map DRep (CompactForm Coin)
drepAccum
              , KeyHash 'StakePool -> CompactForm Coin -> PoolDistr -> PoolDistr
addToPoolDistr KeyHash 'StakePool
spo CompactForm Coin
proposalDeposit PoolDistr
poolAccum
              )
            Just (RewardDelegationDRep DRep
drep CompactForm Coin
r) ->
              ( DRep
-> CompactForm Coin
-> Map DRep (CompactForm Coin)
-> Map DRep (CompactForm Coin)
addToDRepDistr DRep
drep (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
stakeAndDeposits CompactForm Coin
r) Map DRep (CompactForm Coin)
drepAccum
              , PoolDistr
poolAccum
              )
            Just (RewardDelegationBoth KeyHash 'StakePool
spo DRep
drep CompactForm Coin
r) ->
              ( DRep
-> CompactForm Coin
-> Map DRep (CompactForm Coin)
-> Map DRep (CompactForm Coin)
addToDRepDistr DRep
drep (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
stakeAndDeposits CompactForm Coin
r) Map DRep (CompactForm Coin)
drepAccum
              , KeyHash 'StakePool -> CompactForm Coin -> PoolDistr -> PoolDistr
addToPoolDistr KeyHash 'StakePool
spo CompactForm Coin
proposalDeposit PoolDistr
poolAccum
              )
    addToPoolDistr :: KeyHash 'StakePool -> CompactForm Coin -> PoolDistr -> PoolDistr
addToPoolDistr KeyHash 'StakePool
spo CompactForm Coin
proposalDeposit PoolDistr
distr = forall a. a -> Maybe a -> a
fromMaybe PoolDistr
distr forall a b. (a -> b) -> a -> b
$ do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CompactForm Coin
proposalDeposit forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty)
      IndividualPoolStake
ips <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
spo forall a b. (a -> b) -> a -> b
$ PoolDistr
distr forall s a. s -> Getting a s a -> a
^. Lens' PoolDistr (Map (KeyHash 'StakePool) IndividualPoolStake)
poolDistrDistrL
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        PoolDistr
distr
          forall a b. a -> (a -> b) -> b
& Lens' PoolDistr (Map (KeyHash 'StakePool) IndividualPoolStake)
poolDistrDistrL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool
spo (IndividualPoolStake
ips forall a b. a -> (a -> b) -> b
& Lens' IndividualPoolStake (CompactForm Coin)
individualTotalPoolStakeL forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ CompactForm Coin
proposalDeposit)
          forall a b. a -> (a -> b) -> b
& Lens' PoolDistr (CompactForm Coin)
poolDistrTotalL forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ CompactForm Coin
proposalDeposit
    addToDRepDistr :: DRep
-> CompactForm Coin
-> Map DRep (CompactForm Coin)
-> Map DRep (CompactForm Coin)
addToDRepDistr DRep
drep CompactForm Coin
ccoin Map DRep (CompactForm Coin)
distr =
      let updatedDistr :: Map DRep (CompactForm Coin)
updatedDistr = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact DRep
drep CompactForm Coin
ccoin Map DRep (CompactForm Coin)
distr
       in case DRep
drep of
            DRep
DRepAlwaysAbstain -> Map DRep (CompactForm Coin)
updatedDistr
            DRep
DRepAlwaysNoConfidence -> Map DRep (CompactForm Coin)
updatedDistr
            DRepCredential Credential 'DRepRole
cred
              | forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'DRepRole
cred Map (Credential 'DRepRole) DRepState
regDReps -> Map DRep (CompactForm Coin)
updatedDistr
              | Bool
otherwise -> Map DRep (CompactForm Coin)
distr

-- | The type of a Pulser which uses 'computeDRepDistr' as its underlying
-- function. Note that we use two type equality (~) constraints to fix both
-- the monad 'm' and the 'ans' type, to the context where we will use the
-- type as a Pulser. The type DRepPulser must have 'm' and 'ans' as its last
-- two parameters so we can make a Pulsable instance. We will always use this
-- instantiation (DRepPulser era Identity (RatifyState era))
data DRepPulser era (m :: Type -> Type) ans where
  DRepPulser ::
    forall era ans m.
    (ans ~ RatifyState era, m ~ Identity, RunConwayRatify era) =>
    { forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpPulseSize :: !Int
    -- ^ How many elements of 'dpUMap' to consume each pulse.
    , forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpUMap :: !UMap
    -- ^ Snapshot containing the mapping of stake credentials to DReps, Pools and Rewards.
    , forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpIndex :: !Int
    -- ^ The index of the iterator over `dpUMap`. Grows with each pulse.
    , forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpStakeDistr :: !(Map (Credential 'Staking) (CompactForm Coin))
    -- ^ Snapshot of the stake distr (comes from the IncrementalStake)
    , forall era ans (m :: * -> *). DRepPulser era m ans -> PoolDistr
dpStakePoolDistr :: PoolDistr
    -- ^ Snapshot of the pool distr. Lazy on purpose: See `ssStakeMarkPoolDistr` and ADR-7
    -- for explanation.
    , forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpDRepDistr :: !(Map DRep (CompactForm Coin))
    -- ^ The partial result that grows with each pulse. The purpose of the pulsing.
    , forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpDRepState :: !(Map (Credential 'DRepRole) DRepState)
    -- ^ Snapshot of registered DRep credentials
    , forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCurrentEpoch :: !EpochNo
    -- ^ Snapshot of the EpochNo this pulser will complete in.
    , forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpCommitteeState :: !(CommitteeState era)
    -- ^ Snapshot of the CommitteeState
    , forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpEnactState :: !(EnactState era)
    -- ^ Snapshot of the EnactState, Used to build the Env of the RATIFY rule
    , forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposals :: !(StrictSeq (GovActionState era))
    -- ^ Snapshot of the proposals. This is the Signal for the RATIFY rule
    , forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpProposalDeposits :: !(Map (Credential 'Staking) (CompactForm Coin))
    -- ^ Snapshot of the proposal-deposits per reward-account-staking-credential
    , forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpGlobals :: !Globals
    , forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (KeyHash 'StakePool) PoolParams
dpPoolParams :: !(Map (KeyHash 'StakePool) PoolParams)
    -- ^ Snapshot of the parameters of stake pools -
    --   this is needed to get the reward account for SPO vote calculation
    } ->
    DRepPulser era m ans

instance EraPParams era => Eq (DRepPulser era Identity (RatifyState era)) where
  DRepPulser era Identity (RatifyState era)
x == :: DRepPulser era Identity (RatifyState era)
-> DRepPulser era Identity (RatifyState era) -> Bool
== DRepPulser era Identity (RatifyState era)
y = forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
x) forall a. Eq a => a -> a -> Bool
== forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
y)

instance Pulsable (DRepPulser era) where
  done :: forall (m :: * -> *) ans. DRepPulser era m ans -> Bool
done DRepPulser {UMap
dpUMap :: UMap
dpUMap :: forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpUMap, Int
dpIndex :: Int
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpIndex} = Int
dpIndex forall a. Ord a => a -> a -> Bool
>= forall k a. Map k a -> Int
Map.size (UMap -> Map (Credential 'Staking) UMElem
UMap.umElems UMap
dpUMap)

  current :: forall (m :: * -> *) ans. DRepPulser era m ans -> ans
current x :: DRepPulser era m ans
x@(DRepPulser {}) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era m ans
x)

  pulseM :: forall (m :: * -> *) ans.
Monad m =>
DRepPulser era m ans -> m (DRepPulser era m ans)
pulseM pulser :: DRepPulser era m ans
pulser@(DRepPulser {Int
Map (KeyHash 'StakePool) PoolParams
Map DRep (CompactForm Coin)
Map (Credential 'Staking) (CompactForm Coin)
Map (Credential 'DRepRole) DRepState
StrictSeq (GovActionState era)
CommitteeState era
UMap
PoolDistr
Globals
EpochNo
EnactState era
dpPoolParams :: Map (KeyHash 'StakePool) PoolParams
dpGlobals :: Globals
dpProposalDeposits :: Map (Credential 'Staking) (CompactForm Coin)
dpProposals :: StrictSeq (GovActionState era)
dpEnactState :: EnactState era
dpCommitteeState :: CommitteeState era
dpCurrentEpoch :: EpochNo
dpDRepState :: Map (Credential 'DRepRole) DRepState
dpDRepDistr :: Map DRep (CompactForm Coin)
dpStakePoolDistr :: PoolDistr
dpStakeDistr :: Map (Credential 'Staking) (CompactForm Coin)
dpIndex :: Int
dpUMap :: UMap
dpPulseSize :: Int
dpPoolParams :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (KeyHash 'StakePool) PoolParams
dpGlobals :: forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpProposalDeposits :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpProposals :: forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpEnactState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpCommitteeState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpCurrentEpoch :: forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpDRepState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpDRepDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpStakePoolDistr :: forall era ans (m :: * -> *). DRepPulser era m ans -> PoolDistr
dpStakeDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpUMap :: forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpPulseSize :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
..})
    | forall (pulse :: (* -> *) -> * -> *) (m :: * -> *) ans.
Pulsable pulse =>
pulse m ans -> Bool
done DRepPulser era m ans
pulser = forall (f :: * -> *) a. Applicative f => a -> f a
pure DRepPulser era m ans
pulser {dpIndex :: Int
dpIndex = Int
0}
    | Bool
otherwise =
        let !chunk :: Map (Credential 'Staking) UMElem
chunk = forall k a. Int -> Map k a -> Map k a
Map.take Int
dpPulseSize forall a b. (a -> b) -> a -> b
$ forall k a. Int -> Map k a -> Map k a
Map.drop Int
dpIndex forall a b. (a -> b) -> a -> b
$ UMap -> Map (Credential 'Staking) UMElem
UMap.umElems UMap
dpUMap
            (Map DRep (CompactForm Coin)
dRepDistr, PoolDistr
poolDistr) =
              Map (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr Map (Credential 'Staking) (CompactForm Coin)
dpStakeDistr Map (Credential 'DRepRole) DRepState
dpDRepState Map (Credential 'Staking) (CompactForm Coin)
dpProposalDeposits PoolDistr
dpStakePoolDistr Map DRep (CompactForm Coin)
dpDRepDistr Map (Credential 'Staking) UMElem
chunk
         in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
              DRepPulser era m ans
pulser
                { dpIndex :: Int
dpIndex = Int
dpIndex forall a. Num a => a -> a -> a
+ Int
dpPulseSize
                , dpDRepDistr :: Map DRep (CompactForm Coin)
dpDRepDistr = Map DRep (CompactForm Coin)
dRepDistr
                , dpStakePoolDistr :: PoolDistr
dpStakePoolDistr = PoolDistr
poolDistr
                }

  completeM :: forall (m :: * -> *) ans. Monad m => DRepPulser era m ans -> m ans
completeM x :: DRepPulser era m ans
x@(DRepPulser {}) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser @era (forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era m ans
x))

deriving instance (EraPParams era, Show ans) => Show (DRepPulser era m ans)

instance EraPParams era => NoThunks (DRepPulser era Identity (RatifyState era)) where
  showTypeOf :: Proxy (DRepPulser era Identity (RatifyState era)) -> String
showTypeOf Proxy (DRepPulser era Identity (RatifyState era))
_ = String
"DRepPulser"
  wNoThunks :: Context
-> DRepPulser era Identity (RatifyState era)
-> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt drp :: DRepPulser era Identity (RatifyState era)
drp@(DRepPulser Int
_ UMap
_ Int
_ Map (Credential 'Staking) (CompactForm Coin)
_ PoolDistr
_ Map DRep (CompactForm Coin)
_ Map (Credential 'DRepRole) DRepState
_ EpochNo
_ CommitteeState era
_ EnactState era
_ StrictSeq (GovActionState era)
_ Map (Credential 'Staking) (CompactForm Coin)
_ Globals
_ Map (KeyHash 'StakePool) PoolParams
_) =
    [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
      [ forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpPulseSize DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpUMap DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpIndex DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpStakeDistr DRepPulser era Identity (RatifyState era)
drp)
      , -- dpStakePoolDistr is allowed to have thunks
        forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpDRepDistr DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpDRepState DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCurrentEpoch DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpCommitteeState DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpEnactState DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposals DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpProposalDeposits DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpGlobals DRepPulser era Identity (RatifyState era)
drp)
      , forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (KeyHash 'StakePool) PoolParams
dpPoolParams DRepPulser era Identity (RatifyState era)
drp)
      ]

instance EraPParams era => NFData (DRepPulser era Identity (RatifyState era)) where
  rnf :: DRepPulser era Identity (RatifyState era) -> ()
rnf (DRepPulser Int
n UMap
um Int
bal Map (Credential 'Staking) (CompactForm Coin)
stake PoolDistr
pool Map DRep (CompactForm Coin)
drep Map (Credential 'DRepRole) DRepState
dstate EpochNo
ep CommitteeState era
cs EnactState era
es StrictSeq (GovActionState era)
as Map (Credential 'Staking) (CompactForm Coin)
pds Globals
gs Map (KeyHash 'StakePool) PoolParams
poolps) =
    Int
n forall a b. NFData a => a -> b -> b
`deepseq`
      UMap
um forall a b. NFData a => a -> b -> b
`deepseq`
        Int
bal forall a b. NFData a => a -> b -> b
`deepseq`
          Map (Credential 'Staking) (CompactForm Coin)
stake forall a b. NFData a => a -> b -> b
`deepseq`
            PoolDistr
pool forall a b. NFData a => a -> b -> b
`deepseq`
              Map DRep (CompactForm Coin)
drep forall a b. NFData a => a -> b -> b
`deepseq`
                Map (Credential 'DRepRole) DRepState
dstate forall a b. NFData a => a -> b -> b
`deepseq`
                  EpochNo
ep forall a b. NFData a => a -> b -> b
`deepseq`
                    CommitteeState era
cs forall a b. NFData a => a -> b -> b
`deepseq`
                      EnactState era
es forall a b. NFData a => a -> b -> b
`deepseq`
                        StrictSeq (GovActionState era)
as forall a b. NFData a => a -> b -> b
`deepseq`
                          Map (Credential 'Staking) (CompactForm Coin)
pds forall a b. NFData a => a -> b -> b
`deepseq`
                            Globals
gs forall a b. NFData a => a -> b -> b
`deepseq`
                              forall a. NFData a => a -> ()
rnf Map (KeyHash 'StakePool) PoolParams
poolps

class
  ( STS (ConwayRATIFY era)
  , Signal (ConwayRATIFY era) ~ RatifySignal era
  , BaseM (ConwayRATIFY era) ~ Reader Globals
  , Environment (ConwayRATIFY era) ~ RatifyEnv era
  , State (ConwayRATIFY era) ~ RatifyState era
  , PredicateFailure (ConwayRATIFY era) ~ Void
  ) =>
  RunConwayRatify era
  where
  runConwayRatify ::
    Globals -> RatifyEnv era -> RatifyState era -> RatifySignal era -> RatifyState era
  runConwayRatify Globals
globals RatifyEnv era
ratifyEnv RatifyState era
ratifyState (RatifySignal StrictSeq (GovActionState era)
ratifySig) =
    let ratifyResult :: Either (NonEmpty Void) (RatifyState era)
ratifyResult =
          forall r a. Reader r a -> r -> a
runReader
            ( forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTS @(ConwayRATIFY era) forall a b. (a -> b) -> a -> b
$
                forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (RatifyEnv era
ratifyEnv, RatifyState era
ratifyState, forall era. StrictSeq (GovActionState era) -> RatifySignal era
RatifySignal forall a b. (a -> b) -> a -> b
$ forall era.
StrictSeq (GovActionState era) -> StrictSeq (GovActionState era)
reorderActions StrictSeq (GovActionState era)
ratifySig)
            )
            Globals
globals
     in case Either (NonEmpty Void) (RatifyState era)
ratifyResult of
          Left (Void
x :| [Void]
_) -> forall a. Void -> a
absurd Void
x
          Right RatifyState era
ratifyState' -> RatifyState era
ratifyState'

finishDRepPulser :: forall era. DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser :: forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (DRComplete PulsingSnapshot era
snap RatifyState era
ratifyState) = (PulsingSnapshot era
snap, RatifyState era
ratifyState)
finishDRepPulser (DRPulsing (DRepPulser {Int
Map (KeyHash 'StakePool) PoolParams
Map DRep (CompactForm Coin)
Map (Credential 'Staking) (CompactForm Coin)
Map (Credential 'DRepRole) DRepState
StrictSeq (GovActionState era)
CommitteeState era
UMap
PoolDistr
Globals
EpochNo
EnactState era
dpPoolParams :: Map (KeyHash 'StakePool) PoolParams
dpGlobals :: Globals
dpProposalDeposits :: Map (Credential 'Staking) (CompactForm Coin)
dpProposals :: StrictSeq (GovActionState era)
dpEnactState :: EnactState era
dpCommitteeState :: CommitteeState era
dpCurrentEpoch :: EpochNo
dpDRepState :: Map (Credential 'DRepRole) DRepState
dpDRepDistr :: Map DRep (CompactForm Coin)
dpStakePoolDistr :: PoolDistr
dpStakeDistr :: Map (Credential 'Staking) (CompactForm Coin)
dpIndex :: Int
dpUMap :: UMap
dpPulseSize :: Int
dpPoolParams :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (KeyHash 'StakePool) PoolParams
dpGlobals :: forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpProposalDeposits :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpProposals :: forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpEnactState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpCommitteeState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpCurrentEpoch :: forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpDRepState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpDRepDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpStakePoolDistr :: forall era ans (m :: * -> *). DRepPulser era m ans -> PoolDistr
dpStakeDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpUMap :: forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpPulseSize :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
..})) =
  ( forall era.
StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot
      StrictSeq (GovActionState era)
dpProposals
      Map DRep (CompactForm Coin)
finalDRepDistr
      Map (Credential 'DRepRole) DRepState
dpDRepState
      (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map IndividualPoolStake -> CompactForm Coin
individualTotalPoolStake forall a b. (a -> b) -> a -> b
$ PoolDistr -> Map (KeyHash 'StakePool) IndividualPoolStake
unPoolDistr PoolDistr
finalStakePoolDistr)
  , RatifyState era
ratifyState'
  )
  where
    !leftOver :: Map (Credential 'Staking) UMElem
leftOver = forall k a. Int -> Map k a -> Map k a
Map.drop Int
dpIndex forall a b. (a -> b) -> a -> b
$ UMap -> Map (Credential 'Staking) UMElem
umElems UMap
dpUMap
    (Map DRep (CompactForm Coin)
finalDRepDistr, PoolDistr
finalStakePoolDistr) =
      Map (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr Map (Credential 'Staking) (CompactForm Coin)
dpStakeDistr Map (Credential 'DRepRole) DRepState
dpDRepState Map (Credential 'Staking) (CompactForm Coin)
dpProposalDeposits PoolDistr
dpStakePoolDistr Map DRep (CompactForm Coin)
dpDRepDistr Map (Credential 'Staking) UMElem
leftOver
    !ratifyEnv :: RatifyEnv era
ratifyEnv =
      RatifyEnv
        { reStakeDistr :: Map (Credential 'Staking) (CompactForm Coin)
reStakeDistr = Map (Credential 'Staking) (CompactForm Coin)
dpStakeDistr
        , reStakePoolDistr :: PoolDistr
reStakePoolDistr = PoolDistr
finalStakePoolDistr
        , reDRepDistr :: Map DRep (CompactForm Coin)
reDRepDistr = Map DRep (CompactForm Coin)
finalDRepDistr
        , reDRepState :: Map (Credential 'DRepRole) DRepState
reDRepState = Map (Credential 'DRepRole) DRepState
dpDRepState
        , reCurrentEpoch :: EpochNo
reCurrentEpoch = EpochNo
dpCurrentEpoch
        , reCommitteeState :: CommitteeState era
reCommitteeState = CommitteeState era
dpCommitteeState
        , reDelegatees :: Map (Credential 'Staking) DRep
reDelegatees = UMap -> Map (Credential 'Staking) DRep
dRepMap UMap
dpUMap
        , rePoolParams :: Map (KeyHash 'StakePool) PoolParams
rePoolParams = Map (KeyHash 'StakePool) PoolParams
dpPoolParams
        }
    !ratifySig :: RatifySignal era
ratifySig = forall era. StrictSeq (GovActionState era) -> RatifySignal era
RatifySignal StrictSeq (GovActionState era)
dpProposals
    !ratifyState :: RatifyState era
ratifyState =
      RatifyState
        { rsEnactState :: EnactState era
rsEnactState = EnactState era
dpEnactState
        , rsEnacted :: Seq (GovActionState era)
rsEnacted = forall a. Monoid a => a
mempty
        , rsExpired :: Set GovActionId
rsExpired = forall a. Monoid a => a
mempty
        , rsDelayed :: Bool
rsDelayed = Bool
False
        }
    !ratifyState' :: RatifyState era
ratifyState' = forall era.
RunConwayRatify era =>
Globals
-> RatifyEnv era
-> RatifyState era
-> RatifySignal era
-> RatifyState era
runConwayRatify Globals
dpGlobals RatifyEnv era
ratifyEnv RatifyState era
ratifyState RatifySignal era
ratifySig

-- ===========================================================
-- The State which is stored in ConwayGovState
-- ===========================================================

data DRepPulsingState era
  = DRPulsing !(DRepPulser era Identity (RatifyState era))
  | DRComplete
      !(PulsingSnapshot era)
      !(RatifyState era)
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (DRepPulsingState era) x -> DRepPulsingState era
forall era x. DRepPulsingState era -> Rep (DRepPulsingState era) x
$cto :: forall era x. Rep (DRepPulsingState era) x -> DRepPulsingState era
$cfrom :: forall era x. DRepPulsingState era -> Rep (DRepPulsingState era) x
Generic, forall era.
EraPParams era =>
Context -> DRepPulsingState era -> IO (Maybe ThunkInfo)
forall era.
EraPParams era =>
Proxy (DRepPulsingState era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (DRepPulsingState era) -> String
$cshowTypeOf :: forall era.
EraPParams era =>
Proxy (DRepPulsingState era) -> String
wNoThunks :: Context -> DRepPulsingState era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
EraPParams era =>
Context -> DRepPulsingState era -> IO (Maybe ThunkInfo)
noThunks :: Context -> DRepPulsingState era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
EraPParams era =>
Context -> DRepPulsingState era -> IO (Maybe ThunkInfo)
NoThunks, forall era. EraPParams era => DRepPulsingState era -> ()
forall a. (a -> ()) -> NFData a
rnf :: DRepPulsingState era -> ()
$crnf :: forall era. EraPParams era => DRepPulsingState era -> ()
NFData)

-- | This is potentially an expensive getter. Make sure not to use it in the first 80% of
-- the epoch.
psDRepDistrG ::
  SimpleGetter (DRepPulsingState era) (Map DRep (CompactForm Coin))
psDRepDistrG :: forall era.
SimpleGetter (DRepPulsingState era) (Map DRep (CompactForm Coin))
psDRepDistrG = forall s a. (s -> a) -> SimpleGetter s a
to forall {era}. DRepPulsingState era -> Map DRep (CompactForm Coin)
get
  where
    get :: DRepPulsingState era -> Map DRep (CompactForm Coin)
get (DRComplete PulsingSnapshot era
x RatifyState era
_) = forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepDistr PulsingSnapshot era
x
    get DRepPulsingState era
x = forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepDistr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x

instance EraPParams era => Eq (DRepPulsingState era) where
  DRepPulsingState era
x == :: DRepPulsingState era -> DRepPulsingState era -> Bool
== DRepPulsingState era
y = forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x forall a. Eq a => a -> a -> Bool
== forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
y

instance EraPParams era => Show (DRepPulsingState era) where
  show :: DRepPulsingState era -> String
show (DRComplete PulsingSnapshot era
x RatifyState era
m) = String
"(DRComplete " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PulsingSnapshot era
x forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RatifyState era
m forall a. [a] -> [a] -> [a]
++ String
")"
  show DRepPulsingState era
x = forall a. Show a => a -> String
show (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete (forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x))

instance EraPParams era => EncCBOR (DRepPulsingState era) where
  encCBOR :: DRepPulsingState era -> Encoding
encCBOR (DRComplete PulsingSnapshot era
x RatifyState era
y) = forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete 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 PulsingSnapshot era
x 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 RatifyState era
y)
  encCBOR x :: DRepPulsingState era
x@(DRPulsing (DRepPulser {})) = forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete 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 PulsingSnapshot era
snap 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 RatifyState era
ratstate)
    where
      (PulsingSnapshot era
snap, RatifyState era
ratstate) = forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x

-- TODO: Implement Sharing: https://github.com/intersectmbo/cardano-ledger/issues/3486
instance EraPParams era => DecShareCBOR (DRepPulsingState era) where
  decShareCBOR :: forall s.
Share (DRepPulsingState era) -> Decoder s (DRepPulsingState era)
decShareCBOR Share (DRepPulsingState 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.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete
        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 (DRepPulsingState era) where
  decCBOR :: forall s. Decoder s (DRepPulsingState era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete 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)

-- =====================================
-- High level operations of DRepDistr

pulseDRepPulsingState :: DRepPulsingState era -> DRepPulsingState era
pulseDRepPulsingState :: forall era. DRepPulsingState era -> DRepPulsingState era
pulseDRepPulsingState x :: DRepPulsingState era
x@(DRComplete PulsingSnapshot era
_ RatifyState era
_) = DRepPulsingState era
x
pulseDRepPulsingState (DRPulsing x :: DRepPulser era Identity (RatifyState era)
x@(DRepPulser {})) =
  let x2 :: DRepPulser era Identity (RatifyState era)
x2 = forall (p :: (* -> *) -> * -> *) ans.
Pulsable p =>
p Identity ans -> p Identity ans
pulse DRepPulser era Identity (RatifyState era)
x
   in if forall (pulse :: (* -> *) -> * -> *) (m :: * -> *) ans.
Pulsable pulse =>
pulse m ans -> Bool
done DRepPulser era Identity (RatifyState era)
x2
        then forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete (forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
x2))
        else forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
x2

completeDRepPulsingState :: DRepPulsingState era -> DRepPulsingState era
completeDRepPulsingState :: forall era. DRepPulsingState era -> DRepPulsingState era
completeDRepPulsingState x :: DRepPulsingState era
x@(DRPulsing DRepPulser era Identity (RatifyState era)
_) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete (forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x)
completeDRepPulsingState x :: DRepPulsingState era
x@(DRComplete {}) = DRepPulsingState era
x

extractDRepPulsingState :: DRepPulsingState era -> RatifyState era
extractDRepPulsingState :: forall era. DRepPulsingState era -> RatifyState era
extractDRepPulsingState x :: DRepPulsingState era
x@(DRPulsing DRepPulser era Identity (RatifyState era)
_) = forall a b. (a, b) -> b
snd (forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x)
extractDRepPulsingState (DRComplete PulsingSnapshot era
_ RatifyState era
x) = RatifyState era
x