Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
This module provides data structures and operations for talking about Non-native Script languages. It is expected that new languages (or new versions of old languages) will be added here.
Synopsis
- newtype Plutus (l ∷ Language) = Plutus {}
- isValidPlutus ∷ PlutusLanguage l ⇒ Version → Plutus l → Bool
- newtype PlutusBinary = PlutusBinary {}
- newtype PlutusRunnable (l ∷ Language) = PlutusRunnable {}
- plutusFromRunnable ∷ PlutusRunnable l → Plutus l
- decodeWithPlutus ∷ (∀ si l. PlutusLanguage l ⇒ Plutus l → Decoder si a) → Decoder so a
- hashPlutusScript ∷ ∀ c l. (Crypto c, PlutusLanguage l) ⇒ Plutus l → ScriptHash c
- data Language
- mkLanguageEnum ∷ Int → Maybe Language
- languageToText ∷ Language → Text
- languageFromText ∷ MonadFail m ⇒ Text → m Language
- nonNativeLanguages ∷ [Language]
- guardPlutus ∷ Language → Decoder s ()
- data SLanguage (l ∷ Language) where
- class (Typeable l, NFData (PlutusArgs l), EncCBOR (PlutusArgs l), DecCBOR (PlutusArgs l), Pretty (PlutusArgs l), Show (PlutusArgs l), Eq (PlutusArgs l)) ⇒ PlutusLanguage (l ∷ Language) where
- data PlutusArgs l ∷ Type
- isLanguage ∷ SLanguage l
- plutusLanguageTag ∷ Plutus l → Word8
- decodePlutusRunnable ∷ Version → Plutus l → Either ScriptDecodeError (PlutusRunnable l)
- evaluatePlutusRunnable ∷ Version → VerboseMode → EvaluationContext → ExBudget → PlutusRunnable l → PlutusArgs l → (LogOutput, Either EvaluationError ExBudget)
- evaluatePlutusRunnableBudget ∷ Version → VerboseMode → EvaluationContext → PlutusRunnable l → PlutusArgs l → (LogOutput, Either EvaluationError ExBudget)
- mkTermToEvaluate ∷ Version → PlutusRunnable l → PlutusArgs l → Either EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ())
- plutusLanguage ∷ ∀ l proxy. PlutusLanguage l ⇒ proxy l → Language
- plutusSLanguage ∷ PlutusLanguage l ⇒ proxy l → SLanguage l
- toSLanguage ∷ ∀ l m. (PlutusLanguage l, MonadFail m) ⇒ Language → m (SLanguage l)
- withSLanguage ∷ Language → (∀ l. PlutusLanguage l ⇒ SLanguage l → a) → a
- asSLanguage ∷ SLanguage l → proxy l → proxy l
- withSamePlutusLanguage ∷ ∀ f1 f2 l1 l2 a. (PlutusLanguage l1, PlutusLanguage l2) ⇒ f1 l1 → f2 l2 → (∀ l. PlutusLanguage l ⇒ f1 l → f2 l → a) → Maybe a
- data LegacyPlutusArgs l
- = LegacyPlutusArgs2 !Data !(PlutusScriptContext l)
- | LegacyPlutusArgs3 !Data !Data !(PlutusScriptContext l)
- type family PlutusScriptContext (l ∷ Language) = r | r → l where ...
Plutus Script
newtype Plutus (l ∷ Language) Source #
Serialized representation of a Plutus script that distinguishes the language version at the type level. When encoded in CBOR language version is also encoded.
Instances
Generic (Plutus l) Source # | |
Show (Plutus l) Source # | |
PlutusLanguage l ⇒ DecCBOR (Plutus l) Source # | |
PlutusLanguage l ⇒ EncCBOR (Plutus l) Source # | |
SafeToHash (Plutus l) Source # | |
Defined in Cardano.Ledger.Plutus.Language originalBytes ∷ Plutus l → ByteString Source # originalBytesSize ∷ Plutus l → Int Source # makeHashWithExplicitProxys ∷ HashAlgorithm (HASH c) ⇒ Proxy c → Proxy index → Plutus l → SafeHash c index Source # | |
NFData (Plutus l) Source # | |
Defined in Cardano.Ledger.Plutus.Language | |
Eq (Plutus l) Source # | |
Ord (Plutus l) Source # | |
Defined in Cardano.Ledger.Plutus.Language | |
NoThunks (Plutus l) Source # | |
type Rep (Plutus l) Source # | |
Defined in Cardano.Ledger.Plutus.Language type Rep (Plutus l) = D1 ('MetaData "Plutus" "Cardano.Ledger.Plutus.Language" "cardano-ledger-core-1.16.0.0-inplace" 'True) (C1 ('MetaCons "Plutus" 'PrefixI 'True) (S1 ('MetaSel ('Just "plutusBinary") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PlutusBinary))) |
isValidPlutus ∷ PlutusLanguage l ⇒ Version → Plutus l → Bool Source #
Verify that the binary version of the Plutus script is deserializable.
newtype PlutusBinary Source #
Binary representation of a Plutus script.
Instances
newtype PlutusRunnable (l ∷ Language) Source #
This is a deserialized version of the Plutus
type that can be used directly with
evaluation functions that rely on evaluatePlutusRunnable
.
The only way to obtain this type is by the means of deserializing Plutus
with
decodePlutusRunnable
Instances
plutusFromRunnable ∷ PlutusRunnable l → Plutus l Source #
Serialize the runnable version of the plutus script
decodePlutusRunnable majVer (plutusFromRunnable pr) == Right pr
decodeWithPlutus ∷ (∀ si l. PlutusLanguage l ⇒ Plutus l → Decoder si a) → Decoder so a Source #
Plutus script decoder that will enforce the type level language equals the one included in the serialization
hashPlutusScript ∷ ∀ c l. (Crypto c, PlutusLanguage l) ⇒ Plutus l → ScriptHash c Source #
Compute a ScriptHash
of a Plutus
script. This function is equivalent to
hashScript
, except it is restricted to Plutus scripts
Value level Plutus Language version
Non-Native Plutus Script language. This is expected to be an open type. We will add new Constuctors to this type as additional Plutus language versions as are added. We use an enumerated type for two reasons.
- We can write total functions by case analysis over the constructors
- We use DataKinds to make some datatypes indexed by Language.
Note that the the serialization of Language
depends on the ordering.
Instances
guardPlutus ∷ Language → Decoder s () Source #
Prevent decoding a version of Plutus until the appropriate protocol version.
Type level Plutus Language version
data SLanguage (l ∷ Language) where Source #
Singleton for 'Language
'
class (Typeable l, NFData (PlutusArgs l), EncCBOR (PlutusArgs l), DecCBOR (PlutusArgs l), Pretty (PlutusArgs l), Show (PlutusArgs l), Eq (PlutusArgs l)) ⇒ PlutusLanguage (l ∷ Language) where Source #
For implicit reflection on 'SLanguage
'
See Cardano.Ledger.Alonzo.Plutus.TxInfo for example usage
data PlutusArgs l ∷ Type Source #
isLanguage ∷ SLanguage l Source #
plutusLanguageTag ∷ Plutus l → Word8 Source #
Tag that will be used as a prefix to compute the ScriptHash
∷ Version | Which major protocol version to use for deserialization and further execution |
→ Plutus l | Binary version of the script that will be deserialized |
→ Either ScriptDecodeError (PlutusRunnable l) |
evaluatePlutusRunnable Source #
∷ Version | Which major protocol version to use for script execution |
→ VerboseMode | Whether to produce log output |
→ EvaluationContext | Includes the cost model to use for tallying up the execution costs |
→ ExBudget | The resource budget which must not be exceeded during evaluation |
→ PlutusRunnable l | The script to evaluate |
→ PlutusArgs l | The arguments to the script |
→ (LogOutput, Either EvaluationError ExBudget) |
evaluatePlutusRunnableBudget Source #
∷ Version | Which major protocol version to use for script execution |
→ VerboseMode | Whether to produce log output |
→ EvaluationContext | Includes the cost model to use for tallying up the execution costs |
→ PlutusRunnable l | The script to evaluate |
→ PlutusArgs l | The arguments to the script |
→ (LogOutput, Either EvaluationError ExBudget) |
Similar to evaluatePlutusRunnable
, except does not require ExBudget
to be
provided as input and instead computes it as output. This function is meant to be
used for testing.
∷ Version | Which major protocol version to use for script execution |
→ PlutusRunnable l | The script to evaluate |
→ PlutusArgs l | The arguments to the script |
→ Either EvaluationError (Term NamedDeBruijn DefaultUni DefaultFun ()) |
Instances
plutusLanguage ∷ ∀ l proxy. PlutusLanguage l ⇒ proxy l → Language Source #
Construct value level laguage version from the type level
plutusSLanguage ∷ PlutusLanguage l ⇒ proxy l → SLanguage l Source #
toSLanguage ∷ ∀ l m. (PlutusLanguage l, MonadFail m) ⇒ Language → m (SLanguage l) Source #
withSLanguage ∷ Language → (∀ l. PlutusLanguage l ⇒ SLanguage l → a) → a Source #
asSLanguage ∷ SLanguage l → proxy l → proxy l Source #
withSamePlutusLanguage ∷ ∀ f1 f2 l1 l2 a. (PlutusLanguage l1, PlutusLanguage l2) ⇒ f1 l1 → f2 l2 → (∀ l. PlutusLanguage l ⇒ f1 l → f2 l → a) → Maybe a Source #
Plutus Script Context
data LegacyPlutusArgs l Source #
LegacyPlutusArgs2 | Scripts that require 2 arguments. |
| |
LegacyPlutusArgs3 | Scripts that require 3 arguments. Which is only PlutusV1/V2 spending scripts |
|
Instances
type family PlutusScriptContext (l ∷ Language) = r | r → l where ... Source #
Orphan instances
NFData ScriptContext Source # | |
rnf ∷ ScriptContext → () Source # | |
NFData ScriptContext Source # | |
rnf ∷ ScriptContext → () Source # | |
NFData ScriptContext Source # | |
rnf ∷ ScriptContext → () Source # |