{-# 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.Crypto (StandardCrypto)
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 StandardCrypto)))
  | -- | Reward distribution has completed.
    RewardsDistribution EpochNo (Map StakeCredential (Set (Reward StandardCrypto)))
  | -- | 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 StandardCrypto))
  | -- | A number of failed Plutus script evaluations.
    FailedPlutusScript (NonEmpty (PlutusWithContext StandardCrypto))
  | -- 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 StandardCrypto) AnyProposals
  | -- | Governance votes that were invalidated.
    RemovedGovernanceVotes
      (Ledger.TxId StandardCrypto)
      (Set (Ledger.Voter StandardCrypto, Ledger.GovActionId StandardCrypto))
      -- ^ Votes that were replaced in this tx.
      (Set (Ledger.Credential 'Ledger.DRepRole StandardCrypto))
      -- ^ 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 StandardCrypto)
       (Map (Ledger.KeyHash Ledger.StakePool StandardCrypto) Ledger.Coin)
  -> Map StakeCredential (Map (Hash StakePoolKey) L.Coin)
convertRetiredPoolsMap :: Map
  (StakeCredential StandardCrypto)
  (Map (KeyHash 'StakePool StandardCrypto) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
convertRetiredPoolsMap =
  (StakeCredential StandardCrypto -> StakeCredential)
-> Map
     (StakeCredential StandardCrypto) (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 StandardCrypto -> StakeCredential
fromShelleyStakeCredential
    (Map
   (StakeCredential StandardCrypto) (Map (Hash StakePoolKey) Coin)
 -> Map StakeCredential (Map (Hash StakePoolKey) Coin))
-> (Map
      (StakeCredential StandardCrypto)
      (Map (KeyHash 'StakePool StandardCrypto) Coin)
    -> Map
         (StakeCredential StandardCrypto) (Map (Hash StakePoolKey) Coin))
-> Map
     (StakeCredential StandardCrypto)
     (Map (KeyHash 'StakePool StandardCrypto) Coin)
-> Map StakeCredential (Map (Hash StakePoolKey) Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (KeyHash 'StakePool StandardCrypto) Coin
 -> Map (Hash StakePoolKey) Coin)
-> Map
     (StakeCredential StandardCrypto)
     (Map (KeyHash 'StakePool StandardCrypto) Coin)
-> Map
     (StakeCredential StandardCrypto) (Map (Hash StakePoolKey) Coin)
forall a b.
(a -> b)
-> Map (StakeCredential StandardCrypto) a
-> Map (StakeCredential StandardCrypto) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey)
-> Map (KeyHash 'StakePool StandardCrypto) Coin
-> Map (Hash StakePoolKey) Coin
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey
StakePoolKeyHash)