-- | This modules exposes entry points to convert a 'TxSkel' into a fully
-- fledged transaction body
module Cooked.MockChain.GenerateTx.Body
  ( txSkelToTxBody,
    txBodyContentToTxBody,
    txSkelToTxBodyContent,
    txSkelToIndex,
    txSignatoriesAndBodyToCardanoTx,
    txSkelToCardanoTx,
  )
where

import Cardano.Api qualified as Cardano
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Monad
import Cooked.MockChain.Common
import Cooked.MockChain.Error
import Cooked.MockChain.GenerateTx.Certificate
import Cooked.MockChain.GenerateTx.Collateral
import Cooked.MockChain.GenerateTx.Input
import Cooked.MockChain.GenerateTx.Mint
import Cooked.MockChain.GenerateTx.Output
import Cooked.MockChain.GenerateTx.Proposal
import Cooked.MockChain.GenerateTx.ReferenceInputs
import Cooked.MockChain.GenerateTx.Withdrawals
import Cooked.MockChain.GenerateTx.Witness
import Cooked.MockChain.Read
import Cooked.Skeleton
import Data.Map qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import Ledger.Address qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import Plutus.Script.Utils.Address qualified as Script
import Polysemy
import Polysemy.Error
import Polysemy.Fail

-- | Generates a body content from a skeleton
txSkelToTxBodyContent ::
  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
  TxSkel ->
  Fee ->
  Maybe Collaterals ->
  Sem effs (Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra)
txSkelToTxBodyContent :: forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError, Fail]
  effs =>
TxSkel
-> Fee
-> Maybe Collaterals
-> Sem effs (TxBodyContent BuildTx ConwayEra)
txSkelToTxBodyContent skel :: TxSkel
skel@TxSkel {[TxSkelSignatory]
[TxSkelProposal]
[TxSkelCertificate]
[TxSkelOut]
Set TxOutRef
Set TxSkelLabel
Map TxOutRef TxSkelRedeemer
SlotRange
TxSkelOpts
TxSkelWithdrawals
TxSkelMints
txSkelLabels :: Set TxSkelLabel
txSkelOpts :: TxSkelOpts
txSkelMints :: TxSkelMints
txSkelSignatories :: [TxSkelSignatory]
txSkelValidityRange :: SlotRange
txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelInsReference :: Set TxOutRef
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: TxSkelWithdrawals
txSkelCertificates :: [TxSkelCertificate]
txSkelLabels :: TxSkel -> Set TxSkelLabel
txSkelOpts :: TxSkel -> TxSkelOpts
txSkelMints :: TxSkel -> TxSkelMints
txSkelSignatories :: TxSkel -> [TxSkelSignatory]
txSkelValidityRange :: TxSkel -> SlotRange
txSkelIns :: TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelInsReference :: TxSkel -> Set TxOutRef
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelWithdrawals :: TxSkel -> TxSkelWithdrawals
txSkelCertificates :: TxSkel -> [TxSkelCertificate]
..} Fee
fee Maybe Collaterals
mCollaterals = do
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
txIns <- ((TxOutRef, TxSkelRedeemer)
 -> Sem
      effs (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)))
-> [(TxOutRef, TxSkelRedeemer)]
-> Sem
     effs [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TxOutRef, TxSkelRedeemer)
-> Sem
     effs (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
(TxOutRef, TxSkelRedeemer)
-> Sem
     effs (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
toTxInAndWitness ([(TxOutRef, TxSkelRedeemer)]
 -> Sem
      effs [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))])
-> [(TxOutRef, TxSkelRedeemer)]
-> Sem
     effs [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxOutRef TxSkelRedeemer
txSkelIns
  TxInsReference BuildTx ConwayEra
txInsReference <- TxSkel -> Sem effs (TxInsReference BuildTx ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkel -> Sem effs (TxInsReference BuildTx ConwayEra)
toInsReference TxSkel
skel
  (TxInsCollateral ConwayEra
txInsCollateral, TxTotalCollateral ConwayEra
txTotalCollateral, TxReturnCollateral CtxTx ConwayEra
txReturnCollateral) <- Maybe Collaterals
-> Sem
     effs
     (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
Maybe Collaterals
-> Sem
     effs
     (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
toCollateralTriplet Maybe Collaterals
mCollaterals
  [TxOut CtxTx ConwayEra]
txOuts <- (TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra))
-> [TxSkelOut] -> Sem effs [TxOut CtxTx ConwayEra]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
toCardanoTxOut [TxSkelOut]
txSkelOuts
  (TxValidityLowerBound ConwayEra
txValidityLowerBound, TxValidityUpperBound ConwayEra
txValidityUpperBound) <- Either
  ToCardanoError
  (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
-> Sem
     effs
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either
   ToCardanoError
   (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
 -> Sem
      effs
      (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra))
-> Either
     ToCardanoError
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
-> Sem
     effs
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
forall a b. (a -> b) -> a -> b
$ SlotRange
-> Either
     ToCardanoError
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
Ledger.toCardanoValidityRange SlotRange
txSkelValidityRange
  TxMintValue BuildTx ConwayEra
txMintValue <- TxSkelMints -> Sem effs (TxMintValue BuildTx ConwayEra)
forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
TxSkelMints -> Sem effs (TxMintValue BuildTx ConwayEra)
toMintValue TxSkelMints
txSkelMints
  TxExtraKeyWitnesses ConwayEra
txExtraKeyWits <-
    if [TxSkelSignatory] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxSkelSignatory]
txSkelSignatories
      then TxExtraKeyWitnesses ConwayEra
-> Sem effs (TxExtraKeyWitnesses ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxExtraKeyWitnesses ConwayEra
forall era. TxExtraKeyWitnesses era
Cardano.TxExtraKeyWitnessesNone
      else
        AlonzoEraOnwards ConwayEra
-> [Hash PaymentKey] -> TxExtraKeyWitnesses ConwayEra
forall era.
AlonzoEraOnwards era
-> [Hash PaymentKey] -> TxExtraKeyWitnesses era
Cardano.TxExtraKeyWitnesses AlonzoEraOnwards ConwayEra
Cardano.AlonzoEraOnwardsConway
          ([Hash PaymentKey] -> TxExtraKeyWitnesses ConwayEra)
-> Sem effs [Hash PaymentKey]
-> Sem effs (TxExtraKeyWitnesses ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ToCardanoError [Hash PaymentKey]
-> Sem effs [Hash PaymentKey]
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither
            ((TxSkelSignatory -> Either ToCardanoError (Hash PaymentKey))
-> [TxSkelSignatory] -> Either ToCardanoError [Hash PaymentKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PaymentPubKeyHash -> Either ToCardanoError (Hash PaymentKey)
Ledger.toCardanoPaymentKeyHash (PaymentPubKeyHash -> Either ToCardanoError (Hash PaymentKey))
-> (TxSkelSignatory -> PaymentPubKeyHash)
-> TxSkelSignatory
-> Either ToCardanoError (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyHash -> PaymentPubKeyHash
Ledger.PaymentPubKeyHash (PubKeyHash -> PaymentPubKeyHash)
-> (TxSkelSignatory -> PubKeyHash)
-> TxSkelSignatory
-> PaymentPubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelSignatory -> PubKeyHash
forall a. ToPubKeyHash a => a -> PubKeyHash
Script.toPubKeyHash) [TxSkelSignatory]
txSkelSignatories)
  BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
txProtocolParams <- Maybe (LedgerProtocolParameters ConwayEra)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith (Maybe (LedgerProtocolParameters ConwayEra)
 -> BuildTxWith
      BuildTx (Maybe (LedgerProtocolParameters ConwayEra)))
-> (Params -> Maybe (LedgerProtocolParameters ConwayEra))
-> Params
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerProtocolParameters ConwayEra
-> Maybe (LedgerProtocolParameters ConwayEra)
forall a. a -> Maybe a
Just (LedgerProtocolParameters ConwayEra
 -> Maybe (LedgerProtocolParameters ConwayEra))
-> (Params -> LedgerProtocolParameters ConwayEra)
-> Params
-> Maybe (LedgerProtocolParameters ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> LedgerProtocolParameters ConwayEra
Emulator.ledgerProtocolParameters (Params
 -> BuildTxWith
      BuildTx (Maybe (LedgerProtocolParameters ConwayEra)))
-> Sem effs Params
-> Sem
     effs
     (BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
  Maybe
  (Featured
     ConwayEraOnwards
     ConwayEra
     (TxProposalProcedures BuildTx ConwayEra))
txProposalProcedures <- Featured
  ConwayEraOnwards ConwayEra (TxProposalProcedures BuildTx ConwayEra)
-> Maybe
     (Featured
        ConwayEraOnwards
        ConwayEra
        (TxProposalProcedures BuildTx ConwayEra))
forall a. a -> Maybe a
Just (Featured
   ConwayEraOnwards ConwayEra (TxProposalProcedures BuildTx ConwayEra)
 -> Maybe
      (Featured
         ConwayEraOnwards
         ConwayEra
         (TxProposalProcedures BuildTx ConwayEra)))
-> (TxProposalProcedures BuildTx ConwayEra
    -> Featured
         ConwayEraOnwards
         ConwayEra
         (TxProposalProcedures BuildTx ConwayEra))
-> TxProposalProcedures BuildTx ConwayEra
-> Maybe
     (Featured
        ConwayEraOnwards
        ConwayEra
        (TxProposalProcedures BuildTx ConwayEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayEraOnwards ConwayEra
-> TxProposalProcedures BuildTx ConwayEra
-> Featured
     ConwayEraOnwards ConwayEra (TxProposalProcedures BuildTx ConwayEra)
forall (eon :: * -> *) era a. eon era -> a -> Featured eon era a
Cardano.Featured ConwayEraOnwards ConwayEra
Cardano.ConwayEraOnwardsConway (TxProposalProcedures BuildTx ConwayEra
 -> Maybe
      (Featured
         ConwayEraOnwards
         ConwayEra
         (TxProposalProcedures BuildTx ConwayEra)))
-> Sem effs (TxProposalProcedures BuildTx ConwayEra)
-> Sem
     effs
     (Maybe
        (Featured
           ConwayEraOnwards
           ConwayEra
           (TxProposalProcedures BuildTx ConwayEra)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSkelProposal]
-> Sem effs (TxProposalProcedures BuildTx ConwayEra)
forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
[TxSkelProposal]
-> Sem effs (TxProposalProcedures BuildTx ConwayEra)
toProposalProcedures [TxSkelProposal]
txSkelProposals
  TxWithdrawals BuildTx ConwayEra
txWithdrawals <- TxSkelWithdrawals -> Sem effs (TxWithdrawals BuildTx ConwayEra)
forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
TxSkelWithdrawals -> Sem effs (TxWithdrawals BuildTx ConwayEra)
toWithdrawals TxSkelWithdrawals
txSkelWithdrawals
  TxCertificates BuildTx ConwayEra
txCertificates <- [TxSkelCertificate] -> Sem effs (TxCertificates BuildTx ConwayEra)
forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError, Fail]
  effs =>
[TxSkelCertificate] -> Sem effs (TxCertificates BuildTx ConwayEra)
toCertificates [TxSkelCertificate]
txSkelCertificates
  let txFee :: TxFee ConwayEra
txFee = ShelleyBasedEra ConwayEra -> Coin -> TxFee ConwayEra
forall era. ShelleyBasedEra era -> Coin -> TxFee era
Cardano.TxFeeExplicit ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway (Coin -> TxFee ConwayEra) -> Coin -> TxFee ConwayEra
forall a b. (a -> b) -> a -> b
$ Fee -> Coin
Cardano.Coin Fee
fee
      txMetadata :: TxMetadataInEra era
txMetadata = TxMetadataInEra era
forall era. TxMetadataInEra era
Cardano.TxMetadataNone
      txAuxScripts :: TxAuxScripts era
txAuxScripts = TxAuxScripts era
forall era. TxAuxScripts era
Cardano.TxAuxScriptsNone
      txUpdateProposal :: TxUpdateProposal era
txUpdateProposal = TxUpdateProposal era
forall era. TxUpdateProposal era
Cardano.TxUpdateProposalNone
      txScriptValidity :: TxScriptValidity era
txScriptValidity = TxScriptValidity era
forall era. TxScriptValidity era
Cardano.TxScriptValidityNone
      txVotingProcedures :: Maybe a
txVotingProcedures = Maybe a
forall a. Maybe a
Nothing
      txCurrentTreasuryValue :: Maybe a
txCurrentTreasuryValue = Maybe a
forall a. Maybe a
Nothing
      txTreasuryDonation :: Maybe a
txTreasuryDonation = Maybe a
forall a. Maybe a
Nothing
  TxBodyContent BuildTx ConwayEra
-> Sem effs (TxBodyContent BuildTx ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return Cardano.TxBodyContent {[(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
[TxOut CtxTx ConwayEra]
Maybe (Featured ConwayEraOnwards ConwayEra (Maybe Coin))
Maybe (Featured ConwayEraOnwards ConwayEra Coin)
Maybe
  (Featured
     ConwayEraOnwards
     ConwayEra
     (TxProposalProcedures BuildTx ConwayEra))
Maybe
  (Featured
     ConwayEraOnwards ConwayEra (TxVotingProcedures BuildTx ConwayEra))
BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
TxScriptValidity ConwayEra
TxAuxScripts ConwayEra
TxCertificates BuildTx ConwayEra
TxExtraKeyWitnesses ConwayEra
TxFee ConwayEra
TxInsCollateral ConwayEra
TxInsReference BuildTx ConwayEra
TxMetadataInEra ConwayEra
TxMintValue BuildTx ConwayEra
TxReturnCollateral CtxTx ConwayEra
TxTotalCollateral ConwayEra
TxUpdateProposal ConwayEra
TxValidityLowerBound ConwayEra
TxValidityUpperBound ConwayEra
TxWithdrawals BuildTx ConwayEra
forall a. Maybe a
forall era. TxScriptValidity era
forall era. TxAuxScripts era
forall era. TxMetadataInEra era
forall era. TxUpdateProposal era
txIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
txInsReference :: TxInsReference BuildTx ConwayEra
txInsCollateral :: TxInsCollateral ConwayEra
txTotalCollateral :: TxTotalCollateral ConwayEra
txReturnCollateral :: TxReturnCollateral CtxTx ConwayEra
txOuts :: [TxOut CtxTx ConwayEra]
txValidityLowerBound :: TxValidityLowerBound ConwayEra
txValidityUpperBound :: TxValidityUpperBound ConwayEra
txMintValue :: TxMintValue BuildTx ConwayEra
txExtraKeyWits :: TxExtraKeyWitnesses ConwayEra
txProtocolParams :: BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
txProposalProcedures :: Maybe
  (Featured
     ConwayEraOnwards
     ConwayEra
     (TxProposalProcedures BuildTx ConwayEra))
txWithdrawals :: TxWithdrawals BuildTx ConwayEra
txCertificates :: TxCertificates BuildTx ConwayEra
txFee :: TxFee ConwayEra
txMetadata :: forall era. TxMetadataInEra era
txAuxScripts :: forall era. TxAuxScripts era
txUpdateProposal :: forall era. TxUpdateProposal era
txScriptValidity :: forall era. TxScriptValidity era
txVotingProcedures :: forall a. Maybe a
txCurrentTreasuryValue :: forall a. Maybe a
txTreasuryDonation :: forall a. Maybe a
txAuxScripts :: TxAuxScripts ConwayEra
txCertificates :: TxCertificates BuildTx ConwayEra
txCurrentTreasuryValue :: Maybe (Featured ConwayEraOnwards ConwayEra (Maybe Coin))
txExtraKeyWits :: TxExtraKeyWitnesses ConwayEra
txFee :: TxFee ConwayEra
txIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
txInsCollateral :: TxInsCollateral ConwayEra
txInsReference :: TxInsReference BuildTx ConwayEra
txMetadata :: TxMetadataInEra ConwayEra
txMintValue :: TxMintValue BuildTx ConwayEra
txOuts :: [TxOut CtxTx ConwayEra]
txProposalProcedures :: Maybe
  (Featured
     ConwayEraOnwards
     ConwayEra
     (TxProposalProcedures BuildTx ConwayEra))
txProtocolParams :: BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
txReturnCollateral :: TxReturnCollateral CtxTx ConwayEra
txScriptValidity :: TxScriptValidity ConwayEra
txTotalCollateral :: TxTotalCollateral ConwayEra
txTreasuryDonation :: Maybe (Featured ConwayEraOnwards ConwayEra Coin)
txUpdateProposal :: TxUpdateProposal ConwayEra
txValidityLowerBound :: TxValidityLowerBound ConwayEra
txValidityUpperBound :: TxValidityUpperBound ConwayEra
txVotingProcedures :: Maybe
  (Featured
     ConwayEraOnwards ConwayEra (TxVotingProcedures BuildTx ConwayEra))
txWithdrawals :: TxWithdrawals BuildTx ConwayEra
..}

-- | Generates a transaction body from a body content
txBodyContentToTxBody ::
  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
  Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra ->
  Sem effs (Cardano.TxBody Cardano.ConwayEra)
txBodyContentToTxBody :: forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxBodyContent BuildTx ConwayEra -> Sem effs (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBodyContent = do
  Params
params <- Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
  -- We create the associated Shelley TxBody
  Either ToCardanoError (TxBody ConwayEra)
-> Sem effs (TxBody ConwayEra)
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either ToCardanoError (TxBody ConwayEra)
 -> Sem effs (TxBody ConwayEra))
-> Either ToCardanoError (TxBody ConwayEra)
-> Sem effs (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$ Params
-> CardanoBuildTx -> Either ToCardanoError (TxBody ConwayEra)
Emulator.createTransactionBody Params
params (CardanoBuildTx -> Either ToCardanoError (TxBody ConwayEra))
-> CardanoBuildTx -> Either ToCardanoError (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx ConwayEra -> CardanoBuildTx
Ledger.CardanoBuildTx TxBodyContent BuildTx ConwayEra
txBodyContent

-- | Generates an index with utxos known to a 'TxSkel'
txSkelToIndex ::
  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
  TxSkel ->
  Maybe Collaterals ->
  Sem effs (Cardano.UTxO Cardano.ConwayEra)
txSkelToIndex :: forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkel -> Maybe Collaterals -> Sem effs (UTxO ConwayEra)
txSkelToIndex TxSkel
txSkel Maybe Collaterals
mCollaterals = do
  -- We build the index of UTxOs which are known to this skeleton. This includes
  -- collateral inputs, inputs and reference inputs.
  let collateralIns :: [TxOutRef]
collateralIns = [TxOutRef]
-> (Collaterals -> [TxOutRef]) -> Maybe Collaterals -> [TxOutRef]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList (Set TxOutRef -> [TxOutRef])
-> (Collaterals -> Set TxOutRef) -> Collaterals -> [TxOutRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Collaterals -> Set TxOutRef
forall a b. (a, b) -> a
fst) Maybe Collaterals
mCollaterals
  -- We retrieve all the outputs known to the skeleton
  ([TxOutRef]
knownTxORefs, [TxSkelOut]
knownTxOuts) <- [(TxOutRef, TxSkelOut)] -> ([TxOutRef], [TxSkelOut])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(TxOutRef, TxSkelOut)] -> ([TxOutRef], [TxSkelOut]))
-> (Map TxOutRef TxSkelOut -> [(TxOutRef, TxSkelOut)])
-> Map TxOutRef TxSkelOut
-> ([TxOutRef], [TxSkelOut])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef TxSkelOut -> [(TxOutRef, TxSkelOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef TxSkelOut -> ([TxOutRef], [TxSkelOut]))
-> Sem effs (Map TxOutRef TxSkelOut)
-> Sem effs ([TxOutRef], [TxSkelOut])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef] -> Sem effs (Map TxOutRef TxSkelOut)
forall (effs :: EffectRow).
Member MockChainRead effs =>
[TxOutRef] -> Sem effs (Map TxOutRef TxSkelOut)
lookupUtxos (Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList (TxSkel -> Set TxOutRef
txSkelKnownTxOutRefs TxSkel
txSkel) [TxOutRef] -> [TxOutRef] -> [TxOutRef]
forall a. Semigroup a => a -> a -> a
<> [TxOutRef]
collateralIns)
  -- We then compute their Cardano counterparts
  [TxOut CtxTx ConwayEra]
txOutL <- [TxSkelOut]
-> (TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra))
-> Sem effs [TxOut CtxTx ConwayEra]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxSkelOut]
knownTxOuts TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
toCardanoTxOut
  -- We build the index and handle the possible error
  [TxIn]
txInL <- Either ToCardanoError [TxIn] -> Sem effs [TxIn]
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either ToCardanoError [TxIn] -> Sem effs [TxIn])
-> Either ToCardanoError [TxIn] -> Sem effs [TxIn]
forall a b. (a -> b) -> a -> b
$ [TxOutRef]
-> (TxOutRef -> Either ToCardanoError TxIn)
-> Either ToCardanoError [TxIn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxOutRef]
knownTxORefs TxOutRef -> Either ToCardanoError TxIn
Ledger.toCardanoTxIn
  UTxO ConwayEra -> Sem effs (UTxO ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTxO ConwayEra -> Sem effs (UTxO ConwayEra))
-> UTxO ConwayEra -> Sem effs (UTxO ConwayEra)
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO ConwayEra) -> UTxO ConwayEra
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
Cardano.UTxO (Map TxIn (TxOut CtxUTxO ConwayEra) -> UTxO ConwayEra)
-> Map TxIn (TxOut CtxUTxO ConwayEra) -> UTxO ConwayEra
forall a b. (a -> b) -> a -> b
$ [(TxIn, TxOut CtxUTxO ConwayEra)]
-> Map TxIn (TxOut CtxUTxO ConwayEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, TxOut CtxUTxO ConwayEra)]
 -> Map TxIn (TxOut CtxUTxO ConwayEra))
-> [(TxIn, TxOut CtxUTxO ConwayEra)]
-> Map TxIn (TxOut CtxUTxO ConwayEra)
forall a b. (a -> b) -> a -> b
$ [TxIn]
-> [TxOut CtxUTxO ConwayEra] -> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxIn]
txInL ([TxOut CtxUTxO ConwayEra] -> [(TxIn, TxOut CtxUTxO ConwayEra)])
-> [TxOut CtxUTxO ConwayEra] -> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall a b. (a -> b) -> a -> b
$ TxOut CtxTx ConwayEra -> TxOut CtxUTxO ConwayEra
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
Cardano.toCtxUTxOTxOut (TxOut CtxTx ConwayEra -> TxOut CtxUTxO ConwayEra)
-> [TxOut CtxTx ConwayEra] -> [TxOut CtxUTxO ConwayEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut CtxTx ConwayEra]
txOutL

-- | Generates a transaction body from a 'TxSkel' and associated fee and
-- collateral information. This transaction body accounts for the actual
-- execution units of each of the scripts involved in the skeleton.
txSkelToTxBody ::
  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
  TxSkel ->
  Fee ->
  Maybe Collaterals ->
  Sem effs (Cardano.TxBody Cardano.ConwayEra)
txSkelToTxBody :: forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError, Fail]
  effs =>
TxSkel -> Fee -> Maybe Collaterals -> Sem effs (TxBody ConwayEra)
txSkelToTxBody TxSkel
txSkel Fee
fee Maybe Collaterals
mCollaterals = do
  -- We create a first body content and body, without execution units
  TxBodyContent BuildTx ConwayEra
txBodyContent' <- TxSkel
-> Fee
-> Maybe Collaterals
-> Sem effs (TxBodyContent BuildTx ConwayEra)
forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError, Fail]
  effs =>
TxSkel
-> Fee
-> Maybe Collaterals
-> Sem effs (TxBodyContent BuildTx ConwayEra)
txSkelToTxBodyContent TxSkel
txSkel Fee
fee Maybe Collaterals
mCollaterals
  TxBody ConwayEra
txBody' <- TxBodyContent BuildTx ConwayEra -> Sem effs (TxBody ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxBodyContent BuildTx ConwayEra -> Sem effs (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBodyContent'
  -- We create a full transaction from the body
  let tx' :: Tx ConwayEra
tx' = [TxSkelSignatory] -> TxBody ConwayEra -> Tx ConwayEra
txSignatoriesAndBodyToCardanoTx (TxSkel -> [TxSkelSignatory]
txSkelSignatories TxSkel
txSkel) TxBody ConwayEra
txBody'
  -- We retrieve the index and parameters to feed to @getTxExUnitsWithLogs@
  UTxO ConwayEra
index <- TxSkel -> Maybe Collaterals -> Sem effs (UTxO ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkel -> Maybe Collaterals -> Sem effs (UTxO ConwayEra)
txSkelToIndex TxSkel
txSkel Maybe Collaterals
mCollaterals
  Params
params <- Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
  -- We retrieve the execution units associated with the transaction
  case Params
-> UTxO ConwayEra
-> Tx ConwayEra
-> Either ValidationErrorInPhase RedeemerReport
Emulator.getTxExUnitsWithLogs Params
params (UTxO ConwayEra -> UTxO ConwayEra
Ledger.fromPlutusIndex UTxO ConwayEra
index) Tx ConwayEra
tx' of
    -- Computing the execution units can result in all kinds of phase 2
    -- validation failures, except for the ones related to the execution units
    -- themselves. Unless required in the options, we throw the validation
    -- failure right away when applicable.
    Left ValidationErrorInPhase
err | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TxSkelOpts -> Bool
txSkelOptDeferPhase2FailuresDuringBalancing (TxSkelOpts -> Bool) -> TxSkelOpts -> Bool
forall a b. (a -> b) -> a -> b
$ TxSkel -> TxSkelOpts
txSkelOpts TxSkel
txSkel -> MockChainError -> Sem effs (TxBody ConwayEra)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem effs (TxBody ConwayEra))
-> MockChainError -> Sem effs (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$ (ValidationPhase -> ValidationError -> MockChainError)
-> ValidationErrorInPhase -> MockChainError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ValidationPhase -> ValidationError -> MockChainError
MCEValidationError ValidationErrorInPhase
err
    -- The other option is to ignore those and return the unchanged body with
    -- the existing execution units, postponing the handling of the failures.
    Left ValidationErrorInPhase
_ -> TxBody ConwayEra -> Sem effs (TxBody ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxBody ConwayEra
txBody'
    -- When no error arises, we get an execution unit for each script usage. We
    -- first have to transform this Ledger map to a cardano API map.
    Right ((ConwayPlutusPurpose AsIx ConwayEra -> ScriptWitnessIndex)
-> Map (ConwayPlutusPurpose AsIx ConwayEra) ExecutionUnits
-> Map ScriptWitnessIndex ExecutionUnits
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic (AlonzoEraOnwards ConwayEra
-> PlutusPurpose AsIx (ShelleyLedgerEra ConwayEra)
-> ScriptWitnessIndex
forall era.
AlonzoEraOnwards era
-> PlutusPurpose AsIx (ShelleyLedgerEra era) -> ScriptWitnessIndex
Cardano.toScriptIndex AlonzoEraOnwards ConwayEra
Cardano.AlonzoEraOnwardsConway) (Map (ConwayPlutusPurpose AsIx ConwayEra) ExecutionUnits
 -> Map ScriptWitnessIndex ExecutionUnits)
-> (Map (ConwayPlutusPurpose AsIx ConwayEra) ([Text], ExUnits)
    -> Map (ConwayPlutusPurpose AsIx ConwayEra) ExecutionUnits)
-> Map (ConwayPlutusPurpose AsIx ConwayEra) ([Text], ExUnits)
-> Map ScriptWitnessIndex ExecutionUnits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Text], ExUnits) -> ExecutionUnits)
-> Map (ConwayPlutusPurpose AsIx ConwayEra) ([Text], ExUnits)
-> Map (ConwayPlutusPurpose AsIx ConwayEra) ExecutionUnits
forall a b.
(a -> b)
-> Map (ConwayPlutusPurpose AsIx ConwayEra) a
-> Map (ConwayPlutusPurpose AsIx ConwayEra) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExUnits -> ExecutionUnits
Cardano.fromAlonzoExUnits (ExUnits -> ExecutionUnits)
-> (([Text], ExUnits) -> ExUnits)
-> ([Text], ExUnits)
-> ExecutionUnits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], ExUnits) -> ExUnits
forall a b. (a, b) -> b
snd) -> Map ScriptWitnessIndex ExecutionUnits
exUnits) ->
      -- We can then assign the right execution units to the body content
      case Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent BuildTx ConwayEra
-> Either
     (TxBodyErrorAutoBalance ConwayEra)
     (TxBodyContent BuildTx ConwayEra)
forall era.
Map ScriptWitnessIndex ExecutionUnits
-> TxBodyContent BuildTx era
-> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
Cardano.substituteExecutionUnits Map ScriptWitnessIndex ExecutionUnits
exUnits TxBodyContent BuildTx ConwayEra
txBodyContent' of
        -- This can only be a @TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap@
        Left TxBodyErrorAutoBalance ConwayEra
_ -> String -> Sem effs (TxBody ConwayEra)
forall a. String -> Sem effs a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Error while assigning execution units"
        -- We now have a body content with proper execution units and can create
        -- the final body from it
        Right TxBodyContent BuildTx ConwayEra
txBodyContent -> TxBodyContent BuildTx ConwayEra -> Sem effs (TxBody ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxBodyContent BuildTx ConwayEra -> Sem effs (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBodyContent

-- | Generates a Cardano transaction and signs it
txSignatoriesAndBodyToCardanoTx ::
  [TxSkelSignatory] ->
  Cardano.TxBody Cardano.ConwayEra ->
  Cardano.Tx Cardano.ConwayEra
txSignatoriesAndBodyToCardanoTx :: [TxSkelSignatory] -> TxBody ConwayEra -> Tx ConwayEra
txSignatoriesAndBodyToCardanoTx [TxSkelSignatory]
signatories TxBody ConwayEra
txBody = TxBody ConwayEra -> [KeyWitness ConwayEra] -> Tx ConwayEra
forall era. TxBody era -> [KeyWitness era] -> Tx era
Cardano.Tx TxBody ConwayEra
txBody ([KeyWitness ConwayEra] -> Tx ConwayEra)
-> [KeyWitness ConwayEra] -> Tx ConwayEra
forall a b. (a -> b) -> a -> b
$ (TxSkelSignatory -> Maybe (KeyWitness ConwayEra))
-> [TxSkelSignatory] -> [KeyWitness ConwayEra]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxBody ConwayEra -> TxSkelSignatory -> Maybe (KeyWitness ConwayEra)
toKeyWitness TxBody ConwayEra
txBody) [TxSkelSignatory]
signatories

-- | Generates a full Cardano transaction from a skeleton, fees and collaterals
txSkelToCardanoTx ::
  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
  TxSkel ->
  Fee ->
  Maybe Collaterals ->
  Sem effs (Cardano.Tx Cardano.ConwayEra)
txSkelToCardanoTx :: forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError, Fail]
  effs =>
TxSkel -> Fee -> Maybe Collaterals -> Sem effs (Tx ConwayEra)
txSkelToCardanoTx TxSkel
txSkel Fee
fee =
  (TxBody ConwayEra -> Tx ConwayEra)
-> Sem effs (TxBody ConwayEra) -> Sem effs (Tx ConwayEra)
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([TxSkelSignatory] -> TxBody ConwayEra -> Tx ConwayEra
txSignatoriesAndBodyToCardanoTx (TxSkel -> [TxSkelSignatory]
txSkelSignatories TxSkel
txSkel))
    (Sem effs (TxBody ConwayEra) -> Sem effs (Tx ConwayEra))
-> (Maybe Collaterals -> Sem effs (TxBody ConwayEra))
-> Maybe Collaterals
-> Sem effs (Tx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> Fee -> Maybe Collaterals -> Sem effs (TxBody ConwayEra)
forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError, Fail]
  effs =>
TxSkel -> Fee -> Maybe Collaterals -> Sem effs (TxBody ConwayEra)
txSkelToTxBody TxSkel
txSkel Fee
fee