plutus-tx-constraints-1.2.0.0: Plutus Transaction Constraints
Safe Haskell None
Language Haskell2010

Ledger.Tx.Constraints.OffChain

Synopsis

Lookups

data ScriptLookups a Source #

Constructors

ScriptLookups

Fields

Instances

Instances details
Show ( ScriptLookups a) Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Generic ( ScriptLookups a) Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Semigroup ( ScriptLookups a) Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Monoid ( ScriptLookups a) Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

ToJSON ( ScriptLookups a) Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

FromJSON ( ScriptLookups a) Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

type Rep ( ScriptLookups a) Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

typedValidatorLookups :: TypedValidator a -> ScriptLookups a Source #

A script lookups value with a script instance. For convenience this also includes the minting policy script that forwards all checks to the instance's validator.

If called multiple times, only the first typed validator is kept:

typedValidatorLookups tv1 <> typedValidatorLookups tv2 <> ...
    == typedValidatorLookups tv1

unspentOutputs :: Map TxOutRef DecoratedTxOut -> ScriptLookups a Source #

A script lookups value that uses the map of unspent outputs to resolve input constraints.

mintingPolicy :: Versioned MintingPolicy -> ScriptLookups a Source #

A script lookups value with a versioned minting policy script.

plutusV1MintingPolicy :: MintingPolicy -> ScriptLookups a Source #

A script lookups value with a PlutusV1 minting policy script.

plutusV2MintingPolicy :: MintingPolicy -> ScriptLookups a Source #

A script lookups value with a PlutusV2 minting policy script.

otherScript :: Versioned Validator -> ScriptLookups a Source #

A script lookups value with a versioned validator script.

plutusV1OtherScript :: Validator -> ScriptLookups a Source #

A script lookups value with a PlutusV1 validator script.

plutusV2OtherScript :: Validator -> ScriptLookups a Source #

A script lookups value with a PlutusV2 validator script.

otherData :: Datum -> ScriptLookups a Source #

A script lookups value with a datum.

paymentPubKey :: PaymentPubKey -> ScriptLookups a Source #

A script lookups value with a payment public key

paymentPubKeyHash :: PaymentPubKeyHash -> ScriptLookups a Source #

A script lookups value with a payment public key

Constraints resolution

data SomeLookupsAndConstraints where Source #

Some typed TxConstraints and the ScriptLookups needed to turn them into an UnbalancedTx .

Constructors

SomeLookupsAndConstraints :: forall a. ( FromData (DatumType a), ToData (DatumType a), ToData (RedeemerType a)) => ScriptLookups a -> TxConstraints (RedeemerType a) (DatumType a) -> SomeLookupsAndConstraints

data UnbalancedTx Source #

An unbalanced transaction. It needs to be balanced and signed before it can be submitted to the ledger. See note [Submitting transactions from Plutus contracts] in Wallet .

Constructors

UnbalancedCardanoTx

Fields

Instances

Instances details
Eq UnbalancedTx Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Show UnbalancedTx Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Generic UnbalancedTx Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

ToJSON UnbalancedTx Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

FromJSON UnbalancedTx Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Pretty UnbalancedTx Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

type Rep UnbalancedTx Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

