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

module Cardano.Ledger.Shelley.AdaPots (
  AdaPots (..),
  totalAdaES,
  totalAdaPotsES,
  Produced (..),
  Consumed (..),
  consumedTxBody,
  producedTxBody,
  sumAdaPots,
) where

import Cardano.Ledger.CertState (
  CertState (..),
  Obligations (..),
  certsTotalDepositsTxBody,
  certsTotalRefundsTxBody,
  obligationCertState,
  rewards,
  sumObligation,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Compactible (fromCompact)
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.Governance (EraGov (..))
import Cardano.Ledger.Shelley.LedgerState.Types (
  AccountState (..),
  EpochState (..),
  LedgerState (..),
  UTxOState (..),
  lsUTxOStateL,
  utxosGovStateL,
 )
import Cardano.Ledger.Shelley.TxBody (unWithdrawals)
import Cardano.Ledger.UMap (sumRewardsUView)
import Cardano.Ledger.UTxO (UTxO (..), coinBalance, txInsFilter, txouts)
import Control.DeepSeq (NFData)
import Data.Foldable (fold)
import GHC.Generics (Generic)
import Lens.Micro ((^.))

data AdaPots = AdaPots
  { AdaPots -> Coin
treasuryAdaPot :: Coin
  , AdaPots -> Coin
reservesAdaPot :: Coin
  , AdaPots -> Coin
rewardsAdaPot :: Coin
  , AdaPots -> Coin
utxoAdaPot :: Coin
  , AdaPots -> Coin
feesAdaPot :: Coin
  , AdaPots -> Obligations
obligationsPot :: Obligations
  }
  deriving (Int -> AdaPots -> ShowS
[AdaPots] -> ShowS
AdaPots -> String
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
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, forall x. Rep AdaPots x -> AdaPots
forall x. AdaPots -> Rep AdaPots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AdaPots x -> AdaPots
$cfrom :: forall x. AdaPots -> Rep AdaPots x
Generic)

instance NFData AdaPots

-- | Calculate the total ada pots in the epoch state
totalAdaPotsES ::
  ( EraTxOut era
  , EraGov era
  ) =>
  EpochState era ->
  AdaPots
totalAdaPotsES :: forall era. (EraTxOut era, EraGov era) => EpochState era -> AdaPots
totalAdaPotsES (EpochState (AccountState Coin
treasury_ Coin
reserves_) LedgerState era
ls SnapShots
_ NonMyopic
_) =
  AdaPots
    { treasuryAdaPot :: Coin
treasuryAdaPot = Coin
treasury_
    , reservesAdaPot :: Coin
reservesAdaPot = Coin
reserves_
    , rewardsAdaPot :: Coin
rewardsAdaPot = Coin
rewards_
    , utxoAdaPot :: Coin
utxoAdaPot = Coin
coins
    , feesAdaPot :: Coin
feesAdaPot = Coin
fees_
    , obligationsPot :: Obligations
obligationsPot = forall era. CertState era -> Obligations
obligationCertState CertState era
certState forall a. Semigroup a => a -> a -> a
<> Obligations
govStateObligations
    }
  where
    UTxOState UTxO era
u Coin
_ Coin
fees_ GovState era
_ IncrementalStake
_ Coin
_ = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    certState :: CertState era
certState@(CertState VState era
_ PState era
_ DState era
dstate) = forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    rewards_ :: Coin
rewards_ = forall a. Compactible a => CompactForm a -> a
fromCompact forall a b. (a -> b) -> a -> b
$ forall k. UView k RDPair -> CompactForm Coin
sumRewardsUView (forall era. DState era -> UView (Credential 'Staking) RDPair
rewards DState era
dstate)
    coins :: Coin
coins = forall era. EraTxOut era => UTxO era -> Coin
coinBalance UTxO era
u
    govStateObligations :: Obligations
govStateObligations = forall era. EraGov era => GovState era -> Obligations
obligationGovState (LedgerState era
ls forall s a. s -> Getting a s a -> a
^. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL)

sumAdaPots :: AdaPots -> Coin
sumAdaPots :: AdaPots -> Coin
sumAdaPots
  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
feesAdaPot :: Coin
feesAdaPot :: AdaPots -> Coin
feesAdaPot
    , Obligations
obligationsPot :: Obligations
obligationsPot :: AdaPots -> Obligations
obligationsPot
    } =
    Coin
treasuryAdaPot
      forall a. Semigroup a => a -> a -> a
<> Coin
reservesAdaPot
      forall a. Semigroup a => a -> a -> a
<> Coin
rewardsAdaPot
      forall a. Semigroup a => a -> a -> a
<> Coin
utxoAdaPot
      forall a. Semigroup a => a -> a -> a
<> Coin
feesAdaPot
      forall a. Semigroup a => a -> a -> a
<> Obligations -> Coin
sumObligation Obligations
obligationsPot

-- | Calculate the total ada in the epoch state
totalAdaES :: (EraTxOut era, EraGov era) => EpochState era -> Coin
totalAdaES :: forall era. (EraTxOut era, EraGov era) => EpochState era -> Coin
totalAdaES = AdaPots -> Coin
sumAdaPots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. (EraTxOut era, EraGov era) => EpochState era -> AdaPots
totalAdaPotsES

-- =============================================
-- Produced and Consumed are specialized AdaPots
-- relative to the actions of a TxBody

-- | Itemizing what is consumed by a transaction
data Consumed = Consumed
  {Consumed -> Coin
conInputs :: !Coin, Consumed -> Coin
conRefunds :: !Coin, Consumed -> Coin
conWithdrawals :: !Coin}

instance Show Consumed where
  show :: Consumed -> String
show (Consumed (Coin Integer
i) (Coin Integer
r) (Coin Integer
w)) =
    String
"Consumed(Inputs "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i
      forall a. [a] -> [a] -> [a]
++ String
", Refunds "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
r
      forall a. [a] -> [a] -> [a]
++ String
", Withdrawals "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
w
      forall a. [a] -> [a] -> [a]
++ String
") = "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Integer
i forall a. Num a => a -> a -> a
+ Integer
r forall a. Num a => a -> a -> a
+ Integer
w)

