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

import Cardano.Api qualified as Cardano
import Cardano.Api.Internal.Fees qualified as Cardano
import Cardano.Api.Internal.Script qualified as Cardano
import Cardano.Api.Internal.Tx.Body qualified as Cardano
import Cardano.Api.Ledger qualified as Cardano
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Monad
import Control.Monad.Except
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Collateral
import Cooked.MockChain.GenerateTx.Common
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.Skeleton
import Cooked.Wallet
import Data.Map qualified as Map
import Data.Set (Set)
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 PlutusLedgerApi.V3 qualified as Api

-- | Generates a body content from a skeleton
txSkelToTxBodyContent ::
  (MonadBlockChainBalancing m) =>
  -- | The skeleton from which the body is created
  TxSkel ->
  -- | The fee to set in the body
  Integer ->
  -- | The collaterals to set in the body
  Maybe (Set Api.TxOutRef, Wallet) ->
  -- | Returns a Cardano body content
  m (Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra)
txSkelToTxBodyContent :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> m (TxBodyContent BuildTx ConwayEra)
txSkelToTxBodyContent skel :: TxSkel
skel@TxSkel {[Wallet]
[TxSkelProposal]
[TxSkelOut]
Set TxOutRef
Set TxLabel
TxSkelWithdrawals
Map TxOutRef TxSkelRedeemer
TxSkelMints
SlotRange
TxOpts
txSkelLabel :: Set TxLabel
txSkelOpts :: TxOpts
txSkelMints :: TxSkelMints
txSkelSigners :: [Wallet]
txSkelValidityRange :: SlotRange
txSkelIns :: Map TxOutRef TxSkelRedeemer
txSkelInsReference :: Set TxOutRef
txSkelOuts :: [TxSkelOut]
txSkelProposals :: [TxSkelProposal]
txSkelWithdrawals :: TxSkelWithdrawals
txSkelLabel :: TxSkel -> Set TxLabel
txSkelOpts :: TxSkel -> TxOpts
txSkelMints :: TxSkel -> TxSkelMints
txSkelSigners :: TxSkel -> [Wallet]
txSkelValidityRange :: TxSkel -> SlotRange
txSkelIns :: TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelInsReference :: TxSkel -> Set TxOutRef
txSkelOuts :: TxSkel -> [TxSkelOut]
txSkelProposals :: TxSkel -> [TxSkelProposal]
txSkelWithdrawals :: TxSkel -> TxSkelWithdrawals
..} Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals = do
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
txIns <- ((TxOutRef, TxSkelRedeemer)
 -> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)))
-> [(TxOutRef, TxSkelRedeemer)]
-> m [(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)
-> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
(TxOutRef, TxSkelRedeemer)
-> m (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
toTxInAndWitness ([(TxOutRef, TxSkelRedeemer)]
 -> m [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))])
-> [(TxOutRef, TxSkelRedeemer)]
-> m [(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 -> m (TxInsReference BuildTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (TxInsReference BuildTx ConwayEra)
toInsReference TxSkel
skel
  (TxInsCollateral ConwayEra
txInsCollateral, TxTotalCollateral ConwayEra
txTotalCollateral, TxReturnCollateral CtxTx ConwayEra
txReturnCollateral) <- Integer
-> Maybe (Set TxOutRef, Wallet)
-> m (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Set TxOutRef, Wallet)
-> m (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
toCollateralTriplet Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
  [TxOut CtxTx ConwayEra]
txOuts <- (TxSkelOut -> m (TxOut CtxTx ConwayEra))
-> [TxSkelOut] -> m [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 -> m (TxOut CtxTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m (TxOut CtxTx ConwayEra)
toCardanoTxOut [TxSkelOut]
txSkelOuts
  (TxValidityLowerBound ConwayEra
txValidityLowerBound, TxValidityUpperBound ConwayEra
txValidityUpperBound) <-
    String
-> Either
     ToCardanoError
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
-> m (TxValidityLowerBound ConwayEra,
      TxValidityUpperBound ConwayEra)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError
      String
"txSkelToBodyContent: Unable to translate transaction validity range."
      (Either
   ToCardanoError
   (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
 -> m (TxValidityLowerBound ConwayEra,
       TxValidityUpperBound ConwayEra))
-> Either
     ToCardanoError
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
-> m (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 -> m (TxMintValue BuildTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelMints -> m (TxMintValue BuildTx ConwayEra)
toMintValue TxSkelMints
txSkelMints
  TxExtraKeyWitnesses ConwayEra
txExtraKeyWits <-
    if [Wallet] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Wallet]
txSkelSigners
      then TxExtraKeyWitnesses ConwayEra -> m (TxExtraKeyWitnesses ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxExtraKeyWitnesses ConwayEra
forall era. TxExtraKeyWitnesses era
Cardano.TxExtraKeyWitnessesNone
      else
        String
-> ([Hash PaymentKey] -> TxExtraKeyWitnesses ConwayEra)
-> Either ToCardanoError [Hash PaymentKey]
-> m (TxExtraKeyWitnesses ConwayEra)
forall (m :: * -> *) a b.
MonadError MockChainError m =>
String -> (a -> b) -> Either ToCardanoError a -> m b
throwOnToCardanoErrorOrApply
          String
"txSkelToBodyContent: Unable to translate the required signers"
          (AlonzoEraOnwards ConwayEra
-> [Hash PaymentKey] -> TxExtraKeyWitnesses ConwayEra
forall era.
AlonzoEraOnwards era
-> [Hash PaymentKey] -> TxExtraKeyWitnesses era
Cardano.TxExtraKeyWitnesses AlonzoEraOnwards ConwayEra
Cardano.AlonzoEraOnwardsConway)
          (Either ToCardanoError [Hash PaymentKey]
 -> m (TxExtraKeyWitnesses ConwayEra))
-> Either ToCardanoError [Hash PaymentKey]
-> m (TxExtraKeyWitnesses ConwayEra)
forall a b. (a -> b) -> a -> b
$ (Wallet -> Either ToCardanoError (Hash PaymentKey))
-> [Wallet] -> 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))
-> (Wallet -> PaymentPubKeyHash)
-> Wallet
-> Either ToCardanoError (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyHash -> PaymentPubKeyHash
Ledger.PaymentPubKeyHash (PubKeyHash -> PaymentPubKeyHash)
-> (Wallet -> PubKeyHash) -> Wallet -> PaymentPubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> PubKeyHash
forall a. ToPubKeyHash a => a -> PubKeyHash
Script.toPubKeyHash) [Wallet]
txSkelSigners
  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)))
-> m Params
-> m (BuildTxWith
        BuildTx (Maybe (LedgerProtocolParameters ConwayEra)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m 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)))
-> m (TxProposalProcedures BuildTx ConwayEra)
-> m (Maybe
        (Featured
           ConwayEraOnwards
           ConwayEra
           (TxProposalProcedures BuildTx ConwayEra)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSkelProposal]
-> AnchorResolution -> m (TxProposalProcedures BuildTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxSkelProposal]
-> AnchorResolution -> m (TxProposalProcedures BuildTx ConwayEra)
toProposalProcedures [TxSkelProposal]
txSkelProposals (TxOpts -> AnchorResolution
txOptAnchorResolution TxOpts
txSkelOpts)
  TxWithdrawals BuildTx ConwayEra
txWithdrawals <- TxSkelWithdrawals -> m (TxWithdrawals BuildTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelWithdrawals -> m (TxWithdrawals BuildTx ConwayEra)
toWithdrawals TxSkelWithdrawals
txSkelWithdrawals
  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
$ Integer -> Coin
Cardano.Coin Integer
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
      txCertificates :: TxCertificates build era
txCertificates = TxCertificates build era
forall build era. TxCertificates build era
Cardano.TxCertificatesNone
      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
-> m (TxBodyContent BuildTx ConwayEra)
forall a. a -> m 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
forall build era. TxCertificates build 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
txFee :: TxFee ConwayEra
txMetadata :: forall era. TxMetadataInEra era
txAuxScripts :: forall era. TxAuxScripts era
txUpdateProposal :: forall era. TxUpdateProposal era
txCertificates :: forall build era. TxCertificates build 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 :: (MonadBlockChainBalancing m) => Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra -> m (Cardano.TxBody Cardano.ConwayEra)
txBodyContentToTxBody :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxBodyContent BuildTx ConwayEra -> m (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBodyContent = do
  Params
params <- m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  -- We create the associated Shelley TxBody
  (ToCardanoError -> m (TxBody ConwayEra))
-> (TxBody ConwayEra -> m (TxBody ConwayEra))
-> Either ToCardanoError (TxBody ConwayEra)
-> m (TxBody ConwayEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (MockChainError -> m (TxBody ConwayEra)
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m (TxBody ConwayEra))
-> (ToCardanoError -> MockChainError)
-> ToCardanoError
-> m (TxBody ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ToCardanoError -> MockChainError
MCEToCardanoError String
"generateTx :")
    TxBody ConwayEra -> m (TxBody ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Params
-> CardanoBuildTx -> Either ToCardanoError (TxBody ConwayEra)
Emulator.createTransactionBody Params
params (TxBodyContent BuildTx ConwayEra -> CardanoBuildTx
Ledger.CardanoBuildTx TxBodyContent BuildTx ConwayEra
txBodyContent))

-- | Generates an index with utxos known to a 'TxSkel'
txSkelToIndex :: (MonadBlockChainBalancing m) => TxSkel -> Maybe (Set Api.TxOutRef, Wallet) -> m (Cardano.UTxO Cardano.ConwayEra)
txSkelToIndex :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> Maybe (Set TxOutRef, Wallet) -> m (UTxO ConwayEra)
txSkelToIndex TxSkel
txSkel Maybe (Set TxOutRef, Wallet)
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 = case Maybe (Set TxOutRef, Wallet)
mCollaterals of
        Maybe (Set TxOutRef, Wallet)
Nothing -> []
        Just (Set TxOutRef
s, Wallet
_) -> Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
s
  -- 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]))
-> m (Map TxOutRef TxSkelOut) -> m ([TxOutRef], [TxSkelOut])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef] -> m (Map TxOutRef TxSkelOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxOutRef] -> m (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 -> m (TxOut CtxTx ConwayEra))
-> m [TxOut CtxTx ConwayEra]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TxSkelOut]
knownTxOuts TxSkelOut -> m (TxOut CtxTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelOut -> m (TxOut CtxTx ConwayEra)
toCardanoTxOut
  -- We build the index and handle the possible error
  (ToCardanoError -> m (UTxO ConwayEra))
-> (UTxO ConwayEra -> m (UTxO ConwayEra))
-> Either ToCardanoError (UTxO ConwayEra)
-> m (UTxO ConwayEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MockChainError -> m (UTxO ConwayEra)
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m (UTxO ConwayEra))
-> (ToCardanoError -> MockChainError)
-> ToCardanoError
-> m (UTxO ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ToCardanoError -> MockChainError
MCEToCardanoError String
"txSkelToIndex:") UTxO ConwayEra -> m (UTxO ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ToCardanoError (UTxO ConwayEra) -> m (UTxO ConwayEra))
-> Either ToCardanoError (UTxO ConwayEra) -> m (UTxO ConwayEra)
forall a b. (a -> b) -> a -> b
$ do
    [TxIn]
txInL <- [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 -> Either ToCardanoError (UTxO ConwayEra)
forall a. a -> Either ToCardanoError a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTxO ConwayEra -> Either ToCardanoError (UTxO ConwayEra))
-> UTxO ConwayEra -> Either ToCardanoError (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 :: (MonadBlockChainBalancing m) => TxSkel -> Integer -> Maybe (Set Api.TxOutRef, Wallet) -> m (Cardano.TxBody Cardano.ConwayEra)
txSkelToTxBody :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel
-> Integer -> Maybe (Set TxOutRef, Wallet) -> m (TxBody ConwayEra)
txSkelToTxBody TxSkel
txSkel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals = do
  -- We create a first body content and body, without execution units
  TxBodyContent BuildTx ConwayEra
txBodyContent' <- TxSkel
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> m (TxBodyContent BuildTx ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel
-> Integer
-> Maybe (Set TxOutRef, Wallet)
-> m (TxBodyContent BuildTx ConwayEra)
txSkelToTxBodyContent TxSkel
txSkel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
  TxBody ConwayEra
txBody' <- TxBodyContent BuildTx ConwayEra -> m (TxBody ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxBodyContent BuildTx ConwayEra -> m (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBodyContent'
  -- We create a full transaction from the body
  let tx' :: Tx ConwayEra
tx' = TxBody ConwayEra -> [KeyWitness ConwayEra] -> Tx ConwayEra
forall era. TxBody era -> [KeyWitness era] -> Tx era
Cardano.Tx TxBody ConwayEra
txBody' (TxBody ConwayEra -> Wallet -> KeyWitness ConwayEra
toKeyWitness TxBody ConwayEra
txBody' (Wallet -> KeyWitness ConwayEra)
-> [Wallet] -> [KeyWitness ConwayEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkel -> [Wallet]
txSkelSigners TxSkel
txSkel)
  -- We retrieve the index and parameters to feed to @getTxExUnitsWithLogs@
  UTxO ConwayEra
index <- TxSkel -> Maybe (Set TxOutRef, Wallet) -> m (UTxO ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> Maybe (Set TxOutRef, Wallet) -> m (UTxO ConwayEra)
txSkelToIndex TxSkel
txSkel Maybe (Set TxOutRef, Wallet)
mCollaterals
  Params
params <- m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m 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 validation
    -- errors except for the ones related to the execution units themselves.
    Left ValidationErrorInPhase
err -> MockChainError -> m (TxBody ConwayEra)
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m (TxBody ConwayEra))
-> MockChainError -> m (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
    -- 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
_ -> MockChainError -> m (TxBody ConwayEra)
forall a. MockChainError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MockChainError -> m (TxBody ConwayEra))
-> MockChainError -> m (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$ String -> MockChainError
FailWith 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
txBody -> TxBodyContent BuildTx ConwayEra -> m (TxBody ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxBodyContent BuildTx ConwayEra -> m (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBody