{-# 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, compactCoinOrError)
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.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 accountsCount :: EpochState era -> Int
accountsCount EpochState era
esl =
                  Map (Credential 'Staking) (AccountState era) -> Int
forall k a. Map k a -> Int
Map.size (EpochState era
esl EpochState era
-> Getting
     (Map (Credential 'Staking) (AccountState era))
     (EpochState era)
     (Map (Credential 'Staking) (AccountState era))
-> Map (Credential 'Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. (LedgerState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (LedgerState era))
-> EpochState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era
  -> Const
       (Map (Credential 'Staking) (AccountState era)) (LedgerState era))
 -> EpochState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (EpochState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> LedgerState era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (LedgerState era))
-> Getting
     (Map (Credential 'Staking) (AccountState era))
     (EpochState era)
     (Map (Credential 'Staking) (AccountState era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (CertState era))
-> LedgerState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era
  -> Const
       (Map (Credential 'Staking) (AccountState era)) (CertState era))
 -> LedgerState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (LedgerState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> CertState era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (CertState era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Const
         (Map (Credential 'Staking) (AccountState era))
         (Map (Credential 'Staking) (AccountState era)))
-> LedgerState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (DState era))
-> CertState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era
  -> Const
       (Map (Credential 'Staking) (AccountState era)) (DState era))
 -> CertState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (CertState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> DState era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (DState era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Const
         (Map (Credential 'Staking) (AccountState era))
         (Map (Credential 'Staking) (AccountState era)))
-> CertState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> DState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((Accounts era
  -> Const
       (Map (Credential 'Staking) (AccountState era)) (Accounts era))
 -> DState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (DState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> Accounts era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Const
         (Map (Credential 'Staking) (AccountState era))
         (Map (Credential 'Staking) (AccountState era)))
-> DState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) (AccountState era)
 -> Const
      (Map (Credential 'Staking) (AccountState era))
      (Map (Credential 'Staking) (AccountState era)))
-> Accounts era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL)
             in EpochState era -> Int
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 -> Int
accountsCount State (ShelleyMIR era)
EpochState era
st Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== EpochState era -> Int
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 -> Int
accountsCount 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
      accountsMap :: Map (Credential 'Staking) (AccountState era)
accountsMap = DState era
ds DState era
-> Getting
     (Map (Credential 'Staking) (AccountState era))
     (DState era)
     (Map (Credential 'Staking) (AccountState era))
-> Map (Credential 'Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. (Accounts era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> DState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((Accounts era
  -> Const
       (Map (Credential 'Staking) (AccountState era)) (Accounts era))
 -> DState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (DState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> Accounts era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> Getting
     (Map (Credential 'Staking) (AccountState era))
     (DState era)
     (Map (Credential 'Staking) (AccountState era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) (AccountState era)
 -> Const
      (Map (Credential 'Staking) (AccountState era))
      (Map (Credential 'Staking) (AccountState era)))
-> Accounts era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL
      reserves :: Coin
reserves = ChainAccountState -> Coin
casReserves ChainAccountState
chainAccountState
      treasury :: Coin
treasury = ChainAccountState -> Coin
casTreasury ChainAccountState
chainAccountState
      irwdR :: Map (Credential 'Staking) Coin
irwdR = InstantaneousRewards -> Map (Credential 'Staking) Coin
iRReserves (DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds) Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) Coin
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` Map (Credential 'Staking) (AccountState era)
accountsMap
      irwdT :: Map (Credential 'Staking) Coin
irwdT = InstantaneousRewards -> Map (Credential 'Staking) Coin
iRTreasury (DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds) Map (Credential 'Staking) Coin
-> Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) Coin
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` Map (Credential 'Staking) (AccountState era)
accountsMap
      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))
-> ((Accounts era -> Identity (Accounts era))
    -> CertState era -> Identity (CertState era))
-> (Accounts era -> Identity (Accounts era))
-> 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))
-> ((Accounts era -> Identity (Accounts era))
    -> DState era -> Identity (DState era))
-> (Accounts era -> Identity (Accounts era))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Identity (Accounts era))
-> DState era -> Identity (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
                ((Accounts era -> Identity (Accounts era))
 -> LedgerState era -> Identity (LedgerState era))
-> (Accounts era -> Accounts era)
-> LedgerState era
-> LedgerState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map (Credential 'Staking) (CompactForm Coin)
-> Accounts era -> Accounts era
forall era.
EraAccounts era =>
Map (Credential 'Staking) (CompactForm Coin)
-> Accounts era -> Accounts era
addToBalanceAccounts ((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