{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.Api.LedgerEvents.Rule.TICK.NEWEPOCH
  ( LatestTickEventConstraints
  , handleShelleyNEWEPOCHEvents
  , handleLedgerTICKEvents
  , handleConwayNEWEPOCHEvents
  )
where

import           Cardano.Api.Address (fromShelleyStakeCredential)
import           Cardano.Api.LedgerEvents.LedgerEvent
import           Cardano.Api.LedgerEvents.Rule.TICK.RUPD
import           Cardano.Api.ReexposeLedger

import           Cardano.Ledger.Conway.Rules (ConwayNewEpochEvent)
import qualified Cardano.Ledger.Conway.Rules as Conway
import qualified Cardano.Ledger.Core as Core
import           Cardano.Ledger.Shelley.Rules
import qualified Cardano.Ledger.Shelley.Rules as Shelley

import qualified Data.Map.Strict as Map

type LatestTickEventConstraints ledgerera =
  ( Event (Core.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera
  , Event (Core.EraRule "RUPD" ledgerera) ~ RupdEvent StandardCrypto
  , Event (Core.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera
  , Event (Core.EraRule "EPOCH" ledgerera) ~ Shelley.ShelleyEpochEvent ledgerera
  , Event (Core.EraRule "POOLREAP" ledgerera) ~ Shelley.ShelleyPoolreapEvent ledgerera
  )

handleLedgerTICKEvents
  :: EraCrypto ledgerera ~ StandardCrypto
  => LatestTickEventConstraints ledgerera
  => ShelleyTickEvent ledgerera -> Maybe LedgerEvent
handleLedgerTICKEvents :: forall ledgerera.
(EraCrypto ledgerera ~ StandardCrypto,
 LatestTickEventConstraints ledgerera) =>
ShelleyTickEvent ledgerera -> Maybe LedgerEvent
handleLedgerTICKEvents (TickNewEpochEvent Event (EraRule "NEWEPOCH" ledgerera)
newEpochEvent) = ShelleyNewEpochEvent ledgerera -> Maybe LedgerEvent
forall ledgerera.
(EraCrypto ledgerera ~ StandardCrypto,
 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 StandardCrypto -> Maybe LedgerEvent
handleLedgerRUPDEvents Event (EraRule "RUPD" ledgerera)
RupdEvent StandardCrypto
rewardUpdate

handleShelleyNEWEPOCHEvents
  :: EraCrypto ledgerera ~ StandardCrypto
  => Event (Core.EraRule "EPOCH" ledgerera) ~ ShelleyEpochEvent ledgerera
  => Event (Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera
  => ShelleyNewEpochEvent ledgerera -> Maybe LedgerEvent
handleShelleyNEWEPOCHEvents :: forall ledgerera.
(EraCrypto ledgerera ~ StandardCrypto,
 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 (EraCrypto ledgerera))
  (Set (Reward (EraCrypto ledgerera)))
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 StandardCrypto)) -> LedgerEvent
RewardsDistribution EpochNo
epochNo ((StakeCredential StandardCrypto -> StakeCredential)
-> Map
     (StakeCredential StandardCrypto) (Set (Reward StandardCrypto))
-> Map StakeCredential (Set (Reward StandardCrypto))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Set (Reward (EraCrypto ledgerera)))
Map (StakeCredential StandardCrypto) (Set (Reward StandardCrypto))
rewardsMap)
    Shelley.EpochEvent Event (EraRule "EPOCH" ledgerera)
e -> ShelleyEpochEvent ledgerera -> Maybe LedgerEvent
forall ledgerera.
(EraCrypto ledgerera ~ StandardCrypto,
 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
  :: EraCrypto ledgerera ~ StandardCrypto
  => Event (Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera
  => ShelleyEpochEvent ledgerera -> Maybe LedgerEvent
handleEpochEvents :: forall ledgerera.
(EraCrypto ledgerera ~ StandardCrypto,
 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 (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
refundPools :: Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
refundPools :: forall era.
ShelleyPoolreapEvent era
-> Map
     (Credential 'Staking (EraCrypto era))
     (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
refundPools, Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
unclaimedPools :: Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
unclaimedPools :: forall era.
ShelleyPoolreapEvent era
-> Map
     (Credential 'Staking (EraCrypto era))
     (Map (KeyHash 'StakePool (EraCrypto era)) 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
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
Map
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) Coin)
refundPools)
          (Map
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
Map
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) Coin)
unclaimedPools)
handleEpochEvents (SnapEvent{}) = Maybe LedgerEvent
forall a. Maybe a
Nothing
handleEpochEvents (UpecEvent{}) = Maybe LedgerEvent
forall a. Maybe a
Nothing

handleConwayNEWEPOCHEvents
  :: EraCrypto ledgerera ~ StandardCrypto
  => Core.EraPParams ledgerera
  => Event (Core.EraRule "EPOCH" ledgerera) ~ Conway.ConwayEpochEvent ledgerera
  => Event (Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera
  => Event (Core.EraRule "RUPD" ledgerera) ~ RupdEvent StandardCrypto
  => ConwayNewEpochEvent ledgerera -> Maybe LedgerEvent
handleConwayNEWEPOCHEvents :: forall ledgerera.
(EraCrypto ledgerera ~ StandardCrypto, EraPParams ledgerera,
 Event (EraRule "EPOCH" ledgerera) ~ ConwayEpochEvent ledgerera,
 Event (EraRule "POOLREAP" ledgerera)
 ~ ShelleyPoolreapEvent ledgerera,
 Event (EraRule "RUPD" ledgerera) ~ RupdEvent StandardCrypto) =>
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 (StakeCredential StandardCrypto) (Set (Reward StandardCrypto))
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 StandardCrypto)) -> LedgerEvent
IncrementalRewardsDistribution EpochNo
epochNum ((StakeCredential StandardCrypto -> StakeCredential)
-> Map
     (StakeCredential StandardCrypto) (Set (Reward StandardCrypto))
-> Map StakeCredential (Set (Reward StandardCrypto))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential Map (StakeCredential StandardCrypto) (Set (Reward StandardCrypto))
rewards)
    Conway.RestrainedRewards{} -> Maybe LedgerEvent
forall a. Maybe a
Nothing
    Conway.TotalRewardEvent EpochNo
epochNo Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Set (Reward (EraCrypto ledgerera)))
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 StandardCrypto)) -> LedgerEvent
RewardsDistribution EpochNo
epochNo ((StakeCredential StandardCrypto -> StakeCredential)
-> Map
     (StakeCredential StandardCrypto) (Set (Reward StandardCrypto))
-> Map StakeCredential (Set (Reward StandardCrypto))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys StakeCredential StandardCrypto -> StakeCredential
fromShelleyStakeCredential Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Set (Reward (EraCrypto ledgerera)))
Map (StakeCredential StandardCrypto) (Set (Reward StandardCrypto))
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 (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
refundPools :: forall era.
ShelleyPoolreapEvent era
-> Map
     (Credential 'Staking (EraCrypto era))
     (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
refundPools :: Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
refundPools, Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
unclaimedPools :: forall era.
ShelleyPoolreapEvent era
-> Map
     (Credential 'Staking (EraCrypto era))
     (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
unclaimedPools :: Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) 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
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
Map
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) Coin)
refundPools)
                  (Map
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap Map
  (Credential 'Staking (EraCrypto ledgerera))
  (Map (KeyHash 'StakePool (EraCrypto ledgerera)) Coin)
Map
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) 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