{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Cardano.Ledger.Plutus.Evaluate (
  PlutusDebugOverrides (..),
  PlutusWithContext (..),
  ScriptFailure (..),
  ScriptResult (..),
  scriptPass,
  scriptFail,
  PlutusDebugInfo (..),
  debugPlutus,
  runPlutusScript,
  runPlutusScriptWithLogs,
  evaluatePlutusWithContext,
  explainPlutusEvaluationError,
) where

import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  Version,
  toPlainDecoder,
  toPlainEncoding,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Plutus.CostModels (
  CostModel,
  decodeCostModel,
  encodeCostModel,
  getCostModelLanguage,
  getCostModelParams,
  getEvaluationContext,
  mkCostModel,
 )
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..))
import Cardano.Ledger.Plutus.Language (
  Language,
  Plutus (..),
  PlutusBinary (..),
  PlutusLanguage (..),
  PlutusRunnable (..),
  decodeWithPlutus,
  hashPlutusScript,
  plutusFromRunnable,
  plutusLanguage,
  withSamePlutusLanguage,
 )
import Cardano.Ledger.Plutus.TxInfo
import Control.DeepSeq (NFData (..), force)
import Control.Exception (evaluate)
import Control.Monad (join, unless)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Short as SBS
import qualified Data.ByteString.UTF8 as BSU
import Data.Either (fromRight)
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import qualified PlutusLedgerApi.Common as P (
  EvaluationError (CodecError),
  ExBudget,
  VerboseMode (..),
 )
import Prettyprinter (Pretty (..))
import System.Timeout (timeout)

-- | This type contains all that is necessary from Ledger to evaluate a plutus script.
data PlutusWithContext where
  PlutusWithContext ::
    PlutusLanguage l =>
    { PlutusWithContext -> Version
pwcProtocolVersion :: !Version
    -- ^ Major protocol version that is necessary for [de]serialization
    , ()
pwcScript :: !(Either (Plutus l) (PlutusRunnable l))
    -- ^ Actual plutus script that will be evaluated. Script is allowed to be in two forms:
    -- serialized and deserialized. This is necesary for implementing the opptimization
    -- that preserves deserialized `PlutusRunnable` after verifying wellformedness of
    -- plutus scripts during transaction validation (yet to be implemented).
    , PlutusWithContext -> ScriptHash
pwcScriptHash :: !ScriptHash
    -- ^ Hash of the above script as it would appear on-chain. In other words it is not
    -- just a hash of the script contents. (See `Cardano.Ledger.Core.hashScript` for more info)
    , ()
pwcArgs :: !(PlutusArgs l)
    -- ^ All of the arguments to the Plutus scripts, including the redeemer and the
    -- Plutus context that was obtained from the transaction translation
    , PlutusWithContext -> ExUnits
pwcExUnits :: !ExUnits
    -- ^ Limit on the execution units
    , PlutusWithContext -> CostModel
pwcCostModel :: !CostModel
    -- ^ `CostModel` to be used during script evaluation. It must match the language
    -- version in the `pwcScript`
    } ->
    PlutusWithContext

deriving instance Show PlutusWithContext

instance NFData PlutusWithContext where
  rnf :: PlutusWithContext -> ()
rnf PlutusWithContext {Either (Plutus l) (PlutusRunnable l)
Version
ScriptHash
ExUnits
PlutusArgs l
CostModel
pwcProtocolVersion :: PlutusWithContext -> Version
pwcScript :: ()
pwcScriptHash :: PlutusWithContext -> ScriptHash
pwcArgs :: ()
pwcExUnits :: PlutusWithContext -> ExUnits
pwcCostModel :: PlutusWithContext -> CostModel
pwcProtocolVersion :: Version
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
pwcExUnits :: ExUnits
pwcCostModel :: CostModel
..} =
    Version -> ()
forall a. NFData a => a -> ()
rnf Version
pwcProtocolVersion () -> () -> ()
forall a b. a -> b -> b
`seq`
      Either (Plutus l) (PlutusRunnable l) -> ()
forall a. NFData a => a -> ()
rnf Either (Plutus l) (PlutusRunnable l)
pwcScript () -> () -> ()
forall a b. a -> b -> b
`seq`
        ScriptHash -> ()
forall a. NFData a => a -> ()
rnf ScriptHash
pwcScriptHash () -> () -> ()
forall a b. a -> b -> b
`seq`
          PlutusArgs l -> ()
forall a. NFData a => a -> ()
rnf PlutusArgs l
pwcArgs () -> () -> ()
forall a b. a -> b -> b
`seq`
            ExUnits -> ()
forall a. NFData a => a -> ()
rnf ExUnits
pwcExUnits () -> () -> ()
forall a b. a -> b -> b
`seq`
              CostModel -> ()
forall a. NFData a => a -> ()
rnf CostModel
pwcCostModel

instance Eq PlutusWithContext where
  pwc1 :: PlutusWithContext
pwc1@(PlutusWithContext {pwcScript :: ()
pwcScript = Either (Plutus l) (PlutusRunnable l)
s1, pwcArgs :: ()
pwcArgs = PlutusArgs l
args1})
    == :: PlutusWithContext -> PlutusWithContext -> Bool
== pwc2 :: PlutusWithContext
pwc2@(PlutusWithContext {pwcScript :: ()
pwcScript = Either (Plutus l) (PlutusRunnable l)
s2, pwcArgs :: ()
pwcArgs = PlutusArgs l
args2}) =
      PlutusWithContext -> Version
pwcProtocolVersion PlutusWithContext
pwc1 Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusWithContext -> Version
pwcProtocolVersion PlutusWithContext
pwc2
        Bool -> Bool -> Bool
&& PlutusWithContext -> ScriptHash
pwcScriptHash PlutusWithContext
pwc1 ScriptHash -> ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusWithContext -> ScriptHash
pwcScriptHash PlutusWithContext
pwc2
        Bool -> Bool -> Bool
&& Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (PlutusArgs l
-> PlutusArgs l
-> (forall (l :: Language).
    PlutusLanguage l =>
    PlutusArgs l -> PlutusArgs l -> Bool)
-> Maybe Bool
forall (f1 :: Language -> *) (f2 :: Language -> *) (l1 :: Language)
       (l2 :: Language) a.
(PlutusLanguage l1, PlutusLanguage l2) =>
f1 l1
-> f2 l2
-> (forall (l :: Language). PlutusLanguage l => f1 l -> f2 l -> a)
-> Maybe a
withSamePlutusLanguage PlutusArgs l
args1 PlutusArgs l
args2 PlutusArgs l -> PlutusArgs l -> Bool
forall a. Eq a => a -> a -> Bool
forall (l :: Language).
PlutusLanguage l =>
PlutusArgs l -> PlutusArgs l -> Bool
(==))
        Bool -> Bool -> Bool
&& PlutusWithContext -> ExUnits
pwcExUnits PlutusWithContext
pwc1 ExUnits -> ExUnits -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusWithContext -> ExUnits
pwcExUnits PlutusWithContext
pwc2
        Bool -> Bool -> Bool
&& PlutusWithContext -> CostModel
pwcCostModel PlutusWithContext
pwc1 CostModel -> CostModel -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusWithContext -> CostModel
pwcCostModel PlutusWithContext
pwc2
        Bool -> Bool -> Bool
&& Either (Plutus l) (PlutusRunnable l)
-> Either (Plutus l) (PlutusRunnable l) -> Bool
forall {l :: Language} {l :: Language} {l :: Language}
       {l :: Language}.
(PlutusLanguage l, PlutusLanguage l, PlutusLanguage l,
 PlutusLanguage l) =>
Either (Plutus l) (PlutusRunnable l)
-> Either (Plutus l) (PlutusRunnable l) -> Bool
eqScripts Either (Plutus l) (PlutusRunnable l)
s1 Either (Plutus l) (PlutusRunnable l)
s2
      where
        eqScripts :: Either (Plutus l) (PlutusRunnable l)
-> Either (Plutus l) (PlutusRunnable l) -> Bool
eqScripts (Left Plutus l
p1) (Left Plutus l
p2) =
          Plutus l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
p1 Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== Plutus l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
p2 Bool -> Bool -> Bool
&& Plutus l -> PlutusBinary
forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary Plutus l
p1 PlutusBinary -> PlutusBinary -> Bool
forall a. Eq a => a -> a -> Bool
== Plutus l -> PlutusBinary
forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary Plutus l
p2
        eqScripts (Right PlutusRunnable l
p1) (Right PlutusRunnable l
p2) =
          PlutusRunnable l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage PlutusRunnable l
p1 Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusRunnable l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage PlutusRunnable l
p2 Bool -> Bool -> Bool
&& PlutusRunnable l -> ScriptForEvaluation
forall (l :: Language). PlutusRunnable l -> ScriptForEvaluation
plutusRunnable PlutusRunnable l
p1 ScriptForEvaluation -> ScriptForEvaluation -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusRunnable l -> ScriptForEvaluation
forall (l :: Language). PlutusRunnable l -> ScriptForEvaluation
plutusRunnable PlutusRunnable l
p2
        eqScripts Either (Plutus l) (PlutusRunnable l)
_ Either (Plutus l) (PlutusRunnable l)
_ = Bool
False

data ScriptFailure = ScriptFailure
  { ScriptFailure -> Text
scriptFailureMessage :: Text
  , ScriptFailure -> PlutusWithContext
scriptFailurePlutus :: PlutusWithContext
  }
  deriving (Int -> ScriptFailure -> ShowS
[ScriptFailure] -> ShowS
ScriptFailure -> String
(Int -> ScriptFailure -> ShowS)
-> (ScriptFailure -> String)
-> ([ScriptFailure] -> ShowS)
-> Show ScriptFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptFailure -> ShowS
showsPrec :: Int -> ScriptFailure -> ShowS
$cshow :: ScriptFailure -> String
show :: ScriptFailure -> String
$cshowList :: [ScriptFailure] -> ShowS
showList :: [ScriptFailure] -> ShowS
Show, (forall x. ScriptFailure -> Rep ScriptFailure x)
-> (forall x. Rep ScriptFailure x -> ScriptFailure)
-> Generic ScriptFailure
forall x. Rep ScriptFailure x -> ScriptFailure
forall x. ScriptFailure -> Rep ScriptFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptFailure -> Rep ScriptFailure x
from :: forall x. ScriptFailure -> Rep ScriptFailure x
$cto :: forall x. Rep ScriptFailure x -> ScriptFailure
to :: forall x. Rep ScriptFailure x -> ScriptFailure
Generic)

data ScriptResult
  = Passes [PlutusWithContext]
  | Fails [PlutusWithContext] (NonEmpty ScriptFailure)
  deriving ((forall x. ScriptResult -> Rep ScriptResult x)
-> (forall x. Rep ScriptResult x -> ScriptResult)
-> Generic ScriptResult
forall x. Rep ScriptResult x -> ScriptResult
forall x. ScriptResult -> Rep ScriptResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptResult -> Rep ScriptResult x
from :: forall x. ScriptResult -> Rep ScriptResult x
$cto :: forall x. Rep ScriptResult x -> ScriptResult
to :: forall x. Rep ScriptResult x -> ScriptResult
Generic)

scriptPass :: PlutusWithContext -> ScriptResult
scriptPass :: PlutusWithContext -> ScriptResult
scriptPass PlutusWithContext
pwc = [PlutusWithContext] -> ScriptResult
Passes [PlutusWithContext
pwc]

