{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TypeApplications   #-}
{- |
The interface to Plutus V1 for the ledger.
-}
module Plutus.V1.Ledger.Api (
    -- * Scripts
    SerializedScript
    , Script
    , fromCompiledCode
    -- * Validating scripts
    , validateScript
    -- * Running scripts
    , evaluateScriptRestricting
    , evaluateScriptCounting
    -- ** Verbose mode and log output
    , VerboseMode (..)
    , LogOutput
    -- * Costing-related types
    , ExBudget (..)
    , ExCPU (..)
    , ExMemory (..)
    , SatInt
    -- ** Cost model
    , validateCostModelParams
    , defaultCostModelParams
    , CostModelParams
    -- * Context types
    , ScriptContext(..)
    , ScriptPurpose(..)
    -- ** Supporting types used in the context types
    -- *** ByteStrings
    , BuiltinByteString
    , toBuiltin
    , fromBuiltin
    -- *** Bytes
    , LedgerBytes (..)
    , fromBytes
    -- *** Certificates
    , DCert(..)
    -- *** Credentials
    , StakingCredential(..)
    , Credential(..)
    -- *** Value
    , Value (..)
    , CurrencySymbol (..)
    , TokenName (..)
    , singleton
    , unionWith
    , adaSymbol
    , adaToken
    -- *** Time
    , POSIXTime (..)
    , POSIXTimeRange
    -- *** Types for representing transactions
    , Address (..)
    , PubKeyHash (..)
    , TxId (..)
    , TxInfo (..)
    , TxOut(..)
    , TxOutRef(..)
    , TxInInfo(..)
    -- *** Intervals
    , Interval (..)
    , Extended (..)
    , Closure
    , UpperBound (..)
    , LowerBound (..)
    , always
    , from
    , to
    , lowerBound
    , upperBound
    , strictLowerBound
    , strictUpperBound
    -- *** Newtypes for script/datum types and hash types
    , Validator (..)
    , mkValidatorScript
    , unValidatorScript
    , ValidatorHash (..)
    , MintingPolicy (..)
    , mkMintingPolicyScript
    , unMintingPolicyScript
    , MintingPolicyHash (..)
    , StakeValidator (..)
    , mkStakeValidatorScript
    , unStakeValidatorScript
    , StakeValidatorHash (..)
    , Redeemer (..)
    , RedeemerHash (..)
    , Datum (..)
    , DatumHash (..)
    -- * Data
    , PLC.Data (..)
    , BuiltinData (..)
    , ToData (..)
    , FromData (..)
    , UnsafeFromData (..)
    , toData
    , fromData
    , dataToBuiltinData
    , builtinDataToData
    -- * Errors
    , EvaluationError (..)
) where

import Codec.Serialise qualified as CBOR
import Control.Monad.Except
import Control.Monad.Writer
import Data.Bifunctor
import Data.ByteString.Lazy (fromStrict)
import Data.ByteString.Short
import Data.Either
import Data.Maybe (isJust)
import Data.SatInt
import Data.Text (Text)
import Data.Tuple
import Plutus.V1.Ledger.Ada
import Plutus.V1.Ledger.Address
import Plutus.V1.Ledger.Bytes
import Plutus.V1.Ledger.Contexts
import Plutus.V1.Ledger.Credential
import Plutus.V1.Ledger.Crypto
import Plutus.V1.Ledger.DCert
import Plutus.V1.Ledger.Interval hiding (singleton)
import Plutus.V1.Ledger.Scripts as Scripts
import Plutus.V1.Ledger.Time
import Plutus.V1.Ledger.TxId
import Plutus.V1.Ledger.Value
import PlutusCore as PLC
import PlutusCore.Data qualified as PLC
import PlutusCore.Evaluation.Machine.CostModelInterface (CostModelParams, applyCostModelParams)
import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
import PlutusCore.Evaluation.Machine.ExBudget qualified as PLC
import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..))
import PlutusCore.Evaluation.Machine.MachineParameters
import PlutusCore.Pretty
import PlutusTx (FromData (..), ToData (..), UnsafeFromData (..), fromData, toData)
import PlutusTx.Builtins.Internal (BuiltinData (..), builtinDataToData, dataToBuiltinData)
import PlutusTx.Prelude (BuiltinByteString, fromBuiltin, toBuiltin)
import Prettyprinter
import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Check.Scope qualified as UPLC
import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC

{- Note [Abstract types in the ledger API]
We need to support old versions of the ledger API as we update the code that it depends on. You
might think that we should therefore make the types that we expose abstract, and only expose
specific functions for constructing and working with them. However the situation is slightly
different for us.

Normally, when you are in this situation, you want to retain the same *interface* as the old version,
but with the new types and functions underneath. Abstraction lets you do this easily. But we actually
want to keep the old *implementation*, because things really have to work the same, bug-for-bug. And
the types have to translate into Plutus Core in exactly the same way, and so on.

So we're going to end up with multiple versions of the types and functions that we expose here, even
internally. That means we don't lose anything by exposing all the details: we're never going to remove
anything, we're just going to create new versions.
-}

-- | Check if a 'Script' is "valid". At the moment this just means "deserialises correctly", which in particular
-- implies that it is (almost certainly) an encoded script and cannot be interpreted as some other kind of encoded data.
validateScript :: SerializedScript -> Bool
validateScript :: SerializedScript -> Bool
validateScript = Either DeserialiseFailure Script -> Bool
forall a b. Either a b -> Bool
isRight (Either DeserialiseFailure Script -> Bool)
-> (SerializedScript -> Either DeserialiseFailure Script)
-> SerializedScript
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serialise Script => ByteString -> Either DeserialiseFailure Script
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
CBOR.deserialiseOrFail @Script (ByteString -> Either DeserialiseFailure Script)
-> (SerializedScript -> ByteString)
-> SerializedScript
-> Either DeserialiseFailure Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> ByteString)
-> (SerializedScript -> ByteString)
-> SerializedScript
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializedScript -> ByteString
fromShort

validateCostModelParams :: CostModelParams -> Bool
validateCostModelParams :: CostModelParams -> Bool
validateCostModelParams = Maybe (CostModel CekMachineCosts BuiltinCostModel) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (CostModel CekMachineCosts BuiltinCostModel) -> Bool)
-> (CostModelParams
    -> Maybe (CostModel CekMachineCosts BuiltinCostModel))
-> CostModelParams
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModel CekMachineCosts BuiltinCostModel
-> CostModelParams
-> Maybe (CostModel CekMachineCosts BuiltinCostModel)
forall evaluatorcosts builtincosts.
(FromJSON evaluatorcosts, FromJSON builtincosts,
 ToJSON evaluatorcosts, ToJSON builtincosts) =>
CostModel evaluatorcosts builtincosts
-> CostModelParams -> Maybe (CostModel evaluatorcosts builtincosts)
applyCostModelParams CostModel CekMachineCosts BuiltinCostModel
PLC.defaultCekCostModel

data VerboseMode = Verbose | Quiet
    deriving (VerboseMode -> VerboseMode -> Bool
(VerboseMode -> VerboseMode -> Bool)
-> (VerboseMode -> VerboseMode -> Bool) -> Eq VerboseMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerboseMode -> VerboseMode -> Bool
$c/= :: VerboseMode -> VerboseMode -> Bool
== :: VerboseMode -> VerboseMode -> Bool
$c== :: VerboseMode -> VerboseMode -> Bool
Eq)

type LogOutput = [Text]

-- | Scripts to the ledger are serialised bytestrings.
type SerializedScript = ShortByteString

-- | Errors that can be thrown when evaluating a Plutus script.
data EvaluationError =
    CekError (UPLC.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) -- ^ An error from the evaluator itself
    | DeBruijnError PLC.FreeVariableError -- ^ An error in the pre-evaluation step of converting from de-Bruijn indices
    | CodecError CBOR.DeserialiseFailure -- ^ A serialisation error
    | IncompatibleVersionError (PLC.Version ()) -- ^ An error indicating a version tag that we don't support
    -- TODO: make this error more informative when we have more information about what went wrong
    | CostModelParameterMismatch -- ^ An error indicating that the cost model parameters didn't match what we expected
    deriving stock (Int -> EvaluationError -> ShowS
[EvaluationError] -> ShowS
EvaluationError -> String
(Int -> EvaluationError -> ShowS)
-> (EvaluationError -> String)
-> ([EvaluationError] -> ShowS)
-> Show EvaluationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluationError] -> ShowS
$cshowList :: [EvaluationError] -> ShowS
show :: EvaluationError -> String
$cshow :: EvaluationError -> String
showsPrec :: Int -> EvaluationError -> ShowS
$cshowsPrec :: Int -> EvaluationError -> ShowS
Show, EvaluationError -> EvaluationError -> Bool
(EvaluationError -> EvaluationError -> Bool)
-> (EvaluationError -> EvaluationError -> Bool)
-> Eq EvaluationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluationError -> EvaluationError -> Bool
$c/= :: EvaluationError -> EvaluationError -> Bool
== :: EvaluationError -> EvaluationError -> Bool
$c== :: EvaluationError -> EvaluationError -> Bool
Eq)

instance Pretty EvaluationError where
    pretty :: EvaluationError -> Doc ann
pretty (CekError CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
e)      = CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
-> Doc ann
forall a ann. PrettyClassic a => a -> Doc ann
prettyClassicDef CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
e
    pretty (DeBruijnError FreeVariableError
e) = FreeVariableError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FreeVariableError
e
    pretty (CodecError DeserialiseFailure
e) = DeserialiseFailure -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow DeserialiseFailure
e
    pretty (IncompatibleVersionError Version ()
actual) = Doc ann
"This version of the Plutus Core interface does not support the version indicated by the AST:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Version () -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Version ()
actual
    pretty EvaluationError
CostModelParameterMismatch = Doc ann
"Cost model parameters were not as we expected"

-- | Shared helper for the evaluation functions, deserializes the 'SerializedScript' , applies it to its arguments, puts fakenamedebruijns, and scope-checks it.
mkTermToEvaluate :: (MonadError EvaluationError m) => SerializedScript -> [PLC.Data] -> m (UPLC.Term UPLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ())
mkTermToEvaluate :: SerializedScript
-> [Data] -> m (Term NamedDeBruijn DefaultUni DefaultFun ())
mkTermToEvaluate SerializedScript
bs [Data]
args = do
    s :: Script
s@(Script (UPLC.Program ()
_ Version ()
v Term DeBruijn DefaultUni DefaultFun ()
_)) <- Either EvaluationError Script -> m Script
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either EvaluationError Script -> m Script)
-> Either EvaluationError Script -> m Script
forall a b. (a -> b) -> a -> b
$ (DeserialiseFailure -> EvaluationError)
-> Either DeserialiseFailure Script
-> Either EvaluationError Script
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DeserialiseFailure -> EvaluationError
CodecError (Either DeserialiseFailure Script -> Either EvaluationError Script)
-> Either DeserialiseFailure Script
-> Either EvaluationError Script
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DeserialiseFailure Script
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
CBOR.deserialiseOrFail (ByteString -> Either DeserialiseFailure Script)
-> ByteString -> Either DeserialiseFailure Script
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SerializedScript -> ByteString
fromShort SerializedScript
bs
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Version ()
v Version () -> Version () -> Bool
forall a. Eq a => a -> a -> Bool
== () -> Version ()
forall ann. ann -> Version ann
PLC.defaultVersion ()) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ EvaluationError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EvaluationError -> m ()) -> EvaluationError -> m ()
forall a b. (a -> b) -> a -> b
$ Version () -> EvaluationError
IncompatibleVersionError Version ()
v
    let appliedScript :: Program DeBruijn DefaultUni DefaultFun ()
appliedScript = Script -> Program DeBruijn DefaultUni DefaultFun ()
unScript (Script -> Program DeBruijn DefaultUni DefaultFun ())
-> Script -> Program DeBruijn DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Script -> [Data] -> Script
Scripts.applyArguments Script
s [Data]
args
        -- add fake names to keep the api working on NamedDeBruijn
        namedT :: Term NamedDeBruijn DefaultUni DefaultFun ()
namedT = (DeBruijn -> NamedDeBruijn)
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term NamedDeBruijn DefaultUni DefaultFun ()
forall name name' (uni :: * -> *) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames DeBruijn -> NamedDeBruijn
UPLC.fakeNameDeBruijn (Term DeBruijn DefaultUni DefaultFun ()
 -> Term NamedDeBruijn DefaultUni DefaultFun ())
-> Term DeBruijn DefaultUni DefaultFun ()
-> Term NamedDeBruijn DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Program DeBruijn DefaultUni DefaultFun ()
-> Term DeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> Term name uni fun ann
UPLC._progTerm Program DeBruijn DefaultUni DefaultFun ()
appliedScript
    -- make sure that term is closed, i.e. well-scoped
    Either EvaluationError () -> m ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either EvaluationError () -> m ())
-> Either EvaluationError () -> m ()
forall a b. (a -> b) -> a -> b
$ (FreeVariableError -> EvaluationError)
-> Either FreeVariableError () -> Either EvaluationError ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FreeVariableError -> EvaluationError
DeBruijnError (Either FreeVariableError () -> Either EvaluationError ())
-> Either FreeVariableError () -> Either EvaluationError ()
forall a b. (a -> b) -> a -> b
$ Term NamedDeBruijn DefaultUni DefaultFun ()
-> Either FreeVariableError ()
forall e (m :: * -> *) name (uni :: * -> *) fun a.
(HasIndex name, MonadError e m, AsFreeVariableError e) =>
Term name uni fun a -> m ()
UPLC.checkScope Term NamedDeBruijn DefaultUni DefaultFun ()
namedT
    Term NamedDeBruijn DefaultUni DefaultFun ()
-> m (Term NamedDeBruijn DefaultUni DefaultFun ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term NamedDeBruijn DefaultUni DefaultFun ()
namedT

-- | 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.
evaluateScriptRestricting
    :: VerboseMode     -- ^ Whether to produce log output
    -> CostModelParams -- ^ The cost model to use
    -> ExBudget        -- ^ The resource budget which must not be exceeded during evaluation
    -> SerializedScript          -- ^ The script to evaluate
    -> [PLC.Data]          -- ^ The arguments to the script
    -> (LogOutput, Either EvaluationError ExBudget)
evaluateScriptRestricting :: VerboseMode
-> CostModelParams
-> ExBudget
-> SerializedScript
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
evaluateScriptRestricting VerboseMode
verbose CostModelParams
cmdata ExBudget
budget SerializedScript
p [Data]
args = (Either EvaluationError ExBudget, LogOutput)
-> (LogOutput, Either EvaluationError ExBudget)
forall a b. (a, b) -> (b, a)
swap ((Either EvaluationError ExBudget, LogOutput)
 -> (LogOutput, Either EvaluationError ExBudget))
-> (Either EvaluationError ExBudget, LogOutput)
-> (LogOutput, Either EvaluationError ExBudget)
forall a b. (a -> b) -> a -> b
$ forall a. Writer LogOutput a -> (a, LogOutput)
forall w a. Writer w a -> (a, w)
runWriter @LogOutput (Writer LogOutput (Either EvaluationError ExBudget)
 -> (Either EvaluationError ExBudget, LogOutput))
-> Writer LogOutput (Either EvaluationError ExBudget)
-> (Either EvaluationError ExBudget, LogOutput)
forall a b. (a -> b) -> a -> b
$ ExceptT EvaluationError (WriterT LogOutput Identity) ExBudget
-> Writer LogOutput (Either EvaluationError ExBudget)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT EvaluationError (WriterT LogOutput Identity) ExBudget
 -> Writer LogOutput (Either EvaluationError ExBudget))
-> ExceptT EvaluationError (WriterT LogOutput Identity) ExBudget
-> Writer LogOutput (Either EvaluationError ExBudget)
forall a b. (a -> b) -> a -> b
$ do
    Term NamedDeBruijn DefaultUni DefaultFun ()
appliedTerm <- SerializedScript
-> [Data]
-> ExceptT
     EvaluationError
     (WriterT LogOutput Identity)
     (Term NamedDeBruijn DefaultUni DefaultFun ())
