| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Ledger.Typed.Scripts
Synopsis
- data Language
- forwardingMintingPolicyHash :: TypedValidator a -> MintingPolicyHash
- vForwardingMintingPolicy :: TypedValidator a -> Versioned MintingPolicy
- forwardingMintingPolicy :: TypedValidator a -> MintingPolicy
- generalise :: TypedValidator a -> TypedValidator Any
- vValidatorScript :: TypedValidator a -> Versioned Validator
- validatorScript :: TypedValidator a -> Validator
- validatorCardanoAddress :: NetworkId -> TypedValidator a -> AddressInEra BabbageEra
- validatorAddress :: TypedValidator a -> Address
- validatorHash :: TypedValidator a -> ValidatorHash
- type UntypedValidator = BuiltinData -> BuiltinData -> BuiltinData -> ()
- type UntypedMintingPolicy = BuiltinData -> BuiltinData -> ()
- type UntypedStakeValidator = BuiltinData -> BuiltinData -> ()
- data Any
- type family DatumType a
- type family RedeemerType a
- class ValidatorTypes a where
- type RedeemerType a
- type DatumType a
- data TypedValidator a = TypedValidator {}
- class UnsafeFromData sc => IsScriptContext sc where
- mkUntypedValidator :: (UnsafeFromData d, UnsafeFromData r) => (d -> r -> sc -> Bool) -> UntypedValidator
- mkUntypedStakeValidator :: UnsafeFromData r => (r -> sc -> Bool) -> UntypedStakeValidator
- mkUntypedMintingPolicy :: UnsafeFromData r => (r -> sc -> Bool) -> UntypedMintingPolicy
- type ScriptContextV1 = ScriptContext
- type ScriptContextV2 = ScriptContext
- data Versioned script = Versioned {
- unversioned :: script
- version :: Language
- data MintingPolicy
- data Validator
- data ConnectionError
- mkForwardingMintingPolicy :: Versioned Validator -> Versioned MintingPolicy
- unsafeMkTypedValidator :: Versioned Validator -> TypedValidator Any
- type ValidatorType a = DatumType a -> RedeemerType a -> ScriptContext -> Bool
- mkTypedValidator :: CompiledCode (ValidatorType a) -> CompiledCode (ValidatorType a -> UntypedValidator) -> TypedValidator a
- mkTypedValidatorParam :: forall a param. Lift DefaultUni param => CompiledCode (param -> ValidatorType a) -> CompiledCode (ValidatorType a -> UntypedValidator) -> param -> TypedValidator a
Documentation
Non-Native Script language. This is an Enumerated type. This is expected to be an open type. We will add new Constuctors to this type as additional Non-Native scripting language as are added. We use an enumerated type for two reasons. 1) We can write total functions by case analysis over the constructors 2) We will use DataKinds to make some datatypes indexed by Language For now, the only Non-Native Scriting language is Plutus We might add new languages in the futures.
Note that the the serialization of Language depends on the ordering.
Instances
| Bounded Language | |
| Enum Language | |
Defined in Cardano.Ledger.Alonzo.Language Methods succ :: Language -> Language Source # pred :: Language -> Language Source # toEnum :: Int -> Language Source # fromEnum :: Language -> Int Source # enumFrom :: Language -> [Language] Source # enumFromThen :: Language -> Language -> [Language] Source # enumFromTo :: Language -> Language -> [Language] Source # enumFromThenTo :: Language -> Language -> Language -> [Language] Source # | |
| Eq Language | |
| Ord Language | |
Defined in Cardano.Ledger.Alonzo.Language | |
| Show Language | |
| Ix Language | |
Defined in Cardano.Ledger.Alonzo.Language | |
| Generic Language | |
| NFData Language | |
Defined in Cardano.Ledger.Alonzo.Language | |
| FromCBOR Language | |
| ToCBOR Language | |
| NoThunks Language | |
| ToSchema Language Source # | |
Defined in Ledger.Orphans Methods declareNamedSchema :: Proxy Language -> Declare (Definitions Schema) NamedSchema Source # | |
| type Rep Language | |
Defined in Cardano.Ledger.Alonzo.Language | |
forwardingMintingPolicyHash :: TypedValidator a -> MintingPolicyHash Source #
Hash of the minting policy that forwards all checks to the instance's validator
vForwardingMintingPolicy :: TypedValidator a -> Versioned MintingPolicy Source #
The minting policy that forwards all checks to the instance's validator
forwardingMintingPolicy :: TypedValidator a -> MintingPolicy Source #
The unversioned minting policy that forwards all checks to the instance's validator
generalise :: TypedValidator a -> TypedValidator Any Source #
Generalise the typed validator to one that works with the Data type.
vValidatorScript :: TypedValidator a -> Versioned Validator Source #
The validator script itself.
validatorScript :: TypedValidator a -> Validator Source #
The unversioned validator script itself.
validatorCardanoAddress :: NetworkId -> TypedValidator a -> AddressInEra BabbageEra Source #
The address of the validator.
validatorAddress :: TypedValidator a -> Address Source #
The address of the validator.
validatorHash :: TypedValidator a -> ValidatorHash Source #
The hash of the validator.
type UntypedValidator = BuiltinData -> BuiltinData -> BuiltinData -> () Source #
type UntypedMintingPolicy = BuiltinData -> BuiltinData -> () Source #
type UntypedStakeValidator = BuiltinData -> BuiltinData -> () Source #
Instances
| Eq Any | |
| Show Any | |
| Generic Any | |
| ToJSON Any | |
| ValidatorTypes Any | |
Defined in Plutus.Script.Utils.Typed | |
| type Rep Any | |
| type DatumType Any | |
Defined in Plutus.Script.Utils.Typed | |
| type RedeemerType Any | |
Defined in Plutus.Script.Utils.Typed | |
type family DatumType a Source #
The type of the data of this connection type.
Instances
| type DatumType Void | |
Defined in Plutus.Script.Utils.Typed | |
| type DatumType Any | |
Defined in Plutus.Script.Utils.Typed | |
type family RedeemerType a Source #
The type of the redeemers of this connection type.
Instances
| type RedeemerType Void | |
Defined in Plutus.Script.Utils.Typed | |
| type RedeemerType Any | |
Defined in Plutus.Script.Utils.Typed | |
class ValidatorTypes a Source #
A class that associates a type standing for a connection type with two types, the type of the redeemer and the data script for that connection type.
Associated Types
type RedeemerType a Source #
The type of the redeemers of this connection type.
type RedeemerType a = ()
The type of the data of this connection type.
type DatumType a = ()
Instances
| ValidatorTypes Void | |
Defined in Plutus.Script.Utils.Typed | |
| ValidatorTypes Any | |
Defined in Plutus.Script.Utils.Typed | |
data TypedValidator a Source #
A typed validator script with its ValidatorScript and Address.
Constructors
| TypedValidator | |
Fields
| |
Instances
class UnsafeFromData sc => IsScriptContext sc where Source #
Minimal complete definition
Nothing
Methods
mkUntypedValidator :: (UnsafeFromData d, UnsafeFromData r) => (d -> r -> sc -> Bool) -> UntypedValidator Source #
Converts a custom datum and redeemer from a validator function to an untyped validator function. See Note [Scripts returning Bool].
Here's an example of how this function can be used:
import PlutusTx qualified
import Plutus.V2.Ledger.Scripts qualified as Plutus
import Plutus.Script.Utils.V2.Scripts (mkUntypedValidator)
newtype MyCustomDatum = MyCustomDatum Integer
PlutusTx.unstableMakeIsData ''MyCustomDatum
newtype MyCustomRedeemer = MyCustomRedeemer Integer
PlutusTx.unstableMakeIsData ''MyCustomRedeemer
mkValidator :: MyCustomDatum -> MyCustomRedeemer -> Plutus.ScriptContext -> Bool
mkValidator _ _ _ = True
validator :: Plutus.Validator
validator = Plutus.mkValidatorScript
$$(PlutusTx.compile [|| wrap ||])
where
wrap = mkUntypedValidator mkValidator
Here's an example using a parameterized validator:
import PlutusTx qualified
import Plutus.V2.Ledger.Scripts qualified as Plutus
import Plutus.Script.Utils.V2.Scripts (mkUntypedValidator)
newtype MyCustomDatum = MyCustomDatum Integer
PlutusTx.unstableMakeIsData ''MyCustomDatum
newtype MyCustomRedeemer = MyCustomRedeemer Integer
PlutusTx.unstableMakeIsData ''MyCustomRedeemer
mkValidator :: Int -> MyCustomDatum -> MyCustomRedeemer -> Plutus.ScriptContext -> Bool
mkValidator _ _ _ _ = True
validator :: Int -> Plutus.Validator
validator i = Plutus.mkValidatorScript
$$(PlutusTx.compile [|| wrap . mkValidator ||]) applyCode PlutusTx.liftCode i
where
wrap = mkUntypedValidator
For debugging purpose, it may be of interest to know that in the default implementation, the parameters are decoded in the order they appear (data, redeemer and then script context). A log trace is generated after each successfully decoded parameter. Thus, if a parameter can't be decoded, the culprit is the first parameter in the list that doesn't appear as successfully decoded in the log trace.
mkUntypedStakeValidator :: UnsafeFromData r => (r -> sc -> Bool) -> UntypedStakeValidator Source #
Converts a custom redeemer from a stake validator function to an untyped stake validator function. See Note [Scripts returning Bool].
Here's an example of how this function can be used:
import PlutusTx qualified
import Plutus.V1.Ledger.Scripts qualified as Plutus
import Plutus.Script.Utils.V1.Scripts (mkUntypedStakeValidator)
newtype MyCustomRedeemer = MyCustomRedeemer Integer
PlutusTx.unstableMakeIsData ''MyCustomRedeemer
mkStakeValidator :: MyCustomRedeemer -> ScriptContext -> Bool
mkStakeValidator _ _ = True
validator :: Plutus.Validator
validator = Plutus.mkStakeValidatorScript
$$(PlutusTx.compile [|| wrap ||])
where
wrap = mkUntypedStakeValidator mkStakeValidator
For debugging purpose, it may be of interest to know that in the default implementation, the parameters are decoded in the order they appear (redeemer and then script context). A log trace is generated after each successfully decoded parameter. Thus, if a parameter can't be decoded, the culprit is the first parameter in the list that doesn't appear as successfully decoded in the log trace.
mkUntypedMintingPolicy :: UnsafeFromData r => (r -> sc -> Bool) -> UntypedMintingPolicy Source #
Converts a custom redeemer from a minting policy function to an untyped minting policy function. See Note [Scripts returning Bool].
Here's an example of how this function can be used:
import PlutusTx qualified
import Plutus.V1.Ledger.Scripts qualified as Plutus
import Plutus.Script.Utils.V1.Scripts (mkUntypedMintingPolicy)
newtype MyCustomRedeemer = MyCustomRedeemer Integer
PlutusTx.unstableMakeIsData ''MyCustomRedeemer
mkMintingPolicy :: MyCustomRedeemer -> ScriptContext -> Bool
mkMintingPolicy _ _ = True
validator :: Plutus.Validator
validator = Plutus.mkMintingPolicyScript
$$(PlutusTx.compile [|| wrap ||])
where
wrap = mkUntypedMintingPolicy mkMintingPolicy
For debugging purpose, it may be of interest to know that in the default implementation, the parameters are decoded in the order they appear (redeemer and then script context). A log trace is generated after each successfully decoded parameter. Thus, if a parameter can't be decoded, the culprit is the first parameter in the list that doesn't appear as successfully decoded in the log trace.
Instances
| IsScriptContext ScriptContext | |
Defined in Plutus.Script.Utils.Typed Methods mkUntypedValidator :: (UnsafeFromData d, UnsafeFromData r) => (d -> r -> ScriptContext -> Bool) -> UntypedValidator Source # mkUntypedStakeValidator :: UnsafeFromData r => (r -> ScriptContext -> Bool) -> UntypedStakeValidator Source # mkUntypedMintingPolicy :: UnsafeFromData r => (r -> ScriptContext -> Bool) -> UntypedMintingPolicy Source # | |
| IsScriptContext ScriptContext | |
Defined in Plutus.Script.Utils.Typed Methods mkUntypedValidator :: (UnsafeFromData d, UnsafeFromData r) => (d -> r -> ScriptContext -> Bool) -> UntypedValidator Source # mkUntypedStakeValidator :: UnsafeFromData r => (r -> ScriptContext -> Bool) -> UntypedStakeValidator Source # mkUntypedMintingPolicy :: UnsafeFromData r => (r -> ScriptContext -> Bool) -> UntypedMintingPolicy Source # | |
type ScriptContextV1 = ScriptContext Source #
type ScriptContextV2 = ScriptContext Source #
data Versioned script Source #
A script of some kind with its Plutus language version
Constructors
| Versioned | |
Fields
| |
Instances
data MintingPolicy Source #
MintingPolicy is a wrapper around Scripts which are used as validators for minting constraints.
Instances
Instances
| Eq Validator | |
| Ord Validator | |
Defined in Plutus.V1.Ledger.Scripts | |
| Show Validator | |
| Generic Validator | |
| NFData Validator | |
Defined in Plutus.V1.Ledger.Scripts | |
| ToJSON Validator Source # | |
| FromJSON Validator Source # | |
| ToSchema Validator Source # | |
Defined in Ledger.Orphans Methods declareNamedSchema :: Proxy Validator -> Declare (Definitions Schema) NamedSchema Source # | |
| Pretty Validator | |
| Serialise Validator | |
| type Rep Validator | |
Defined in Plutus.V1.Ledger.Scripts | |
data ConnectionError Source #
An error we can get while trying to type an existing transaction part.
Constructors
| WrongValidatorAddress Address Address | |
| WrongOutType WrongOutTypeError | |
| WrongValidatorType String | |
| WrongRedeemerType BuiltinData | |
| WrongDatumType BuiltinData | |
| NoDatum TxOutRef DatumHash | |
| UnknownRef TxOutRef |
Instances
unsafeMkTypedValidator :: Versioned Validator -> TypedValidator Any Source #
Make a TypedValidator (with no type constraints) from an untyped Validator script.
type ValidatorType a = DatumType a -> RedeemerType a -> ScriptContext -> Bool Source #
The type of validators for the given connection type.
Arguments
| :: CompiledCode (ValidatorType a) | Validator script (compiled) |
| -> CompiledCode (ValidatorType a -> UntypedValidator) | A wrapper for the compiled validator |
| -> TypedValidator a |
Make a TypedValidator from the CompiledCode of a validator script and its wrapper.
mkTypedValidatorParam Source #
Arguments
| :: forall a param. Lift DefaultUni param | |
| => CompiledCode (param -> ValidatorType a) | Validator script (compiled) |
| -> CompiledCode (ValidatorType a -> UntypedValidator) | A wrapper for the compiled validator |
| -> param | The extra paramater for the validator script |
| -> TypedValidator a |
Make a TypedValidator from the CompiledCode of a parameterized validator script and its wrapper.