{-# 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.Keys (KeyHash, KeyRole (..))
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 (EraCrypto era)) (CompactForm Coin)
psDRepDistr :: !(Map (DRep (EraCrypto era)) (CompactForm Coin))
  , forall era.
PulsingSnapshot era
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
psDRepState :: !(Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
  , forall era.
PulsingSnapshot era
-> Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
psPoolDistr :: Map (KeyHash 'StakePool (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin))
psDRepDistrL :: forall era.
Lens'
  (PulsingSnapshot era)
  (Map (DRep (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
psDRepDistr (\PulsingSnapshot era
x Map (DRep (EraCrypto era)) (CompactForm Coin)
y -> PulsingSnapshot era
x {psDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
psDRepDistr = Map (DRep (EraCrypto era)) (CompactForm Coin)
y})

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

psPoolDistrL ::
  Lens'
    (PulsingSnapshot era)
    (Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin))
psPoolDistrL :: forall era.
Lens'
  (PulsingSnapshot era)
  (Map (KeyHash 'StakePool (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
psPoolDistr (\PulsingSnapshot era
x Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
y -> PulsingSnapshot era
x {psPoolDistr :: Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
psPoolDistr = Map (KeyHash 'StakePool (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
_ Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
_ Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
_) =
  let (PulsingSnapshot {Map (DRep (EraCrypto era)) (CompactForm Coin)
Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
StrictSeq (GovActionState era)
psPoolDistr :: Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
psDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
psDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
psProposals :: StrictSeq (GovActionState era)
psPoolDistr :: forall era.
PulsingSnapshot era
-> Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
psDRepState :: forall era.
PulsingSnapshot era
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
psDRepDistr :: forall era.
PulsingSnapshot era
-> Map (DRep (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
psDRepDistr
      , Key
"psDRepState" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
psDRepState
      , Key
"psPoolDistr" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) (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 (DRep (EraCrypto era)) (CompactForm Coin)
Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
StrictSeq (GovActionState era)
psPoolDistr :: Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
psDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
psDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
psProposals :: StrictSeq (GovActionState era)
psPoolDistr :: forall era.
PulsingSnapshot era
-> Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
psDRepState :: forall era.
PulsingSnapshot era
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
psDRepDistr :: forall era.
PulsingSnapshot era
-> Map (DRep (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) (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 (EraCrypto era)) (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 (EraCrypto era)) (DRepState (EraCrypto era))
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 (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) (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 (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) (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 ::
  forall c.
  Map (Credential 'Staking c) (CompactForm Coin) ->
  Map (Credential 'DRepRole c) (DRepState c) ->
  Map (Credential 'Staking c) (CompactForm Coin) ->
  PoolDistr c ->
  Map (DRep c) (CompactForm Coin) ->
  Map (Credential 'Staking c) (UMElem c) ->
  (Map (DRep c) (CompactForm Coin), PoolDistr c)
computeDRepDistr :: forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map (Credential 'DRepRole c) (DRepState c)
-> Map (Credential 'Staking c) (CompactForm Coin)
-> PoolDistr c
-> Map (DRep c) (CompactForm Coin)
-> Map (Credential 'Staking c) (UMElem c)
-> (Map (DRep c) (CompactForm Coin), PoolDistr c)
computeDRepDistr Map (Credential 'Staking c) (CompactForm Coin)
stakeDistr Map (Credential 'DRepRole c) (DRepState c)
regDReps Map (Credential 'Staking c) (CompactForm Coin)
proposalDeposits PoolDistr c
poolDistr Map (DRep c) (CompactForm Coin)
dRepDistr Map (Credential 'Staking c) (UMElem c)
uMapChunk =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Map (DRep c) (CompactForm Coin), PoolDistr c)
-> Credential 'Staking c
-> UMElem c
-> (Map (DRep c) (CompactForm Coin), PoolDistr c)
go (Map (DRep c) (CompactForm Coin)
dRepDistr, PoolDistr c
poolDistr) Map (Credential 'Staking c) (UMElem c)
uMapChunk
  where
    go :: (Map (DRep c) (CompactForm Coin), PoolDistr c)
-> Credential 'Staking c
-> UMElem c
-> (Map (DRep c) (CompactForm Coin), PoolDistr c)
go (!Map (DRep c) (CompactForm Coin)
drepAccum, !PoolDistr c
poolAccum) Credential 'Staking c
stakeCred UMElem c
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 c
stakeCred Map (Credential 'Staking c) (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 c
stakeCred Map (Credential 'Staking c) (CompactForm Coin)
proposalDeposits
          stakeAndDeposits :: CompactForm Coin
stakeAndDeposits = CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
stake CompactForm Coin
proposalDeposit
       in case forall c. UMElem c -> Maybe (RewardDelegation c)
umElemDelegations UMElem c
umElem of
            Maybe (RewardDelegation c)
Nothing -> (Map (DRep c) (CompactForm Coin)
drepAccum, PoolDistr c
poolAccum)
            Just (RewardDelegationSPO KeyHash 'StakePool c
spo CompactForm Coin
_r) ->
              ( Map (DRep c) (CompactForm Coin)
drepAccum
              , forall {c}.
KeyHash 'StakePool c
-> CompactForm Coin -> PoolDistr c -> PoolDistr c
addToPoolDistr KeyHash 'StakePool c
spo CompactForm Coin
proposalDeposit PoolDistr c
poolAccum
              )
            Just (RewardDelegationDRep DRep c
drep CompactForm Coin
r) ->
              ( DRep c
-> CompactForm Coin
-> Map (DRep c) (CompactForm Coin)
-> Map (DRep c) (CompactForm Coin)
addToDRepDistr DRep c
drep (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
stakeAndDeposits CompactForm Coin
r) Map (DRep c) (CompactForm Coin)
drepAccum
              , PoolDistr c
poolAccum
              )
            Just (RewardDelegationBoth KeyHash 'StakePool c
spo DRep c
drep CompactForm Coin
r) ->
              ( DRep c
-> CompactForm Coin
-> Map (DRep c) (CompactForm Coin)
-> Map (DRep c) (CompactForm Coin)
addToDRepDistr DRep c
drep (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
stakeAndDeposits CompactForm Coin
r) Map (DRep c) (CompactForm Coin)
drepAccum
              , forall {c}.
KeyHash 'StakePool c
-> CompactForm Coin -> PoolDistr c -> PoolDistr c
addToPoolDistr KeyHash 'StakePool c
spo CompactForm Coin
proposalDeposit PoolDistr c
poolAccum
              )
    addToPoolDistr :: KeyHash 'StakePool c
-> CompactForm Coin -> PoolDistr c -> PoolDistr c
addToPoolDistr KeyHash 'StakePool c
spo CompactForm Coin
proposalDeposit PoolDistr c
distr = forall a. a -> Maybe a -> a
fromMaybe PoolDistr c
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 c
ips <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool c
spo forall a b. (a -> b) -> a -> b
$ PoolDistr c
distr forall s a. s -> Getting a s a -> a
^. forall c.
Lens'
  (PoolDistr c) (Map (KeyHash 'StakePool c) (IndividualPoolStake c))
poolDistrDistrL
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        PoolDistr c
distr
          forall a b. a -> (a -> b) -> b
& forall c.
Lens'
  (PoolDistr c) (Map (KeyHash 'StakePool c) (IndividualPoolStake c))
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 c
spo (IndividualPoolStake c
ips forall a b. a -> (a -> b) -> b
& forall c. Lens' (IndividualPoolStake c) (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
& forall c. Lens' (PoolDistr c) (CompactForm Coin)
poolDistrTotalL forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ CompactForm Coin
proposalDeposit
    addToDRepDistr :: DRep c
-> CompactForm Coin
-> Map (DRep c) (CompactForm Coin)
-> Map (DRep c) (CompactForm Coin)
addToDRepDistr DRep c
drep CompactForm Coin
ccoin Map (DRep c) (CompactForm Coin)
distr =
      let updatedDistr :: Map (DRep c) (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 c
drep CompactForm Coin
ccoin Map (DRep c) (CompactForm Coin)
distr
       in case DRep c
drep of
            DRep c
DRepAlwaysAbstain -> Map (DRep c) (CompactForm Coin)
updatedDistr
            DRep c
DRepAlwaysNoConfidence -> Map (DRep c) (CompactForm Coin)
updatedDistr
            DRepCredential Credential 'DRepRole c
cred
              | forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'DRepRole c
cred Map (Credential 'DRepRole c) (DRepState c)
regDReps -> Map (DRep c) (CompactForm Coin)
updatedDistr
              | Bool
otherwise -> Map (DRep c) (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 (EraCrypto era)
dpUMap :: !(UMap (EraCrypto era))
    -- ^ 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 (EraCrypto era)) (CompactForm Coin)
dpStakeDistr :: !(Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin))
    -- ^ Snapshot of the stake distr (comes from the IncrementalStake)
    , forall era ans (m :: * -> *).
DRepPulser era m ans -> PoolDistr (EraCrypto era)
dpStakePoolDistr :: PoolDistr (EraCrypto era)
    -- ^ 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 (EraCrypto era)) (CompactForm Coin)
dpDRepDistr :: !(Map (DRep (EraCrypto era)) (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 (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState :: !(Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
    -- ^ 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 (EraCrypto era)) (CompactForm Coin)
dpProposalDeposits :: !(Map (Credential 'Staking (EraCrypto era)) (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 (EraCrypto era)) (PoolParams (EraCrypto era))
dpPoolParams :: !(Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
    -- ^ 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 (EraCrypto era)
dpUMap :: UMap (EraCrypto era)
dpUMap :: forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
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 (forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
UMap.umElems UMap (EraCrypto era)
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 (DRep (EraCrypto era)) (CompactForm Coin)
Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
StrictSeq (GovActionState era)
CommitteeState era
UMap (EraCrypto era)
PoolDistr (EraCrypto era)
Globals
EpochNo
EnactState era
dpPoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpGlobals :: Globals
dpProposalDeposits :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpProposals :: StrictSeq (GovActionState era)
dpEnactState :: EnactState era
dpCommitteeState :: CommitteeState era
dpCurrentEpoch :: EpochNo
dpDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
dpStakePoolDistr :: PoolDistr (EraCrypto era)
dpStakeDistr :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpIndex :: Int
dpUMap :: UMap (EraCrypto era)
dpPulseSize :: Int
dpPoolParams :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpGlobals :: forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpProposalDeposits :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking (EraCrypto era)) (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 (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
dpStakePoolDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans -> PoolDistr (EraCrypto era)
dpStakeDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpUMap :: forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
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 (EraCrypto era)) (UMElem (EraCrypto era))
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
$ forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
UMap.umElems UMap (EraCrypto era)
dpUMap
            (Map (DRep (EraCrypto era)) (CompactForm Coin)
dRepDistr, PoolDistr (EraCrypto era)
poolDistr) =
              forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map (Credential 'DRepRole c) (DRepState c)
-> Map (Credential 'Staking c) (CompactForm Coin)
-> PoolDistr c
-> Map (DRep c) (CompactForm Coin)
-> Map (Credential 'Staking c) (UMElem c)
-> (Map (DRep c) (CompactForm Coin), PoolDistr c)
computeDRepDistr Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpStakeDistr Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpProposalDeposits PoolDistr (EraCrypto era)
dpStakePoolDistr Map (DRep (EraCrypto era)) (CompactForm Coin)
dpDRepDistr Map (Credential 'Staking (EraCrypto era)) (UMElem (EraCrypto era))
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 (EraCrypto era)) (CompactForm Coin)
dpDRepDistr = Map (DRep (EraCrypto era)) (CompactForm Coin)
dRepDistr
                , dpStakePoolDistr :: PoolDistr (EraCrypto era)
dpStakePoolDistr = PoolDistr (EraCrypto era)
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 (EraCrypto era)
_ Int
_ Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
_ PoolDistr (EraCrypto era)
_ Map (DRep (EraCrypto era)) (CompactForm Coin)
_ Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
_ EpochNo
_ CommitteeState era
_ EnactState era
_ StrictSeq (GovActionState era)
_ Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
_ Globals
_ Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
_) =
    [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 (EraCrypto era)
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 (EraCrypto era)) (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 (EraCrypto era)) (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 (EraCrypto era)) (DRepState (EraCrypto era))
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 (EraCrypto era)) (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 (EraCrypto era)) (PoolParams (EraCrypto era))
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 (EraCrypto era)
um Int
bal Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stake PoolDistr (EraCrypto era)
pool Map (DRep (EraCrypto era)) (CompactForm Coin)
drep Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dstate EpochNo
ep CommitteeState era
cs EnactState era
es StrictSeq (GovActionState era)
as Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
pds Globals
gs Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolps) =
    Int
n forall a b. NFData a => a -> b -> b
`deepseq`
      UMap (EraCrypto era)
um forall a b. NFData a => a -> b -> b
`deepseq`
        Int
bal forall a b. NFData a => a -> b -> b
`deepseq`
          Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stake forall a b. NFData a => a -> b -> b
`deepseq`
            PoolDistr (EraCrypto era)
pool forall a b. NFData a => a -> b -> b
`deepseq`
              Map (DRep (EraCrypto era)) (CompactForm Coin)
drep forall a b. NFData a => a -> b -> b
`deepseq`
                Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
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 (EraCrypto era)) (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 (EraCrypto era)) (PoolParams (EraCrypto era))
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 (DRep (EraCrypto era)) (CompactForm Coin)
Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
StrictSeq (GovActionState era)
CommitteeState era
UMap (EraCrypto era)
PoolDistr (EraCrypto era)
Globals
EpochNo
EnactState era
dpPoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpGlobals :: Globals
dpProposalDeposits :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpProposals :: StrictSeq (GovActionState era)
dpEnactState :: EnactState era
dpCommitteeState :: CommitteeState era
dpCurrentEpoch :: EpochNo
dpDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
dpStakePoolDistr :: PoolDistr (EraCrypto era)
dpStakeDistr :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpIndex :: Int
dpUMap :: UMap (EraCrypto era)
dpPulseSize :: Int
dpPoolParams :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpGlobals :: forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpProposalDeposits :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking (EraCrypto era)) (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 (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
dpStakePoolDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans -> PoolDistr (EraCrypto era)
dpStakeDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpUMap :: forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
dpPulseSize :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
..})) =
  ( forall era.
StrictSeq (GovActionState era)
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot
      StrictSeq (GovActionState era)
dpProposals
      Map (DRep (EraCrypto era)) (CompactForm Coin)
finalDRepDistr
      Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState
      (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall c. IndividualPoolStake c -> CompactForm Coin
individualTotalPoolStake forall a b. (a -> b) -> a -> b
$ forall c.
PoolDistr c -> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
unPoolDistr PoolDistr (EraCrypto era)
finalStakePoolDistr)
  , RatifyState era
ratifyState'
  )
  where
    !leftOver :: Map (Credential 'Staking (EraCrypto era)) (UMElem (EraCrypto era))
leftOver = forall k a. Int -> Map k a -> Map k a
Map.drop Int
dpIndex forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems UMap (EraCrypto era)
dpUMap
    (Map (DRep (EraCrypto era)) (CompactForm Coin)
finalDRepDistr, PoolDistr (EraCrypto era)
finalStakePoolDistr) =
      forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map (Credential 'DRepRole c) (DRepState c)
-> Map (Credential 'Staking c) (CompactForm Coin)
-> PoolDistr c
-> Map (DRep c) (CompactForm Coin)
-> Map (Credential 'Staking c) (UMElem c)
-> (Map (DRep c) (CompactForm Coin), PoolDistr c)
computeDRepDistr Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpStakeDistr Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpProposalDeposits PoolDistr (EraCrypto era)
dpStakePoolDistr Map (DRep (EraCrypto era)) (CompactForm Coin)
dpDRepDistr Map (Credential 'Staking (EraCrypto era)) (UMElem (EraCrypto era))
leftOver
    !ratifyEnv :: RatifyEnv era
ratifyEnv =
      RatifyEnv
        { reStakeDistr :: Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
reStakeDistr = Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
dpStakeDistr
        , reStakePoolDistr :: PoolDistr (EraCrypto era)
reStakePoolDistr = PoolDistr (EraCrypto era)
finalStakePoolDistr
        , reDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
reDRepDistr = Map (DRep (EraCrypto era)) (CompactForm Coin)
finalDRepDistr
        , reDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
reDRepState = Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState
        , reCurrentEpoch :: EpochNo
reCurrentEpoch = EpochNo
dpCurrentEpoch
        , reCommitteeState :: CommitteeState era
reCommitteeState = CommitteeState era
dpCommitteeState
        , reDelegatees :: Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
reDelegatees = forall c. UMap c -> Map (Credential 'Staking c) (DRep c)
dRepMap UMap (EraCrypto era)
dpUMap
        , rePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
rePoolParams = Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
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 (EraCrypto era))
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 (EraCrypto era)) (CompactForm Coin))
psDRepDistrG :: forall era.
SimpleGetter
  (DRepPulsingState era)
  (Map (DRep (EraCrypto era)) (CompactForm Coin))
psDRepDistrG = forall s a. (s -> a) -> SimpleGetter s a
to forall {era}.
DRepPulsingState era
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
get
  where
    get :: DRepPulsingState era
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
get (DRComplete PulsingSnapshot era
x RatifyState era
_) = forall era.
PulsingSnapshot era
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
psDRepDistr PulsingSnapshot era
x
    get DRepPulsingState era
x = forall era.
PulsingSnapshot era
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
psDRepDistr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall era.
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