{-# LANGUAGE BlockArguments    #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module PlutusLedgerApi.Test.EvaluationEvent
  ( ScriptEvaluationEvents (..)
  , ScriptEvaluationEvent (..)
  , ScriptEvaluationData (..)
  , ScriptEvaluationResult (..)
  , UnexpectedEvaluationResult (..)
  , TestFailure (..)
  , renderTestFailure
  , renderTestFailures
  , checkEvaluationEvent
  ) where

import PlutusCore.Data qualified as PLC
import PlutusCore.Pretty
import PlutusLedgerApi.Common
import PlutusLedgerApi.V1 qualified as V1
import PlutusLedgerApi.V2 qualified as V2

import Codec.Serialise (Serialise (..))
import Data.ByteString.Base64 qualified as Base64
import Data.ByteString.Short qualified as BS
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty, toList)
import Data.Text.Encoding qualified as Text
import GHC.Generics (Generic)
import PlutusLedgerApi.V3 qualified as V3
import Prettyprinter

data ScriptEvaluationResult = ScriptEvaluationSuccess | ScriptEvaluationFailure
  deriving stock (Int -> ScriptEvaluationResult -> ShowS
[ScriptEvaluationResult] -> ShowS
ScriptEvaluationResult -> String
(Int -> ScriptEvaluationResult -> ShowS)
-> (ScriptEvaluationResult -> String)
-> ([ScriptEvaluationResult] -> ShowS)
-> Show ScriptEvaluationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptEvaluationResult -> ShowS
showsPrec :: Int -> ScriptEvaluationResult -> ShowS
$cshow :: ScriptEvaluationResult -> String
show :: ScriptEvaluationResult -> String
$cshowList :: [ScriptEvaluationResult] -> ShowS
showList :: [ScriptEvaluationResult] -> ShowS
Show, (forall x. ScriptEvaluationResult -> Rep ScriptEvaluationResult x)
-> (forall x.
    Rep ScriptEvaluationResult x -> ScriptEvaluationResult)
-> Generic ScriptEvaluationResult
forall x. Rep ScriptEvaluationResult x -> ScriptEvaluationResult
forall x. ScriptEvaluationResult -> Rep ScriptEvaluationResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptEvaluationResult -> Rep ScriptEvaluationResult x
from :: forall x. ScriptEvaluationResult -> Rep ScriptEvaluationResult x
$cto :: forall x. Rep ScriptEvaluationResult x -> ScriptEvaluationResult
to :: forall x. Rep ScriptEvaluationResult x -> ScriptEvaluationResult
Generic)
  deriving anyclass ([ScriptEvaluationResult] -> Encoding
ScriptEvaluationResult -> Encoding
(ScriptEvaluationResult -> Encoding)
-> (forall s. Decoder s ScriptEvaluationResult)
-> ([ScriptEvaluationResult] -> Encoding)
-> (forall s. Decoder s [ScriptEvaluationResult])
-> Serialise ScriptEvaluationResult
forall s. Decoder s [ScriptEvaluationResult]
forall s. Decoder s ScriptEvaluationResult
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ScriptEvaluationResult -> Encoding
encode :: ScriptEvaluationResult -> Encoding
$cdecode :: forall s. Decoder s ScriptEvaluationResult
decode :: forall s. Decoder s ScriptEvaluationResult
$cencodeList :: [ScriptEvaluationResult] -> Encoding
encodeList :: [ScriptEvaluationResult] -> Encoding
$cdecodeList :: forall s. Decoder s [ScriptEvaluationResult]
decodeList :: forall s. Decoder s [ScriptEvaluationResult]
Serialise)

instance Pretty ScriptEvaluationResult where
  pretty :: forall ann. ScriptEvaluationResult -> Doc ann
pretty = ScriptEvaluationResult -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

