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
txSkelToTxBodyContent ::
(MonadBlockChainBalancing m) =>
TxSkel ->
Integer ->
Maybe (Set Api.TxOutRef, Wallet) ->
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
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 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
..}
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
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)
[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
let datumHashes :: [DatumHash]
datumHashes = [DatumHash
hash | (Api.TxOut Address
_ Value
_ (Api.OutputDatumHash DatumHash
hash) Maybe ScriptHash
_) <- [TxOut]
refIns]
[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
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]
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
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
(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)
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
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]
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
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
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