{-# 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 (
  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.Crypto (Crypto)
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Plutus.CostModels (
  CostModel,
  decodeCostModel,
  encodeCostModel,
  getEvaluationContext,
 )
import Cardano.Ledger.Plutus.ExUnits (ExUnits)
import Cardano.Ledger.Plutus.Language (
  Plutus (..),
  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 qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.UTF8 as BSU
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import GHC.Generics (Generic)
import 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 c where
  PlutusWithContext ::
    PlutusLanguage l =>
    { forall c. PlutusWithContext c -> Version
pwcProtocolVersion :: !Version
    -- ^ Mayjor 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).
    , forall c. PlutusWithContext c -> ScriptHash c
pwcScriptHash :: !(ScriptHash c)
    -- ^ 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
    , forall c. PlutusWithContext c -> ExUnits
pwcExUnits :: !ExUnits
    -- ^ Limit on the execution units
    , forall c. PlutusWithContext c -> CostModel
pwcCostModel :: !CostModel
    -- ^ `CostModel` to be used during script evaluation. It must match the language
    -- version in the `pwcScript`
    } ->
    PlutusWithContext c

deriving instance Show (PlutusWithContext c)

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

instance Eq (PlutusWithContext c) where
  pwc1 :: PlutusWithContext c
pwc1@(PlutusWithContext {pwcScript :: ()
pwcScript = Either (Plutus l) (PlutusRunnable l)
s1, pwcArgs :: ()
pwcArgs = PlutusArgs l
args1})
    == :: PlutusWithContext c -> PlutusWithContext c -> Bool
== pwc2 :: PlutusWithContext c
pwc2@(PlutusWithContext {pwcScript :: ()
pwcScript = Either (Plutus l) (PlutusRunnable l)
s2, pwcArgs :: ()
pwcArgs = PlutusArgs l
args2}) =
      forall c. PlutusWithContext c -> Version
pwcProtocolVersion PlutusWithContext c
pwc1 forall a. Eq a => a -> a -> Bool
== forall c. PlutusWithContext c -> Version
pwcProtocolVersion PlutusWithContext c
pwc2
        Bool -> Bool -> Bool
&& forall c. PlutusWithContext c -> ScriptHash c
pwcScriptHash PlutusWithContext c
pwc1 forall a. Eq a => a -> a -> Bool
== forall c. PlutusWithContext c -> ScriptHash c
pwcScriptHash PlutusWithContext c
pwc2
        Bool -> Bool -> Bool
&& forall a. a -> Maybe a -> a
fromMaybe Bool
False (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 forall a. Eq a => a -> a -> Bool
(==))
        Bool -> Bool -> Bool
&& forall c. PlutusWithContext c -> ExUnits
pwcExUnits PlutusWithContext c
pwc1 forall a. Eq a => a -> a -> Bool
== forall c. PlutusWithContext c -> ExUnits
pwcExUnits PlutusWithContext c
pwc2
        Bool -> Bool -> Bool
&& forall c. PlutusWithContext c -> CostModel
pwcCostModel PlutusWithContext c
pwc1 forall a. Eq a => a -> a -> Bool
== forall c. PlutusWithContext c -> CostModel
pwcCostModel PlutusWithContext c
pwc2
        Bool -> Bool -> 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) =
          forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
p1 forall a. Eq a => a -> a -> Bool
== forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
p2 Bool -> Bool -> Bool
&& forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary Plutus l
p1 forall a. Eq a => a -> a -> Bool
== forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary Plutus l
p2
        eqScripts (Right PlutusRunnable l
p1) (Right PlutusRunnable l
p2) =
          forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage PlutusRunnable l
