{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# 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 (..),
  KeyValuePairs (..),
  ToKeyValuePairs (..),
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  Interns,
  ToCBOR (..),
  decNoShareCBOR,
  decodeMap,
  decodeStrictSeq,
  interns,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Coin (Coin (..), addCompactCoin)
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.PoolParams (PoolParams)
import Cardano.Ledger.State
import Cardano.Ledger.UMap
import qualified Cardano.Ledger.UMap as UMap
import Control.DeepSeq (NFData (..), deepseq)
import Control.Monad.Trans.Reader (Reader, runReader)
import Control.State.Transition.Extended
import Data.Aeson (ToJSON (..), (.=))
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 x. PulsingSnapshot era -> Rep (PulsingSnapshot era) x)
-> (forall x. Rep (PulsingSnapshot era) x -> PulsingSnapshot era)
-> Generic (PulsingSnapshot era)
forall x. Rep (PulsingSnapshot era) x -> PulsingSnapshot era
forall x. PulsingSnapshot era -> Rep (PulsingSnapshot era) x
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
$cfrom :: forall era x. PulsingSnapshot era -> Rep (PulsingSnapshot era) x
from :: forall x. PulsingSnapshot era -> Rep (PulsingSnapshot era) x
$cto :: forall era x. Rep (PulsingSnapshot era) x -> PulsingSnapshot era
to :: forall x. Rep (PulsingSnapshot era) x -> PulsingSnapshot era
Generic)

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

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

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

psPoolDistrL ::
  Lens'
    (PulsingSnapshot era)
    (Map (KeyHash 'StakePool) (CompactForm Coin))
psPoolDistrL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) (CompactForm Coin)
 -> f (Map (KeyHash 'StakePool) (CompactForm Coin)))
-> PulsingSnapshot era -> f (PulsingSnapshot era)
psPoolDistrL = (PulsingSnapshot era
 -> Map (KeyHash 'StakePool) (CompactForm Coin))
-> (PulsingSnapshot era
    -> Map (KeyHash 'StakePool) (CompactForm Coin)
    -> PulsingSnapshot era)
-> Lens
     (PulsingSnapshot era)
     (PulsingSnapshot era)
     (Map (KeyHash 'StakePool) (CompactForm Coin))
     (Map (KeyHash 'StakePool) (CompactForm Coin))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
forall era.
PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr (\PulsingSnapshot era
x Map (KeyHash 'StakePool) (CompactForm Coin)
y -> PulsingSnapshot era
x {psPoolDistr = 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)

instance EraPParams era => ToKeyValuePairs (PulsingSnapshot era) where
  toKeyValuePairs :: forall e kv. KeyValue e kv => PulsingSnapshot era -> [kv]
toKeyValuePairs 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)
psProposals :: forall era. PulsingSnapshot era -> StrictSeq (GovActionState era)
psDRepDistr :: forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepState :: forall era.
PulsingSnapshot era -> Map (Credential 'DRepRole) DRepState
psPoolDistr :: forall era.
PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psProposals :: StrictSeq (GovActionState era)
psDRepDistr :: Map DRep (CompactForm Coin)
psDRepState :: Map (Credential 'DRepRole) DRepState
psPoolDistr :: Map (KeyHash 'StakePool) (CompactForm Coin)
..}) = PulsingSnapshot era
gas
     in [ Key
"psProposals" Key -> StrictSeq (GovActionState era) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictSeq (GovActionState era)
psProposals
        , Key
"psDRepDistr" Key -> Map DRep (CompactForm Coin) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map DRep (CompactForm Coin)
psDRepDistr
        , Key
"psDRepState" Key -> Map (Credential 'DRepRole) DRepState -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'DRepRole) DRepState
psDRepState
        , Key
"psPoolDistr" Key -> Map (KeyHash 'StakePool) (CompactForm Coin) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr
        ]

deriving via
  KeyValuePairs (PulsingSnapshot era)
  instance
    EraPParams era => ToJSON (PulsingSnapshot era)

instance Default (PulsingSnapshot era) where
  def :: PulsingSnapshot era
def = StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
forall era.
StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot StrictSeq (GovActionState era)
forall a. Monoid a => a
mempty Map DRep (CompactForm Coin)
forall a. Default a => a
def Map (Credential 'DRepRole) DRepState
forall a. Default a => a
def Map (KeyHash 'StakePool) (CompactForm Coin)
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)
psProposals :: forall era. PulsingSnapshot era -> StrictSeq (GovActionState era)
psDRepDistr :: forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepState :: forall era.
PulsingSnapshot era -> Map (Credential 'DRepRole) DRepState
psPoolDistr :: forall era.
PulsingSnapshot era -> Map (KeyHash 'StakePool) (CompactForm Coin)
psProposals :: StrictSeq (GovActionState era)
psDRepDistr :: Map DRep (CompactForm Coin)
psDRepState :: Map (Credential 'DRepRole) DRepState
psPoolDistr :: Map (KeyHash 'StakePool) (CompactForm Coin)
..} =
    Encode ('Closed 'Dense) (PulsingSnapshot era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (PulsingSnapshot era) -> Encoding)
-> Encode ('Closed 'Dense) (PulsingSnapshot era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (StrictSeq (GovActionState era)
 -> Map DRep (CompactForm Coin)
 -> Map (Credential 'DRepRole) DRepState
 -> Map (KeyHash 'StakePool) (CompactForm Coin)
 -> PulsingSnapshot era)
-> Encode
     ('Closed 'Dense)
     (StrictSeq (GovActionState era)
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> Map (KeyHash 'StakePool) (CompactForm Coin)
      -> PulsingSnapshot era)
forall t. t -> Encode ('Closed 'Dense) t
Rec StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
forall era.
StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot
        Encode
  ('Closed 'Dense)
  (StrictSeq (GovActionState era)
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> Map (KeyHash 'StakePool) (CompactForm Coin)
   -> PulsingSnapshot era)
-> Encode ('Closed 'Dense) (StrictSeq (GovActionState era))
-> Encode
     ('Closed 'Dense)
     (Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> Map (KeyHash 'StakePool) (CompactForm Coin)
      -> PulsingSnapshot era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> StrictSeq (GovActionState era)
-> Encode ('Closed 'Dense) (StrictSeq (GovActionState era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictSeq (GovActionState era)
psProposals
        Encode
  ('Closed 'Dense)
  (Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> Map (KeyHash 'StakePool) (CompactForm Coin)
   -> PulsingSnapshot era)
-> Encode ('Closed 'Dense) (Map DRep (CompactForm Coin))
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'DRepRole) DRepState
      -> Map (KeyHash 'StakePool) (CompactForm Coin)
      -> PulsingSnapshot era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map DRep (CompactForm Coin)
-> Encode ('Closed 'Dense) (Map DRep (CompactForm Coin))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map DRep (CompactForm Coin)
psDRepDistr
        Encode
  ('Closed 'Dense)
  (Map (Credential 'DRepRole) DRepState
   -> Map (KeyHash 'StakePool) (CompactForm Coin)
   -> PulsingSnapshot era)
-> Encode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
-> Encode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool) (CompactForm Coin)
      -> PulsingSnapshot era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'DRepRole) DRepState
-> Encode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'DRepRole) DRepState
psDRepState
        Encode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool) (CompactForm Coin)
   -> PulsingSnapshot era)
-> Encode
     ('Closed 'Dense) (Map (KeyHash 'StakePool) (CompactForm Coin))
-> Encode ('Closed 'Dense) (PulsingSnapshot era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (KeyHash 'StakePool) (CompactForm Coin)
-> Encode
     ('Closed 'Dense) (Map (KeyHash 'StakePool) (CompactForm Coin))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'StakePool) (CompactForm Coin)
psPoolDistr

instance EraPParams era => DecShareCBOR (PulsingSnapshot era) where
  type
    Share (PulsingSnapshot era) =
      ( Interns (Credential 'Staking)
      , Interns (KeyHash 'StakePool)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  decShareCBOR :: forall s.
Share (PulsingSnapshot era) -> Decoder s (PulsingSnapshot era)
decShareCBOR is :: Share (PulsingSnapshot era)
is@(Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
ks, Interns (Credential 'DRepRole)
cd, Interns (Credential 'HotCommitteeRole)
_) =
    Decode ('Closed 'Dense) (PulsingSnapshot era)
-> Decoder s (PulsingSnapshot era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (PulsingSnapshot era)
 -> Decoder s (PulsingSnapshot era))
-> Decode ('Closed 'Dense) (PulsingSnapshot era)
-> Decoder s (PulsingSnapshot era)
forall a b. (a -> b) -> a -> b
$
      (StrictSeq (GovActionState era)
 -> Map DRep (CompactForm Coin)
 -> Map (Credential 'DRepRole) DRepState
 -> Map (KeyHash 'StakePool) (CompactForm Coin)
 -> PulsingSnapshot era)
-> Decode
     ('Closed 'Dense)
     (StrictSeq (GovActionState era)
      -> Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> Map (KeyHash 'StakePool) (CompactForm Coin)
      -> PulsingSnapshot era)
forall t. t -> Decode ('Closed 'Dense) t
RecD StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
forall era.
StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot
        Decode
  ('Closed 'Dense)
  (StrictSeq (GovActionState era)
   -> Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> Map (KeyHash 'StakePool) (CompactForm Coin)
   -> PulsingSnapshot era)
-> Decode ('Closed 'Dense) (StrictSeq (GovActionState era))
-> Decode
     ('Closed 'Dense)
     (Map DRep (CompactForm Coin)
      -> Map (Credential 'DRepRole) DRepState
      -> Map (KeyHash 'StakePool) (CompactForm Coin)
      -> PulsingSnapshot era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (StrictSeq (GovActionState era)))
-> Decode ('Closed 'Dense) (StrictSeq (GovActionState era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (GovActionState era)
-> Decoder s (StrictSeq (GovActionState era))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq (Share (GovActionState era) -> Decoder s (GovActionState era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (GovActionState era) -> Decoder s (GovActionState era)
decShareCBOR Share (GovActionState era)
Share (PulsingSnapshot era)
is))
        Decode
  ('Closed 'Dense)
  (Map DRep (CompactForm Coin)
   -> Map (Credential 'DRepRole) DRepState
   -> Map (KeyHash 'StakePool) (CompactForm Coin)
   -> PulsingSnapshot era)
-> Decode ('Closed 'Dense) (Map DRep (CompactForm Coin))
-> Decode
     ('Closed 'Dense)
     (Map (Credential 'DRepRole) DRepState
      -> Map (KeyHash 'StakePool) (CompactForm Coin)
      -> PulsingSnapshot era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (Map DRep (CompactForm Coin)))
-> Decode ('Closed 'Dense) (Map DRep (CompactForm Coin))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s DRep
-> Decoder s (CompactForm Coin)
-> Decoder s (Map DRep (CompactForm Coin))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (Share DRep -> Decoder s DRep
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share DRep -> Decoder s DRep
decShareCBOR Share DRep
Interns (Credential 'DRepRole)
cd) Decoder s (CompactForm Coin)
forall s. Decoder s (CompactForm Coin)
forall a s. DecCBOR a => Decoder s a
decCBOR)
        Decode
  ('Closed 'Dense)
  (Map (Credential 'DRepRole) DRepState
   -> Map (KeyHash 'StakePool) (CompactForm Coin)
   -> PulsingSnapshot era)
-> Decode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
-> Decode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool) (CompactForm Coin)
      -> PulsingSnapshot era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (Map (Credential 'DRepRole) DRepState))
-> Decode ('Closed 'Dense) (Map (Credential 'DRepRole) DRepState)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (Credential 'DRepRole)
-> Decoder s DRepState
-> Decoder s (Map (Credential 'DRepRole) DRepState)
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (Interns (Credential 'DRepRole)
-> Credential 'DRepRole -> Credential 'DRepRole
forall k. Interns k -> k -> k
interns Interns (Credential 'DRepRole)
cd (Credential 'DRepRole -> Credential 'DRepRole)
-> Decoder s (Credential 'DRepRole)
-> Decoder s (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Credential 'DRepRole)
forall s. Decoder s (Credential 'DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR) (Share DRepState -> Decoder s DRepState
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share DRepState -> Decoder s DRepState
decShareCBOR Share DRepState
Interns (Credential 'Staking)
cs))
        Decode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool) (CompactForm Coin)
   -> PulsingSnapshot era)
-> Decode
     ('Closed 'Dense) (Map (KeyHash 'StakePool) (CompactForm Coin))
-> Decode ('Closed 'Dense) (PulsingSnapshot era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (Map (KeyHash 'StakePool) (CompactForm Coin)))
-> Decode
     ('Closed 'Dense) (Map (KeyHash 'StakePool) (CompactForm Coin))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (KeyHash 'StakePool)
-> Decoder s (CompactForm Coin)
-> Decoder s (Map (KeyHash 'StakePool) (CompactForm Coin))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (Interns (KeyHash 'StakePool)
-> KeyHash 'StakePool -> KeyHash 'StakePool
forall k. Interns k -> k -> k
interns Interns (KeyHash 'StakePool)
ks (KeyHash 'StakePool -> KeyHash 'StakePool)
-> Decoder s (KeyHash 'StakePool) -> Decoder s (KeyHash 'StakePool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'StakePool)
forall s. Decoder s (KeyHash 'StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR) Decoder s (CompactForm Coin)
forall s. Decoder s (CompactForm Coin)
forall a s. DecCBOR a => Decoder s a
decCBOR)

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

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 ::
  EraStake era =>
  InstantStake era ->
  Map (Credential 'DRepRole) DRepState ->
  Map (Credential 'Staking) (CompactForm Coin) ->
  PoolDistr ->
  Map DRep (CompactForm Coin) ->
  Map (Credential 'Staking) UMElem ->
  (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr :: forall era.
EraStake era =>
InstantStake era
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr InstantStake era
instantStake Map (Credential 'DRepRole) DRepState
regDReps Map (Credential 'Staking) (CompactForm Coin)
proposalDeposits PoolDistr
poolDistr Map DRep (CompactForm Coin)
dRepDistr =
  ((Map DRep (CompactForm Coin), PoolDistr)
 -> Credential 'Staking
 -> UMElem
 -> (Map DRep (CompactForm Coin), PoolDistr))
-> (Map DRep (CompactForm Coin), PoolDistr)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
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)
  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 instantStakeCredentials :: Map (Credential 'Staking) (CompactForm Coin)
instantStakeCredentials = InstantStake era
instantStake InstantStake era
-> Getting
     (Map (Credential 'Staking) (CompactForm Coin))
     (InstantStake era)
     (Map (Credential 'Staking) (CompactForm Coin))
-> Map (Credential 'Staking) (CompactForm Coin)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'Staking) (CompactForm Coin))
  (InstantStake era)
  (Map (Credential 'Staking) (CompactForm Coin))
forall era.
EraStake era =>
Lens'
  (InstantStake era) (Map (Credential 'Staking) (CompactForm Coin))
Lens'
  (InstantStake era) (Map (Credential 'Staking) (CompactForm Coin))
instantStakeCredentialsL
          stake :: CompactForm Coin
stake = CompactForm Coin -> Maybe (CompactForm Coin) -> CompactForm Coin
forall a. a -> Maybe a -> a
fromMaybe (Word64 -> CompactForm Coin
CompactCoin Word64
0) (Maybe (CompactForm Coin) -> CompactForm Coin)
-> Maybe (CompactForm Coin) -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ Credential 'Staking
-> Map (Credential 'Staking) (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
stakeCred Map (Credential 'Staking) (CompactForm Coin)
instantStakeCredentials
          mProposalDeposit :: Maybe (CompactForm Coin)
mProposalDeposit = Credential 'Staking
-> Map (Credential 'Staking) (CompactForm Coin)
-> Maybe (CompactForm Coin)
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)
-> Maybe (CompactForm Coin)
-> CompactForm Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CompactForm Coin
stake (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompactCoin CompactForm Coin
stake) Maybe (CompactForm Coin)
mProposalDeposit
       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
-> Maybe (CompactForm Coin) -> PoolDistr -> PoolDistr
addToPoolDistr KeyHash 'StakePool
spo Maybe (CompactForm Coin)
mProposalDeposit 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
addCompactCoin 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
addCompactCoin CompactForm Coin
stakeAndDeposits CompactForm Coin
r) Map DRep (CompactForm Coin)
drepAccum
              , KeyHash 'StakePool
-> Maybe (CompactForm Coin) -> PoolDistr -> PoolDistr
addToPoolDistr KeyHash 'StakePool
spo Maybe (CompactForm Coin)
mProposalDeposit PoolDistr
poolAccum
              )
    addToPoolDistr :: KeyHash 'StakePool
-> Maybe (CompactForm Coin) -> PoolDistr -> PoolDistr
addToPoolDistr KeyHash 'StakePool
spo Maybe (CompactForm Coin)
mProposalDeposit PoolDistr
distr = PoolDistr -> Maybe PoolDistr -> PoolDistr
forall a. a -> Maybe a -> a
fromMaybe PoolDistr
distr (Maybe PoolDistr -> PoolDistr) -> Maybe PoolDistr -> PoolDistr
forall a b. (a -> b) -> a -> b
$ do
      CompactForm Coin
proposalDeposit <- Maybe (CompactForm Coin)
mProposalDeposit
      IndividualPoolStake
ips <- KeyHash 'StakePool
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Maybe IndividualPoolStake
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool
spo (Map (KeyHash 'StakePool) IndividualPoolStake
 -> Maybe IndividualPoolStake)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Maybe IndividualPoolStake
forall a b. (a -> b) -> a -> b
$ PoolDistr
distr PoolDistr
-> Getting
     (Map (KeyHash 'StakePool) IndividualPoolStake)
     PoolDistr
     (Map (KeyHash 'StakePool) IndividualPoolStake)
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (KeyHash 'StakePool) IndividualPoolStake)
  PoolDistr
  (Map (KeyHash 'StakePool) IndividualPoolStake)
Lens' PoolDistr (Map (KeyHash 'StakePool) IndividualPoolStake)
poolDistrDistrL
      PoolDistr -> Maybe PoolDistr
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PoolDistr -> Maybe PoolDistr) -> PoolDistr -> Maybe PoolDistr
forall a b. (a -> b) -> a -> b
$
        PoolDistr
distr
          PoolDistr -> (PoolDistr -> PoolDistr) -> PoolDistr
forall a b. a -> (a -> b) -> b
& (Map (KeyHash 'StakePool) IndividualPoolStake
 -> Identity (Map (KeyHash 'StakePool) IndividualPoolStake))
-> PoolDistr -> Identity PoolDistr
Lens' PoolDistr (Map (KeyHash 'StakePool) IndividualPoolStake)
poolDistrDistrL ((Map (KeyHash 'StakePool) IndividualPoolStake
  -> Identity (Map (KeyHash 'StakePool) IndividualPoolStake))
 -> PoolDistr -> Identity PoolDistr)
-> (Map (KeyHash 'StakePool) IndividualPoolStake
    -> Map (KeyHash 'StakePool) IndividualPoolStake)
-> PoolDistr
-> PoolDistr
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyHash 'StakePool
-> IndividualPoolStake
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Map (KeyHash 'StakePool) IndividualPoolStake
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash 'StakePool
spo (IndividualPoolStake
ips IndividualPoolStake
-> (IndividualPoolStake -> IndividualPoolStake)
-> IndividualPoolStake
forall a b. a -> (a -> b) -> b
& (CompactForm Coin -> Identity (CompactForm Coin))
-> IndividualPoolStake -> Identity IndividualPoolStake
Lens' IndividualPoolStake (CompactForm Coin)
individualTotalPoolStakeL ((CompactForm Coin -> Identity (CompactForm Coin))
 -> IndividualPoolStake -> Identity IndividualPoolStake)
-> CompactForm Coin -> IndividualPoolStake -> IndividualPoolStake
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ CompactForm Coin
proposalDeposit)
          PoolDistr -> (PoolDistr -> PoolDistr) -> PoolDistr
forall a b. a -> (a -> b) -> b
& (CompactForm Coin -> Identity (CompactForm Coin))
-> PoolDistr -> Identity PoolDistr
Lens' PoolDistr (CompactForm Coin)
poolDistrTotalL ((CompactForm Coin -> Identity (CompactForm Coin))
 -> PoolDistr -> Identity PoolDistr)
-> CompactForm Coin -> PoolDistr -> PoolDistr
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 = (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> DRep
-> CompactForm Coin
-> Map DRep (CompactForm Coin)
-> Map DRep (CompactForm Coin)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompactCoin 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
              | Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Bool
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 -> InstantStake era
dpInstantStake :: !(InstantStake era)
    -- ^ 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, EraStake 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 = DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
x) (PulsingSnapshot era, RatifyState era)
-> (PulsingSnapshot era, RatifyState era) -> Bool
forall a. Eq a => a -> a -> Bool
== DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
y)

instance EraStake era => Pulsable (DRepPulser era) where
  done :: forall (m :: * -> *) ans. DRepPulser era m ans -> Bool
done DRepPulser {UMap
dpUMap :: forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpUMap :: UMap
dpUMap, Int
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpIndex :: Int
dpIndex} = Int
dpIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Map (Credential 'Staking) UMElem -> Int
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 {}) = (PulsingSnapshot era, ans) -> ans
forall a b. (a, b) -> b
snd ((PulsingSnapshot era, ans) -> ans)
-> (PulsingSnapshot era, ans) -> ans
forall a b. (a -> b) -> a -> b
$ DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era m ans
DRepPulser era Identity (RatifyState era)
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
PoolDistr
CommitteeState era
InstantStake era
StrictSeq (GovActionState era)
EpochNo
Globals
UMap
EnactState era
dpPulseSize :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpUMap :: forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpInstantStake :: forall era ans (m :: * -> *).
DRepPulser era m ans -> InstantStake era
dpStakePoolDistr :: forall era ans (m :: * -> *). DRepPulser era m ans -> PoolDistr
dpDRepDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpDRepState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpCurrentEpoch :: forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCommitteeState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpEnactState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpProposals :: forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposalDeposits :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpGlobals :: forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpPoolParams :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (KeyHash 'StakePool) PoolParams
dpPulseSize :: Int
dpUMap :: UMap
dpIndex :: Int
dpInstantStake :: InstantStake era
dpStakePoolDistr :: PoolDistr
dpDRepDistr :: Map DRep (CompactForm Coin)
dpDRepState :: Map (Credential 'DRepRole) DRepState
dpCurrentEpoch :: EpochNo
dpCommitteeState :: CommitteeState era
dpEnactState :: EnactState era
dpProposals :: StrictSeq (GovActionState era)
dpProposalDeposits :: Map (Credential 'Staking) (CompactForm Coin)
dpGlobals :: Globals
dpPoolParams :: Map (KeyHash 'StakePool) PoolParams
..})
    | DRepPulser era m ans -> Bool
forall (m :: * -> *) ans. DRepPulser era m ans -> Bool
forall (pulse :: (* -> *) -> * -> *) (m :: * -> *) ans.
Pulsable pulse =>
pulse m ans -> Bool
done DRepPulser era m ans
pulser = DRepPulser era m ans -> m (DRepPulser era m ans)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRepPulser era m ans
pulser {dpIndex = 0}
    | Bool
otherwise =
        let !chunk :: Map (Credential 'Staking) UMElem
chunk = Int
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a. Int -> Map k a -> Map k a
Map.take Int
dpPulseSize (Map (Credential 'Staking) UMElem
 -> Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall a b. (a -> b) -> a -> b
$ Int
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a. Int -> Map k a -> Map k a
Map.drop Int
dpIndex (Map (Credential 'Staking) UMElem
 -> Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall a b. (a -> b) -> a -> b
$ UMap -> Map (Credential 'Staking) UMElem
UMap.umElems UMap
dpUMap
            (Map DRep (CompactForm Coin)
dRepDistr, PoolDistr
poolDistr) =
              InstantStake era
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
forall era.
EraStake era =>
InstantStake era
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr InstantStake era
dpInstantStake Map (Credential 'DRepRole) DRepState
dpDRepState Map (Credential 'Staking) (CompactForm Coin)
dpProposalDeposits PoolDistr
dpStakePoolDistr Map DRep (CompactForm Coin)
dpDRepDistr Map (Credential 'Staking) UMElem
chunk
         in DRepPulser era m ans -> m (DRepPulser era m ans)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DRepPulser era m ans -> m (DRepPulser era m ans))
-> DRepPulser era m ans -> m (DRepPulser era m ans)
forall a b. (a -> b) -> a -> b
$
              DRepPulser era m ans
pulser
                { dpIndex = dpIndex + dpPulseSize
                , dpDRepDistr = dRepDistr
                , dpStakePoolDistr = poolDistr
                }

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

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

instance
  (EraPParams era, NoThunks (InstantStake 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
_ InstantStake era
_ 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
      [ Context -> Int -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era) -> Int
forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpPulseSize DRepPulser era Identity (RatifyState era)
drp)
      , Context -> UMap -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era) -> UMap
forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpUMap DRepPulser era Identity (RatifyState era)
drp)
      , Context -> Int -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era) -> Int
forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpIndex DRepPulser era Identity (RatifyState era)
drp)
      , Context -> InstantStake era -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era) -> InstantStake era
forall era ans (m :: * -> *).
DRepPulser era m ans -> InstantStake era
dpInstantStake DRepPulser era Identity (RatifyState era)
drp)
      , -- dpStakePoolDistr is allowed to have thunks
        Context -> Map DRep (CompactForm Coin) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era)
-> Map DRep (CompactForm Coin)
forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpDRepDistr DRepPulser era Identity (RatifyState era)
drp)
      , Context
-> Map (Credential 'DRepRole) DRepState -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era)
-> Map (Credential 'DRepRole) DRepState
forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpDRepState DRepPulser era Identity (RatifyState era)
drp)
      , Context -> EpochNo -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era) -> EpochNo
forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCurrentEpoch DRepPulser era Identity (RatifyState era)
drp)
      , Context -> CommitteeState era -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era) -> CommitteeState era
forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpCommitteeState DRepPulser era Identity (RatifyState era)
drp)
      , Context -> EnactState era -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era) -> EnactState era
forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpEnactState DRepPulser era Identity (RatifyState era)
drp)
      , Context -> StrictSeq (GovActionState era) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era)
-> StrictSeq (GovActionState era)
forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposals DRepPulser era Identity (RatifyState era)
drp)
      , Context
-> Map (Credential 'Staking) (CompactForm Coin)
-> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era)
-> Map (Credential 'Staking) (CompactForm Coin)
forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpProposalDeposits DRepPulser era Identity (RatifyState era)
drp)
      , Context -> Globals -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era) -> Globals
forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpGlobals DRepPulser era Identity (RatifyState era)
drp)
      , Context
-> Map (KeyHash 'StakePool) PoolParams -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctxt (DRepPulser era Identity (RatifyState era)
-> Map (KeyHash 'StakePool) PoolParams
forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (KeyHash 'StakePool) PoolParams
dpPoolParams DRepPulser era Identity (RatifyState era)
drp)
      ]

instance (EraPParams era, NFData (InstantStake era)) => NFData (DRepPulser era Identity (RatifyState era)) where
  rnf :: DRepPulser era Identity (RatifyState era) -> ()
rnf (DRepPulser Int
n UMap
um Int
bal InstantStake era
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 Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
      UMap
um UMap -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
        Int
bal Int -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
          InstantStake era
stake InstantStake era -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
            PoolDistr
pool PoolDistr -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
              Map DRep (CompactForm Coin)
drep Map DRep (CompactForm Coin) -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                Map (Credential 'DRepRole) DRepState
dstate Map (Credential 'DRepRole) DRepState -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                  EpochNo
ep EpochNo -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                    CommitteeState era
cs CommitteeState era -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                      EnactState era
es EnactState era -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                        StrictSeq (GovActionState era)
as StrictSeq (GovActionState era) -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                          Map (Credential 'Staking) (CompactForm Coin)
pds Map (Credential 'Staking) (CompactForm Coin) -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                            Globals
gs Globals -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq`
                              Map (KeyHash 'StakePool) PoolParams -> ()
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 =
          Reader Globals (Either (NonEmpty Void) (RatifyState era))
-> Globals -> Either (NonEmpty Void) (RatifyState era)
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) (RuleContext 'Transition (ConwayRATIFY era)
 -> ReaderT
      Globals
      Identity
      (Either
         (NonEmpty (PredicateFailure (ConwayRATIFY era)))
         (State (ConwayRATIFY era))))
-> RuleContext 'Transition (ConwayRATIFY era)
-> ReaderT
     Globals
     Identity
     (Either
        (NonEmpty (PredicateFailure (ConwayRATIFY era)))
        (State (ConwayRATIFY era)))
forall a b. (a -> b) -> a -> b
$
                (Environment (ConwayRATIFY era), State (ConwayRATIFY era),
 Signal (ConwayRATIFY era))
-> TRC (ConwayRATIFY era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (Environment (ConwayRATIFY era)
RatifyEnv era
ratifyEnv, State (ConwayRATIFY era)
RatifyState era
ratifyState, StrictSeq (GovActionState era) -> RatifySignal era
forall era. StrictSeq (GovActionState era) -> RatifySignal era
RatifySignal (StrictSeq (GovActionState era) -> RatifySignal era)
-> StrictSeq (GovActionState era) -> RatifySignal era
forall a b. (a -> b) -> a -> b
$ StrictSeq (GovActionState era) -> StrictSeq (GovActionState era)
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]
_) -> Void -> RatifyState era
forall a. Void -> a
absurd Void
x
          Right RatifyState era
ratifyState' -> RatifyState era
ratifyState'

finishDRepPulser :: EraStake era => DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser :: forall era.
EraStake 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
PoolDistr
CommitteeState era
InstantStake era
StrictSeq (GovActionState era)
EpochNo
Globals
UMap
EnactState era
dpPulseSize :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpUMap :: forall era ans (m :: * -> *). DRepPulser era m ans -> UMap
dpIndex :: forall era ans (m :: * -> *). DRepPulser era m ans -> Int
dpInstantStake :: forall era ans (m :: * -> *).
DRepPulser era m ans -> InstantStake era
dpStakePoolDistr :: forall era ans (m :: * -> *). DRepPulser era m ans -> PoolDistr
dpDRepDistr :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map DRep (CompactForm Coin)
dpDRepState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (Credential 'DRepRole) DRepState
dpCurrentEpoch :: forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCommitteeState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpEnactState :: forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpProposals :: forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposalDeposits :: forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (Credential 'Staking) (CompactForm Coin)
dpGlobals :: forall era ans (m :: * -> *). DRepPulser era m ans -> Globals
dpPoolParams :: forall era ans (m :: * -> *).
DRepPulser era m ans -> Map (KeyHash 'StakePool) PoolParams
dpPulseSize :: Int
dpUMap :: UMap
dpIndex :: Int
dpInstantStake :: InstantStake era
dpStakePoolDistr :: PoolDistr
dpDRepDistr :: Map DRep (CompactForm Coin)
dpDRepState :: Map (Credential 'DRepRole) DRepState
dpCurrentEpoch :: EpochNo
dpCommitteeState :: CommitteeState era
dpEnactState :: EnactState era
dpProposals :: StrictSeq (GovActionState era)
dpProposalDeposits :: Map (Credential 'Staking) (CompactForm Coin)
dpGlobals :: Globals
dpPoolParams :: Map (KeyHash 'StakePool) PoolParams
..})) =
  ( StrictSeq (GovActionState era)
-> Map DRep (CompactForm Coin)
-> Map (Credential 'DRepRole) DRepState
-> Map (KeyHash 'StakePool) (CompactForm Coin)
-> PulsingSnapshot era
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
      ((IndividualPoolStake -> CompactForm Coin)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Map (KeyHash 'StakePool) (CompactForm Coin)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map IndividualPoolStake -> CompactForm Coin
individualTotalPoolStake (Map (KeyHash 'StakePool) IndividualPoolStake
 -> Map (KeyHash 'StakePool) (CompactForm Coin))
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Map (KeyHash 'StakePool) (CompactForm Coin)
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 = Int
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall k a. Int -> Map k a -> Map k a
Map.drop Int
dpIndex (Map (Credential 'Staking) UMElem
 -> Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
-> Map (Credential 'Staking) UMElem
forall a b. (a -> b) -> a -> b
$ UMap -> Map (Credential 'Staking) UMElem
umElems UMap
dpUMap
    (Map DRep (CompactForm Coin)
finalDRepDistr, PoolDistr
finalStakePoolDistr) =
      InstantStake era
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
forall era.
EraStake era =>
InstantStake era
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr InstantStake era
dpInstantStake 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
        { reInstantStake :: InstantStake era
reInstantStake = InstantStake era
dpInstantStake
        , 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 = StrictSeq (GovActionState era) -> RatifySignal era
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 = Seq (GovActionState era)
forall a. Monoid a => a
mempty
        , rsExpired :: Set GovActionId
rsExpired = Set GovActionId
forall a. Monoid a => a
mempty
        , rsDelayed :: Bool
rsDelayed = Bool
False
        }
    !ratifyState' :: RatifyState era
ratifyState' = Globals
-> RatifyEnv era
-> RatifyState era
-> RatifySignal era
-> RatifyState era
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 x. DRepPulsingState era -> Rep (DRepPulsingState era) x)
-> (forall x. Rep (DRepPulsingState era) x -> DRepPulsingState era)
-> Generic (DRepPulsingState era)
forall x. Rep (DRepPulsingState era) x -> DRepPulsingState era
forall x. DRepPulsingState era -> Rep (DRepPulsingState era) x
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
$cfrom :: forall era x. DRepPulsingState era -> Rep (DRepPulsingState era) x
from :: forall x. DRepPulsingState era -> Rep (DRepPulsingState era) x
$cto :: forall era x. Rep (DRepPulsingState era) x -> DRepPulsingState era
to :: forall x. Rep (DRepPulsingState era) x -> DRepPulsingState era
Generic)

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

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

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

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

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

instance (EraStake era, EraPParams era) => EncCBOR (DRepPulsingState era) where
  encCBOR :: DRepPulsingState era -> Encoding
encCBOR (DRComplete PulsingSnapshot era
x RatifyState era
y) = Encode ('Closed 'Dense) (DRepPulsingState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> Encode
     ('Closed 'Dense)
     (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete Encode
  ('Closed 'Dense)
  (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> Encode ('Closed 'Dense) (PulsingSnapshot era)
-> Encode
     ('Closed 'Dense) (RatifyState era -> DRepPulsingState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PulsingSnapshot era
-> Encode ('Closed 'Dense) (PulsingSnapshot era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PulsingSnapshot era
x Encode ('Closed 'Dense) (RatifyState era -> DRepPulsingState era)
-> Encode ('Closed 'Dense) (RatifyState era)
-> Encode ('Closed 'Dense) (DRepPulsingState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RatifyState era -> Encode ('Closed 'Dense) (RatifyState era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RatifyState era
y)
  encCBOR x :: DRepPulsingState era
x@(DRPulsing (DRepPulser {})) = Encode ('Closed 'Dense) (DRepPulsingState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> Encode
     ('Closed 'Dense)
     (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete Encode
  ('Closed 'Dense)
  (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> Encode ('Closed 'Dense) (PulsingSnapshot era)
-> Encode
     ('Closed 'Dense) (RatifyState era -> DRepPulsingState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PulsingSnapshot era
-> Encode ('Closed 'Dense) (PulsingSnapshot era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PulsingSnapshot era
snap Encode ('Closed 'Dense) (RatifyState era -> DRepPulsingState era)
-> Encode ('Closed 'Dense) (RatifyState era)
-> Encode ('Closed 'Dense) (DRepPulsingState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RatifyState era -> Encode ('Closed 'Dense) (RatifyState era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RatifyState era
ratstate)
    where
      (PulsingSnapshot era
snap, RatifyState era
ratstate) = DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x

instance EraPParams era => DecShareCBOR (DRepPulsingState era) where
  type
    Share (DRepPulsingState era) =
      ( Interns (Credential 'Staking)
      , Interns (KeyHash 'StakePool)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  decShareCBOR :: forall s.
Share (DRepPulsingState era) -> Decoder s (DRepPulsingState era)
decShareCBOR Share (DRepPulsingState era)
is =
    Decode ('Closed 'Dense) (DRepPulsingState era)
-> Decoder s (DRepPulsingState era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (DRepPulsingState era)
 -> Decoder s (DRepPulsingState era))
-> Decode ('Closed 'Dense) (DRepPulsingState era)
-> Decoder s (DRepPulsingState era)
forall a b. (a -> b) -> a -> b
$
      (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> Decode
     ('Closed 'Dense)
     (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
forall t. t -> Decode ('Closed 'Dense) t
RecD PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete
        Decode
  ('Closed 'Dense)
  (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> Decode ('Closed 'Dense) (PulsingSnapshot era)
-> Decode
     ('Closed 'Dense) (RatifyState era -> DRepPulsingState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (PulsingSnapshot era))
-> Decode ('Closed 'Dense) (PulsingSnapshot era)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Share (PulsingSnapshot era) -> Decoder s (PulsingSnapshot era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (PulsingSnapshot era) -> Decoder s (PulsingSnapshot era)
decShareCBOR Share (DRepPulsingState era)
Share (PulsingSnapshot era)
is)
        Decode ('Closed 'Dense) (RatifyState era -> DRepPulsingState era)
-> Decode ('Closed 'Dense) (RatifyState era)
-> Decode ('Closed 'Dense) (DRepPulsingState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (RatifyState era))
-> Decode ('Closed 'Dense) (RatifyState era)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Share (RatifyState era) -> Decoder s (RatifyState era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share (RatifyState era) -> Decoder s (RatifyState era)
decShareCBOR Share (RatifyState era)
Share (DRepPulsingState era)
is)

instance EraPParams era => DecCBOR (DRepPulsingState era) where
  decCBOR :: forall s. Decoder s (DRepPulsingState era)
decCBOR = Decode ('Closed 'Dense) (DRepPulsingState era)
-> Decoder s (DRepPulsingState era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode ((PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> Decode
     ('Closed 'Dense)
     (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
forall t. t -> Decode ('Closed 'Dense) t
RecD PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete Decode
  ('Closed 'Dense)
  (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> Decode ('Closed Any) (PulsingSnapshot era)
-> Decode
     ('Closed 'Dense) (RatifyState era -> DRepPulsingState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PulsingSnapshot era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (RatifyState era -> DRepPulsingState era)
-> Decode ('Closed Any) (RatifyState era)
-> Decode ('Closed 'Dense) (DRepPulsingState era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (RatifyState era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From)

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

pulseDRepPulsingState :: EraStake era => DRepPulsingState era -> DRepPulsingState era
pulseDRepPulsingState :: forall era.
EraStake 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 = DRepPulser era Identity (RatifyState era)
-> DRepPulser era Identity (RatifyState era)
forall (p :: (* -> *) -> * -> *) ans.
Pulsable p =>
p Identity ans -> p Identity ans
pulse DRepPulser era Identity (RatifyState era)
x
   in if DRepPulser era Identity (RatifyState era) -> Bool
forall (m :: * -> *) ans. DRepPulser era m ans -> Bool
forall (pulse :: (* -> *) -> * -> *) (m :: * -> *) ans.
Pulsable pulse =>
pulse m ans -> Bool
done DRepPulser era Identity (RatifyState era)
x2
        then (PulsingSnapshot era -> RatifyState era -> DRepPulsingState era)
-> (PulsingSnapshot era, RatifyState era) -> DRepPulsingState era
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete (DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
x2))
        else DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
x2

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

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