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

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:
    --
    -- @
    -- let (Right unsignedTx) = Exp.makeUnsignedTx era txBodyContent
    -- @
    --
    -- 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 (..)
  , makeUnsignedTx
  , makeKeyWitness
  , signTx
  , convertTxBodyToUnsignedTx
  , hashTxBody
  , getUnsignedTxFee

    -- * TxBodyContent
  , TxBodyContent (..)
  , defaultTxBodyContent
  , mkTxCertificates
  , mkTxVotingProcedures
  , mkTxProposalProcedures
  , modTxOuts
  , setTxAuxScripts
  , setTxCertificates
  , setTxReturnCollateral
  , setTxTotalCollateral
  , setTxCurrentTreasuryValue
  , setTxExtraKeyWits
  , setTxFee
  , setTxIns
  , setTxInsCollateral
  , setTxInsReference
  , setTxMetadata
  , setTxMintValue
  , setTxOuts
  , setTxProposalProcedures
  , setTxProtocolParams
  , setTxScriptValidity
  , setTxTreasuryDonation
  , setTxValidityLowerBound
  , setTxValidityUpperBound
  , setTxVotingProcedures
  , setTxWithdrawals

    -- * Legacy Conversions
  , legacyDatumToDatum
  , fromLegacyTxOut

    -- * 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 (..)

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

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

    -- ** Internal functions
  , extractExecutionUnits
  , getTxScriptWitnessRequirements
  )
where

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.New
import Cardano.Api.Experimental.Tx.Internal.Fee
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.ProtocolParameters
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.Crypto.Hash qualified as Hash
import Cardano.Ledger.Alonzo.Tx qualified as L
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Binary qualified as Ledger
import Cardano.Ledger.Core qualified as Ledger
import Cardano.Ledger.Hashes qualified as L hiding (Hash)

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 qualified as Set
import GHC.Stack
import Lens.Micro

getUnsignedTxFee :: UnsignedTx era -> L.Coin
getUnsignedTxFee :: forall era. UnsignedTx era -> Coin
getUnsignedTxFee (UnsignedTx Tx (LedgerEra era)
unsignedTx) =
  let txbody :: TxBody (LedgerEra era)
txbody = Tx (LedgerEra era)
unsignedTx Tx (LedgerEra era)
-> Getting
     (TxBody (LedgerEra era))
     (Tx (LedgerEra era))
     (TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody (LedgerEra era))
  (Tx (LedgerEra era))
  (TxBody (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (LedgerEra era)) (TxBody (LedgerEra era))
L.bodyTxL
   in TxBody (LedgerEra era)
txbody TxBody (LedgerEra era)
-> Getting Coin (TxBody (LedgerEra era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody (LedgerEra era)) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (LedgerEra era)) Coin
L.feeTxBodyL

hashTxBody
  :: L.HashAnnotated (Ledger.TxBody era) L.EraIndependentTxBody
  => L.TxBody era -> Hash.Hash L.HASH L.EraIndependentTxBody
hashTxBody :: forall era.
HashAnnotated (TxBody era) EraIndependentTxBody =>
TxBody era -> Hash HASH EraIndependentTxBody
hashTxBody = SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
L.extractHash (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody)
-> (TxBody era -> SafeHash EraIndependentTxBody)
-> TxBody era
-> Hash HASH EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
L.hashAnnotated

makeKeyWitness
  :: Era era
  -> UnsignedTx era
  -> ShelleyWitnessSigningKey
  -> L.WitVKey L.Witness
makeKeyWitness :: forall era.
Era era
-> UnsignedTx era -> ShelleyWitnessSigningKey -> WitVKey 'Witness
makeKeyWitness Era era
era (UnsignedTx Tx (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
$
    let txbody :: TxBody (LedgerEra era)
txbody = Tx (LedgerEra era)
unsignedTx Tx (LedgerEra era)
-> Getting
     (TxBody (LedgerEra era))
     (Tx (LedgerEra era))
     (TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody (LedgerEra era))
  (Tx (LedgerEra era))
  (TxBody (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (LedgerEra era)) (TxBody (LedgerEra era))
L.bodyTxL
        txhash :: Hash.Hash L.HASH L.EraIndependentTxBody
        txhash :: Hash HASH EraIndependentTxBody
txhash = Era era
-> (EraCommonConstraints era => Hash HASH EraIndependentTxBody)
-> Hash HASH EraIndependentTxBody
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => Hash HASH EraIndependentTxBody)
 -> Hash HASH EraIndependentTxBody)
-> (EraCommonConstraints era => Hash HASH EraIndependentTxBody)
-> Hash HASH EraIndependentTxBody
forall a b. (a -> b) -> a -> b
$ TxBody (LedgerEra era) -> Hash HASH EraIndependentTxBody
forall era.
HashAnnotated (TxBody era) EraIndependentTxBody =>
TxBody era -> Hash HASH EraIndependentTxBody
hashTxBody TxBody (LedgerEra era)
txbody
        sk :: ShelleySigningKey
sk = ShelleyWitnessSigningKey -> ShelleySigningKey
toShelleySigningKey ShelleyWitnessSigningKey
wsk
        vk :: VKey 'Witness
vk = ShelleySigningKey -> VKey 'Witness
getShelleyKeyWitnessVerificationKey ShelleySigningKey
sk
        signature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature = Hash HASH EraIndependentTxBody
-> ShelleySigningKey
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
forall tosign.
SignableRepresentation tosign =>
tosign -> ShelleySigningKey -> SignedDSIGN DSIGN tosign
makeShelleySignature Hash HASH EraIndependentTxBody
txhash ShelleySigningKey
sk
     in VKey 'Witness
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> WitVKey 'Witness
forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
L.WitVKey VKey 'Witness
vk SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature

-- | A transaction that has been witnesssed
data SignedTx era
  = L.EraTx (LedgerEra era) => SignedTx (Ledger.Tx (LedgerEra 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 (LedgerEra era)
  )
  => SerialiseAsRawBytes (SignedTx era)
  where
  serialiseToRawBytes :: SignedTx era -> ByteString
serialiseToRawBytes (SignedTx Tx (LedgerEra era)
tx) =
    Version -> Tx (LedgerEra era) -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
Ledger.serialize' (forall era. Era era => Version
Ledger.eraProtVerHigh @(LedgerEra era)) Tx (LedgerEra era)
tx
  deserialiseFromRawBytes :: AsType (SignedTx era)
-> ByteString -> Either SerialiseAsRawBytesError (SignedTx era)
deserialiseFromRawBytes AsType (SignedTx era)
_ =
    (DecoderError -> SerialiseAsRawBytesError)
-> (Tx (LedgerEra era) -> SignedTx era)
-> Either DecoderError (Tx (LedgerEra 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 (LedgerEra era) -> SignedTx era
forall era.
EraTx (LedgerEra era) =>
Tx (LedgerEra era) -> SignedTx era
SignedTx
      (Either DecoderError (Tx (LedgerEra era))
 -> Either SerialiseAsRawBytesError (SignedTx era))
-> (ByteString -> Either DecoderError (Tx (LedgerEra era)))
-> ByteString
-> Either SerialiseAsRawBytesError (SignedTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version
-> Text
-> (forall s. Decoder s (Annotator (Tx (LedgerEra era))))
-> ByteString
-> Either DecoderError (Tx (LedgerEra era))
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
Ledger.decodeFullAnnotator
        (forall era. Era era => Version
Ledger.eraProtVerHigh @(LedgerEra era))
        Text
"SignedTx"
        Decoder s (Annotator (Tx (LedgerEra era)))
forall s. Decoder s (Annotator (Tx (LedgerEra era)))
forall a s. DecCBOR a => Decoder s a
Ledger.decCBOR
      (ByteString -> Either DecoderError (Tx (LedgerEra era)))
-> (ByteString -> ByteString)
-> ByteString
-> Either DecoderError (Tx (LedgerEra 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 era
  -> SignedTx era
signTx :: forall era.
Era era
-> [BootstrapWitness]
-> [WitVKey 'Witness]
-> UnsignedTx era
-> SignedTx era
signTx Era era
era [BootstrapWitness]
bootstrapWits [WitVKey 'Witness]
shelleyKeyWits (UnsignedTx Tx (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
$
    let currentScriptWitnesses :: TxWits (LedgerEra era)
currentScriptWitnesses = Tx (LedgerEra era)
unsigned Tx (LedgerEra era)
-> Getting
     (TxWits (LedgerEra era))
     (Tx (LedgerEra era))
     (TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxWits (LedgerEra era))
  (Tx (LedgerEra era))
  (TxWits (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (LedgerEra era)) (TxWits (LedgerEra era))
L.witsTxL
        keyWits :: TxWits (LedgerEra era)
keyWits =
          Era era
-> (EraCommonConstraints era => TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => TxWits (LedgerEra era))
 -> TxWits (LedgerEra era))
-> (EraCommonConstraints era => TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
            TxWits (LedgerEra era)
forall era. EraTxWits era => TxWits era
L.mkBasicTxWits
              TxWits (LedgerEra era)
-> (TxWits (LedgerEra era) -> TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
-> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits (LedgerEra era)) (Set (WitVKey 'Witness))
L.addrTxWitsL
                ((Set (WitVKey 'Witness) -> Identity (Set (WitVKey 'Witness)))
 -> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Set (WitVKey 'Witness)
-> TxWits (LedgerEra era)
-> TxWits (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WitVKey 'Witness] -> Set (WitVKey 'Witness)
forall a. Ord a => [a] -> Set a
Set.fromList [WitVKey 'Witness]
shelleyKeyWits
              TxWits (LedgerEra era)
-> (TxWits (LedgerEra era) -> TxWits (LedgerEra era))
-> TxWits (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits (LedgerEra era)) (Set BootstrapWitness)
L.bootAddrTxWitsL
                ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
 -> TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Set BootstrapWitness
-> TxWits (LedgerEra era)
-> TxWits (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [BootstrapWitness] -> Set BootstrapWitness
forall a. Ord a => [a] -> Set a
Set.fromList [BootstrapWitness]
bootstrapWits
        signedTx :: Tx (LedgerEra era)
signedTx = Tx (LedgerEra era)
unsigned Tx (LedgerEra era)
-> (Tx (LedgerEra era) -> Tx (LedgerEra era)) -> Tx (LedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
-> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (LedgerEra era)) (TxWits (LedgerEra era))
L.witsTxL ((TxWits (LedgerEra era) -> Identity (TxWits (LedgerEra era)))
 -> Tx (LedgerEra era) -> Identity (Tx (LedgerEra era)))
-> TxWits (LedgerEra era)
-> Tx (LedgerEra era)
-> Tx (LedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TxWits (LedgerEra era)
keyWits TxWits (LedgerEra era)
-> TxWits (LedgerEra era) -> TxWits (LedgerEra era)
forall a. Semigroup a => a -> a -> a
<> TxWits (LedgerEra era)
currentScriptWitnesses)
     in Tx (LedgerEra era) -> SignedTx era
forall era.
EraTx (LedgerEra era) =>
Tx (LedgerEra era) -> SignedTx era
SignedTx Tx (LedgerEra era)
signedTx

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

convertTxBodyToUnsignedTx
  :: HasCallStack => ShelleyBasedEra era -> TxBody era -> UnsignedTx era
convertTxBodyToUnsignedTx :: forall era.
HasCallStack =>
ShelleyBasedEra era -> TxBody era -> UnsignedTx era
convertTxBodyToUnsignedTx ShelleyBasedEra era
sbe TxBody era
txbody =
  CardanoEra era
-> UnsignedTx era -> (Era era -> UnsignedTx era) -> UnsignedTx 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 era
forall a. HasCallStack => String -> a
error (String -> UnsignedTx era) -> String -> UnsignedTx 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 (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 era) -> UnsignedTx era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
w ((EraCommonConstraints era => UnsignedTx era) -> UnsignedTx era)
-> (EraCommonConstraints era => UnsignedTx era) -> UnsignedTx era
forall a b. (a -> b) -> a -> b
$ Tx (LedgerEra era) -> UnsignedTx era
forall era.
EraTx (LedgerEra era) =>
Tx (LedgerEra era) -> UnsignedTx era
UnsignedTx Tx (ShelleyLedgerEra era)
Tx (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 era
  -> L.UTxO (LedgerEra era)
  -> Map Api.ScriptWitnessIndex Api.ScriptHash
collectPlutusScriptHashes :: forall era.
IsEra era =>
UnsignedTx era
-> UTxO (LedgerEra era) -> Map ScriptWitnessIndex ScriptHash
collectPlutusScriptHashes (UnsignedTx Tx (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 (LedgerEra era) -> ScriptsNeeded (LedgerEra era)
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
L.getScriptsNeeded UTxO (LedgerEra era)
utxo (Tx (LedgerEra era)
tx Tx (LedgerEra era)
-> Getting
     (TxBody (LedgerEra era))
     (Tx (LedgerEra era))
     (TxBody (LedgerEra era))
-> TxBody (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody (LedgerEra era))
  (Tx (LedgerEra era))
  (TxBody (LedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (LedgerEra era)) (TxBody (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
          ( \PlutusPurpose AsIxItem (LedgerEra era)
pp ->
              Era era
-> (EraCommonConstraints era => ScriptWitnessIndex)
-> ScriptWitnessIndex
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) ((EraCommonConstraints era => ScriptWitnessIndex)
 -> ScriptWitnessIndex)
-> (EraCommonConstraints era => ScriptWitnessIndex)
-> 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 (ShelleyLedgerEra era) -> ScriptWitnessIndex)
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
forall a b. (a -> b) -> a -> b
$
                  PlutusPurpose AsIxItem (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
forall era.
IsEra era =>
PlutusPurpose AsIxItem (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
purposeAsIxItemToAsIx PlutusPurpose AsIxItem (LedgerEra era)
pp
          )
          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