p1 forall a. Eq a => a -> a -> Bool
== forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage PlutusRunnable l
p2 Bool -> Bool -> Bool
&& forall (l :: Language). PlutusRunnable l -> ScriptForEvaluation
plutusRunnable PlutusRunnable l
p1 forall a. Eq a => a -> a -> Bool
== 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 c = ScriptFailure
  { forall c. ScriptFailure c -> Text
scriptFailureMessage :: Text
  , forall c. ScriptFailure c -> PlutusWithContext c
scriptFailurePlutus :: PlutusWithContext c
  }
  deriving (Int -> ScriptFailure c -> ShowS
forall c. Int -> ScriptFailure c -> ShowS
forall c. [ScriptFailure c] -> ShowS
forall c. ScriptFailure c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptFailure c] -> ShowS
$cshowList :: forall c. [ScriptFailure c] -> ShowS
show :: ScriptFailure c -> String
$cshow :: forall c. ScriptFailure c -> String
showsPrec :: Int -> ScriptFailure c -> ShowS
$cshowsPrec :: forall c. Int -> ScriptFailure c -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (ScriptFailure c) x -> ScriptFailure c
forall c x. ScriptFailure c -> Rep (ScriptFailure c) x
$cto :: forall c x. Rep (ScriptFailure c) x -> ScriptFailure c
$cfrom :: forall c x. ScriptFailure c -> Rep (ScriptFailure c) x
Generic)

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

scriptPass :: PlutusWithContext c -> ScriptResult c
scriptPass :: forall c. PlutusWithContext c -> ScriptResult c
scriptPass PlutusWithContext c
pwc = forall c. [PlutusWithContext c] -> ScriptResult c
Passes [PlutusWithContext c
pwc]

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

withRunnablePlutusWithContext ::
  PlutusWithContext c ->
  -- | Handle the decoder failure
  (P.EvaluationError -> a) ->
  (forall l. PlutusLanguage l => PlutusRunnable l -> PlutusArgs l -> a) ->
  a
withRunnablePlutusWithContext :: forall c a.
PlutusWithContext c
-> (EvaluationError -> a)
-> (forall (l :: Language).
    PlutusLanguage l =>
    PlutusRunnable l -> PlutusArgs l -> a)
-> a
withRunnablePlutusWithContext PlutusWithContext {Version
pwcProtocolVersion :: Version
pwcProtocolVersion :: forall c. PlutusWithContext c -> Version
pwcProtocolVersion, Either (Plutus l) (PlutusRunnable l)
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScript :: ()
pwcScript, PlutusArgs l
pwcArgs :: PlutusArgs l
pwcArgs :: ()
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 -> forall (l :: Language).
PlutusLanguage l =>
PlutusRunnable l -> PlutusArgs l -> a
f PlutusRunnable l
pr PlutusArgs l
pwcArgs
    Left Plutus l
plutus ->
      case forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
decodePlutusRunnable Version
pwcProtocolVersion Plutus l
plutus of
        Right PlutusRunnable l
pr -> 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 c) where
  Passes [PlutusWithContext c]
ps <> :: ScriptResult c -> ScriptResult c -> ScriptResult c
<> Passes [PlutusWithContext c]
qs = forall c. [PlutusWithContext c] -> ScriptResult c
Passes ([PlutusWithContext c]
ps forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext c]
qs)
  Passes [PlutusWithContext c]
ps <> Fails [PlutusWithContext c]
qs NonEmpty (ScriptFailure c)
xs = forall c.
[PlutusWithContext c]
-> NonEmpty (ScriptFailure c) -> ScriptResult c
Fails ([PlutusWithContext c]
ps forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext c]
qs) NonEmpty (ScriptFailure c)
xs
  Fails [PlutusWithContext c]
ps NonEmpty (ScriptFailure c)
xs <> Passes [PlutusWithContext c]
qs = forall c.
[PlutusWithContext c]
-> NonEmpty (ScriptFailure c) -> ScriptResult c
Fails ([PlutusWithContext c]
ps forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext c]
qs) NonEmpty (ScriptFailure c)
xs
  Fails [PlutusWithContext c]
