{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Alonzo.Plutus.Evaluate (
  evalPlutusScripts,
  CollectError (..),
  collectPlutusScriptsWithContext,
  scriptsWithContextFromLedgerTxInfo,
  scriptsWithContextFromLedgerTxInfoWithResult,

  -- * Execution units estimation

  -- | Functions in this section are provided for testing and downstream users like cardano-api
  evalPlutusScriptsWithLogs,
  TransactionScriptFailure (..),
  evalTxExUnits,
  RedeemerReport,
  evalTxExUnitsWithLogs,
  RedeemerReportWithLogs,
) where

import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Plutus.Context (
  CollectError (..),
  ContextError,
  EraPlutusContext (..),
  LedgerTxInfo (..),
 )
import Cardano.Ledger.Alonzo.Scripts (lookupPlutusScript, plutusScriptLanguage, toAsItem, toAsIx)
import Cardano.Ledger.Alonzo.TxWits (unRedeemersL)
import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO,
  AlonzoScriptsNeeded (..),
  resolveNeededPlutusScriptsWithPurpose,
 )
import Cardano.Ledger.Plutus.CostModels (CostModels, costModelsValid)
import Cardano.Ledger.Plutus.Evaluate (
  PlutusWithContext (..),
  ScriptResult (..),
  evaluatePlutusWithContext,
  runPlutusScriptWithLogs,
 )
import Cardano.Ledger.Plutus.ExUnits
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.Plutus.TxInfo (exBudgetToExUnits)
import Cardano.Ledger.State (EraUTxO (..), ScriptsProvided (..), UTxO (..))
import Cardano.Ledger.TxIn (TxIn)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Data.Bifunctor (first)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras (fromElems)
import Data.Text (Text)
import qualified Debug.Trace as Debug
import GHC.Generics
import Lens.Micro
import qualified PlutusLedgerApi.Common as P

-- ===============================================================
-- From the specification, Figure 7 "Scripts and their Arguments"
-- ===============================================================

collectPlutusScriptsWithContext ::
  forall era l.
  ( AlonzoEraTxBody era
  , AlonzoEraTxWits era
  , AlonzoEraUTxO era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , EraPlutusContext era
  ) =>
  EpochInfo (Either Text) ->
  SystemStart ->
  PParams era ->
  Tx l era ->
  UTxO era ->
  Either (NonEmpty (CollectError era)) [PlutusWithContext]