{- | All the data needed to evaluate a script using the ledger API, except for the cost model
 parameters, as these are tracked separately.
-}
data ScriptEvaluationData = ScriptEvaluationData
  { ScriptEvaluationData -> MajorProtocolVersion
dataProtocolVersion :: MajorProtocolVersion
  , ScriptEvaluationData -> ExBudget
dataBudget          :: ExBudget
  , ScriptEvaluationData -> SerialisedScript
dataScript          :: SerialisedScript
  , ScriptEvaluationData -> [Data]
dataInputs          :: [PLC.Data]
  }
  deriving stock (Int -> ScriptEvaluationData -> ShowS
[ScriptEvaluationData] -> ShowS
ScriptEvaluationData -> String
(Int -> ScriptEvaluationData -> ShowS)
-> (ScriptEvaluationData -> String)
-> ([ScriptEvaluationData] -> ShowS)
-> Show ScriptEvaluationData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptEvaluationData -> ShowS
showsPrec :: Int -> ScriptEvaluationData -> ShowS
$cshow :: ScriptEvaluationData -> String
show :: ScriptEvaluationData -> String
$cshowList :: [ScriptEvaluationData] -> ShowS
showList :: [ScriptEvaluationData] -> ShowS
Show, (forall x. ScriptEvaluationData -> Rep ScriptEvaluationData x)
-> (forall x. Rep ScriptEvaluationData x -> ScriptEvaluationData)
-> Generic ScriptEvaluationData
forall x. Rep ScriptEvaluationData x -> ScriptEvaluationData
forall x. ScriptEvaluationData -> Rep ScriptEvaluationData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptEvaluationData -> Rep ScriptEvaluationData x
from :: forall x. ScriptEvaluationData -> Rep ScriptEvaluationData x
$cto :: forall x. Rep ScriptEvaluationData x -> ScriptEvaluationData
to :: forall x. Rep ScriptEvaluationData x -> ScriptEvaluationData
Generic)
  deriving anyclass ([ScriptEvaluationData] -> Encoding
ScriptEvaluationData -> Encoding
(ScriptEvaluationData -> Encoding)
-> (forall s. Decoder s ScriptEvaluationData)
-> ([ScriptEvaluationData] -> Encoding)
-> (forall s. Decoder s [ScriptEvaluationData])
-> Serialise ScriptEvaluationData
forall s. Decoder s [ScriptEvaluationData]
forall s. Decoder s ScriptEvaluationData
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ScriptEvaluationData -> Encoding
encode :: ScriptEvaluationData -> Encoding
$cdecode :: forall s. Decoder s ScriptEvaluationData
decode :: forall s. Decoder s ScriptEvaluationData
$cencodeList :: [ScriptEvaluationData] -> Encoding
encodeList :: [ScriptEvaluationData] -> Encoding
$cdecodeList :: forall s. Decoder s [ScriptEvaluationData]
decodeList :: forall s. Decoder s [ScriptEvaluationData]
Serialise)

instance Pretty ScriptEvaluationData where
  pretty :: forall ann. ScriptEvaluationData -> Doc ann
pretty ScriptEvaluationData{[Data]
SerialisedScript
ExBudget
MajorProtocolVersion
dataProtocolVersion :: ScriptEvaluationData -> MajorProtocolVersion
dataBudget :: ScriptEvaluationData -> ExBudget
dataScript :: ScriptEvaluationData -> SerialisedScript
dataInputs :: ScriptEvaluationData -> [Data]
dataProtocolVersion :: MajorProtocolVersion
dataBudget :: ExBudget
dataScript :: SerialisedScript
dataInputs :: [Data]
..} =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ Doc ann
"major protocol version:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MajorProtocolVersion -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MajorProtocolVersion -> Doc ann
pretty MajorProtocolVersion
dataProtocolVersion
      , Doc ann
"budget: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExBudget -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExBudget -> Doc ann
pretty ExBudget
dataBudget
      , Doc ann
"script: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ SerialisedScript -> ByteString
BS.fromShort SerialisedScript
dataScript)
      , Doc ann
"data: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Data -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Data -> Doc ann
pretty (Data -> Doc ann) -> [Data] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Data]
dataInputs)
      ]

