{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

-- | Transaction building and inspecting relies heavily on lenses (`microlens`). Therefore, some
-- familiarity with those is necessary. However, you can probably go a long way by simply
-- looking at the examples and try to go from there.
--
-- Let's start by defining the GHC extensions and imports.
--
-- >>> :set -XTypeApplications
-- >>> :set -XScopedTypeVariables
-- >>> import Test.QuickCheck
-- >>> import qualified Data.Sequence.Strict as StrictSeq
-- >>> import Cardano.Ledger.Api.Era (BabbageEra)
-- >>> import Lens.Micro
-- >>> import Test.Cardano.Ledger.Babbage.Arbitrary ()
--
-- Here's an example on how to build a Babbage era unbalanced transaction containing a single
-- transaction output using the provided interface.
--
-- >>> :{
-- quickCheck $ \(txOut :: TxOut BabbageEra) ->
--     let
--         -- Defining a Babbage era transaction body with a single random transaction output
--         txBody = mkBasicTxBody @_ @TopTx
--                & outputsTxBodyL <>~ StrictSeq.singleton txOut
--         -- Defining a basic transaction with our transaction body
--         tx = mkBasicTx txBody
--      in
--         -- We verify that the transaction's outputs contains our single random output
--         tx ^. bodyTxL . outputsTxBodyL == StrictSeq.singleton txOut
-- :}
-- +++ OK, passed 100 tests.
module Cardano.Ledger.Api.Tx (
  -- | Building and inspecting transaction bodies
  module Cardano.Ledger.Api.Tx.Body,
  module Cardano.Ledger.Api.Tx.Cert,
  module Cardano.Ledger.Api.Tx.AuxData,
  module Cardano.Ledger.Api.Tx.Wits,

  -- * Any era
  AnyEraTx (isPhase2ValidTxG),
  producedTxOuts,

  -- * Shelley onwards
  EraTx (Tx),
  mkBasicTx,
  bodyTxL,
  witsTxL,
  auxDataTxL,
  sizeTxF,
  getMinFeeTx,
  setMinFeeTx,
  setMinFeeTxUtxo,
  calcMinFeeTx,
  estimateMinFeeTx,
  txIdTx,

  -- * Alonzo onwards
  AlonzoEraTx,
  isPhase2ValidTxL,
  IsPhase2Valid (..),

  -- ** Execution units
  evalTxExUnits,
  RedeemerReport,
  evalTxExUnitsWithLogs,
  RedeemerReportWithLogs,
  TransactionScriptFailure (..),

  -- * Upgrade
  binaryUpgradeTx,
  upgradeTx,

  -- * Deprecated
  isValidTxG,
  isValidTxL,
  IsValid,
  pattern IsValid,
) where

import Cardano.Ledger.Alonzo.Tx (
  AlonzoEraTx (..),
  IsPhase2Valid (..),
  IsValid,
  isValidTxL,
  pattern IsValid,
 )
import Cardano.Ledger.Api.Era
import Cardano.Ledger.Api.Scripts.ExUnits (
  RedeemerReport,
  RedeemerReportWithLogs,
  TransactionScriptFailure (..),
  evalTxExUnits,
  evalTxExUnitsWithLogs,
 )
import Cardano.Ledger.Api.Tx.AuxData
import Cardano.Ledger.Api.Tx.Body
import Cardano.Ledger.Api.Tx.Cert
import Cardano.Ledger.Api.Tx.Wits
import Cardano.Ledger.Babbage.Collateral (mkCollateralTxIn)
import Cardano.Ledger.Core (EraTx (..), TxLevel (..), binaryUpgradeTx, txIdTx)
import Cardano.Ledger.State (UTxO (..), txouts)
import Cardano.Ledger.Tools (calcMinFeeTx, estimateMinFeeTx, setMinFeeTx, setMinFeeTxUtxo)
import Control.Monad (join)
import qualified Data.Map as Map
import Lens.Micro

class (EraTx era, AnyEraTxBody era, AnyEraTxWits era, AnyEraTxAuxData era) => AnyEraTx era where
  isPhase2ValidTxG :: SimpleGetter (Tx TopTx era) (Maybe IsPhase2Valid)
  default isPhase2ValidTxG :: AlonzoEraTx era => SimpleGetter (Tx TopTx era) (Maybe IsPhase2Valid)
  isPhase2ValidTxG = (IsPhase2Valid -> Const r IsPhase2Valid)
-> Tx TopTx era -> Const r (Tx TopTx era)
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsPhase2Valid
Lens' (Tx TopTx era) IsPhase2Valid
isPhase2ValidTxL ((IsPhase2Valid -> Const r IsPhase2Valid)
 -> Tx TopTx era -> Const r (Tx TopTx era))
-> ((Maybe IsPhase2Valid -> Const r (Maybe IsPhase2Valid))
    -> IsPhase2Valid -> Const r IsPhase2Valid)
-> (Maybe IsPhase2Valid -> Const r (Maybe IsPhase2Valid))
-> Tx TopTx era
-> Const r (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsPhase2Valid -> Maybe IsPhase2Valid)
-> SimpleGetter IsPhase2Valid (Maybe IsPhase2Valid)
forall s a. (s -> a) -> SimpleGetter s a
to IsPhase2Valid -> Maybe IsPhase2Valid
forall a. a -> Maybe a
Just

  isValidTxG :: SimpleGetter (Tx TopTx era) (Maybe IsPhase2Valid)
  isValidTxG = Getting r (Tx TopTx era) (Maybe IsPhase2Valid)
forall era.
AnyEraTx era =>
SimpleGetter (Tx TopTx era) (Maybe IsPhase2Valid)
SimpleGetter (Tx TopTx era) (Maybe IsPhase2Valid)
isPhase2ValidTxG

{-# DEPRECATED isValidTxG "In favor of `isPhase2ValidTxG`" #-}

instance AnyEraTx ShelleyEra where
  isPhase2ValidTxG :: SimpleGetter (Tx TopTx ShelleyEra) (Maybe IsPhase2Valid)
isPhase2ValidTxG = (Tx TopTx ShelleyEra -> Maybe IsPhase2Valid)
-> SimpleGetter (Tx TopTx ShelleyEra) (Maybe IsPhase2Valid)
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe IsPhase2Valid -> Tx TopTx ShelleyEra -> Maybe IsPhase2Valid
forall a b. a -> b -> a
const Maybe IsPhase2Valid
forall a. Maybe a
Nothing)

instance AnyEraTx AllegraEra where
  isPhase2ValidTxG :: SimpleGetter (Tx TopTx AllegraEra) (Maybe IsPhase2Valid)
isPhase2ValidTxG = (Tx TopTx AllegraEra -> Maybe IsPhase2Valid)
-> SimpleGetter (Tx TopTx AllegraEra) (Maybe IsPhase2Valid)
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe IsPhase2Valid -> Tx TopTx AllegraEra -> Maybe IsPhase2Valid
forall a b. a -> b -> a
const Maybe IsPhase2Valid
forall a. Maybe a
Nothing)

instance AnyEraTx MaryEra where
  isPhase2ValidTxG :: SimpleGetter (Tx TopTx MaryEra) (Maybe IsPhase2Valid)
isPhase2ValidTxG = (Tx TopTx MaryEra -> Maybe IsPhase2Valid)
-> SimpleGetter (Tx TopTx MaryEra) (Maybe IsPhase2Valid)
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe IsPhase2Valid -> Tx TopTx MaryEra -> Maybe IsPhase2Valid
forall a b. a -> b -> a
const Maybe IsPhase2Valid
forall a. Maybe a
Nothing)

instance AnyEraTx AlonzoEra

instance AnyEraTx BabbageEra

instance AnyEraTx ConwayEra

instance AnyEraTx DijkstraEra

-- | Construct all of the unspent outputs that will be produced by this transaction
producedTxOuts :: AnyEraTx era => Tx TopTx era -> UTxO era
producedTxOuts :: forall era. AnyEraTx era => Tx TopTx era -> UTxO era
producedTxOuts Tx TopTx era
tx =
  case Tx TopTx era
tx Tx TopTx era
-> Getting
     (Maybe IsPhase2Valid) (Tx TopTx era) (Maybe IsPhase2Valid)
-> Maybe IsPhase2Valid
forall s a. s -> Getting a s a -> a
^. Getting (Maybe IsPhase2Valid) (Tx TopTx era) (Maybe IsPhase2Valid)
forall era.
AnyEraTx era =>
SimpleGetter (Tx TopTx era) (Maybe IsPhase2Valid)
SimpleGetter (Tx TopTx era) (Maybe IsPhase2Valid)
isPhase2ValidTxG of
    Just IsPhase2Valid
Phase2Invalid ->
      Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO (Map TxIn (TxOut era) -> UTxO era)
-> Map TxIn (TxOut era) -> UTxO era
forall a b. (a -> b) -> a -> b
$
        case Maybe (Maybe (TxOut era)) -> Maybe (TxOut era)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (TxBody TopTx era
txBody TxBody TopTx era
-> Getting
     (Maybe (Maybe (TxOut era)))
     (TxBody TopTx era)
     (Maybe (Maybe (TxOut era)))
-> Maybe (Maybe (TxOut era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Maybe (TxOut era)))
  (TxBody TopTx era)
  (Maybe (Maybe (TxOut era)))
forall era.
AnyEraTxBody era =>
SimpleGetter (TxBody TopTx era) (Maybe (Maybe (TxOut era)))
SimpleGetter (TxBody TopTx era) (Maybe (Maybe (TxOut era)))
collateralReturnTxBodyG) of
          Maybe (TxOut era)
Nothing -> Map TxIn (TxOut era)
forall a. Monoid a => a
mempty
          Just TxOut era
txOut -> TxIn -> TxOut era -> Map TxIn (TxOut era)
forall k a. k -> a -> Map k a
Map.singleton (TxBody TopTx era -> TxIn
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxIn
mkCollateralTxIn TxBody TopTx era
txBody) TxOut era
txOut
    Maybe IsPhase2Valid
_ -> TxBody TopTx era -> UTxO era
forall era (l :: TxLevel).
EraTxBody era =>
TxBody l era -> UTxO era
txouts TxBody TopTx era
txBody
  where
    txBody :: TxBody TopTx era
txBody = Tx TopTx era
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL