{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

module Cardano.Ledger.Api.Tx.Body (
  -- | Building and inspecting transaction outputs
  module Cardano.Ledger.Api.Tx.Out,
  -- | Working with Timelock scripts and Plutus scripts
  module Cardano.Ledger.Api.Scripts,
  EraTxBody (TxBody),
  mkBasicTxBody,
  inputsTxBodyL,
  outputsTxBodyL,
  feeTxBodyL,
  withdrawalsTxBodyL,
  Withdrawals (..),
  auxDataHashTxBodyL,
  TxAuxDataHash (..),
  AuxiliaryDataHash,
  spendableInputsTxBodyF,
  allInputsTxBodyF,
  evalBalanceTxBody,
  txIdTxBody,

  -- * Shelley Era
  ShelleyEraTxBody,
  ttlTxBodyL,
  updateTxBodyL,
  certsTxBodyL,

  -- * Allegra Era
  AllegraEraTxBody,
  vldtTxBodyL,
  ValidityInterval (..),
  invalidBeforeL,
  invalidHereAfterL,

  -- * Mary Era
  MaryEraTxBody,
  mintTxBodyL,
  mintValueTxBodyF,
  mintedTxBodyF,

  -- * Alonzo Era
  AlonzoEraTxBody,
  collateralInputsTxBodyL,
  reqSignerHashesTxBodyL,
  scriptIntegrityHashTxBodyL,
  networkIdTxBodyL,
  redeemerPointer,
  redeemerPointerInverse,

  -- * Babbage Era
  BabbageEraTxBody,
  sizedOutputsTxBodyL,
  referenceInputsTxBodyL,
  totalCollateralTxBodyL,
  collateralReturnTxBodyL,
  sizedCollateralReturnTxBodyL,
  allSizedOutputsTxBodyF,

  -- * Conway Era
  ConwayEraTxBody,
  votingProceduresTxBodyL,
  proposalProceduresTxBodyL,
) where

import Cardano.Ledger.Address (Withdrawals (..))
import Cardano.Ledger.Allegra.Core (AllegraEraTxBody (..))
import Cardano.Ledger.Alonzo.TxBody (AlonzoEraTxBody (..))
import Cardano.Ledger.Api.Era ()
import Cardano.Ledger.Api.Scripts
import Cardano.Ledger.Api.Tx.Out
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
import Cardano.Ledger.Babbage.TxBody (BabbageEraTxBody (..))
import Cardano.Ledger.BaseTypes (SlotNo, StrictMaybe (..))
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.TxBody (ConwayEraTxBody (..))
import Cardano.Ledger.Core (EraTxBody (..), PParams, TxAuxDataHash (..), Value, txIdTxBody)
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Ledger.Mary.Core (MaryEraTxBody (..))
import Cardano.Ledger.Shelley.Core (ShelleyEraTxBody (..))
import Cardano.Ledger.Shelley.UTxO (getProducedValue)
import Cardano.Ledger.State (EraUTxO (getConsumedValue), UTxO)
import Cardano.Ledger.Val ((<->))
import Lens.Micro (Lens', lens)

-- | Evaluate the difference between the value currently being consumed by a transaction
-- and the total value being produced. This value will be zero for a valid transaction.
--
-- In case when full `Cardano.Ledger.CertState` is available then this can be simplified to:
--
-- > let lookupRefund = lookupDepositDState (certDState dpState)
-- > let isRegPoolId = (`Map.member` psStakePoolParams (certPState dpState))
-- > evalBalanceTxBody pp lookupRefund isRegPoolId utxo txBody
evalBalanceTxBody ::
  EraUTxO era =>
  -- | Current protocol parameters
  PParams era ->
  -- | Lookup current deposit amount for a registered stake credential delegation. This
  -- function must produce valid answer for all of the stake credentials present in any of
  -- the `DeRegKey` delegation certificates in the supplied `TxBody`. In other words,
  -- there is no requirement to know about all of the delegation certificates in the
  -- ledger state, just the ones this transaction cares about.
  (Credential 'Staking -> Maybe Coin) ->
  -- | Lookup current deposit amount for a registered DRep credential. This
  -- function must produce valid answer for all of the DRep credentials present in any of
  -- the `UnRegDRep` certificates in the supplied `TxBody`. In other words,
  -- there is no requirement to know about all of the DRep registrations in the
  -- ledger state, just the ones this transaction cares about.
  (Credential 'DRepRole -> Maybe Coin) ->
  -- | Check whether a pool with a supplied PoolStakeId is already registered. There is no
  -- requirement to answer this question for all stake pool credentials, just for the ones
  -- that have the registration certificates included in the supplied `TxBody`
  (KeyHash 'StakePool -> Bool) ->
  -- | The UTxO relevant to the transaction.
  UTxO era ->
  -- | The transaction being evaluated for balance.
  TxBody era ->
  -- | The difference between what the transaction consumes and what it produces.
  Value era
evalBalanceTxBody :: forall era.
EraUTxO era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> (KeyHash 'StakePool -> Bool)
-> UTxO era
-> TxBody era
-> Value era
evalBalanceTxBody PParams era
pp Credential 'Staking -> Maybe Coin
lookupKeyRefund Credential 'DRepRole -> Maybe Coin
lookupDRepRefund KeyHash 'StakePool -> Bool
isRegPoolId UTxO era
utxo TxBody era
txBody =
  PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody era
-> Value era
forall era.
EraUTxO era =>
PParams era
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody era
-> Value era
getConsumedValue PParams era
pp Credential 'Staking -> Maybe Coin
lookupKeyRefund Credential 'DRepRole -> Maybe Coin
lookupDRepRefund UTxO era
utxo TxBody era
txBody
    Value era -> Value era -> Value era
forall t. Val t => t -> t -> t
<-> PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> Value era
forall era.
EraUTxO era =>
PParams era
-> (KeyHash 'StakePool -> Bool) -> TxBody era -> Value era
getProducedValue PParams era
pp KeyHash 'StakePool -> Bool
isRegPoolId TxBody era
txBody

-- | Lens to access the 'invalidBefore' field of a 'ValidityInterval' as a 'Maybe SlotNo'.
invalidBeforeL :: Lens' ValidityInterval (Maybe SlotNo)
invalidBeforeL :: Lens' ValidityInterval (Maybe SlotNo)
invalidBeforeL = (ValidityInterval -> Maybe SlotNo)
-> (ValidityInterval -> Maybe SlotNo -> ValidityInterval)
-> Lens' ValidityInterval (Maybe SlotNo)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ValidityInterval -> Maybe SlotNo
g ValidityInterval -> Maybe SlotNo -> ValidityInterval
s
  where
    g :: ValidityInterval -> Maybe SlotNo
    g :: ValidityInterval -> Maybe SlotNo
g (ValidityInterval StrictMaybe SlotNo
ma StrictMaybe SlotNo
_) =
      case StrictMaybe SlotNo
ma of
        StrictMaybe SlotNo
SNothing -> Maybe SlotNo
forall a. Maybe a
Nothing
        SJust SlotNo
a -> SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
a

    s :: ValidityInterval -> Maybe SlotNo -> ValidityInterval
    s :: ValidityInterval -> Maybe SlotNo -> ValidityInterval
s (ValidityInterval StrictMaybe SlotNo
_ StrictMaybe SlotNo
b) Maybe SlotNo
a = StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (StrictMaybe SlotNo
-> (SlotNo -> StrictMaybe SlotNo)
-> Maybe SlotNo
-> StrictMaybe SlotNo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust Maybe SlotNo
a) StrictMaybe SlotNo
b

-- | Lens to access the 'invalidHereAfter' field of a 'ValidityInterval' as a 'Maybe SlotNo'.
invalidHereAfterL :: Lens' ValidityInterval (Maybe SlotNo)
invalidHereAfterL :: Lens' ValidityInterval (Maybe SlotNo)
invalidHereAfterL = (ValidityInterval -> Maybe SlotNo)
-> (ValidityInterval -> Maybe SlotNo -> ValidityInterval)
-> Lens' ValidityInterval (Maybe SlotNo)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ValidityInterval -> Maybe SlotNo
g ValidityInterval -> Maybe SlotNo -> ValidityInterval
s
  where
    g :: ValidityInterval -> Maybe SlotNo
    g :: ValidityInterval -> Maybe SlotNo
g (ValidityInterval StrictMaybe SlotNo
_ StrictMaybe SlotNo
mb) =
      case StrictMaybe SlotNo
mb of
        StrictMaybe SlotNo
SNothing -> Maybe SlotNo
forall a. Maybe a
Nothing
        SJust SlotNo
b -> SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
b

    s :: ValidityInterval -> Maybe SlotNo -> ValidityInterval
    s :: ValidityInterval -> Maybe SlotNo -> ValidityInterval
s (ValidityInterval StrictMaybe SlotNo
ma StrictMaybe SlotNo
_) = StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
ma (StrictMaybe SlotNo -> ValidityInterval)
-> (Maybe SlotNo -> StrictMaybe SlotNo)
-> Maybe SlotNo
-> ValidityInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe SlotNo
-> (SlotNo -> StrictMaybe SlotNo)
-> Maybe SlotNo
-> StrictMaybe SlotNo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust