{-# 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 -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
--                & 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 (..), 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 era) (Maybe IsValid)
  default isValidTxG :: AlonzoEraTx era => SimpleGetter (Tx era) (Maybe IsValid)
  isValidTxG = (IsValid -> Const r IsValid) -> Tx era -> Const r (Tx era)
forall era. AlonzoEraTx era => Lens' (Tx era) IsValid
Lens' (Tx era) IsValid
isValidTxL ((IsValid -> Const r IsValid) -> Tx era -> Const r (Tx era))
-> ((Maybe IsValid -> Const r (Maybe IsValid))
    -> IsValid -> Const r IsValid)
-> (Maybe IsValid -> Const r (Maybe IsValid))
-> Tx era
-> Const r (Tx 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 ShelleyEra) (Maybe IsValid)
isValidTxG = (Tx ShelleyEra -> Maybe IsValid)
-> SimpleGetter (Tx ShelleyEra) (Maybe IsValid)
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe IsValid -> Tx ShelleyEra -> Maybe IsValid
forall a b. a -> b -> a
const Maybe IsValid
forall a. Maybe a
Nothing)

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

instance AnyEraTx MaryEra where
  isValidTxG :: SimpleGetter (Tx MaryEra) (Maybe IsValid)
isValidTxG = (Tx MaryEra -> Maybe IsValid)
-> SimpleGetter (Tx MaryEra) (Maybe IsValid)
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe IsValid -> Tx 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 era -> UTxO era
producedTxOuts :: forall era. AnyEraTx era => Tx era -> UTxO era
producedTxOuts Tx era
tx =
  case Tx era
tx Tx era
-> Getting (Maybe IsValid) (Tx era) (Maybe IsValid)
-> Maybe IsValid
forall s a. s -> Getting a s a -> a
^. Getting (Maybe IsValid) (Tx era) (Maybe IsValid)
forall era. AnyEraTx era => SimpleGetter (Tx era) (Maybe IsValid)
SimpleGetter (Tx 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 era
txBody TxBody era
-> Getting
     (Maybe (Maybe (TxOut era)))
     (TxBody era)
     (Maybe (Maybe (TxOut era)))
-> Maybe (Maybe (TxOut era))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Maybe (TxOut era)))
  (TxBody era)
  (Maybe (Maybe (TxOut era)))
forall era.
AnyEraTxBody era =>
SimpleGetter (TxBody era) (Maybe (Maybe (TxOut era)))
SimpleGetter (TxBody 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 era -> TxIn
forall era. EraTxBody era => TxBody era -> TxIn
mkCollateralTxIn TxBody era
txBody) TxOut era
txOut
    Maybe IsValid
_ -> TxBody era -> UTxO era
forall era. EraTxBody era => TxBody era -> UTxO era
txouts TxBody era
txBody
  where
    txBody :: TxBody era
txBody = Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL