module Cooked.MockChain.GenerateTx.Body 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.Reader
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.Either.Combinators
import Data.Map (Map)
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 qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api

data TxContext where
  TxContext ::
    { TxContext -> Integer
fee :: Integer,
      TxContext -> Maybe (Set TxOutRef, Wallet)
mCollaterals :: Maybe (Set Api.TxOutRef, Wallet),
      TxContext -> Params
params :: Emulator.Params,
      TxContext -> Map DatumHash Datum
managedData :: Map Api.DatumHash Api.Datum,
      TxContext -> Map TxOutRef TxOut
managedTxOuts :: Map Api.TxOutRef Api.TxOut,
      TxContext -> Map ValidatorHash (Versioned Validator)
managedValidators :: Map Script.ValidatorHash (Script.Versioned Script.Validator)
    } ->
    TxContext

type BodyGen a = TxGen TxContext a

instance Transform TxContext Cardano.NetworkId where
  transform :: TxContext -> NetworkId
transform = Params -> NetworkId
Emulator.pNetworkId (Params -> NetworkId)
-> (TxContext -> Params) -> TxContext -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxContext -> Params
params

instance Transform TxContext (Map Api.TxOutRef Api.TxOut) where
  transform :: TxContext -> Map TxOutRef TxOut
transform = TxContext -> Map TxOutRef TxOut
managedTxOuts

instance Transform TxContext (Emulator.PParams, Map Api.TxOutRef Api.TxOut) where
  transform :: TxContext -> (PParams, Map TxOutRef TxOut)
transform TxContext
ctx = (Params -> PParams
Emulator.pEmulatorPParams (Params -> PParams) -> Params -> PParams
forall a b. (a -> b) -> a -> b
$ TxContext -> Params
params TxContext
ctx, TxContext -> Map TxOutRef TxOut
forall a b. Transform a b => a -> b
transform TxContext
ctx)

instance Transform TxContext Input.InputContext where
  transform :: TxContext -> InputContext
transform TxContext {Integer
Maybe (Set TxOutRef, Wallet)
Map TxOutRef TxOut
Map DatumHash Datum
Map ValidatorHash (Versioned Validator)
Params
fee :: TxContext -> Integer
mCollaterals :: TxContext -> Maybe (Set TxOutRef, Wallet)
params :: TxContext -> Params
managedData :: TxContext -> Map DatumHash Datum
managedTxOuts :: TxContext -> Map TxOutRef TxOut
managedValidators :: TxContext -> Map ValidatorHash (Versioned Validator)
fee :: Integer
mCollaterals :: Maybe (Set TxOutRef, Wallet)
params :: Params
managedData :: Map DatumHash Datum
managedTxOuts :: Map TxOutRef TxOut
managedValidators :: Map ValidatorHash (Versioned Validator)
..} = Input.InputContext {Map TxOutRef TxOut
Map DatumHash Datum
Map ValidatorHash (Versioned Validator)
managedData :: Map DatumHash Datum
managedTxOuts :: Map TxOutRef TxOut
managedValidators :: Map ValidatorHash (Versioned Validator)
managedData :: Map DatumHash Datum
managedTxOuts :: Map TxOutRef TxOut
managedValidators :: Map ValidatorHash (Versioned Validator)
..}

instance Transform TxContext Collateral.CollateralContext where
  transform :: TxContext -> CollateralContext
transform TxContext {Integer
Maybe (Set TxOutRef, Wallet)
Map TxOutRef TxOut
Map DatumHash Datum
Map ValidatorHash (Versioned Validator)
Params
fee :: TxContext -> Integer
mCollaterals :: TxContext -> Maybe (Set TxOutRef, Wallet)
params :: TxContext -> Params
managedData :: TxContext -> Map DatumHash Datum
managedTxOuts :: TxContext -> Map TxOutRef TxOut
managedValidators :: TxContext -> Map ValidatorHash (Versioned Validator)
fee :: Integer
mCollaterals :: Maybe (Set TxOutRef, Wallet)
params :: Params
managedData :: Map DatumHash Datum
managedTxOuts :: Map TxOutRef TxOut
managedValidators :: Map ValidatorHash (Versioned Validator)
..} = Collateral.CollateralContext {Integer
Maybe (Set TxOutRef, Wallet)
Map TxOutRef TxOut
Params
fee :: Integer
mCollaterals :: Maybe (Set TxOutRef, Wallet)
params :: Params
managedTxOuts :: Map TxOutRef TxOut
managedTxOuts :: Map TxOutRef TxOut
fee :: Integer
mCollaterals :: Maybe (Set TxOutRef, Wallet)
params :: Params
..}

instance Transform TxContext Withdrawals.WithdrawalsContext where
  transform :: TxContext -> WithdrawalsContext
transform TxContext {Integer
Maybe (Set TxOutRef, Wallet)
Map TxOutRef TxOut
Map DatumHash Datum
Map ValidatorHash (Versioned Validator)
Params
fee :: TxContext -> Integer
mCollaterals :: TxContext -> Maybe (Set TxOutRef, Wallet)
params :: TxContext -> Params
managedData :: TxContext -> Map DatumHash Datum
managedTxOuts :: TxContext -> Map TxOutRef TxOut
managedValidators :: TxContext -> Map ValidatorHash (Versioned Validator)
fee :: Integer
mCollaterals :: Maybe (Set TxOutRef, Wallet)
params :: Params
managedData :: Map DatumHash Datum
managedTxOuts :: Map TxOutRef TxOut
managedValidators :: Map ValidatorHash (Versioned Validator)
..} =
    let networkId :: NetworkId
networkId = Params -> NetworkId
Emulator.pNetworkId Params
params
     in Withdrawals.WithdrawalsContext {Map TxOutRef TxOut
NetworkId
managedTxOuts :: Map TxOutRef TxOut
networkId :: NetworkId
managedTxOuts :: Map TxOutRef TxOut
networkId :: NetworkId
..}

-- | Generates a body content from a skeleton
txSkelToBodyContent :: TxSkel -> BodyGen (Cardano.TxBodyContent Cardano.BuildTx Cardano.ConwayEra)
txSkelToBodyContent :: TxSkel -> BodyGen (TxBodyContent BuildTx ConwayEra)
txSkelToBodyContent 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
..} | [TxOutRef]
txSkelReferenceInputs <- TxSkel -> [TxOutRef]
txSkelReferenceTxOutRefs TxSkel
skel = do
  [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
txIns <- ((TxOutRef, TxSkelRedeemer)
 -> ReaderT
      TxContext
      (Either GenerateTxError)
      (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)))
-> [(TxOutRef, TxSkelRedeemer)]
-> ReaderT
     TxContext
     (Either GenerateTxError)
     [(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 (TxGen
  InputContext
  (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen (TxGen
   InputContext
   (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
 -> ReaderT
      TxContext
      (Either GenerateTxError)
      (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)))
-> ((TxOutRef, TxSkelRedeemer)
    -> TxGen
         InputContext
         (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)))
-> (TxOutRef, TxSkelRedeemer)
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxSkelRedeemer)
-> TxGen
     InputContext
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
Input.toTxInAndWitness) ([(TxOutRef, TxSkelRedeemer)]
 -> ReaderT
      TxContext
      (Either GenerateTxError)
      [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))])
-> [(TxOutRef, TxSkelRedeemer)]
-> ReaderT
     TxContext
     (Either GenerateTxError)
     [(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
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (TxInsReference BuildTx ConwayEra)
forall a. a -> ReaderT TxContext (Either GenerateTxError) 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]
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (TxInsReference BuildTx ConwayEra)
forall a b context.
String -> (a -> b) -> Either ToCardanoError a -> TxGen context 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]
 -> ReaderT
      TxContext
      (Either GenerateTxError)
      (TxInsReference BuildTx ConwayEra))
-> Either ToCardanoError [TxIn]
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (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) <- TxGen
  CollateralContext
  (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
   TxReturnCollateral CtxTx ConwayEra)
