{-# 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 Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (CollectError Any) -> Encoding)
-> Encode 'Open (CollectError Any) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Language -> CollectError Any)
-> Word -> Encode 'Open (Language -> CollectError Any)
forall t. t -> Word -> Encode 'Open t
Sum Language -> CollectError Any
forall era. Language -> CollectError era
NoCostModel Word
2 Encode 'Open (Language -> CollectError Any)
-> Encode ('Closed 'Dense) Language
-> Encode 'Open (CollectError Any)
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 Any) (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 Any) (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 Any) 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 Any) 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 Any) 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 Any) 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 Any) (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 Any) (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 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 era
-> UTxO era
-> Either [CollectError era] [PlutusWithContext]
collectPlutusScriptsWithContext EpochInfo (Either Text)
epochInfo SystemStart
systemStart PParams era
pp Tx 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 era
ltiTx = Tx 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 era -> ScriptsProvided era
forall era.
EraUTxO era =>
UTxO era -> Tx era -> ScriptsProvided era
getScriptsProvided UTxO era
utxo Tx era
tx
    AlonzoScriptsNeeded [(PlutusPurpose AsIxItem era, ScriptHash)]
scriptsNeeded = UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded UTxO era
utxo (Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody 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 era
tx Tx era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx 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 era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
 -> Tx era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx 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 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
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
      (ContextError era -> CollectError era)
-> Either (ContextError era) PlutusWithContext
-> Either (CollectError era) PlutusWithContext
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ContextError era -> CollectError era
forall era. ContextError era -> CollectError era
BadTranslation (Either (ContextError era) PlutusWithContext
 -> Either (CollectError era) PlutusWithContext)
-> Either (ContextError era) PlutusWithContext
-> Either (CollectError era) PlutusWithContext
forall a b. (a -> b) -> a -> b
$
        PlutusScript era
-> ScriptHash
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> TxInfoResult era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) PlutusWithContext
forall era.
EraPlutusContext era =>
PlutusScript era
-> ScriptHash
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> TxInfoResult era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) PlutusWithContext
mkPlutusWithContext
          PlutusScript era
plutusScript
          ScriptHash
plutusScriptHash
          PlutusPurpose AsIxItem era
plutusPurpose
          LedgerTxInfo era
ledgerTxInfo
          TxInfoResult era
txInfoResult
          (Data era
redeemerData, ExUnits
exUnits)
          CostModel
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 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 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 era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReport era
evalTxExUnits PParams era
pp Tx 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 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 era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReportWithLogs era
evalTxExUnitsWithLogs PParams era
pp Tx 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 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 era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> RedeemerReportWithLogs era
evalTxExUnitsWithLogs PParams era
pp Tx 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 era
ltiTx = Tx 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 era
txBody = Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL
    wits :: TxWits era
wits = Tx era
tx Tx era -> Getting (TxWits era) (Tx era) (TxWits era) -> TxWits era
forall s a. s -> Getting a s a -> a
^. Getting (TxWits era) (Tx era) (TxWits era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx 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 era -> ScriptsProvided era
forall era.
EraUTxO era =>
UTxO era -> Tx era -> ScriptsProvided era
getScriptsProvided UTxO era
utxo Tx era
tx
    AlonzoScriptsNeeded [(PlutusPurpose AsIxItem era, ScriptHash)]
scriptsNeeded = UTxO era -> TxBody era -> ScriptsNeeded era
forall era.
EraUTxO era =>
UTxO era -> TxBody era -> ScriptsNeeded era
getScriptsNeeded UTxO era
utxo TxBody 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 AsIxItem era
plutusPurpose, ScriptHash
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 :: Map
  (PlutusPurpose AsIx era)
  (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
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 era
plutusScript <-
        TransactionScriptFailure era
-> Maybe (PlutusScript era)
-> Either (TransactionScriptFailure era) (PlutusScript era)
forall e a. e -> Maybe a -> Either e a
note (PlutusPurpose AsIx era
-> Map
     (PlutusPurpose AsIx era)
     (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
-> TransactionScriptFailure era
forall era.
PlutusPurpose AsIx era
-> Map
     (PlutusPurpose AsIx era)
     (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
-> TransactionScriptFailure era
MissingScript PlutusPurpose AsIx era
pointer Map
  (PlutusPurpose AsIx era)
  (PlutusPurpose AsItem era, Maybe (PlutusScript era), ScriptHash)
ptrToPlutusScriptNoContext) (Maybe (PlutusScript era)
 -> Either (TransactionScriptFailure era) (PlutusScript era))
-> Maybe (PlutusScript era)
-> Either (TransactionScriptFailure era) (PlutusScript era)
forall a b. (a -> b) -> a -> b
$
          ScriptHash
-> Map ScriptHash (Script era) -> Maybe (PlutusScript era)
forall era.
AlonzoEraScript era =>
ScriptHash
-> Map ScriptHash (Script era) -> Maybe (PlutusScript era)
lookupPlutusScript ScriptHash
plutusScriptHash Map ScriptHash (Script era)
scriptsProvided
      let lang :: Language
lang = PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript
      CostModel
costModel <-
        TransactionScriptFailure era
-> Maybe CostModel
-> Either (TransactionScriptFailure era) CostModel
forall e a. e -> Maybe a -> Either e a
note (Language -> TransactionScriptFailure era
forall era. Language -> TransactionScriptFailure era
NoCostModelInLedgerState Language
lang) (Maybe CostModel
 -> Either (TransactionScriptFailure era) CostModel)
-> Maybe CostModel
-> Either (TransactionScriptFailure 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
      PlutusWithContext
pwc <-
        (ContextError era -> TransactionScriptFailure era)
-> Either (ContextError era) PlutusWithContext
-> Either (TransactionScriptFailure era) PlutusWithContext
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ContextError era -> TransactionScriptFailure era
forall era. ContextError era -> TransactionScriptFailure era
ContextError (Either (ContextError era) PlutusWithContext
 -> Either (TransactionScriptFailure era) PlutusWithContext)
-> Either (ContextError era) PlutusWithContext
-> Either (TransactionScriptFailure era) PlutusWithContext
forall a b. (a -> b) -> a -> b
$
          PlutusScript era
-> ScriptHash
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> TxInfoResult era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) PlutusWithContext
forall era.
EraPlutusContext era =>
PlutusScript era
-> ScriptHash
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> TxInfoResult era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) PlutusWithContext
mkPlutusWithContext
            PlutusScript era
plutusScript
            ScriptHash
plutusScriptHash
            PlutusPurpose AsIxItem era
plutusPurpose
            LedgerTxInfo era
ledgerTxInfo
            TxInfoResult era
txInfoResult
            (Data era
redeemerData, ExUnits
maxBudget)
            CostModel
costModel
      case VerboseMode
-> PlutusWithContext -> ([Text], Either EvaluationError ExBudget)
evaluatePlutusWithContext VerboseMode
P.Verbose PlutusWithContext
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