scriptFail :: ScriptFailure -> ScriptResult
scriptFail :: ScriptFailure -> ScriptResult
scriptFail ScriptFailure
sf = [PlutusWithContext] -> NonEmpty ScriptFailure -> ScriptResult
Fails [] (ScriptFailure -> NonEmpty ScriptFailure
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptFailure
sf)

withRunnablePlutusWithContext ::
  PlutusWithContext ->
  -- | Handle the decoder failure
  (P.EvaluationError -> a) ->
  (forall l. PlutusLanguage l => PlutusRunnable l -> PlutusArgs l -> a) ->
  a
withRunnablePlutusWithContext :: forall a.
PlutusWithContext
-> (EvaluationError -> a)
-> (forall (l :: Language).
    PlutusLanguage l =>
    PlutusRunnable l -> PlutusArgs l -> a)
-> a
withRunnablePlutusWithContext PlutusWithContext {Version
pwcProtocolVersion :: PlutusWithContext -> Version
pwcProtocolVersion :: Version
pwcProtocolVersion, Either (Plutus l) (PlutusRunnable l)
pwcScript :: ()
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScript, PlutusArgs l
pwcArgs :: ()
pwcArgs :: PlutusArgs l
pwcArgs} EvaluationError -> a
onError forall (l :: Language).
PlutusLanguage l =>
PlutusRunnable l -> PlutusArgs l -> a
f =
  case Either (Plutus l) (PlutusRunnable l)
pwcScript of
    Right PlutusRunnable l
pr -> PlutusRunnable l -> PlutusArgs l -> a
forall (l :: Language).
PlutusLanguage l =>
PlutusRunnable l -> PlutusArgs l -> a
f PlutusRunnable l
pr PlutusArgs l
pwcArgs
    Left Plutus l
plutus ->
      case Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
decodePlutusRunnable Version
pwcProtocolVersion Plutus l
plutus of
        Right PlutusRunnable l
pr -> PlutusRunnable l -> PlutusArgs l -> a
forall (l :: Language).
PlutusLanguage l =>
PlutusRunnable l -> PlutusArgs l -> a
f PlutusRunnable l
pr PlutusArgs l
pwcArgs
        Left ScriptDecodeError
err -> EvaluationError -> a
onError (ScriptDecodeError -> EvaluationError
P.CodecError ScriptDecodeError
err)

instance Semigroup ScriptResult where
  Passes [PlutusWithContext]
ps <> :: ScriptResult -> ScriptResult -> ScriptResult
<> Passes [PlutusWithContext]
qs = [PlutusWithContext] -> ScriptResult
Passes ([PlutusWithContext]
ps [PlutusWithContext] -> [PlutusWithContext] -> [PlutusWithContext]
forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext]
qs)
  Passes [PlutusWithContext]
ps <> Fails [PlutusWithContext]
qs NonEmpty ScriptFailure
xs = [PlutusWithContext] -> NonEmpty ScriptFailure -> ScriptResult
Fails ([PlutusWithContext]
ps [PlutusWithContext] -> [PlutusWithContext] -> [PlutusWithContext]
forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext]
qs) NonEmpty ScriptFailure
xs
  Fails [PlutusWithContext]
ps NonEmpty ScriptFailure
xs <> Passes [PlutusWithContext]
qs = [PlutusWithContext] -> NonEmpty ScriptFailure -> ScriptResult
Fails ([PlutusWithContext]
ps [PlutusWithContext] -> [PlutusWithContext] -> [PlutusWithContext]
forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext]
qs) NonEmpty ScriptFailure
xs
  Fails [PlutusWithContext]
ps NonEmpty ScriptFailure
xs <> Fails [PlutusWithContext]
qs NonEmpty ScriptFailure
ys = [PlutusWithContext] -> NonEmpty ScriptFailure -> ScriptResult
Fails ([PlutusWithContext]
ps [PlutusWithContext] -> [PlutusWithContext] -> [PlutusWithContext]
forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext]
qs) (NonEmpty ScriptFailure
xs NonEmpty ScriptFailure
-> NonEmpty ScriptFailure -> NonEmpty ScriptFailure
forall a. Semigroup a => a -> a -> a
<> NonEmpty ScriptFailure
ys)

instance Monoid ScriptResult where
  mempty :: ScriptResult
mempty = [PlutusWithContext] -> ScriptResult
Passes [PlutusWithContext]
forall a. Monoid a => a
mempty

instance ToCBOR PlutusWithContext where
  toCBOR :: PlutusWithContext -> Encoding
toCBOR (PlutusWithContext {Either (Plutus l) (PlutusRunnable l)
Version
ScriptHash
ExUnits
PlutusArgs l
CostModel
pwcProtocolVersion :: PlutusWithContext -> Version
pwcScript :: ()
pwcScriptHash :: PlutusWithContext -> ScriptHash
pwcArgs :: ()
pwcExUnits :: PlutusWithContext -> ExUnits
pwcCostModel :: PlutusWithContext -> CostModel
pwcProtocolVersion :: Version
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
pwcExUnits :: ExUnits
pwcCostModel :: CostModel
..}) =
    Word -> Encoding
Plain.encodeListLen Word
6
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Version -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Version
pwcProtocolVersion
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Version -> Encoding -> Encoding
toPlainEncoding Version
pwcProtocolVersion ((Plutus l -> Encoding)
-> (PlutusRunnable l -> Encoding)
-> Either (Plutus l) (PlutusRunnable l)
-> Encoding
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Plutus l -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PlutusRunnable l -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Either (Plutus l) (PlutusRunnable l)
pwcScript)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Version -> Encoding -> Encoding
toPlainEncoding Version
pwcProtocolVersion (ScriptHash -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ScriptHash
pwcScriptHash)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Version -> Encoding -> Encoding
toPlainEncoding Version
pwcProtocolVersion (PlutusArgs l -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR PlutusArgs l
pwcArgs)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Version -> Encoding -> Encoding
toPlainEncoding Version
pwcProtocolVersion (ExUnits -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ExUnits
pwcExUnits)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Version -> Encoding -> Encoding
toPlainEncoding Version
pwcProtocolVersion (CostModel -> Encoding
encodeCostModel CostModel
pwcCostModel)

instance FromCBOR PlutusWithContext where
  fromCBOR :: forall s. Decoder s PlutusWithContext
fromCBOR = Text
-> (PlutusWithContext -> Int)
-> Decoder s PlutusWithContext
-> Decoder s PlutusWithContext
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
Plain.decodeRecordNamed Text
"PlutusWithContext" (Int -> PlutusWithContext -> Int
forall a b. a -> b -> a
const Int
6) (Decoder s PlutusWithContext -> Decoder s PlutusWithContext)
-> Decoder s PlutusWithContext -> Decoder s PlutusWithContext
forall a b. (a -> b) -> a -> b
$ do
    Version
pwcProtocolVersion <- Decoder s Version
forall s. Decoder s Version
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Maybe ByteString
-> Version
-> Decoder s PlutusWithContext
-> Decoder s PlutusWithContext
forall s a.
Maybe ByteString -> Version -> Decoder s a -> Decoder s a
toPlainDecoder Maybe ByteString
forall a. Maybe a
Nothing Version
pwcProtocolVersion (Decoder s PlutusWithContext -> Decoder s PlutusWithContext)
-> Decoder s PlutusWithContext -> Decoder s PlutusWithContext
forall a b. (a -> b) -> a -> b
$ (forall si (l :: Language).
 PlutusLanguage l =>
 Plutus l -> Decoder si PlutusWithContext)
-> Decoder s PlutusWithContext
forall a so.
(forall si (l :: Language).
 PlutusLanguage l =>
 Plutus l -> Decoder si a)
-> Decoder so a
decodeWithPlutus ((forall si (l :: Language).
  PlutusLanguage l =>
  Plutus l -> Decoder si PlutusWithContext)
 -> Decoder s PlutusWithContext)
-> (forall si (l :: Language).
    PlutusLanguage l =>
    Plutus l -> Decoder si PlutusWithContext)
-> Decoder s PlutusWithContext
forall a b. (a -> b) -> a -> b
$ \Plutus l
plutus -> do
      let lang :: Language
lang = Plutus l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
plutus
          pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScript = Plutus l -> Either (Plutus l) (PlutusRunnable l)
forall a b. a -> Either a b
Left Plutus l
plutus
          scriptHash :: ScriptHash
scriptHash = Plutus l -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript Plutus l
plutus
      ScriptHash
pwcScriptHash <- Decoder si ScriptHash
forall s. Decoder s ScriptHash
forall a s. DecCBOR a => Decoder s a
decCBOR
      Bool -> Decoder si () -> Decoder si ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ScriptHash
pwcScriptHash ScriptHash -> ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptHash
scriptHash) (Decoder si () -> Decoder si ()) -> Decoder si () -> Decoder si ()
forall a b. (a -> b) -> a -> b
$
        String -> Decoder si ()
forall a. String -> Decoder si a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder si ()) -> String -> Decoder si ()
forall a b. (a -> b) -> a -> b
$
          String
"ScriptHash mismatch. Encoded: "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> String
forall a. Show a => a -> String
show ScriptHash
pwcScriptHash
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" doesn't match the actual: "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> String
forall a. Show a => a -> String
show ScriptHash
scriptHash
      PlutusArgs l
pwcArgs <- Decoder si (PlutusArgs l)
forall s. Decoder s (PlutusArgs l)
forall a s. DecCBOR a => Decoder s a
decCBOR
      ExUnits
pwcExUnits <- Decoder si ExUnits
forall s. Decoder s ExUnits
forall a s. DecCBOR a => Decoder s a
decCBOR
      CostModel
pwcCostModel <- Language -> Decoder si CostModel
forall s. Language -> Decoder s CostModel
decodeCostModel Language
lang
      PlutusWithContext -> Decoder si PlutusWithContext
forall a. a -> Decoder si a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlutusWithContext {Either (Plutus l) (PlutusRunnable l)
Version
ScriptHash
ExUnits
PlutusArgs l
CostModel
pwcProtocolVersion :: Version
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
pwcExUnits :: ExUnits
pwcCostModel :: CostModel
pwcProtocolVersion :: Version
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
pwcExUnits :: ExUnits
pwcCostModel :: CostModel
..}

data PlutusDebugInfo
  = DebugBadHex String
  | DebugCannotDecode String
  | DebugSuccess
      -- | Execution logs from the plutus interpreter
      [Text]
      -- | Execution budget that was consumed. It will always be less or equal to what was
      -- supplied during execution.
      P.ExBudget
  | DebugFailure
      -- | Execution logs from the plutus interpreter
      [Text]
      -- | Evaluation error from Plutus interpreter
      P.EvaluationError
      -- | Everything that is needed in order to run the script
      PlutusWithContext
      -- | Expected execution budget. This value is Nothing when the supplied script can't
      -- be executed within 5 second limit or there is a problem with decoding plutus script
      -- itself.
      (Maybe P.ExBudget)
  deriving (Int -> PlutusDebugInfo -> ShowS
[PlutusDebugInfo] -> ShowS
PlutusDebugInfo -> String
(Int -> PlutusDebugInfo -> ShowS)
-> (PlutusDebugInfo -> String)
-> ([PlutusDebugInfo] -> ShowS)
-> Show PlutusDebugInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlutusDebugInfo -> ShowS
showsPrec :: Int -> PlutusDebugInfo -> ShowS
$cshow :: PlutusDebugInfo -> String
show :: PlutusDebugInfo -> String
$cshowList :: [PlutusDebugInfo] -> ShowS
showList :: [PlutusDebugInfo] -> ShowS
Show)

