{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.Epoch (
  ConwayEPOCH,
  PredicateFailure,
  ConwayEpochEvent (..),
) where

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.BaseTypes (ProtVer, ShelleyBase)
import Cardano.Ledger.Coin (Coin, compactCoinOrError)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEPOCH, ConwayEra, ConwayHARDFORK, ConwayRATIFY)
import Cardano.Ledger.Conway.Governance (
  Committee,
  ConwayEraGov (..),
  ConwayGovState,
  EnactState (..),
  GovActionId,
  GovActionState (..),
  Proposals,
  RatifyEnv (..),
  RatifySignal (..),
  RatifyState (..),
  RunConwayRatify,
  cgsCommitteeL,
  cgsConstitutionL,
  cgsCurPParamsL,
  cgsFuturePParamsL,
  cgsPrevPParamsL,
  cgsProposalsL,
  ensTreasuryL,
  ensWithdrawalsL,
  epochStateDRepPulsingStateL,
  extractDRepPulsingState,
  gasDeposit,
  gasReturnAddr,
  pPropsL,
  proposalsApplyEnactment,
  proposalsGovStateL,
  setFreshDRepPulsingState,
 )
import Cardano.Ledger.Conway.Governance.Procedures (Committee (..))
import Cardano.Ledger.Conway.Rules.HardFork (
  ConwayHardForkEvent (..),
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  LedgerState (..),
  UTxOState (..),
  curPParamsEpochStateL,
  esLStateL,
  esSnapshotsL,
  lsCertStateL,
  lsUTxOStateL,
  prevPParamsEpochStateL,
  totalObligation,
  utxosDepositedL,
  utxosDonationL,
  utxosGovStateL,
 )
import Cardano.Ledger.Shelley.Rewards ()
import Cardano.Ledger.Shelley.Rules (
  ShelleyPOOLREAP,
  ShelleyPoolreapEvent,
  ShelleyPoolreapPredFailure,
  ShelleyPoolreapState (..),
  ShelleySNAP,
  ShelleySnapPredFailure,
  SnapEnv (..),
  UpecPredFailure,
 )
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.Slot (EpochNo)
import Cardano.Ledger.UMap (RDPair (..), UMap, UView (..), (∪+), (◁))
import qualified Cardano.Ledger.UMap as UMap
import Cardano.Ledger.Val (zero, (<->))
import Control.DeepSeq (NFData)
import Control.SetAlgebra (eval, (⨃))
import Control.State.Transition (
  Embed (..),
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  liftSTS,
  tellEvent,
  trans,
 )
import Data.Foldable (Foldable (..))
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.OMap.Strict as OMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Void (Void, absurd)
import GHC.Generics (Generic)
import Lens.Micro ((%~), (&), (.~), (<>~), (^.))

data ConwayEpochEvent era
  = PoolReapEvent (Event (EraRule "POOLREAP" era))
  | SnapEvent (Event (EraRule "SNAP" era))
  | EpochBoundaryRatifyState (RatifyState era)
  | GovInfoEvent
      -- | Enacted actions
      (Set (GovActionState era))
      -- | Actions that were removed as conflicting due to enactment
      (Set (GovActionState era))
      -- | Actions that were removed due to expiration together with their dependees
      (Set (GovActionState era))
      -- | Map of removed governance action ids that had an unregistered reward account to their unclaimed deposits so they can be transferred to the treasury.
      (Map.Map GovActionId Coin)
  | HardForkEvent (Event (EraRule "HARDFORK" era))
  deriving ((forall x. ConwayEpochEvent era -> Rep (ConwayEpochEvent era) x)
-> (forall x. Rep (ConwayEpochEvent era) x -> ConwayEpochEvent era)
-> Generic (ConwayEpochEvent era)
forall x. Rep (ConwayEpochEvent era) x -> ConwayEpochEvent era
forall x. ConwayEpochEvent era -> Rep (ConwayEpochEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayEpochEvent era) x -> ConwayEpochEvent era
forall era x. ConwayEpochEvent era -> Rep (ConwayEpochEvent era) x
$cfrom :: forall era x. ConwayEpochEvent era -> Rep (ConwayEpochEvent era) x
from :: forall x. ConwayEpochEvent era -> Rep (ConwayEpochEvent era) x
$cto :: forall era x. Rep (ConwayEpochEvent era) x -> ConwayEpochEvent era
to :: forall x. Rep (ConwayEpochEvent era) x -> ConwayEpochEvent era
Generic)

type instance EraRuleEvent "EPOCH" ConwayEra = ConwayEpochEvent ConwayEra

deriving instance
  ( EraPParams era
  , Eq (Event (EraRule "POOLREAP" era))
  , Eq (Event (EraRule "SNAP" era))
  , Eq (Event (EraRule "HARDFORK" era))
  ) =>
  Eq (ConwayEpochEvent era)

instance
  ( EraPParams era
  , NFData (Event (EraRule "POOLREAP" era))
  , NFData (Event (EraRule "SNAP" era))
  , NFData (Event (EraRule "HARDFORK" era))
  ) =>
  NFData (ConwayEpochEvent era)

instance
  ( EraTxOut era
  , RunConwayRatify era
  , ConwayEraCertState era
  , ConwayEraGov era
  , EraStake era
  , EraCertState era
  , Embed (EraRule "SNAP" era) (ConwayEPOCH era)
  , Environment (EraRule "SNAP" era) ~ SnapEnv era
  , State (EraRule "SNAP" era) ~ SnapShots
  , Signal (EraRule "SNAP" era) ~ ()
  , Embed (EraRule "POOLREAP" era) (ConwayEPOCH era)
  , Environment (EraRule "POOLREAP" era) ~ ()
  , State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era
  , Signal (EraRule "POOLREAP" era) ~ EpochNo
  , Eq (UpecPredFailure era)
  , Show (UpecPredFailure era)
  , Embed (EraRule "RATIFY" era) (ConwayEPOCH era)
  , Environment (EraRule "RATIFY" era) ~ RatifyEnv era
  , GovState era ~ ConwayGovState era
  , State (EraRule "RATIFY" era) ~ RatifyState era
  , Signal (EraRule "RATIFY" era) ~ RatifySignal era
  , Embed (EraRule "HARDFORK" era) (ConwayEPOCH era)
  , Environment (EraRule "HARDFORK" era) ~ ()
  , State (EraRule "HARDFORK" era) ~ EpochState era
  , Signal (EraRule "HARDFORK" era) ~ ProtVer
  ) =>
  STS (ConwayEPOCH era)
  where
  type State (ConwayEPOCH era) = EpochState era
  type Signal (ConwayEPOCH era) = EpochNo
  type Environment (ConwayEPOCH era) = ()
  type BaseM (ConwayEPOCH era) = ShelleyBase

  -- EPOCH rule can never fail
  type PredicateFailure (ConwayEPOCH era) = Void
  type Event (ConwayEPOCH era) = ConwayEpochEvent era
  transitionRules :: [TransitionRule (ConwayEPOCH era)]
