{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Shelley.AdaPots
  ( AdaPots (..),
    totalAdaES,
    totalAdaPotsES,
  )
where

import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Shelley.Constraints (UsesValue)
import Cardano.Ledger.Shelley.LedgerState
  ( AccountState (..),
    DPState (..),
    EpochState (..),
    LedgerState (..),
    UTxOState (..),
    rewards,
  )
import Cardano.Ledger.Shelley.UTxO (balance)
import qualified Cardano.Ledger.Val as Val
import Data.Foldable (fold)

data AdaPots = AdaPots
  { AdaPots -> Coin
treasuryAdaPot :: Coin,
    AdaPots -> Coin
reservesAdaPot :: Coin,
    AdaPots -> Coin
rewardsAdaPot :: Coin,
    AdaPots -> Coin
utxoAdaPot :: Coin,
    AdaPots -> Coin
depositsAdaPot :: Coin,
    AdaPots -> Coin
feesAdaPot :: Coin
  }
  deriving (Int -> AdaPots -> ShowS
[AdaPots] -> ShowS
AdaPots -> String
(Int -> AdaPots -> ShowS)
-> (AdaPots -> String) -> ([AdaPots] -> ShowS) -> Show AdaPots
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdaPots] -> ShowS
$cshowList :: [AdaPots] -> ShowS
show :: AdaPots -> String
$cshow :: AdaPots -> String
showsPrec :: Int -> AdaPots -> ShowS
$cshowsPrec :: Int -> AdaPots -> ShowS
Show, AdaPots -> AdaPots -> Bool
(AdaPots -> AdaPots -> Bool)
-> (AdaPots -> AdaPots -> Bool) -> Eq AdaPots
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdaPots -> AdaPots -> Bool
$c/= :: AdaPots -> AdaPots -> Bool
== :: AdaPots -> AdaPots -> Bool
$c== :: AdaPots -> AdaPots -> Bool
Eq)

-- | Calculate the total ada pots in the epoch state
totalAdaPotsES ::
  UsesValue era =>
  EpochState era ->
  AdaPots
totalAdaPotsES :: EpochState era -> AdaPots
totalAdaPotsES (EpochState (AccountState Coin
treasury_ Coin
reserves_) SnapShots (Crypto era)
_ LedgerState era
ls PParams era
_ PParams era
_ NonMyopic (Crypto era)
_) =
  AdaPots :: Coin -> Coin -> Coin -> Coin -> Coin -> Coin -> AdaPots
AdaPots
    { treasuryAdaPot :: Coin
treasuryAdaPot = Coin
treasury_,
      reservesAdaPot :: Coin
reservesAdaPot = Coin
reserves_,
      rewardsAdaPot :: Coin
rewardsAdaPot = Coin
rewards_,
      utxoAdaPot :: Coin
utxoAdaPot = Coin
coins,
      depositsAdaPot :: Coin
depositsAdaPot = Coin
deposits,
      feesAdaPot :: Coin
feesAdaPot = Coin
fees_
    }
  where
    (UTxOState UTxO era
u Coin
deposits Coin
fees_ State (EraRule "PPUP" era)
_ IncrementalStake (Crypto era)
_) = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    (DPState DState (Crypto era)
dstate PState (Crypto era)
_) = LedgerState era -> DPState (Crypto era)
forall era. LedgerState era -> DPState (Crypto era)
lsDPState LedgerState era
ls
    rewards_ :: Coin
rewards_ = View
  Coin
  (Credential 'Staking (Crypto era))
  (KeyHash 'StakePool (Crypto era))
  Ptr
  (Credential 'Staking (Crypto era))
  Coin
-> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (DState (Crypto era)
-> View
     Coin
     (Credential 'Staking (Crypto era))
     (KeyHash 'StakePool (Crypto era))
     Ptr
     (Credential 'Staking (Crypto era))
     Coin
forall crypto.
DState crypto -> ViewMap crypto (Credential 'Staking crypto) Coin
rewards DState (Crypto era)
dstate)
    coins :: Coin
coins = Value era -> Coin
forall t. Val t => t -> Coin
Val.coin (Value era -> Coin) -> Value era -> Coin
forall a b. (a -> b) -> a -> b
$ UTxO era -> Value era
forall era. Era era => UTxO era -> Value era
balance UTxO era
u

-- | Calculate the total ada in the epoch state
totalAdaES :: UsesValue era => EpochState era -> Coin
totalAdaES :: EpochState era -> Coin
totalAdaES EpochState era
cs =
  Coin
treasuryAdaPot
    Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
reservesAdaPot
    Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
rewardsAdaPot
    Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
utxoAdaPot
    Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
depositsAdaPot
    Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
feesAdaPot
  where
    AdaPots
      { Coin
treasuryAdaPot :: Coin
treasuryAdaPot :: AdaPots -> Coin
treasuryAdaPot,
        Coin
reservesAdaPot :: Coin
reservesAdaPot :: AdaPots -> Coin
reservesAdaPot,
        Coin
rewardsAdaPot :: Coin
rewardsAdaPot :: AdaPots -> Coin
rewardsAdaPot,
        Coin
utxoAdaPot :: Coin
utxoAdaPot :: AdaPots -> Coin
utxoAdaPot,
        Coin
depositsAdaPot :: Coin
depositsAdaPot :: AdaPots -> Coin
depositsAdaPot,
        Coin
feesAdaPot :: Coin
feesAdaPot :: AdaPots -> Coin
feesAdaPot
      } = EpochState era -> AdaPots
forall era. UsesValue era => EpochState era -> AdaPots
totalAdaPotsES EpochState era
cs