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

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

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

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

import           Data.List.NonEmpty (NonEmpty)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict 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)