transitionRules = [TransitionRule (ConwayEPOCH era)
forall era.
(RunConwayRatify era, ConwayEraCertState era, EraTxOut era,
 Eq (UpecPredFailure era), Show (UpecPredFailure era),
 Environment (EraRule "SNAP" era) ~ SnapEnv era,
 State (EraRule "SNAP" era) ~ SnapShots,
 Signal (EraRule "SNAP" era) ~ (),
 Embed (EraRule "SNAP" era) (ConwayEPOCH era),
 Embed (EraRule "POOLREAP" era) (ConwayEPOCH era),
 Environment (EraRule "POOLREAP" era) ~ (),
 State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era,
 Signal (EraRule "POOLREAP" era) ~ EpochNo,
 Embed (EraRule "RATIFY" era) (ConwayEPOCH era),
 Environment (EraRule "RATIFY" era) ~ RatifyEnv era,
 State (EraRule "RATIFY" era) ~ RatifyState era,
 GovState era ~ ConwayGovState era,
 Signal (EraRule "RATIFY" era) ~ RatifySignal era, ConwayEraGov era,
 Embed (EraRule "HARDFORK" era) (ConwayEPOCH era),
 Environment (EraRule "HARDFORK" era) ~ (),
 State (EraRule "HARDFORK" era) ~ EpochState era,
 Signal (EraRule "HARDFORK" era) ~ ProtVer) =>
TransitionRule (ConwayEPOCH era)
epochTransition]

returnProposalDeposits ::
  Foldable f =>
  f (GovActionState era) ->
  UMap ->
  (UMap, Map.Map GovActionId Coin)
returnProposalDeposits :: forall (f :: * -> *) era.
Foldable f =>
f (GovActionState era) -> UMap -> (UMap, Map GovActionId Coin)
returnProposalDeposits f (GovActionState era)
removedProposals UMap
oldUMap =
  (GovActionState era
 -> (UMap, Map GovActionId Coin) -> (UMap, Map GovActionId Coin))
-> (UMap, Map GovActionId Coin)
-> f (GovActionState era)
-> (UMap, Map GovActionId Coin)
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' GovActionState era
-> (UMap, Map GovActionId Coin) -> (UMap, Map GovActionId Coin)
forall {era}.
GovActionState era
-> (UMap, Map GovActionId Coin) -> (UMap, Map GovActionId Coin)
processProposal (UMap
oldUMap, Map GovActionId Coin
forall a. Monoid a => a
mempty) f (GovActionState era)
removedProposals
  where
    processProposal :: GovActionState era
-> (UMap, Map GovActionId Coin) -> (UMap, Map GovActionId Coin)
processProposal GovActionState era
gas (UMap
um, Map GovActionId Coin
unclaimed)
      | Credential 'Staking -> UView (Credential 'Staking) RDPair -> Bool
forall k v. k -> UView k v -> Bool
UMap.member (RewardAccount -> Credential 'Staking
raCredential (GovActionState era -> RewardAccount
forall era. GovActionState era -> RewardAccount
gasReturnAddr GovActionState era
gas)) (UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
um) =
          ( (RDPair -> RDPair)
-> Credential 'Staking
-> UView (Credential 'Staking) RDPair
-> UMap
forall k. (RDPair -> RDPair) -> k -> UView k RDPair -> UMap
UMap.adjust
              (Coin -> RDPair -> RDPair
addReward (GovActionState era -> Coin
forall era. GovActionState era -> Coin
gasDeposit GovActionState era
gas))
              (RewardAccount -> Credential 'Staking
raCredential (GovActionState era -> RewardAccount
forall era. GovActionState era -> RewardAccount
gasReturnAddr GovActionState era
gas))
              (UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
um)
          , Map GovActionId Coin
unclaimed
          )
      | Bool
otherwise = (UMap
um, GovActionId -> Coin -> Map GovActionId Coin -> Map GovActionId Coin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (GovActionState era -> GovActionId
forall era. GovActionState era -> GovActionId
gasId GovActionState era
gas) (GovActionState era -> Coin
forall era. GovActionState era -> Coin
gasDeposit GovActionState era
gas) Map GovActionId Coin
unclaimed)
    addReward :: Coin -> RDPair -> RDPair
addReward Coin
c RDPair
rd =
      -- Deposits have been validated at this point
      RDPair
rd {rdReward = rdReward rd <> compactCoinOrError c}

-- | When there have been zero governance proposals to vote on in the previous epoch
-- increase the dormant-epoch counter by one.
updateNumDormantEpochs :: EpochNo -> Proposals era -> VState era -> VState era
updateNumDormantEpochs :: forall era. EpochNo -> Proposals era -> VState era -> VState era
updateNumDormantEpochs EpochNo
currentEpoch Proposals era
ps VState era
vState =
  if OMap GovActionId (GovActionState era) -> Bool
forall a. OMap GovActionId a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (OMap GovActionId (GovActionState era) -> Bool)
-> OMap GovActionId (GovActionState era) -> Bool
forall a b. (a -> b) -> a -> b
$ (GovActionState era -> Bool)
-> OMap GovActionId (GovActionState era)
-> OMap GovActionId (GovActionState era)
forall k v. Ord k => (v -> Bool) -> OMap k v -> OMap k v
OMap.filter ((EpochNo
currentEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<=) (EpochNo -> Bool)
-> (GovActionState era -> EpochNo) -> GovActionState era -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionState era -> EpochNo
forall era. GovActionState era -> EpochNo
gasExpiresAfter) (OMap GovActionId (GovActionState era)
 -> OMap GovActionId (GovActionState era))
-> OMap GovActionId (GovActionState era)
-> OMap GovActionId (GovActionState era)
forall a b. (a -> b) -> a -> b
$ Proposals era
ps Proposals era
-> Getting
     (OMap GovActionId (GovActionState era))
     (Proposals era)
     (OMap GovActionId (GovActionState era))
-> OMap GovActionId (GovActionState era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OMap GovActionId (GovActionState era))
  (Proposals era)
  (OMap GovActionId (GovActionState era))
forall era (f :: * -> *).
Functor f =>
(OMap GovActionId (GovActionState era)
 -> f (OMap GovActionId (GovActionState era)))
-> Proposals era -> f (Proposals era)
pPropsL
    then VState era
vState VState era -> (VState era -> VState era) -> VState era
forall a b. a -> (a -> b) -> b
& (EpochNo -> Identity EpochNo)
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL ((EpochNo -> Identity EpochNo)
 -> VState era -> Identity (VState era))
-> (EpochNo -> EpochNo) -> VState era -> VState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ EpochNo -> EpochNo
forall a. Enum a => a -> a
succ
    else VState era
vState

-- | Apply TreasuryWithdrawals to the EpochState
--
--   acnt' = record acnt { treasury = treasury + UTxOState.fees utxoSt
--                                  + getCoin unclaimed + donations ∸ totWithdrawals }
--
-- The utxo fees and donations are applied in the remaining body of EPOCH transition
applyEnactedWithdrawals ::
  ChainAccountState ->
  DState era ->
  EnactState era ->
  (ChainAccountState, DState era, EnactState era)
