{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Rules.Deleg (
  ShelleyDELEG,
  DelegEnv (..),
  PredicateFailure,
  ShelleyDelegPredFailure (..),
  ShelleyDelegEvent (..),
) where

import Cardano.Ledger.BaseTypes (
  EpochInterval (..),
  Globals (..),
  Mismatch (..),
  Relation (..),
  ShelleyBase,
  addEpochInterval,
  epochInfoPure,
  invalidKey,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  decodeRecordSum,
  encodeListLen,
 )
import Cardano.Ledger.Coin (
  Coin (..),
  DeltaCoin (..),
  addDeltaCoin,
  compactCoinOrError,
  toDeltaCoin,
 )
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Credential (Credential, Ptr)
import Cardano.Ledger.Hashes (GenDelegPair (..), GenDelegs (..))
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Era (ShelleyDELEG, ShelleyEra, hardforkAlonzoAllowMIRTransfer)
import Cardano.Ledger.Shelley.LedgerState (availableAfterMIR)
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Slot (
  Duration (..),
  EpochNo (..),
  SlotNo,
  epochInfoFirst,
  (*-),
  (+*),
 )
import Control.DeepSeq
import Control.Monad (guard)
import Control.Monad.Trans.Reader (asks)
import Control.SetAlgebra (eval, range, singleton, (∉), (∪), (⨃))
import Control.State.Transition
import Data.Foldable (fold)
import Data.Group (Group (..))
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

data DelegEnv era = DelegEnv
  { forall era. DelegEnv era -> SlotNo
slotNo :: SlotNo
  , forall era. DelegEnv era -> EpochNo
deCurEpochNo :: EpochNo
  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
  , forall era. DelegEnv era -> Ptr
ptr_ :: Ptr
  , forall era. DelegEnv era -> ChainAccountState
deChainAccountState :: ChainAccountState
  , forall era. DelegEnv era -> PParams era
ppDE :: PParams era -- The protocol parameters are only used for the HardFork mechanism
  }
  deriving ((forall x. DelegEnv era -> Rep (DelegEnv era) x)
-> (forall x. Rep (DelegEnv era) x -> DelegEnv era)
-> Generic (DelegEnv era)
forall x. Rep (DelegEnv era) x -> DelegEnv era
forall x. DelegEnv era -> Rep (DelegEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (DelegEnv era) x -> DelegEnv era
forall era x. DelegEnv era -> Rep (DelegEnv era) x
$cfrom :: forall era x. DelegEnv era -> Rep (DelegEnv era) x
from :: forall x. DelegEnv era -> Rep (DelegEnv era) x
$cto :: forall era x. Rep (DelegEnv era) x -> DelegEnv era
to :: forall x. Rep (DelegEnv era) x -> DelegEnv era
Generic)

deriving instance Show (PParams era) => Show (DelegEnv era)

deriving instance Eq (PParams era) => Eq (DelegEnv era)

instance NFData (PParams era) => NFData (DelegEnv era)

data ShelleyDelegPredFailure era
  = StakeKeyAlreadyRegisteredDELEG
      (Credential Staking) -- Credential which is already registered
  | StakeKeyNotRegisteredDELEG
      (Credential Staking) -- Credential which is not registered
  | StakeKeyNonZeroAccountBalanceDELEG
      Coin -- The remaining reward account balance
  | StakeDelegationImpossibleDELEG
      (Credential Staking) -- Credential that is not registered
  | WrongCertificateTypeDELEG -- The TxCertPool constructor should not be used by this transition
  | GenesisKeyNotInMappingDELEG
      (KeyHash GenesisRole) -- Unknown Genesis KeyHash
  | DuplicateGenesisDelegateDELEG
      (KeyHash GenesisDelegate) -- Keyhash which is already delegated to
  | InsufficientForInstantaneousRewardsDELEG
      MIRPot -- which pot the rewards are to be drawn from, treasury or reserves
      (Mismatch RelLTEQ Coin)
  | MIRCertificateTooLateinEpochDELEG
      (Mismatch RelLT SlotNo)
  | DuplicateGenesisVRFDELEG
      (VRFVerKeyHash GenDelegVRF) -- VRF KeyHash which is already delegated to
  | MIRTransferNotCurrentlyAllowed
  | MIRNegativesNotCurrentlyAllowed
  | InsufficientForTransferDELEG
      MIRPot -- which pot the rewards are to be drawn from, treasury or reserves
      (Mismatch RelLTEQ Coin)
  | MIRProducesNegativeUpdate
  | MIRNegativeTransfer
      MIRPot -- which pot the rewards are to be drawn from, treasury or reserves
      Coin -- amount attempted to transfer
  deriving (Int -> ShelleyDelegPredFailure era -> ShowS
[ShelleyDelegPredFailure era] -> ShowS
ShelleyDelegPredFailure era -> String
(Int -> ShelleyDelegPredFailure era -> ShowS)
-> (ShelleyDelegPredFailure era -> String)
-> ([ShelleyDelegPredFailure era] -> ShowS)
-> Show (ShelleyDelegPredFailure era)
forall era. Int -> ShelleyDelegPredFailure era -> ShowS
forall era. [ShelleyDelegPredFailure era] -> ShowS
forall era. ShelleyDelegPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ShelleyDelegPredFailure era -> ShowS
showsPrec :: Int -> ShelleyDelegPredFailure era -> ShowS
$cshow :: forall era. ShelleyDelegPredFailure era -> String
show :: ShelleyDelegPredFailure era -> String
$cshowList :: forall era. [ShelleyDelegPredFailure era] -> ShowS
showList :: [ShelleyDelegPredFailure era] -> ShowS
Show, ShelleyDelegPredFailure era -> ShelleyDelegPredFailure era -> Bool
(ShelleyDelegPredFailure era
 -> ShelleyDelegPredFailure era -> Bool)
-> (ShelleyDelegPredFailure era
    -> ShelleyDelegPredFailure era -> Bool)
-> Eq (ShelleyDelegPredFailure era)
forall era.
ShelleyDelegPredFailure era -> ShelleyDelegPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ShelleyDelegPredFailure era -> ShelleyDelegPredFailure era -> Bool
== :: ShelleyDelegPredFailure era -> ShelleyDelegPredFailure era -> Bool
$c/= :: forall era.
ShelleyDelegPredFailure era -> ShelleyDelegPredFailure era -> Bool
/= :: ShelleyDelegPredFailure era -> ShelleyDelegPredFailure era -> Bool
Eq, (forall x.
 ShelleyDelegPredFailure era -> Rep (ShelleyDelegPredFailure era) x)
-> (forall x.
    Rep (ShelleyDelegPredFailure era) x -> ShelleyDelegPredFailure era)
-> Generic (ShelleyDelegPredFailure era)
forall x.
Rep (ShelleyDelegPredFailure era) x -> ShelleyDelegPredFailure era
forall x.
ShelleyDelegPredFailure era -> Rep (ShelleyDelegPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyDelegPredFailure era) x -> ShelleyDelegPredFailure era
forall era x.
ShelleyDelegPredFailure era -> Rep (ShelleyDelegPredFailure era) x
$cfrom :: forall era x.
ShelleyDelegPredFailure era -> Rep (ShelleyDelegPredFailure era) x
from :: forall x.
ShelleyDelegPredFailure era -> Rep (ShelleyDelegPredFailure era) x
$cto :: forall era x.
Rep (ShelleyDelegPredFailure era) x -> ShelleyDelegPredFailure era
to :: forall x.
Rep (ShelleyDelegPredFailure era) x -> ShelleyDelegPredFailure era
Generic)

type instance EraRuleFailure "DELEG" ShelleyEra = ShelleyDelegPredFailure ShelleyEra

instance InjectRuleFailure "DELEG" ShelleyDelegPredFailure ShelleyEra

newtype ShelleyDelegEvent era = DelegNewEpoch EpochNo
  deriving ((forall x. ShelleyDelegEvent era -> Rep (ShelleyDelegEvent era) x)
-> (forall x.
    Rep (ShelleyDelegEvent era) x -> ShelleyDelegEvent era)
-> Generic (ShelleyDelegEvent era)
forall x. Rep (ShelleyDelegEvent era) x -> ShelleyDelegEvent era
forall x. ShelleyDelegEvent era -> Rep (ShelleyDelegEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyDelegEvent era) x -> ShelleyDelegEvent era
forall era x.
ShelleyDelegEvent era -> Rep (ShelleyDelegEvent era) x
$cfrom :: forall era x.
ShelleyDelegEvent era -> Rep (ShelleyDelegEvent era) x
from :: forall x. ShelleyDelegEvent era -> Rep (ShelleyDelegEvent era) x
$cto :: forall era x.
Rep (ShelleyDelegEvent era) x -> ShelleyDelegEvent era
to :: forall x. Rep (ShelleyDelegEvent era) x -> ShelleyDelegEvent era
Generic, ShelleyDelegEvent era -> ShelleyDelegEvent era -> Bool
(ShelleyDelegEvent era -> ShelleyDelegEvent era -> Bool)
-> (ShelleyDelegEvent era -> ShelleyDelegEvent era -> Bool)
-> Eq (ShelleyDelegEvent era)
forall era. ShelleyDelegEvent era -> ShelleyDelegEvent era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. ShelleyDelegEvent era -> ShelleyDelegEvent era -> Bool
== :: ShelleyDelegEvent era -> ShelleyDelegEvent era -> Bool
$c/= :: forall era. ShelleyDelegEvent era -> ShelleyDelegEvent era -> Bool
/= :: ShelleyDelegEvent era -> ShelleyDelegEvent era -> Bool
Eq)

instance NFData (ShelleyDelegEvent era)

instance
  ( EraCertState era
  , EraPParams era
  , ShelleyEraAccounts era
  , ShelleyEraTxCert era
  , AtMostEra "Babbage" era
  ) =>
  STS (ShelleyDELEG era)
  where
  type State (ShelleyDELEG era) = CertState era
  type Signal (ShelleyDELEG era) = TxCert era
  type Environment (ShelleyDELEG era) = DelegEnv era
  type BaseM (ShelleyDELEG era) = ShelleyBase
  type PredicateFailure (ShelleyDELEG era) = ShelleyDelegPredFailure era
  type Event (ShelleyDELEG era) = ShelleyDelegEvent era

  transitionRules :: [TransitionRule (ShelleyDELEG era)]
transitionRules = [TransitionRule (ShelleyDELEG era)
forall era.
(EraCertState era, ShelleyEraAccounts era, ShelleyEraTxCert era,
 EraPParams era, AtMostEra "Babbage" era) =>
TransitionRule (ShelleyDELEG era)
delegationTransition]

instance NoThunks (ShelleyDelegPredFailure era)

instance NFData (ShelleyDelegPredFailure era)

instance Era era => EncCBOR (ShelleyDelegPredFailure era) where
  encCBOR :: ShelleyDelegPredFailure era -> Encoding
encCBOR = \case
    StakeKeyAlreadyRegisteredDELEG Credential Staking
cred ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential Staking
cred
    StakeKeyNotRegisteredDELEG Credential Staking
cred ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential Staking
cred
    StakeKeyNonZeroAccountBalanceDELEG Coin
rewardBalance ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
rewardBalance
    StakeDelegationImpossibleDELEG Credential Staking
cred ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Credential Staking -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Credential Staking
cred
    ShelleyDelegPredFailure era
WrongCertificateTypeDELEG ->
      Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
4 :: Word8)
    GenesisKeyNotInMappingDELEG KeyHash GenesisRole
gkh ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
5 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash GenesisRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash GenesisRole
gkh
    DuplicateGenesisDelegateDELEG KeyHash GenesisDelegate
kh ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
6 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash GenesisDelegate -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash GenesisDelegate
kh
    InsufficientForInstantaneousRewardsDELEG MIRPot
pot Mismatch RelLTEQ Coin
m ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
7 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRPot -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR MIRPot
pot
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Mismatch RelLTEQ Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Mismatch RelLTEQ Coin
m
    MIRCertificateTooLateinEpochDELEG Mismatch RelLT SlotNo
m ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
8 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Mismatch RelLT SlotNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Mismatch RelLT SlotNo
m
    DuplicateGenesisVRFDELEG VRFVerKeyHash GenDelegVRF
vrf ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
9 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VRFVerKeyHash GenDelegVRF -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR VRFVerKeyHash GenDelegVRF
vrf
    ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed ->
      Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
11 :: Word8)
    ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed ->
      Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
12 :: Word8)
    InsufficientForTransferDELEG MIRPot
pot Mismatch RelLTEQ Coin
m ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
13 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRPot -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR MIRPot
pot
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Mismatch RelLTEQ Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Mismatch RelLTEQ Coin
m
    ShelleyDelegPredFailure era
MIRProducesNegativeUpdate ->
      Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
14 :: Word8)
    MIRNegativeTransfer MIRPot
pot Coin
amt ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
15 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRPot -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR MIRPot
pot
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
amt

instance
  (Era era, Typeable (Script era)) =>
  DecCBOR (ShelleyDelegPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ShelleyDelegPredFailure era)
decCBOR = Text
-> (Word -> Decoder s (Int, ShelleyDelegPredFailure era))
-> Decoder s (ShelleyDelegPredFailure era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"ShelleyDelegPredFailure" ((Word -> Decoder s (Int, ShelleyDelegPredFailure era))
 -> Decoder s (ShelleyDelegPredFailure era))
-> (Word -> Decoder s (Int, ShelleyDelegPredFailure era))
-> Decoder s (ShelleyDelegPredFailure era)
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> do
        kh <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, StakeKeyAlreadyRegisteredDELEG kh)
      Word
1 -> do
        kh <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, StakeKeyNotRegisteredDELEG kh)
      Word
2 -> do
        b <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, StakeKeyNonZeroAccountBalanceDELEG b)
      Word
3 -> do
        kh <- Decoder s (Credential Staking)
forall s. Decoder s (Credential Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, StakeDelegationImpossibleDELEG kh)
      Word
4 -> do
        (Int, ShelleyDelegPredFailure era)
-> Decoder s (Int, ShelleyDelegPredFailure era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
WrongCertificateTypeDELEG)
      Word
5 -> do
        gkh <- Decoder s (KeyHash GenesisRole)
forall s. Decoder s (KeyHash GenesisRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, GenesisKeyNotInMappingDELEG gkh)
      Word
6 -> do
        kh <- Decoder s (KeyHash GenesisDelegate)
forall s. Decoder s (KeyHash GenesisDelegate)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, DuplicateGenesisDelegateDELEG kh)
      Word
7 -> do
        pot <- Decoder s MIRPot
forall s. Decoder s MIRPot
forall a s. DecCBOR a => Decoder s a
decCBOR
        m <- decCBOR
        pure (3, InsufficientForInstantaneousRewardsDELEG pot m)
      Word
8 -> do
        m <- Decoder s (Mismatch RelLT SlotNo)
forall s. Decoder s (Mismatch RelLT SlotNo)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, MIRCertificateTooLateinEpochDELEG m)
      Word
9 -> do
        vrf <- Decoder s (VRFVerKeyHash GenDelegVRF)
forall s. Decoder s (VRFVerKeyHash GenDelegVRF)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, DuplicateGenesisVRFDELEG vrf)
      Word
11 -> do
        (Int, ShelleyDelegPredFailure era)
-> Decoder s (Int, ShelleyDelegPredFailure era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed)
      Word
12 -> do
        (Int, ShelleyDelegPredFailure era)
-> Decoder s (Int, ShelleyDelegPredFailure era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed)
      Word
13 -> do
        pot <- Decoder s MIRPot
forall s. Decoder s MIRPot
forall a s. DecCBOR a => Decoder s a
decCBOR
        m <- decCBOR
        pure (3, InsufficientForTransferDELEG pot m)
      Word
14 -> do
        (Int, ShelleyDelegPredFailure era)
-> Decoder s (Int, ShelleyDelegPredFailure era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
MIRProducesNegativeUpdate)
      Word
15 -> do
        pot <- Decoder s MIRPot
forall s. Decoder s MIRPot
forall a s. DecCBOR a => Decoder s a
decCBOR
        amt <- decCBOR
        pure (3, MIRNegativeTransfer pot amt)
      Word
