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

import Cardano.Api qualified as Cardano
import Cardano.Api.Shelley qualified as Cardano
import Cardano.Ledger.Alonzo.Tx qualified as Alonzo
import Cardano.Ledger.Alonzo.TxBody qualified as Alonzo
import Cardano.Ledger.Alonzo.TxWits qualified as Alonzo
import Cardano.Ledger.Conway.PParams qualified as Conway
import Cardano.Ledger.Plutus qualified as Cardano
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Lens qualified as Lens
import Control.Monad
import Control.Monad.Except
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Collateral qualified as Collateral
import Cooked.MockChain.GenerateTx.Common
import Cooked.MockChain.GenerateTx.Input qualified as Input
import Cooked.MockChain.GenerateTx.Mint qualified as Mint
import Cooked.MockChain.GenerateTx.Output qualified as Output
import Cooked.MockChain.GenerateTx.Proposal qualified as Proposal
import Cooked.MockChain.GenerateTx.Withdrawals qualified as Withdrawals
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 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 | [TxOutRef]
txSkelReferenceInputs <- TxSkel -> [TxOutRef]
txSkelReferenceTxOutRefs TxSkel
skel = 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))
Input.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 ConwayEra
txInsReference <-
    if [TxOutRef] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOutRef]
txSkelReferenceInputs
      then TxInsReference ConwayEra -> m (TxInsReference ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxInsReference ConwayEra
forall era. TxInsReference era
Cardano.TxInsReferenceNone
      else
        String
-> ([TxIn] -> TxInsReference ConwayEra)
-> Either ToCardanoError [TxIn]
-> m (TxInsReference ConwayEra)
forall (m :: * -> *) a b.
MonadError MockChainError m =>
String -> (a -> b) -> Either ToCardanoError a -> m b
throwOnToCardanoErrorOrApply
          String
"txSkelToBodyContent: Unable to translate reference inputs."
          (BabbageEraOnwards ConwayEra -> [TxIn] -> TxInsReference ConwayEra
forall era. BabbageEraOnwards era -> [TxIn] -> TxInsReference era
Cardano.TxInsReference BabbageEraOnwards ConwayEra
Cardano.BabbageEraOnwardsConway)
          (Either ToCardanoError [TxIn] -> m (TxInsReference ConwayEra))
-> Either ToCardanoError [TxIn] -> m (TxInsReference ConwayEra)
forall a b. (a -> b) -> a -> b
$ (TxOutRef -> Either ToCardanoError TxIn)
-> [TxOutRef] -> Either ToCardanoError [TxIn]
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 -> Either ToCardanoError TxIn
Ledger.toCardanoTxIn [TxOutRef]
txSkelReferenceInputs
  (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)
Collateral.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)
Output.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)
Mint.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
walletPKHash) [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
  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
Emulator.Coin Integer
fee
  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)
Proposal.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)
Withdrawals.toWithdrawals TxSkelWithdrawals
txSkelWithdrawals
  let txMetadata :: TxMetadataInEra era
txMetadata = TxMetadataInEra era
forall era. TxMetadataInEra era
Cardano.TxMetadataNone -- That's what plutus-apps does as well
      txAuxScripts :: TxAuxScripts era
txAuxScripts = TxAuxScripts era
forall era. TxAuxScripts era
Cardano.TxAuxScriptsNone -- That's what plutus-apps does as well
      txUpdateProposal :: TxUpdateProposal era
txUpdateProposal = TxUpdateProposal era
forall era. TxUpdateProposal era
Cardano.TxUpdateProposalNone -- That's what plutus-apps does as well
      txCertificates :: TxCertificates build era
txCertificates = TxCertificates build era
forall build era. TxCertificates build era
Cardano.TxCertificatesNone -- That's what plutus-apps does as well
      txScriptValidity :: TxScriptValidity era
txScriptValidity = TxScriptValidity era
forall era. TxScriptValidity era
Cardano.TxScriptValidityNone -- That's what plutus-apps does as well
      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 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 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))
txFee :: TxFee ConwayEra
txProposalProcedures :: Maybe
  (Featured
     ConwayEraOnwards
     ConwayEra
     (TxProposalProcedures BuildTx ConwayEra))