applyEnactedWithdrawals :: forall era.
ChainAccountState
-> DState era
-> EnactState era
-> (ChainAccountState, DState era, EnactState era)
applyEnactedWithdrawals ChainAccountState
chainAccountState DState era
dState EnactState era
enactedState =
  let enactedWithdrawals :: Map (Credential 'Staking) Coin
enactedWithdrawals = EnactState era
enactedState EnactState era
-> Getting
     (Map (Credential 'Staking) Coin)
     (EnactState era)
     (Map (Credential 'Staking) Coin)
-> Map (Credential 'Staking) Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'Staking) Coin)
  (EnactState era)
  (Map (Credential 'Staking) Coin)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'Staking) Coin
 -> f (Map (Credential 'Staking) Coin))
-> EnactState era -> f (EnactState era)
ensWithdrawalsL
      rewardsUView :: UView (Credential 'Staking) RDPair
rewardsUView = UMap -> UView (Credential 'Staking) RDPair
RewDepUView (UMap -> UView (Credential 'Staking) RDPair)
-> UMap -> UView (Credential 'Staking) RDPair
forall a b. (a -> b) -> a -> b
$ DState era
dState DState era -> Getting UMap (DState era) UMap -> UMap
forall s a. s -> Getting a s a -> a
^. Getting UMap (DState era) UMap
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL
      successfulWithdrawls :: Map (Credential 'Staking) Coin
successfulWithdrawls = UView (Credential 'Staking) RDPair
rewardsUView UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) Coin -> Map (Credential 'Staking) Coin
forall k v u. UView k v -> Map k u -> Map k u
◁ Map (Credential 'Staking) Coin
enactedWithdrawals
      chainAccountState' :: ChainAccountState
chainAccountState' =
        ChainAccountState
chainAccountState
          -- Subtract `successfulWithdrawals` from the treasury, and add them to the rewards UMap
          -- `unclaimed` withdrawals remain in the treasury.
          -- Compared to the spec, instead of adding `unclaimed` and subtracting `totWithdrawals`
          --   + unclaimed - totWithdrawals
          -- we just subtract the `refunds`
          --   - refunds
          ChainAccountState
-> (ChainAccountState -> ChainAccountState) -> ChainAccountState
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> ChainAccountState -> Identity ChainAccountState
Lens' ChainAccountState Coin
casTreasuryL ((Coin -> Identity Coin)
 -> ChainAccountState -> Identity ChainAccountState)
-> (Coin -> Coin) -> ChainAccountState -> ChainAccountState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Map (Credential 'Staking) Coin -> Coin
forall m. Monoid m => Map (Credential 'Staking) m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking) Coin
successfulWithdrawls)
      -- The use of the partial function `compactCoinOrError` is justified here because
      -- 1. the decoder for coin at the proposal-submission boundary has already
      --    confirmed we have a compactible value
      -- 2. the refunds and unsuccessful refunds together do not exceed the
      --    current treasury value, as enforced by the `ENACT` rule.
      dState' :: DState era
dState' =
        DState era
dState
          DState era -> (DState era -> DState era) -> DState era
forall a b. a -> (a -> b) -> b
& (UMap -> Identity UMap) -> DState era -> Identity (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL ((UMap -> Identity UMap) -> DState era -> Identity (DState era))
-> UMap -> DState era -> DState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (UView (Credential 'Staking) RDPair
rewardsUView UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) (CompactForm Coin) -> UMap
∪+ (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError (Coin -> CompactForm Coin)
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (Credential 'Staking) Coin
successfulWithdrawls))
      -- Reset enacted withdrawals:
      enactedState' :: EnactState era
enactedState' =
        EnactState era
enactedState
          EnactState era
-> (EnactState era -> EnactState era) -> EnactState era
forall a b. a -> (a -> b) -> b
& (Map (Credential 'Staking) Coin
 -> Identity (Map (Credential 'Staking) Coin))
-> EnactState era -> Identity (EnactState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'Staking) Coin
 -> f (Map (Credential 'Staking) Coin))
-> EnactState era -> f (EnactState era)
ensWithdrawalsL ((Map (Credential 'Staking) Coin
  -> Identity (Map (Credential 'Staking) Coin))
 -> EnactState era -> Identity (EnactState era))
-> Map (Credential 'Staking) Coin
-> EnactState era
-> EnactState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty
          EnactState era
-> (EnactState era -> EnactState era) -> EnactState era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> EnactState era -> Identity (EnactState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> EnactState era -> f (EnactState era)
ensTreasuryL ((Coin -> Identity Coin)
 -> EnactState era -> Identity (EnactState era))
-> Coin -> EnactState era -> EnactState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
forall a. Monoid a => a
mempty
   in (ChainAccountState
chainAccountState', DState era
dState', EnactState era
enactedState')

epochTransition ::
  forall era.
  ( RunConwayRatify era
  , ConwayEraCertState era
  , EraTxOut era
  , Eq (UpecPredFailure era)
  , Show (UpecPredFailure era)
  , Environment (EraRule "SNAP" era) ~ SnapEnv era
  , State (EraRule "SNAP" era) ~ SnapShots
  , Signal (EraRule "SNAP" era) ~ ()
  , Embed (EraRule "SNAP" era) (ConwayEPOCH era)
  , Embed (EraRule "POOLREAP" era) (ConwayEPOCH era)
  , Environment (EraRule "POOLREAP" era) ~ ()
  , State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era
  , Signal (EraRule "POOLREAP" era) ~ EpochNo
  , Embed (EraRule "RATIFY" era) (ConwayEPOCH era)
  , Environment (EraRule "RATIFY" era) ~ RatifyEnv era
  , State (EraRule "RATIFY" era) ~ RatifyState era
  , GovState era ~ ConwayGovState era
  , Signal (EraRule "RATIFY" era) ~ RatifySignal era
  , ConwayEraGov era
  , Embed (EraRule "HARDFORK" era) (ConwayEPOCH era)
  , Environment (EraRule "HARDFORK" era) ~ ()
  , State (EraRule "HARDFORK" era) ~ EpochState era
  , Signal (EraRule "HARDFORK" era) ~ ProtVer
  ) =>
  TransitionRule (ConwayEPOCH era)
epochTransition :: forall era.
(RunConwayRatify era, ConwayEraCertState era, EraTxOut era,
 Eq (UpecPredFailure era), Show (UpecPredFailure era),
 Environment (EraRule "SNAP" era) ~ SnapEnv era,
 State (EraRule "SNAP" era) ~ SnapShots,
 Signal (EraRule "SNAP" era) ~ (),
 Embed (EraRule "SNAP" era) (ConwayEPOCH era),
 Embed (EraRule "POOLREAP" era) (ConwayEPOCH era),
 Environment (EraRule "POOLREAP" era) ~ (),
 State (EraRule "POOLREAP" era) ~ ShelleyPoolreapState era,
 Signal (EraRule "POOLREAP" era) ~ EpochNo,
 Embed (EraRule "RATIFY" era) (ConwayEPOCH era),
 Environment (EraRule "RATIFY" era) ~ RatifyEnv era,
 State (EraRule "RATIFY" era) ~ RatifyState era,
 GovState era ~ ConwayGovState era,
 Signal (EraRule "RATIFY" era) ~ RatifySignal era, ConwayEraGov era,
 Embed (EraRule "HARDFORK" era) (ConwayEPOCH era),
 Environment (EraRule "HARDFORK" era) ~ (),
 State (EraRule "HARDFORK" era) ~ EpochState era,
 Signal (EraRule "HARDFORK" era) ~ ProtVer) =>
TransitionRule (ConwayEPOCH era)
epochTransition = do
  TRC
    ( ()
      , epochState0 :: State (ConwayEPOCH era)
epochState0@EpochState
          { esSnapshots :: forall era. EpochState era -> SnapShots
esSnapshots = SnapShots
snapshots0
          , esLState :: forall era. EpochState era -> LedgerState era
esLState = LedgerState era
ledgerState0
          }
      , Signal (ConwayEPOCH era)
eNo
      ) <-
    Rule
  (ConwayEPOCH era)
  'Transition
  (RuleContext 'Transition (ConwayEPOCH era))
F (Clause (ConwayEPOCH era) 'Transition) (TRC (ConwayEPOCH era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let chainAccountState0 :: ChainAccountState
chainAccountState0 = State (ConwayEPOCH era)
EpochState era
epochState0 EpochState era
-> Getting ChainAccountState (EpochState era) ChainAccountState
-> ChainAccountState
forall s a. s -> Getting a s a -> a
^. Getting ChainAccountState (EpochState era) ChainAccountState
forall era. Lens' (EpochState era) ChainAccountState
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) ChainAccountState
chainAccountStateL
      govState0 :: GovState era
govState0 = UTxOState era -> GovState era
forall era. UTxOState era -> GovState era
utxosGovState UTxOState era
utxoState0
      curPParams :: PParams era
curPParams = GovState era
ConwayGovState era
govState0 ConwayGovState era
-> Getting (PParams era) (ConwayGovState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. (PParams era -> Const (PParams era) (PParams era))
-> GovState era -> Const (PParams era) (GovState era)
Getting (PParams era) (ConwayGovState era) (PParams era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
curPParamsGovStateL
      utxoState0 :: UTxOState era
utxoState0 = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ledgerState0
      certState0 :: CertState era
certState0 = LedgerState era
ledgerState0 LedgerState era
-> Getting (CertState era) (LedgerState era) (CertState era)
-> CertState era
forall s a. s -> Getting a s a -> a
^. Getting (CertState era) (LedgerState era) (CertState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL
      vState :: VState era
vState = CertState era
certState0 CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL
      pState0 :: PState era
pState0 = CertState era
certState0 CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
  SnapShots
snapshots1 <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "SNAP" era) (RuleContext 'Transition (EraRule "SNAP" era)
 -> Rule (ConwayEPOCH era) 'Transition (State (EraRule "SNAP" era)))
-> RuleContext 'Transition (EraRule "SNAP" era)
-> Rule (ConwayEPOCH era) 'Transition (State (EraRule "SNAP" era))
forall a b. (a -> b) -> a -> b
$ (Environment (EraRule "SNAP" era), State (EraRule "SNAP" era),
 Signal (EraRule "SNAP" era))
-> TRC (EraRule "SNAP" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerState era -> PParams era -> SnapEnv era
forall era. LedgerState era -> PParams era -> SnapEnv era
SnapEnv LedgerState era
ledgerState0 PParams era
curPParams, SnapShots
State (EraRule "SNAP" era)
snapshots0, ())

  -- Activate future StakePools
  let newStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
newStakePoolParams = Exp (Map (KeyHash 'StakePool) PoolParams)
-> Map (KeyHash 'StakePool) PoolParams
forall s t. Embed s t => Exp t -> s
eval (PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psStakePoolParams PState era
pState0 Map (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
-> Exp (Map (KeyHash 'StakePool) PoolParams)
forall k s1 (f :: * -> * -> *) v s2 (g :: * -> * -> *).
(Ord k, HasExp s1 (f k v), HasExp s2 (g k v)) =>
s1 -> s2 -> Exp (f k v)
⨃ PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams PState era
pState0)
      pState1 :: PState era
pState1 =
        PState era
pState0
          { psStakePoolParams = newStakePoolParams
          , psFutureStakePoolParams = Map.empty
          }
  PoolreapState UTxOState era
utxoState1 ChainAccountState
chainAccountState1 CertState era
certState1 <-
    forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "POOLREAP" era) (RuleContext 'Transition (EraRule "POOLREAP" era)
 -> Rule
      (ConwayEPOCH era) 'Transition (State (EraRule "POOLREAP" era)))
-> RuleContext 'Transition (EraRule "POOLREAP" era)
-> Rule
     (ConwayEPOCH era) 'Transition (State (EraRule "POOLREAP" era))
forall a b. (a -> b) -> a -> b
$
      (Environment (EraRule "POOLREAP" era),
 State (EraRule "POOLREAP" era), Signal (EraRule "POOLREAP" era))
-> TRC (EraRule "POOLREAP" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), UTxOState era
-> ChainAccountState -> CertState era -> ShelleyPoolreapState era
forall era.
UTxOState era
-> ChainAccountState -> CertState era -> ShelleyPoolreapState era
PoolreapState UTxOState era
utxoState0 ChainAccountState
chainAccountState0 (CertState era
certState0 CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
pState1), Signal (EraRule "POOLREAP" era)
Signal (ConwayEPOCH era)
eNo)

  let
    stakePoolDistr :: PoolDistr
stakePoolDistr = SnapShots -> PoolDistr
ssStakeMarkPoolDistr SnapShots
snapshots1
    pulsingState :: DRepPulsingState era
pulsingState = State (ConwayEPOCH era)
EpochState era
epochState0 EpochState era
-> Getting
     (DRepPulsingState era) (EpochState era) (DRepPulsingState era)
-> DRepPulsingState era
forall s a. s -> Getting a s a -> a
^. Getting
  (DRepPulsingState era) (EpochState era) (DRepPulsingState era)
forall era.
ConwayEraGov era =>
Lens' (EpochState era) (DRepPulsingState era)
Lens' (EpochState era) (DRepPulsingState era)
epochStateDRepPulsingStateL

    ratifyState :: RatifyState era
ratifyState@RatifyState {EnactState era
rsEnactState :: EnactState era
rsEnactState :: forall era. RatifyState era -> EnactState era
rsEnactState, Seq (GovActionState era)
rsEnacted :: Seq (GovActionState era)
rsEnacted :: forall era. RatifyState era -> Seq (GovActionState era)
rsEnacted, Set GovActionId
rsExpired :: Set GovActionId
rsExpired :: forall era. RatifyState era -> Set GovActionId
rsExpired} =
      DRepPulsingState era -> RatifyState era
forall era. EraStake era => DRepPulsingState era -> RatifyState era
extractDRepPulsingState DRepPulsingState era
pulsingState

    (ChainAccountState
chainAccountState2, DState era
dState2, EnactState {Map (Credential 'Staking) Coin
StrictMaybe (Committee era)
PParams era
Coin
Constitution era
GovRelation StrictMaybe era
ensCommittee :: StrictMaybe (Committee era)
ensConstitution :: Constitution era
ensCurPParams :: PParams era
ensPrevPParams :: PParams era
ensTreasury :: Coin
ensWithdrawals :: Map (Credential 'Staking) Coin
ensPrevGovActionIds :: GovRelation StrictMaybe era
ensCommittee :: forall era. EnactState era -> StrictMaybe (Committee era)
ensConstitution :: forall era. EnactState era -> Constitution era
ensCurPParams :: forall era. EnactState era -> PParams era
ensPrevPParams :: forall era. EnactState era -> PParams era
ensTreasury :: forall era. EnactState era -> Coin
ensWithdrawals :: forall era. EnactState era -> Map (Credential 'Staking) Coin
ensPrevGovActionIds :: forall era. EnactState era -> GovRelation StrictMaybe era
..}) =
      ChainAccountState
-> DState era
-> EnactState era
-> (ChainAccountState, DState era, EnactState era)
forall era.
ChainAccountState
-> DState era
-> EnactState era
-> (ChainAccountState, DState era, EnactState era)
applyEnactedWithdrawals ChainAccountState
chainAccountState1 (CertState era
certState1 CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL) EnactState era
rsEnactState

    -- NOTE: It is important that we apply the results of ratification
    -- and enactment from the pulser to the working copy of proposals.
    -- The proposals in the pulser are a subset of the current
    -- proposals, in that, in addition to the proposals in the pulser,
    -- the current proposals now contain new proposals submitted during
    -- the epoch that just passed (we are at its boundary here) and
    -- any votes that were submitted to the already pulsing as well as
    -- newly submitted proposals. We only need to apply the enactment
    -- operations to this superset to get a new set of proposals with:
    -- enacted actions and their sibling subtrees, as well as expired
    -- actions and their subtrees, removed, and with all the votes
    -- intact for the rest of them.
    (Proposals era
newProposals, Map GovActionId (GovActionState era)
enactedActions, Map GovActionId (GovActionState era)
removedDueToEnactment, Map GovActionId (GovActionState era)
expiredActions) =
      Seq (GovActionState era)
-> Set GovActionId
-> Proposals era
-> (Proposals era, Map GovActionId (GovActionState era),
    Map GovActionId (GovActionState era),
    Map GovActionId (GovActionState era))
forall era.
EraPParams era =>
Seq (GovActionState era)
-> Set GovActionId
-> Proposals era
-> (Proposals era, Map GovActionId (GovActionState era),
    Map GovActionId (GovActionState era),
    Map GovActionId (GovActionState era))
proposalsApplyEnactment Seq (GovActionState era)
rsEnacted Set GovActionId
rsExpired (GovState era
ConwayGovState era
govState0 ConwayGovState era
-> Getting (Proposals era) (ConwayGovState era) (Proposals era)
-> Proposals era
forall s a. s -> Getting a s a -> a
^. (Proposals era -> Const (Proposals era) (Proposals era))
-> GovState era -> Const (Proposals era) (GovState era)
Getting (Proposals era) (ConwayGovState era) (Proposals era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
Lens' (GovState era) (Proposals era)
proposalsGovStateL)

    -- Apply the values from the computed EnactState to the GovState
    govState1 :: ConwayGovState era
govState1 =
      GovState era
ConwayGovState era
govState0
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (Proposals era -> Identity (Proposals era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(Proposals era -> f (Proposals era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsProposalsL ((Proposals era -> Identity (Proposals era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> Proposals era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proposals era
newProposals
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Committee era)
 -> Identity (StrictMaybe (Committee era)))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> ConwayGovState era -> f (ConwayGovState era)
cgsCommitteeL ((StrictMaybe (Committee era)
  -> Identity (StrictMaybe (Committee era)))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> StrictMaybe (Committee era)
-> ConwayGovState era
-> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Committee era)
ensCommittee
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (Constitution era -> Identity (Constitution era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(Constitution era -> f (Constitution era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsConstitutionL ((Constitution era -> Identity (Constitution era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> Constitution era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Constitution era
ensConstitution
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsCurPParamsL ((PParams era -> Identity (PParams era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> PParams era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GovState era -> PParams era
forall era. EraGov era => GovState era -> PParams era
nextEpochPParams GovState era
govState0
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(PParams era -> f (PParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsPrevPParamsL ((PParams era -> Identity (PParams era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> PParams era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
curPParams
        ConwayGovState era
-> (ConwayGovState era -> ConwayGovState era) -> ConwayGovState era
forall a b. a -> (a -> b) -> b
& (FuturePParams era -> Identity (FuturePParams era))
-> ConwayGovState era -> Identity (ConwayGovState era)
forall era (f :: * -> *).
Functor f =>
(FuturePParams era -> f (FuturePParams era))
-> ConwayGovState era -> f (ConwayGovState era)
cgsFuturePParamsL ((FuturePParams era -> Identity (FuturePParams era))
 -> ConwayGovState era -> Identity (ConwayGovState era))
-> FuturePParams era -> ConwayGovState era -> ConwayGovState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (PParams era) -> FuturePParams era
forall era. Maybe (PParams era) -> FuturePParams era
PotentialPParamsUpdate Maybe (PParams era)
forall a. Maybe a
Nothing

    allRemovedGovActions :: Map GovActionId (GovActionState era)
allRemovedGovActions = [Map GovActionId (GovActionState era)]
-> Map GovActionId (GovActionState era)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map GovActionId (GovActionState era)
expiredActions, Map GovActionId (GovActionState era)
enactedActions, Map GovActionId (GovActionState era)
removedDueToEnactment]
    (UMap
newUMap, Map GovActionId Coin
unclaimed) =
      Map GovActionId (GovActionState era)
-> UMap -> (UMap, Map GovActionId Coin)
forall (f :: * -> *) era.
Foldable f =>
f (GovActionState era) -> UMap -> (UMap, Map GovActionId Coin)
returnProposalDeposits Map GovActionId (GovActionState era)
allRemovedGovActions (UMap -> (UMap, Map GovActionId Coin))
-> UMap -> (UMap, Map GovActionId Coin)
forall a b. (a -> b) -> a -> b
$
        DState era
dState2 DState era -> Getting UMap (DState era) UMap -> UMap
forall s a. s -> Getting a s a -> a
^. Getting UMap (DState era) UMap
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL

  Event (ConwayEPOCH era) -> Rule (ConwayEPOCH era) 'Transition ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (ConwayEPOCH era) -> Rule (ConwayEPOCH era) 'Transition ())
-> Event (ConwayEPOCH era) -> Rule (ConwayEPOCH era) 'Transition ()
forall a b. (a -> b) -> a -> b
$
    Set (GovActionState era)
-> Set (GovActionState era)
-> Set (GovActionState era)
-> Map GovActionId Coin
-> ConwayEpochEvent era
forall era.
Set (GovActionState era)
-> Set (GovActionState era)
-> Set (GovActionState era)
-> Map GovActionId Coin
-> ConwayEpochEvent era
GovInfoEvent
      ([GovActionState era] -> Set (GovActionState era)
forall a. Ord a => [a] -> Set a
Set.fromList ([GovActionState era] -> Set (GovActionState era))
-> [GovActionState era] -> Set (GovActionState era)
forall a b. (a -> b) -> a -> b
$ Map GovActionId (GovActionState era) -> [GovActionState era]
forall k a. Map k a -> [a]
Map.elems Map GovActionId (GovActionState era)
enactedActions)
      ([GovActionState era] -> Set (GovActionState era)
forall a. Ord a => [a] -> Set a
Set.fromList ([GovActionState era] -> Set (GovActionState era))
-> [GovActionState era] -> Set (GovActionState era)
forall a b. (a -> b) -> a -> b
$ Map GovActionId (GovActionState era) -> [GovActionState era]
forall k a. Map k a -> [a]
Map.elems Map GovActionId (GovActionState era)
removedDueToEnactment)
      ([GovActionState era] -> Set (GovActionState era)
forall a. Ord a => [a] -> Set a
Set.fromList ([GovActionState era] -> Set (GovActionState era))
-> [GovActionState era] -> Set (GovActionState era)
forall a b. (a -> b) -> a -> b
$ Map GovActionId (GovActionState era) -> [GovActionState era]
forall k a. Map k a -> [a]
Map.elems Map GovActionId (GovActionState era)
expiredActions)
      Map GovActionId Coin
unclaimed

  let
    certState2 :: CertState era
certState2 =
      VState era -> PState era -> DState era -> CertState era
forall era.
ConwayEraCertState era =>
VState era -> PState era -> DState era -> CertState era
mkConwayCertState
        -- Increment the dormant epoch counter
        ( EpochNo -> Proposals era -> VState era -> VState era
forall era. EpochNo -> Proposals era -> VState era -> VState era
updateNumDormantEpochs EpochNo
Signal (ConwayEPOCH era)
eNo Proposals era
newProposals VState era
vState
            -- Remove cold credentials of committee members that were removed or were invalid
            VState era -> (VState era -> VState era) -> VState era
forall a b. a -> (a -> b) -> b
& (CommitteeState era -> Identity (CommitteeState era))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState era)
vsCommitteeStateL ((CommitteeState era -> Identity (CommitteeState era))
 -> VState era -> Identity (VState era))
-> (CommitteeState era -> CommitteeState era)
-> VState era
-> VState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ StrictMaybe (Committee era)
-> CommitteeState era -> CommitteeState era
forall era.
StrictMaybe (Committee era)
-> CommitteeState era -> CommitteeState era
updateCommitteeState (ConwayGovState era
govState1 ConwayGovState era
-> Getting
     (StrictMaybe (Committee era))
     (ConwayGovState era)
     (StrictMaybe (Committee era))
-> StrictMaybe (Committee era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Committee era))
  (ConwayGovState era)
  (StrictMaybe (Committee era))
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (Committee era) -> f (StrictMaybe (Committee era)))
-> ConwayGovState era -> f (ConwayGovState era)
cgsCommitteeL)
        )
        (CertState era
certState1 CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL)
        (DState era
dState2 DState era -> (DState era -> DState era) -> DState era
forall a b. a -> (a -> b) -> b
& (UMap -> Identity UMap) -> DState era -> Identity (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL ((UMap -> Identity UMap) -> DState era -> Identity (DState era))
-> UMap -> DState era -> DState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UMap
newUMap)
    chainAccountState3 :: ChainAccountState
chainAccountState3 =
      ChainAccountState
chainAccountState2
        -- Move donations and unclaimed rewards from proposals to treasury:
        ChainAccountState
-> (ChainAccountState -> ChainAccountState) -> ChainAccountState
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> ChainAccountState -> Identity ChainAccountState
Lens' ChainAccountState Coin
casTreasuryL ((Coin -> Identity Coin)
 -> ChainAccountState -> Identity ChainAccountState)
-> Coin -> ChainAccountState -> ChainAccountState
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ (UTxOState era
utxoState0 UTxOState era -> Getting Coin (UTxOState era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (UTxOState era) Coin
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDonationL Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Map GovActionId Coin -> Coin
forall m. Monoid m => Map GovActionId m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map GovActionId Coin
unclaimed)
    utxoState2 :: UTxOState era
utxoState2 =
      UTxOState era
utxoState1
        UTxOState era -> (UTxOState era -> UTxOState era) -> UTxOState era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDepositedL ((Coin -> Identity Coin)
 -> UTxOState era -> Identity (UTxOState era))
-> Coin -> UTxOState era -> UTxOState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CertState era -> GovState era -> Coin
forall era.
(EraGov era, EraCertState era) =>
CertState era -> GovState era -> Coin
totalObligation CertState era
certState2 GovState era
ConwayGovState era
govState1
        -- Clear the donations field:
        UTxOState era -> (UTxOState era -> UTxOState era) -> UTxOState era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> UTxOState era -> f (UTxOState era)
utxosDonationL ((Coin -> Identity Coin)
 -> UTxOState era -> Identity (UTxOState era))
-> Coin -> UTxOState era -> UTxOState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
forall t. Val t => t
zero
        UTxOState era -> (UTxOState era -> UTxOState era) -> UTxOState era
forall a b. a -> (a -> b) -> b
& (GovState era -> Identity (GovState era))
-> UTxOState era -> Identity (UTxOState era)
(ConwayGovState era -> Identity (ConwayGovState era))
-> UTxOState era -> Identity (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL ((ConwayGovState era -> Identity (ConwayGovState era))
 -> UTxOState era -> Identity (UTxOState era))
-> ConwayGovState era -> UTxOState era -> UTxOState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ConwayGovState era
govState1
    ledgerState1 :: LedgerState era
ledgerState1 =
      LedgerState era
ledgerState0
        LedgerState era
-> (LedgerState era -> LedgerState era) -> LedgerState era
forall a b. a -> (a -> b) -> b
& (CertState era -> Identity (CertState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Identity (CertState era))
 -> LedgerState era -> Identity (LedgerState era))
-> CertState era -> LedgerState era -> LedgerState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CertState era
certState2
        LedgerState era
-> (LedgerState era -> LedgerState era) -> LedgerState era
forall a b. a -> (a -> b) -> b
& (UTxOState era -> Identity (UTxOState era))
-> LedgerState era -> Identity (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Identity (UTxOState era))
 -> LedgerState era -> Identity (LedgerState era))
-> UTxOState era -> LedgerState era -> LedgerState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTxOState era
utxoState2
    epochState1 :: EpochState era
epochState1 =
      State (ConwayEPOCH era)
EpochState era
epochState0
        EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (ChainAccountState -> Identity ChainAccountState)
-> EpochState era -> Identity (EpochState era)
forall era. Lens' (EpochState era) ChainAccountState
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) ChainAccountState
chainAccountStateL ((ChainAccountState -> Identity ChainAccountState)
 -> EpochState era -> Identity (EpochState era))
-> ChainAccountState -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ChainAccountState
chainAccountState3
        EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (SnapShots -> Identity SnapShots)
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(SnapShots -> f SnapShots) -> EpochState era -> f (EpochState era)
esSnapshotsL ((SnapShots -> Identity SnapShots)
 -> EpochState era -> Identity (EpochState era))
-> SnapShots -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SnapShots
snapshots1
        EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (LedgerState era -> Identity (LedgerState era))
-> EpochState era -> Identity (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Identity (LedgerState era))
 -> EpochState era -> Identity (EpochState era))
-> LedgerState era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LedgerState era
ledgerState1
  Event (ConwayEPOCH era) -> Rule (ConwayEPOCH era) 'Transition ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (ConwayEPOCH era) -> Rule (ConwayEPOCH era) 'Transition ())
-> Event (ConwayEPOCH era) -> Rule (ConwayEPOCH era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ RatifyState era -> ConwayEpochEvent era
forall era. RatifyState era -> ConwayEpochEvent era
EpochBoundaryRatifyState RatifyState era
ratifyState
  EpochState era
epochState2 <- do
    let curPv :: ProtVer
curPv = EpochState era
epochState1 EpochState era
-> Getting ProtVer (EpochState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (PParams era -> Const ProtVer (PParams era))
-> EpochState era -> Const ProtVer (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const ProtVer (PParams era))
 -> EpochState era -> Const ProtVer (EpochState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> PParams era -> Const ProtVer (PParams era))
-> Getting ProtVer (EpochState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> PParams era -> Const ProtVer (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
    if ProtVer
curPv ProtVer -> ProtVer -> Bool
forall a. Eq a => a -> a -> Bool
/= EpochState era
epochState1 EpochState era
-> Getting ProtVer (EpochState era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. (PParams era -> Const ProtVer (PParams era))
-> EpochState era -> Const ProtVer (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL ((PParams era -> Const ProtVer (PParams era))
 -> EpochState era -> Const ProtVer (EpochState era))
-> ((ProtVer -> Const ProtVer ProtVer)
    -> PParams era -> Const ProtVer (PParams era))
-> Getting ProtVer (EpochState era) ProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const ProtVer ProtVer)
-> PParams era -> Const ProtVer (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
      then forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "HARDFORK" era) (RuleContext 'Transition (EraRule "HARDFORK" era)
 -> Rule
      (ConwayEPOCH era) 'Transition (State (EraRule "HARDFORK" era)))
-> RuleContext 'Transition (EraRule "HARDFORK" era)
-> Rule
     (ConwayEPOCH era) 'Transition (State (EraRule "HARDFORK" era))
forall a b. (a -> b) -> a -> b
$ (Environment (EraRule "HARDFORK" era),
 State (EraRule "HARDFORK" era), Signal (EraRule "HARDFORK" era))
-> TRC (EraRule "HARDFORK" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC ((), State (EraRule "HARDFORK" era)
EpochState era
epochState1, ProtVer
Signal (EraRule "HARDFORK" era)
curPv)
      else EpochState era
-> F (Clause (ConwayEPOCH era) 'Transition) (EpochState era)
forall a. a -> F (Clause (ConwayEPOCH era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochState era
epochState1
  BaseM (ConwayEPOCH era) (EpochState era)
-> F (Clause (ConwayEPOCH era) 'Transition) (EpochState era)
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (ConwayEPOCH era) (EpochState era)
 -> F (Clause (ConwayEPOCH era) 'Transition) (EpochState era))
-> BaseM (ConwayEPOCH era) (EpochState era)
-> F (Clause (ConwayEPOCH era) 'Transition) (EpochState era)
forall a b. (a -> b) -> a -> b
$ EpochNo
-> PoolDistr
-> EpochState era
-> ReaderT Globals Identity (EpochState era)
forall era (m :: * -> *).
(GovState era ~ ConwayGovState era, Monad m, RunConwayRatify era,
 ConwayEraGov era, ConwayEraCertState era) =>
EpochNo
-> PoolDistr
-> EpochState era
-> ReaderT Globals m (EpochState era)
setFreshDRepPulsingState EpochNo
Signal (ConwayEPOCH era)
eNo PoolDistr
stakePoolDistr EpochState era
epochState2

instance
  ( Era era
  , STS (ShelleyPOOLREAP era)
  , PredicateFailure (EraRule "POOLREAP" era) ~ ShelleyPoolreapPredFailure era
  , Event (EraRule "POOLREAP" era) ~ ShelleyPoolreapEvent era
  ) =>
  Embed (ShelleyPOOLREAP era) (ConwayEPOCH era)
  where
  wrapFailed :: PredicateFailure (ShelleyPOOLREAP era)
-> PredicateFailure (ConwayEPOCH era)
wrapFailed = \case {}
  wrapEvent :: Event (ShelleyPOOLREAP era) -> Event (ConwayEPOCH era)
wrapEvent = Event (EraRule "POOLREAP" era) -> ConwayEpochEvent era
Event (ShelleyPOOLREAP era) -> Event (ConwayEPOCH era)
forall era. Event (EraRule "POOLREAP" era) -> ConwayEpochEvent era
PoolReapEvent

instance
  ( EraTxOut era
  , EraStake era
  , EraCertState era
  , PredicateFailure (EraRule "SNAP" era) ~ ShelleySnapPredFailure era
  , Event (EraRule "SNAP" era) ~ Shelley.SnapEvent era
  ) =>
  Embed (ShelleySNAP era) (ConwayEPOCH era)
  where
  wrapFailed :: PredicateFailure (ShelleySNAP era)
-> PredicateFailure (ConwayEPOCH era)
wrapFailed = \case {}
  wrapEvent :: Event (ShelleySNAP era) -> Event (ConwayEPOCH era)
wrapEvent = Event (EraRule "SNAP" era) -> ConwayEpochEvent era
Event (ShelleySNAP era) -> Event (ConwayEPOCH era)
forall era. Event (EraRule "SNAP" era) -> ConwayEpochEvent era
SnapEvent

instance
  ( EraGov era
  , PredicateFailure (ConwayRATIFY era) ~ Void
  , STS (ConwayRATIFY era)
  , BaseM (ConwayRATIFY era) ~ ShelleyBase
  , Event (ConwayRATIFY era) ~ Void
  ) =>
  Embed (ConwayRATIFY era) (ConwayEPOCH era)
  where
  wrapFailed :: PredicateFailure (ConwayRATIFY era)
-> PredicateFailure (ConwayEPOCH era)
wrapFailed = Void -> Void
PredicateFailure (ConwayRATIFY era)
-> PredicateFailure (ConwayEPOCH era)
forall a. Void -> a
absurd
  wrapEvent :: Event (ConwayRATIFY era) -> Event (ConwayEPOCH era)
wrapEvent = Void -> ConwayEpochEvent era
Event (ConwayRATIFY era) -> Event (ConwayEPOCH era)
forall a. Void -> a
absurd

instance
  ( EraGov era
  , PredicateFailure (ConwayHARDFORK era) ~ Void
  , STS (ConwayHARDFORK era)
  , BaseM (ConwayHARDFORK era) ~ ShelleyBase
  , Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era
  ) =>
  Embed (ConwayHARDFORK era) (ConwayEPOCH era)
  where
  wrapFailed :: PredicateFailure (ConwayHARDFORK era)
-> PredicateFailure (ConwayEPOCH era)
wrapFailed = Void -> Void
PredicateFailure (ConwayHARDFORK era)
-> PredicateFailure (ConwayEPOCH era)
forall a. Void -> a
absurd
  wrapEvent :: Event (ConwayHARDFORK era) -> Event (ConwayEPOCH era)
wrapEvent = Event (EraRule "HARDFORK" era) -> ConwayEpochEvent era
Event (ConwayHARDFORK era) -> Event (ConwayEPOCH era)
forall era. Event (EraRule "HARDFORK" era) -> ConwayEpochEvent era
HardForkEvent

updateCommitteeState :: StrictMaybe (Committee era) -> CommitteeState era -> CommitteeState era
updateCommitteeState :: forall era.
StrictMaybe (Committee era)
-> CommitteeState era -> CommitteeState era
updateCommitteeState StrictMaybe (Committee era)
committee (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
creds) =
  Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
forall era.
Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
CommitteeState (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> CommitteeState era)
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
forall a b. (a -> b) -> a -> b
$ Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
creds Map (Credential 'ColdCommitteeRole) EpochNo
members
  where
    members :: Map (Credential 'ColdCommitteeRole) EpochNo
members = (Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> StrictMaybe (Committee era)
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall m a. Monoid m => (a -> m) -> StrictMaybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers StrictMaybe (Committee era)
committee