{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Rules.Rupd (
  ShelleyRUPD,
  RupdEnv (..),
  PredicateFailure,
  ShelleyRupdPredFailure,
  epochInfoRange,
  PulsingRewUpdate (..),
  startStep,
  pulseStep,
  completeStep,
  lift,
  Identity (..),
  RupdEvent (..),
) where

import Cardano.Ledger.BaseTypes (
  BlocksMade,
  ShelleyBase,
  StrictMaybe (..),
  activeSlotCoeff,
  epochInfoPure,
  maxLovelaceSupply,
  randomnessStabilisationWindow,
  securityParameter,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Shelley.Era (ShelleyRUPD)
import Cardano.Ledger.Shelley.Governance (EraGov)
import Cardano.Ledger.Shelley.LedgerState (
  EpochState,
  PulsingRewUpdate (..),
  completeStep,
  pulseStep,
  startStep,
 )
import Cardano.Ledger.Slot (
  Duration (..),
  EpochNo (..),
  SlotNo,
  epochInfoEpoch,
  epochInfoFirst,
  epochInfoSize,
  (+*),
 )
import Cardano.Ledger.State (EraCertState)
import Cardano.Slotting.EpochInfo.API (epochInfoRange)
import Control.DeepSeq (NFData)
import Control.Monad.Identity (Identity (..))
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition (
  Rule,
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  liftSTS,
  tellEvent,
 )
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

data RupdEnv era
  = RupdEnv BlocksMade (EpochState era)

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

instance NoThunks (ShelleyRupdPredFailure era)

instance NFData (ShelleyRupdPredFailure era)

instance
  ( Era era
  , EraGov era
  , EraCertState era
  ) =>
  STS (ShelleyRUPD era)
  where
  type State (ShelleyRUPD era) = StrictMaybe PulsingRewUpdate
  type Signal (ShelleyRUPD era) = SlotNo
  type Environment (ShelleyRUPD era) = RupdEnv era
  type BaseM (ShelleyRUPD era) = ShelleyBase
  type PredicateFailure (ShelleyRUPD era) = ShelleyRupdPredFailure era
  type Event (ShelleyRUPD era) = RupdEvent

  initialRules :: [InitialRule (ShelleyRUPD era)]
initialRules = [StrictMaybe PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Initial)
     (StrictMaybe PulsingRewUpdate)
forall a. a -> F (Clause (ShelleyRUPD era) 'Initial) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe PulsingRewUpdate
forall a. StrictMaybe a
SNothing]
  transitionRules :: [TransitionRule (ShelleyRUPD era)]
transitionRules = [TransitionRule (ShelleyRUPD era)
forall era.
(EraGov era, EraCertState era) =>
TransitionRule (ShelleyRUPD era)
rupdTransition]

data RupdEvent
  = RupdEvent
      !EpochNo
      !(Map.Map (Credential 'Staking) (Set Reward))
  deriving ((forall x. RupdEvent -> Rep RupdEvent x)
-> (forall x. Rep RupdEvent x -> RupdEvent) -> Generic RupdEvent
forall x. Rep RupdEvent x -> RupdEvent
forall x. RupdEvent -> Rep RupdEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RupdEvent -> Rep RupdEvent x
from :: forall x. RupdEvent -> Rep RupdEvent x
$cto :: forall x. Rep RupdEvent x -> RupdEvent
to :: forall x. Rep RupdEvent x -> RupdEvent
Generic, RupdEvent -> RupdEvent -> Bool
(RupdEvent -> RupdEvent -> Bool)
-> (RupdEvent -> RupdEvent -> Bool) -> Eq RupdEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RupdEvent -> RupdEvent -> Bool
== :: RupdEvent -> RupdEvent -> Bool
$c/= :: RupdEvent -> RupdEvent -> Bool
/= :: RupdEvent -> RupdEvent -> Bool
Eq)

instance NFData RupdEvent

-- | tell a RupdEvent only if the map is non-empty
tellRupd :: String -> RupdEvent -> Rule (ShelleyRUPD era) rtype ()
tellRupd :: forall era (rtype :: RuleType).
String -> RupdEvent -> Rule (ShelleyRUPD era) rtype ()
tellRupd String
_ (RupdEvent EpochNo
_ Map (Credential 'Staking) (Set Reward)
m) | Map (Credential 'Staking) (Set Reward) -> Bool
forall k a. Map k a -> Bool
Map.null Map (Credential 'Staking) (Set Reward)
m = () -> F (Clause (ShelleyRUPD era) rtype) ()
forall a. a -> F (Clause (ShelleyRUPD era) rtype) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
tellRupd String
_message RupdEvent
x = Event (ShelleyRUPD era) -> F (Clause (ShelleyRUPD era) rtype) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent Event (ShelleyRUPD era)
RupdEvent
x

-- | The Goldilocks labeling of when to do the reward calculation.
data RewardTiming = RewardsTooEarly | RewardsJustRight | RewardsTooLate

determineRewardTiming :: SlotNo -> SlotNo -> SlotNo -> RewardTiming
determineRewardTiming :: SlotNo -> SlotNo -> SlotNo -> RewardTiming
determineRewardTiming SlotNo
currentSlot SlotNo
startAfterSlot SlotNo
endSlot
  | SlotNo
currentSlot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
> SlotNo
endSlot = RewardTiming
RewardsTooLate
  | SlotNo
currentSlot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
startAfterSlot = RewardTiming
RewardsTooEarly
  | Bool
otherwise = RewardTiming
RewardsJustRight

rupdTransition :: (EraGov era, EraCertState era) => TransitionRule (ShelleyRUPD era)
rupdTransition :: forall era.
(EraGov era, EraCertState era) =>
TransitionRule (ShelleyRUPD era)
rupdTransition = do
  TRC (RupdEnv BlocksMade
b EpochState era
es, State (ShelleyRUPD era)
ru, Signal (ShelleyRUPD era)
s) <- Rule
  (ShelleyRUPD era)
  'Transition
  (RuleContext 'Transition (ShelleyRUPD era))
F (Clause (ShelleyRUPD era) 'Transition) (TRC (ShelleyRUPD era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  (EpochSize
slotsPerEpoch, SlotNo
slot, SlotNo
slotForce, Word64
maxLL, ActiveSlotCoeff
asc, NonZero Word64
k, EpochNo
e) <- BaseM
  (ShelleyRUPD era)
  (EpochSize, SlotNo, SlotNo, Word64, ActiveSlotCoeff,
   NonZero Word64, EpochNo)
-> Rule
     (ShelleyRUPD era)
     'Transition
     (EpochSize, SlotNo, SlotNo, Word64, ActiveSlotCoeff,
      NonZero Word64, EpochNo)
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM
   (ShelleyRUPD era)
   (EpochSize, SlotNo, SlotNo, Word64, ActiveSlotCoeff,
    NonZero Word64, EpochNo)
 -> Rule
      (ShelleyRUPD era)
      'Transition
      (EpochSize, SlotNo, SlotNo, Word64, ActiveSlotCoeff,
       NonZero Word64, EpochNo))
-> BaseM
     (ShelleyRUPD era)
     (EpochSize, SlotNo, SlotNo, Word64, ActiveSlotCoeff,
      NonZero Word64, EpochNo)
-> Rule
     (ShelleyRUPD era)
     'Transition
     (EpochSize, SlotNo, SlotNo, Word64, ActiveSlotCoeff,
      NonZero Word64, EpochNo)
forall a b. (a -> b) -> a -> b
$ do
    EpochInfo Identity
ei <- (Globals -> EpochInfo Identity)
-> ReaderT Globals Identity (EpochInfo Identity)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> EpochInfo Identity
epochInfoPure
    Word64
sr <- (Globals -> Word64) -> ReaderT Globals Identity Word64
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Word64
randomnessStabilisationWindow
    let e :: EpochNo
e = HasCallStack => EpochInfo Identity -> SlotNo -> EpochNo
EpochInfo Identity -> SlotNo -> EpochNo
epochInfoEpoch EpochInfo Identity
ei SlotNo
Signal (ShelleyRUPD era)
s
        slotsPerEpoch :: EpochSize
slotsPerEpoch = HasCallStack => EpochInfo Identity -> EpochNo -> EpochSize
EpochInfo Identity -> EpochNo -> EpochSize
epochInfoSize EpochInfo Identity
ei EpochNo
e
        slot :: SlotNo
slot = HasCallStack => EpochInfo Identity -> EpochNo -> SlotNo
EpochInfo Identity -> EpochNo -> SlotNo
epochInfoFirst EpochInfo Identity
ei EpochNo
e SlotNo -> Duration -> SlotNo
+* Word64 -> Duration
Duration Word64
sr
    Word64
maxLL <- (Globals -> Word64) -> ReaderT Globals Identity Word64
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Word64
maxLovelaceSupply
    ActiveSlotCoeff
asc <- (Globals -> ActiveSlotCoeff)
-> ReaderT Globals Identity ActiveSlotCoeff
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> ActiveSlotCoeff
activeSlotCoeff
    NonZero Word64
k <- (Globals -> NonZero Word64)
-> ReaderT Globals Identity (NonZero Word64)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> NonZero Word64
securityParameter -- Maximum number of blocks we are allowed to roll back
    (EpochSize, SlotNo, SlotNo, Word64, ActiveSlotCoeff,
 NonZero Word64, EpochNo)
-> ReaderT
     Globals
     Identity
     (EpochSize, SlotNo, SlotNo, Word64, ActiveSlotCoeff,
      NonZero Word64, EpochNo)
forall a. a -> ReaderT Globals Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpochSize
slotsPerEpoch, SlotNo
slot, SlotNo
slot SlotNo -> Duration -> SlotNo
+* Word64 -> Duration
Duration Word64
sr, Word64
maxLL, ActiveSlotCoeff
asc, NonZero Word64
k, EpochNo
e)
  let maxsupply :: Coin
maxsupply = Integer -> Coin
Coin (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
maxLL)
  case SlotNo -> SlotNo -> SlotNo -> RewardTiming
determineRewardTiming SlotNo
Signal (ShelleyRUPD era)
s SlotNo
slot SlotNo
slotForce of
    -- Waiting for the stability point, do nothing, keep waiting
    RewardTiming
RewardsTooEarly -> StrictMaybe PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Transition)
     (StrictMaybe PulsingRewUpdate)
forall a. a -> F (Clause (ShelleyRUPD era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe PulsingRewUpdate
forall a. StrictMaybe a
SNothing
    -- More blocks to come, get things started or take a step
    RewardTiming
RewardsJustRight ->
      case State (ShelleyRUPD era)
ru of
        StrictMaybe PulsingRewUpdate
State (ShelleyRUPD era)
SNothing ->
          -- This is the first opportunity to pulse, so start pulsing.
          -- SJust <$> tellLeaderEvents (e + 1) (fst (startStep slotsPerEpoch b es maxsupply asc k))
          (StrictMaybe PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Transition)
     (StrictMaybe PulsingRewUpdate)
forall a. a -> F (Clause (ShelleyRUPD era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictMaybe PulsingRewUpdate
 -> F (Clause (ShelleyRUPD era) 'Transition)
      (StrictMaybe PulsingRewUpdate))
-> (PulsingRewUpdate -> StrictMaybe PulsingRewUpdate)
-> PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Transition)
     (StrictMaybe PulsingRewUpdate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PulsingRewUpdate -> StrictMaybe PulsingRewUpdate
forall a. a -> StrictMaybe a
SJust) (EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> PulsingRewUpdate
startStep EpochSize
slotsPerEpoch BlocksMade
b EpochState era
es Coin
maxsupply ActiveSlotCoeff
asc NonZero Word64
k)
        (SJust p :: PulsingRewUpdate
p@(Pulsing RewardSnapShot
_ Pulser
_)) -> do
          -- We began pulsing earlier, so run another pulse
          (PulsingRewUpdate
ans, Map (Credential 'Staking) (Set Reward)
event) <- BaseM
  (ShelleyRUPD era)
  (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> Rule
     (ShelleyRUPD era)
     'Transition
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM
   (ShelleyRUPD era)
   (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
 -> Rule
      (ShelleyRUPD era)
      'Transition
      (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> BaseM
     (ShelleyRUPD era)
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> Rule
     (ShelleyRUPD era)
     'Transition
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall a b. (a -> b) -> a -> b
$ PulsingRewUpdate
-> ShelleyBase
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
pulseStep PulsingRewUpdate
p
          String -> RupdEvent -> Rule (ShelleyRUPD era) 'Transition ()
forall era (rtype :: RuleType).
String -> RupdEvent -> Rule (ShelleyRUPD era) rtype ()
tellRupd String
"Pulsing Rupd" (EpochNo -> Map (Credential 'Staking) (Set Reward) -> RupdEvent
RupdEvent (EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
e) Map (Credential 'Staking) (Set Reward)
event)
          StrictMaybe PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Transition)
     (StrictMaybe PulsingRewUpdate)
forall a. a -> F (Clause (ShelleyRUPD era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PulsingRewUpdate -> StrictMaybe PulsingRewUpdate
forall a. a -> StrictMaybe a
SJust PulsingRewUpdate
ans)
        (SJust p :: PulsingRewUpdate
p@(Complete RewardUpdate
_)) -> StrictMaybe PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Transition)
     (StrictMaybe PulsingRewUpdate)
forall a. a -> F (Clause (ShelleyRUPD era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PulsingRewUpdate -> StrictMaybe PulsingRewUpdate
forall a. a -> StrictMaybe a
SJust PulsingRewUpdate
p)
    -- Time to force the completion of the pulser so that downstream tools such as db-sync
    -- have time to see the reward update before the epoch boundary rollover.
    RewardTiming
RewardsTooLate ->
      case State (ShelleyRUPD era)
ru of
        StrictMaybe PulsingRewUpdate
State (ShelleyRUPD era)
SNothing -> do
          -- Nothing has been done, so start, and then complete the pulser. We hope this is very rare.
          let pulser :: PulsingRewUpdate
pulser = EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> PulsingRewUpdate
forall era.
(EraGov era, EraCertState era) =>
EpochSize
-> BlocksMade
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> NonZero Word64
-> PulsingRewUpdate
startStep EpochSize
slotsPerEpoch BlocksMade
b EpochState era
es Coin
maxsupply ActiveSlotCoeff
asc NonZero Word64
k
          (PulsingRewUpdate
reward, Map (Credential 'Staking) (Set Reward)
event) <- BaseM
  (ShelleyRUPD era)
  (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> Rule
     (ShelleyRUPD era)
     'Transition
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM
   (ShelleyRUPD era)
   (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
 -> Rule
      (ShelleyRUPD era)
      'Transition
      (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> BaseM
     (ShelleyRUPD era)
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> Rule
     (ShelleyRUPD era)
     'Transition
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall a b. (a -> b) -> a -> b
$ PulsingRewUpdate
-> ShelleyBase
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
completeStep PulsingRewUpdate
pulser
          String -> RupdEvent -> Rule (ShelleyRUPD era) 'Transition ()
forall era (rtype :: RuleType).
String -> RupdEvent -> Rule (ShelleyRUPD era) rtype ()
tellRupd String
"Starting too late" (EpochNo -> Map (Credential 'Staking) (Set Reward) -> RupdEvent
RupdEvent (EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
e) Map (Credential 'Staking) (Set Reward)
event)
          StrictMaybe PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Transition)
     (StrictMaybe PulsingRewUpdate)
forall a. a -> F (Clause (ShelleyRUPD era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PulsingRewUpdate -> StrictMaybe PulsingRewUpdate
forall a. a -> StrictMaybe a
SJust PulsingRewUpdate
reward)
        SJust p :: PulsingRewUpdate
p@(Pulsing RewardSnapShot
_ Pulser
_) -> do
          -- We have been pulsing, but we ran out of time, so complete the pulser.
          (PulsingRewUpdate
reward, Map (Credential 'Staking) (Set Reward)
event) <- BaseM
  (ShelleyRUPD era)
  (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> Rule
     (ShelleyRUPD era)
     'Transition
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM
   (ShelleyRUPD era)
   (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
 -> Rule
      (ShelleyRUPD era)
      'Transition
      (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward)))
-> BaseM
     (ShelleyRUPD era)
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
-> Rule
     (ShelleyRUPD era)
     'Transition
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
forall a b. (a -> b) -> a -> b
$ PulsingRewUpdate
-> ShelleyBase
     (PulsingRewUpdate, Map (Credential 'Staking) (Set Reward))
completeStep PulsingRewUpdate
p
          String -> RupdEvent -> Rule (ShelleyRUPD era) 'Transition ()
forall era (rtype :: RuleType).
String -> RupdEvent -> Rule (ShelleyRUPD era) rtype ()
tellRupd String
"Completing too late" (EpochNo -> Map (Credential 'Staking) (Set Reward) -> RupdEvent
RupdEvent (EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
e) Map (Credential 'Staking) (Set Reward)
event)
          StrictMaybe PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Transition)
     (StrictMaybe PulsingRewUpdate)
forall a. a -> F (Clause (ShelleyRUPD era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PulsingRewUpdate -> StrictMaybe PulsingRewUpdate
forall a. a -> StrictMaybe a
SJust PulsingRewUpdate
reward)
        complete :: State (ShelleyRUPD era)
complete@(SJust (Complete RewardUpdate
_)) -> StrictMaybe PulsingRewUpdate
-> F (Clause (ShelleyRUPD era) 'Transition)
     (StrictMaybe PulsingRewUpdate)
forall a. a -> F (Clause (ShelleyRUPD era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe PulsingRewUpdate
State (ShelleyRUPD era)
complete