{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Ledger.Alonzo.Tools
  ( evaluateTransactionExecutionUnits,
    evaluateTransactionExecutionUnitsWithLogs,
    TransactionScriptFailure (..),
  )
where

import Cardano.Ledger.Alonzo.Data (Data, Datum (..), binaryDataToData, getPlutusData)
import Cardano.Ledger.Alonzo.Language (Language (..))
import Cardano.Ledger.Alonzo.PlutusScriptApi (knownToNotBe1Phase, scriptsNeeded)
import Cardano.Ledger.Alonzo.Scripts
  ( CostModel,
    ExUnits (..),
    Script (..),
    getEvaluationContext,
  )
import Cardano.Ledger.Alonzo.Tx (DataHash, ScriptPurpose (..), rdptr)
import Cardano.Ledger.Alonzo.TxInfo
  ( ExtendedUTxO (getTxOutDatum, txscripts),
    TranslationError,
    VersionedTxInfo (..),
    exBudgetToExUnits,
    transExUnits,
    transProtocolVersion,
    txInfo,
    valContext,
  )
import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr (..), Redeemers, TxDats, unRedeemers, unTxDats)
import Cardano.Ledger.BaseTypes (ProtVer, StrictMaybe (..))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era (Crypto, Era)
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Shelley.Tx (TxIn)
import Cardano.Ledger.Shelley.TxBody (DCert, Wdrl)
import Cardano.Ledger.Shelley.UTxO (UTxO (..), unUTxO)
import Cardano.Slotting.EpochInfo.API (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Data.Array (Array, bounds, (!))
import Data.ByteString.Short as SBS (ShortByteString)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import GHC.Records (HasField (..))
import qualified Plutus.V1.Ledger.Api as PV1
import qualified Plutus.V2.Ledger.Api as PV2

-- | Script failures that can be returned by 'evaluateTransactionExecutionUnits'.
data TransactionScriptFailure c
  = -- | A redeemer was supplied that does not point to a
    --  valid plutus evaluation site in the given transaction.
    RedeemerNotNeeded !RdmrPtr !(ScriptHash c)
  | -- | A redeemer was supplied which points to a script hash which
    -- we cannot connect to a Plutus script.
    RedeemerPointsToUnknownScriptHash !RdmrPtr
  | -- | Missing redeemer. The first parameter is the redeemer pointer which cannot be resolved,
    -- and the second parameter is the map of pointers which can be resolved.
    MissingScript !RdmrPtr !(Map RdmrPtr (ScriptPurpose c, Maybe (ShortByteString, Language), ScriptHash c))
  | -- | Missing datum.
    MissingDatum !(DataHash c)
  | -- | Plutus V1 evaluation error.
    ValidationFailedV1 !PV1.EvaluationError ![Text]
  | -- | Plutus V2 evaluation error.
    ValidationFailedV2 !PV2.EvaluationError ![Text]
  | -- | A redeemer points to a transaction input which is not
    --  present in the current UTxO.
    UnknownTxIn !(TxIn c)
  | -- | A redeemer points to a transaction input which is not
    --  plutus locked.
    InvalidTxIn !(TxIn c)
  | -- | The execution budget that was calculated by the Plutus
    --  evaluator is out of bounds.
    IncompatibleBudget !PV1.ExBudget
  | -- | There was no cost model for a given version of Plutus in the ledger state
    NoCostModelInLedgerState !Language
  deriving (Int -> TransactionScriptFailure c -> ShowS
[TransactionScriptFailure c] -> ShowS
TransactionScriptFailure c -> String
(Int -> TransactionScriptFailure c -> ShowS)
-> (TransactionScriptFailure c -> String)
-> ([TransactionScriptFailure c] -> ShowS)
-> Show (TransactionScriptFailure c)
forall c. Int -> TransactionScriptFailure c -> ShowS
forall c. [TransactionScriptFailure c] -> ShowS
forall c. TransactionScriptFailure c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionScriptFailure c] -> ShowS
$cshowList :: forall c. [TransactionScriptFailure c] -> ShowS
show :: TransactionScriptFailure c -> String
$cshow :: forall c. TransactionScriptFailure c -> String
showsPrec :: Int -> TransactionScriptFailure c -> ShowS
$cshowsPrec :: forall c. Int -> TransactionScriptFailure c -> ShowS
Show, TransactionScriptFailure c -> TransactionScriptFailure c -> Bool
(TransactionScriptFailure c -> TransactionScriptFailure c -> Bool)
-> (TransactionScriptFailure c
    -> TransactionScriptFailure c -> Bool)
-> Eq (TransactionScriptFailure c)
forall c.
TransactionScriptFailure c -> TransactionScriptFailure c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionScriptFailure c -> TransactionScriptFailure c -> Bool
$c/= :: forall c.
TransactionScriptFailure c -> TransactionScriptFailure c -> Bool
== :: TransactionScriptFailure c -> TransactionScriptFailure c -> Bool
$c== :: forall c.
TransactionScriptFailure c -> TransactionScriptFailure c -> Bool
Eq)

note :: e -> Maybe a -> Either e a
note :: 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 c = Map RdmrPtr (Either (TransactionScriptFailure c) ExUnits)

type RedeemerReportWithLogs c = Map RdmrPtr (Either (TransactionScriptFailure c) ([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 'evaluateTransactionExecutionUnits' are intended to replace them.
evaluateTransactionExecutionUnits ::
  forall era.
  ( Era era,
    ExtendedUTxO era,
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "txdats" (Core.Witnesses era) (TxDats era),
    HasField "txrdmrs" (Core.Witnesses era) (Redeemers era),
    HasField "_maxTxExUnits" (Core.PParams era) ExUnits,
    HasField "_protocolVersion" (Core.PParams era) ProtVer,
    Core.Script era ~ Script era
  ) =>
  Core.PParams era ->
  -- | The transaction.
  Core.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 ->
  -- | The array of cost models, indexed by the supported languages.
  Array Language CostModel ->
  -- | We return a map from redeemer pointers to either a failure or a
  --  sufficient execution budget.
  --  Otherwise, we return a 'TranslationError' manifesting from failed attempts
  --  to construct a valid execution context for the given transaction.
  Either (TranslationError (Crypto era)) (RedeemerReport (Crypto era))
evaluateTransactionExecutionUnits :: PParams era
-> Tx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Array Language CostModel
-> Either
     (TranslationError (Crypto era)) (RedeemerReport (Crypto era))
evaluateTransactionExecutionUnits PParams era
pp Tx era
tx UTxO era
utxo EpochInfo (Either Text)
ei SystemStart
sysS Array Language CostModel
costModels =
  (Map
   RdmrPtr
   (Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits))
 -> RedeemerReport (Crypto era))
-> Either
     (TranslationError (Crypto era))
     (Map
        RdmrPtr
        (Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)))
-> Either
     (TranslationError (Crypto era)) (RedeemerReport (Crypto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
 -> Either (TransactionScriptFailure (Crypto era)) ExUnits)
-> Map
     RdmrPtr
     (Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits))
-> RedeemerReport (Crypto era)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((([Text], ExUnits) -> ExUnits)
-> Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
-> Either (TransactionScriptFailure (Crypto era)) ExUnits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text], ExUnits) -> ExUnits
forall a b. (a, b) -> b
snd)) (Either
   (TranslationError (Crypto era))
   (Map
      RdmrPtr
      (Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)))
 -> Either
      (TranslationError (Crypto era)) (RedeemerReport (Crypto era)))
-> Either
     (TranslationError (Crypto era))
     (Map
        RdmrPtr
        (Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)))
-> Either
     (TranslationError (Crypto era)) (RedeemerReport (Crypto era))
forall a b. (a -> b) -> a -> b
$ PParams era
-> Tx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Array Language CostModel
-> Either
     (TranslationError (Crypto era))
     (Map
        RdmrPtr
        (Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)))
forall era.
(Era era, ExtendedUTxO era,
 HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "txdats" (Witnesses era) (TxDats era),
 HasField "txrdmrs" (Witnesses era) (Redeemers era),
 HasField "_maxTxExUnits" (PParams era) ExUnits,
 HasField "_protocolVersion" (PParams era) ProtVer,
 Script era ~ Script era) =>
PParams era
-> Tx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Array Language CostModel
-> Either
     (TranslationError (Crypto era))
     (RedeemerReportWithLogs (Crypto era))
evaluateTransactionExecutionUnitsWithLogs PParams era
pp Tx era
tx UTxO era
utxo EpochInfo (Either Text)
ei SystemStart
sysS Array Language CostModel
costModels

-- | 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 'evaluateTransactionExecutionUnitsWithLogs' are intended to replace them.
evaluateTransactionExecutionUnitsWithLogs ::
  forall era.
  ( Era era,
    ExtendedUTxO era,
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "txdats" (Core.Witnesses era) (TxDats era),
    HasField "txrdmrs" (Core.Witnesses era) (Redeemers era),
    HasField "_maxTxExUnits" (Core.PParams era) ExUnits,
    HasField "_protocolVersion" (Core.PParams era) ProtVer,
    Core.Script era ~ Script era
  ) =>
  Core.PParams era ->
  -- | The transaction.
  Core.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 ->
  -- | The array of cost models, indexed by the supported languages.
  Array Language CostModel ->
  -- | 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.
  Either (TranslationError (Crypto era)) (RedeemerReportWithLogs (Crypto era))
evaluateTransactionExecutionUnitsWithLogs :: PParams era
-> Tx era
-> UTxO era
-> EpochInfo (Either Text)
-> SystemStart
-> Array Language CostModel
-> Either
     (TranslationError (Crypto era))
     (RedeemerReportWithLogs (Crypto era))
evaluateTransactionExecutionUnitsWithLogs PParams era
pp Tx era
tx UTxO era
utxo EpochInfo (Either Text)
ei SystemStart
sysS Array Language CostModel
costModels = do
  let getInfo :: Language -> Either (TranslationError (Crypto era)) VersionedTxInfo
      getInfo :: Language -> Either (TranslationError (Crypto era)) VersionedTxInfo
getInfo Language
lang = PParams era
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx era
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall era.
ExtendedUTxO era =>
PParams era
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx era
-> Either (TranslationError (Crypto era)) VersionedTxInfo
txInfo PParams era
pp Language
lang EpochInfo (Either Text)
ei SystemStart
sysS UTxO era
utxo Tx era
tx
  Map Language VersionedTxInfo
ctx <- Map
  Language (Either (TranslationError (Crypto era)) VersionedTxInfo)
-> Either
     (TranslationError (Crypto era)) (Map Language VersionedTxInfo)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Map
   Language (Either (TranslationError (Crypto era)) VersionedTxInfo)
 -> Either
      (TranslationError (Crypto era)) (Map Language VersionedTxInfo))
-> Map
     Language (Either (TranslationError (Crypto era)) VersionedTxInfo)
-> Either
     (TranslationError (Crypto era)) (Map Language VersionedTxInfo)
forall a b. (a -> b) -> a -> b
$ (Language
 -> Either (TranslationError (Crypto era)) VersionedTxInfo)
-> Set Language
-> Map
     Language (Either (TranslationError (Crypto era)) VersionedTxInfo)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet Language -> Either (TranslationError (Crypto era)) VersionedTxInfo
getInfo Set Language
languagesUsed
  RedeemerReportWithLogs (Crypto era)
-> Either
     (TranslationError (Crypto era))
     (RedeemerReportWithLogs (Crypto era))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RedeemerReportWithLogs (Crypto era)
 -> Either
      (TranslationError (Crypto era))
      (RedeemerReportWithLogs (Crypto era)))
-> RedeemerReportWithLogs (Crypto era)
-> Either
     (TranslationError (Crypto era))
     (RedeemerReportWithLogs (Crypto era))
forall a b. (a -> b) -> a -> b
$
    (RdmrPtr
 -> (Data era, ExUnits)
 -> Either
      (TransactionScriptFailure (Crypto era)) ([Text], ExUnits))
-> Map RdmrPtr (Data era, ExUnits)
-> RedeemerReportWithLogs (Crypto era)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
      (PParams era
-> Map Language VersionedTxInfo
-> RdmrPtr
-> (Data era, ExUnits)
-> Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
findAndCount PParams era
pp Map Language VersionedTxInfo
ctx)
      (Redeemers era -> Map RdmrPtr (Data era, ExUnits)
forall era. Redeemers era -> Map RdmrPtr (Data era, ExUnits)
unRedeemers (Redeemers era -> Map RdmrPtr (Data era, ExUnits))
-> Redeemers era -> Map RdmrPtr (Data era, ExUnits)
forall a b. (a -> b) -> a -> b
$ Witnesses era -> Redeemers era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txrdmrs" Witnesses era
ws)
  where
    txb :: TxBody era
txb = Tx era -> TxBody era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"body" Tx era
tx
    ws :: Witnesses era
ws = Tx era -> Witnesses era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wits" Tx era
tx
    dats :: Map (DataHash (Crypto era)) (Data era)
dats = TxDats era -> Map (DataHash (Crypto era)) (Data era)
forall era. TxDats era -> Map (DataHash (Crypto era)) (Data era)
unTxDats (TxDats era -> Map (DataHash (Crypto era)) (Data era))
-> TxDats era -> Map (DataHash (Crypto era)) (Data era)
forall a b. (a -> b) -> a -> b
$ Witnesses era -> TxDats era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txdats" Witnesses era
ws
    scriptsAvailable :: Map (ScriptHash (Crypto era)) (Script era)
scriptsAvailable = UTxO era -> Tx era -> Map (ScriptHash (Crypto era)) (Script era)
forall era.
ExtendedUTxO era =>
UTxO era -> Tx era -> Map (ScriptHash (Crypto era)) (Script era)
txscripts UTxO era
utxo Tx era
tx
    needed :: [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
needed = UTxO era
-> Tx era
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
forall era tx.
(Era era, HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "body" tx (TxBody era)) =>
UTxO era
-> tx -> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
scriptsNeeded UTxO era
utxo Tx era
tx
    neededAndConfirmedToBePlutus :: [(ScriptPurpose (Crypto era), Language, ShortByteString)]
neededAndConfirmedToBePlutus = ((ScriptPurpose (Crypto era), ScriptHash (Crypto era))
 -> Maybe (ScriptPurpose (Crypto era), Language, ShortByteString))
-> [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
-> [(ScriptPurpose (Crypto era), Language, ShortByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Map (ScriptHash (Crypto era)) (Script era)
-> (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
-> Maybe (ScriptPurpose (Crypto era), Language, ShortByteString)
forall era.
Map (ScriptHash (Crypto era)) (Script era)
-> (ScriptPurpose (Crypto era), ScriptHash (Crypto era))
-> Maybe (ScriptPurpose (Crypto era), Language, ShortByteString)
knownToNotBe1Phase Map (ScriptHash (Crypto era)) (Script era)
Map (ScriptHash (Crypto era)) (Script era)
scriptsAvailable) [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
needed
    languagesUsed :: Set Language
languagesUsed = [Language] -> Set Language
forall a. Ord a => [a] -> Set a
Set.fromList [Language
lang | (ScriptPurpose (Crypto era)
_, Language
lang, ShortByteString
_) <- [(ScriptPurpose (Crypto era), Language, ShortByteString)]
neededAndConfirmedToBePlutus]

    ptrToPlutusScript :: Map
  RdmrPtr
  (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
   ScriptHash (Crypto era))
ptrToPlutusScript = [(RdmrPtr,
  (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
   ScriptHash (Crypto era)))]
-> Map
     RdmrPtr
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RdmrPtr,
   (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
    ScriptHash (Crypto era)))]
 -> Map
      RdmrPtr
      (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
       ScriptHash (Crypto era)))
-> [(RdmrPtr,
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era)))]
-> Map
     RdmrPtr
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
forall a b. (a -> b) -> a -> b
$ do
      (ScriptPurpose (Crypto era)
sp, ScriptHash (Crypto era)
sh) <- [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
needed
      Maybe (ShortByteString, Language)
msb <- case ScriptHash (Crypto era)
-> Map (ScriptHash (Crypto era)) (Script era) -> Maybe (Script era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash (Crypto era)
sh Map (ScriptHash (Crypto era)) (Script era)
Map (ScriptHash (Crypto era)) (Script era)
scriptsAvailable of
        Maybe (Script era)
Nothing -> Maybe (ShortByteString, Language)
-> [Maybe (ShortByteString, Language)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ShortByteString, Language)
forall a. Maybe a
Nothing
        Just (TimelockScript Timelock (Crypto era)
_) -> []
        Just (PlutusScript Language
lang ShortByteString
bytes) -> Maybe (ShortByteString, Language)
-> [Maybe (ShortByteString, Language)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ShortByteString, Language)
 -> [Maybe (ShortByteString, Language)])
-> Maybe (ShortByteString, Language)
-> [Maybe (ShortByteString, Language)]
forall a b. (a -> b) -> a -> b
$ (ShortByteString, Language) -> Maybe (ShortByteString, Language)
forall a. a -> Maybe a
Just (ShortByteString
bytes, Language
lang)
      RdmrPtr
pointer <- case TxBody era -> ScriptPurpose (Crypto era) -> StrictMaybe RdmrPtr
forall era.
(HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "minted" (TxBody era) (Set (ScriptHash (Crypto era)))) =>
TxBody era -> ScriptPurpose (Crypto era) -> StrictMaybe RdmrPtr
rdptr TxBody era
txb ScriptPurpose (Crypto era)
sp of
        StrictMaybe RdmrPtr
SNothing -> []
        -- Since scriptsNeeded used the transaction to create script purposes,
        -- it would be a logic error if rdptr was not able to find sp.
        SJust RdmrPtr
p -> RdmrPtr -> [RdmrPtr]
forall (f :: * -> *) a. Applicative f => a -> f a
pure RdmrPtr
p
      (RdmrPtr,
 (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
  ScriptHash (Crypto era)))
-> [(RdmrPtr,
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era)))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RdmrPtr
pointer, (ScriptPurpose (Crypto era)
sp, Maybe (ShortByteString, Language)
msb, ScriptHash (Crypto era)
sh))

    findAndCount ::
      Core.PParams era ->
      Map Language VersionedTxInfo ->
      RdmrPtr ->
      (Data era, ExUnits) ->
      Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
    findAndCount :: PParams era
-> Map Language VersionedTxInfo
-> RdmrPtr
-> (Data era, ExUnits)
-> Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
findAndCount PParams era
pparams Map Language VersionedTxInfo
info RdmrPtr
pointer (Data era
rdmr, ExUnits
_) = do
      (ScriptPurpose (Crypto era)
sp, Maybe (ShortByteString, Language)
mscript, ScriptHash (Crypto era)
sh) <-
        TransactionScriptFailure (Crypto era)
-> Maybe
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
-> Either
     (TransactionScriptFailure (Crypto era))
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
forall e a. e -> Maybe a -> Either e a
note (RdmrPtr -> TransactionScriptFailure (Crypto era)
forall c. RdmrPtr -> TransactionScriptFailure c
RedeemerPointsToUnknownScriptHash RdmrPtr
pointer) (Maybe
   (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
    ScriptHash (Crypto era))
 -> Either
      (TransactionScriptFailure (Crypto era))
      (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
       ScriptHash (Crypto era)))
-> Maybe
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
-> Either
     (TransactionScriptFailure (Crypto era))
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
forall a b. (a -> b) -> a -> b
$
          RdmrPtr
-> Map
     RdmrPtr
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
-> Maybe
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RdmrPtr
pointer Map
  RdmrPtr
  (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
   ScriptHash (Crypto era))
ptrToPlutusScript
      (ShortByteString
script, Language
lang) <- TransactionScriptFailure (Crypto era)
-> Maybe (ShortByteString, Language)
-> Either
     (TransactionScriptFailure (Crypto era)) (ShortByteString, Language)
forall e a. e -> Maybe a -> Either e a
note (RdmrPtr
-> Map
     RdmrPtr
     (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
      ScriptHash (Crypto era))
-> TransactionScriptFailure (Crypto era)
forall c.
RdmrPtr
-> Map
     RdmrPtr
     (ScriptPurpose c, Maybe (ShortByteString, Language), ScriptHash c)
-> TransactionScriptFailure c
MissingScript RdmrPtr
pointer Map
  RdmrPtr
  (ScriptPurpose (Crypto era), Maybe (ShortByteString, Language),
   ScriptHash (Crypto era))
ptrToPlutusScript) Maybe (ShortByteString, Language)
mscript
      VersionedTxInfo
inf <- TransactionScriptFailure (Crypto era)
-> Maybe VersionedTxInfo
-> Either (TransactionScriptFailure (Crypto era)) VersionedTxInfo
forall e a. e -> Maybe a -> Either e a
note (RdmrPtr
-> ScriptHash (Crypto era) -> TransactionScriptFailure (Crypto era)
forall c. RdmrPtr -> ScriptHash c -> TransactionScriptFailure c
RedeemerNotNeeded RdmrPtr
pointer ScriptHash (Crypto era)
sh) (Maybe VersionedTxInfo
 -> Either (TransactionScriptFailure (Crypto era)) VersionedTxInfo)
-> Maybe VersionedTxInfo
-> Either (TransactionScriptFailure (Crypto era)) VersionedTxInfo
forall a b. (a -> b) -> a -> b
$ Language -> Map Language VersionedTxInfo -> Maybe VersionedTxInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
lang Map Language VersionedTxInfo
info
      let (Language
l1, Language
l2) = Array Language CostModel -> (Language, Language)
forall i e. Array i e -> (i, i)
bounds Array Language CostModel
costModels
      CostModel
cm <-
        if Language
l1 Language -> Language -> Bool
forall a. Ord a => a -> a -> Bool
<= Language
lang Bool -> Bool -> Bool
&& Language
lang Language -> Language -> Bool
forall a. Ord a => a -> a -> Bool
<= Language
l2
          then CostModel
-> Either (TransactionScriptFailure (Crypto era)) CostModel
forall a b. b -> Either a b
Right (Array Language CostModel
costModels Array Language CostModel -> Language -> CostModel
forall i e. Ix i => Array i e -> i -> e
! Language
lang)
          else TransactionScriptFailure (Crypto era)
-> Either (TransactionScriptFailure (Crypto era)) CostModel
forall a b. a -> Either a b
Left (Language -> TransactionScriptFailure (Crypto era)
forall c. Language -> TransactionScriptFailure c
NoCostModelInLedgerState Language
lang)
      [Data era]
args <- case ScriptPurpose (Crypto era)
sp of
        Spending TxIn (Crypto era)
txin -> do
          TxOut era
txOut <- TransactionScriptFailure (Crypto era)
-> Maybe (TxOut era)
-> Either (TransactionScriptFailure (Crypto era)) (TxOut era)
forall e a. e -> Maybe a -> Either e a
note (TxIn (Crypto era) -> TransactionScriptFailure (Crypto era)
forall c. TxIn c -> TransactionScriptFailure c
UnknownTxIn TxIn (Crypto era)
txin) (Maybe (TxOut era)
 -> Either (TransactionScriptFailure (Crypto era)) (TxOut era))
-> Maybe (TxOut era)
-> Either (TransactionScriptFailure (Crypto era)) (TxOut era)
forall a b. (a -> b) -> a -> b
$ TxIn (Crypto era)
-> Map (TxIn (Crypto era)) (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn (Crypto era)
txin (UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
forall era. UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
unUTxO UTxO era
utxo)
          Data era
datum <- case TxOut era -> Datum era
forall era. ExtendedUTxO era => TxOut era -> Datum era
getTxOutDatum TxOut era
txOut of
            Datum BinaryData era
binaryData -> Data era
-> Either (TransactionScriptFailure (Crypto era)) (Data era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data era
 -> Either (TransactionScriptFailure (Crypto era)) (Data era))
-> Data era
-> Either (TransactionScriptFailure (Crypto era)) (Data era)
forall a b. (a -> b) -> a -> b
$ BinaryData era -> Data era
forall era. BinaryData era -> Data era
binaryDataToData BinaryData era
binaryData
            DatumHash DataHash (Crypto era)
dh -> TransactionScriptFailure (Crypto era)
-> Maybe (Data era)
-> Either (TransactionScriptFailure (Crypto era)) (Data era)
forall e a. e -> Maybe a -> Either e a
note (DataHash (Crypto era) -> TransactionScriptFailure (Crypto era)
forall c. DataHash c -> TransactionScriptFailure c
MissingDatum DataHash (Crypto era)
dh) (Maybe (Data era)
 -> Either (TransactionScriptFailure (Crypto era)) (Data era))
-> Maybe (Data era)
-> Either (TransactionScriptFailure (Crypto era)) (Data era)
forall a b. (a -> b) -> a -> b
$ DataHash (Crypto era)
-> Map (DataHash (Crypto era)) (Data era) -> Maybe (Data era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DataHash (Crypto era)
dh Map (DataHash (Crypto era)) (Data era)
dats
            Datum era
NoDatum -> TransactionScriptFailure (Crypto era)
-> Either (TransactionScriptFailure (Crypto era)) (Data era)
forall a b. a -> Either a b
Left (TxIn (Crypto era) -> TransactionScriptFailure (Crypto era)
forall c. TxIn c -> TransactionScriptFailure c
InvalidTxIn TxIn (Crypto era)
txin)
          [Data era]
-> Either (TransactionScriptFailure (Crypto era)) [Data era]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Data era
datum, Data era
rdmr, VersionedTxInfo -> ScriptPurpose (Crypto era) -> Data era
forall era.
VersionedTxInfo -> ScriptPurpose (Crypto era) -> Data era
valContext VersionedTxInfo
inf ScriptPurpose (Crypto era)
sp]
        ScriptPurpose (Crypto era)
_ -> [Data era]
-> Either (TransactionScriptFailure (Crypto era)) [Data era]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Data era
rdmr, VersionedTxInfo -> ScriptPurpose (Crypto era) -> Data era
forall era.
VersionedTxInfo -> ScriptPurpose (Crypto era) -> Data era
valContext VersionedTxInfo
inf ScriptPurpose (Crypto era)
sp]
      let pArgs :: [Data]
pArgs = (Data era -> Data) -> [Data era] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map Data era -> Data
forall era. Data era -> Data
getPlutusData [Data era]
args

      case Language
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> ([Text], Either EvaluationError ExBudget)
interpreter Language
lang (CostModel -> EvaluationContext
getEvaluationContext CostModel
cm) ExBudget
maxBudget ShortByteString
script [Data]
pArgs of
        ([Text]
logs, Left EvaluationError
e) -> case Language
lang of
          Language
PlutusV1 -> TransactionScriptFailure (Crypto era)
-> Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
forall a b. a -> Either a b
Left (TransactionScriptFailure (Crypto era)
 -> Either
      (TransactionScriptFailure (Crypto era)) ([Text], ExUnits))
-> TransactionScriptFailure (Crypto era)
-> Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
forall a b. (a -> b) -> a -> b
$ EvaluationError -> [Text] -> TransactionScriptFailure (Crypto era)
forall c. EvaluationError -> [Text] -> TransactionScriptFailure c
ValidationFailedV1 EvaluationError
e [Text]
logs
          Language
PlutusV2 -> TransactionScriptFailure (Crypto era)
-> Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
forall a b. a -> Either a b
Left (TransactionScriptFailure (Crypto era)
 -> Either
      (TransactionScriptFailure (Crypto era)) ([Text], ExUnits))
-> TransactionScriptFailure (Crypto era)
-> Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
forall a b. (a -> b) -> a -> b
$ EvaluationError -> [Text] -> TransactionScriptFailure (Crypto era)
forall c. EvaluationError -> [Text] -> TransactionScriptFailure c
ValidationFailedV2 EvaluationError
e [Text]
logs
        ([Text]
logs, Right ExBudget
exBudget) -> TransactionScriptFailure (Crypto era)
-> Maybe ([Text], ExUnits)
-> Either (TransactionScriptFailure (Crypto era)) ([Text], ExUnits)
forall e a. e -> Maybe a -> Either e a
note (ExBudget -> TransactionScriptFailure (Crypto era)
forall c. ExBudget -> TransactionScriptFailure c
IncompatibleBudget ExBudget
exBudget) (Maybe ([Text], ExUnits)
 -> Either
      (TransactionScriptFailure (Crypto era)) ([Text], ExUnits))
-> Maybe ([Text], ExUnits)
-> Either (TransactionScriptFailure (Crypto 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
      where
        maxBudget :: ExBudget
maxBudget = ExUnits -> ExBudget
transExUnits (ExUnits -> ExBudget)
-> (PParams era -> ExUnits) -> PParams era -> ExBudget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "_maxTxExUnits" r a => r -> a
getField @"_maxTxExUnits" (PParams era -> ExBudget) -> PParams era -> ExBudget
forall a b. (a -> b) -> a -> b
$ PParams era
pparams
        pv :: ProtocolVersion
pv = ProtVer -> ProtocolVersion
transProtocolVersion (ProtVer -> ProtocolVersion)
-> (PParams era -> ProtVer) -> PParams era -> ProtocolVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "_protocolVersion" r a => r -> a
getField @"_protocolVersion" (PParams era -> ProtocolVersion) -> PParams era -> ProtocolVersion
forall a b. (a -> b) -> a -> b
$ PParams era
pparams
        interpreter :: Language
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> ([Text], Either EvaluationError ExBudget)
interpreter Language
lang = case Language
lang of
          Language
PlutusV1 -> ProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> ([Text], Either EvaluationError ExBudget)
PV1.evaluateScriptRestricting ProtocolVersion
pv VerboseMode
PV1.Verbose
          Language
PlutusV2 -> ProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> ([Text], Either EvaluationError ExBudget)
PV2.evaluateScriptRestricting ProtocolVersion
pv VerboseMode
PV2.Verbose