{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Api.Internal.LedgerEvents.LedgerEvent
  ( LedgerEvent (..)
  , AnyProposals (..)
  , AnyRatificationState (..)
  , MIRDistributionDetails (..)
  , PoolReapDetails (..)
  , convertRetiredPoolsMap
  )
where

import Cardano.Api.Internal.Address (StakeCredential, fromShelleyStakeCredential)
import Cardano.Api.Internal.Block (EpochNo)
import Cardano.Api.Internal.Keys.Shelley (Hash (..), StakePoolKey)

import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Coin qualified as Ledger
import Cardano.Ledger.Conway.Governance qualified as Ledger
import Cardano.Ledger.Core qualified as Ledger.Core
import Cardano.Ledger.Credential qualified as Ledger
import Cardano.Ledger.Keys qualified as Ledger
import Cardano.Ledger.Plutus.Evaluate (PlutusWithContext)
import Cardano.Ledger.Shelley.Rewards (Reward)
import Cardano.Ledger.TxIn qualified as Ledger

import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)

data AnyProposals
  = forall era. Ledger.Core.EraPParams era => AnyProposals (Ledger.Proposals era)

deriving instance Show AnyProposals

data AnyRatificationState
  = forall era. Ledger.Core.EraPParams era => AnyRatificationState (Ledger.RatifyState era)

deriving instance Show AnyRatificationState

