{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Rules.Mir (
  ShelleyMIR,
  PredicateFailure,
  ShelleyMirPredFailure,
  ShelleyMirEvent (..),
  emptyInstantaneousRewards,
) where

import Cardano.Ledger.BaseTypes (ShelleyBase)
import Cardano.Ledger.Coin (Coin, addDeltaCoin)
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Keys (KeyRole (..))
import Cardano.Ledger.Shelley.Era (ShelleyMIR)
import Cardano.Ledger.Shelley.LedgerState (
  EpochState,
  curPParamsEpochStateL,
  esChainAccountState,
  esLState,
  esLStateL,
  esNonMyopic,
  esSnapshots,
  lsCertStateL,
  prevPParamsEpochStateL,
  pattern EpochState,
 )
import Cardano.Ledger.State
import Cardano.Ledger.UMap (compactCoinOrError)
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.Val ((<->))
import Control.DeepSeq (NFData)
import Control.SetAlgebra (eval, (∪+))
import Control.State.Transition (
  Assertion (..),
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  tellEvent,
 )
import Data.Default (Default)
import Data.Foldable (fold)
import qualified Data.Map.Strict as Map
import GHC.Generics (Generic)
import Lens.Micro ((&), (.~), (^.))
import NoThunks.Class (NoThunks (..))

data ShelleyMirPredFailure era
  deriving (Int -> ShelleyMirPredFailure era -> ShowS
[ShelleyMirPredFailure era] -> ShowS
ShelleyMirPredFailure era -> String
(Int -> ShelleyMirPredFailure era -> ShowS)
-> (ShelleyMirPredFailure era -> String)
-> ([ShelleyMirPredFailure era] -> ShowS)
-> Show (ShelleyMirPredFailure era)
forall era. Int -> ShelleyMirPredFailure era -> ShowS
forall era. [ShelleyMirPredFailure era] -> ShowS
forall era. ShelleyMirPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ShelleyMirPredFailure era -> ShowS
showsPrec :: Int -> ShelleyMirPredFailure era -> ShowS
$cshow :: forall era. ShelleyMirPredFailure era -> String
show :: ShelleyMirPredFailure era -> String
$cshowList :: forall era. [ShelleyMirPredFailure era] -> ShowS
showList :: [ShelleyMirPredFailure era] -> ShowS
Show, (forall x.
 ShelleyMirPredFailure era -> Rep (ShelleyMirPredFailure era) x)
-> (forall x.
    Rep (ShelleyMirPredFailure era) x -> ShelleyMirPredFailure era)
-> Generic (ShelleyMirPredFailure era)
forall x.
Rep (ShelleyMirPredFailure era) x -> ShelleyMirPredFailure era
forall x.
ShelleyMirPredFailure era -> Rep (ShelleyMirPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyMirPredFailure era) x -> ShelleyMirPredFailure era
forall era x.
ShelleyMirPredFailure era -> Rep (ShelleyMirPredFailure era) x
$cfrom :: forall era x.
ShelleyMirPredFailure era -> Rep (ShelleyMirPredFailure era) x
from :: forall x.
ShelleyMirPredFailure era -> Rep (ShelleyMirPredFailure era) x
$cto :: forall era x.
Rep (ShelleyMirPredFailure era) x -> ShelleyMirPredFailure era
to :: forall x.
Rep (ShelleyMirPredFailure era) x -> ShelleyMirPredFailure era
Generic, ShelleyMirPredFailure era -> ShelleyMirPredFailure era -> Bool
(ShelleyMirPredFailure era -> ShelleyMirPredFailure era -> Bool)
-> (ShelleyMirPredFailure era -> ShelleyMirPredFailure era -> Bool)
-> Eq (ShelleyMirPredFailure era)
forall era.
ShelleyMirPredFailure era -> ShelleyMirPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ShelleyMirPredFailure era -> ShelleyMirPredFailure era -> Bool
== :: ShelleyMirPredFailure era -> ShelleyMirPredFailure era -> Bool
$c/= :: forall era.
ShelleyMirPredFailure era -> ShelleyMirPredFailure era -> Bool
/= :: ShelleyMirPredFailure era -> ShelleyMirPredFailure era -> Bool
Eq)

instance NFData (ShelleyMirPredFailure era)

data ShelleyMirEvent era
  = MirTransfer InstantaneousRewards
  | -- | We were not able to perform an MIR transfer due to insufficient funds.
    --   This event gives the rewards we wanted to pay, plus the available
    --   reserves and treasury.
    NoMirTransfer InstantaneousRewards Coin Coin
  deriving ((forall x. ShelleyMirEvent era -> Rep (ShelleyMirEvent era) x)
-> (forall x. Rep (ShelleyMirEvent era) x -> ShelleyMirEvent era)
-> Generic (ShelleyMirEvent era)
forall x. Rep (ShelleyMirEvent era) x -> ShelleyMirEvent era
forall x. ShelleyMirEvent era -> Rep (ShelleyMirEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyMirEvent era) x -> ShelleyMirEvent era
forall era x. ShelleyMirEvent era -> Rep (ShelleyMirEvent era) x
$cfrom :: forall era x. ShelleyMirEvent era -> Rep (ShelleyMirEvent era) x
from :: forall x. ShelleyMirEvent era -> Rep (ShelleyMirEvent era) x
$cto :: forall era x. Rep (ShelleyMirEvent era) x -> ShelleyMirEvent era
to :: forall x. Rep (ShelleyMirEvent era) x -> ShelleyMirEvent era
Generic)

deriving instance Eq (ShelleyMirEvent era)

instance NFData (ShelleyMirEvent era)

instance NoThunks (ShelleyMirPredFailure era)

instance
  ( Default (EpochState era)
  , EraGov era
  , EraCertState era
  ) =>
  STS (ShelleyMIR era)
  where
  type State (ShelleyMIR era) = EpochState era
  type Signal (ShelleyMIR era) = ()
  type Environment (ShelleyMIR era) = ()
  type BaseM (ShelleyMIR era) = ShelleyBase
  type Event (ShelleyMIR era) = ShelleyMirEvent era
  type PredicateFailure (ShelleyMIR era) = ShelleyMirPredFailure era

  transitionRules :: [TransitionRule (ShelleyMIR era)]
transitionRules = [TransitionRule (ShelleyMIR era)
forall era.
(EraGov era, EraCertState era) =>
TransitionRule (ShelleyMIR era)
mirTransition]

  assertions :: [Assertion (ShelleyMIR era)]
assertions =
    [ String
-> (TRC (ShelleyMIR era) -> State (ShelleyMIR era) -> Bool)
-> Assertion (ShelleyMIR era)
forall sts.
String -> (TRC sts -> State sts -> Bool) -> Assertion sts
PostCondition
        String
"MIR may not create or remove reward accounts"
        ( \(TRC (Environment (ShelleyMIR era)
_, State (ShelleyMIR era)
st, Signal (ShelleyMIR era)
_)) State (ShelleyMIR era)
st' ->
            let r :: EpochState era -> UView (Credential 'Staking) RDPair
r EpochState era
esl = DState era -> UView (Credential 'Staking) RDPair
forall era. DState era -> UView (Credential 'Staking) RDPair
rewards (EpochState era
esl EpochState era
-> Getting (DState era) (EpochState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. (LedgerState era -> Const (DState era) (LedgerState era))
-> EpochState era -> Const (DState era) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const (DState era) (LedgerState era))
 -> EpochState era -> Const (DState era) (EpochState era))
-> ((DState era -> Const (DState era) (DState era))
    -> LedgerState era -> Const (DState era) (LedgerState era))
-> Getting (DState era) (EpochState era) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const (DState era) (CertState era))
-> LedgerState era -> Const (DState era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const (DState era) (CertState era))
 -> LedgerState era -> Const (DState era) (LedgerState era))
-> ((DState era -> Const (DState era) (DState era))
    -> CertState era -> Const (DState era) (CertState era))
-> (DState era -> Const (DState era) (DState era))
-> LedgerState era
-> Const (DState era) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const (DState era) (DState era))
-> CertState era -> Const (DState era) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL)
             in UView (Credential 'Staking) RDPair -> Int
forall a. UView (Credential 'Staking) a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (EpochState era -> UView (Credential 'Staking) RDPair
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
EpochState era -> UView (Credential 'Staking) RDPair
r State (ShelleyMIR era)
EpochState era
st) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== UView (Credential 'Staking) RDPair -> Int
forall a. UView (Credential 'Staking) a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (EpochState era -> UView (Credential 'Staking) RDPair
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraCertState era) =>
EpochState era -> UView (Credential 'Staking) RDPair
r State (ShelleyMIR era)
EpochState era
st')
        )
    ]

mirTransition ::
  forall era.
  (EraGov era, EraCertState era) =>
  TransitionRule (ShelleyMIR era)
mirTransition :: forall era.
(EraGov era, EraCertState era) =>
TransitionRule (ShelleyMIR era)
mirTransition = do
  TRC
    ( Environment (ShelleyMIR era)
_
      , es :: State (ShelleyMIR era)
es@EpochState
          { esChainAccountState :: forall era. EpochState era -> ChainAccountState
esChainAccountState = ChainAccountState
chainAccountState
          , esSnapshots :: forall era. EpochState era -> SnapShots
esSnapshots = SnapShots
ss
          , esLState :: forall era. EpochState era -> LedgerState era
esLState = LedgerState era
ls
          , esNonMyopic :: forall era. EpochState era -> NonMyopic
esNonMyopic = NonMyopic
nm
          }
      , ()
      ) <-
    Rule
  (ShelleyMIR era)
  'Transition
  (RuleContext 'Transition (ShelleyMIR era))
F (Clause (ShelleyMIR era) 'Transition) (TRC (ShelleyMIR era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let pr :: PParams era
pr = State (ShelleyMIR era)
EpochState era
es EpochState era
-> Getting (PParams era) (EpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL
      pp :: PParams era
pp = State (ShelleyMIR era)
EpochState era
es EpochState era
-> Getting (PParams era) (EpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. Getting (PParams era) (EpochState era) (PParams era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
      dpState :: CertState era
dpState = LedgerState era
ls 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
      ds :: DState era
ds = CertState era
dpState 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
      rewards' :: UView (Credential 'Staking) RDPair
rewards' = DState era -> UView (Credential 'Staking) RDPair
forall era. DState era -> UView (Credential 'Staking) RDPair
rewards DState era
ds
      reserves :: Coin
reserves = ChainAccountState -> Coin
casReserves ChainAccountState
chainAccountState
      treasury :: Coin
treasury = ChainAccountState -> Coin
casTreasury ChainAccountState
chainAccountState
      irwdR :: Map (Credential 'Staking) Coin
irwdR = UView (Credential 'Staking) RDPair
rewards' 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
UM.◁ InstantaneousRewards -> Map (Credential 'Staking) Coin
iRReserves (DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds) :: Map.Map (Credential 'Staking) Coin
      irwdT :: Map (Credential 'Staking) Coin
irwdT = UView (Credential 'Staking) RDPair
rewards' 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
UM.◁ InstantaneousRewards -> Map (Credential 'Staking) Coin
iRTreasury (DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds) :: Map.Map (Credential 'Staking) Coin
      totR :: Coin
totR = 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
irwdR
      totT :: Coin
totT = 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
irwdT
      availableReserves :: Coin
availableReserves = Coin
reserves Coin -> DeltaCoin -> Coin
`addDeltaCoin` InstantaneousRewards -> DeltaCoin
deltaReserves (DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds)
      availableTreasury :: Coin
availableTreasury = Coin
treasury Coin -> DeltaCoin -> Coin
`addDeltaCoin` InstantaneousRewards -> DeltaCoin
deltaTreasury (DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds)
      update :: Map (Credential 'Staking) Coin
update = Exp (Map (Credential 'Staking) Coin)
-> Map (Credential 'Staking) Coin
forall s t. Embed s t => Exp t -> s
eval (Map (Credential 'Staking) Coin
irwdR Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> Exp (Map (Credential 'Staking) Coin)
forall k n s1 (f :: * -> * -> *) s2 (g :: * -> * -> *).
(Ord k, Monoid n, HasExp s1 (f k n), HasExp s2 (g k n)) =>
s1 -> s2 -> Exp (f k n)
∪+ Map (Credential 'Staking) Coin
irwdT) :: Map.Map (Credential 'Staking) Coin

  if Coin
totR Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
availableReserves Bool -> Bool -> Bool
&& Coin
totT Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
availableTreasury
    then do
      Event (ShelleyMIR era) -> Rule (ShelleyMIR era) 'Transition ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (ShelleyMIR era) -> Rule (ShelleyMIR era) 'Transition ())
-> Event (ShelleyMIR era) -> Rule (ShelleyMIR era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ InstantaneousRewards -> ShelleyMirEvent era
forall era. InstantaneousRewards -> ShelleyMirEvent era
MirTransfer ((DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds) {iRReserves = irwdR, iRTreasury = irwdT})
      EpochState era
-> F (Clause (ShelleyMIR era) 'Transition) (EpochState era)
forall a. a -> F (Clause (ShelleyMIR era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochState era
 -> F (Clause (ShelleyMIR era) 'Transition) (EpochState era))
-> EpochState era
-> F (Clause (ShelleyMIR era) 'Transition) (EpochState era)
forall a b. (a -> b) -> a -> b
$
        ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
forall era.
ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
EpochState
          ChainAccountState
            { casReserves :: Coin
casReserves = Coin
availableReserves Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
totR
            , casTreasury :: Coin
casTreasury = Coin
availableTreasury Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
totT
            }
          ( LedgerState era
ls
              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))
-> ((UMap -> Identity UMap)
    -> CertState era -> Identity (CertState era))
-> (UMap -> Identity UMap)
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> ((UMap -> Identity UMap) -> DState era -> Identity (DState era))
-> (UMap -> Identity UMap)
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
 -> LedgerState era -> Identity (LedgerState era))
-> UMap -> LedgerState era -> LedgerState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (UView (Credential 'Staking) RDPair
rewards' UView (Credential 'Staking) RDPair
-> Map (Credential 'Staking) (CompactForm Coin) -> UMap
UM.∪+ (Coin -> CompactForm Coin)
-> Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) (CompactForm Coin)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Map (Credential 'Staking) Coin
update)
              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))
-> ((InstantaneousRewards -> Identity InstantaneousRewards)
    -> CertState era -> Identity (CertState era))
-> (InstantaneousRewards -> Identity InstantaneousRewards)
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> ((InstantaneousRewards -> Identity InstantaneousRewards)
    -> DState era -> Identity (DState era))
-> (InstantaneousRewards -> Identity InstantaneousRewards)
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstantaneousRewards -> Identity InstantaneousRewards)
-> DState era -> Identity (DState era)
forall era (f :: * -> *).
Functor f =>
(InstantaneousRewards -> f InstantaneousRewards)
-> DState era -> f (DState era)
dsIRewardsL ((InstantaneousRewards -> Identity InstantaneousRewards)
 -> LedgerState era -> Identity (LedgerState era))
-> InstantaneousRewards -> LedgerState era -> LedgerState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InstantaneousRewards
emptyInstantaneousRewards
          )
          SnapShots
ss
          NonMyopic
nm
          EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pr
          EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
    else do
      Event (ShelleyMIR era) -> Rule (ShelleyMIR era) 'Transition ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (ShelleyMIR era) -> Rule (ShelleyMIR era) 'Transition ())
-> Event (ShelleyMIR era) -> Rule (ShelleyMIR era) 'Transition ()
forall a b. (a -> b) -> a -> b
$
        InstantaneousRewards -> Coin -> Coin -> ShelleyMirEvent era
forall era.
InstantaneousRewards -> Coin -> Coin -> ShelleyMirEvent era
NoMirTransfer
          ((DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds) {iRReserves = irwdR, iRTreasury = irwdT})
          Coin
availableReserves
          Coin
availableTreasury
      EpochState era
-> F (Clause (ShelleyMIR era) 'Transition) (EpochState era)
forall a. a -> F (Clause (ShelleyMIR era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochState era
 -> F (Clause (ShelleyMIR era) 'Transition) (EpochState era))
-> EpochState era
-> F (Clause (ShelleyMIR era) 'Transition) (EpochState era)
forall a b. (a -> b) -> a -> b
$
        ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
forall era.
ChainAccountState
-> LedgerState era -> SnapShots -> NonMyopic -> EpochState era
EpochState
          ChainAccountState
chainAccountState
          ( LedgerState era
ls
              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))
-> ((InstantaneousRewards -> Identity InstantaneousRewards)
    -> CertState era -> Identity (CertState era))
-> (InstantaneousRewards -> Identity InstantaneousRewards)
-> LedgerState era
-> Identity (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> ((InstantaneousRewards -> Identity InstantaneousRewards)
    -> DState era -> Identity (DState era))
-> (InstantaneousRewards -> Identity InstantaneousRewards)
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstantaneousRewards -> Identity InstantaneousRewards)
-> DState era -> Identity (DState era)
forall era (f :: * -> *).
Functor f =>
(InstantaneousRewards -> f InstantaneousRewards)
-> DState era -> f (DState era)
dsIRewardsL ((InstantaneousRewards -> Identity InstantaneousRewards)
 -> LedgerState era -> Identity (LedgerState era))
-> InstantaneousRewards -> LedgerState era -> LedgerState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InstantaneousRewards
emptyInstantaneousRewards
          )
          SnapShots
ss
          NonMyopic
nm
          EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pr
          EpochState era
-> (EpochState era -> EpochState era) -> EpochState era
forall a b. a -> (a -> b) -> b
& (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
 -> EpochState era -> Identity (EpochState era))
-> PParams era -> EpochState era -> EpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp

emptyInstantaneousRewards :: InstantaneousRewards
emptyInstantaneousRewards :: InstantaneousRewards
emptyInstantaneousRewards = Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards
InstantaneousRewards Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty Map (Credential 'Staking) Coin
forall k a. Map k a
Map.empty DeltaCoin
forall a. Monoid a => a
mempty DeltaCoin
forall a. Monoid a => a
mempty