{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

module Cardano.Api.Experimental.Tx
  ( -- * Creating transactions using the new API

    -- |
    -- Both the old and new APIs can be used to create transactions, and
    -- it is possible to transform a transaction from one format to the other
    -- as they share the same representation. However, the focus will shift
    -- towards using the new API, while the old API will be deprecated to ensure
    -- simplicity, closer alignment with the ledger, and easier maintenance.
    --
    -- In both the new and old APIs, constructing a transaction requires creating
    -- a 'TxBodyContent', along with at least one witness (for example, a
    -- 'ShelleyWitnessSigningKey') to sign the transaction.
    -- This process remains unchanged.
    --
    -- To learn how to create a transaction using the old API, see the
    -- "Cardano.Api.Tx.Internal.Body" documentation.
    --
    -- In the examples below, the following qualified modules are used:
    --
    -- @
    -- import qualified Cardano.Api as Api                -- the general `cardano-api` exports (including the old API)
    -- import qualified Cardano.Api.Script as Script      -- types related to scripts (Plutus and native)
    -- import qualified Cardano.Api.Ledger as Ledger      -- cardano-ledger re-exports
    -- import qualified Cardano.Api.Experimental as Exp   -- the experimental API
    -- @
    --
    -- For instructions on how to do this, refer to the @Test.Cardano.Api.Experimental@ documentation.

    -- ** Creating a 'TxBodyContent'

    -- |
    -- Regardless of whether the experimental or the traditional API is used, creating a 'TxBodyContent'
    -- is necessary.
    --
    -- You can see how to do this in the documentation of the "Cardano.Api.Tx.Internal.Body" module.

    -- ** Balancing a transaction

    -- |
    -- If a UTXO has exactly 12 ada, the transaction could be constructed as described in
    -- "Cardano.Api.Tx.Internal.Body", and it would be valid. However:
    --
    --   * Ada may be wasted
    --   * The UTXO that we intend to spend may not contain exactly 12 ada
    --   * The transaction may not be this simple.
    --
    -- For these reasons, it is recommended to balance the transaction before proceeding with
    -- signing and submitting.
    --
    -- For instructions on how to balance a transaction, refer to the "Cardano.Api.Tx.Internal.Fee" documentation.

    -- ** Creating a 'ShelleyWitnessSigningKey'

    -- |
    -- Signing a transaction requires a witness, such as a 'ShelleyWitnessSigningKey'.
    --
    -- For instructions on creating a 'ShelleyWitnessSigningKey' refer to the "Cardano.Api.Tx.Internal.Sign" documentation.

    -- ** Creating a transaction using the new API

    -- |
    -- This section outlines how to create a transaction using the new API. First,
    -- create an 'UnsignedTx' using the 'makeUnsignedTx' function and the 'Era' and
    -- 'TxBodyContent' that we defined earlier:
    --
    -- @
    -- case Exp.makeUnsignedTx era txBodyContent of
    --   Left err -> error (show err)
    --   Right unsignedTx -> ...
    -- @
    --
    -- Next, use the key witness to sign the unsigned transaction with the 'makeKeyWitness' function:
    --
    -- @
    -- let transactionWitness = Exp.makeKeyWitness era unsignedTx (Api.WitnessPaymentKey signingKey)
    -- @
    --
    -- Finally, sign the transaction using the 'signTx' function:
    --
    -- @
    -- let newApiSignedTx :: Ledger.Tx (Exp.LedgerEra Exp.ConwayEra) = Exp.signTx era [] [transactionWitness] unsignedTx
    -- @
    --
    -- The empty list represents the bootstrap witnesses, which are not needed in this case.
    --
    -- The transaction is now signed.

    -- ** Converting a transaction from the new API to the old API

    -- |
    -- A transaction created with the new API can be easily converted to the old API by
    -- wrapping it with the 'ShelleyTx' constructor:
    --
    -- @
    -- let oldStyleTx :: Api.Tx Api.ConwayEra = ShelleyTx sbe newApiSignedTx
    -- @

    -- ** Inspecting transactions

    -- |
    -- When using a 'Tx' created with the experimental API, the 'TxBody' and
    -- 'TxWits' can be extracted using the 'txBody' and 'txWits' lenses from
    -- "Cardano.Api.Ledger" respectively.

    -- * Contents
    UnsignedTx (..)
  , SignedTx (..)
  , MakeUnsignedTxError (..)
  , makeUnsignedTx
  , makeKeyWitness
  , signTx
  , convertTxBodyToUnsignedTx
  , hashTxBody
  , getUnsignedTxFee

    -- * TxBodyContent

    -- | Body content is one type, 'BodyContent', indexed by the transaction
    -- level. 'TxBodyContent' is a top-level body and 'SubTxBodyContent' is a
    -- Dijkstra sub-transaction body. A setter typed @BodyContent l era@ works
    -- on both; a setter typed @TxBodyContent era@ sets a field that only a
    -- top-level body has.
  , BodyContent (..)
  , TxBodyContent
  , SubTxBodyContent
  , defaultTxBodyContent
  , defaultSubTxBodyContent
  , mkTxCertificates
  , mkTxVotingProcedures
  , mkTxProposalProcedures

    -- ** Fields of a top-level body
  , txIns
  , txInsCollateral
  , txInsReference
  , txOuts
  , txTotalCollateral
  , txReturnCollateral
  , txFee
  , txValidityLowerBound
  , txValidityUpperBound
  , txMetadata
  , txAuxScripts
  , txExtraKeyWits
  , txProtocolParams
  , txWithdrawals
  , txCertificates
  , txMintValue
  , txScriptValidity
  , txProposalProcedures
  , txVotingProcedures
  , txCurrentTreasuryValue
  , txTreasuryDonation
  , txSupplementalDatums
  , txGuards
  , txSubTransactions
  , txRequiredTopLevelGuards
  , txDirectDeposits
  , txAccountBalanceIntervals
  , txStartingAccountBalanceIntervals

    -- ** Fields of a sub-transaction body
  , subTxIns
  , subTxInsReference
  , subTxOuts
  , subTxValidityLowerBound
  , subTxValidityUpperBound
  , subTxMetadata
  , subTxAuxScripts
  , subTxProtocolParams
  , subTxWithdrawals
  , subTxCertificates
  , subTxMintValue
  , subTxProposalProcedures
  , subTxVotingProcedures
  , subTxCurrentTreasuryValue
  , subTxTreasuryDonation
  , subTxSupplementalDatums
  , subTxGuards
  , subTxRequiredTopLevelGuards
  , subTxDirectDeposits
  , subTxAccountBalanceIntervals

    -- ** Setters shared by both levels
  , modTxOuts
  , setTxAuxScripts
  , setTxCertificates
  , setTxCurrentTreasuryValue
  , setTxIns
  , setTxInsReference
  , setTxMetadata
  , setTxMintValue
  , setTxOuts
  , setTxProposalProcedures
  , setTxProtocolParams
  , setTxSupplementalDatums
  , setTxTreasuryDonation
  , setTxValidityLowerBound
  , setTxValidityUpperBound
  , setTxVotingProcedures
  , setTxWithdrawals
  , setTxGuards
  , setTxRequiredTopLevelGuards
  , setTxDirectDeposits
  , setTxAccountBalanceIntervals

    -- ** Setters for top-level bodies only
  , setTxReturnCollateral
  , setTxTotalCollateral
  , setTxExtraKeyWits
  , setTxFee
  , setTxInsCollateral
  , setTxScriptValidity
  , setTxSubTransactions
  , setTxSignedSubTransactions
  , setTxStartingAccountBalanceIntervals

    -- * Sub-transactions (Dijkstra era onwards)
  , UnsignedSubTx (..)
  , SignedSubTx (..)
  , makeUnsignedSubTx
  , makeSubTxKeyWitness
  , signSubTx
  , makeSignedSubTx
  , getUnsignedSubTxId
  , getSignedSubTxId
  , AsType (AsUnsignedSubTx, AsSignedSubTx)

    -- * Ordered guard witnesses
  , TxGuards
  , ScriptGuardWitness (..)
  , TxGuardsError (..)
  , mkTxGuards
  , emptyTxGuards

    -- * TxBodyContent sub type
  , TxCertificates (..)
  , TxMintValue (..)
  , TxOut (..)
  , TxProposalProcedures (..)
  , TxVotingProcedures (..)
  , TxWithdrawals (..)
  , TxReturnCollateral (..)
  , TxTotalCollateral (..)
  , TxExtraKeyWitnesses (..)
  , TxInsReference (..)

    -- * Witness

    -- ** Any witness (key, simple script, plutus script).
  , AnyWitness (..)
  , getAnyWitnessScript
  , getAnyWitnessReferenceInput
  , getAnyWitnessPlutusLanguage
  , getAnyWitnessScriptData

    -- ** All the parts that constitute a plutus script witness but also including simple scripts
  , TxScriptWitnessRequirements (..)

    -- ** Plutus related
  , Datum (..)
  , getDatums
  , extractDatumsAndHashes

    -- ** Collecting plutus script witness related transaction requirements.
  , collectPlutusScriptHashes
  , extractAllIndexedPlutusScriptWitnesses
  , getTxScriptWitnessesRequirements
  , obtainMonoidConstraint

    -- * Transaction evaluation
  , evaluateTransaction
  , evaluateSignedTx
  , TxEvaluationResult (..)
  , evaluateTransactionExecutionUnits

    -- * Balancing transactions
  , calculateMinimumUTxO
  , makeTransactionBodyAutoBalance
  , TxBodyErrorAutoBalance (..)
  , TxFeeEstimationError (..)

    -- ** Internal functions
  , extractExecutionUnits
  , getTxScriptWitnessRequirements
  , extractWitnessableTxIns
  , extractWitnessableMints
  , extractWitnessableCertificates
  , extractWitnessableWithdrawals
  , extractWitnessableVotes
  , extractWitnessableProposals
  )
where

import Cardano.Api.Address (StakeCredential)
import Cardano.Api.Certificate.Internal (PoolId)
import Cardano.Api.Era.Internal.Core qualified as Api
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Experimental.Era
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
import Cardano.Api.Experimental.Tx.Internal.BodyContent
import Cardano.Api.Experimental.Tx.Internal.Fee
import Cardano.Api.Experimental.Tx.Internal.Guard
import Cardano.Api.Experimental.Tx.Internal.SubTransaction
import Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
import Cardano.Api.Experimental.Tx.Internal.Type
import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
import Cardano.Api.Ledger.Internal.Reexport qualified as L
import Cardano.Api.Plutus.Internal.Script qualified as Api
import Cardano.Api.Pretty (docToString, pretty)
import Cardano.Api.Query.Internal.Type.QueryInMode (LedgerEpochInfo, SystemStart)
import Cardano.Api.Serialise.Raw
  ( SerialiseAsRawBytes (..)
  , SerialiseAsRawBytesError (SerialiseAsRawBytesError)
  )
import Cardano.Api.Tx.Internal.Body qualified as Api
import Cardano.Api.Tx.Internal.Sign

import Cardano.Ledger.Alonzo.Core qualified as Ledger
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Binary qualified as Ledger

import Control.Exception (displayException)
import Data.Bifunctor (bimap)
import Data.ByteString.Lazy (fromStrict)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import GHC.Stack
import Lens.Micro

getUnsignedTxFee :: UnsignedTx era -> L.Coin
getUnsignedTxFee :: forall era. UnsignedTx era -> Coin
getUnsignedTxFee (UnsignedTx Tx TopTx era
unsignedTx) =
  let txbody :: TxBody TopTx era
txbody = Tx TopTx era
unsignedTx 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)
L.bodyTxL
   in TxBody TopTx era
txbody TxBody TopTx era -> Getting Coin (TxBody TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx era) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
L.feeTxBodyL

makeKeyWitness
  :: HasCallStack
  => Era era
  -> UnsignedTx (LedgerEra era)
  -> ShelleyWitnessSigningKey
  -> L.WitVKey L.Witness
makeKeyWitness :: forall era.
HasCallStack =>
Era era
-> UnsignedTx (LedgerEra era)
-> ShelleyWitnessSigningKey
-> WitVKey Witness
makeKeyWitness Era era
era (UnsignedTx Tx TopTx (LedgerEra era)
unsignedTx) ShelleyWitnessSigningKey
wsk =
  Era era
-> (EraCommonConstraints era => WitVKey Witness) -> WitVKey Witness
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => WitVKey Witness) -> WitVKey Witness)
-> (EraCommonConstraints era => WitVKey Witness) -> WitVKey Witness
forall a b. (a -> b) -> a -> b
$
    HasCallStack =>
Hash HASH EraIndependentTxBody
-> ShelleyWitnessSigningKey -> WitVKey Witness
Hash HASH EraIndependentTxBody
-> ShelleyWitnessSigningKey -> WitVKey Witness
makeShelleyKeyWitnessFromHash (TxBody TopTx (LedgerEra era) -> Hash HASH EraIndependentTxBody
forall (l :: TxLevel) era.
HashAnnotated (TxBody l era) EraIndependentTxBody =>
TxBody l era -> Hash HASH EraIndependentTxBody
hashTxBody (Tx TopTx (LedgerEra era)
unsignedTx Tx TopTx (LedgerEra era)
-> Getting
     (TxBody TopTx (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (TxBody TopTx (LedgerEra era))
-> TxBody TopTx (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx (LedgerEra era))
  (Tx TopTx (LedgerEra era))
  (TxBody TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxBody l (LedgerEra era))
L.bodyTxL)) ShelleyWitnessSigningKey
wsk

-- | A transaction that has been witnesssed
data SignedTx era
  = L.EraTx (ShelleyLedgerEra era) => SignedTx (Ledger.Tx Ledger.TopTx (ShelleyLedgerEra era))

deriving instance Eq (SignedTx era)

deriving instance Show (SignedTx era)

instance HasTypeProxy era => HasTypeProxy (SignedTx era) where
  data AsType (SignedTx era) = AsSignedTx (AsType era)
  proxyToAsType :: Proxy (SignedTx era) -> AsType (SignedTx era)
  proxyToAsType :: Proxy (SignedTx era) -> AsType (SignedTx era)
proxyToAsType Proxy (SignedTx era)
_ = AsType era -> AsType (SignedTx era)
forall era. AsType era -> AsType (SignedTx era)
AsSignedTx (forall t. HasTypeProxy t => AsType t
asType @era)

instance
  ( HasTypeProxy era
  , L.EraTx (ShelleyLedgerEra era)
  )
  => SerialiseAsRawBytes (SignedTx era)
  where
  serialiseToRawBytes :: SignedTx era -> ByteString
serialiseToRawBytes (SignedTx Tx TopTx (ShelleyLedgerEra era)
tx) =
    Version -> Tx TopTx (ShelleyLedgerEra era) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
Ledger.serialize' (forall era. Era era => Version
Ledger.eraProtVerHigh @(ShelleyLedgerEra era)) Tx TopTx (ShelleyLedgerEra era)
tx
  deserialiseFromRawBytes :: AsType (SignedTx era)
-> ByteString -> Either SerialiseAsRawBytesError (SignedTx era)
deserialiseFromRawBytes AsType (SignedTx era)
_ =
    (DecoderError -> SerialiseAsRawBytesError)
-> (Tx TopTx (ShelleyLedgerEra era) -> SignedTx era)
-> Either DecoderError (Tx TopTx (ShelleyLedgerEra era))
-> Either SerialiseAsRawBytesError (SignedTx era)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DecoderError -> SerialiseAsRawBytesError
wrapError Tx TopTx (ShelleyLedgerEra era) -> SignedTx era
forall era.
EraTx (ShelleyLedgerEra era) =>
Tx TopTx (ShelleyLedgerEra era) -> SignedTx era
SignedTx
      (Either DecoderError (Tx TopTx (ShelleyLedgerEra era))
 -> Either SerialiseAsRawBytesError (SignedTx era))
-> (ByteString
    -> Either DecoderError (Tx TopTx (ShelleyLedgerEra era)))
-> ByteString
-> Either SerialiseAsRawBytesError (SignedTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version
-> Text
-> (forall s.
    Decoder s (Annotator (Tx TopTx (ShelleyLedgerEra era))))
-> ByteString
-> Either DecoderError (Tx TopTx (ShelleyLedgerEra era))
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
Ledger.decodeFullAnnotator
        (forall era. Era era => Version
Ledger.eraProtVerHigh @(ShelleyLedgerEra era))
        Text
"SignedTx"
        Decoder s (Annotator (Tx TopTx (ShelleyLedgerEra era)))
forall s. Decoder s (Annotator (Tx TopTx (ShelleyLedgerEra era)))
forall a s. DecCBOR a => Decoder s a
Ledger.decCBOR
      (ByteString
 -> Either DecoderError (Tx TopTx (ShelleyLedgerEra era)))
-> (ByteString -> ByteString)
-> ByteString
-> Either DecoderError (Tx TopTx (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
   where
    wrapError
      :: Ledger.DecoderError -> SerialiseAsRawBytesError
    wrapError :: DecoderError -> SerialiseAsRawBytesError
wrapError = String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String -> SerialiseAsRawBytesError)
-> (DecoderError -> String)
-> DecoderError
-> SerialiseAsRawBytesError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> String
forall e. Exception e => e -> String
displayException

signTx
  :: Era era
  -> [L.BootstrapWitness]
  -> [L.WitVKey L.Witness]
  -> UnsignedTx (LedgerEra era)
  -> SignedTx era
signTx :: forall era.
Era era
-> [BootstrapWitness]
-> [WitVKey Witness]
-> UnsignedTx (LedgerEra era)
-> SignedTx era
signTx Era era
era [BootstrapWitness]
bootstrapWits [WitVKey Witness]
shelleyKeyWits (UnsignedTx Tx TopTx (LedgerEra era)
unsigned) =
  Era era
-> (EraCommonConstraints era => SignedTx era) -> SignedTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => SignedTx era) -> SignedTx era)
-> (EraCommonConstraints era => SignedTx era) -> SignedTx era
forall a b. (a -> b) -> a -> b
$
    Tx TopTx (ShelleyLedgerEra era) -> SignedTx era
forall era.
EraTx (ShelleyLedgerEra era) =>
Tx TopTx (ShelleyLedgerEra era) -> SignedTx era
SignedTx (Tx TopTx (ShelleyLedgerEra era) -> SignedTx era)
-> Tx TopTx (ShelleyLedgerEra era) -> SignedTx era
forall a b. (a -> b) -> a -> b
$
      [BootstrapWitness]
-> [WitVKey Witness]
-> Tx TopTx (ShelleyLedgerEra era)
-> Tx TopTx (ShelleyLedgerEra era)
forall era (l :: TxLevel).
EraTx era =>
[BootstrapWitness] -> [WitVKey Witness] -> Tx l era -> Tx l era
addKeyWitnesses [BootstrapWitness]
bootstrapWits [WitVKey Witness]
shelleyKeyWits Tx TopTx (ShelleyLedgerEra era)
Tx TopTx (LedgerEra era)
unsigned

-- | Like 'evaluateTransaction' but accepts a 'SignedTx' directly.
evaluateSignedTx
  :: forall era
   . IsEra era
  => SystemStart
  -- ^ Start time of the blockchain
  -> LedgerEpochInfo
  -- ^ Epoch info for slot/time conversions
  -> L.PParams (LedgerEra era)
  -- ^ Protocol parameters
  -> Set PoolId
  -- ^ Registered stake pools
  -> Map StakeCredential L.Coin
  -- ^ Stake delegation deposits
  -> L.UTxO (LedgerEra era)
  -- ^ UTxO set for the transaction inputs
  -> SignedTx era
  -- ^ Signed transaction to evaluate
  -> TxEvaluationResult (LedgerEra era)
evaluateSignedTx :: forall era.
IsEra era =>
SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> UTxO (LedgerEra era)
-> SignedTx era
-> TxEvaluationResult (LedgerEra era)
evaluateSignedTx SystemStart
systemStart LedgerEpochInfo
epochInfo PParams (LedgerEra era)
protocolParams Set PoolId
poolIds Map StakeCredential Coin
stakeDelegDeposits UTxO (LedgerEra era)
utxo (SignedTx Tx TopTx (ShelleyLedgerEra era)
tx) =
  -- obtainCommonConstraints is needed here to bring ShelleyLedgerEra era ~ LedgerEra era
  -- into scope, unifying SignedTx's ShelleyLedgerEra with evaluateTransaction's LedgerEra.
  Era era
-> (EraCommonConstraints era => TxEvaluationResult (LedgerEra era))
-> TxEvaluationResult (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => TxEvaluationResult (LedgerEra era))
 -> TxEvaluationResult (LedgerEra era))
-> (EraCommonConstraints era => TxEvaluationResult (LedgerEra era))
-> TxEvaluationResult (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
    SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> UTxO (LedgerEra era)
-> Tx TopTx (LedgerEra era)
-> TxEvaluationResult (LedgerEra era)
forall era.
IsEra era =>
SystemStart
-> LedgerEpochInfo
-> PParams (LedgerEra era)
-> Set PoolId
-> Map StakeCredential Coin
-> UTxO (LedgerEra era)
-> Tx TopTx (LedgerEra era)
-> TxEvaluationResult (LedgerEra era)
evaluateTransaction
      SystemStart
systemStart
      LedgerEpochInfo
epochInfo
      PParams (LedgerEra era)
protocolParams
      Set PoolId
poolIds
      Map StakeCredential Coin
stakeDelegDeposits
      UTxO (LedgerEra era)
utxo
      Tx TopTx (ShelleyLedgerEra era)
Tx TopTx (LedgerEra era)
tx

-- Compatibility related. Will be removed once the old api has been deprecated and deleted.

convertTxBodyToUnsignedTx
  :: HasCallStack => ShelleyBasedEra era -> TxBody era -> UnsignedTx (LedgerEra era)
convertTxBodyToUnsignedTx :: forall era.
HasCallStack =>
ShelleyBasedEra era -> TxBody era -> UnsignedTx (LedgerEra era)
convertTxBodyToUnsignedTx ShelleyBasedEra era
sbe TxBody era
txbody =
  CardanoEra era
-> UnsignedTx (LedgerEra era)
-> (Era era -> UnsignedTx (LedgerEra era))
-> UnsignedTx (LedgerEra era)
forall (eon :: * -> *) era a.
Eon eon =>
CardanoEra era -> a -> (eon era -> a) -> a
Api.forEraInEon
    (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
Api.toCardanoEra ShelleyBasedEra era
sbe)
    (String -> UnsignedTx (LedgerEra era)
forall a. HasCallStack => String -> a
error (String -> UnsignedTx (LedgerEra era))
-> String -> UnsignedTx (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ String
"convertTxBodyToUnsignedTx: Error - unsupported era " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle -> String
docToString (ShelleyBasedEra era -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
forall ann. ShelleyBasedEra era -> Doc ann
pretty ShelleyBasedEra era
sbe))
    ( \Era era
w -> do
        let ShelleyTx ShelleyBasedEra era
_ Tx TopTx (ShelleyLedgerEra era)
unsignedLedgerTx = [KeyWitness era] -> TxBody era -> Tx era
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [] TxBody era
txbody
        Era era
-> (EraCommonConstraints era => UnsignedTx (LedgerEra era))
-> UnsignedTx (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
w ((EraCommonConstraints era => UnsignedTx (LedgerEra era))
 -> UnsignedTx (LedgerEra era))
-> (EraCommonConstraints era => UnsignedTx (LedgerEra era))
-> UnsignedTx (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ Tx TopTx (LedgerEra era) -> UnsignedTx (LedgerEra era)
forall era. EraTx era => Tx TopTx era -> UnsignedTx era
UnsignedTx Tx TopTx (ShelleyLedgerEra era)
Tx TopTx (LedgerEra era)
unsignedLedgerTx
    )

-- | Collect all plutus script hashes that are needed to validate the given transaction
-- and return them in a map with their corresponding 'ScriptWitnessIndex' as key.
collectPlutusScriptHashes
  :: forall era
   . IsEra era
  => UnsignedTx (LedgerEra era)
  -> L.UTxO (LedgerEra era)
  -> Map Api.ScriptWitnessIndex Api.ScriptHash
collectPlutusScriptHashes :: forall era.
IsEra era =>
UnsignedTx (LedgerEra era)
-> UTxO (LedgerEra era) -> Map ScriptWitnessIndex ScriptHash
collectPlutusScriptHashes (UnsignedTx Tx TopTx (LedgerEra era)
tx) UTxO (LedgerEra era)
utxo =
  let AlonzoScriptsNeeded (LedgerEra era)
sNeeded :: L.AlonzoScriptsNeeded (LedgerEra era) = Era era
-> (EraCommonConstraints era =>
    AlonzoScriptsNeeded (LedgerEra era))
-> AlonzoScriptsNeeded (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => AlonzoScriptsNeeded (LedgerEra era))
 -> AlonzoScriptsNeeded (LedgerEra era))
-> (EraCommonConstraints era =>
    AlonzoScriptsNeeded (LedgerEra era))
-> AlonzoScriptsNeeded (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ UTxO (LedgerEra era)
-> TxBody TopTx (LedgerEra era) -> ScriptsNeeded (LedgerEra era)
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> TxBody t era -> ScriptsNeeded era
forall (t :: TxLevel).
UTxO (LedgerEra era)
-> TxBody t (LedgerEra era) -> ScriptsNeeded (LedgerEra era)
L.getScriptsNeeded UTxO (LedgerEra era)
utxo (Tx TopTx (LedgerEra era)
tx Tx TopTx (LedgerEra era)
-> Getting
     (TxBody TopTx (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (TxBody TopTx (LedgerEra era))
-> TxBody TopTx (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx (LedgerEra era))
  (Tx TopTx (LedgerEra era))
  (TxBody TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxBody l (LedgerEra era))
L.bodyTxL)
   in forall era.
IsEra era =>
AlonzoScriptsNeeded (LedgerEra era)
-> Map ScriptWitnessIndex ScriptHash
getPurposes @era AlonzoScriptsNeeded (LedgerEra era)
sNeeded

getPurposes
  :: forall era
   . IsEra era
  => L.AlonzoScriptsNeeded (LedgerEra era)
  -> Map Api.ScriptWitnessIndex Api.ScriptHash
getPurposes :: forall era.
IsEra era =>
AlonzoScriptsNeeded (LedgerEra era)
-> Map ScriptWitnessIndex ScriptHash
getPurposes (L.AlonzoScriptsNeeded [(PlutusPurpose AsIxItem (LedgerEra era), ScriptHash)]
purposes) =
  [(ScriptWitnessIndex, ScriptHash)]
-> Map ScriptWitnessIndex ScriptHash
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ScriptWitnessIndex, ScriptHash)]
 -> Map ScriptWitnessIndex ScriptHash)
-> [(ScriptWitnessIndex, ScriptHash)]
-> Map ScriptWitnessIndex ScriptHash
forall a b. (a -> b) -> a -> b
$
    ((PlutusPurpose AsIxItem (LedgerEra era), ScriptHash)
 -> (ScriptWitnessIndex, ScriptHash))
-> [(PlutusPurpose AsIxItem (LedgerEra era), ScriptHash)]
-> [(ScriptWitnessIndex, ScriptHash)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map
      ( (PlutusPurpose AsIxItem (LedgerEra era) -> ScriptWitnessIndex)
-> (ScriptHash -> ScriptHash)
-> (PlutusPurpose AsIxItem (LedgerEra era), ScriptHash)
-> (ScriptWitnessIndex, ScriptHash)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
          ( Era era
-> (EraCommonConstraints era =>
    PlutusPurpose AsIxItem (LedgerEra era) -> ScriptWitnessIndex)
-> PlutusPurpose AsIxItem (LedgerEra era)
-> ScriptWitnessIndex
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era =>
  PlutusPurpose AsIxItem (LedgerEra era) -> ScriptWitnessIndex)
 -> PlutusPurpose AsIxItem (LedgerEra era) -> ScriptWitnessIndex)
-> (EraCommonConstraints era =>
    PlutusPurpose AsIxItem (LedgerEra era) -> ScriptWitnessIndex)
-> PlutusPurpose AsIxItem (LedgerEra era)
-> ScriptWitnessIndex
forall a b. (a -> b) -> a -> b
$
              AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
Api.toScriptIndex (Era era -> AlonzoEraOnwards era
forall era. Era era -> AlonzoEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (forall era. IsEra era => Era era
useEra @era))
                (PlutusPurpose AsIx (LedgerEra era) -> ScriptWitnessIndex)
-> (PlutusPurpose AsIxItem (LedgerEra era)
    -> PlutusPurpose AsIx (LedgerEra era))
-> PlutusPurpose AsIxItem (LedgerEra era)
-> ScriptWitnessIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusPurpose AsIxItem (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
forall era.
IsEra era =>
PlutusPurpose AsIxItem (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
purposeAsIxItemToAsIx
          )
          ScriptHash -> ScriptHash
Api.fromShelleyScriptHash
      )
      [(PlutusPurpose AsIxItem (LedgerEra era), ScriptHash)]
purposes

purposeAsIxItemToAsIx
  :: forall era
   . IsEra era
  => L.PlutusPurpose L.AsIxItem (LedgerEra era)
  -> L.PlutusPurpose L.AsIx (LedgerEra era)
purposeAsIxItemToAsIx :: forall era.
IsEra era =>
PlutusPurpose AsIxItem (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
purposeAsIxItemToAsIx PlutusPurpose AsIxItem (LedgerEra era)
purpose =
  Era era
-> (EraCommonConstraints era => PlutusPurpose AsIx (LedgerEra era))
-> PlutusPurpose AsIx (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => PlutusPurpose AsIx (LedgerEra era))
 -> PlutusPurpose AsIx (LedgerEra era))
-> (EraCommonConstraints era => PlutusPurpose AsIx (LedgerEra era))
-> PlutusPurpose AsIx (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ (forall ix it. AsIxItem ix it -> AsIx ix it)
-> PlutusPurpose AsIxItem (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g (LedgerEra era)
-> PlutusPurpose f (LedgerEra era)
L.hoistPlutusPurpose AsIxItem ix it -> AsIx ix it
forall ix it. AsIxItem ix it -> AsIx ix it
L.toAsIx PlutusPurpose AsIxItem (LedgerEra era)
purpose