{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableSuperClasses #-}

-- | 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 (isValidTxG),
  producedTxOuts,

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

  -- * Alonzo onwards
  AlonzoEraTx,
  isValidTxL,
  IsValid (..),

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

  -- * Upgrade
  binaryUpgradeTx,
  upgradeTx,
) where

import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), 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
  isValidTxG :: SimpleGetter (Tx TopTx era) (Maybe IsValid)
  default isValidTxG :: AlonzoEraTx era => SimpleGetter (Tx TopTx era) (Maybe IsValid)
  isValidTxG = (IsValid -> Const r IsValid)
-> Tx TopTx era -> Const r (Tx TopTx era)
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx era) IsValid
isValidTxL ((IsValid -> Const r IsValid)
 -> Tx TopTx era -> Const r (Tx TopTx era))
-> ((Maybe IsValid -> Const r (Maybe IsValid))
    -> IsValid -> Const r IsValid)
-> (Maybe IsValid -> Const r (Maybe IsValid))
-> Tx TopTx era
-> Const r (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsValid -> Maybe IsValid) -> SimpleGetter IsValid (Maybe IsValid)
forall s a. (s -> a) -> SimpleGetter s a
to IsValid -> Maybe IsValid
forall a. a -> Maybe a
Just

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

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

instance AnyEraTx MaryEra where
  isValidTxG :: SimpleGetter (Tx TopTx MaryEra) (Maybe IsValid)
isValidTxG = (Tx TopTx MaryEra -> Maybe IsValid)
-> SimpleGetter (Tx TopTx MaryEra) (Maybe IsValid)
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe IsValid -> Tx TopTx MaryEra -> Maybe IsValid
forall a b. a -> b -> a
const Maybe IsValid
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 IsValid) (Tx TopTx era) (Maybe IsValid)
-> Maybe IsValid
forall s a. s -> Getting a s a -> a
^. Getting (Maybe IsValid) (Tx TopTx era) (Maybe IsValid)
forall era.
AnyEraTx era =>
SimpleGetter (Tx TopTx era) (Maybe IsValid)
SimpleGetter (Tx TopTx era) (Maybe IsValid)
isValidTxG of
    Just (IsValid Bool
False) ->
      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 IsValid
_ -> 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