-> TxGen
     TxContext
     (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen TxGen
  CollateralContext
  (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
   TxReturnCollateral CtxTx ConwayEra)
Collateral.toCollateralTriplet
  [TxOut CtxTx ConwayEra]
txOuts <- (TxSkelOut
 -> ReaderT
      TxContext (Either GenerateTxError) (TxOut CtxTx ConwayEra))
-> [TxSkelOut]
-> ReaderT
     TxContext (Either GenerateTxError) [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 (TxGen NetworkId (TxOut CtxTx ConwayEra)
-> ReaderT
     TxContext (Either GenerateTxError) (TxOut CtxTx ConwayEra)
forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen (TxGen NetworkId (TxOut CtxTx ConwayEra)
 -> ReaderT
      TxContext (Either GenerateTxError) (TxOut CtxTx ConwayEra))
-> (TxSkelOut -> TxGen NetworkId (TxOut CtxTx ConwayEra))
-> TxSkelOut
-> ReaderT
     TxContext (Either GenerateTxError) (TxOut CtxTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelOut -> TxGen NetworkId (TxOut CtxTx ConwayEra)
Output.toCardanoTxOut) [TxSkelOut]
txSkelOuts
  (TxValidityLowerBound ConwayEra
txValidityLowerBound, TxValidityUpperBound ConwayEra
txValidityUpperBound) <-
    String
-> Either
     ToCardanoError
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
-> TxGen
     TxContext
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
forall a context.
String -> Either ToCardanoError a -> TxGen context a
throwOnToCardanoError
      String
"txSkelToBodyContent: Unable to translate transaction validity range."
      (Either
   ToCardanoError
   (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
 -> TxGen
      TxContext
      (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra))
-> Either
     ToCardanoError
     (TxValidityLowerBound ConwayEra, TxValidityUpperBound ConwayEra)
-> TxGen
     TxContext
     (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 <- TxGen (Map TxOutRef TxOut) (TxMintValue BuildTx ConwayEra)
-> TxGen TxContext (TxMintValue BuildTx ConwayEra)
forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen (TxGen (Map TxOutRef TxOut) (TxMintValue BuildTx ConwayEra)
 -> TxGen TxContext (TxMintValue BuildTx ConwayEra))
-> TxGen (Map TxOutRef TxOut) (TxMintValue BuildTx ConwayEra)
-> TxGen TxContext (TxMintValue BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$ TxSkelMints
-> TxGen (Map TxOutRef TxOut) (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
-> ReaderT
     TxContext (Either GenerateTxError) (TxExtraKeyWitnesses ConwayEra)
forall a. a -> ReaderT TxContext (Either GenerateTxError) 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]
-> ReaderT
     TxContext (Either GenerateTxError) (TxExtraKeyWitnesses ConwayEra)
forall a b context.
String -> (a -> b) -> Either ToCardanoError a -> TxGen context 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]
 -> ReaderT
      TxContext (Either GenerateTxError) (TxExtraKeyWitnesses ConwayEra))
-> Either ToCardanoError [Hash PaymentKey]
-> ReaderT
     TxContext (Either GenerateTxError) (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 <- (TxContext
 -> BuildTxWith
      BuildTx (Maybe (LedgerProtocolParameters ConwayEra)))
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra)))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Maybe (LedgerProtocolParameters ConwayEra)
-> BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith (Maybe (LedgerProtocolParameters ConwayEra)
 -> BuildTxWith
      BuildTx (Maybe (LedgerProtocolParameters ConwayEra)))
-> (TxContext -> Maybe (LedgerProtocolParameters ConwayEra))
-> TxContext
-> 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))
-> (TxContext -> LedgerProtocolParameters ConwayEra)
-> TxContext
-> Maybe (LedgerProtocolParameters ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> LedgerProtocolParameters ConwayEra
Emulator.ledgerProtocolParameters (Params -> LedgerProtocolParameters ConwayEra)
-> (TxContext -> Params)
-> TxContext
-> LedgerProtocolParameters ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxContext -> Params
params)
  TxFee ConwayEra
