Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
The interface to Plutus V1 for the ledger.
Synopsis
- type SerialisedScript = ShortByteString
- data ScriptForEvaluation
- serialisedScript ∷ ScriptForEvaluation → SerialisedScript
- deserialisedScript ∷ ScriptForEvaluation → ScriptNamedDeBruijn
- serialiseCompiledCode ∷ ∀ a. CompiledCode a → SerialisedScript
- serialiseUPLC ∷ Program DeBruijn DefaultUni DefaultFun () → SerialisedScript
- deserialiseScript ∷ ∀ m. MonadError ScriptDecodeError m ⇒ MajorProtocolVersion → SerialisedScript → m ScriptForEvaluation
- uncheckedDeserialiseUPLC ∷ SerialisedScript → Program DeBruijn DefaultUni DefaultFun ()
- evaluateScriptRestricting ∷ MajorProtocolVersion → VerboseMode → EvaluationContext → ExBudget → ScriptForEvaluation → [Data] → (LogOutput, Either EvaluationError ExBudget)
- evaluateScriptCounting ∷ MajorProtocolVersion → VerboseMode → EvaluationContext → ScriptForEvaluation → [Data] → (LogOutput, Either EvaluationError ExBudget)
- newtype MajorProtocolVersion = MajorProtocolVersion {}
- data VerboseMode
- type LogOutput = [Text]
- data ExBudget = ExBudget {}
- newtype ExCPU = ExCPU CostingInteger
- newtype ExMemory = ExMemory CostingInteger
- data SatInt
- fromSatInt ∷ Num a ⇒ SatInt → a
- data EvaluationContext
- mkEvaluationContext ∷ (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m) ⇒ [Int64] → m EvaluationContext
- data ParamName
- = AddInteger'cpu'arguments'intercept
- | AddInteger'cpu'arguments'slope
- | AddInteger'memory'arguments'intercept
- | AddInteger'memory'arguments'slope
- | AppendByteString'cpu'arguments'intercept
- | AppendByteString'cpu'arguments'slope
- | AppendByteString'memory'arguments'intercept
- | AppendByteString'memory'arguments'slope
- | AppendString'cpu'arguments'intercept
- | AppendString'cpu'arguments'slope
- | AppendString'memory'arguments'intercept
- | AppendString'memory'arguments'slope
- | BData'cpu'arguments
- | BData'memory'arguments
- | Blake2b_256'cpu'arguments'intercept
- | Blake2b_256'cpu'arguments'slope
- | Blake2b_256'memory'arguments
- | CekApplyCost'exBudgetCPU
- | CekApplyCost'exBudgetMemory
- | CekBuiltinCost'exBudgetCPU
- | CekBuiltinCost'exBudgetMemory
- | CekConstCost'exBudgetCPU
- | CekConstCost'exBudgetMemory
- | CekDelayCost'exBudgetCPU
- | CekDelayCost'exBudgetMemory
- | CekForceCost'exBudgetCPU
- | CekForceCost'exBudgetMemory
- | CekLamCost'exBudgetCPU
- | CekLamCost'exBudgetMemory
- | CekStartupCost'exBudgetCPU
- | CekStartupCost'exBudgetMemory
- | CekVarCost'exBudgetCPU
- | CekVarCost'exBudgetMemory
- | ChooseData'cpu'arguments
- | ChooseData'memory'arguments
- | ChooseList'cpu'arguments
- | ChooseList'memory'arguments
- | ChooseUnit'cpu'arguments
- | ChooseUnit'memory'arguments
- | ConsByteString'cpu'arguments'intercept
- | ConsByteString'cpu'arguments'slope
- | ConsByteString'memory'arguments'intercept
- | ConsByteString'memory'arguments'slope
- | ConstrData'cpu'arguments
- | ConstrData'memory'arguments
- | DecodeUtf8'cpu'arguments'intercept
- | DecodeUtf8'cpu'arguments'slope
- | DecodeUtf8'memory'arguments'intercept
- | DecodeUtf8'memory'arguments'slope
- | DivideInteger'cpu'arguments'constant
- | DivideInteger'cpu'arguments'model'arguments'intercept
- | DivideInteger'cpu'arguments'model'arguments'slope
- | DivideInteger'memory'arguments'intercept
- | DivideInteger'memory'arguments'minimum
- | DivideInteger'memory'arguments'slope
- | EncodeUtf8'cpu'arguments'intercept
- | EncodeUtf8'cpu'arguments'slope
- | EncodeUtf8'memory'arguments'intercept
- | EncodeUtf8'memory'arguments'slope
- | EqualsByteString'cpu'arguments'constant
- | EqualsByteString'cpu'arguments'intercept
- | EqualsByteString'cpu'arguments'slope
- | EqualsByteString'memory'arguments
- | EqualsData'cpu'arguments'intercept
- | EqualsData'cpu'arguments'slope
- | EqualsData'memory'arguments
- | EqualsInteger'cpu'arguments'intercept
- | EqualsInteger'cpu'arguments'slope
- | EqualsInteger'memory'arguments
- | EqualsString'cpu'arguments'constant
- | EqualsString'cpu'arguments'intercept
- | EqualsString'cpu'arguments'slope
- | EqualsString'memory'arguments
- | FstPair'cpu'arguments
- | FstPair'memory'arguments
- | HeadList'cpu'arguments
- | HeadList'memory'arguments
- | IData'cpu'arguments
- | IData'memory'arguments
- | IfThenElse'cpu'arguments
- | IfThenElse'memory'arguments
- | IndexByteString'cpu'arguments
- | IndexByteString'memory'arguments
- | LengthOfByteString'cpu'arguments
- | LengthOfByteString'memory'arguments
- | LessThanByteString'cpu'arguments'intercept
- | LessThanByteString'cpu'arguments'slope
- | LessThanByteString'memory'arguments
- | LessThanEqualsByteString'cpu'arguments'intercept
- | LessThanEqualsByteString'cpu'arguments'slope
- | LessThanEqualsByteString'memory'arguments
- | LessThanEqualsInteger'cpu'arguments'intercept
- | LessThanEqualsInteger'cpu'arguments'slope
- | LessThanEqualsInteger'memory'arguments
- | LessThanInteger'cpu'arguments'intercept
- | LessThanInteger'cpu'arguments'slope
- | LessThanInteger'memory'arguments
- | ListData'cpu'arguments
- | ListData'memory'arguments
- | MapData'cpu'arguments
- | MapData'memory'arguments
- | MkCons'cpu'arguments
- | MkCons'memory'arguments
- | MkNilData'cpu'arguments
- | MkNilData'memory'arguments
- | MkNilPairData'cpu'arguments
- | MkNilPairData'memory'arguments
- | MkPairData'cpu'arguments
- | MkPairData'memory'arguments
- | ModInteger'cpu'arguments'constant
- | ModInteger'cpu'arguments'model'arguments'intercept
- | ModInteger'cpu'arguments'model'arguments'slope
- | ModInteger'memory'arguments'intercept
- | ModInteger'memory'arguments'minimum
- | ModInteger'memory'arguments'slope
- | MultiplyInteger'cpu'arguments'intercept
- | MultiplyInteger'cpu'arguments'slope
- | MultiplyInteger'memory'arguments'intercept
- | MultiplyInteger'memory'arguments'slope
- | NullList'cpu'arguments
- | NullList'memory'arguments
- | QuotientInteger'cpu'arguments'constant
- | QuotientInteger'cpu'arguments'model'arguments'intercept
- | QuotientInteger'cpu'arguments'model'arguments'slope
- | QuotientInteger'memory'arguments'intercept
- | QuotientInteger'memory'arguments'minimum
- | QuotientInteger'memory'arguments'slope
- | RemainderInteger'cpu'arguments'constant
- | RemainderInteger'cpu'arguments'model'arguments'intercept
- | RemainderInteger'cpu'arguments'model'arguments'slope
- | RemainderInteger'memory'arguments'intercept
- | RemainderInteger'memory'arguments'minimum
- | RemainderInteger'memory'arguments'slope
- | Sha2_256'cpu'arguments'intercept
- | Sha2_256'cpu'arguments'slope
- | Sha2_256'memory'arguments
- | Sha3_256'cpu'arguments'intercept
- | Sha3_256'cpu'arguments'slope
- | Sha3_256'memory'arguments
- | SliceByteString'cpu'arguments'intercept
- | SliceByteString'cpu'arguments'slope
- | SliceByteString'memory'arguments'intercept
- | SliceByteString'memory'arguments'slope
- | SndPair'cpu'arguments
- | SndPair'memory'arguments
- | SubtractInteger'cpu'arguments'intercept
- | SubtractInteger'cpu'arguments'slope
- | SubtractInteger'memory'arguments'intercept
- | SubtractInteger'memory'arguments'slope
- | TailList'cpu'arguments
- | TailList'memory'arguments
- | Trace'cpu'arguments
- | Trace'memory'arguments
- | UnBData'cpu'arguments
- | UnBData'memory'arguments
- | UnConstrData'cpu'arguments
- | UnConstrData'memory'arguments
- | UnIData'cpu'arguments
- | UnIData'memory'arguments
- | UnListData'cpu'arguments
- | UnListData'memory'arguments
- | UnMapData'cpu'arguments
- | UnMapData'memory'arguments
- | VerifyEd25519Signature'cpu'arguments'intercept
- | VerifyEd25519Signature'cpu'arguments'slope
- | VerifyEd25519Signature'memory'arguments
- data CostModelApplyError
- type CostModelParams = Map Text Int64
- assertWellFormedCostModelParams ∷ MonadError CostModelApplyError m ⇒ CostModelParams → m ()
- data ScriptContext = ScriptContext {}
- data ScriptPurpose
- data BuiltinByteString
- toBuiltin ∷ HasToBuiltin a ⇒ a → ToBuiltin a
- fromBuiltin ∷ HasFromBuiltin arep ⇒ arep → FromBuiltin arep
- toOpaque ∷ HasToOpaque a arep ⇒ a → arep
- fromOpaque ∷ HasFromOpaque arep a ⇒ arep → a
- newtype LedgerBytes = LedgerBytes {}
- fromBytes ∷ ByteString → LedgerBytes
- data DCert
- data StakingCredential
- data Credential
- newtype Value = Value {}
- newtype CurrencySymbol = CurrencySymbol {}
- newtype TokenName = TokenName {}
- singleton ∷ CurrencySymbol → TokenName → Integer → Value
- unionWith ∷ (Integer → Integer → Integer) → Value → Value → Value
- adaSymbol ∷ CurrencySymbol
- adaToken ∷ TokenName
- newtype Lovelace = Lovelace {}
- newtype POSIXTime = POSIXTime {}
- type POSIXTimeRange = Interval POSIXTime
- data Address = Address {}
- newtype PubKeyHash = PubKeyHash {}
- newtype TxId = TxId {}
- data TxInfo = TxInfo {}
- data TxOut = TxOut {}
- data TxOutRef = TxOutRef {}
- data TxInInfo = TxInInfo {}
- data Interval a = Interval {
- ivFrom ∷ LowerBound a
- ivTo ∷ UpperBound a
- data Extended a
- type Closure = Bool
- data UpperBound a = UpperBound (Extended a) Closure
- data LowerBound a = LowerBound (Extended a) Closure
- always ∷ Interval a
- from ∷ a → Interval a
- to ∷ a → Interval a
- lowerBound ∷ a → LowerBound a
- upperBound ∷ a → UpperBound a
- strictLowerBound ∷ a → LowerBound a
- strictUpperBound ∷ a → UpperBound a
- newtype ScriptHash = ScriptHash {}
- newtype Redeemer = Redeemer {}
- newtype RedeemerHash = RedeemerHash BuiltinByteString
- newtype Datum = Datum {}
- newtype DatumHash = DatumHash BuiltinByteString
- data Data
- data BuiltinData = BuiltinData ~Data
- class ToData a where
- toBuiltinData ∷ a → BuiltinData
- class FromData a where
- fromBuiltinData ∷ BuiltinData → Maybe a
- class UnsafeFromData a where
- toData ∷ ToData a ⇒ a → Data
- fromData ∷ FromData a ⇒ Data → Maybe a
- unsafeFromData ∷ UnsafeFromData a ⇒ Data → a
- dataToBuiltinData ∷ Data → BuiltinData
- builtinDataToData ∷ BuiltinData → Data
- class Monad m ⇒ MonadError e (m ∷ Type → Type) | m → e
- data EvaluationError
- data ScriptDecodeError
Scripts
type SerialisedScript = ShortByteString Source #
Scripts to the ledger are serialised bytestrings.
data ScriptForEvaluation Source #
A Plutus script ready to be evaluated on-chain, via evaluateScriptRestricting
.
Instances
Generic ScriptForEvaluation Source # | |
Defined in PlutusLedgerApi.Common.SerialisedScript | |
Show ScriptForEvaluation Source # | |
Defined in PlutusLedgerApi.Common.SerialisedScript | |
NFData ScriptForEvaluation Source # | |
Defined in PlutusLedgerApi.Common.SerialisedScript rnf ∷ ScriptForEvaluation → () Source # | |
Eq ScriptForEvaluation Source # | |
NoThunks ScriptForEvaluation Source # | |
Defined in PlutusLedgerApi.Common.SerialisedScript | |
type Rep ScriptForEvaluation Source # | |
Defined in PlutusLedgerApi.Common.SerialisedScript type Rep ScriptForEvaluation = D1 ('MetaData "ScriptForEvaluation" "PlutusLedgerApi.Common.SerialisedScript" "plutus-ledger-api-1.36.0.0-inplace" 'False) (C1 ('MetaCons "UnsafeScriptForEvaluation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SerialisedScript) :*: S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ScriptNamedDeBruijn))) |
serialisedScript ∷ ScriptForEvaluation → SerialisedScript Source #
Get a SerialisedScript
from a ScriptForEvaluation
. O(1).
deserialisedScript ∷ ScriptForEvaluation → ScriptNamedDeBruijn Source #
Get a ScriptNamedDeBruijn
from a ScriptForEvaluation
. O(1).
serialiseCompiledCode ∷ ∀ a. CompiledCode a → SerialisedScript Source #
Turns a program which was compiled using the 'PlutusTx' toolchain into a binary format that is understood by the network and can be stored on-chain.
serialiseUPLC ∷ Program DeBruijn DefaultUni DefaultFun () → SerialisedScript Source #
Turns a program's AST (most likely manually constructed) into a binary format that is understood by the network and can be stored on-chain.
∷ ∀ m. MonadError ScriptDecodeError m | |
⇒ MajorProtocolVersion | which major protocol version the script was submitted in. |
→ SerialisedScript | the script to deserialise. |
→ m ScriptForEvaluation |
The deserialization from a serialised script into a ScriptForEvaluation
,
ready to be evaluated on-chain.
Called inside phase-1 validation (i.e., deserialisation error is a phase-1 error).
uncheckedDeserialiseUPLC ∷ SerialisedScript → Program DeBruijn DefaultUni DefaultFun () Source #
Deserialises a SerialisedScript
back into an AST. Does *not* do
ledger-language-version-specific checks like for allowable builtins.
Running scripts
evaluateScriptRestricting Source #
∷ MajorProtocolVersion | Which major protocol version to run the operation in |
→ 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 |
→ ScriptForEvaluation | The script to evaluate |
→ [Data] | The arguments to the script |
→ (LogOutput, Either EvaluationError ExBudget) |
Evaluates a script, with a cost model and a budget that restricts how many resources it can use according to the cost model. Also returns the budget that was actually used.
Can be used to calculate budgets for scripts, but even in this case you must give a limit to guard against scripts that run for a long time or loop.
evaluateScriptCounting Source #
∷ MajorProtocolVersion | Which major protocol version to run the operation in |
→ VerboseMode | Whether to produce log output |
→ EvaluationContext | Includes the cost model to use for tallying up the execution costs |
→ ScriptForEvaluation | The script to evaluate |
→ [Data] | The arguments to the script |
→ (LogOutput, Either EvaluationError ExBudget) |
Evaluates a script, returning the minimum budget that the script would need
to evaluate successfully. This will take as long as the script takes, if you need to
limit the execution time of the script also, you can use evaluateScriptRestricting
, which
also returns the used budget.
Protocol version
newtype MajorProtocolVersion Source #
This represents the major component of the Cardano protocol version. The ledger can only supply the major component of the protocol version, not the minor component, and Plutus should only need to care about the major component anyway. This relies on careful understanding between us and the ledger as to what this means.
Instances
Verbose mode and log output
data VerboseMode Source #
A simple toggle indicating whether or not we should accumulate logs during script execution.
Instances
Eq VerboseMode Source # | |
Defined in PlutusLedgerApi.Common.Eval (==) ∷ VerboseMode → VerboseMode → Bool Source # (/=) ∷ VerboseMode → VerboseMode → Bool Source # |
type LogOutput = [Text] Source #
The type of the executed script's accumulated log output: a list of Text
.
It will be an empty list if the VerboseMode
is set to Quiet
.
Costing-related types
Instances
Counts CPU units in picoseconds: maximum value for SatInt is 2^63 ps, or appproximately 106 days.
Instances
FromJSON ExCPU | |
Defined in PlutusCore.Evaluation.Machine.ExMemory | |
ToJSON ExCPU | |
Defined in PlutusCore.Evaluation.Machine.ExMemory | |
Monoid ExCPU | |
Semigroup ExCPU | |
Bounded ExCPU | |
Generic ExCPU | |
Num ExCPU | |
Read ExCPU | |
Show ExCPU | |
NFData ExCPU | |
Defined in PlutusCore.Evaluation.Machine.ExMemory | |
Eq ExCPU | |
Ord ExCPU | |
Defined in PlutusCore.Evaluation.Machine.ExMemory | |
NoThunks ExCPU | |
Pretty ExCPU | |
Serialise ExCPU | |
PrettyBy config ExCPU | |
Lift ExCPU | |
type Rep ExCPU | |
Defined in PlutusCore.Evaluation.Machine.ExMemory type Rep ExCPU = D1 ('MetaData "ExCPU" "PlutusCore.Evaluation.Machine.ExMemory" "plutus-core-1.36.0.0-inplace" 'True) (C1 ('MetaCons "ExCPU" 'PrefixI 'False) (S1 ('MetaSel ('Nothing ∷ Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CostingInteger))) |
Counts size in machine words.
Instances
Instances
fromSatInt ∷ Num a ⇒ SatInt → a Source #
An optimized version of fromIntegral . unSatInt
.
Cost model
data EvaluationContext Source #
An opaque type that contains all the static parameters that the evaluator needs to evaluate a script. This is so that they can be computed once and cached, rather than being recomputed on every evaluation.
Different protocol versions may require different bundles of machine parameters, which allows us for
example to tweak the shape of the costing function of a builtin, so that the builtin costs less.
Currently this means that we have to create multiple DefaultMachineParameters
per language
version, which we put into a cache (represented by an association list) in order to avoid costly
recomputation of machine parameters.
In order to get the appropriate DefaultMachineParameters
at validation time we look it up in the
cache using a semantics variant as a key. We compute the semantics variant from the protocol
version using the stored function. Note that the semantics variant depends on the language version
too, but the latter is known statically (because each language version has its own evaluation
context), hence there's no reason to require it to be provided at runtime.
To say it differently, there's a matrix of semantics variants indexed by (LL, PV) pairs and we
cache its particular row corresponding to the statically given LL in an EvaluationContext
.
The reason why we associate a DefaultMachineParameters
with a semantics variant rather than a
protocol version are
- generally there are far more protocol versions than semantics variants supported by a specific language version, so we save on pointless duplication of bundles of machine parameters
- builtins don't know anything about protocol versions, only semantics variants. It is therefore more semantically precise to associate bundles of machine parameters with semantics variants than with protocol versions
Instances
∷ (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m) | |
⇒ [Int64] | the (updated) cost model parameters of the protocol |
→ m EvaluationContext |
Build the EvaluationContext
.
The input is a list of cost model parameters (which are integer values) passed from the ledger.
IMPORTANT: the cost model parameters MUST appear in the correct order,
matching the names in ParamName
. If the parameters are
supplied in the wrong order then script cost calculations will be incorrect.
IMPORTANT: The evaluation context of every Plutus version must be recreated upon a protocol update with the updated cost model parameters.
The enumeration of all possible cost model parameter names for this language version.
IMPORTANT: The order of appearance of the data constructors here matters. DO NOT REORDER. See Note [Quotation marks in cost model parameter constructors] See Note [Cost model parameters from the ledger's point of view]
Instances
Bounded ParamName Source # | |
Enum ParamName Source # | |
Defined in PlutusLedgerApi.V1.ParamName succ ∷ ParamName → ParamName Source # pred ∷ ParamName → ParamName Source # toEnum ∷ Int → ParamName Source # fromEnum ∷ ParamName → Int Source # enumFrom ∷ ParamName → [ParamName] Source # enumFromThen ∷ ParamName → ParamName → [ParamName] Source # enumFromTo ∷ ParamName → ParamName → [ParamName] Source # enumFromThenTo ∷ ParamName → ParamName → ParamName → [ParamName] Source # | |
Generic ParamName Source # | |
Ix ParamName Source # | |
Defined in PlutusLedgerApi.V1.ParamName | |
Eq ParamName Source # | |
Ord ParamName Source # | |
Defined in PlutusLedgerApi.V1.ParamName | |
IsParamName ParamName Source # | |
Defined in PlutusLedgerApi.V1.ParamName | |
type Rep ParamName Source # | |
Defined in PlutusLedgerApi.V1.ParamName type Rep ParamName = D1 ('MetaData "ParamName" "PlutusLedgerApi.V1.ParamName" "plutus-ledger-api-1.36.0.0-inplace" 'False) (((((((C1 ('MetaCons "AddInteger'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "AddInteger'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "AddInteger'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "AddInteger'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "AppendByteString'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "AppendByteString'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "AppendByteString'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "AppendByteString'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "AppendString'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "AppendString'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type))))) :+: (((C1 ('MetaCons "AppendString'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "AppendString'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "BData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "BData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "Blake2b_256'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "Blake2b_256'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "Blake2b_256'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "CekApplyCost'exBudgetCPU" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "CekApplyCost'exBudgetMemory" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "CekBuiltinCost'exBudgetCPU" 'PrefixI 'False) (U1 ∷ Type → Type)))))) :+: ((((C1 ('MetaCons "CekBuiltinCost'exBudgetMemory" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "CekConstCost'exBudgetCPU" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "CekConstCost'exBudgetMemory" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "CekDelayCost'exBudgetCPU" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "CekDelayCost'exBudgetMemory" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "CekForceCost'exBudgetCPU" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "CekForceCost'exBudgetMemory" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "CekLamCost'exBudgetCPU" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "CekLamCost'exBudgetMemory" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "CekStartupCost'exBudgetCPU" 'PrefixI 'False) (U1 ∷ Type → Type))))) :+: (((C1 ('MetaCons "CekStartupCost'exBudgetMemory" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "CekVarCost'exBudgetCPU" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "CekVarCost'exBudgetMemory" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "ChooseData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ChooseData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "ChooseList'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "ChooseList'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ChooseUnit'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type))) :+: (C1 ('MetaCons "ChooseUnit'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "ConsByteString'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ConsByteString'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type))))))) :+: (((((C1 ('MetaCons "ConsByteString'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ConsByteString'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "ConstrData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "ConstrData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "DecodeUtf8'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "DecodeUtf8'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "DecodeUtf8'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "DecodeUtf8'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "DivideInteger'cpu'arguments'constant" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "DivideInteger'cpu'arguments'model'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type))))) :+: (((C1 ('MetaCons "DivideInteger'cpu'arguments'model'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "DivideInteger'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "DivideInteger'memory'arguments'minimum" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "DivideInteger'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "EncodeUtf8'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "EncodeUtf8'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "EncodeUtf8'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "EncodeUtf8'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type))) :+: (C1 ('MetaCons "EqualsByteString'cpu'arguments'constant" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "EqualsByteString'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "EqualsByteString'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type)))))) :+: ((((C1 ('MetaCons "EqualsByteString'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "EqualsData'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "EqualsData'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "EqualsData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "EqualsInteger'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "EqualsInteger'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "EqualsInteger'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "EqualsString'cpu'arguments'constant" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "EqualsString'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "EqualsString'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type))))) :+: (((C1 ('MetaCons "EqualsString'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "FstPair'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "FstPair'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "HeadList'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "HeadList'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "IData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "IData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "IfThenElse'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type))) :+: (C1 ('MetaCons "IfThenElse'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "IndexByteString'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "IndexByteString'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))))))) :+: ((((((C1 ('MetaCons "LengthOfByteString'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "LengthOfByteString'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "LessThanByteString'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "LessThanByteString'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "LessThanByteString'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "LessThanEqualsByteString'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "LessThanEqualsByteString'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "LessThanEqualsByteString'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "LessThanEqualsInteger'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "LessThanEqualsInteger'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type))))) :+: (((C1 ('MetaCons "LessThanEqualsInteger'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "LessThanInteger'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "LessThanInteger'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "LessThanInteger'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ListData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "ListData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "MapData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "MapData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "MkCons'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "MkCons'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))))) :+: ((((C1 ('MetaCons "MkNilData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "MkNilData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "MkNilPairData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "MkNilPairData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "MkPairData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "MkPairData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ModInteger'cpu'arguments'constant" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "ModInteger'cpu'arguments'model'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "ModInteger'cpu'arguments'model'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ModInteger'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type))))) :+: (((C1 ('MetaCons "ModInteger'memory'arguments'minimum" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "ModInteger'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "MultiplyInteger'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "MultiplyInteger'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "MultiplyInteger'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "MultiplyInteger'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "NullList'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "NullList'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type))) :+: (C1 ('MetaCons "QuotientInteger'cpu'arguments'constant" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "QuotientInteger'cpu'arguments'model'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "QuotientInteger'cpu'arguments'model'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type))))))) :+: (((((C1 ('MetaCons "QuotientInteger'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "QuotientInteger'memory'arguments'minimum" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "QuotientInteger'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "RemainderInteger'cpu'arguments'constant" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "RemainderInteger'cpu'arguments'model'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "RemainderInteger'cpu'arguments'model'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "RemainderInteger'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "RemainderInteger'memory'arguments'minimum" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "RemainderInteger'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "Sha2_256'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type))))) :+: (((C1 ('MetaCons "Sha2_256'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "Sha2_256'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "Sha3_256'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "Sha3_256'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "Sha3_256'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "SliceByteString'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "SliceByteString'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "SliceByteString'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type))) :+: (C1 ('MetaCons "SliceByteString'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "SndPair'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "SndPair'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))))) :+: ((((C1 ('MetaCons "SubtractInteger'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "SubtractInteger'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "SubtractInteger'memory'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "SubtractInteger'memory'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "TailList'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "TailList'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "Trace'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "Trace'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "UnBData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "UnBData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type))))) :+: (((C1 ('MetaCons "UnConstrData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "UnConstrData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)) :+: (C1 ('MetaCons "UnIData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "UnIData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "UnListData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type)))) :+: ((C1 ('MetaCons "UnListData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "UnMapData'cpu'arguments" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "UnMapData'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type))) :+: (C1 ('MetaCons "VerifyEd25519Signature'cpu'arguments'intercept" 'PrefixI 'False) (U1 ∷ Type → Type) :+: (C1 ('MetaCons "VerifyEd25519Signature'cpu'arguments'slope" 'PrefixI 'False) (U1 ∷ Type → Type) :+: C1 ('MetaCons "VerifyEd25519Signature'memory'arguments" 'PrefixI 'False) (U1 ∷ Type → Type))))))))) |
data CostModelApplyError Source #
A fatal error when trying to create a cost given some plain costmodel parameters.
CMUnknownParamError !Text | a costmodel parameter with the give name does not exist in the costmodel to be applied upon |
CMInternalReadError | internal error when we are transforming the applyParams' input to json (should not happen) |
CMInternalWriteError !String | internal error when we are transforming the applied params from json with given jsonstring error (should not happen) |
Instances
type CostModelParams = Map Text Int64 Source #
A raw representation of the ledger's cost model parameters.
The associated keys/names to the parameter values are arbitrarily set by the plutus team; the ledger does not hold any such names.
See Note [Cost model parameters]
assertWellFormedCostModelParams ∷ MonadError CostModelApplyError m ⇒ CostModelParams → m () Source #
Context types
data ScriptContext Source #
The context that the currently-executing script can access.
ScriptContext | |
|
Instances
data ScriptPurpose Source #
Purpose of the script that is currently running
Instances
Supporting types used in the context types
Builtins
data BuiltinByteString Source #
An opaque type representing Plutus Core ByteStrings.
Instances
toBuiltin ∷ HasToBuiltin a ⇒ a → ToBuiltin a Source #
fromBuiltin ∷ HasFromBuiltin arep ⇒ arep → FromBuiltin arep Source #
toOpaque ∷ HasToOpaque a arep ⇒ a → arep Source #
fromOpaque ∷ HasFromOpaque arep a ⇒ arep → a Source #
Bytes
newtype LedgerBytes Source #
Instances
fromBytes ∷ ByteString → LedgerBytes Source #
Lift a Haskell bytestring to the Plutus abstraction LedgerBytes
Certificates
A representation of the ledger DCert. Some information is digested, and not included
DCertDelegRegKey StakingCredential | |
DCertDelegDeRegKey StakingCredential | |
DCertDelegDelegate | |
| |
DCertPoolRegister | A digest of the PoolParams |
| |
DCertPoolRetire PubKeyHash Integer | The retirement certificate and the Epoch in which the retirement will take place |
DCertGenesis | A really terse Digest |
DCertMir | Another really terse Digest |
Instances
Credentials
data StakingCredential Source #
Staking credential used to assign rewards.
StakingHash Credential | The staking hash is the |
StakingPtr | The certificate pointer, constructed by the given
slot number, transaction and certificate indices.
NB: The fields should really be all |
Instances
data Credential Source #
Credentials required to unlock a transaction output.
PubKeyCredential PubKeyHash | The transaction that spends this output must be signed by the private key.
See |
ScriptCredential ScriptHash | The transaction that spends this output must include the validator script and
be accepted by the validator. See |
Instances
Value
The Value
type represents a collection of amounts of different currencies.
We can think of Value
as a vector space whose dimensions are currencies.
Operations on currencies are usually implemented pointwise. That is,
we apply the operation to the quantities for each currency in turn. So
when we add two Value
s the resulting Value
has, for each currency,
the sum of the quantities of that particular currency in the argument
Value
. The effect of this is that the currencies in the Value
are "independent",
and are operated on separately.
Whenever we need to get the quantity of a currency in a Value
where there
is no explicit quantity of that currency in the Value
, then the quantity is
taken to be zero.
There is no 'Ord Value' instance since Value
is only a partial order, so compare
can't
do the right thing in some cases.
Instances
newtype CurrencySymbol Source #
ByteString representing the currency, hashed with BLAKE2b-224.
It is empty for Ada
, 28 bytes for MintingPolicyHash
.
Forms an AssetClass
along with TokenName
.
A Value
is a map from CurrencySymbol
's to a map from TokenName
to an Integer
.
This is a simple type without any validation, use with caution. You may want to add checks for its invariants. See the Shelley ledger specification.