Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- type UntypedValidator = BuiltinData -> BuiltinData -> BuiltinData -> ()
- type UntypedMintingPolicy = BuiltinData -> BuiltinData -> ()
- type UntypedStakeValidator = BuiltinData -> BuiltinData -> ()
- class ValidatorTypes (a :: Type) where
- type RedeemerType a :: Type
- type DatumType a :: Type
- data TypedValidator (a :: Type) = TypedValidator {}
- validatorHash :: TypedValidator a -> ValidatorHash
- validatorCardanoAddress :: NetworkId -> TypedValidator a -> AddressInEra BabbageEra
- validatorCardanoAddressAny :: NetworkId -> TypedValidator a -> AddressAny
- validatorAddress :: TypedValidator a -> Address
- validatorScript :: TypedValidator a -> Validator
- vValidatorScript :: TypedValidator a -> Versioned Validator
- forwardingMintingPolicy :: TypedValidator a -> MintingPolicy
- vForwardingMintingPolicy :: TypedValidator a -> Versioned MintingPolicy
- forwardingMintingPolicyHash :: TypedValidator a -> MintingPolicyHash
- generalise :: forall a. TypedValidator a -> TypedValidator Any
- data Any
- data Language
- data Versioned script = Versioned {
- unversioned :: script
- version :: Language
- 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
Documentation
type UntypedValidator = BuiltinData -> BuiltinData -> BuiltinData -> () Source #
type UntypedMintingPolicy = BuiltinData -> BuiltinData -> () Source #
type UntypedStakeValidator = BuiltinData -> BuiltinData -> () Source #
class ValidatorTypes (a :: Type) 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.
type RedeemerType a :: Type Source #
The type of the redeemers of this connection type.
type RedeemerType a = ()
type DatumType a :: Type Source #
The type of the data of this connection type.
type DatumType a = ()
Instances
ValidatorTypes Void Source # | |
Defined in Plutus.Script.Utils.Typed | |
ValidatorTypes Any Source # | |
Defined in Plutus.Script.Utils.Typed |
data TypedValidator (a :: Type) Source #
A typed validator script with its ValidatorScript
and Address
.
TypedValidator | |
|
Instances
validatorHash :: TypedValidator a -> ValidatorHash Source #
The hash of the validator.
validatorCardanoAddress :: NetworkId -> TypedValidator a -> AddressInEra BabbageEra Source #
The address of the validator.
validatorCardanoAddressAny :: NetworkId -> TypedValidator a -> AddressAny Source #
validatorAddress :: TypedValidator a -> Address Source #
The address of the validator.
validatorScript :: TypedValidator a -> Validator Source #
The unversioned validator script itself.
vValidatorScript :: TypedValidator a -> Versioned Validator Source #
The validator script itself.
forwardingMintingPolicy :: TypedValidator a -> MintingPolicy Source #
The unversioned 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
forwardingMintingPolicyHash :: TypedValidator a -> MintingPolicyHash Source #
Hash of the minting policy that forwards all checks to the instance's validator
generalise :: forall a. TypedValidator a -> TypedValidator Any Source #
Generalise the typed validator to one that works with the Data
type.
Instances
Eq Any Source # | |
Show Any Source # | |
Generic Any Source # | |
ToJSON Any Source # | |
Defined in Plutus.Script.Utils.Typed | |
ValidatorTypes Any Source # | |
Defined in Plutus.Script.Utils.Typed | |
type Rep Any Source # | |
type RedeemerType Any Source # | |
Defined in Plutus.Script.Utils.Typed | |
type DatumType Any Source # | |
Defined in Plutus.Script.Utils.Typed |
Instances
data Versioned script Source #
A script of some kind with its Plutus language version
Versioned | |
|
Instances
Functor Versioned Source # | |
Eq script => Eq (Versioned script) Source # | |
Ord script => Ord (Versioned script) Source # | |
Defined in Plutus.Script.Utils.Scripts compare :: Versioned script -> Versioned script -> Ordering Source # (<) :: Versioned script -> Versioned script -> Bool Source # (<=) :: Versioned script -> Versioned script -> Bool Source # (>) :: Versioned script -> Versioned script -> Bool Source # (>=) :: Versioned script -> Versioned script -> Bool Source # max :: Versioned script -> Versioned script -> Versioned script Source # min :: Versioned script -> Versioned script -> Versioned script Source # | |
Show script => Show (Versioned script) Source # | |
Generic (Versioned script) Source # | |
Serialise script => Serialise (Versioned script) Source # | |
Defined in Plutus.Script.Utils.Scripts encode :: Versioned script -> Encoding decode :: Decoder s (Versioned script) encodeList :: [Versioned script] -> Encoding decodeList :: Decoder s [Versioned script] | |
FromJSON script => FromJSON (Versioned script) Source # | |
Defined in Plutus.Script.Utils.Scripts parseJSON :: Value -> Parser (Versioned script) parseJSONList :: Value -> Parser [Versioned script] | |
ToJSON script => ToJSON (Versioned script) Source # | |
Defined in Plutus.Script.Utils.Scripts toJSON :: Versioned script -> Value toEncoding :: Versioned script -> Encoding toJSONList :: [Versioned script] -> Value toEncodingList :: [Versioned script] -> Encoding | |
Pretty script => Pretty (Versioned script) Source # | |
Defined in Plutus.Script.Utils.Scripts pretty :: Versioned script -> Doc ann prettyList :: [Versioned script] -> Doc ann | |
type Rep (Versioned script) Source # | |
Defined in Plutus.Script.Utils.Scripts type Rep (Versioned script) = D1 ('MetaData "Versioned" "Plutus.Script.Utils.Scripts" "plutus-script-utils-1.2.0.0-5TpLCy32WGLK5IaOxcwe9j" 'False) (C1 ('MetaCons "Versioned" 'PrefixI 'True) (S1 ('MetaSel ('Just "unversioned") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 script) :*: S1 ('MetaSel ('Just "version") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Language))) |
class UnsafeFromData sc => IsScriptContext sc where Source #
Nothing
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 Source # | |
Defined in Plutus.Script.Utils.Typed 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 Source # | |
Defined in Plutus.Script.Utils.Typed 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 #