data PlutusDebugOverrides = PlutusDebugOverrides
  { PlutusDebugOverrides -> Maybe ByteString
pdoScript :: !(Maybe ByteString)
  , PlutusDebugOverrides -> Maybe Version
pdoProtocolVersion :: !(Maybe Version)
  , PlutusDebugOverrides -> Maybe Language
pdoLanguage :: !(Maybe Language)
  , PlutusDebugOverrides -> Maybe [Int64]
pdoCostModelValues :: !(Maybe [Int64])
  , PlutusDebugOverrides -> Maybe Natural
pdoExUnitsMem :: !(Maybe Natural)
  , PlutusDebugOverrides -> Maybe Natural
pdoExUnitsSteps :: !(Maybe Natural)
  }
  deriving (Int -> PlutusDebugOverrides -> ShowS
[PlutusDebugOverrides] -> ShowS
PlutusDebugOverrides -> String
(Int -> PlutusDebugOverrides -> ShowS)
-> (PlutusDebugOverrides -> String)
-> ([PlutusDebugOverrides] -> ShowS)
-> Show PlutusDebugOverrides
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlutusDebugOverrides -> ShowS
showsPrec :: Int -> PlutusDebugOverrides -> ShowS
$cshow :: PlutusDebugOverrides -> String
show :: PlutusDebugOverrides -> String
$cshowList :: [PlutusDebugOverrides] -> ShowS
showList :: [PlutusDebugOverrides] -> ShowS
Show)

-- TODO: Add support for overriding arguments.
overrideContext :: PlutusWithContext -> PlutusDebugOverrides -> PlutusWithContext
overrideContext :: PlutusWithContext -> PlutusDebugOverrides -> PlutusWithContext
overrideContext PlutusWithContext {Either (Plutus l) (PlutusRunnable l)
Version
ScriptHash
ExUnits
PlutusArgs l
CostModel
pwcProtocolVersion :: PlutusWithContext -> Version
pwcScript :: ()
pwcScriptHash :: PlutusWithContext -> ScriptHash
pwcArgs :: ()
pwcExUnits :: PlutusWithContext -> ExUnits
pwcCostModel :: PlutusWithContext -> CostModel
pwcProtocolVersion :: Version
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
pwcExUnits :: ExUnits
pwcCostModel :: CostModel
..} PlutusDebugOverrides {Maybe Natural
Maybe [Int64]
Maybe ByteString
Maybe Version
Maybe Language
pdoScript :: PlutusDebugOverrides -> Maybe ByteString
pdoProtocolVersion :: PlutusDebugOverrides -> Maybe Version
pdoLanguage :: PlutusDebugOverrides -> Maybe Language
pdoCostModelValues :: PlutusDebugOverrides -> Maybe [Int64]
pdoExUnitsMem :: PlutusDebugOverrides -> Maybe Natural
pdoExUnitsSteps :: PlutusDebugOverrides -> Maybe Natural
pdoScript :: Maybe ByteString
pdoProtocolVersion :: Maybe Version
pdoLanguage :: Maybe Language
pdoCostModelValues :: Maybe [Int64]
pdoExUnitsMem :: Maybe Natural
pdoExUnitsSteps :: Maybe Natural
..} =
  -- NOTE: due to GADTs, we can't do a record update here and need to
  -- copy all the fields. Otherwise GHC will greet us with
  -- `Record update for insufficiently polymorphic field...` error
  PlutusWithContext
    { pwcProtocolVersion :: Version
pwcProtocolVersion = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe Version
pwcProtocolVersion Maybe Version
pdoProtocolVersion
    , pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScript = Either (Plutus l) (PlutusRunnable l)
overrideScript
    , pwcExUnits :: ExUnits
pwcExUnits = ExUnits
overrideExUnits
    , pwcCostModel :: CostModel
pwcCostModel = CostModel
overrideCostModel
    , ScriptHash
PlutusArgs l
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
..
    }
  where
    overrideExUnits :: ExUnits
overrideExUnits =
      Natural -> Natural -> ExUnits
ExUnits
        (Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe (ExUnits -> Natural
exUnitsMem ExUnits
pwcExUnits) Maybe Natural
pdoExUnitsMem)
        (Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe (ExUnits -> Natural
exUnitsSteps ExUnits
pwcExUnits) Maybe Natural
pdoExUnitsSteps)
    overrideCostModel :: CostModel
overrideCostModel =
      CostModel -> Either CostModelApplyError CostModel -> CostModel
forall b a. b -> Either a b -> b
fromRight CostModel
pwcCostModel (Either CostModelApplyError CostModel -> CostModel)
-> Either CostModelApplyError CostModel -> CostModel
forall a b. (a -> b) -> a -> b
$
        Language -> [Int64] -> Either CostModelApplyError CostModel
mkCostModel
          (Language -> Maybe Language -> Language
forall a. a -> Maybe a -> a
fromMaybe (CostModel -> Language
getCostModelLanguage CostModel
pwcCostModel) Maybe Language
pdoLanguage)
          ([Int64] -> Maybe [Int64] -> [Int64]
forall a. a -> Maybe a -> a
fromMaybe (CostModel -> [Int64]
getCostModelParams CostModel
pwcCostModel) Maybe [Int64]
pdoCostModelValues)
    overrideScript :: Either (Plutus l) (PlutusRunnable l)
overrideScript =
      case Maybe ByteString
pdoScript of
        Maybe ByteString
Nothing -> Either (Plutus l) (PlutusRunnable l)
pwcScript
        Just ByteString