forall (m :: * -> *).
MonadError EvaluationError m =>
SerializedScript
-> [Data] -> m (Term NamedDeBruijn DefaultUni DefaultFun ())
mkTermToEvaluate SerializedScript
p [Data]
args
    CostModel CekMachineCosts BuiltinCostModel
model <- case CostModel CekMachineCosts BuiltinCostModel
-> CostModelParams
-> Maybe (CostModel CekMachineCosts BuiltinCostModel)
forall evaluatorcosts builtincosts.
(FromJSON evaluatorcosts, FromJSON builtincosts,
 ToJSON evaluatorcosts, ToJSON builtincosts) =>
CostModel evaluatorcosts builtincosts
-> CostModelParams -> Maybe (CostModel evaluatorcosts builtincosts)
applyCostModelParams CostModel CekMachineCosts BuiltinCostModel
PLC.defaultCekCostModel CostModelParams
cmdata of
        Just CostModel CekMachineCosts BuiltinCostModel
model -> CostModel CekMachineCosts BuiltinCostModel
-> ExceptT
     EvaluationError
     (WriterT LogOutput Identity)
     (CostModel CekMachineCosts BuiltinCostModel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CostModel CekMachineCosts BuiltinCostModel
model
        Maybe (CostModel CekMachineCosts BuiltinCostModel)
Nothing    -> EvaluationError
-> ExceptT
     EvaluationError
     (WriterT LogOutput Identity)
     (CostModel CekMachineCosts BuiltinCostModel)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EvaluationError
CostModelParameterMismatch

    let (Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (Term NamedDeBruijn DefaultUni DefaultFun ())
res, UPLC.RestrictingSt (PLC.ExRestrictingBudget ExBudget
final), LogOutput
logs) =
            MachineParameters CekMachineCosts CekValue DefaultUni DefaultFun
-> ExBudgetMode RestrictingSt DefaultUni DefaultFun
-> EmitterMode DefaultUni DefaultFun
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      (Term NamedDeBruijn DefaultUni DefaultFun ()),
    RestrictingSt, LogOutput)
forall (uni :: * -> *) fun cost.
(Everywhere uni ExMemoryUsage, Ix fun, PrettyUni uni fun) =>
MachineParameters CekMachineCosts CekValue uni fun
-> ExBudgetMode cost uni fun
-> EmitterMode uni fun
-> Term NamedDeBruijn uni fun ()
-> (Either
      (CekEvaluationException NamedDeBruijn uni fun)
      (Term NamedDeBruijn uni fun ()),
    cost, LogOutput)
UPLC.runCekDeBruijn
                (CostModel CekMachineCosts BuiltinCostModel
-> MachineParameters CekMachineCosts CekValue DefaultUni DefaultFun
forall (val :: (* -> *) -> * -> *) (uni :: * -> *) fun builtincosts
       machinecosts.
(UniOf (val uni fun) ~ uni, CostingPart uni fun ~ builtincosts,
 HasConstant (val uni fun), ToBuiltinMeaning uni fun) =>
CostModel machinecosts builtincosts
-> MachineParameters machinecosts val uni fun
toMachineParameters CostModel CekMachineCosts BuiltinCostModel
model)
                (ExRestrictingBudget
-> ExBudgetMode RestrictingSt DefaultUni DefaultFun
forall (uni :: * -> *) fun.
PrettyUni uni fun =>
ExRestrictingBudget -> ExBudgetMode RestrictingSt uni fun
UPLC.restricting (ExRestrictingBudget
 -> ExBudgetMode RestrictingSt DefaultUni DefaultFun)
-> ExRestrictingBudget
-> ExBudgetMode RestrictingSt DefaultUni DefaultFun
forall a b. (a -> b) -> a -> b
$ ExBudget -> ExRestrictingBudget
PLC.ExRestrictingBudget ExBudget
budget)
                (if VerboseMode
verbose VerboseMode -> VerboseMode -> Bool
forall a. Eq a => a -> a -> Bool
== VerboseMode
Verbose then EmitterMode DefaultUni DefaultFun
forall (uni :: * -> *) fun. EmitterMode uni fun
UPLC.logEmitter else EmitterMode DefaultUni DefaultFun
forall (uni :: * -> *) fun. EmitterMode uni fun
UPLC.noEmitter)
                Term NamedDeBruijn DefaultUni DefaultFun ()