{- | Information about an on-chain script evaluation event, specifically the information needed
 to evaluate the script, and the expected result.
-}
data ScriptEvaluationEvent
  = PlutusEvent PlutusLedgerLanguage ScriptEvaluationData ScriptEvaluationResult
  deriving stock (Int -> ScriptEvaluationEvent -> ShowS
[ScriptEvaluationEvent] -> ShowS
ScriptEvaluationEvent -> String
(Int -> ScriptEvaluationEvent -> ShowS)
-> (ScriptEvaluationEvent -> String)
-> ([ScriptEvaluationEvent] -> ShowS)
-> Show ScriptEvaluationEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptEvaluationEvent -> ShowS
showsPrec :: Int -> ScriptEvaluationEvent -> ShowS
$cshow :: ScriptEvaluationEvent -> String
show :: ScriptEvaluationEvent -> String
$cshowList :: [ScriptEvaluationEvent] -> ShowS
showList :: [ScriptEvaluationEvent] -> ShowS
Show, (forall x. ScriptEvaluationEvent -> Rep ScriptEvaluationEvent x)
-> (forall x. Rep ScriptEvaluationEvent x -> ScriptEvaluationEvent)
-> Generic ScriptEvaluationEvent
forall x. Rep ScriptEvaluationEvent x -> ScriptEvaluationEvent
forall x. ScriptEvaluationEvent -> Rep ScriptEvaluationEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptEvaluationEvent -> Rep ScriptEvaluationEvent x
from :: forall x. ScriptEvaluationEvent -> Rep ScriptEvaluationEvent x
$cto :: forall x. Rep ScriptEvaluationEvent x -> ScriptEvaluationEvent
to :: forall x. Rep ScriptEvaluationEvent x -> ScriptEvaluationEvent
Generic)
  deriving anyclass ([ScriptEvaluationEvent] -> Encoding
ScriptEvaluationEvent -> Encoding
(ScriptEvaluationEvent -> Encoding)
-> (forall s. Decoder s ScriptEvaluationEvent)
-> ([ScriptEvaluationEvent] -> Encoding)
-> (forall s. Decoder s [ScriptEvaluationEvent])
-> Serialise ScriptEvaluationEvent
forall s. Decoder s [ScriptEvaluationEvent]
forall s. Decoder s ScriptEvaluationEvent
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ScriptEvaluationEvent -> Encoding
encode :: ScriptEvaluationEvent -> Encoding
$cdecode :: forall s. Decoder s ScriptEvaluationEvent
decode :: forall s. Decoder s ScriptEvaluationEvent
$cencodeList :: [ScriptEvaluationEvent] -> Encoding
encodeList :: [ScriptEvaluationEvent] -> Encoding
$cdecodeList :: forall s. Decoder s [ScriptEvaluationEvent]
decodeList :: forall s. Decoder s [ScriptEvaluationEvent]
Serialise)

instance Pretty ScriptEvaluationEvent where
  pretty :: forall ann. ScriptEvaluationEvent -> Doc ann
pretty (PlutusEvent PlutusLedgerLanguage
plutusLedgerVersion ScriptEvaluationData
d ScriptEvaluationResult
res) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
        [ Doc ann
"PlutusEvent"
        , PlutusLedgerLanguage -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PlutusLedgerLanguage -> Doc ann
pretty PlutusLedgerLanguage
plutusLedgerVersion
        , ScriptEvaluationData -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ScriptEvaluationData -> Doc ann
pretty ScriptEvaluationData
d
        , ScriptEvaluationResult -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ScriptEvaluationResult -> Doc ann
pretty ScriptEvaluationResult
res
        ]

{- | This type contains a list of on-chain script evaluation events. All PlutusV1
 evaluations (if any) share the same cost parameters. Same with PlutusV2.

 Sharing the cost parameters lets us avoid creating a new `EvaluationContext` for
 each `ScriptEvaluationEvent`.
-}
data ScriptEvaluationEvents = ScriptEvaluationEvents
  { ScriptEvaluationEvents -> Maybe [Int64]
eventsCostParamsV1 :: Maybe [Int64]
  -- ^ Cost parameters shared by all PlutusV1 evaluation events in `eventsEvents`, if any.
  , ScriptEvaluationEvents -> Maybe [Int64]
eventsCostParamsV2 :: Maybe [Int64]
  -- ^ Cost parameters shared by all PlutusV2 evaluation events in `eventsEvents`, if any.
  , ScriptEvaluationEvents -> NonEmpty ScriptEvaluationEvent
eventsEvents       :: NonEmpty ScriptEvaluationEvent
  }
  deriving stock ((forall x. ScriptEvaluationEvents -> Rep ScriptEvaluationEvents x)
-> (forall x.
    Rep ScriptEvaluationEvents x -> ScriptEvaluationEvents)
-> Generic ScriptEvaluationEvents
forall x. Rep ScriptEvaluationEvents x -> ScriptEvaluationEvents
forall x. ScriptEvaluationEvents -> Rep ScriptEvaluationEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptEvaluationEvents -> Rep ScriptEvaluationEvents x
from :: forall x. ScriptEvaluationEvents -> Rep ScriptEvaluationEvents x
$cto :: forall x. Rep ScriptEvaluationEvents x -> ScriptEvaluationEvents
to :: forall x. Rep ScriptEvaluationEvents x -> ScriptEvaluationEvents
Generic)
  deriving anyclass ([ScriptEvaluationEvents] -> Encoding
ScriptEvaluationEvents -> Encoding
(ScriptEvaluationEvents -> Encoding)
-> (forall s. Decoder s ScriptEvaluationEvents)
-> ([ScriptEvaluationEvents] -> Encoding)
-> (forall s. Decoder s [ScriptEvaluationEvents])
-> Serialise ScriptEvaluationEvents
forall s. Decoder s [ScriptEvaluationEvents]
forall s. Decoder s ScriptEvaluationEvents
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ScriptEvaluationEvents -> Encoding
encode :: ScriptEvaluationEvents -> Encoding
$cdecode :: forall s. Decoder s ScriptEvaluationEvents
decode :: forall s. Decoder s ScriptEvaluationEvents
$cencodeList :: [ScriptEvaluationEvents] -> Encoding
encodeList :: [ScriptEvaluationEvents] -> Encoding
$cdecodeList :: forall s. Decoder s [ScriptEvaluationEvents]
decodeList :: forall s. Decoder s [ScriptEvaluationEvents]
Serialise)