type Rep UnbalancedTx = D1 (' MetaData "UnbalancedTx" "Ledger.Tx.Constraints.OffChain" "plutus-tx-constraints-1.2.0.0-5XBz5Nhh1is2GnetLpxiQv" ' False ) ( C1 (' MetaCons "UnbalancedCardanoTx" ' PrefixI ' True ) ( S1 (' MetaSel (' Just "unBalancedCardanoBuildTx") ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 CardanoBuildTx) :*: S1 (' MetaSel (' Just "unBalancedTxUtxoIndex") ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 ( Map TxOutRef TxOut))))

adjustUnbalancedTx :: PParams -> UnbalancedTx -> Either ToCardanoError ([ Lovelace ], UnbalancedTx ) Source #

Each transaction output should contain a minimum amount of Ada (this is a restriction on the real Cardano network).

mkTx :: ( FromData (DatumType a), ToData (DatumType a), ToData (RedeemerType a)) => Params -> ScriptLookups a -> TxConstraints (RedeemerType a) (DatumType a) -> Either MkTxError UnbalancedTx Source #

Turn a TxConstraints value into an unbalanced transaction that satisfies the constraints. To use this in a contract, see submitTxConstraints and related functions.

mkTxWithParams :: ( FromData (DatumType a), ToData (DatumType a), ToData (RedeemerType a)) => Params -> ScriptLookups a -> TxConstraints (RedeemerType a) (DatumType a) -> Either MkTxError UnbalancedTx Source #

Turn a TxConstraints value into an unbalanced transaction that satisfies the constraints. To use this in a contract, see submitTxConstraints and related functions.

mkSomeTx :: Params -> [ SomeLookupsAndConstraints ] -> Either MkTxError UnbalancedTx Source #

Given a list of SomeLookupsAndConstraints describing the constraints for several scripts, build a single transaction that runs all the scripts.

data MkTxError Source #

Instances

Instances details
Eq MkTxError Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Show MkTxError Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Generic MkTxError Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

ToJSON MkTxError Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

FromJSON MkTxError Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

Pretty MkTxError Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

type Rep MkTxError Source #
Instance details

Defined in Ledger.Tx.Constraints.OffChain

type Rep MkTxError = D1 (' MetaData "MkTxError" "Ledger.Tx.Constraints.OffChain" "plutus-tx-constraints-1.2.0.0-5XBz5Nhh1is2GnetLpxiQv" ' False ) (((( C1 (' MetaCons "TypeCheckFailed" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 ConnectionError)) :+: C1 (' MetaCons "ToCardanoError" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 ToCardanoError))) :+: ( C1 (' MetaCons "TxOutRefNotFound" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 TxOutRef )) :+: C1 (' MetaCons "TxOutRefWrongType" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 TxOutRef )))) :+: (( C1 (' MetaCons "TxOutRefNoReferenceScript" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 TxOutRef )) :+: C1 (' MetaCons "DatumNotFound" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 DatumHash ))) :+: ( C1 (' MetaCons "DeclaredInputMismatch" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 Value )) :+: C1 (' MetaCons "DeclaredOutputMismatch" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 Value ))))) :+: ((( C1 (' MetaCons "MintingPolicyNotFound" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 MintingPolicyHash )) :+: C1 (' MetaCons "ScriptHashNotFound" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 ScriptHash ))) :+: ( C1 (' MetaCons "TypedValidatorMissing" ' PrefixI ' False ) ( U1 :: Type -> Type ) :+: C1 (' MetaCons "DatumWrongHash" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 DatumHash ) :*: S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 Datum )))) :+: (( C1 (' MetaCons "CannotSatisfyAny" ' PrefixI ' False ) ( U1 :: Type -> Type ) :+: C1 (' MetaCons "NoMatchingOutputFound" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 ValidatorHash ))) :+: ( C1 (' MetaCons "MultipleMatchingOutputsFound" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 ValidatorHash )) :+: ( C1 (' MetaCons "AmbiguousRedeemer" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 TxOutRef ) :*: S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 [ Redeemer ])) :+: C1 (' MetaCons "AmbiguousReferenceScript" ' PrefixI ' False ) ( S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 TxOutRef ) :*: S1 (' MetaSel (' Nothing :: Maybe Symbol ) ' NoSourceUnpackedness ' NoSourceStrictness ' DecidedLazy ) ( Rec0 [ TxOutRef ])))))))

_TypeCheckFailed :: AsMkTxError r => Prism' r ConnectionError Source #

_ToCardanoError :: AsMkTxError r => Prism' r ToCardanoError Source #

Internals exposed for testing

data ValueSpentBalances Source #

The balances we track for computing the missing Value (if any) that needs to be added to the transaction. See note [Balance of value spent].

Constructors

ValueSpentBalances

Fields

data ConstraintProcessingState Source #

Constructors

ConstraintProcessingState

Fields

addOwnInput :: ( MonadReader ( ScriptLookups a) m, MonadError MkTxError m, FromData (DatumType a), ToData (DatumType a), ToData (RedeemerType a)) => ScriptInputConstraint (RedeemerType a) -> m TxConstraint Source #

Add a typed input, checking the type of the output it spends. Return the value of the spent output.

addOwnOutput :: ( MonadReader ( ScriptLookups a) m, MonadError MkTxError m, ToData (DatumType a)) => ScriptOutputConstraint (DatumType a) -> m TxConstraint Source #

Convert a ScriptOutputConstraint into a TxConstraint .