{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Cardano.Api.Internal.LedgerEvents.Rule.TICK.NEWEPOCH
( LatestTickEventConstraints
, handleShelleyNEWEPOCHEvents
, handleLedgerTICKEvents
, handleConwayNEWEPOCHEvents
)
where
import Cardano.Api.Internal.Address (fromShelleyStakeCredential)
import Cardano.Api.Internal.LedgerEvents.LedgerEvent
import Cardano.Api.Internal.LedgerEvents.Rule.TICK.RUPD
import Cardano.Ledger.Conway.Rules (ConwayNewEpochEvent)
import Cardano.Ledger.Conway.Rules qualified as Conway
import Cardano.Ledger.Core qualified as Core
import Cardano.Ledger.Shelley.Rules
import Cardano.Ledger.Shelley.Rules qualified as Shelley
import Data.Map.Strict qualified as Map
type LatestTickEventConstraints ledgerera =
( Event (Core.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera
, Event (Core.EraRule "RUPD" ledgerera) ~ RupdEvent
, Event (Core.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera
, Event (Core.EraRule "EPOCH" ledgerera) ~ Shelley.ShelleyEpochEvent ledgerera
, Event (Core.EraRule "POOLREAP" ledgerera) ~ Shelley.ShelleyPoolreapEvent ledgerera
)
handleLedgerTICKEvents
:: LatestTickEventConstraints ledgerera
=> ShelleyTickEvent ledgerera -> Maybe LedgerEvent
handleLedgerTICKEvents :: forall ledgerera.
LatestTickEventConstraints ledgerera =>
ShelleyTickEvent ledgerera -> Maybe LedgerEvent
handleLedgerTICKEvents (TickNewEpochEvent Event (EraRule "NEWEPOCH" ledgerera)
newEpochEvent) = ShelleyNewEpochEvent ledgerera -> Maybe LedgerEvent
forall ledgerera.
(Event (EraRule "EPOCH" ledgerera) ~ ShelleyEpochEvent ledgerera,
Event (EraRule "POOLREAP" ledgerera)
~ ShelleyPoolreapEvent ledgerera) =>
ShelleyNewEpochEvent ledgerera -> Maybe LedgerEvent
handleShelleyNEWEPOCHEvents Event (EraRule "NEWEPOCH" ledgerera)
ShelleyNewEpochEvent ledgerera
newEpochEvent
handleLedgerTICKEvents (TickRupdEvent Event (EraRule "RUPD" ledgerera)
rewardUpdate) = RupdEvent -> Maybe LedgerEvent
handleLedgerRUPDEvents Event (EraRule "RUPD" ledgerera)
RupdEvent
rewardUpdate
handleShelleyNEWEPOCHEvents
:: Event (Core.EraRule "EPOCH" ledgerera) ~ ShelleyEpochEvent ledgerera
=> Event (Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera
=> ShelleyNewEpochEvent ledgerera -> Maybe LedgerEvent
handleShelleyNEWEPOCHEvents :: forall ledgerera.
(Event (EraRule "EPOCH" ledgerera) ~ ShelleyEpochEvent ledgerera,
Event (EraRule "POOLREAP" ledgerera)
~ ShelleyPoolreapEvent ledgerera) =>
ShelleyNewEpochEvent ledgerera -> Maybe LedgerEvent
handleShelleyNEWEPOCHEvents ShelleyNewEpochEvent ledgerera
shelleyNewEpochEvent =
case ShelleyNewEpochEvent ledgerera
shelleyNewEpochEvent of
Shelley.DeltaRewardEvent{} -> Maybe LedgerEvent
forall a. Maybe a
Nothing
Shelley.RestrainedRewards{} -> Maybe LedgerEvent
forall a. Maybe a
Nothing
Shelley.TotalRewardEvent EpochNo
epochNo Map (Credential 'Staking) (Set Reward)
rewardsMap ->
LedgerEvent -> Maybe LedgerEvent
forall a. a -> Maybe a
Just (LedgerEvent -> Maybe LedgerEvent)
-> LedgerEvent -> Maybe LedgerEvent
forall a b. (a -> b) -> a -> b
$ EpochNo -> Map StakeCredential (Set Reward) -> LedgerEvent
RewardsDistribution EpochNo
epochNo ((Credential 'Staking -> StakeCredential)
-> Map (Credential 'Staking) (Set Reward)
-> Map StakeCredential (Set Reward)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Credential 'Staking -> StakeCredential
fromShelleyStakeCredential Map (Credential 'Staking) (Set Reward)
rewardsMap)
Shelley.EpochEvent Event (EraRule "EPOCH" ledgerera)
e -> ShelleyEpochEvent ledgerera -> Maybe LedgerEvent
forall ledgerera.
(Event (EraRule "POOLREAP" ledgerera)
~ ShelleyPoolreapEvent ledgerera) =>
ShelleyEpochEvent ledgerera -> Maybe LedgerEvent
handleEpochEvents Event (EraRule "EPOCH" ledgerera)
ShelleyEpochEvent ledgerera
e
Shelley.MirEvent{} -> Maybe LedgerEvent
forall a. Maybe a
Nothing
Shelley.TotalAdaPotsEvent{} -> Maybe LedgerEvent
forall a. Maybe a
Nothing
handleEpochEvents
:: Event (Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera
=> ShelleyEpochEvent ledgerera -> Maybe LedgerEvent
handleEpochEvents :: forall ledgerera.
(Event (EraRule "POOLREAP" ledgerera)
~ ShelleyPoolreapEvent ledgerera) =>
ShelleyEpochEvent ledgerera -> Maybe LedgerEvent
handleEpochEvents (PoolReapEvent Event (EraRule "POOLREAP" ledgerera)
e) =
case Event (EraRule "POOLREAP" ledgerera)
e of
RetiredPools{Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
refundPools :: Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
refundPools :: forall era.
ShelleyPoolreapEvent era
-> Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
refundPools, Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
unclaimedPools :: Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
unclaimedPools :: forall era.
ShelleyPoolreapEvent era
-> Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
unclaimedPools, EpochNo
epochNo :: EpochNo
epochNo :: forall era. ShelleyPoolreapEvent era -> EpochNo
epochNo} ->
LedgerEvent -> Maybe LedgerEvent
forall a. a -> Maybe a
Just (LedgerEvent -> Maybe LedgerEvent)
-> (PoolReapDetails -> LedgerEvent)
-> PoolReapDetails
-> Maybe LedgerEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolReapDetails -> LedgerEvent
PoolReap (PoolReapDetails -> Maybe LedgerEvent)
-> PoolReapDetails -> Maybe LedgerEvent
forall a b. (a -> b) -> a -> b
$
EpochNo
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
-> PoolReapDetails
PoolReapDetails
EpochNo
epochNo
(Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
refundPools)
(Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
unclaimedPools)
handleEpochEvents (SnapEvent{}) = Maybe LedgerEvent
forall a. Maybe a
Nothing
handleEpochEvents (UpecEvent{}) = Maybe LedgerEvent
forall a. Maybe a
Nothing
handleConwayNEWEPOCHEvents
:: Core.EraPParams ledgerera
=> Event (Core.EraRule "EPOCH" ledgerera) ~ Conway.ConwayEpochEvent ledgerera
=> Event (Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera
=> Event (Core.EraRule "RUPD" ledgerera) ~ RupdEvent
=> ConwayNewEpochEvent ledgerera -> Maybe LedgerEvent
handleConwayNEWEPOCHEvents :: forall ledgerera.
(EraPParams ledgerera,
Event (EraRule "EPOCH" ledgerera) ~ ConwayEpochEvent ledgerera,
Event (EraRule "POOLREAP" ledgerera)
~ ShelleyPoolreapEvent ledgerera,
Event (EraRule "RUPD" ledgerera) ~ RupdEvent) =>
ConwayNewEpochEvent ledgerera -> Maybe LedgerEvent
handleConwayNEWEPOCHEvents ConwayNewEpochEvent ledgerera
conwayNewEpochEvent =
case ConwayNewEpochEvent ledgerera
conwayNewEpochEvent of
Conway.DeltaRewardEvent Event (EraRule "RUPD" ledgerera)
rewardUpdate ->
case Event (EraRule "RUPD" ledgerera)
rewardUpdate of
RupdEvent EpochNo
epochNum Map (Credential 'Staking) (Set Reward)
rewards ->
LedgerEvent -> Maybe LedgerEvent
forall a. a -> Maybe a
Just (LedgerEvent -> Maybe LedgerEvent)
-> LedgerEvent -> Maybe LedgerEvent
forall a b. (a -> b) -> a -> b
$ EpochNo -> Map StakeCredential (Set Reward) -> LedgerEvent
IncrementalRewardsDistribution EpochNo
epochNum ((Credential 'Staking -> StakeCredential)
-> Map (Credential 'Staking) (Set Reward)
-> Map StakeCredential (Set Reward)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Credential 'Staking -> StakeCredential
fromShelleyStakeCredential Map (Credential 'Staking) (Set Reward)
rewards)
Conway.RestrainedRewards{} -> Maybe LedgerEvent
forall a. Maybe a
Nothing
Conway.TotalRewardEvent EpochNo
epochNo Map (Credential 'Staking) (Set Reward)
rewardsMap ->
LedgerEvent -> Maybe LedgerEvent
forall a. a -> Maybe a
Just (LedgerEvent -> Maybe LedgerEvent)
-> LedgerEvent -> Maybe LedgerEvent
forall a b. (a -> b) -> a -> b
$ EpochNo -> Map StakeCredential (Set Reward) -> LedgerEvent
RewardsDistribution EpochNo
epochNo ((Credential 'Staking -> StakeCredential)
-> Map (Credential 'Staking) (Set Reward)
-> Map StakeCredential (Set Reward)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Credential 'Staking -> StakeCredential
fromShelleyStakeCredential Map (Credential 'Staking) (Set Reward)
rewardsMap)
Conway.EpochEvent Event (EraRule "EPOCH" ledgerera)
epochEvent ->
case Event (EraRule "EPOCH" ledgerera)
epochEvent of
Conway.EpochBoundaryRatifyState RatifyState ledgerera
ratifyState ->
LedgerEvent -> Maybe LedgerEvent
forall a. a -> Maybe a
Just (LedgerEvent -> Maybe LedgerEvent)
-> LedgerEvent -> Maybe LedgerEvent
forall a b. (a -> b) -> a -> b
$ AnyRatificationState -> LedgerEvent
EpochBoundaryRatificationState (RatifyState ledgerera -> AnyRatificationState
forall era.
EraPParams era =>
RatifyState era -> AnyRatificationState
AnyRatificationState RatifyState ledgerera
ratifyState)
Conway.PoolReapEvent Event (EraRule "POOLREAP" ledgerera)
poolReap ->
case Event (EraRule "POOLREAP" ledgerera)
poolReap of
RetiredPools{Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
refundPools :: forall era.
ShelleyPoolreapEvent era
-> Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
refundPools :: Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
refundPools, Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
unclaimedPools :: forall era.
ShelleyPoolreapEvent era
-> Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
unclaimedPools :: Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
unclaimedPools, EpochNo
epochNo :: forall era. ShelleyPoolreapEvent era -> EpochNo
epochNo :: EpochNo
epochNo} ->
LedgerEvent -> Maybe LedgerEvent
forall a. a -> Maybe a
Just (LedgerEvent -> Maybe LedgerEvent)
-> (PoolReapDetails -> LedgerEvent)
-> PoolReapDetails
-> Maybe LedgerEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolReapDetails -> LedgerEvent
PoolReap (PoolReapDetails -> Maybe LedgerEvent)
-> PoolReapDetails -> Maybe LedgerEvent
forall a b. (a -> b) -> a -> b
$
EpochNo
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
-> PoolReapDetails
PoolReapDetails
EpochNo
epochNo
(Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
refundPools)
(Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap Map (Credential 'Staking) (Map (KeyHash 'StakePool) Coin)
unclaimedPools)
Conway.SnapEvent Event (EraRule "SNAP" ledgerera)
_ -> Maybe LedgerEvent
forall a. Maybe a
Nothing
Conway.GovInfoEvent{} -> Maybe LedgerEvent
forall a. Maybe a
Nothing
Conway.HardForkEvent{} -> Maybe LedgerEvent
forall a. Maybe a
Nothing
Conway.TotalAdaPotsEvent AdaPots
_ -> Maybe LedgerEvent
forall a. Maybe a
Nothing