k -> Word -> Decoder s (Int, ShelleyDelegPredFailure era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k

delegationTransition ::
  ( EraCertState era
  , ShelleyEraAccounts era
  , ShelleyEraTxCert era
  , EraPParams era
  , AtMostEra "Babbage" era
  ) =>
  TransitionRule (ShelleyDELEG era)
delegationTransition :: forall era.
(EraCertState era, ShelleyEraAccounts era, ShelleyEraTxCert era,
 EraPParams era, AtMostEra "Babbage" era) =>
TransitionRule (ShelleyDELEG era)
delegationTransition = do
  TRC (DelegEnv slot epochNo ptr chainAccountState pp, certState, c) <- Rule
  (ShelleyDELEG era)
  'Transition
  (RuleContext 'Transition (ShelleyDELEG era))
F (Clause (ShelleyDELEG era) 'Transition) (TRC (ShelleyDELEG era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let pv = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
      ds = CertState era
State (ShelleyDELEG era)
certState 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
  case c of
    RegTxCert Credential Staking
cred -> do
      -- (hk ∉ dom (rewards ds))
      Bool -> Bool
not (Credential Staking -> Accounts era -> Bool
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Bool
isAccountRegistered Credential Staking
cred (DState era
ds DState era
-> Getting (Accounts era) (DState era) (Accounts era)
-> Accounts era
forall s a. s -> Getting a s a -> a
^. Getting (Accounts era) (DState era) (Accounts era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL)) Bool
-> PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential Staking -> ShelleyDelegPredFailure era
forall era. Credential Staking -> ShelleyDelegPredFailure era
StakeKeyAlreadyRegisteredDELEG Credential Staking
cred
      let compactDeposit :: CompactForm Coin
compactDeposit = HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError (PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL)
      CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ CertState era
State (ShelleyDELEG era)
certState CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
 -> CertState era -> Identity (CertState era))
-> (Accounts era -> Accounts era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Accounts era
-> Accounts era
forall era.
ShelleyEraAccounts era =>
Credential Staking
-> Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Accounts era
-> Accounts era
registerShelleyAccount Credential Staking
cred Ptr
ptr CompactForm Coin
compactDeposit Maybe (KeyHash StakePool)
forall a. Maybe a
Nothing
    UnRegTxCert Credential Staking
cred -> do
      let !(!Maybe (AccountState era)
mAccountState, !Accounts era
accounts) = Credential Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
forall era.
ShelleyEraAccounts era =>
Credential Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
unregisterShelleyAccount Credential Staking
cred (DState era
ds DState era
-> Getting (Accounts era) (DState era) (Accounts era)
-> Accounts era
forall s a. s -> Getting a s a -> a
^. Getting (Accounts era) (DState era) (Accounts era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL)
          checkStakeKeyHasZeroRewardBalance :: Maybe Coin
checkStakeKeyHasZeroRewardBalance = do
            accountState <- Maybe (AccountState era)
mAccountState
            let accountBalance = AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL
            guard (accountBalance /= mempty)
            Just $ fromCompact accountBalance
      Maybe Coin
-> (Coin -> PredicateFailure (ShelleyDELEG era))
-> Rule (ShelleyDELEG era) 'Transition ()
forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe Coin
checkStakeKeyHasZeroRewardBalance Coin -> PredicateFailure (ShelleyDELEG era)
Coin -> ShelleyDelegPredFailure era
forall era. Coin -> ShelleyDelegPredFailure era
StakeKeyNonZeroAccountBalanceDELEG
      -- (hk ∈ dom (rewards ds))
      case Maybe (AccountState era)
mAccountState of
        Maybe (AccountState era)
Nothing -> do
          PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (PredicateFailure (ShelleyDELEG era)
 -> Rule (ShelleyDELEG era) 'Transition ())
-> PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ Credential Staking -> ShelleyDelegPredFailure era
forall era. Credential Staking -> ShelleyDelegPredFailure era
StakeKeyNotRegisteredDELEG Credential Staking
cred
          CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CertState era
State (ShelleyDELEG era)
certState
        Just AccountState era
accountState ->
          CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
            CertState era
State (ShelleyDELEG era)
certState
              CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
 -> CertState era -> Identity (CertState era))
-> Accounts era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Accounts era
accounts
              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 -> PState era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
forall era.
EraAccounts era =>
Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
unDelegReDelegStakePool Credential Staking
cred AccountState era
accountState Maybe (KeyHash StakePool)
forall a. Maybe a
Nothing
    DelegStakeTxCert Credential Staking
cred KeyHash StakePool
stakePool -> do
      -- note that pattern match is used instead of cwitness and dpool, as in the spec
      -- (hk ∈ dom (rewards ds))
      case Credential Staking
-> Accounts era -> Maybe (Credential Staking, AccountState era)
forall era.
EraAccounts era =>
Credential Staking
-> Accounts era -> Maybe (Credential Staking, AccountState era)
lookupAccountStateIntern Credential Staking
cred (DState era
ds DState era
-> Getting (Accounts era) (DState era) (Accounts era)
-> Accounts era
forall s a. s -> Getting a s a -> a
^. Getting (Accounts era) (DState era) (Accounts era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL) of
        Maybe (Credential Staking, AccountState era)
Nothing -> do
          PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (PredicateFailure (ShelleyDELEG era)
 -> Rule (ShelleyDELEG era) 'Transition ())
-> PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ Credential Staking -> ShelleyDelegPredFailure era
forall era. Credential Staking -> ShelleyDelegPredFailure era
StakeDelegationImpossibleDELEG Credential Staking
cred
          CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CertState era
State (ShelleyDELEG era)
certState
        Just (Credential Staking
internedCred, AccountState era
accountState) ->
          CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
            CertState era
State (ShelleyDELEG era)
certState
              CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
 -> CertState era -> Identity (CertState era))
-> (Accounts era -> Accounts era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AccountState era -> AccountState era)
-> Credential Staking -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
(AccountState era -> AccountState era)
-> Credential Staking -> Accounts era -> Accounts era
adjustAccountState ((Maybe (KeyHash StakePool) -> Identity (Maybe (KeyHash StakePool)))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash StakePool))
Lens' (AccountState era) (Maybe (KeyHash StakePool))
stakePoolDelegationAccountStateL ((Maybe (KeyHash StakePool)
  -> Identity (Maybe (KeyHash StakePool)))
 -> AccountState era -> Identity (AccountState era))
-> KeyHash StakePool -> AccountState era -> AccountState era
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ KeyHash StakePool
stakePool) Credential Staking
cred
              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 -> PState era) -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
forall era.
EraAccounts era =>
Credential Staking
-> AccountState era
-> Maybe (KeyHash StakePool)
-> PState era
-> PState era
unDelegReDelegStakePool Credential Staking
internedCred AccountState era
accountState (KeyHash StakePool -> Maybe (KeyHash StakePool)
forall a. a -> Maybe a
Just KeyHash StakePool
stakePool)
    GenesisDelegTxCert KeyHash GenesisRole
gkh KeyHash GenesisDelegate
vkh VRFVerKeyHash GenDelegVRF
vrf -> do
      sp <- BaseM (ShelleyDELEG era) Word64
-> Rule (ShelleyDELEG era) 'Transition Word64
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (ShelleyDELEG era) Word64
 -> Rule (ShelleyDELEG era) 'Transition Word64)
-> BaseM (ShelleyDELEG era) Word64
-> Rule (ShelleyDELEG era) 'Transition Word64
forall a b. (a -> b) -> a -> b
$ (Globals -> Word64) -> ReaderT Globals Identity Word64
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Word64
stabilityWindow
      -- note that pattern match is used instead of genesisDeleg, as in the spec
      let s' = SlotNo
slot SlotNo -> Duration -> SlotNo
+* Word64 -> Duration
Duration Word64
sp
          GenDelegs genDelegs = dsGenDelegs ds

      -- gkh ∈ dom genDelegs ?! GenesisKeyNotInMappingDELEG gkh
      isJust (Map.lookup gkh genDelegs) ?! GenesisKeyNotInMappingDELEG gkh

      let cod = Map (KeyHash GenesisRole) GenDelegPair -> Set GenDelegPair
forall v k. Ord v => Map k v -> Set v
forall (f :: * -> * -> *) v k. (Basic f, Ord v) => f k v -> Set v
range (Map (KeyHash GenesisRole) GenDelegPair -> Set GenDelegPair)
-> Map (KeyHash GenesisRole) GenDelegPair -> Set GenDelegPair
forall a b. (a -> b) -> a -> b
$ KeyHash GenesisRole
-> Map (KeyHash GenesisRole) GenDelegPair
-> Map (KeyHash GenesisRole) GenDelegPair
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete KeyHash GenesisRole
gkh Map (KeyHash GenesisRole) GenDelegPair
genDelegs
          fod =
            Map FutureGenDeleg GenDelegPair -> Set GenDelegPair
forall v k. Ord v => Map k v -> Set v
forall (f :: * -> * -> *) v k. (Basic f, Ord v) => f k v -> Set v
range (Map FutureGenDeleg GenDelegPair -> Set GenDelegPair)
-> Map FutureGenDeleg GenDelegPair -> Set GenDelegPair
forall a b. (a -> b) -> a -> b
$
              (FutureGenDeleg -> GenDelegPair -> Bool)
-> Map FutureGenDeleg GenDelegPair
-> Map FutureGenDeleg GenDelegPair
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\(FutureGenDeleg SlotNo
_ KeyHash GenesisRole
g) GenDelegPair
_ -> KeyHash GenesisRole
g KeyHash GenesisRole -> KeyHash GenesisRole -> Bool
forall a. Eq a => a -> a -> Bool
/= KeyHash GenesisRole
gkh) (DState era -> Map FutureGenDeleg GenDelegPair
forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs DState era
ds)
          currentOtherColdKeyHashes = (GenDelegPair -> KeyHash GenesisDelegate)
-> Set GenDelegPair -> Set (KeyHash GenesisDelegate)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map GenDelegPair -> KeyHash GenesisDelegate
genDelegKeyHash Set GenDelegPair
cod
          currentOtherVrfKeyHashes = (GenDelegPair -> VRFVerKeyHash GenDelegVRF)
-> Set GenDelegPair -> Set (VRFVerKeyHash GenDelegVRF)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map GenDelegPair -> VRFVerKeyHash GenDelegVRF
genDelegVrfHash Set GenDelegPair
cod
          futureOtherColdKeyHashes = (GenDelegPair -> KeyHash GenesisDelegate)
-> Set GenDelegPair -> Set (KeyHash GenesisDelegate)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map GenDelegPair -> KeyHash GenesisDelegate
genDelegKeyHash Set GenDelegPair
fod
          futureOtherVrfKeyHashes = (GenDelegPair -> VRFVerKeyHash GenDelegVRF)
-> Set GenDelegPair -> Set (VRFVerKeyHash GenDelegVRF)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map GenDelegPair -> VRFVerKeyHash GenDelegVRF
genDelegVrfHash Set GenDelegPair
fod

      eval (vkh ∉ (currentOtherColdKeyHashes ∪ futureOtherColdKeyHashes))
        ?! DuplicateGenesisDelegateDELEG vkh
      eval (vrf ∉ (currentOtherVrfKeyHashes ∪ futureOtherVrfKeyHashes))
        ?! DuplicateGenesisVRFDELEG vrf

      pure $
        certState
          & certDStateL . dsFutureGenDelegsL
            .~ eval (dsFutureGenDelegs ds ⨃ singleton (FutureGenDeleg s' gkh) (GenDelegPair vkh vrf))
    RegPoolTxCert StakePoolParams
_ -> do
      PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause PredicateFailure (ShelleyDELEG era)
ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
WrongCertificateTypeDELEG -- this always fails
      CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CertState era
State (ShelleyDELEG era)
certState
    Signal (ShelleyDELEG era)
_ | Just (MIRCert MIRPot
targetPot MIRTarget
mirTarget) <- TxCert era -> Maybe MIRCert
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era) =>
TxCert era -> Maybe MIRCert
getMirTxCert TxCert era
Signal (ShelleyDELEG era)
c -> do
      SlotNo -> EpochNo -> Rule (ShelleyDELEG era) 'Transition ()
forall era.
(EraCertState era, ShelleyEraAccounts era, ShelleyEraTxCert era,
 EraPParams era, AtMostEra "Babbage" era) =>
SlotNo -> EpochNo -> Rule (ShelleyDELEG era) 'Transition ()
checkSlotNotTooLate SlotNo
slot EpochNo
epochNo
      case MIRTarget
mirTarget of
        StakeAddressesMIR Map (Credential Staking) DeltaCoin
credCoinMap -> do
          let (Coin
potAmount, DeltaCoin
delta, Map (Credential Staking) Coin
instantaneousRewards) =
                case MIRPot
targetPot of
                  MIRPot
ReservesMIR ->
                    ( ChainAccountState -> Coin
casReserves ChainAccountState
chainAccountState
                    , InstantaneousRewards -> DeltaCoin
deltaReserves (InstantaneousRewards -> DeltaCoin)
-> InstantaneousRewards -> DeltaCoin
forall a b. (a -> b) -> a -> b
$ DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds
                    , InstantaneousRewards -> Map (Credential Staking) Coin
iRReserves (InstantaneousRewards -> Map (Credential Staking) Coin)
-> InstantaneousRewards -> Map (Credential Staking) Coin
forall a b. (a -> b) -> a -> b
$ DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds
                    )
                  MIRPot
TreasuryMIR ->
                    ( ChainAccountState -> Coin
casTreasury ChainAccountState
chainAccountState
                    , InstantaneousRewards -> DeltaCoin
deltaTreasury (InstantaneousRewards -> DeltaCoin)
-> InstantaneousRewards -> DeltaCoin
forall a b. (a -> b) -> a -> b
$ DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds
                    , InstantaneousRewards -> Map (Credential Staking) Coin
iRTreasury (InstantaneousRewards -> Map (Credential Staking) Coin)
-> InstantaneousRewards -> Map (Credential Staking) Coin
forall a b. (a -> b) -> a -> b
$ DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds
                    )
          let credCoinMap' :: Map (Credential Staking) Coin
credCoinMap' = (DeltaCoin -> Coin)
-> Map (Credential Staking) DeltaCoin
-> Map (Credential Staking) Coin
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(DeltaCoin Integer
x) -> Integer -> Coin
Coin Integer
x) Map (Credential Staking) DeltaCoin
credCoinMap
          (combinedMap, available) <-
            if ProtVer -> Bool
hardforkAlonzoAllowMIRTransfer ProtVer
pv
              then do
                let cm :: Map (Credential Staking) Coin
cm = (Coin -> Coin -> Coin)
-> Map (Credential Staking) Coin
-> Map (Credential Staking) Coin
-> Map (Credential Staking) Coin
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Map (Credential Staking) Coin
credCoinMap' Map (Credential Staking) Coin
instantaneousRewards
                (Coin -> Bool) -> Map (Credential Staking) Coin -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
forall a. Monoid a => a
mempty) Map (Credential Staking) Coin
cm Bool
-> PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure (ShelleyDELEG era)
ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
MIRProducesNegativeUpdate
                (Map (Credential Staking) Coin, Coin)
-> F (Clause (ShelleyDELEG era) 'Transition)
     (Map (Credential Staking) Coin, Coin)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (Credential Staking) Coin
cm, Coin
potAmount Coin -> DeltaCoin -> Coin
`addDeltaCoin` DeltaCoin
delta)
              else do
                (DeltaCoin -> Bool) -> Map (Credential Staking) DeltaCoin -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (DeltaCoin -> DeltaCoin -> Bool
forall a. Ord a => a -> a -> Bool
>= DeltaCoin
forall a. Monoid a => a
mempty) Map (Credential Staking) DeltaCoin
credCoinMap Bool
-> PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure (ShelleyDELEG era)
ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
MIRNegativesNotCurrentlyAllowed
                (Map (Credential Staking) Coin, Coin)
-> F (Clause (ShelleyDELEG era) 'Transition)
     (Map (Credential Staking) Coin, Coin)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (Credential Staking) Coin
-> Map (Credential Staking) Coin -> Map (Credential Staking) Coin
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (Credential Staking) Coin
credCoinMap' Map (Credential Staking) Coin
instantaneousRewards, Coin
potAmount)
          updateReservesAndTreasury targetPot combinedMap available certState
        SendToOppositePotMIR Coin
coin ->
          if ProtVer -> Bool
hardforkAlonzoAllowMIRTransfer ProtVer
pv
            then do
              let available :: Coin
available = MIRPot -> ChainAccountState -> InstantaneousRewards -> Coin
availableAfterMIR MIRPot
targetPot ChainAccountState
chainAccountState (DState era -> InstantaneousRewards
forall era. DState era -> InstantaneousRewards
dsIRewards DState era
ds)
              Coin
coin Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
forall a. Monoid a => a
mempty Bool
-> PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! MIRPot -> Coin -> ShelleyDelegPredFailure era
forall era. MIRPot -> Coin -> ShelleyDelegPredFailure era
MIRNegativeTransfer MIRPot
targetPot Coin
coin
              Coin
coin Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
available Bool
-> PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! MIRPot -> Mismatch RelLTEQ Coin -> ShelleyDelegPredFailure era
forall era.
MIRPot -> Mismatch RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForTransferDELEG MIRPot
targetPot (Coin -> Coin -> Mismatch RelLTEQ Coin
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch Coin
coin Coin
available)
              case MIRPot
targetPot of
                MIRPot
ReservesMIR ->
                  CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
                    CertState era
State (ShelleyDELEG era)
certState
                      CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
-> ((DeltaCoin -> Identity DeltaCoin)
    -> DState era -> Identity (DState era))
-> (DeltaCoin -> Identity DeltaCoin)
-> 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)
 -> DState era -> Identity (DState era))