txWithdrawals :: TxWithdrawals BuildTx 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 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 -> TxSkel -> m (Cardano.TxBody Cardano.ConwayEra)
txBodyContentToTxBody :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxBodyContent BuildTx ConwayEra -> TxSkel -> m (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBodyContent TxSkel
skel = do
  -- We create the associated Shelley TxBody
  txBody :: TxBody ConwayEra
txBody@(Cardano.ShelleyTxBody ShelleyBasedEra ConwayEra
a TxBody (ShelleyLedgerEra ConwayEra)
body [Script (ShelleyLedgerEra ConwayEra)]
c TxBodyScriptData ConwayEra
dats Maybe (TxAuxData (ShelleyLedgerEra ConwayEra))
e TxScriptValidity ConwayEra
f) <-
    (TxBodyError -> m (TxBody ConwayEra))
-> (TxBody ConwayEra -> m (TxBody ConwayEra))
-> Either TxBodyError (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))
-> (TxBodyError -> MockChainError)
-> TxBodyError
-> m (TxBody ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenerateTxError -> MockChainError
MCEGenerationError (GenerateTxError -> MockChainError)
-> (TxBodyError -> GenerateTxError)
-> TxBodyError
-> MockChainError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TxBodyError -> GenerateTxError
TxBodyError String
"generateTx :")
      TxBody ConwayEra -> m (TxBody ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
      (ShelleyBasedEra ConwayEra
-> TxBodyContent BuildTx ConwayEra
-> Either TxBodyError (TxBody ConwayEra)
forall era.
HasCallStack =>
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
Cardano.createTransactionBody ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway TxBodyContent BuildTx ConwayEra
txBodyContent)

  -- There is a chance that the body is in need of additional data. This happens
  -- when the set of reference inputs contains hashed datums that will need to
  -- be resolved during phase 2 validation. All that follows until the
  -- definition of "txBody'" aims at doing just that. In the process, we have to
  -- reconstruct the body with the new data and the associated hash. Hopefully,
  -- in the future, cardano-api provides a way to add those data in the body
  -- directly without requiring this method, which somewhat feels like a hack.

  -- We attempt to resolve the reference inputs used by the skeleton
  [TxOut]
refIns <- [TxOutRef] -> (TxOutRef -> m TxOut) -> m [TxOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (TxSkel -> [TxOutRef]
txSkelReferenceTxOutRefs TxSkel
skel) ((TxOutRef -> m TxOut) -> m [TxOut])
-> (TxOutRef -> m TxOut) -> m [TxOut]
forall a b. (a -> b) -> a -> b
$ \TxOutRef
oRef ->
    String -> Maybe TxOut -> m TxOut
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Maybe a -> m a
throwOnMaybe (String
"txSkelToCardanoTx: Unable to resolve TxOutRef " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TxOutRef -> String
forall a. Show a => a -> String
show TxOutRef
oRef) (Maybe TxOut -> m TxOut) -> m (Maybe TxOut) -> m TxOut
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TxOutRef -> m (Maybe TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxOut)
txOutByRef TxOutRef
oRef
  -- We collect the datum hashes present at these outputs
  let datumHashes :: [DatumHash]
datumHashes = [DatumHash
hash | (Api.TxOut Address
_ Value
_ (Api.OutputDatumHash DatumHash
hash) Maybe ScriptHash
_) <- [TxOut]
refIns]
  -- We resolve those datum hashes from the context
  [Datum]
additionalData <- [DatumHash] -> (DatumHash -> m Datum) -> m [Datum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DatumHash]
datumHashes ((DatumHash -> m Datum) -> m [Datum])
-> (DatumHash -> m Datum) -> m [Datum]
forall a b. (a -> b) -> a -> b
$ \DatumHash
dHash ->
    String -> Maybe Datum -> m Datum
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Maybe a -> m a
throwOnMaybe (String
"txSkelToCardanoTx: Unable to resolve datum hash " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DatumHash -> String
forall a. Show a => a -> String
show DatumHash
dHash) (Maybe Datum -> m Datum) -> m (Maybe Datum) -> m Datum
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DatumHash -> m (Maybe Datum)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
DatumHash -> m (Maybe Datum)
datumFromHash DatumHash
dHash
  -- We compute the map from datum hash to datum of these additional required data
  let additionalDataMap :: Map DataHash (Data ConwayEra)
additionalDataMap = [(DataHash, Data ConwayEra)] -> Map DataHash (Data ConwayEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Data ConwayEra -> DataHash
forall era. Data era -> DataHash
Cardano.hashData Data ConwayEra
dat, Data ConwayEra
dat) | Api.Datum (Data -> Data ConwayEra
forall era. Era era => Data -> Data era
Cardano.Data (Data -> Data ConwayEra)
-> (BuiltinData -> Data) -> BuiltinData -> Data ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
forall a. ToData a => a -> Data
Api.toData -> Data ConwayEra
dat) <- [Datum]
additionalData]
  -- We retrieve a needed parameter to process difference plutus languages
  Language -> LangDepView
toLangDepViewParam <- PParams ConwayEra -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
Conway.getLanguageView (PParams ConwayEra -> Language -> LangDepView)
-> (Params -> PParams ConwayEra)
-> Params
-> Language
-> LangDepView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerProtocolParameters ConwayEra
-> PParams (ShelleyLedgerEra ConwayEra)
LedgerProtocolParameters ConwayEra -> PParams ConwayEra
forall era.
LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
Cardano.unLedgerProtocolParameters (LedgerProtocolParameters ConwayEra -> PParams ConwayEra)
-> (Params -> LedgerProtocolParameters ConwayEra)
-> Params
-> PParams ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> LedgerProtocolParameters ConwayEra
Emulator.ledgerProtocolParameters (Params -> Language -> LangDepView)
-> m Params -> m (Language -> LangDepView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  -- We convert our data map into a 'TxDats'
  let txDats' :: TxDats ConwayEra
txDats' = Map DataHash (Data ConwayEra) -> TxDats ConwayEra
forall era. Era era => Map DataHash (Data era) -> TxDats era
Alonzo.TxDats Map DataHash (Data ConwayEra)
additionalDataMap
      -- We compute the new era, datums and redeemers based on the current dats
      -- in the body and the additional data to include in the body.
      (AlonzoEraOnwards ConwayEra
era, TxDats ConwayEra
datums, Redeemers ConwayEra
redeemers) = case TxBodyScriptData ConwayEra
dats of
        TxBodyScriptData ConwayEra
Cardano.TxBodyNoScriptData -> (AlonzoEraOnwards ConwayEra
Cardano.AlonzoEraOnwardsConway, TxDats ConwayEra
txDats', Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
-> Redeemers ConwayEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Alonzo.Redeemers Map (PlutusPurpose AsIx ConwayEra) (Data ConwayEra, ExUnits)
forall k a. Map k a
Map.empty)
        Cardano.TxBodyScriptData AlonzoEraOnwards ConwayEra
era' TxDats (ShelleyLedgerEra ConwayEra)
txDats Redeemers (ShelleyLedgerEra ConwayEra)
reds -> (AlonzoEraOnwards ConwayEra
era', TxDats (ShelleyLedgerEra ConwayEra)
TxDats ConwayEra
txDats TxDats ConwayEra -> TxDats ConwayEra -> TxDats ConwayEra
forall a. Semigroup a => a -> a -> a
<> TxDats ConwayEra
txDats', Redeemers (ShelleyLedgerEra ConwayEra)
Redeemers ConwayEra
reds)
      -- We collect the various witnesses in the body
      witnesses :: [(ScriptWitnessIndex, AnyScriptWitness ConwayEra)]
witnesses = ShelleyBasedEra ConwayEra
-> TxBodyContent BuildTx ConwayEra
-> [(ScriptWitnessIndex, AnyScriptWitness ConwayEra)]
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
Cardano.collectTxBodyScriptWitnesses ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway TxBodyContent BuildTx ConwayEra
txBodyContent
      -- We collect their associated languages
      languages :: [Language]
languages = [PlutusScriptVersion lang -> Language
forall lang. PlutusScriptVersion lang -> Language
toCardanoLanguage PlutusScriptVersion lang
v | (ScriptWitnessIndex
_, Cardano.AnyScriptWitness (Cardano.PlutusScriptWitness ScriptLanguageInEra lang ConwayEra
_ PlutusScriptVersion lang
v PlutusScriptOrReferenceInput lang
_ ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_)) <- [(ScriptWitnessIndex, AnyScriptWitness ConwayEra)]
witnesses]
      -- We compute the new script integrity hash with the added data
      scriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
scriptIntegrityHash =
        AlonzoEraOnwards ConwayEra
-> (AlonzoEraOnwardsConstraints ConwayEra =>
    StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ScriptIntegrityHash
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
Cardano.alonzoEraOnwardsConstraints AlonzoEraOnwards ConwayEra
era ((AlonzoEraOnwardsConstraints ConwayEra =>
  StrictMaybe ScriptIntegrityHash)
 -> StrictMaybe ScriptIntegrityHash)
-> (AlonzoEraOnwardsConstraints ConwayEra =>
    StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ScriptIntegrityHash
forall a b. (a -> b) -> a -> b
$
          Set LangDepView
-> Redeemers ConwayEra
-> TxDats ConwayEra
-> StrictMaybe ScriptIntegrityHash
forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era -> TxDats era -> StrictMaybe ScriptIntegrityHash
Alonzo.hashScriptIntegrity ([LangDepView] -> Set LangDepView
forall a. Ord a => [a] -> Set a
Set.fromList ([LangDepView] -> Set LangDepView)
-> [LangDepView] -> Set LangDepView
forall a b. (a -> b) -> a -> b
$ Language -> LangDepView
toLangDepViewParam (Language -> LangDepView) -> [Language] -> [LangDepView]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Language]
languages) Redeemers ConwayEra
redeemers TxDats ConwayEra
datums
      -- We wrap all of this in the new body
      body' :: ConwayTxBody ConwayEra
body' = TxBody (ShelleyLedgerEra ConwayEra)
ConwayTxBody ConwayEra
body ConwayTxBody ConwayEra
-> (ConwayTxBody ConwayEra -> ConwayTxBody ConwayEra)
-> ConwayTxBody ConwayEra
forall a b. a -> (a -> b) -> b
Lens.& (StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> TxBody ConwayEra -> Identity (TxBody ConwayEra)
(StrictMaybe ScriptIntegrityHash
 -> Identity (StrictMaybe ScriptIntegrityHash))
-> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody ConwayEra) (StrictMaybe ScriptIntegrityHash)
Alonzo.scriptIntegrityHashTxBodyL ((StrictMaybe ScriptIntegrityHash
  -> Identity (StrictMaybe ScriptIntegrityHash))
 -> ConwayTxBody ConwayEra -> Identity (ConwayTxBody ConwayEra))
-> StrictMaybe ScriptIntegrityHash
-> ConwayTxBody ConwayEra
-> ConwayTxBody ConwayEra
forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ StrictMaybe ScriptIntegrityHash
scriptIntegrityHash
      txBody' :: TxBody ConwayEra
txBody' = ShelleyBasedEra ConwayEra
-> TxBody (ShelleyLedgerEra ConwayEra)
-> [Script (ShelleyLedgerEra ConwayEra)]
-> TxBodyScriptData ConwayEra
-> Maybe (TxAuxData (ShelleyLedgerEra ConwayEra))
-> TxScriptValidity ConwayEra
-> TxBody ConwayEra
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (TxAuxData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
Cardano.ShelleyTxBody ShelleyBasedEra ConwayEra
a TxBody (ShelleyLedgerEra ConwayEra)
ConwayTxBody ConwayEra
body' [Script (ShelleyLedgerEra ConwayEra)]
c (AlonzoEraOnwards ConwayEra
-> TxDats (ShelleyLedgerEra ConwayEra)
-> Redeemers (ShelleyLedgerEra ConwayEra)
-> TxBodyScriptData ConwayEra
forall era.
AlonzoEraOnwardsConstraints era =>
AlonzoEraOnwards era
-> TxDats (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> TxBodyScriptData era
Cardano.TxBodyScriptData AlonzoEraOnwards ConwayEra
era TxDats (ShelleyLedgerEra ConwayEra)
TxDats ConwayEra
datums Redeemers (ShelleyLedgerEra ConwayEra)
Redeemers ConwayEra
redeemers) Maybe (TxAuxData (ShelleyLedgerEra ConwayEra))
e TxScriptValidity ConwayEra
f

  TxBody ConwayEra -> m (TxBody ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxBody ConwayEra -> m (TxBody ConwayEra))
-> TxBody ConwayEra -> m (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$ if Map DataHash (Data ConwayEra) -> Bool
forall a. Map DataHash a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map DataHash (Data ConwayEra)
additionalDataMap then TxBody ConwayEra
txBody else TxBody ConwayEra
txBody'
  where
    toCardanoLanguage :: Cardano.PlutusScriptVersion lang -> Cardano.Language
    toCardanoLanguage :: forall lang. PlutusScriptVersion lang -> Language
toCardanoLanguage = \case
      PlutusScriptVersion lang
Cardano.PlutusScriptV1 -> Language
Cardano.PlutusV1
      PlutusScriptVersion lang
Cardano.PlutusScriptV2 -> Language
Cardano.PlutusV2
      PlutusScriptVersion lang
Cardano.PlutusScriptV3 -> Language
Cardano.PlutusV3

-- | Generates a transaction body from a 'TxSkel' and associated fee and
-- collateral information
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
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals = do
  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
skel Integer
fee Maybe (Set TxOutRef, Wallet)
mCollaterals
  TxBodyContent BuildTx ConwayEra -> TxSkel -> m (TxBody ConwayEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxBodyContent BuildTx ConwayEra -> TxSkel -> m (TxBody ConwayEra)
txBodyContentToTxBody TxBodyContent BuildTx ConwayEra
txBodyContent TxSkel
skel