txFee <- (TxContext -> TxFee ConwayEra)
-> ReaderT TxContext (Either GenerateTxError) (TxFee ConwayEra)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ShelleyBasedEra ConwayEra -> Coin -> TxFee ConwayEra
forall era. ShelleyBasedEra era -> Coin -> TxFee era
Cardano.TxFeeExplicit ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway (Coin -> TxFee ConwayEra)
-> (TxContext -> Coin) -> TxContext -> TxFee ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Emulator.Coin (Integer -> Coin) -> (TxContext -> Integer) -> TxContext -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxContext -> 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)))
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (TxProposalProcedures BuildTx ConwayEra)
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (Maybe
        (Featured
           ConwayEraOnwards
           ConwayEra
           (TxProposalProcedures BuildTx ConwayEra)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxGen
  (PParams, Map TxOutRef TxOut)
  (TxProposalProcedures BuildTx ConwayEra)
-> ReaderT
     TxContext
     (Either GenerateTxError)
     (TxProposalProcedures BuildTx ConwayEra)
forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen ([TxSkelProposal]
-> AnchorResolution
-> TxGen
     (PParams, Map TxOutRef TxOut)
     (TxProposalProcedures BuildTx ConwayEra)
Proposal.toProposalProcedures [TxSkelProposal]
txSkelProposals (TxOpts -> AnchorResolution
txOptAnchorResolution TxOpts
txSkelOpts))
  TxWithdrawals BuildTx ConwayEra
txWithdrawals <- TxGen WithdrawalsContext (TxWithdrawals BuildTx ConwayEra)
-> TxGen TxContext (TxWithdrawals BuildTx ConwayEra)
forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen (TxSkelWithdrawals
-> TxGen WithdrawalsContext (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
  TxBodyContent BuildTx ConwayEra
-> BodyGen (TxBodyContent BuildTx ConwayEra)
forall a. a -> ReaderT TxContext (Either GenerateTxError) 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))
TxScriptValidity ConwayEra
TxMintValue BuildTx ConwayEra
TxUpdateProposal ConwayEra
TxCertificates BuildTx ConwayEra
TxWithdrawals BuildTx ConwayEra
TxExtraKeyWitnesses ConwayEra
TxAuxScripts ConwayEra
TxMetadataInEra ConwayEra
TxValidityLowerBound ConwayEra
TxValidityUpperBound ConwayEra
TxFee ConwayEra
TxTotalCollateral ConwayEra
TxReturnCollateral CtxTx ConwayEra
TxInsReference BuildTx ConwayEra
TxInsCollateral ConwayEra
BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
forall a. Maybe a
forall era. TxScriptValidity era
forall era. TxUpdateProposal era
forall era. TxAuxScripts era
forall era. TxMetadataInEra 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
txIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))]
txInsCollateral :: TxInsCollateral ConwayEra
txInsReference :: TxInsReference BuildTx ConwayEra
txOuts :: [TxOut CtxTx ConwayEra]
txTotalCollateral :: TxTotalCollateral ConwayEra
txReturnCollateral :: TxReturnCollateral CtxTx ConwayEra
txFee :: TxFee ConwayEra
txValidityLowerBound :: TxValidityLowerBound ConwayEra
txValidityUpperBound :: TxValidityUpperBound ConwayEra
txMetadata :: TxMetadataInEra ConwayEra
txAuxScripts :: TxAuxScripts ConwayEra
txExtraKeyWits :: TxExtraKeyWitnesses ConwayEra
txProtocolParams :: BuildTxWith BuildTx (Maybe (LedgerProtocolParameters ConwayEra))
txWithdrawals :: TxWithdrawals BuildTx ConwayEra
txCertificates :: TxCertificates BuildTx ConwayEra
txUpdateProposal :: TxUpdateProposal ConwayEra
txMintValue :: TxMintValue BuildTx ConwayEra
txScriptValidity :: TxScriptValidity ConwayEra
txProposalProcedures :: Maybe
  (Featured
     ConwayEraOnwards
     ConwayEra
     (TxProposalProcedures BuildTx ConwayEra))
txVotingProcedures :: Maybe
  (Featured
     ConwayEraOnwards ConwayEra (TxVotingProcedures BuildTx ConwayEra))
..}

-- | Generates a transaction for a skeleton. We first generate a body and we
-- sign it with the required signers.
txSkelToCardanoTx :: TxSkel -> BodyGen (Cardano.Tx Cardano.ConwayEra)
txSkelToCardanoTx :: TxSkel -> BodyGen (Tx ConwayEra)
txSkelToCardanoTx TxSkel
txSkel = do
  -- We begin by creating the body content of the transaction
  TxBodyContent BuildTx ConwayEra
txBodyContent <- TxSkel -> BodyGen (TxBodyContent BuildTx ConwayEra)
txSkelToBodyContent TxSkel
txSkel

  -- 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) <-
    Either GenerateTxError (TxBody ConwayEra)
-> ReaderT TxContext (Either GenerateTxError) (TxBody ConwayEra)
forall (m :: * -> *) a. Monad m => m a -> ReaderT TxContext m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either GenerateTxError (TxBody ConwayEra)
 -> ReaderT TxContext (Either GenerateTxError) (TxBody ConwayEra))
-> Either GenerateTxError (TxBody ConwayEra)
-> ReaderT TxContext (Either GenerateTxError) (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$ (TxBodyError -> GenerateTxError)
-> Either TxBodyError (TxBody ConwayEra)
-> Either GenerateTxError (TxBody ConwayEra)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (String -> TxBodyError -> GenerateTxError
TxBodyError String
"generateTx :") (Either TxBodyError (TxBody ConwayEra)
 -> Either GenerateTxError (TxBody ConwayEra))
-> Either TxBodyError (TxBody ConwayEra)
-> Either GenerateTxError (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$ 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

  -- 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 retrieve the data available in the context
  Map DatumHash Datum
mData <- (TxContext -> Map DatumHash Datum)
-> ReaderT TxContext (Either GenerateTxError) (Map DatumHash Datum)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TxContext -> Map DatumHash Datum
managedData
  -- We retrieve the outputs available in the context
  Map TxOutRef TxOut
mTxOut <- (TxContext -> Map TxOutRef TxOut)
-> ReaderT TxContext (Either GenerateTxError) (Map TxOutRef TxOut)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TxContext -> Map TxOutRef TxOut
managedTxOuts
  -- We attempt to resolve the reference inputs used by the skeleton
  [TxOut]
refIns <- [TxOutRef]
-> (TxOutRef -> ReaderT TxContext (Either GenerateTxError) TxOut)
-> ReaderT TxContext (Either GenerateTxError) [TxOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (TxSkel -> [TxOutRef]
txSkelReferenceTxOutRefs TxSkel
txSkel) ((TxOutRef -> ReaderT TxContext (Either GenerateTxError) TxOut)
 -> ReaderT TxContext (Either GenerateTxError) [TxOut])
-> (TxOutRef -> ReaderT TxContext (Either GenerateTxError) TxOut)
-> ReaderT TxContext (Either GenerateTxError) [TxOut]
forall a b. (a -> b) -> a -> b
$ \TxOutRef
oRef ->
    String
-> TxOutRef
-> Map TxOutRef TxOut
-> ReaderT TxContext (Either GenerateTxError) TxOut
forall k a context.
Ord k =>
String -> k -> Map k a -> TxGen context a
throwOnLookup (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) TxOutRef
oRef Map TxOutRef TxOut
mTxOut
  -- 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 -> ReaderT TxContext (Either GenerateTxError) Datum)
-> ReaderT TxContext (Either GenerateTxError) [Datum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DatumHash]
datumHashes ((DatumHash -> ReaderT TxContext (Either GenerateTxError) Datum)
 -> ReaderT TxContext (Either GenerateTxError) [Datum])
-> (DatumHash -> ReaderT TxContext (Either GenerateTxError) Datum)
-> ReaderT TxContext (Either GenerateTxError) [Datum]
forall a b. (a -> b) -> a -> b
$ \DatumHash
dHash ->
    String
-> DatumHash
-> Map DatumHash Datum
-> ReaderT TxContext (Either GenerateTxError) Datum
forall k a context.
Ord k =>
String -> k -> Map k a -> TxGen context a
throwOnLookup (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) DatumHash
dHash Map DatumHash Datum
mData
  -- We compute the map from datum hash to datum of these additional required data
  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]
  -- We retrieve a needed parameter to process difference plutus languages
  Language -> LangDepView
toLangDepViewParam <- (TxContext -> Language -> LangDepView)
-> ReaderT
     TxContext (Either GenerateTxError) (Language -> LangDepView)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PParams -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
Conway.getLanguageView (PParams -> Language -> LangDepView)
-> (TxContext -> PParams) -> TxContext -> Language -> LangDepView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerProtocolParameters ConwayEra
-> PParams (ShelleyLedgerEra ConwayEra)
LedgerProtocolParameters ConwayEra -> PParams
forall era.
LedgerProtocolParameters era -> PParams (ShelleyLedgerEra era)
Cardano.unLedgerProtocolParameters (LedgerProtocolParameters ConwayEra -> PParams)
-> (TxContext -> LedgerProtocolParameters ConwayEra)
-> TxContext
-> PParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> LedgerProtocolParameters ConwayEra
Emulator.ledgerProtocolParameters (Params -> LedgerProtocolParameters ConwayEra)
-> (TxContext -> Params)
-> TxContext
-> LedgerProtocolParameters ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxContext -> Params
params)
  -- We convert our data map into a 'TxDats'
  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
      -- 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 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)
      -- 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 (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
      -- We wrap all of this in the new body
      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

  -- We return the transaction signed by all the required signers. The body is
  -- chosen based on whether or not it required additional data.
  Tx ConwayEra -> BodyGen (Tx ConwayEra)
forall a. a -> ReaderT TxContext (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx ConwayEra -> BodyGen (Tx ConwayEra))
-> Tx ConwayEra -> BodyGen (Tx ConwayEra)
forall a b. (a -> b) -> a -> b
$
    CardanoTx -> Tx ConwayEra
Ledger.getEmulatorEraTx (CardanoTx -> Tx ConwayEra) -> CardanoTx -> Tx ConwayEra
forall a b. (a -> b) -> a -> b
$
      (CardanoTx -> ShelleyWitnessSigningKey -> CardanoTx)
-> CardanoTx -> [ShelleyWitnessSigningKey] -> CardanoTx
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
        ((ShelleyWitnessSigningKey -> CardanoTx -> CardanoTx)
-> CardanoTx -> ShelleyWitnessSigningKey -> CardanoTx
forall a b c. (a -> b -> c) -> b -> a -> c
flip ShelleyWitnessSigningKey -> CardanoTx -> CardanoTx
Ledger.addCardanoTxWitness)
        (Tx ConwayEra -> CardanoTx
Ledger.CardanoEmulatorEraTx (Tx ConwayEra -> CardanoTx) -> Tx ConwayEra -> CardanoTx
forall a b. (a -> b) -> a -> b
$ TxBody ConwayEra -> [KeyWitness ConwayEra] -> Tx ConwayEra
forall era. TxBody era -> [KeyWitness era] -> Tx era
Cardano.Tx (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') [])
        (PaymentPrivateKey -> ShelleyWitnessSigningKey
forall a. ToWitness a => a -> ShelleyWitnessSigningKey
Ledger.toWitness (PaymentPrivateKey -> ShelleyWitnessSigningKey)
-> (Wallet -> PaymentPrivateKey)
-> Wallet
-> ShelleyWitnessSigningKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> PaymentPrivateKey
Ledger.PaymentPrivateKey (XPrv -> PaymentPrivateKey)
-> (Wallet -> XPrv) -> Wallet -> PaymentPrivateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> XPrv
walletSK (Wallet -> ShelleyWitnessSigningKey)
-> [Wallet] -> [ShelleyWitnessSigningKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkel -> [Wallet]
txSkelSigners TxSkel
txSkel)
  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