{-# 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 -- We no longer care about MIR events
    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