plutus-script-utils-1.2.0.0: Helper/utility functions for writing Plutus scripts.
Safe HaskellNone
LanguageHaskell2010

Plutus.Script.Utils.V1.Typed.Scripts.Validators

Synopsis

Documentation

type UntypedValidator = BuiltinData -> BuiltinData -> BuiltinData -> () Source #

mkUntypedValidator :: (IsScriptContext sc, 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.

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.

Associated Types

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

Instances details
ValidatorTypes Void Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Associated Types

type RedeemerType Void Source #

type DatumType Void Source #

ValidatorTypes Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Associated Types

type RedeemerType Any Source #

type DatumType Any Source #

type ValidatorType (a :: Type) = DatumType a -> RedeemerType a -> ScriptContext -> Bool Source #

The type of validators for the given connection type.

data TypedValidator (a :: Type) Source #

A typed validator script with its ValidatorScript and Address.

Instances

Instances details
Eq (TypedValidator a) Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Show (TypedValidator a) Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Generic (TypedValidator a) Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Associated Types

type Rep (TypedValidator a) :: Type -> Type Source #

type Rep (TypedValidator a) Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

type Rep (TypedValidator a) = D1 ('MetaData "TypedValidator" "Plutus.Script.Utils.Typed" "plutus-script-utils-1.2.0.0-5TpLCy32WGLK5IaOxcwe9j" 'False) (C1 ('MetaCons "TypedValidator" 'PrefixI 'True) ((S1 ('MetaSel ('Just "tvValidator") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Versioned Validator)) :*: S1 ('MetaSel ('Just "tvValidatorHash") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ValidatorHash)) :*: (S1 ('MetaSel ('Just "tvForwardingMPS") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Versioned MintingPolicy)) :*: S1 ('MetaSel ('Just "tvForwardingMPSHash") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MintingPolicyHash))))

mkTypedValidator Source #

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.

validatorHash :: TypedValidator a -> ValidatorHash Source #

The hash of the validator.

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.

data WrongOutTypeError Source #

Instances

Instances details
Eq WrongOutTypeError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Ord WrongOutTypeError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Show WrongOutTypeError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Generic WrongOutTypeError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Associated Types

type Rep WrongOutTypeError :: Type -> Type Source #

FromJSON WrongOutTypeError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Methods

parseJSON :: Value -> Parser WrongOutTypeError

parseJSONList :: Value -> Parser [WrongOutTypeError]

ToJSON WrongOutTypeError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

type Rep WrongOutTypeError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

type Rep WrongOutTypeError = D1 ('MetaData "WrongOutTypeError" "Plutus.Script.Utils.V1.Typed.Scripts.Validators" "plutus-script-utils-1.2.0.0-5TpLCy32WGLK5IaOxcwe9j" 'False) (C1 ('MetaCons "ExpectedScriptGotPubkey" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ExpectedPubkeyGotScript" 'PrefixI 'False) (U1 :: Type -> Type))

data ConnectionError Source #

An error we can get while trying to type an existing transaction part.

Instances

Instances details
Eq ConnectionError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Ord ConnectionError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Show ConnectionError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Generic ConnectionError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Associated Types

type Rep ConnectionError :: Type -> Type Source #

Pretty ConnectionError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

Methods

pretty :: ConnectionError -> Doc ann

prettyList :: [ConnectionError] -> Doc ann

type Rep ConnectionError Source # 
Instance details

Defined in Plutus.Script.Utils.V1.Typed.Scripts.Validators

type Rep ConnectionError = D1 ('MetaData "ConnectionError" "Plutus.Script.Utils.V1.Typed.Scripts.Validators" "plutus-script-utils-1.2.0.0-5TpLCy32WGLK5IaOxcwe9j" 'False) ((C1 ('MetaCons "WrongValidatorAddress" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Address) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Address)) :+: (C1 ('MetaCons "WrongOutType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 WrongOutTypeError)) :+: C1 ('MetaCons "WrongValidatorType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))) :+: ((C1 ('MetaCons "WrongRedeemerType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 BuiltinData)) :+: C1 ('MetaCons "WrongDatumType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 BuiltinData))) :+: (C1 ('MetaCons "NoDatum" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TxOutRef) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DatumHash)) :+: C1 ('MetaCons "UnknownRef" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TxOutRef)))))

checkValidatorAddress :: forall a m. MonadError ConnectionError m => TypedValidator a -> Address -> m () Source #

Checks that the given validator hash is consistent with the actual validator.

checkDatum :: forall a m. (FromData (DatumType a), MonadError ConnectionError m) => TypedValidator a -> Datum -> m (DatumType a) Source #

Checks that the given datum has the right type.

checkRedeemer :: forall inn m. (FromData (RedeemerType inn), MonadError ConnectionError m) => TypedValidator inn -> Redeemer -> m (RedeemerType inn) Source #

Checks that the given redeemer script has the right type.