script ->
          (String -> Either (Plutus l) (PlutusRunnable l))
-> (ByteString -> Either (Plutus l) (PlutusRunnable l))
-> Either String ByteString
-> Either (Plutus l) (PlutusRunnable l)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either (Plutus l) (PlutusRunnable l)
forall a. HasCallStack => String -> a
error (Plutus l -> Either (Plutus l) (PlutusRunnable l)
forall a b. a -> Either a b
Left (Plutus l -> Either (Plutus l) (PlutusRunnable l))
-> (ByteString -> Plutus l)
-> ByteString
-> Either (Plutus l) (PlutusRunnable l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus l
forall (l :: Language). PlutusBinary -> Plutus l
Plutus (PlutusBinary -> Plutus l)
-> (ByteString -> PlutusBinary) -> ByteString -> Plutus l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PlutusBinary
PlutusBinary (ShortByteString -> PlutusBinary)
-> (ByteString -> ShortByteString) -> ByteString -> PlutusBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort) (Either String ByteString -> Either (Plutus l) (PlutusRunnable l))
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either (Plutus l) (PlutusRunnable l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
B16.decode (ByteString -> Either (Plutus l) (PlutusRunnable l))
-> ByteString -> Either (Plutus l) (PlutusRunnable l)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BSC.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ByteString
script

debugPlutus :: String -> PlutusDebugOverrides -> IO PlutusDebugInfo
debugPlutus :: String -> PlutusDebugOverrides -> IO PlutusDebugInfo
debugPlutus String
scriptsWithContext PlutusDebugOverrides
opts =
  case ByteString -> Either String ByteString
B64.decode (String -> ByteString
BSU.fromString String
scriptsWithContext) of
    Left String
e -> PlutusDebugInfo -> IO PlutusDebugInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusDebugInfo -> IO PlutusDebugInfo)
-> PlutusDebugInfo -> IO PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$ String -> PlutusDebugInfo
DebugBadHex (ShowS
forall a. Show a => a -> String
show String
e)
    Right ByteString
bs ->
      case ByteString -> Either DecoderError PlutusWithContext
forall a. FromCBOR a => ByteString -> Either DecoderError a
Plain.decodeFull' ByteString
bs of
        Left DecoderError
e -> PlutusDebugInfo -> IO PlutusDebugInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusDebugInfo -> IO PlutusDebugInfo)
-> PlutusDebugInfo -> IO PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$ String -> PlutusDebugInfo
DebugCannotDecode (String -> PlutusDebugInfo) -> String -> PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$ DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e
        Right PlutusWithContext
pwcOriginal ->
          let pwc :: PlutusWithContext
pwc = PlutusWithContext -> PlutusDebugOverrides -> PlutusWithContext
overrideContext PlutusWithContext
pwcOriginal PlutusDebugOverrides
opts
              cm :: EvaluationContext
cm = CostModel -> EvaluationContext
getEvaluationContext (CostModel -> EvaluationContext) -> CostModel -> EvaluationContext
forall a b. (a -> b) -> a -> b
$ PlutusWithContext -> CostModel
pwcCostModel PlutusWithContext
pwc
              eu :: ExBudget
eu = ExUnits -> ExBudget
transExUnits (ExUnits -> ExBudget) -> ExUnits -> ExBudget
forall a b. (a -> b) -> a -> b
$ PlutusWithContext -> ExUnits
pwcExUnits PlutusWithContext
pwc
              onDecoderError :: EvaluationError -> IO PlutusDebugInfo
onDecoderError EvaluationError
err = PlutusDebugInfo -> IO PlutusDebugInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusDebugInfo -> IO PlutusDebugInfo)
-> PlutusDebugInfo -> IO PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$ [Text]
-> EvaluationError
-> PlutusWithContext
-> Maybe ExBudget
-> PlutusDebugInfo
DebugFailure [] EvaluationError
err PlutusWithContext
pwc Maybe ExBudget
forall a. Maybe a
Nothing
           in PlutusWithContext
-> (EvaluationError -> IO PlutusDebugInfo)
-> (forall {l :: Language}.
    PlutusLanguage l =>
    PlutusRunnable l -> PlutusArgs l -> IO PlutusDebugInfo)
-> IO PlutusDebugInfo
forall a.
PlutusWithContext
-> (EvaluationError -> a)
-> (forall (l :: Language).
    PlutusLanguage l =>
    PlutusRunnable l -> PlutusArgs l -> a)
-> a
withRunnablePlutusWithContext PlutusWithContext
pwc EvaluationError -> IO PlutusDebugInfo
onDecoderError ((forall {l :: Language}.
  PlutusLanguage l =>
  PlutusRunnable l -> PlutusArgs l -> IO PlutusDebugInfo)
 -> IO PlutusDebugInfo)
-> (forall {l :: Language}.
    PlutusLanguage l =>
    PlutusRunnable l -> PlutusArgs l -> IO PlutusDebugInfo)
-> IO PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$ \PlutusRunnable l
plutusRunnable PlutusArgs l
args ->
                let toDebugInfo :: ([Text], Either EvaluationError ExBudget) -> IO PlutusDebugInfo
toDebugInfo = \case
                      ([Text]
logs, Left err :: EvaluationError
err@(P.CodecError {})) -> PlutusDebugInfo -> IO PlutusDebugInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusDebugInfo -> IO PlutusDebugInfo)
-> PlutusDebugInfo -> IO PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$ [Text]
-> EvaluationError
-> PlutusWithContext
-> Maybe ExBudget
-> PlutusDebugInfo
DebugFailure [Text]
logs EvaluationError
err PlutusWithContext
pwc Maybe ExBudget
forall a. Maybe a
Nothing
                      ([Text]
logs, Left EvaluationError
err) -> do
                        Maybe (Maybe ExBudget)