data LedgerEvent
  = -- | The given pool is being registered for the first time on chain.
    PoolRegistration
  | -- | The given pool already exists and is being re-registered.
    PoolReRegistration
  | -- | Incremental rewards are being computed.
    IncrementalRewardsDistribution EpochNo (Map StakeCredential (Set Reward))
  | -- | Reward distribution has completed.
    RewardsDistribution EpochNo (Map StakeCredential (Set Reward))
  | -- | MIR are being distributed.
    MIRDistribution MIRDistributionDetails
  | -- | Pools have been reaped and deposits refunded.
    PoolReap PoolReapDetails
  | -- | A number of succeeded Plutus script evaluations.
    SuccessfulPlutusScript (NonEmpty PlutusWithContext)
  | -- | A number of failed Plutus script evaluations.
    FailedPlutusScript (NonEmpty PlutusWithContext)
  | -- Only events available on the Conway Era.
    -- TODO: Update the above constructors to work in the conway era.
    -- See toLedgerEventConway

    -- | Newly submittted governance proposals in a single transaction.
    NewGovernanceProposals Ledger.TxId AnyProposals
  | -- | Governance votes that were invalidated.
    RemovedGovernanceVotes
      Ledger.TxId
      (Set (Ledger.Voter, Ledger.GovActionId))
      -- ^ Votes that were replaced in this tx.
      (Set (Ledger.Credential 'Ledger.DRepRole))
      -- ^ Any votes from these DReps in this or in previous txs are removed
  | -- | The current state of governance matters at the epoch boundary.
    -- I.E the current constitution, committee, protocol parameters, etc.
    EpochBoundaryRatificationState AnyRatificationState
  deriving Int -> LedgerEvent -> ShowS
[LedgerEvent] -> ShowS
LedgerEvent -> String
(Int -> LedgerEvent -> ShowS)
-> (LedgerEvent -> String)
-> ([LedgerEvent] -> ShowS)
-> Show LedgerEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LedgerEvent -> ShowS
showsPrec :: Int -> LedgerEvent -> ShowS
$cshow :: LedgerEvent -> String
show :: LedgerEvent -> String
$cshowList :: [LedgerEvent] -> ShowS
showList :: [LedgerEvent] -> ShowS
Show

--------------------------------------------------------------------------------
-- Event details
--------------------------------------------------------------------------------

-- | Details of fund transfers due to MIR certificates.
--
--   Note that the transfers from reserves to treasury and treasury to reserves
--   are inverse; a transfer of 100 ADA in either direction will result in a net
--   movement of 0, but we include both directions for assistance in debugging.
data MIRDistributionDetails = MIRDistributionDetails
  { MIRDistributionDetails -> Map StakeCredential Coin
mirddReservePayouts :: Map StakeCredential L.Coin
  , MIRDistributionDetails -> Map StakeCredential Coin
mirddTreasuryPayouts :: Map StakeCredential L.Coin
  , MIRDistributionDetails -> Coin
mirddReservesToTreasury :: L.Coin
  , MIRDistributionDetails -> Coin
mirddTreasuryToReserves :: L.Coin
  }
  deriving Int -> MIRDistributionDetails -> ShowS
[MIRDistributionDetails] -> ShowS
MIRDistributionDetails -> String
(Int -> MIRDistributionDetails -> ShowS)
-> (MIRDistributionDetails -> String)
-> ([MIRDistributionDetails] -> ShowS)
-> Show MIRDistributionDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MIRDistributionDetails -> ShowS
showsPrec :: Int -> MIRDistributionDetails -> ShowS
$cshow :: MIRDistributionDetails -> String
show :: MIRDistributionDetails -> String
$cshowList :: [MIRDistributionDetails] -> ShowS
showList :: [MIRDistributionDetails] -> ShowS
Show

data PoolReapDetails = PoolReapDetails
  { PoolReapDetails -> EpochNo
prdEpochNo :: EpochNo
  , PoolReapDetails
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
prdRefunded :: Map StakeCredential (Map (Hash StakePoolKey) L.Coin)
  -- ^ Refunded deposits. The pools referenced are now retired, and the
  --   'StakeCredential' accounts are credited with the deposits.
  , PoolReapDetails
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
prdUnclaimed :: Map StakeCredential (Map (Hash StakePoolKey) L.Coin)
  -- ^ Unclaimed deposits. The 'StakeCredential' referenced in this map is not
  -- actively registered at the time of the pool reaping, and as such the
  -- funds are returned to the treasury.
  }
  deriving Int -> PoolReapDetails -> ShowS
[PoolReapDetails] -> ShowS
PoolReapDetails -> String
(Int -> PoolReapDetails -> ShowS)
-> (PoolReapDetails -> String)
-> ([PoolReapDetails] -> ShowS)
-> Show PoolReapDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PoolReapDetails -> ShowS
showsPrec :: Int -> PoolReapDetails -> ShowS
$cshow :: PoolReapDetails -> String
show :: PoolReapDetails -> String
$cshowList :: [PoolReapDetails] -> ShowS
showList :: [PoolReapDetails] -> ShowS
Show

convertRetiredPoolsMap
  :: Map
       Ledger.StakeCredential
       (Map (Ledger.KeyHash Ledger.StakePool) Ledger.Coin)
  -> Map StakeCredential (Map (Hash StakePoolKey) L.Coin)
convertRetiredPoolsMap :: Map StakeCredential (Map (KeyHash 'StakePool) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap =
  (StakeCredential -> StakeCredential)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys StakeCredential -> StakeCredential
fromShelleyStakeCredential
    (Map StakeCredential (Map (Hash StakePoolKey) Coin)
 -> Map StakeCredential (Map (Hash StakePoolKey) Coin))
-> (Map StakeCredential (Map (KeyHash 'StakePool) Coin)
    -> Map StakeCredential (Map (Hash StakePoolKey) Coin))
-> Map StakeCredential (Map (KeyHash 'StakePool) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool) Coin -> Map (Hash StakePoolKey) Coin)
-> Map StakeCredential (Map (KeyHash 'StakePool) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
forall a b.
(a -> b) -> Map StakeCredential a -> Map StakeCredential b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KeyHash 'StakePool -> Hash StakePoolKey)
-> Map (KeyHash 'StakePool) Coin -> Map (Hash StakePoolKey) Coin
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys KeyHash 'StakePool -> Hash StakePoolKey
StakePoolKeyHash)