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 BuildTx ConwayEra
txInsReference <-
if [TxOutRef] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOutRef]
txSkelReferenceInputs
then TxInsReference BuildTx ConwayEra
-> m (TxInsReference BuildTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxInsReference BuildTx ConwayEra
forall build era. TxInsReference build era
Cardano.TxInsReferenceNone
else
String
-> ([TxIn] -> TxInsReference BuildTx ConwayEra)
-> Either ToCardanoError [TxIn]
-> m (TxInsReference BuildTx 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 BuildTx ConwayEra
forall era build.
BabbageEraOnwards era -> [TxIn] -> TxInsReference build era
Cardano.TxInsReference BabbageEraOnwards ConwayEra
Cardano.BabbageEraOnwardsConway)
(Either ToCardanoError [TxIn]
-> m (TxInsReference BuildTx ConwayEra))
-> Either ToCardanoError [TxIn]
-> m (TxInsReference BuildTx 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
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
(TxProposalProcedures BuildTx ConwayEra))
Maybe
(Featured
ConwayEraOnwards ConwayEra (TxVotingProcedures BuildTx ConwayEra))
BuildTxWith BuildTx (Maybe (LedgerProtocolParameters 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
TxScriptValidity ConwayEra
forall a. Maybe a
forall era. TxAuxScripts era
forall era. TxMetadataInEra era
forall era. TxUpdateProposal era
forall era. TxScriptValidity 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))
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
txAuxScripts :: TxAuxScripts ConwayEra
txCertificates :: TxCertificates BuildTx ConwayEra
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
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.
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
Cardano.createAndValidateTransactionBody 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 (EraCrypto StandardConway)) (Data StandardConway)
additionalDataMap = [(DataHash (EraCrypto StandardConway), Data StandardConway)]
-> Map (DataHash (EraCrypto StandardConway)) (Data StandardConway)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Data StandardConway -> DataHash (EraCrypto StandardConway)
forall era. Era era => Data era -> DataHash (EraCrypto era)
Cardano.hashData Data StandardConway
dat, Data StandardConway
dat) | Api.Datum (Data -> Data StandardConway
forall era. Era era => Data -> Data era
Cardano.Data (Data -> Data StandardConway)
-> (BuiltinData -> Data) -> BuiltinData -> Data StandardConway
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
forall a. ToData a => a -> Data
Api.toData -> Data StandardConway
dat) <- [Datum]
additionalData]
Language -> LangDepView
toLangDepViewParam <- PParams StandardConway -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
Conway.getLanguageView (PParams StandardConway -> Language -> LangDepView)
-> (Params -> PParams StandardConway)
-> Params
-> Language
-> LangDepView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerProtocolParameters ConwayEra
-> PParams (ShelleyLedgerEra ConwayEra)
LedgerProtocolParameters ConwayEra -> PParams StandardConway
forall era.
LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
Cardano.unLedgerProtocolParameters (LedgerProtocolParameters ConwayEra -> PParams StandardConway)
-> (Params -> LedgerProtocolParameters ConwayEra)
-> Params
-> PParams StandardConway
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 StandardConway
txDats' = Map (DataHash (EraCrypto StandardConway)) (Data StandardConway)
-> TxDats StandardConway
forall era.
Era era =>
Map (DataHash (EraCrypto era)) (Data era) -> TxDats era
Alonzo.TxDats Map (DataHash (EraCrypto StandardConway)) (Data StandardConway)
additionalDataMap
(AlonzoEraOnwards ConwayEra
era, TxDats StandardConway
datums, Redeemers StandardConway
redeemers) = case TxBodyScriptData ConwayEra
dats of
TxBodyScriptData ConwayEra
Cardano.TxBodyNoScriptData -> (AlonzoEraOnwards ConwayEra
Cardano.AlonzoEraOnwardsConway, TxDats StandardConway
txDats', Map
(PlutusPurpose AsIx StandardConway) (Data StandardConway, ExUnits)
-> Redeemers StandardConway
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Alonzo.Redeemers Map
(PlutusPurpose AsIx StandardConway) (Data StandardConway, 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 StandardConway
txDats TxDats StandardConway
-> TxDats StandardConway -> TxDats StandardConway
forall a. Semigroup a => a -> a -> a
<> TxDats StandardConway
txDats', Redeemers (ShelleyLedgerEra ConwayEra)
Redeemers StandardConway
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 (EraCrypto StandardConway))
scriptIntegrityHash =
AlonzoEraOnwards ConwayEra
-> (AlonzoEraOnwardsConstraints ConwayEra =>
StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway)))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
Cardano.alonzoEraOnwardsConstraints AlonzoEraOnwards ConwayEra
era ((AlonzoEraOnwardsConstraints ConwayEra =>
StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway)))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway)))
-> (AlonzoEraOnwardsConstraints ConwayEra =>
StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway)))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))
forall a b. (a -> b) -> a -> b
$
Set LangDepView
-> Redeemers StandardConway
-> TxDats StandardConway
-> StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))
forall era.
AlonzoEraScript era =>
Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (EraCrypto era))
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 StandardConway
redeemers TxDats StandardConway
datums
body' :: ConwayTxBody StandardConway
body' = TxBody (ShelleyLedgerEra ConwayEra)
ConwayTxBody StandardConway
body ConwayTxBody StandardConway
-> (ConwayTxBody StandardConway -> ConwayTxBody StandardConway)
-> ConwayTxBody StandardConway
forall a b. a -> (a -> b) -> b
Lens.& (StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))
-> Identity
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))))
-> TxBody StandardConway -> Identity (TxBody StandardConway)
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))
-> Identity
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))))
-> ConwayTxBody StandardConway
-> Identity (ConwayTxBody StandardConway)
forall era.
AlonzoEraTxBody era =>
Lens'
(TxBody era) (StrictMaybe (ScriptIntegrityHash (EraCrypto era)))
Lens'
(TxBody StandardConway)
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway)))
Alonzo.scriptIntegrityHashTxBodyL ((StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))
-> Identity
(StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))))
-> ConwayTxBody StandardConway
-> Identity (ConwayTxBody StandardConway))
-> StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))
-> ConwayTxBody StandardConway
-> ConwayTxBody StandardConway
forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ StrictMaybe (ScriptIntegrityHash (EraCrypto StandardConway))
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 StandardConway
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 StandardConway
datums Redeemers (ShelleyLedgerEra ConwayEra)
Redeemers StandardConway
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 (EraCrypto StandardConway)) (Data StandardConway)
-> Bool
forall a. Map (DataHash (EraCrypto StandardConway)) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map (DataHash (EraCrypto StandardConway)) (Data StandardConway)
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