mExpectedExUnits <-
                          Int -> IO (Maybe ExBudget) -> IO (Maybe (Maybe ExBudget))
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
5_000_000 (IO (Maybe ExBudget) -> IO (Maybe (Maybe ExBudget)))
-> IO (Maybe ExBudget) -> IO (Maybe (Maybe ExBudget))
forall a b. (a -> b) -> a -> b
$ do
                            let res :: ([Text], Either EvaluationError ExBudget)
res =
                                  Version
-> VerboseMode
-> EvaluationContext
-> PlutusRunnable l
-> PlutusArgs l
-> ([Text], Either EvaluationError ExBudget)
forall (l :: Language).
PlutusLanguage l =>
Version
-> VerboseMode
-> EvaluationContext
-> PlutusRunnable l
-> PlutusArgs l
-> ([Text], Either EvaluationError ExBudget)
evaluatePlutusRunnableBudget (PlutusWithContext -> Version
pwcProtocolVersion PlutusWithContext
pwc) VerboseMode
P.Verbose EvaluationContext
cm PlutusRunnable l
plutusRunnable PlutusArgs l
args
                            case ([Text], Either EvaluationError ExBudget)
-> Either EvaluationError ExBudget
forall a b. (a, b) -> b
snd ([Text], Either EvaluationError ExBudget)
res of
                              Left {} -> Maybe ExBudget -> IO (Maybe ExBudget)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ExBudget
forall a. Maybe a
Nothing
                              Right ExBudget
exUnits -> ExBudget -> Maybe ExBudget
forall a. a -> Maybe a
Just (ExBudget -> Maybe ExBudget) -> IO ExBudget -> IO (Maybe ExBudget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExBudget -> IO ExBudget
forall a. a -> IO a
evaluate (ExBudget -> ExBudget
forall a. NFData a => a -> a
force ExBudget
exUnits)
                        PlutusDebugInfo -> IO PlutusDebugInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusDebugInfo -> IO PlutusDebugInfo)
-> PlutusDebugInfo -> IO PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$ [Text]
-> EvaluationError
-> PlutusWithContext
-> Maybe ExBudget
-> PlutusDebugInfo
DebugFailure [Text]
logs EvaluationError
err PlutusWithContext
pwc (Maybe (Maybe ExBudget) -> Maybe ExBudget
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe ExBudget)
mExpectedExUnits)
                      ([Text]
logs, Right ExBudget
ex) -> PlutusDebugInfo -> IO PlutusDebugInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusDebugInfo -> IO PlutusDebugInfo)
-> PlutusDebugInfo -> IO PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$ [Text] -> ExBudget -> PlutusDebugInfo
DebugSuccess [Text]
logs ExBudget
ex
                 in ([Text], Either EvaluationError ExBudget) -> IO PlutusDebugInfo
toDebugInfo (([Text], Either EvaluationError ExBudget) -> IO PlutusDebugInfo)
-> ([Text], Either EvaluationError ExBudget) -> IO PlutusDebugInfo
forall a b. (a -> b) -> a -> b
$
                      Version
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> PlutusRunnable l
-> PlutusArgs l
-> ([Text], Either EvaluationError ExBudget)
forall (l :: Language).
PlutusLanguage l =>
Version
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> PlutusRunnable l
-> PlutusArgs l
-> ([Text], Either EvaluationError ExBudget)
evaluatePlutusRunnable (PlutusWithContext -> Version
pwcProtocolVersion PlutusWithContext
pwc) VerboseMode
P.Verbose EvaluationContext
cm ExBudget
eu PlutusRunnable l
plutusRunnable PlutusArgs l
args

runPlutusScript :: PlutusWithContext -> ScriptResult
runPlutusScript :: PlutusWithContext -> ScriptResult
runPlutusScript = ([Text], ScriptResult) -> ScriptResult
forall a b. (a, b) -> b
snd (([Text], ScriptResult) -> ScriptResult)
-> (PlutusWithContext -> ([Text], ScriptResult))
-> PlutusWithContext
-> ScriptResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusWithContext -> ([Text], ScriptResult)
runPlutusScriptWithLogs

runPlutusScriptWithLogs ::
  PlutusWithContext ->
  ([Text], ScriptResult)
runPlutusScriptWithLogs :: PlutusWithContext -> ([Text], ScriptResult)
runPlutusScriptWithLogs PlutusWithContext
pwc = Either EvaluationError ExBudget -> ScriptResult
toScriptResult (Either EvaluationError ExBudget -> ScriptResult)
-> ([Text], Either EvaluationError ExBudget)
-> ([Text], ScriptResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerboseMode
-> PlutusWithContext -> ([Text], Either EvaluationError ExBudget)
evaluatePlutusWithContext VerboseMode
P.Quiet PlutusWithContext
pwc
  where
    toScriptResult :: Either EvaluationError ExBudget -> ScriptResult
toScriptResult = \case
      Left EvaluationError
evalError -> PlutusWithContext -> EvaluationError -> ScriptResult
explainPlutusEvaluationError PlutusWithContext
pwc EvaluationError
evalError
      Right ExBudget
_ -> PlutusWithContext -> ScriptResult
scriptPass PlutusWithContext
pwc

evaluatePlutusWithContext ::
  P.VerboseMode ->
  PlutusWithContext ->
  ([Text], Either P.EvaluationError P.ExBudget)
evaluatePlutusWithContext :: VerboseMode
-> PlutusWithContext -> ([Text], Either EvaluationError ExBudget)
evaluatePlutusWithContext VerboseMode
mode pwc :: PlutusWithContext
pwc@PlutusWithContext {Either (Plutus l) (PlutusRunnable l)
Version
ScriptHash
ExUnits
PlutusArgs l
CostModel
pwcProtocolVersion :: PlutusWithContext -> Version
pwcScript :: ()
pwcScriptHash :: PlutusWithContext -> ScriptHash
pwcArgs :: ()
pwcExUnits :: PlutusWithContext -> ExUnits
pwcCostModel :: PlutusWithContext -> CostModel
pwcProtocolVersion :: Version
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
pwcExUnits :: ExUnits
pwcCostModel :: CostModel
..} =
  PlutusWithContext
-> (EvaluationError -> ([Text], Either EvaluationError ExBudget))
-> (forall {l :: Language}.
    PlutusLanguage l =>
    PlutusRunnable l
    -> PlutusArgs l -> ([Text], Either EvaluationError ExBudget))
-> ([Text], Either EvaluationError ExBudget)
forall a.
PlutusWithContext
-> (EvaluationError -> a)
-> (forall (l :: Language).
    PlutusLanguage l =>
    PlutusRunnable l -> PlutusArgs l -> a)
-> a
withRunnablePlutusWithContext PlutusWithContext
pwc (([],) (Either EvaluationError ExBudget
 -> ([Text], Either EvaluationError ExBudget))
-> (EvaluationError -> Either EvaluationError ExBudget)
-> EvaluationError
-> ([Text], Either EvaluationError ExBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluationError -> Either EvaluationError ExBudget
forall a b. a -> Either a b
Left) ((forall {l :: Language}.
  PlutusLanguage l =>
  PlutusRunnable l
  -> PlutusArgs l -> ([Text], Either EvaluationError ExBudget))
 -> ([Text], Either EvaluationError ExBudget))
-> (forall {l :: Language}.
    PlutusLanguage l =>
    PlutusRunnable l
    -> PlutusArgs l -> ([Text], Either EvaluationError ExBudget))
-> ([Text], Either EvaluationError ExBudget)
forall a b. (a -> b) -> a -> b
$
    Version
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> PlutusRunnable l
-> PlutusArgs l
-> ([Text], Either EvaluationError ExBudget)
forall (l :: Language).
PlutusLanguage l =>
Version
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> PlutusRunnable l
-> PlutusArgs l
-> ([Text], Either EvaluationError ExBudget)
evaluatePlutusRunnable
      Version
pwcProtocolVersion
      VerboseMode
mode
      (CostModel -> EvaluationContext
getEvaluationContext CostModel
pwcCostModel)
      (ExUnits -> ExBudget
transExUnits ExUnits
pwcExUnits)

-- | Explain why a script might fail. Scripts come in three flavors:
--
-- (1) with 3 arguments @[data,redeemer,context]@ for `PlutusV1` and `PlustuV2`
--
-- (2) with 2 arguments @[redeemer,context]@ for `PlutusV1` and `PlustuV2`
--
-- (3) with 1 argument @context@ for `PlutusV3` onwards
explainPlutusEvaluationError ::
  PlutusWithContext ->
  P.EvaluationError ->
  ScriptResult
explainPlutusEvaluationError :: PlutusWithContext -> EvaluationError -> ScriptResult
explainPlutusEvaluationError pwc :: PlutusWithContext
pwc@PlutusWithContext {Version
pwcProtocolVersion :: PlutusWithContext -> Version
pwcProtocolVersion :: Version
pwcProtocolVersion, Either (Plutus l) (PlutusRunnable l)
pwcScript :: ()
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScript, PlutusArgs l
pwcArgs :: ()
pwcArgs :: PlutusArgs l
pwcArgs} EvaluationError
e =
  let lang :: Language
lang = (Plutus l -> Language)
-> (PlutusRunnable l -> Language)
-> Either (Plutus l) (PlutusRunnable l)
-> Language
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Plutus l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage PlutusRunnable l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Either (Plutus l) (PlutusRunnable l)
pwcScript
      Plutus PlutusBinary
binaryScript = (Plutus l -> Plutus l)
-> (PlutusRunnable l -> Plutus l)
-> Either (Plutus l) (PlutusRunnable l)
-> Plutus l
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Plutus l -> Plutus l
forall a. a -> a
id PlutusRunnable l -> Plutus l
forall (l :: Language). PlutusRunnable l -> Plutus l
plutusFromRunnable Either (Plutus l) (PlutusRunnable l)
pwcScript
      firstLines :: [String]
firstLines =
        [ String
"The " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Language -> String
forall a. Show a => a -> String
show Language
lang String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" script failed:"
        , String
"Base64-encoded script bytes:"
        ]
      shLine :: String
shLine = String
"The script hash is:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScriptHash -> String
forall a. Show a => a -> String
show (PlutusWithContext -> ScriptHash
pwcScriptHash PlutusWithContext
pwc)
      pvLine :: String
pvLine = String
"The protocol version is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Show a => a -> String
show Version
pwcProtocolVersion
      plutusError :: String
plutusError = String
"The plutus evaluation error is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ EvaluationError -> String
forall a. Show a => a -> String
show EvaluationError
e

      dataLines :: String
dataLines = Doc Any -> String
forall a. Show a => a -> String
show (PlutusArgs l -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. PlutusArgs l -> Doc ann
pretty PlutusArgs l
pwcArgs)
      line :: Text
line =
        String -> Text
pack (String -> Text) -> ([String] -> String) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Text) -> [String] -> Text
forall a b. (a -> b) -> a -> b
$ String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
firstLines [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [PlutusBinary -> String
forall a. Show a => a -> String
show PlutusBinary
binaryScript, String
shLine, String
plutusError, String
pvLine, String
dataLines]
   in ScriptFailure -> ScriptResult
scriptFail (ScriptFailure -> ScriptResult) -> ScriptFailure -> ScriptResult
forall a b. (a -> b) -> a -> b
$ Text -> PlutusWithContext -> ScriptFailure
ScriptFailure Text
line PlutusWithContext
pwc