appliedTerm

    LogOutput
-> ExceptT EvaluationError (WriterT LogOutput Identity) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell LogOutput
logs
    Either EvaluationError ()
-> ExceptT EvaluationError (WriterT LogOutput Identity) ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either EvaluationError ()
 -> ExceptT EvaluationError (WriterT LogOutput Identity) ())
-> Either EvaluationError ()
-> ExceptT EvaluationError (WriterT LogOutput Identity) ()
forall a b. (a -> b) -> a -> b
$ (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
 -> EvaluationError)
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) ()
-> Either EvaluationError ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
-> EvaluationError
CekError (Either
   (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) ()
 -> Either EvaluationError ())
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) ()
-> Either EvaluationError ()
forall a b. (a -> b) -> a -> b
$ Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (Term NamedDeBruijn DefaultUni DefaultFun ())
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (Term NamedDeBruijn DefaultUni DefaultFun ())
res
    ExBudget
-> ExceptT EvaluationError (WriterT LogOutput Identity) ExBudget
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExBudget
budget ExBudget -> ExBudget -> ExBudget
`PLC.minusExBudget` ExBudget
final)

-- | 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.
evaluateScriptCounting
    :: VerboseMode     -- ^ Whether to produce log output
    -> CostModelParams -- ^ The cost model to use
    -> SerializedScript          -- ^ The script to evaluate
    -> [PLC.Data]          -- ^ The arguments to the script
    -> (LogOutput, Either EvaluationError ExBudget)
evaluateScriptCounting :: VerboseMode
-> CostModelParams
-> SerializedScript
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
evaluateScriptCounting VerboseMode
verbose CostModelParams
cmdata SerializedScript
p [Data]
args = (Either EvaluationError ExBudget, LogOutput)
-> (LogOutput, Either EvaluationError ExBudget)
forall a b. (a, b) -> (b, a)
swap ((Either EvaluationError ExBudget, LogOutput)
 -> (LogOutput, Either EvaluationError ExBudget))
-> (Either EvaluationError ExBudget, LogOutput)
-> (LogOutput, Either EvaluationError ExBudget)
forall a b. (a -> b) -> a -> b
$ forall a. Writer LogOutput a -> (a, LogOutput)
forall w a. Writer w a -> (a, w)
runWriter @LogOutput (Writer LogOutput (Either EvaluationError ExBudget)
 -> (Either EvaluationError ExBudget, LogOutput))
-> Writer LogOutput (Either EvaluationError ExBudget)
-> (Either EvaluationError ExBudget, LogOutput)
forall a b. (a -> b) -> a -> b
$ ExceptT EvaluationError (WriterT LogOutput Identity) ExBudget
-> Writer LogOutput (Either EvaluationError ExBudget)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT EvaluationError (WriterT LogOutput Identity) ExBudget
 -> Writer LogOutput (Either EvaluationError ExBudget))
-> ExceptT EvaluationError (WriterT LogOutput Identity) ExBudget
-> Writer LogOutput (Either EvaluationError ExBudget)
forall a b. (a -> b) -> a -> b
$ do
    Term NamedDeBruijn DefaultUni DefaultFun ()
appliedTerm <- SerializedScript
-> [Data]
-> ExceptT
     EvaluationError
     (WriterT LogOutput Identity)
     (Term NamedDeBruijn DefaultUni DefaultFun ())
forall (m :: * -> *).
MonadError EvaluationError m =>
SerializedScript
-> [Data] -> m (Term NamedDeBruijn DefaultUni DefaultFun ())
mkTermToEvaluate SerializedScript
p [Data]
args
    CostModel CekMachineCosts BuiltinCostModel
model <- case CostModel CekMachineCosts BuiltinCostModel
-> CostModelParams
-> Maybe (CostModel CekMachineCosts BuiltinCostModel)
forall evaluatorcosts builtincosts.
(FromJSON evaluatorcosts, FromJSON builtincosts,
 ToJSON evaluatorcosts, ToJSON builtincosts) =>
CostModel evaluatorcosts builtincosts
-> CostModelParams -> Maybe (CostModel evaluatorcosts builtincosts)
applyCostModelParams CostModel CekMachineCosts BuiltinCostModel
PLC.defaultCekCostModel CostModelParams
cmdata of
        Just CostModel CekMachineCosts BuiltinCostModel
model -> CostModel CekMachineCosts BuiltinCostModel
-> ExceptT
     EvaluationError
     (WriterT LogOutput Identity)
     (CostModel CekMachineCosts BuiltinCostModel)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CostModel CekMachineCosts BuiltinCostModel
model
        Maybe (CostModel CekMachineCosts BuiltinCostModel)
Nothing    -> EvaluationError
-> ExceptT
     EvaluationError
     (WriterT LogOutput Identity)
     (CostModel CekMachineCosts BuiltinCostModel)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EvaluationError
CostModelParameterMismatch

    let (Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (Term NamedDeBruijn DefaultUni DefaultFun ())
res, UPLC.CountingSt ExBudget
final, LogOutput
logs) =
            MachineParameters CekMachineCosts CekValue DefaultUni DefaultFun
-> ExBudgetMode CountingSt DefaultUni DefaultFun
-> EmitterMode DefaultUni DefaultFun
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      (Term NamedDeBruijn DefaultUni DefaultFun ()),
    CountingSt, LogOutput)
forall (uni :: * -> *) fun cost.
(Everywhere uni ExMemoryUsage, Ix fun, PrettyUni uni fun) =>
MachineParameters CekMachineCosts CekValue uni fun
-> ExBudgetMode cost uni fun
-> EmitterMode uni fun
-> Term NamedDeBruijn uni fun ()
-> (Either
      (CekEvaluationException NamedDeBruijn uni fun)
      (Term NamedDeBruijn uni fun ()),
    cost, LogOutput)
UPLC.runCekDeBruijn
                (CostModel CekMachineCosts BuiltinCostModel
-> MachineParameters CekMachineCosts CekValue DefaultUni DefaultFun
forall (val :: (* -> *) -> * -> *) (uni :: * -> *) fun builtincosts
       machinecosts.
(UniOf (val uni fun) ~ uni, CostingPart uni fun ~ builtincosts,
 HasConstant (val uni fun), ToBuiltinMeaning uni fun) =>
CostModel machinecosts builtincosts
-> MachineParameters machinecosts val uni fun
toMachineParameters CostModel CekMachineCosts BuiltinCostModel
model)
                ExBudgetMode CountingSt DefaultUni DefaultFun
forall (uni :: * -> *) fun. ExBudgetMode CountingSt uni fun
UPLC.counting
                (if VerboseMode
verbose VerboseMode -> VerboseMode -> Bool
forall a. Eq a => a -> a -> Bool
== VerboseMode
Verbose then EmitterMode DefaultUni DefaultFun
forall (uni :: * -> *) fun. EmitterMode uni fun
UPLC.logEmitter else EmitterMode DefaultUni DefaultFun
forall (uni :: * -> *) fun. EmitterMode uni fun
UPLC.noEmitter)
                Term NamedDeBruijn DefaultUni DefaultFun ()
appliedTerm

    LogOutput
-> ExceptT EvaluationError (WriterT LogOutput Identity) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell LogOutput
logs
    Either EvaluationError ()
-> ExceptT EvaluationError (WriterT LogOutput Identity) ()
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either EvaluationError ()
 -> ExceptT EvaluationError (WriterT LogOutput Identity) ())
-> Either EvaluationError ()
-> ExceptT EvaluationError (WriterT LogOutput Identity) ()
forall a b. (a -> b) -> a -> b
$ (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
 -> EvaluationError)
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) ()
-> Either EvaluationError ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
-> EvaluationError
CekError (Either
   (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) ()
 -> Either EvaluationError ())
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) ()
-> Either EvaluationError ()
forall a b. (a -> b) -> a -> b
$ Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (Term NamedDeBruijn DefaultUni DefaultFun ())
-> Either
     (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Either
  (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
  (Term NamedDeBruijn DefaultUni DefaultFun ())
res
    ExBudget
-> ExceptT EvaluationError (WriterT LogOutput Identity) ExBudget
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExBudget
final