collectPlutusScriptsWithContext :: forall era (l :: TxLevel).
(AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraPlutusContext era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx l era
-> UTxO era
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
collectPlutusScriptsWithContext EpochInfo (Either Text)
epochInfo SystemStart
systemStart PParams era
pp Tx l era
tx UTxO era
utxo =
  LedgerTxInfo era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall era.
(AlonzoEraTxWits era, AlonzoEraUTxO era, EraPlutusContext era) =>
LedgerTxInfo era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
scriptsWithContextFromLedgerTxInfo LedgerTxInfo era
ledgerTxInfo (PParams era
pp PParams era
-> Getting CostModels (PParams era) CostModels -> CostModels
forall s a. s -> Getting a s a -> a
^. Getting CostModels (PParams era) CostModels
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL) [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
neededPlutusScripts
  where
    -- We need to pass major protocol version to the script for script evaluation
    protVer :: ProtVer
protVer = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
    ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
      LedgerTxInfo
        { ltiProtVer :: ProtVer
ltiProtVer = ProtVer
protVer
        , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
epochInfo
        , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
systemStart
        , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
utxo
        , ltiTx :: Tx l era
ltiTx = Tx l era
tx
        , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
        }
    neededPlutusScripts :: [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
neededPlutusScripts =
      ScriptsProvided era
-> AlonzoScriptsNeeded era
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
forall era.
AlonzoEraScript era =>
ScriptsProvided era
-> AlonzoScriptsNeeded era
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
resolveNeededPlutusScriptsWithPurpose
        (UTxO era -> Tx l era -> ScriptsProvided era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> Tx t era -> ScriptsProvided era
forall (t :: TxLevel). UTxO era -> Tx t era -> ScriptsProvided era
getScriptsProvided UTxO era
utxo Tx l era
tx)
        (UTxO era -> TxBody l era -> ScriptsNeeded era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> TxBody t era -> ScriptsNeeded era
forall (t :: TxLevel).
UTxO era -> TxBody t era -> ScriptsNeeded era
getScriptsNeeded UTxO era
utxo (Tx l era
tx Tx l era
-> Getting (TxBody l era) (Tx l era) (TxBody l era) -> TxBody l era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody l era) (Tx l era) (TxBody l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL))

scriptsWithContextFromLedgerTxInfo ::
  forall era.
  ( AlonzoEraTxWits era
  , AlonzoEraUTxO era
  , EraPlutusContext era
  ) =>
  LedgerTxInfo era ->
  CostModels ->
  [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)] ->
  Either (NonEmpty (CollectError era)) [PlutusWithContext]
scriptsWithContextFromLedgerTxInfo :: forall era.
(AlonzoEraTxWits era, AlonzoEraUTxO era, EraPlutusContext era) =>
LedgerTxInfo era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
scriptsWithContextFromLedgerTxInfo LedgerTxInfo era
lti =
  LedgerTxInfo era
-> TxInfoResult era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall era.
(AlonzoEraTxWits era, AlonzoEraUTxO era, EraPlutusContext era) =>
LedgerTxInfo era
-> TxInfoResult era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
scriptsWithContextFromLedgerTxInfoWithResult LedgerTxInfo era
lti (LedgerTxInfo era -> TxInfoResult era
forall era.
EraPlutusContext era =>
LedgerTxInfo era -> TxInfoResult era
mkTxInfoResult LedgerTxInfo era
lti)

scriptsWithContextFromLedgerTxInfoWithResult ::
  forall era.
  ( AlonzoEraTxWits era
  , AlonzoEraUTxO era
  , EraPlutusContext era
  ) =>
  LedgerTxInfo era ->
  TxInfoResult era ->
  CostModels ->
  [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)] ->
  Either (NonEmpty (CollectError era)) [PlutusWithContext]
scriptsWithContextFromLedgerTxInfoWithResult :: forall era.
(AlonzoEraTxWits era, AlonzoEraUTxO era, EraPlutusContext era) =>
LedgerTxInfo era
-> TxInfoResult era
-> CostModels
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
scriptsWithContextFromLedgerTxInfoWithResult LedgerTxInfo era
lti TxInfoResult era
txInfoResult CostModels
costModels [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
plutusScriptsUsed =
  ((PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
  ScriptHash)
 -> Either (CollectError era) PlutusWithContext)
-> [Either
      (CollectError era)
      (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
       ScriptHash)]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall t b a.
(t -> Either a b)
-> [Either a t]
-> Either (NonEmpty a) [b]
-> Either (NonEmpty a) [b]
merge
    (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
 ScriptHash)
-> Either (CollectError era) PlutusWithContext
apply
    (((ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)
 -> Either
      (CollectError era)
      (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
       ScriptHash))
-> [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
-> [Either
      (CollectError era)
      (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
       ScriptHash)]
forall a b. (a -> b) -> [a] -> [b]
map (ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)
-> Either
     (CollectError era)
     (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
      ScriptHash)
getScriptWithRedeemer [(ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)]
plutusScriptsUsed)
    ([PlutusWithContext]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall a b. b -> Either a b
Right [])
  where
    redeemers :: Map (PlutusPurpose AsIx era) (Data era, ExUnits)
redeemers =
      case LedgerTxInfo era
lti of
        LedgerTxInfo {Tx level era
ltiTx :: ()
ltiTx :: Tx level era
ltiTx} -> Tx level era
ltiTx Tx level era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx level era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall s a. s -> Getting a s a -> a
^. (TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> Tx level era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx level era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
 -> Tx level era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx level era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> TxWits era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx level era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
 -> TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> Redeemers era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> Redeemers era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era)
forall era.
AlonzoEraScript era =>
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
unRedeemersL
    getScriptWithRedeemer :: (ScriptHash, PlutusPurpose AsIxItem era, PlutusScript era)
-> Either
     (CollectError era)
     (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
      ScriptHash)
getScriptWithRedeemer (ScriptHash
plutusScriptHash, PlutusPurpose AsIxItem era
plutusPurpose, PlutusScript era
plutusScript) =
      let redeemerIndex :: PlutusPurpose AsIx era
redeemerIndex = (forall ix it. AsIxItem ix it -> AsIx ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsIx era
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsIx ix it
forall ix it. AsIxItem ix it -> AsIx ix it
toAsIx PlutusPurpose AsIxItem era
plutusPurpose
       in case PlutusPurpose AsIx era
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Maybe (Data era, ExUnits)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PlutusPurpose AsIx era
redeemerIndex Map (PlutusPurpose AsIx era) (Data era, ExUnits)
redeemers of
            Just (Data era
d, ExUnits
exUnits) -> (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
 ScriptHash)
-> Either
     (CollectError era)
     (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
      ScriptHash)
forall a b. b -> Either a b
Right (PlutusScript era
plutusScript, PlutusPurpose AsIxItem era
plutusPurpose, Data era
d, ExUnits
exUnits, ScriptHash
plutusScriptHash)
            Maybe (Data era, ExUnits)
Nothing -> CollectError era
-> Either
     (CollectError era)
     (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
      ScriptHash)
forall a b. a -> Either a b
Left (PlutusPurpose AsItem era -> CollectError era
forall era. PlutusPurpose AsItem era -> CollectError era
NoRedeemer ((forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsItem era
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem PlutusPurpose AsIxItem era
plutusPurpose))
    apply :: (PlutusScript era, PlutusPurpose AsIxItem era, Data era, ExUnits,
 ScriptHash)
-> Either (CollectError era) PlutusWithContext
apply (PlutusScript era
plutusScript, PlutusPurpose AsIxItem era
plutusPurpose, Data era
redeemerData, ExUnits
exUnits, ScriptHash
plutusScriptHash) = do
      let lang :: Language
lang = PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript
      costModel <- Either (CollectError era) CostModel
-> (CostModel -> Either (CollectError era) CostModel)
-> Maybe CostModel
-> Either (CollectError era) CostModel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CollectError era -> Either (CollectError era) CostModel
forall a b. a -> Either a b
Left (Language -> CollectError era
forall era. Language -> CollectError era
NoCostModel Language
lang)) CostModel -> Either (CollectError era) CostModel
forall a b. b -> Either a b
Right (Maybe CostModel -> Either (CollectError era) CostModel)
-> Maybe CostModel -> Either (CollectError era) CostModel
forall a b. (a -> b) -> a -> b
$ Language -> Map Language CostModel -> Maybe CostModel
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
lang (Map Language CostModel -> Maybe CostModel)
-> Map Language CostModel -> Maybe CostModel
forall a b. (a -> b) -> a -> b
$ CostModels -> Map Language CostModel
costModelsValid CostModels
costModels
      first BadTranslation $
        mkPlutusWithContext
          plutusScript
          plutusScriptHash
          plutusPurpose
          lti
          txInfoResult
          (redeemerData, exUnits)
          costModel

    -- Merge two lists (the first of which may have failures, i.e. (Left _)), collect all the failures
    -- but if there are none, use 'f' to construct a success.
    merge ::
      forall t b a.
      (t -> Either a b) -> [Either a t] -> Either (NonEmpty a) [b] -> Either (NonEmpty a) [b]
    merge :: forall t b a.
(t -> Either a b)
-> [Either a t]
-> Either (NonEmpty a) [b]
-> Either (NonEmpty a) [b]
merge t -> Either a b
_f [] Either (NonEmpty a) [b]
answer = Either (NonEmpty a) [b]
answer
    merge t -> Either a b
f (Either a t
x : [Either a t]
xs) Either (NonEmpty a) [b]
zs = (t -> Either a b)
-> [Either a t]
-> Either (NonEmpty a) [b]
-> Either (NonEmpty a) [b]
forall t b a.
(t -> Either a b)
-> [Either a t]
-> Either (NonEmpty a) [b]
-> Either (NonEmpty a) [b]
merge t -> Either a b
f [Either a t]
xs (Either a t -> Either (NonEmpty a) [b] -> Either (NonEmpty a) [b]
gg Either a t
x Either (NonEmpty a) [b]
zs)
      where
        gg :: Either a t -> Either (NonEmpty a) [b] -> Either (NonEmpty a) [b]
        gg :: Either a t -> Either (NonEmpty a) [b] -> Either (NonEmpty a) [b]
gg (Right t
t) (Right [b]
cs) =
          case t -> Either a b
f t
t of
            Right b
c -> [b] -> Either (NonEmpty a) [b]
forall a b. b -> Either a b
Right ([b] -> Either (NonEmpty a) [b]) -> [b] -> Either (NonEmpty a) [b]
forall a b. (a -> b) -> a -> b
$ b
c b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
cs
            Left a
e -> NonEmpty a -> Either (NonEmpty a) [b]
forall a b. a -> Either a b
Left [a
Item (NonEmpty a)
e]
        gg (Left a
a) (Right [b]
_) = NonEmpty a -> Either (NonEmpty a) [b]
forall a b. a -> Either a b
Left [a
Item (NonEmpty a)
a]
        gg (Right t
_) (Left NonEmpty a
cs) = NonEmpty a -> Either (NonEmpty a) [b]
forall a b. a -> Either a b
Left NonEmpty a
cs
        gg (Left a
a) (Left NonEmpty a
cs) = NonEmpty a -> Either (NonEmpty a) [b]
forall a b. a -> Either a b
Left (NonEmpty a -> Either (NonEmpty a) [b])
-> NonEmpty a -> Either (NonEmpty a) [b]
forall a b. (a -> b) -> a -> b
$ a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons a
a NonEmpty a
cs

-- | Evaluate a list of Plutus scripts. All scripts in the list must evaluate to `True`.
evalPlutusScripts :: [PlutusWithContext] -> ScriptResult
evalPlutusScripts :: [PlutusWithContext] -> ScriptResult
evalPlutusScripts [PlutusWithContext]
pwcs = ([Text], ScriptResult) -> ScriptResult
forall a b. (a, b) -> b
snd (([Text], ScriptResult) -> ScriptResult)
-> ([Text], ScriptResult) -> ScriptResult
forall a b. (a -> b) -> a -> b
$ [PlutusWithContext] -> ([Text], ScriptResult)
evalPlutusScriptsWithLogs [PlutusWithContext]
pwcs

evalPlutusScriptsWithLogs :: [PlutusWithContext] -> ([Text], ScriptResult)
evalPlutusScriptsWithLogs :: [PlutusWithContext] -> ([Text], ScriptResult)
evalPlutusScriptsWithLogs [] = ([Text], ScriptResult)
forall a. Monoid a => a
mempty
evalPlutusScriptsWithLogs (PlutusWithContext
plutusWithContext : [PlutusWithContext]
rest) =
  let beginMsg :: [Char]
beginMsg =
        [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
          [Char]
","
          [ [Char]
Item [[Char]]
"[LEDGER][PLUTUS_SCRIPT]"
          , [Char]
Item [[Char]]
"BEGIN"
          ]
      !res :: ([Text], ScriptResult)
res = [Char] -> ([Text], ScriptResult) -> ([Text], ScriptResult)
forall a. [Char] -> a -> a
Debug.traceEvent [Char]
beginMsg (([Text], ScriptResult) -> ([Text], ScriptResult))
-> ([Text], ScriptResult) -> ([Text], ScriptResult)
forall a b. (a -> b) -> a -> b
$ PlutusWithContext -> ([Text], ScriptResult)
runPlutusScriptWithLogs PlutusWithContext
plutusWithContext
      endMsg :: [Char]
endMsg =
        [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate
          [Char]
","
          [ [Char]
Item [[Char]]
"[LEDGER][PLUTUS_SCRIPT]"
          , [Char]
Item [[Char]]
"END"
          ]
   in [Char] -> ([Text], ScriptResult) -> ([Text], ScriptResult)
forall a. [Char] -> a -> a
Debug.traceEvent [Char]
endMsg ([Text], ScriptResult)
res ([Text], ScriptResult)
-> ([Text], ScriptResult) -> ([Text], ScriptResult)
forall a. Semigroup a => a -> a -> a
<> [PlutusWithContext] -> ([Text], ScriptResult)
evalPlutusScriptsWithLogs [PlutusWithContext]
rest

-- | Script failures that can be returned by 'evalTxExUnitsWithLogs'.
data TransactionScriptFailure era
  = -- | A redeemer was supplied which points to a script hash which
    -- we cannot connect to a Plutus script.
    RedeemerPointsToUnknownScriptHash !(PlutusPurpose AsIx era)
  | -- | Missing redeemer.
    MissingScript
      -- | Redeemer pointer which cannot be resolved
      !(PlutusPurpose AsIx era)
      -- | Map of pointers which can be resolved together with PlutusScripts and their
      -- respective contexts
      !( Map
           (PlutusPurpose AsIx era)
           (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
       )
  | -- | Missing datum.
    MissingDatum !DataHash
  | -- | Plutus evaluation error, for any version
    ValidationFailure
      -- | Supplied execution units in the transaction, which were ignored for calculating
      -- the actual execution units.
      !ExUnits
      !P.EvaluationError
      ![Text]
      !PlutusWithContext
  | -- | A redeemer points to a transaction input which is not
    --  present in the current UTxO.
    UnknownTxIn !TxIn
  | -- | A redeemer points to a transaction input which is not
    --  plutus locked.
    InvalidTxIn !TxIn
  | -- | The execution budget that was calculated by the Plutus
    --  evaluator is out of bounds.
    IncompatibleBudget !P.ExBudget
  | -- | There was no cost model for a given version of Plutus in the ledger state
    NoCostModelInLedgerState !Language
  | -- | Error that can happen during plutus context translation
    ContextError !(ContextError era)
  deriving ((forall x.
 TransactionScriptFailure era
 -> Rep (TransactionScriptFailure era) x)
-> (forall x.
    Rep (TransactionScriptFailure era) x
    -> TransactionScriptFailure era)
-> Generic (TransactionScriptFailure era)
forall x.
Rep (TransactionScriptFailure era) x
-> TransactionScriptFailure era
forall x.
TransactionScriptFailure era
-> Rep (TransactionScriptFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (TransactionScriptFailure era) x
-> TransactionScriptFailure era
forall era x.
TransactionScriptFailure era
-> Rep (TransactionScriptFailure era) x
$cfrom :: forall era x.
TransactionScriptFailure era
-> Rep (TransactionScriptFailure era) x
from :: forall x.
TransactionScriptFailure era
-> Rep (TransactionScriptFailure era) x
$cto :: forall era x.
Rep (TransactionScriptFailure era) x
-> TransactionScriptFailure era
to :: forall x.
Rep (TransactionScriptFailure era) x
-> TransactionScriptFailure era
Generic)

deriving instance
  ( Era era
  , Eq (TxCert era)
  , Eq (PlutusScript era)
  , Eq (ContextError era)
  , Eq (PlutusPurpose AsIx era)
  , Eq (PlutusPurpose AsItem era)
  ) =>
  Eq (TransactionScriptFailure era)

deriving instance
  ( Era era
  , Show (TxCert era)
  , Show (ContextError era)
  , Show (PlutusScript era)
  , Show (PlutusPurpose AsIx era)
  , Show (PlutusPurpose AsItem era)
  ) =>
  Show (TransactionScriptFailure era)

note :: e -> Maybe a -> Either e a
note :: forall e a. e -> Maybe a -> Either e a
note e
_ (Just a
x) = a -> Either e a
forall a b. b -> Either a b
Right a
x
note e
e Maybe a
Nothing = e -> Either e a
forall a b. a -> Either a b
Left e
e

type RedeemerReport era =
  Map (PlutusPurpose AsIx era) (Either (TransactionScriptFailure era) ExUnits)

type RedeemerReportWithLogs era =
  Map (PlutusPurpose AsIx era) (Either (TransactionScriptFailure era) ([Text], ExUnits))

-- | Evaluate the execution budgets needed for all the redeemers in
--  a given transaction. If a redeemer is invalid, a failure is returned instead.
--
--  The execution budgets in the supplied transaction are completely ignored.
--  The results of 'evalTxExUnitsWithLogs' are intended to replace them.
evalTxExUnits ::
  forall era.
  ( AlonzoEraTx era
  , EraUTxO era
  , EraPlutusContext era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  ) =>
  PParams era ->
  -- | The transaction.
  Tx TopTx era ->
  -- | The current UTxO set (or the relevant portion for the transaction).
  UTxO era ->
  -- | The epoch info, used to translate slots to POSIX time for plutus.
  EpochInfo (Either Text) ->
  -- | The start time of the given block chain.
  SystemStart ->
  -- | We return a map from redeemer pointers to either a failure or a
  --  sufficient execution budget.
  RedeemerReport era
evalTxExUnits :: forall era.
(AlonzoEraTx era, EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
PParams era
-> Tx TopTx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReport era
evalTxExUnits PParams era
pp Tx TopTx era
tx UTxO era
utxo EpochInfo (Either Text)
epochInfo SystemStart
systemStart =
  (Either (TransactionScriptFailure era) ([Text], ExUnits)
 -> Either (TransactionScriptFailure era) ExUnits)
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ([Text], ExUnits))
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ExUnits)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((([Text], ExUnits) -> ExUnits)
-> Either (TransactionScriptFailure era) ([Text], ExUnits)
-> Either (TransactionScriptFailure era) ExUnits
forall a b.
(a -> b)
-> Either (TransactionScriptFailure era) a
-> Either (TransactionScriptFailure era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text], ExUnits) -> ExUnits
forall a b. (a, b) -> b
snd) (Map
   (PlutusPurpose AsIx era)
   (Either (TransactionScriptFailure era) ([Text], ExUnits))
 -> Map
      (PlutusPurpose AsIx era)
      (Either (TransactionScriptFailure era) ExUnits))
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ([Text], ExUnits))
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ExUnits)
forall a b. (a -> b) -> a -> b
$ PParams era
-> Tx TopTx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ([Text], ExUnits))
forall era.
(AlonzoEraTx era, EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
PParams era
-> Tx TopTx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReportWithLogs era
evalTxExUnitsWithLogs PParams era
pp Tx TopTx era
tx UTxO era
utxo EpochInfo (Either Text)
epochInfo SystemStart
systemStart

-- | Evaluate the execution budgets needed for all the redeemers in
--  a given transaction.
--
--  The execution budgets in the supplied transaction are completely ignored.
--  The results of 'evalTxExUnitsWithLogs' are intended to replace them.
evalTxExUnitsWithLogs ::
  forall era.
  ( AlonzoEraTx era
  , EraUTxO era
  , EraPlutusContext era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  ) =>
  PParams era ->
  -- | The transaction.
  Tx TopTx era ->
  -- | The current UTxO set (or the relevant portion for the transaction).
  UTxO era ->
  -- | The epoch info, used to translate slots to POSIX time for plutus.
  EpochInfo (Either Text) ->
  -- | The start time of the given block chain.
  SystemStart ->
  -- | We return a map from redeemer pointers to either a failure or a sufficient
  --  execution budget with logs of the script.  Otherwise, we return a 'TranslationError'
  --  manifesting from failed attempts to construct a valid execution context for the
  --  given transaction.
  --
  --  Unlike `evalTxExUnits`, this function also returns evaluation logs, useful for
  --  debugging.
  RedeemerReportWithLogs era
evalTxExUnitsWithLogs :: forall era.
(AlonzoEraTx era, EraUTxO era, EraPlutusContext era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
PParams era
-> Tx TopTx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReportWithLogs era
evalTxExUnitsWithLogs PParams era
pp Tx TopTx era
tx UTxO era
utxo EpochInfo (Either Text)
epochInfo SystemStart
systemStart = (PlutusPurpose AsIx era
 -> (Data era, ExUnits)
 -> Either (TransactionScriptFailure era) ([Text], ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Map
     (PlutusPurpose AsIx era)
     (Either (TransactionScriptFailure era) ([Text], ExUnits))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey PlutusPurpose AsIx era
-> (Data era, ExUnits)
-> Either (TransactionScriptFailure era) ([Text], ExUnits)
findAndCount Map (PlutusPurpose AsIx era) (Data era, ExUnits)
rdmrs
  where
    keyedByPurpose :: (PlutusPurpose AsIxItem era, b) -> PlutusPurpose AsIx era
keyedByPurpose (PlutusPurpose AsIxItem era
plutusPurpose, b
_) = (forall ix it. AsIxItem ix it -> AsIx ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsIx era
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsIx ix it
forall ix it. AsIxItem ix it -> AsIx ix it
toAsIx PlutusPurpose AsIxItem era
plutusPurpose
    purposeToScriptHash :: Map
  (PlutusPurpose AsIx era) (PlutusPurpose AsIxItem era, ScriptHash)
purposeToScriptHash = ((PlutusPurpose AsIxItem era, ScriptHash)
 -> PlutusPurpose AsIx era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> Map
     (PlutusPurpose AsIx era) (PlutusPurpose AsIxItem era, ScriptHash)
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
fromElems (PlutusPurpose AsIxItem era, ScriptHash) -> PlutusPurpose AsIx era
forall {era} {b}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era) =>
(PlutusPurpose AsIxItem era, b) -> PlutusPurpose AsIx era
keyedByPurpose [(PlutusPurpose AsIxItem era, ScriptHash)]
scriptsNeeded
    ledgerTxInfo :: LedgerTxInfo era
ledgerTxInfo =
      LedgerTxInfo
        { ltiProtVer :: ProtVer
ltiProtVer = ProtVer
protVer
        , ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo = EpochInfo (Either Text)
epochInfo
        , ltiSystemStart :: SystemStart
ltiSystemStart = SystemStart
systemStart
        , ltiUTxO :: UTxO era
ltiUTxO = UTxO era
utxo
        , ltiTx :: Tx TopTx era
ltiTx = Tx TopTx era
tx
        , ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions = Map TxId (TxInfoResult era)
forall a. Monoid a => a
mempty
        }
    txInfoResult :: TxInfoResult era
txInfoResult = LedgerTxInfo era -> TxInfoResult era
forall era.
EraPlutusContext era =>
LedgerTxInfo era -> TxInfoResult era
mkTxInfoResult LedgerTxInfo era
ledgerTxInfo
    maxBudget :: ExUnits
maxBudget = PParams era
pp PParams era -> Getting ExUnits (PParams era) ExUnits -> ExUnits
forall s a. s -> Getting a s a -> a
^. Getting ExUnits (PParams era) ExUnits
forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
Lens' (PParams era) ExUnits
ppMaxTxExUnitsL
    txBody :: TxBody TopTx era
txBody = Tx TopTx era
tx Tx TopTx era
-> Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
-> TxBody TopTx era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx era) (Tx TopTx era) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
    wits :: TxWits era
wits = Tx TopTx era
tx Tx TopTx era
-> Getting (TxWits era) (Tx TopTx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx TopTx era) (TxWits era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL
    rdmrs :: Map (PlutusPurpose AsIx era) (Data era, ExUnits)
rdmrs = TxWits era
wits TxWits era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (TxWits era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall s a. s -> Getting a s a -> a
^. (Redeemers era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
 -> TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> Redeemers era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (TxWits era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> Redeemers era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era)
forall era.
AlonzoEraScript era =>
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
unRedeemersL
    protVer :: ProtVer
protVer = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
    costModels :: Map Language CostModel
costModels = CostModels -> Map Language CostModel
costModelsValid (CostModels -> Map Language CostModel)
-> CostModels -> Map Language CostModel
forall a b. (a -> b) -> a -> b
$ PParams era
pp PParams era
-> Getting CostModels (PParams era) CostModels -> CostModels
forall s a. s -> Getting a s a -> a
^. Getting CostModels (PParams era) CostModels
forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
Lens' (PParams era) CostModels
ppCostModelsL
    ScriptsProvided Map ScriptHash (Script era)
scriptsProvided = UTxO era -> Tx TopTx era -> ScriptsProvided era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> Tx t era -> ScriptsProvided era
forall (t :: TxLevel). UTxO era -> Tx t era -> ScriptsProvided era
getScriptsProvided UTxO era
utxo Tx TopTx era
tx
    AlonzoScriptsNeeded [(PlutusPurpose AsIxItem era, ScriptHash)]
scriptsNeeded = UTxO era -> TxBody TopTx era -> ScriptsNeeded era
forall era (t :: TxLevel).
EraUTxO era =>
UTxO era -> TxBody t era -> ScriptsNeeded era
forall (t :: TxLevel).
UTxO era -> TxBody t era -> ScriptsNeeded era
getScriptsNeeded UTxO era
utxo TxBody TopTx era
txBody
    findAndCount :: PlutusPurpose AsIx era
-> (Data era, ExUnits)
-> Either (TransactionScriptFailure era) ([Text], ExUnits)
findAndCount PlutusPurpose AsIx era
pointer (Data era
redeemerData, ExUnits
exUnits) = do
      (plutusPurpose, plutusScriptHash) <-
        TransactionScriptFailure era
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
-> Either
     (TransactionScriptFailure era)
     (PlutusPurpose AsIxItem era, ScriptHash)
forall e a. e -> Maybe a -> Either e a
note (PlutusPurpose AsIx era -> TransactionScriptFailure era
forall era. PlutusPurpose AsIx era -> TransactionScriptFailure era
RedeemerPointsToUnknownScriptHash PlutusPurpose AsIx era
pointer) (Maybe (PlutusPurpose AsIxItem era, ScriptHash)
 -> Either
      (TransactionScriptFailure era)
      (PlutusPurpose AsIxItem era, ScriptHash))
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
-> Either
     (TransactionScriptFailure era)
     (PlutusPurpose AsIxItem era, ScriptHash)
forall a b. (a -> b) -> a -> b
$
          PlutusPurpose AsIx era
-> Map
     (PlutusPurpose AsIx era) (PlutusPurpose AsIxItem era, ScriptHash)
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PlutusPurpose AsIx era
pointer Map
  (PlutusPurpose AsIx era) (PlutusPurpose AsIxItem era, ScriptHash)
purposeToScriptHash
      let ptrToPlutusScriptNoContext =
            ((PlutusPurpose AsIxItem era, ScriptHash)
 -> (PlutusPurpose AsItem era, Maybe (PlutusScript era),
     ScriptHash))
-> Map
     (PlutusPurpose AsIx era) (PlutusPurpose AsIxItem era, ScriptHash)
-> Map
     (PlutusPurpose AsIx era)
     (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
              ( \(PlutusPurpose AsIxItem era
sp, ScriptHash
sh) ->
                  ( (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsItem era
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem PlutusPurpose AsIxItem era
sp
                  , ScriptHash
-> Map ScriptHash (Script era) -> Maybe (PlutusScript era)
forall era.
AlonzoEraScript era =>
ScriptHash
-> Map ScriptHash (Script era) -> Maybe (PlutusScript era)
lookupPlutusScript ScriptHash
sh Map ScriptHash (Script era)
scriptsProvided
                  , ScriptHash
sh
                  )
              )
              Map
  (PlutusPurpose AsIx era) (PlutusPurpose AsIxItem era, ScriptHash)
purposeToScriptHash
      plutusScript <-
        note (MissingScript pointer ptrToPlutusScriptNoContext) $
          lookupPlutusScript plutusScriptHash scriptsProvided
      let lang = PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript
      costModel <-
        note (NoCostModelInLedgerState lang) $ Map.lookup lang costModels
      pwc <-
        first ContextError $
          mkPlutusWithContext
            plutusScript
            plutusScriptHash
            plutusPurpose
            ledgerTxInfo
            txInfoResult
            (redeemerData, maxBudget)
            costModel
      case evaluatePlutusWithContext P.Verbose pwc of
        ([Text]
logs, Left EvaluationError
err) -> TransactionScriptFailure era
-> Either (TransactionScriptFailure era) ([Text], ExUnits)
forall a b. a -> Either a b
Left (TransactionScriptFailure era
 -> Either (TransactionScriptFailure era) ([Text], ExUnits))
-> TransactionScriptFailure era
-> Either (TransactionScriptFailure era) ([Text], ExUnits)
forall a b. (a -> b) -> a -> b
$ ExUnits
-> EvaluationError
-> [Text]
-> PlutusWithContext
-> TransactionScriptFailure era
forall era.
ExUnits
-> EvaluationError
-> [Text]
-> PlutusWithContext
-> TransactionScriptFailure era
ValidationFailure ExUnits
exUnits EvaluationError
err [Text]
logs PlutusWithContext
pwc
        ([Text]
logs, Right ExBudget
exBudget) ->
          TransactionScriptFailure era
-> Maybe ([Text], ExUnits)
-> Either (TransactionScriptFailure era) ([Text], ExUnits)
forall e a. e -> Maybe a -> Either e a
note (ExBudget -> TransactionScriptFailure era
forall era. ExBudget -> TransactionScriptFailure era
IncompatibleBudget ExBudget
exBudget) (Maybe ([Text], ExUnits)
 -> Either (TransactionScriptFailure era) ([Text], ExUnits))
-> Maybe ([Text], ExUnits)
-> Either (TransactionScriptFailure era) ([Text], ExUnits)
forall a b. (a -> b) -> a -> b
$
            (,) [Text]
logs (ExUnits -> ([Text], ExUnits))
-> Maybe ExUnits -> Maybe ([Text], ExUnits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExBudget -> Maybe ExUnits
exBudgetToExUnits ExBudget
exBudget