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

Plutus.Script.Utils.Typed

Synopsis

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.

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 #

data TypedValidator (a :: Type) Source #

A typed validator script with its ValidatorScript and Address.

Constructors

TypedValidator 

Fields

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))))

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.

data Any Source #

Instances

Instances details
Eq Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Methods

(==) :: Any -> Any -> Bool Source #

(/=) :: Any -> Any -> Bool Source #

Show Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Generic Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Associated Types

type Rep Any :: Type -> Type Source #

Methods

from :: Any -> Rep Any x Source #

to :: Rep Any x -> Any Source #

ToJSON Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Methods

toJSON :: Any -> Value

toEncoding :: Any -> Encoding

toJSONList :: [Any] -> Value

toEncodingList :: [Any] -> Encoding

ValidatorTypes Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

Associated Types

type RedeemerType Any Source #

type DatumType Any Source #

type Rep Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

type Rep Any = D1 ('MetaData "Any" "Plutus.Script.Utils.Typed" "plutus-script-utils-1.2.0.0-5TpLCy32WGLK5IaOxcwe9j" 'False) (V1 :: Type -> Type)
type RedeemerType Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

type RedeemerType Any = BuiltinData
type DatumType Any Source # 
Instance details

Defined in Plutus.Script.Utils.Typed

type DatumType Any = BuiltinData

data Language #

Constructors

PlutusV1 
PlutusV2 

Instances

Instances details
Bounded Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Enum Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Eq Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Ord Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Show Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Ix Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Generic Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Associated Types

type Rep Language :: Type -> Type Source #

NFData Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Methods

rnf :: Language -> () Source #

Serialise Language 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

encode :: Language -> Encoding

decode :: Decoder s Language

encodeList :: [Language] -> Encoding

decodeList :: Decoder s [Language]

Pretty Language 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

pretty :: Language -> Doc ann

prettyList :: [Language] -> Doc ann

NoThunks Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Methods

noThunks :: Context -> Language -> IO (Maybe ThunkInfo)

wNoThunks :: Context -> Language -> IO (Maybe ThunkInfo)

showTypeOf :: Proxy Language -> String

FromCBOR Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Methods

fromCBOR :: Decoder s Language

label :: Proxy Language -> Text

ToCBOR Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

Methods

toCBOR :: Language -> Encoding

encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Language -> Size

encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Language] -> Size

type Rep Language 
Instance details

Defined in Cardano.Ledger.Alonzo.Language

type Rep Language = D1 ('MetaData "Language" "Cardano.Ledger.Alonzo.Language" "cardano-ledger-alonzo-0.1.0.0-9kQ50A9XcYDHq5wCBkTOc6" 'False) (C1 ('MetaCons "PlutusV1" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PlutusV2" 'PrefixI 'False) (U1 :: Type -> Type))

data Versioned script Source #

A script of some kind with its Plutus language version

Constructors

Versioned 

Fields

Instances

Instances details
Functor Versioned Source # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

fmap :: (a -> b) -> Versioned a -> Versioned b Source #

(<$) :: a -> Versioned b -> Versioned a Source #

Eq script => Eq (Versioned script) Source # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

(==) :: Versioned script -> Versioned script -> Bool Source #

(/=) :: Versioned script -> Versioned script -> Bool Source #

Ord script => Ord (Versioned script) Source # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

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 # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

showsPrec :: Int -> Versioned script -> ShowS Source #

show :: Versioned script -> String Source #

showList :: [Versioned script] -> ShowS Source #

Generic (Versioned script) Source # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Associated Types

type Rep (Versioned script) :: Type -> Type Source #

Methods

from :: Versioned script -> Rep (Versioned script) x Source #

to :: Rep (Versioned script) x -> Versioned script Source #

Serialise script => Serialise (Versioned script) Source # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

encode :: Versioned script -> Encoding

decode :: Decoder s (Versioned script)

encodeList :: [Versioned script] -> Encoding

decodeList :: Decoder s [Versioned script]

FromJSON script => FromJSON (Versioned script) Source # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

parseJSON :: Value -> Parser (Versioned script)

parseJSONList :: Value -> Parser [Versioned script]

ToJSON script => ToJSON (Versioned script) Source # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

toJSON :: Versioned script -> Value

toEncoding :: Versioned script -> Encoding

toJSONList :: [Versioned script] -> Value

toEncodingList :: [Versioned script] -> Encoding

Pretty script => Pretty (Versioned script) Source # 
Instance details

Defined in Plutus.Script.Utils.Scripts

Methods

pretty :: Versioned script -> Doc ann

prettyList :: [Versioned script] -> Doc ann

type Rep (Versioned script) Source # 
Instance details

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 #

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

Instances details
IsScriptContext ScriptContext Source # 
Instance details

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 Source # 
Instance details

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 #