ps NonEmpty (ScriptFailure c)
xs <> Fails [PlutusWithContext c]
qs NonEmpty (ScriptFailure c)
ys = forall c.
[PlutusWithContext c]
-> NonEmpty (ScriptFailure c) -> ScriptResult c
Fails ([PlutusWithContext c]
ps forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext c]
qs) (NonEmpty (ScriptFailure c)
xs forall a. Semigroup a => a -> a -> a
<> NonEmpty (ScriptFailure c)
ys)

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

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

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

data PlutusDebugInfo c
  = 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 c)
      -- | 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 c -> ShowS
forall c. Int -> PlutusDebugInfo c -> ShowS
forall c. [PlutusDebugInfo c] -> ShowS
forall c. PlutusDebugInfo c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusDebugInfo c] -> ShowS
$cshowList :: forall c. [PlutusDebugInfo c] -> ShowS
show :: PlutusDebugInfo c -> String
$cshow :: forall c. PlutusDebugInfo c -> String
showsPrec :: Int -> PlutusDebugInfo c -> ShowS
$cshowsPrec :: forall c. Int -> PlutusDebugInfo c -> ShowS
Show)

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

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

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

evaluatePlutusWithContext ::
  P.VerboseMode ->
  PlutusWithContext c ->
  ([Text], Either P.EvaluationError P.ExBudget)
evaluatePlutusWithContext :: forall c.
VerboseMode
-> PlutusWithContext c -> ([Text], Either EvaluationError ExBudget)
evaluatePlutusWithContext VerboseMode
mode pwc :: PlutusWithContext c
pwc@PlutusWithContext {Either (Plutus l) (PlutusRunnable l)
Version
ScriptHash c
PlutusArgs l
CostModel
ExUnits
pwcCostModel :: CostModel
pwcExUnits :: ExUnits
pwcArgs :: PlutusArgs l
pwcScriptHash :: ScriptHash c
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcProtocolVersion :: Version
pwcCostModel :: forall c. PlutusWithContext c -> CostModel
pwcExUnits :: forall c. PlutusWithContext c -> ExUnits
pwcArgs :: ()
pwcScriptHash :: forall c. PlutusWithContext c -> ScriptHash c
pwcScript :: ()
pwcProtocolVersion :: forall c. PlutusWithContext c -> Version
..} =
  forall c a.
PlutusWithContext c
-> (EvaluationError -> a)
-> (forall (l :: Language).
    PlutusLanguage l =>
    PlutusRunnable l -> PlutusArgs l -> a)
-> a
withRunnablePlutusWithContext PlutusWithContext c
pwc (([],) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall a b. (a -> b) -> a -> b
$
    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 c ->
  P.EvaluationError ->
  ScriptResult c
explainPlutusEvaluationError :: forall c. PlutusWithContext c -> EvaluationError -> ScriptResult c
explainPlutusEvaluationError pwc :: PlutusWithContext c
pwc@PlutusWithContext {Version
pwcProtocolVersion :: Version
pwcProtocolVersion :: forall c. PlutusWithContext c -> Version
pwcProtocolVersion, Either (Plutus l) (PlutusRunnable l)
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScript :: ()
pwcScript, PlutusArgs l
pwcArgs :: PlutusArgs l
pwcArgs :: ()
pwcArgs} EvaluationError
e =
  let lang :: Language
lang = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Either (Plutus l) (PlutusRunnable l)
pwcScript
      Plutus PlutusBinary
binaryScript = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall (l :: Language). PlutusRunnable l -> Plutus l
plutusFromRunnable Either (Plutus l) (PlutusRunnable l)
pwcScript
      firstLines :: [String]
firstLines =
        [ String
"The " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Language
lang forall a. [a] -> [a] -> [a]
++ String
" script failed:"
        , String
"Base64-encoded script bytes:"
        ]
      shLine :: String
shLine = String
"The script hash is:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. PlutusWithContext c -> ScriptHash c
pwcScriptHash PlutusWithContext c
pwc)
      pvLine :: String
pvLine = String
"The protocol version is: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Version
pwcProtocolVersion
      plutusError :: String
plutusError = String
"The plutus evaluation error is: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show EvaluationError
e

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