{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

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

  -- * 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 (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 (..))
import Cardano.Ledger.BaseTypes (kindObject)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Plutus.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 Control.DeepSeq (NFData)
import Data.Aeson (ToJSON (..), (.=), pattern String)
import Data.Bifunctor (first)
import Data.List (intercalate)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras (fromElems)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Debug.Trace as Debug
import GHC.Generics
import Lens.Micro
import NoThunks.Class (NoThunks)
import qualified PlutusLedgerApi.Common as P

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

-- | When collecting inputs for two phase scripts, 3 things can go wrong.
data CollectError era
  = NoRedeemer !(PlutusPurpose AsItem era)
  | NoWitness !ScriptHash
  | NoCostModel !Language
  | BadTranslation !(ContextError era)
  deriving ((forall x. CollectError era -> Rep (CollectError era) x)
-> (forall x. Rep (CollectError era) x -> CollectError era)
-> Generic (CollectError era)
forall x. Rep (CollectError era) x -> CollectError era
forall x. CollectError era -> Rep (CollectError era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (CollectError era) x -> CollectError era
forall era x. CollectError era -> Rep (CollectError era) x
$cfrom :: forall era x. CollectError era -> Rep (CollectError era) x
from :: forall x. CollectError era -> Rep (CollectError era) x
$cto :: forall era x. Rep (CollectError era) x -> CollectError era
to :: forall x. Rep (CollectError era) x -> CollectError era
Generic)

deriving instance
  (AlonzoEraScript era, Eq (ContextError era)) =>
  Eq (CollectError era)

deriving instance
  (AlonzoEraScript era, Show (ContextError era)) =>
  Show (CollectError era)

deriving instance
  (AlonzoEraScript era, NoThunks (ContextError era)) =>
  NoThunks (CollectError era)

deriving instance
  (AlonzoEraScript era, NFData (ContextError era)) =>
  NFData (CollectError era)

instance (AlonzoEraScript era, EncCBOR (ContextError era)) => EncCBOR (CollectError era) where
  encCBOR :: CollectError era -> Encoding
encCBOR (NoRedeemer PlutusPurpose AsItem era
x) = Encode Open (CollectError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (CollectError era) -> Encoding)
-> Encode Open (CollectError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (PlutusPurpose AsItem era -> CollectError era)
-> Word
-> Encode Open (PlutusPurpose AsItem era -> CollectError era)
forall t. t -> Word -> Encode Open t
Sum PlutusPurpose AsItem era -> CollectError era
forall era. PlutusPurpose AsItem era -> CollectError era
NoRedeemer Word
0 Encode Open (PlutusPurpose AsItem era -> CollectError era)
-> Encode (Closed Dense) (PlutusPurpose AsItem era)
-> Encode Open (CollectError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PlutusPurpose AsItem era
-> Encode (Closed Dense) (PlutusPurpose AsItem era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PlutusPurpose AsItem era
x
  encCBOR (NoWitness ScriptHash
x) = Encode Open (CollectError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (CollectError era) -> Encoding)
-> Encode Open (CollectError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (ScriptHash -> CollectError era)
-> Word -> Encode Open (ScriptHash -> CollectError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. ScriptHash -> CollectError era
NoWitness @era) Word
1 Encode Open (ScriptHash -> CollectError era)
-> Encode (Closed Dense) ScriptHash
-> Encode Open (CollectError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ScriptHash -> Encode (Closed Dense) ScriptHash
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ScriptHash
x
  encCBOR (NoCostModel Language
x) = Encode Open (CollectError (ZonkAny 4)) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (CollectError (ZonkAny 4)) -> Encoding)
-> Encode Open (CollectError (ZonkAny 4)) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Language -> CollectError (ZonkAny 4))
-> Word -> Encode Open (Language -> CollectError (ZonkAny 4))
forall t. t -> Word -> Encode Open t
Sum Language -> CollectError (ZonkAny 4)
forall era. Language -> CollectError era
NoCostModel Word
2 Encode Open (Language -> CollectError (ZonkAny 4))
-> Encode (Closed Dense) Language
-> Encode Open (CollectError (ZonkAny 4))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Language -> Encode (Closed Dense) Language
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Language
x
  encCBOR (BadTranslation ContextError era
x) = Encode Open (CollectError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (CollectError era) -> Encoding)
-> Encode Open (CollectError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (ContextError era -> CollectError era)
-> Word -> Encode Open (ContextError era -> CollectError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. ContextError era -> CollectError era
BadTranslation @era) Word
3 Encode Open (ContextError era -> CollectError era)
-> Encode (Closed Dense) (ContextError era)
-> Encode Open (CollectError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ContextError era -> Encode (Closed Dense) (ContextError era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ContextError era
x

instance (AlonzoEraScript era, DecCBOR (ContextError era)) => DecCBOR (CollectError era) where
  decCBOR :: forall s. Decoder s (CollectError era)
decCBOR = Decode (Closed Dense) (CollectError era)
-> Decoder s (CollectError era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Text
-> (Word -> Decode Open (CollectError era))
-> Decode (Closed Dense) (CollectError era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"CollectError" Word -> Decode Open (CollectError era)
forall {era}.
(DecCBOR (PlutusPurpose AsItem era), DecCBOR (ContextError era)) =>
Word -> Decode Open (CollectError era)
dec)
    where
      dec :: Word -> Decode Open (CollectError era)
dec Word
0 = (PlutusPurpose AsItem era -> CollectError era)
-> Decode Open (PlutusPurpose AsItem era -> CollectError era)
forall t. t -> Decode Open t
SumD PlutusPurpose AsItem era -> CollectError era
forall era. PlutusPurpose AsItem era -> CollectError era
NoRedeemer Decode Open (PlutusPurpose AsItem era -> CollectError era)
-> Decode (Closed (ZonkAny 0)) (PlutusPurpose AsItem era)
-> Decode Open (CollectError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 0)) (PlutusPurpose AsItem era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
1 = (ScriptHash -> CollectError era)
-> Decode Open (ScriptHash -> CollectError era)
forall t. t -> Decode Open t
SumD ScriptHash -> CollectError era
forall era. ScriptHash -> CollectError era
NoWitness Decode Open (ScriptHash -> CollectError era)
-> Decode (Closed (ZonkAny 1)) ScriptHash
-> Decode Open (CollectError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) ScriptHash
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
2 = (Language -> CollectError era)
-> Decode Open (Language -> CollectError era)
forall t. t -> Decode Open t
SumD Language -> CollectError era
forall era. Language -> CollectError era
NoCostModel Decode Open (Language -> CollectError era)
-> Decode (Closed (ZonkAny 2)) Language
-> Decode Open (CollectError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) Language
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
3 = (ContextError era -> CollectError era)
-> Decode Open (ContextError era -> CollectError era)
forall t. t -> Decode Open t
SumD ContextError era -> CollectError era
forall era. ContextError era -> CollectError era
BadTranslation Decode Open (ContextError era -> CollectError era)
-> Decode (Closed (ZonkAny 3)) (ContextError era)
-> Decode Open (CollectError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) (ContextError era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
n = Word -> Decode Open (CollectError era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

instance
  ( Era era
  , ToJSON (PlutusPurpose AsItem era)
  , ToJSON (ContextError era)
  ) =>
  ToJSON (CollectError era)
  where
  toJSON :: CollectError era -> Value
toJSON = \case
    NoRedeemer PlutusPurpose AsItem era
sPurpose ->
      Text -> [Pair] -> Value
kindObject Text
"CollectError" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NoRedeemer"
        , Key
"plutusPurpose" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PlutusPurpose AsItem era -> Value
forall a. ToJSON a => a -> Value
toJSON PlutusPurpose AsItem era
sPurpose
        ]
    NoWitness ScriptHash
sHash ->
      Text -> [Pair] -> Value
kindObject Text
"CollectError" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NoWitness"
        , Key
"scriptHash" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash -> Value
forall a. ToJSON a => a -> Value
toJSON ScriptHash
sHash
        ]
    NoCostModel Language
lang ->
      Text -> [Pair] -> Value
kindObject Text
"CollectError" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NoCostModel"
        , Key
"language" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Language -> Value
forall a. ToJSON a => a -> Value
toJSON Language
lang
        ]
    BadTranslation ContextError era
err ->
      Text -> [Pair] -> Value
kindObject Text
"BadTranslation" [Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ContextError era -> Value
forall a. ToJSON a => a -> Value
toJSON ContextError era
err]

collectPlutusScriptsWithContext ::
  forall era.
  ( AlonzoEraTxBody era
  , AlonzoEraTxWits era
  , AlonzoEraUTxO era
  , ScriptsNeeded era ~ AlonzoScriptsNeeded era
  , EraPlutusContext era
  ) =>
  EpochInfo (Either Text) ->
  SystemStart ->
  PParams era ->
  Tx TopTx era ->
  UTxO era ->
  Either [CollectError era] [PlutusWithContext]
collectPlutusScriptsWithContext :: forall era.
(AlonzoEraTxBody era, AlonzoEraTxWits era, AlonzoEraUTxO era,
 ScriptsNeeded era ~ AlonzoScriptsNeeded era,
 EraPlutusContext era) =>
EpochInfo (Either Text)
-> SystemStart
-> PParams era
-> Tx TopTx era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectPlutusScriptsWithContext EpochInfo (Either Text)
epochInfo SystemStart
systemStart PParams era
pp Tx TopTx era
tx UTxO era
utxo =
  ((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 [CollectError era] [PlutusWithContext]
-> Either [CollectError era] [PlutusWithContext]
forall t b a.
(t -> Either a b)
-> [Either a t] -> Either [a] [b] -> Either [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)]
neededPlutusScripts)
    ([PlutusWithContext]
-> Either [CollectError era] [PlutusWithContext]
forall a b. b -> Either a b
Right [])
  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
    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
    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
        }
    txInfoResult :: TxInfoResult era
txInfoResult = LedgerTxInfo era -> TxInfoResult era
forall era.
EraPlutusContext era =>
LedgerTxInfo era -> TxInfoResult era
mkTxInfoResult LedgerTxInfo era
ledgerTxInfo

    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 (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)
    neededPlutusScripts :: [((ScriptHash, PlutusPurpose AsIxItem era), PlutusScript era)]
neededPlutusScripts =
      ((PlutusPurpose AsIxItem era, ScriptHash)
 -> Maybe
      ((ScriptHash, PlutusPurpose AsIxItem era), PlutusScript era))
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> [((ScriptHash, PlutusPurpose AsIxItem era), PlutusScript era)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(PlutusPurpose AsIxItem era
sp, ScriptHash
sh) -> (,) (ScriptHash
sh, PlutusPurpose AsIxItem era
sp) (PlutusScript era
 -> ((ScriptHash, PlutusPurpose AsIxItem era), PlutusScript era))
-> Maybe (PlutusScript era)
-> Maybe
     ((ScriptHash, PlutusPurpose AsIxItem era), PlutusScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) [(PlutusPurpose AsIxItem era, ScriptHash)]
scriptsNeeded

    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)
 -> Maybe (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Maybe (Data era, ExUnits)
forall a b. (a -> b) -> a -> b
$ Tx TopTx era
tx Tx TopTx era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx TopTx 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 TopTx era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx TopTx 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 TopTx era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx TopTx 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 TopTx 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 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
costModels
      first BadTranslation $
        mkPlutusWithContext
          plutusScript
          plutusScriptHash
          plutusPurpose
          ledgerTxInfo
          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 [a] [b] -> Either [a] [b]
merge :: forall t b a.
(t -> Either a b)
-> [Either a t] -> Either [a] [b] -> Either [a] [b]
merge t -> Either a b
_f [] Either [a] [b]
answer = Either [a] [b]
answer
merge t -> Either a b
f (Either a t
x : [Either a t]
xs) Either [a] [b]
zs = (t -> Either a b)
-> [Either a t] -> Either [a] [b] -> Either [a] [b]
forall t b a.
(t -> Either a b)
-> [Either a t] -> Either [a] [b] -> Either [a] [b]
merge t -> Either a b
f [Either a t]
xs (Either a t -> Either [a] [b] -> Either [a] [b]
gg Either a t
x Either [a] [b]
zs)
  where
    gg :: Either a t -> Either [a] [b] -> Either [a] [b]
    gg :: Either a t -> Either [a] [b] -> Either [a] [b]
gg (Right t
t) (Right [b]
cs) =
      case t -> Either a b
f t
t of
        Right b
c -> [b] -> Either [a] [b]
forall a b. b -> Either a b
Right ([b] -> Either [a] [b]) -> [b] -> Either [a] [b]
forall a b. (a -> b) -> a -> b
$ b
c b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
cs
        Left a
e -> [a] -> Either [a] [b]
forall a b. a -> Either a b
Left [a
e]
    gg (Left a
a) (Right [b]
_) = [a] -> Either [a] [b]
forall a b. a -> Either a b
Left [a
a]
    gg (Right t
_) (Left [a]
cs) = [a] -> Either [a] [b]
forall a b. a -> Either a b
Left [a]
cs
    gg (Left a
a) (Left [a]
cs) = [a] -> Either [a] [b]
forall a b. a -> Either a b
Left (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [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 :: String
beginMsg =
        String -> Context -> String
forall a. [a] -> [[a]] -> [a]
intercalate
          String
","
          [ String
"[LEDGER][PLUTUS_SCRIPT]"
          , String
"BEGIN"
          ]
      !res :: ([Text], ScriptResult)
res = String -> ([Text], ScriptResult) -> ([Text], ScriptResult)
forall a. String -> a -> a
Debug.traceEvent String
beginMsg (([Text], ScriptResult) -> ([Text], ScriptResult))
-> ([Text], ScriptResult) -> ([Text], ScriptResult)
forall a b. (a -> b) -> a -> b
$ PlutusWithContext -> ([Text], ScriptResult)
runPlutusScriptWithLogs PlutusWithContext
plutusWithContext
      endMsg :: String
endMsg =
        String -> Context -> String
forall a. [a] -> [[a]] -> [a]
intercalate
          String
","
          [ String
"[LEDGER][PLUTUS_SCRIPT]"
          , String
"END"
          ]
   in String -> ([Text], ScriptResult) -> ([Text], ScriptResult)
forall a. String -> a -> a
Debug.traceEvent String
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
        }
    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