-- | Error type when re-evaluating a `ScriptEvaluationEvent`.
data UnexpectedEvaluationResult
  = UnexpectedEvaluationSuccess
      ScriptEvaluationEvent
      [Int64]
      -- ^ Cost parameters
      ExBudget
      -- ^ Actual budget consumed
  | UnexpectedEvaluationFailure
      ScriptEvaluationEvent
      [Int64]
      -- ^ Cost parameters
      EvaluationError
  | DecodeError ScriptDecodeError
  deriving stock (Int -> UnexpectedEvaluationResult -> ShowS
[UnexpectedEvaluationResult] -> ShowS
UnexpectedEvaluationResult -> String
(Int -> UnexpectedEvaluationResult -> ShowS)
-> (UnexpectedEvaluationResult -> String)
-> ([UnexpectedEvaluationResult] -> ShowS)
-> Show UnexpectedEvaluationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnexpectedEvaluationResult -> ShowS
showsPrec :: Int -> UnexpectedEvaluationResult -> ShowS
$cshow :: UnexpectedEvaluationResult -> String
show :: UnexpectedEvaluationResult -> String
$cshowList :: [UnexpectedEvaluationResult] -> ShowS
showList :: [UnexpectedEvaluationResult] -> ShowS
Show)

instance Pretty UnexpectedEvaluationResult where
  pretty :: forall ann. UnexpectedEvaluationResult -> Doc ann
pretty = \case
    UnexpectedEvaluationSuccess ScriptEvaluationEvent
ev [Int64]
params ExBudget
budget ->
      Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
          [ Doc ann
"UnexpectedEvaluationSuccess"
          , ScriptEvaluationEvent -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ScriptEvaluationEvent -> Doc ann
pretty ScriptEvaluationEvent
ev
          , Doc ann
"Cost parameters:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Int64] -> Doc ann
forall ann. [Int64] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Int64]
params
          , Doc ann
"Budget spent:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExBudget -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExBudget -> Doc ann
pretty ExBudget
budget
          ]
    UnexpectedEvaluationFailure ScriptEvaluationEvent
ev [Int64]
params EvaluationError
err ->
      Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
          [ Doc ann
"UnexpectedEvaluationFailure"
          , ScriptEvaluationEvent -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ScriptEvaluationEvent -> Doc ann
pretty ScriptEvaluationEvent
ev
          , Doc ann
"Cost parameters:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Int64] -> Doc ann
forall ann. [Int64] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Int64]
params
          , Doc ann
"Evaluation error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> EvaluationError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. EvaluationError -> Doc ann
pretty EvaluationError
err
          ]
    DecodeError ScriptDecodeError
err ->
      Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
          [ Doc ann
"ScriptDecodeError"
          , ScriptDecodeError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ScriptDecodeError -> Doc ann
pretty ScriptDecodeError
err
          , Doc ann
"This should never happen at phase 2!"
          ]

data TestFailure
  = InvalidResult UnexpectedEvaluationResult
  | MissingCostParametersFor PlutusLedgerLanguage

renderTestFailure :: TestFailure -> String
renderTestFailure :: TestFailure -> String
renderTestFailure = \case
  InvalidResult UnexpectedEvaluationResult
err -> UnexpectedEvaluationResult -> String
forall str a. (Pretty a, Render str) => a -> str
display UnexpectedEvaluationResult
err
  MissingCostParametersFor PlutusLedgerLanguage
lang ->
    String
"Missing cost parameters for "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlutusLedgerLanguage -> String
forall a. Show a => a -> String
show PlutusLedgerLanguage
lang
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Report this as a bug against the script dumper in plutus-apps."

renderTestFailures :: NonEmpty TestFailure -> String
renderTestFailures :: NonEmpty TestFailure -> String
renderTestFailures NonEmpty TestFailure
testFailures =
  String
"Number of failed test cases: "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (NonEmpty TestFailure -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty TestFailure
testFailures)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".\n"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((TestFailure -> String) -> [TestFailure] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestFailure -> String
renderTestFailure (NonEmpty TestFailure -> [TestFailure]
forall a. NonEmpty a -> [a]
toList NonEmpty TestFailure
testFailures))

-- | Re-evaluate an on-chain script evaluation event.
checkEvaluationEvent
  :: EvaluationContext
  -> [Int64]
  -- ^ Cost parameters
  -> ScriptEvaluationEvent
  -> Maybe UnexpectedEvaluationResult
checkEvaluationEvent :: EvaluationContext
-> [Int64]
-> ScriptEvaluationEvent
-> Maybe UnexpectedEvaluationResult
checkEvaluationEvent EvaluationContext
ctx [Int64]
params ScriptEvaluationEvent
ev = case ScriptEvaluationEvent
ev of
  PlutusEvent PlutusLedgerLanguage
PlutusV1 ScriptEvaluationData{[Data]
SerialisedScript
ExBudget
MajorProtocolVersion
dataProtocolVersion :: ScriptEvaluationData -> MajorProtocolVersion
dataBudget :: ScriptEvaluationData -> ExBudget
dataScript :: ScriptEvaluationData -> SerialisedScript
dataInputs :: ScriptEvaluationData -> [Data]
dataProtocolVersion :: MajorProtocolVersion
dataBudget :: ExBudget
dataScript :: SerialisedScript
dataInputs :: [Data]
..} ScriptEvaluationResult
expected ->
    case PlutusLedgerLanguage
-> MajorProtocolVersion
-> SerialisedScript
-> Either ScriptDecodeError ScriptForEvaluation
forall (m :: * -> *).
MonadError ScriptDecodeError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion
-> SerialisedScript
-> m ScriptForEvaluation
deserialiseScript PlutusLedgerLanguage
PlutusV1 MajorProtocolVersion
dataProtocolVersion SerialisedScript
dataScript of
      Right ScriptForEvaluation
script ->
        let (LogOutput
_, Either EvaluationError ExBudget
actual) =
              MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ScriptForEvaluation
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
V1.evaluateScriptRestricting
                MajorProtocolVersion
dataProtocolVersion
                VerboseMode
V1.Quiet
                EvaluationContext
ctx
                ExBudget
dataBudget
                ScriptForEvaluation
script
                [Data]
dataInputs
         in ScriptEvaluationResult
-> Either EvaluationError ExBudget
-> Maybe UnexpectedEvaluationResult
verify ScriptEvaluationResult
expected Either EvaluationError ExBudget
actual
      Left ScriptDecodeError
err -> UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult
forall a. a -> Maybe a
Just (ScriptDecodeError -> UnexpectedEvaluationResult
DecodeError ScriptDecodeError
err)
  PlutusEvent PlutusLedgerLanguage
PlutusV2 ScriptEvaluationData{[Data]
SerialisedScript
ExBudget
MajorProtocolVersion
dataProtocolVersion :: ScriptEvaluationData -> MajorProtocolVersion
dataBudget :: ScriptEvaluationData -> ExBudget
dataScript :: ScriptEvaluationData -> SerialisedScript
dataInputs :: ScriptEvaluationData -> [Data]
dataProtocolVersion :: MajorProtocolVersion
dataBudget :: ExBudget
dataScript :: SerialisedScript
dataInputs :: [Data]
..} ScriptEvaluationResult
expected ->
    case PlutusLedgerLanguage
-> MajorProtocolVersion
-> SerialisedScript
-> Either ScriptDecodeError ScriptForEvaluation
forall (m :: * -> *).
MonadError ScriptDecodeError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion
-> SerialisedScript
-> m ScriptForEvaluation
deserialiseScript PlutusLedgerLanguage
PlutusV2 MajorProtocolVersion
dataProtocolVersion SerialisedScript
dataScript of
      Right ScriptForEvaluation
script ->
        let (LogOutput
_, Either EvaluationError ExBudget
actual) =
              MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ScriptForEvaluation
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
V2.evaluateScriptRestricting
                MajorProtocolVersion
dataProtocolVersion
                VerboseMode
V2.Quiet
                EvaluationContext
ctx
                ExBudget
dataBudget
                ScriptForEvaluation
script
                [Data]
dataInputs
         in ScriptEvaluationResult
-> Either EvaluationError ExBudget
-> Maybe UnexpectedEvaluationResult
verify ScriptEvaluationResult
expected Either EvaluationError ExBudget
actual
      Left ScriptDecodeError
err -> UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult
forall a. a -> Maybe a
Just (ScriptDecodeError -> UnexpectedEvaluationResult
DecodeError ScriptDecodeError
err)
  PlutusEvent PlutusLedgerLanguage
PlutusV3 ScriptEvaluationData{[Data]
SerialisedScript
ExBudget
MajorProtocolVersion
dataProtocolVersion :: ScriptEvaluationData -> MajorProtocolVersion
dataBudget :: ScriptEvaluationData -> ExBudget
dataScript :: ScriptEvaluationData -> SerialisedScript
dataInputs :: ScriptEvaluationData -> [Data]
dataProtocolVersion :: MajorProtocolVersion
dataBudget :: ExBudget
dataScript :: SerialisedScript
dataInputs :: [Data]
..} ScriptEvaluationResult
expected ->
    case PlutusLedgerLanguage
-> MajorProtocolVersion
-> SerialisedScript
-> Either ScriptDecodeError ScriptForEvaluation
forall (m :: * -> *).
MonadError ScriptDecodeError m =>
PlutusLedgerLanguage
-> MajorProtocolVersion
-> SerialisedScript
-> m ScriptForEvaluation
deserialiseScript PlutusLedgerLanguage
PlutusV3 MajorProtocolVersion
dataProtocolVersion SerialisedScript
dataScript of
      Right ScriptForEvaluation
script -> do
        Data
dataInput <-
          case [Data]
dataInputs of
            [Data
input] -> Data -> Maybe Data
forall a. a -> Maybe a
Just Data
input
            [Data]
_       -> Maybe Data
forall a. Maybe a
Nothing
        let (LogOutput
_, Either EvaluationError ExBudget
actual) =
              MajorProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ScriptForEvaluation
-> Data
-> (LogOutput, Either EvaluationError ExBudget)
V3.evaluateScriptRestricting
                MajorProtocolVersion
dataProtocolVersion
                VerboseMode
V3.Quiet
                EvaluationContext
ctx
                ExBudget
dataBudget
                ScriptForEvaluation
script
                Data
dataInput
        ScriptEvaluationResult
-> Either EvaluationError ExBudget
-> Maybe UnexpectedEvaluationResult
verify ScriptEvaluationResult
expected Either EvaluationError ExBudget
actual
      Left ScriptDecodeError
err -> UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult
forall a. a -> Maybe a
Just (ScriptDecodeError -> UnexpectedEvaluationResult
DecodeError ScriptDecodeError
err)
  where
    verify :: ScriptEvaluationResult
-> Either EvaluationError ExBudget
-> Maybe UnexpectedEvaluationResult
verify ScriptEvaluationResult
ScriptEvaluationSuccess (Left EvaluationError
err) =
      UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult
forall a. a -> Maybe a
Just (UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult)
-> UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult
forall a b. (a -> b) -> a -> b
$ ScriptEvaluationEvent
-> [Int64] -> EvaluationError -> UnexpectedEvaluationResult
UnexpectedEvaluationFailure ScriptEvaluationEvent
ev [Int64]
params EvaluationError
err
    verify ScriptEvaluationResult
ScriptEvaluationFailure (Right ExBudget
budget) =
      UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult
forall a. a -> Maybe a
Just (UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult)
-> UnexpectedEvaluationResult -> Maybe UnexpectedEvaluationResult
forall a b. (a -> b) -> a -> b
$ ScriptEvaluationEvent
-> [Int64] -> ExBudget -> UnexpectedEvaluationResult
UnexpectedEvaluationSuccess ScriptEvaluationEvent
ev [Int64]
params ExBudget
budget
    verify ScriptEvaluationResult
_ Either EvaluationError ExBudget
_ =
      Maybe UnexpectedEvaluationResult
forall a. Maybe a
Nothing