-- | Itemizing what is Produced by a transaction
data Produced = Produced
  { Produced -> Coin
proOutputs :: !Coin
  , Produced -> Coin
proFees :: !Coin
  , Produced -> Coin
proDeposits :: !Coin
  }

instance Show Produced where
  show :: Produced -> String
show (Produced (Coin Integer
out) (Coin Integer
f) (Coin Integer
d)) =
    String
"Produced(Outputs "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
out
      forall a. [a] -> [a] -> [a]
++ String
", Fees "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
f
      forall a. [a] -> [a] -> [a]
++ String
", Deposits "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
d
      forall a. [a] -> [a] -> [a]
++ String
") = "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Integer
out forall a. Num a => a -> a -> a
+ Integer
f forall a. Num a => a -> a -> a
+ Integer
d)

-- =========================

-- | Compute the Coin part of what is consumed by a TxBody, itemized as a 'Consume'
consumedTxBody ::
  EraTxBody era =>
  TxBody era ->
  PParams era ->
  CertState era ->
  UTxO era ->
  Consumed
consumedTxBody :: forall era.
EraTxBody era =>
TxBody era -> PParams era -> CertState era -> UTxO era -> Consumed
consumedTxBody TxBody era
txBody PParams era
pp CertState era
dpstate UTxO era
utxo =
  Consumed
    { conInputs :: Coin
conInputs =
        forall era. EraTxOut era => UTxO era -> Coin
coinBalance (forall era. UTxO era -> Set TxIn -> UTxO era
txInsFilter UTxO era
utxo (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL))
    , conRefunds :: Coin
conRefunds = forall era.
EraTxBody era =>
PParams era -> CertState era -> TxBody era -> Coin
certsTotalRefundsTxBody PParams era
pp CertState era
dpstate TxBody era
txBody
    , conWithdrawals :: Coin
conWithdrawals = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. Withdrawals -> Map RewardAccount Coin
unWithdrawals forall a b. (a -> b) -> a -> b
$ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL
    }

-- | Compute the Coin part of what is produced by a TxBody, itemized as a 'Produced'
producedTxBody ::
  EraTxBody era =>
  TxBody era ->
  PParams era ->
  CertState era ->
  Produced
producedTxBody :: forall era.
EraTxBody era =>
TxBody era -> PParams era -> CertState era -> Produced
producedTxBody TxBody era
txBody PParams era
pp CertState era
dpstate =
  Produced
    { proOutputs :: Coin
proOutputs = forall era. EraTxOut era => UTxO era -> Coin
coinBalance (forall era. EraTxBody era => TxBody era -> UTxO era
txouts TxBody era
txBody)
    , proFees :: Coin
proFees = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL
    , proDeposits :: Coin
proDeposits = forall era.
EraTxBody era =>
PParams era -> CertState era -> TxBody era -> Coin
certsTotalDepositsTxBody PParams era
pp CertState era
dpstate TxBody era
txBody
    }