-> ((DeltaCoin -> Identity DeltaCoin)
    -> InstantaneousRewards -> Identity InstantaneousRewards)
-> (DeltaCoin -> Identity DeltaCoin)
-> DState era
-> Identity (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeltaCoin -> Identity DeltaCoin)
-> InstantaneousRewards -> Identity InstantaneousRewards
Lens' InstantaneousRewards DeltaCoin
iRDeltaReservesL ((DeltaCoin -> Identity DeltaCoin)
 -> CertState era -> Identity (CertState era))
-> DeltaCoin -> CertState era -> CertState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert (Coin -> DeltaCoin
toDeltaCoin Coin
coin)
                      CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
-> ((DeltaCoin -> Identity DeltaCoin)
    -> DState era -> Identity (DState era))
-> (DeltaCoin -> Identity DeltaCoin)
-> 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)
 -> DState era -> Identity (DState era))
-> ((DeltaCoin -> Identity DeltaCoin)
    -> InstantaneousRewards -> Identity InstantaneousRewards)
-> (DeltaCoin -> Identity DeltaCoin)
-> DState era
-> Identity (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeltaCoin -> Identity DeltaCoin)
-> InstantaneousRewards -> Identity InstantaneousRewards
Lens' InstantaneousRewards DeltaCoin
iRDeltaTreasuryL ((DeltaCoin -> Identity DeltaCoin)
 -> CertState era -> Identity (CertState era))
-> DeltaCoin -> CertState era -> CertState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Coin -> DeltaCoin
toDeltaCoin Coin
coin
                MIRPot
TreasuryMIR ->
                  CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
                    CertState era
State (ShelleyDELEG era)
certState
                      CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
-> ((DeltaCoin -> Identity DeltaCoin)
    -> DState era -> Identity (DState era))
-> (DeltaCoin -> Identity DeltaCoin)
-> 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)
 -> DState era -> Identity (DState era))
-> ((DeltaCoin -> Identity DeltaCoin)
    -> InstantaneousRewards -> Identity InstantaneousRewards)
-> (DeltaCoin -> Identity DeltaCoin)
-> DState era
-> Identity (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeltaCoin -> Identity DeltaCoin)
-> InstantaneousRewards -> Identity InstantaneousRewards
Lens' InstantaneousRewards DeltaCoin
iRDeltaReservesL ((DeltaCoin -> Identity DeltaCoin)
 -> CertState era -> Identity (CertState era))
-> DeltaCoin -> CertState era -> CertState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Coin -> DeltaCoin
toDeltaCoin Coin
coin
                      CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
-> ((DeltaCoin -> Identity DeltaCoin)
    -> DState era -> Identity (DState era))
-> (DeltaCoin -> Identity DeltaCoin)
-> 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)
 -> DState era -> Identity (DState era))
-> ((DeltaCoin -> Identity DeltaCoin)
    -> InstantaneousRewards -> Identity InstantaneousRewards)
-> (DeltaCoin -> Identity DeltaCoin)
-> DState era
-> Identity (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeltaCoin -> Identity DeltaCoin)
-> InstantaneousRewards -> Identity InstantaneousRewards
Lens' InstantaneousRewards DeltaCoin
iRDeltaTreasuryL ((DeltaCoin -> Identity DeltaCoin)
 -> CertState era -> Identity (CertState era))
-> DeltaCoin -> CertState era -> CertState era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ DeltaCoin -> DeltaCoin
forall m. Group m => m -> m
invert (Coin -> DeltaCoin
toDeltaCoin Coin
coin)
            else do
              PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause PredicateFailure (ShelleyDELEG era)
ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
MIRTransferNotCurrentlyAllowed
              CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CertState era
State (ShelleyDELEG era)
certState
    Signal (ShelleyDELEG era)
_ -> do
      -- The impossible case
      PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause PredicateFailure (ShelleyDELEG era)
ShelleyDelegPredFailure era
forall era. ShelleyDelegPredFailure era
WrongCertificateTypeDELEG -- this always fails
      CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CertState era
State (ShelleyDELEG era)
certState

checkSlotNotTooLate ::
  ( EraCertState era
  , ShelleyEraAccounts era
  , ShelleyEraTxCert era
  , EraPParams era
  , AtMostEra "Babbage" era
  ) =>
  SlotNo ->
  EpochNo ->
  Rule (ShelleyDELEG era) 'Transition ()
checkSlotNotTooLate :: forall era.
(EraCertState era, ShelleyEraAccounts era, ShelleyEraTxCert era,
 EraPParams era, AtMostEra "Babbage" era) =>
SlotNo -> EpochNo -> Rule (ShelleyDELEG era) 'Transition ()
checkSlotNotTooLate SlotNo
slot EpochNo
curEpochNo = do
  sp <- BaseM (ShelleyDELEG era) Word64
-> Rule (ShelleyDELEG era) 'Transition Word64
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (ShelleyDELEG era) Word64
 -> Rule (ShelleyDELEG era) 'Transition Word64)
-> BaseM (ShelleyDELEG era) Word64
-> Rule (ShelleyDELEG era) 'Transition Word64
forall a b. (a -> b) -> a -> b
$ (Globals -> Word64) -> ReaderT Globals Identity Word64
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Word64
stabilityWindow
  ei <- liftSTS $ asks epochInfoPure
  let firstSlot = HasCallStack => EpochInfo Identity -> EpochNo -> SlotNo
EpochInfo Identity -> EpochNo -> SlotNo
epochInfoFirst EpochInfo Identity
ei EpochNo
newEpoch
      tooLate = SlotNo
firstSlot SlotNo -> Duration -> SlotNo
*- Word64 -> Duration
Duration Word64
sp
      newEpoch = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
1)
  tellEvent (DelegNewEpoch newEpoch)
  slot < tooLate ?! MIRCertificateTooLateinEpochDELEG (Mismatch slot tooLate)

updateReservesAndTreasury ::
  EraCertState era =>
  MIRPot ->
  Map.Map (Credential Staking) Coin ->
  Coin ->
  CertState era ->
  Rule (ShelleyDELEG era) 'Transition (CertState era)
updateReservesAndTreasury :: forall era.
EraCertState era =>
MIRPot
-> Map (Credential Staking) Coin
-> Coin
-> CertState era
-> Rule (ShelleyDELEG era) 'Transition (CertState era)
updateReservesAndTreasury MIRPot
targetPot Map (Credential Staking) Coin
combinedMap Coin
available CertState era
certState = do
  let requiredForRewards :: Coin
requiredForRewards = 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
combinedMap
  Coin
requiredForRewards
    Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
available
      Bool
-> PredicateFailure (ShelleyDELEG era)
-> Rule (ShelleyDELEG era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! MIRPot -> Mismatch RelLTEQ Coin -> ShelleyDelegPredFailure era
forall era.
MIRPot -> Mismatch RelLTEQ Coin -> ShelleyDelegPredFailure era
InsufficientForInstantaneousRewardsDELEG
        MIRPot
targetPot
        Mismatch
          { mismatchSupplied :: Coin
mismatchSupplied = Coin
requiredForRewards
          , mismatchExpected :: Coin
mismatchExpected = Coin
available
          }
  CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a. a -> F (Clause (ShelleyDELEG era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ShelleyDELEG era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ShelleyDELEG era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
    case MIRPot
targetPot of
      MIRPot
ReservesMIR -> CertState era
certState CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
-> ((Map (Credential Staking) Coin
     -> Identity (Map (Credential Staking) Coin))
    -> DState era -> Identity (DState era))
-> (Map (Credential Staking) Coin
    -> Identity (Map (Credential Staking) Coin))
-> 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)
 -> DState era -> Identity (DState era))
-> ((Map (Credential Staking) Coin
     -> Identity (Map (Credential Staking) Coin))
    -> InstantaneousRewards -> Identity InstantaneousRewards)
-> (Map (Credential Staking) Coin
    -> Identity (Map (Credential Staking) Coin))
-> DState era
-> Identity (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential Staking) Coin
 -> Identity (Map (Credential Staking) Coin))
-> InstantaneousRewards -> Identity InstantaneousRewards
Lens' InstantaneousRewards (Map (Credential Staking) Coin)
iRReservesL ((Map (Credential Staking) Coin
  -> Identity (Map (Credential Staking) Coin))
 -> CertState era -> Identity (CertState era))
-> Map (Credential Staking) Coin -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Credential Staking) Coin
combinedMap
      MIRPot
TreasuryMIR -> CertState era
certState CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (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))
-> ((Map (Credential Staking) Coin
     -> Identity (Map (Credential Staking) Coin))
    -> DState era -> Identity (DState era))
-> (Map (Credential Staking) Coin
    -> Identity (Map (Credential Staking) Coin))
-> 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)
 -> DState era -> Identity (DState era))
-> ((Map (Credential Staking) Coin
     -> Identity (Map (Credential Staking) Coin))
    -> InstantaneousRewards -> Identity InstantaneousRewards)
-> (Map (Credential Staking) Coin
    -> Identity (Map (Credential Staking) Coin))
-> DState era
-> Identity (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential Staking) Coin
 -> Identity (Map (Credential Staking) Coin))
-> InstantaneousRewards -> Identity InstantaneousRewards
Lens' InstantaneousRewards (Map (Credential Staking) Coin)
iRTreasuryL ((Map (Credential Staking) Coin
  -> Identity (Map (Credential Staking) Coin))
 -> CertState era -> Identity (CertState era))
-> Map (Credential Staking) Coin -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Credential Staking) Coin
combinedMap