{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO (..),
  getAlonzoSpendingDatum,

  -- * Scripts needed
  AlonzoScriptsNeeded (..),
  getAlonzoScriptsNeeded,
  getSpendingScriptsNeeded,
  getWithdrawingScriptsNeeded,
  getRewardingScriptsNeeded,
  getMintingScriptsNeeded,
  getAlonzoScriptsHashesNeeded,
  scriptsNeededAlonzoStAnnTx,
  zipAsIxItem,

  -- * Scripts provided
  scriptsProvidedAlonzoStAnnTx,
  resolveNeededPlutusScriptsWithPurpose,

  -- * Plutus scripts with context
  plutusScriptsWithContextAlonzoStAnnTx,

  -- * Plutus languages used
  plutusLanguagesUsedAlonzoStAnnTx,

  -- * Datums needed
  getInputDataHashesTxBody,

  -- * WitsVKey needed
  getAlonzoWitsVKeyNeeded,
) where

import Cardano.Ledger.Address (accountAddressCredentialL)
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.Plutus.Context (
  CollectError,
  EraPlutusContext,
  SupportedPlutusRunnable (..),
  mkSupportedPlutusRunnable,
 )
import Cardano.Ledger.Alonzo.Scripts (lookupPlutusScript, plutusScriptLanguage)
import Cardano.Ledger.Alonzo.State ()
import Cardano.Ledger.Alonzo.Tx (
  AlonzoStAnnTx (..),
  alonzoMinFeeTx,
  exUnitsAlonzoStAnnTx,
  refScriptsSizeAlonzoStAnnTx,
 )
import Cardano.Ledger.Alonzo.TxWits (unTxDatsL)
import Cardano.Ledger.BaseTypes (ProtVer (..), StrictMaybe (..))
import Cardano.Ledger.Credential (credScriptHash)
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Mary.UTxO (getConsumedMaryValue, getProducedMaryValue)
import Cardano.Ledger.Mary.Value (PolicyID (..))
import Cardano.Ledger.Plutus (
  Data,
  Datum (..),
  Language (..),
  PlutusRunnable (..),
  PlutusWithContext,
 )
import Cardano.Ledger.Plutus.ExUnits (ExUnits)
import Cardano.Ledger.Shelley.UTxO (
  getShelleyMinFeeTxUtxo,
  getShelleyWitsVKeyNeeded,
 )
import Cardano.Ledger.State (
  EraCertState (..),
  EraUTxO (..),
  ScriptsProvided (..),
  UTxO (..),
  getScriptHash,
 )
import Cardano.Ledger.TxIn
import Control.DeepSeq (NFData)
import Control.Exception (assert)
import Data.Foldable as F (foldl', toList)
import Data.Functor ((<&>))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe, isJust)
import qualified Data.Set as Set
import Data.Word (Word32)
import GHC.Generics
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)

-- | Alonzo era style `ScriptsNeeded` require also a `PlutusPurpose`, not only the `ScriptHash`
newtype AlonzoScriptsNeeded era
  = AlonzoScriptsNeeded {forall era.
AlonzoScriptsNeeded era
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
unAlonzoScriptsNeeded :: [(PlutusPurpose AsIxItem era, ScriptHash)]}
  deriving (Semigroup (AlonzoScriptsNeeded era)
AlonzoScriptsNeeded era
Semigroup (AlonzoScriptsNeeded era) =>
AlonzoScriptsNeeded era
-> (AlonzoScriptsNeeded era
    -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era)
-> ([AlonzoScriptsNeeded era] -> AlonzoScriptsNeeded era)
-> Monoid (AlonzoScriptsNeeded era)
[AlonzoScriptsNeeded era] -> AlonzoScriptsNeeded era
AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall era. Semigroup (AlonzoScriptsNeeded era)
forall era. AlonzoScriptsNeeded era
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall era. [AlonzoScriptsNeeded era] -> AlonzoScriptsNeeded era
forall era.
AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
$cmempty :: forall era. AlonzoScriptsNeeded era
mempty :: AlonzoScriptsNeeded era
$cmappend :: forall era.
AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
mappend :: AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
$cmconcat :: forall era. [AlonzoScriptsNeeded era] -> AlonzoScriptsNeeded era
mconcat :: [AlonzoScriptsNeeded era] -> AlonzoScriptsNeeded era
Monoid, NonEmpty (AlonzoScriptsNeeded era) -> AlonzoScriptsNeeded era
AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
(AlonzoScriptsNeeded era
 -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era)
-> (NonEmpty (AlonzoScriptsNeeded era) -> AlonzoScriptsNeeded era)
-> (forall b.
    Integral b =>
    b -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era)
-> Semigroup (AlonzoScriptsNeeded era)
forall b.
Integral b =>
b -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall era.
NonEmpty (AlonzoScriptsNeeded era) -> AlonzoScriptsNeeded era
forall era.
AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall era b.
Integral b =>
b -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
$c<> :: forall era.
AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
<> :: AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
$csconcat :: forall era.
NonEmpty (AlonzoScriptsNeeded era) -> AlonzoScriptsNeeded era
sconcat :: NonEmpty (AlonzoScriptsNeeded era) -> AlonzoScriptsNeeded era
$cstimes :: forall era b.
Integral b =>
b -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
stimes :: forall b.
Integral b =>
b -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
Semigroup, (forall x.
 AlonzoScriptsNeeded era -> Rep (AlonzoScriptsNeeded era) x)
-> (forall x.
    Rep (AlonzoScriptsNeeded era) x -> AlonzoScriptsNeeded era)
-> Generic (AlonzoScriptsNeeded era)
forall x.
Rep (AlonzoScriptsNeeded era) x -> AlonzoScriptsNeeded era
forall x.
AlonzoScriptsNeeded era -> Rep (AlonzoScriptsNeeded era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (AlonzoScriptsNeeded era) x -> AlonzoScriptsNeeded era
forall era x.
AlonzoScriptsNeeded era -> Rep (AlonzoScriptsNeeded era) x
$cfrom :: forall era x.
AlonzoScriptsNeeded era -> Rep (AlonzoScriptsNeeded era) x
from :: forall x.
AlonzoScriptsNeeded era -> Rep (AlonzoScriptsNeeded era) x
$cto :: forall era x.
Rep (AlonzoScriptsNeeded era) x -> AlonzoScriptsNeeded era
to :: forall x.
Rep (AlonzoScriptsNeeded era) x -> AlonzoScriptsNeeded era
Generic)

deriving instance AlonzoEraScript era => Eq (AlonzoScriptsNeeded era)

deriving instance AlonzoEraScript era => Show (AlonzoScriptsNeeded era)

deriving instance AlonzoEraScript era => NFData (AlonzoScriptsNeeded era)

instance EraUTxO AlonzoEra where
  type ScriptsNeeded AlonzoEra = AlonzoScriptsNeeded AlonzoEra

  getConsumedValue :: forall (t :: TxLevel).
PParams AlonzoEra
-> (Credential Staking -> Maybe Coin)
-> UTxO AlonzoEra
-> TxBody t AlonzoEra
-> Value AlonzoEra
getConsumedValue = PParams AlonzoEra
-> (Credential Staking -> Maybe Coin)
-> UTxO AlonzoEra
-> TxBody t AlonzoEra
-> Value AlonzoEra
PParams AlonzoEra
-> (Credential Staking -> Maybe Coin)
-> UTxO AlonzoEra
-> TxBody t AlonzoEra
-> MaryValue
forall era (l :: TxLevel).
(MaryEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> UTxO era
-> TxBody l era
-> MaryValue
getConsumedMaryValue

  getProducedValue :: PParams AlonzoEra
-> (KeyHash StakePool -> Bool)
-> TxBody TopTx AlonzoEra
-> Value AlonzoEra
getProducedValue = PParams AlonzoEra
-> (KeyHash StakePool -> Bool)
-> TxBody TopTx AlonzoEra
-> Value AlonzoEra
PParams AlonzoEra
-> (KeyHash StakePool -> Bool)
-> TxBody TopTx AlonzoEra
-> MaryValue
forall era.
(MaryEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> MaryValue
getProducedMaryValue

  getScriptsProvided :: forall (t :: TxLevel).
UTxO AlonzoEra -> Tx t AlonzoEra -> ScriptsProvided AlonzoEra
getScriptsProvided UTxO AlonzoEra
_ Tx t AlonzoEra
tx = Map ScriptHash (Script AlonzoEra) -> ScriptsProvided AlonzoEra
forall era. Map ScriptHash (Script era) -> ScriptsProvided era
ScriptsProvided (Tx t AlonzoEra
tx Tx t AlonzoEra
-> Getting
     (Map ScriptHash (AlonzoScript AlonzoEra))
     (Tx t AlonzoEra)
     (Map ScriptHash (AlonzoScript AlonzoEra))
-> Map ScriptHash (AlonzoScript AlonzoEra)
forall s a. s -> Getting a s a -> a
^. (TxWits AlonzoEra
 -> Const
      (Map ScriptHash (AlonzoScript AlonzoEra)) (TxWits AlonzoEra))
-> Tx t AlonzoEra
-> Const (Map ScriptHash (AlonzoScript AlonzoEra)) (Tx t AlonzoEra)
(AlonzoTxWits AlonzoEra
 -> Const
      (Map ScriptHash (AlonzoScript AlonzoEra)) (AlonzoTxWits AlonzoEra))
-> Tx t AlonzoEra
-> Const (Map ScriptHash (AlonzoScript AlonzoEra)) (Tx t AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxWits AlonzoEra)
witsTxL ((AlonzoTxWits AlonzoEra
  -> Const
       (Map ScriptHash (AlonzoScript AlonzoEra)) (AlonzoTxWits AlonzoEra))
 -> Tx t AlonzoEra
 -> Const
      (Map ScriptHash (AlonzoScript AlonzoEra)) (Tx t AlonzoEra))
-> ((Map ScriptHash (AlonzoScript AlonzoEra)
     -> Const
          (Map ScriptHash (AlonzoScript AlonzoEra))
          (Map ScriptHash (AlonzoScript AlonzoEra)))
    -> AlonzoTxWits AlonzoEra
    -> Const
         (Map ScriptHash (AlonzoScript AlonzoEra)) (AlonzoTxWits AlonzoEra))
-> Getting
     (Map ScriptHash (AlonzoScript AlonzoEra))
     (Tx t AlonzoEra)
     (Map ScriptHash (AlonzoScript AlonzoEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script AlonzoEra)
 -> Const
      (Map ScriptHash (AlonzoScript AlonzoEra))
      (Map ScriptHash (Script AlonzoEra)))
-> TxWits AlonzoEra
-> Const
     (Map ScriptHash (AlonzoScript AlonzoEra)) (TxWits AlonzoEra)
(Map ScriptHash (AlonzoScript AlonzoEra)
 -> Const
      (Map ScriptHash (AlonzoScript AlonzoEra))
      (Map ScriptHash (AlonzoScript AlonzoEra)))
-> AlonzoTxWits AlonzoEra
-> Const
     (Map ScriptHash (AlonzoScript AlonzoEra)) (AlonzoTxWits AlonzoEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits AlonzoEra) (Map ScriptHash (Script AlonzoEra))
scriptTxWitsL)

  getScriptsNeeded :: forall (t :: TxLevel).
UTxO AlonzoEra -> TxBody t AlonzoEra -> ScriptsNeeded AlonzoEra
getScriptsNeeded = UTxO AlonzoEra -> TxBody t AlonzoEra -> ScriptsNeeded AlonzoEra
UTxO AlonzoEra
-> TxBody t AlonzoEra -> AlonzoScriptsNeeded AlonzoEra
forall era (l :: TxLevel).
(MaryEraTxBody era, AlonzoEraScript era) =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getAlonzoScriptsNeeded

  getScriptsHashesNeeded :: ScriptsNeeded AlonzoEra -> Set ScriptHash
getScriptsHashesNeeded = ScriptsNeeded AlonzoEra -> Set ScriptHash
AlonzoScriptsNeeded AlonzoEra -> Set ScriptHash
forall era. AlonzoScriptsNeeded era -> Set ScriptHash
getAlonzoScriptsHashesNeeded

  getWitsVKeyNeeded :: forall (t :: TxLevel).
CertState AlonzoEra
-> UTxO AlonzoEra -> TxBody t AlonzoEra -> Set (KeyHash Witness)
getWitsVKeyNeeded = CertState AlonzoEra
-> UTxO AlonzoEra -> TxBody t AlonzoEra -> Set (KeyHash Witness)
forall era (l :: TxLevel).
(EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era,
 EraCertState era, STxLevel l era ~ STxTopLevel l era) =>
CertState era -> UTxO era -> TxBody l era -> Set (KeyHash Witness)
getAlonzoWitsVKeyNeeded

  getMinFeeTxUtxo :: forall (t :: TxLevel).
PParams AlonzoEra -> Tx t AlonzoEra -> UTxO AlonzoEra -> Coin
getMinFeeTxUtxo PParams AlonzoEra
pp Tx t AlonzoEra
tx UTxO AlonzoEra
_ = PParams AlonzoEra -> Tx t AlonzoEra -> Coin
forall era (l :: TxLevel).
EraTx era =>
PParams era -> Tx l era -> Coin
getShelleyMinFeeTxUtxo PParams AlonzoEra
pp Tx t AlonzoEra
tx

  calcMinFeeStAnnTx :: PParams AlonzoEra -> StAnnTx TopTx AlonzoEra -> Coin
calcMinFeeStAnnTx PParams AlonzoEra
pp AlonzoStAnnTx {Tx TopTx AlonzoEra
asatTx :: Tx TopTx AlonzoEra
asatTx :: forall era. AlonzoStAnnTx TopTx era -> Tx TopTx era
asatTx, ExUnits
asatExUnits :: ExUnits
asatExUnits :: forall era. AlonzoStAnnTx TopTx era -> ExUnits
asatExUnits, UTxO AlonzoEra
asatUTxO :: UTxO AlonzoEra
asatUTxO :: forall era. AlonzoStAnnTx TopTx era -> UTxO era
asatUTxO} =
    Bool -> Coin -> Coin
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PParams AlonzoEra -> Tx TopTx AlonzoEra -> UTxO AlonzoEra -> Coin
forall era (t :: TxLevel).
EraUTxO era =>
PParams era -> Tx t era -> UTxO era -> Coin
forall (t :: TxLevel).
PParams AlonzoEra -> Tx t AlonzoEra -> UTxO AlonzoEra -> Coin
getMinFeeTxUtxo PParams AlonzoEra
pp Tx TopTx AlonzoEra
asatTx UTxO AlonzoEra
asatUTxO Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
minFee) Coin
minFee
    where
      minFee :: Coin
minFee = PParams AlonzoEra -> Tx TopTx AlonzoEra -> ExUnits -> Coin
forall era (l :: TxLevel).
AlonzoEraTx era =>
PParams era -> Tx l era -> ExUnits -> Coin
alonzoMinFeeTx PParams AlonzoEra
pp Tx TopTx AlonzoEra
asatTx ExUnits
asatExUnits

class EraUTxO era => AlonzoEraUTxO era where
  -- | Get data hashes for a transaction that are not required. Such datums are optional,
  -- but they can be added to the witness set. In a broaded terms datums corresponding to
  -- the inputs that might be spent are the required datums and the datums corresponding
  -- to the outputs and reference inputs are the supplemental datums.
  getSupplementalDataHashes ::
    UTxO era ->
    TxBody l era ->
    Set.Set DataHash

  -- | Lookup the TxIn from the `Spending` ScriptPurpose and find the datum needed for
  -- spending that input. This function will return `Nothing` for all script purposes,
  -- except spending, because only spending scripts require an extra datum.
  --
  -- This is similar to @getDatum@ function as in the spec:
  --
  -- @
  --   getDatum :: Tx era -> UTxO era -> ScriptPurpose era -> [Data era]
  -- @
  getSpendingDatum ::
    UTxO era ->
    Tx l era ->
    PlutusPurpose AsItem era ->
    Maybe (Data era)

  scriptsProvidedStAnnTx :: StAnnTx l era -> ScriptsProvided era

  scriptsNeededStAnnTx :: StAnnTx l era -> ScriptsNeeded era

  plutusScriptsWithContextStAnnTx ::
    StAnnTx l era ->
    Either (NonEmpty (CollectError era)) [PlutusWithContext]

  plutusLanguagesUsedStAnnTx :: StAnnTx l era -> Set.Set Language

  -- | Total size in bytes of the reference scripts used by the whole transaction,
  -- including sub-transactions where supported.
  -- Zero in eras in which there are no reference scripts limits or pricing (i.e. for pre-Conway eras).
  --
  -- This value can only become stale if an input or reference input is no longer in the UTXO,
  -- in which case the transaction is rejected for a missing input.
  refScriptsSizeStAnnTx :: StAnnTx TopTx era -> Int

  -- | Total execution units of all the redeemers in this transaction across the whole transaction,
  -- including sub-transactions where supported.
  --
  -- Derived from the transaction alone, so it never goes stale.
  exUnitsStAnnTx :: StAnnTx TopTx era -> ExUnits

instance AlonzoEraUTxO AlonzoEra where
  getSupplementalDataHashes :: forall (l :: TxLevel).
UTxO AlonzoEra -> TxBody l AlonzoEra -> Set DataHash
getSupplementalDataHashes UTxO AlonzoEra
_ = TxBody l AlonzoEra -> Set DataHash
forall era (l :: TxLevel).
(EraTxBody era, AlonzoEraTxOut era) =>
TxBody l era -> Set DataHash
getAlonzoSupplementalDataHashes

  getSpendingDatum :: forall (l :: TxLevel).
UTxO AlonzoEra
-> Tx l AlonzoEra
-> PlutusPurpose AsItem AlonzoEra
-> Maybe (Data AlonzoEra)
getSpendingDatum = UTxO AlonzoEra
-> Tx l AlonzoEra
-> PlutusPurpose AsItem AlonzoEra
-> Maybe (Data AlonzoEra)
forall era (l :: TxLevel).
(AlonzoEraTxWits era, AlonzoEraTxOut era, EraTx era) =>
UTxO era
-> Tx l era -> PlutusPurpose AsItem era -> Maybe (Data era)
getAlonzoSpendingDatum

  scriptsProvidedStAnnTx :: forall (l :: TxLevel).
StAnnTx l AlonzoEra -> ScriptsProvided AlonzoEra
scriptsProvidedStAnnTx = StAnnTx l AlonzoEra -> ScriptsProvided AlonzoEra
AlonzoStAnnTx l AlonzoEra -> ScriptsProvided AlonzoEra
forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era -> ScriptsProvided era
scriptsProvidedAlonzoStAnnTx

  scriptsNeededStAnnTx :: forall (l :: TxLevel).
StAnnTx l AlonzoEra -> ScriptsNeeded AlonzoEra
scriptsNeededStAnnTx = StAnnTx l AlonzoEra -> ScriptsNeeded AlonzoEra
AlonzoStAnnTx l AlonzoEra -> ScriptsNeeded AlonzoEra
forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era -> ScriptsNeeded era
scriptsNeededAlonzoStAnnTx

  plutusScriptsWithContextStAnnTx :: forall (l :: TxLevel).
StAnnTx l AlonzoEra
-> Either (NonEmpty (CollectError AlonzoEra)) [PlutusWithContext]
plutusScriptsWithContextStAnnTx = StAnnTx l AlonzoEra
-> Either (NonEmpty (CollectError AlonzoEra)) [PlutusWithContext]
AlonzoStAnnTx l AlonzoEra
-> Either (NonEmpty (CollectError AlonzoEra)) [PlutusWithContext]
forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
plutusScriptsWithContextAlonzoStAnnTx

  plutusLanguagesUsedStAnnTx :: forall (l :: TxLevel). StAnnTx l AlonzoEra -> Set Language
plutusLanguagesUsedStAnnTx = StAnnTx l AlonzoEra -> Set Language
AlonzoStAnnTx l AlonzoEra -> Set Language
forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era -> Set Language
plutusLanguagesUsedAlonzoStAnnTx

  refScriptsSizeStAnnTx :: StAnnTx TopTx AlonzoEra -> Int
refScriptsSizeStAnnTx = StAnnTx TopTx AlonzoEra -> Int
AlonzoStAnnTx TopTx AlonzoEra -> Int
forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era -> Int
refScriptsSizeAlonzoStAnnTx

  exUnitsStAnnTx :: StAnnTx TopTx AlonzoEra -> ExUnits
exUnitsStAnnTx = StAnnTx TopTx AlonzoEra -> ExUnits
AlonzoStAnnTx TopTx AlonzoEra -> ExUnits
forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era -> ExUnits
exUnitsAlonzoStAnnTx

scriptsProvidedAlonzoStAnnTx ::
  ( EraTxLevel era
  , STxLevel l era ~ STxTopLevel l era
  , STxLevel TopTx era ~ STxTopLevel TopTx era
  ) =>
  AlonzoStAnnTx l era -> ScriptsProvided era
scriptsProvidedAlonzoStAnnTx :: forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era -> ScriptsProvided era
scriptsProvidedAlonzoStAnnTx AlonzoStAnnTx l era
stAnnTx =
  AlonzoStAnnTx l era
-> (AlonzoStAnnTx TopTx era -> ScriptsProvided era)
-> ScriptsProvided era
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly AlonzoStAnnTx l era
stAnnTx ((AlonzoStAnnTx TopTx era -> ScriptsProvided era)
 -> ScriptsProvided era)
-> (AlonzoStAnnTx TopTx era -> ScriptsProvided era)
-> ScriptsProvided era
forall a b. (a -> b) -> a -> b
$ \AlonzoStAnnTx {ScriptsProvided era
asatScriptsProvided :: ScriptsProvided era
asatScriptsProvided :: forall era. AlonzoStAnnTx TopTx era -> ScriptsProvided era
asatScriptsProvided} -> ScriptsProvided era
asatScriptsProvided

scriptsNeededAlonzoStAnnTx ::
  ( EraTxLevel era
  , STxLevel l era ~ STxTopLevel l era
  , STxLevel TopTx era ~ STxTopLevel TopTx era
  ) =>
  AlonzoStAnnTx l era -> ScriptsNeeded era
scriptsNeededAlonzoStAnnTx :: forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era -> ScriptsNeeded era
scriptsNeededAlonzoStAnnTx AlonzoStAnnTx l era
stAnnTx =
  AlonzoStAnnTx l era
-> (AlonzoStAnnTx TopTx era -> ScriptsNeeded era)
-> ScriptsNeeded era
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly AlonzoStAnnTx l era
stAnnTx ((AlonzoStAnnTx TopTx era -> ScriptsNeeded era)
 -> ScriptsNeeded era)
-> (AlonzoStAnnTx TopTx era -> ScriptsNeeded era)
-> ScriptsNeeded era
forall a b. (a -> b) -> a -> b
$ \AlonzoStAnnTx {ScriptsNeeded era
asatScriptsNeeded :: ScriptsNeeded era
asatScriptsNeeded :: forall era. AlonzoStAnnTx TopTx era -> ScriptsNeeded era
asatScriptsNeeded} -> ScriptsNeeded era
asatScriptsNeeded

plutusScriptsWithContextAlonzoStAnnTx ::
  ( EraTxLevel era
  , STxLevel l era ~ STxTopLevel l era
  , STxLevel TopTx era ~ STxTopLevel TopTx era
  ) =>
  AlonzoStAnnTx l era ->
  Either (NonEmpty (CollectError era)) [PlutusWithContext]
plutusScriptsWithContextAlonzoStAnnTx :: forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
plutusScriptsWithContextAlonzoStAnnTx AlonzoStAnnTx l era
stAnnTx =
  AlonzoStAnnTx l era
-> (AlonzoStAnnTx TopTx era
    -> Either (NonEmpty (CollectError era)) [PlutusWithContext])
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly AlonzoStAnnTx l era
stAnnTx ((AlonzoStAnnTx TopTx era
  -> Either (NonEmpty (CollectError era)) [PlutusWithContext])
 -> Either (NonEmpty (CollectError era)) [PlutusWithContext])
-> (AlonzoStAnnTx TopTx era
    -> Either (NonEmpty (CollectError era)) [PlutusWithContext])
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall a b. (a -> b) -> a -> b
$
    \AlonzoStAnnTx {Either (NonEmpty (CollectError era)) [PlutusWithContext]
asatPlutusScriptsWithContext :: Either (NonEmpty (CollectError era)) [PlutusWithContext]
asatPlutusScriptsWithContext :: forall era.
AlonzoStAnnTx TopTx era
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
asatPlutusScriptsWithContext} -> Either (NonEmpty (CollectError era)) [PlutusWithContext]
asatPlutusScriptsWithContext

plutusLanguagesUsedAlonzoStAnnTx ::
  ( EraTxLevel era
  , STxLevel l era ~ STxTopLevel l era
  , STxLevel TopTx era ~ STxTopLevel TopTx era
  ) =>
  AlonzoStAnnTx l era -> Set.Set Language
plutusLanguagesUsedAlonzoStAnnTx :: forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxTopLevel l era,
 STxLevel TopTx era ~ STxTopLevel TopTx era) =>
AlonzoStAnnTx l era -> Set Language
plutusLanguagesUsedAlonzoStAnnTx AlonzoStAnnTx l era
stAnnTx =
  AlonzoStAnnTx l era
-> (AlonzoStAnnTx TopTx era -> Set Language) -> Set Language
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly AlonzoStAnnTx l era
stAnnTx ((AlonzoStAnnTx TopTx era -> Set Language) -> Set Language)
-> (AlonzoStAnnTx TopTx era -> Set Language) -> Set Language
forall a b. (a -> b) -> a -> b
$
    \AlonzoStAnnTx {Set Language
asatPlutusLanguagesUsed :: Set Language
asatPlutusLanguagesUsed :: forall era. AlonzoStAnnTx TopTx era -> Set Language
asatPlutusLanguagesUsed} -> Set Language
asatPlutusLanguagesUsed

getAlonzoSupplementalDataHashes ::
  (EraTxBody era, AlonzoEraTxOut era) =>
  TxBody l era ->
  Set.Set DataHash
getAlonzoSupplementalDataHashes :: forall era (l :: TxLevel).
(EraTxBody era, AlonzoEraTxOut era) =>
TxBody l era -> Set DataHash
getAlonzoSupplementalDataHashes TxBody l era
txBody =
  [DataHash] -> Set DataHash
forall a. Ord a => [a] -> Set a
Set.fromList
    [ DataHash
dh
    | TxOut era
txOut <- StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut era) -> [TxOut era])
-> StrictSeq (TxOut era) -> [TxOut era]
forall a b. (a -> b) -> a -> b
$ TxBody l era
txBody TxBody l era
-> Getting
     (StrictSeq (TxOut era)) (TxBody l era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody l era) (StrictSeq (TxOut era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL
    , SJust DataHash
dh <- [TxOut era
txOut TxOut era
-> Getting
     (StrictMaybe DataHash) (TxOut era) (StrictMaybe DataHash)
-> StrictMaybe DataHash
forall s a. s -> Getting a s a -> a
^. Getting (StrictMaybe DataHash) (TxOut era) (StrictMaybe DataHash)
forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
Lens' (TxOut era) (StrictMaybe DataHash)
dataHashTxOutL]
    ]

-- | Get the Data associated with a ScriptPurpose. Only the Spending ScriptPurpose
--  contains Data. Nothing is returned for the other kinds.
getAlonzoSpendingDatum ::
  (AlonzoEraTxWits era, AlonzoEraTxOut era, EraTx era) =>
  UTxO era ->
  Tx l era ->
  PlutusPurpose AsItem era ->
  Maybe (Data era)
getAlonzoSpendingDatum :: forall era (l :: TxLevel).
(AlonzoEraTxWits era, AlonzoEraTxOut era, EraTx era) =>
UTxO era
-> Tx l era -> PlutusPurpose AsItem era -> Maybe (Data era)
getAlonzoSpendingDatum (UTxO Map TxIn (TxOut era)
m) Tx l era
tx PlutusPurpose AsItem era
sp = do
  AsItem txIn <- PlutusPurpose AsItem era -> Maybe (AsItem Word32 TxIn)
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 TxIn)
forall (f :: * -> * -> *).
PlutusPurpose f era -> Maybe (f Word32 TxIn)
toSpendingPurpose PlutusPurpose AsItem era
sp
  txOut <- Map.lookup txIn m
  SJust hash <- Just $ txOut ^. dataHashTxOutL
  Map.lookup hash $ tx ^. witsTxL . datsTxWitsL . unTxDatsL

getAlonzoScriptsHashesNeeded :: AlonzoScriptsNeeded era -> Set.Set ScriptHash
getAlonzoScriptsHashesNeeded :: forall era. AlonzoScriptsNeeded era -> Set ScriptHash
getAlonzoScriptsHashesNeeded (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem era, ScriptHash)]
sn) = [ScriptHash] -> Set ScriptHash
forall a. Ord a => [a] -> Set a
Set.fromList (((PlutusPurpose AsIxItem era, ScriptHash) -> ScriptHash)
-> [(PlutusPurpose AsIxItem era, ScriptHash)] -> [ScriptHash]
forall a b. (a -> b) -> [a] -> [b]
map (PlutusPurpose AsIxItem era, ScriptHash) -> ScriptHash
forall a b. (a, b) -> b
snd [(PlutusPurpose AsIxItem era, ScriptHash)]
sn)

-- | Compute two sets for all TwoPhase scripts in a Tx.
--
--   1) DataHashes for each Two phase Script in a TxIn that has a DataHash
--   2) TxIns that are TwoPhase scripts, and should have a DataHash but don't.
--
-- @{ h | (_ → (a,_,h)) ∈ txins tx ◁ utxo, isNonNativeScriptAddress tx a}@
getInputDataHashesTxBody ::
  (EraTxBody era, AlonzoEraTxOut era, AlonzoEraScript era) =>
  UTxO era ->
  TxBody l era ->
  ScriptsProvided era ->
  (Set.Set DataHash, Set.Set TxIn)
getInputDataHashesTxBody :: forall era (l :: TxLevel).
(EraTxBody era, AlonzoEraTxOut era, AlonzoEraScript era) =>
UTxO era
-> TxBody l era -> ScriptsProvided era -> (Set DataHash, Set TxIn)
getInputDataHashesTxBody (UTxO Map TxIn (TxOut era)
utxo) TxBody l era
txBody (ScriptsProvided Map ScriptHash (Script era)
scriptsProvided) =
  ((Set DataHash, Set TxIn)
 -> TxIn -> TxOut era -> (Set DataHash, Set TxIn))
-> (Set DataHash, Set TxIn)
-> Map TxIn (TxOut era)
-> (Set DataHash, Set TxIn)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Set DataHash, Set TxIn)
-> TxIn -> TxOut era -> (Set DataHash, Set TxIn)
accum (Set DataHash
forall a. Set a
Set.empty, Set TxIn
forall a. Set a
Set.empty) Map TxIn (TxOut era)
spendUTxO
  where
    spendingPlutusScriptLanguage :: Addr -> Maybe Language
spendingPlutusScriptLanguage Addr
addr = do
      scriptHash <- Addr -> Maybe ScriptHash
getScriptHash Addr
addr
      plutusScript <- lookupPlutusScript scriptHash scriptsProvided
      pure $ plutusScriptLanguage plutusScript
    isSpendingPlutusScript :: Addr -> Bool
isSpendingPlutusScript = Maybe Language -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Language -> Bool)
-> (Addr -> Maybe Language) -> Addr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Maybe Language
spendingPlutusScriptLanguage
    spendInputs :: Set TxIn
spendInputs = TxBody l era
txBody TxBody l era
-> Getting (Set TxIn) (TxBody l era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody l era) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL
    spendUTxO :: Map TxIn (TxOut era)
spendUTxO = Map TxIn (TxOut era) -> Set TxIn -> Map TxIn (TxOut era)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn (TxOut era)
utxo Set TxIn
spendInputs
    accum :: (Set DataHash, Set TxIn)
-> TxIn -> TxOut era -> (Set DataHash, Set TxIn)
accum ans :: (Set DataHash, Set TxIn)
ans@(!Set DataHash
hashSet, !Set TxIn
inputSet) TxIn
txIn TxOut era
txOut =
      let addr :: Addr
addr = TxOut era
txOut TxOut era -> Getting Addr (TxOut era) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. Getting Addr (TxOut era) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut era) Addr
addrTxOutL
       in case TxOut era
txOut TxOut era
-> Getting (Datum era) (TxOut era) (Datum era) -> Datum era
forall s a. s -> Getting a s a -> a
^. Getting (Datum era) (TxOut era) (Datum era)
forall era.
AlonzoEraTxOut era =>
SimpleGetter (TxOut era) (Datum era)
SimpleGetter (TxOut era) (Datum era)
datumTxOutF of
            Datum era
NoDatum
              | Just Language
lang <- Addr -> Maybe Language
spendingPlutusScriptLanguage Addr
addr
              , -- Spending Datums are no longer required with PlutusV3. See: CIP-0069
                Language
lang Language -> Language -> Bool
forall a. Ord a => a -> a -> Bool
< Language
PlutusV3 ->
                  (Set DataHash
hashSet, TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => a -> Set a -> Set a
Set.insert TxIn
txIn Set TxIn
inputSet)
            DatumHash DataHash
dataHash
              | Addr -> Bool
isSpendingPlutusScript Addr
addr -> (DataHash -> Set DataHash -> Set DataHash
forall a. Ord a => a -> Set a -> Set a
Set.insert DataHash
dataHash Set DataHash
hashSet, Set TxIn
inputSet)
            -- Though it is somewhat odd to allow native scripts to include a datum,
            -- the Alonzo era already set the precedent with datum hashes, and several dapp
            -- developers see this as a helpful feature.
            Datum era
_ -> (Set DataHash, Set TxIn)
ans

-- |
-- Uses of inputs in ‘txscripts’ and ‘neededScripts’
-- There are currently 3 sets of inputs (spending, collateral, reference). A particular TxInput
-- can appear in more than one of the sets. Even in all three at the same, but that may not be
-- a really useful case. Inputs are where you find scripts with the 'Spending' purpose.
--
-- 1) Collateral inputs are only spent if phase two fails. Their corresponding TxOut can only have
--    Key (not Script) Pay credentials, so ‘neededScripts’ does not look there.
-- 2) Reference inputs are not spent in the current Tx, unless that same input also appears in one
--    of the other sets. If that is not the case, their credentials are never needed, so anyone can
--    access the inline datums and scripts in their corresponding TxOut, without needing any
--    authorizing credentials. So ‘neededScripts’ does not look there.
-- 3) Spending inputs are always spent. So their Pay credentials are always needed.
--
-- Collect information (purpose and ScriptHash) about all the Credentials that refer to scripts
-- that will be needed to run in a TxBody in the Utxow rule. Note there may be credentials that
-- cannot be run, so are not collected. In Babbage, reference inputs, fit that description.
-- Purposes include
-- 1) Spending (payment script credentials, but NOT staking scripts) in the Addr of a TxOut, pointed
--    to by some input that needs authorization. Be sure (txBody ^. inputsTxBodyL) gets all such inputs.
--    In some Eras there may be multiple sets of inputs, which ones should be included? Currently that
--    is only the spending inputs. Because collateral inputs can only have key-locked credentials,
--    and reference inputs are never authorized. That might not always be the case.
-- 2) Withdrawing,
-- 3) Minting (minted field), and
-- 4) Certifying (Delegating) scripts.
--
-- 'getAlonzoScriptsNeeded' is an aggregation of the needed Credentials referring to
-- Scripts used in Utxow rule.  The flip side of 'getAlonzoScriptsNeeded' (which collects
-- script hashes) is 'txscripts' which finds the actual scripts. We maintain an invariant
-- that every script credential refers to some actual script.  This is tested in the test
-- function 'validateMissingScripts' in the Utxow rule.
getAlonzoScriptsNeeded ::
  (MaryEraTxBody era, AlonzoEraScript era) =>
  UTxO era ->
  TxBody l era ->
  AlonzoScriptsNeeded era
getAlonzoScriptsNeeded :: forall era (l :: TxLevel).
(MaryEraTxBody era, AlonzoEraScript era) =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getAlonzoScriptsNeeded UTxO era
utxo TxBody l era
txBody =
  UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
forall era (l :: TxLevel).
(AlonzoEraScript era, EraTxBody era) =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getSpendingScriptsNeeded UTxO era
utxo TxBody l era
txBody
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> TxBody l era -> AlonzoScriptsNeeded era
forall era (l :: TxLevel).
(AlonzoEraScript era, EraTxBody era) =>
TxBody l era -> AlonzoScriptsNeeded era
getWithdrawingScriptsNeeded TxBody l era
txBody
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> AlonzoScriptsNeeded era
certifyingScriptsNeeded
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> TxBody l era -> AlonzoScriptsNeeded era
forall era (l :: TxLevel).
(AlonzoEraScript era, MaryEraTxBody era) =>
TxBody l era -> AlonzoScriptsNeeded era
getMintingScriptsNeeded TxBody l era
txBody
  where
    certifyingScriptsNeeded :: AlonzoScriptsNeeded era
certifyingScriptsNeeded =
      [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded ([(PlutusPurpose AsIxItem era, ScriptHash)]
 -> AlonzoScriptsNeeded era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall a b. (a -> b) -> a -> b
$
        case ((Map (TxCert era) Word32, Word32,
  [(PlutusPurpose AsIxItem era, ScriptHash)])
 -> TxCert era
 -> (Map (TxCert era) Word32, Word32,
     [(PlutusPurpose AsIxItem era, ScriptHash)]))
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash)])
-> StrictSeq (TxCert era)
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash)])
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (Map (TxCert era) Word32, Word32,
 [(PlutusPurpose AsIxItem era, ScriptHash)])
-> TxCert era
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash)])
forall {era}.
(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 ...),
 EraTxCert era, AlonzoEraScript era) =>
(Map (TxCert era) Word32, Word32,
 [(PlutusPurpose AsIxItem era, ScriptHash)])
-> TxCert era
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash)])
addUniqueTxCertPurpose (Map (TxCert era) Word32
forall k a. Map k a
Map.empty, Word32
0, []) (TxBody l era
txBody TxBody l era
-> Getting
     (StrictSeq (TxCert era)) (TxBody l era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody l era) (StrictSeq (TxCert era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL) of
          (Map (TxCert era) Word32
_, Word32
_, [(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes) -> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. [a] -> [a]
reverse [(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes
      where
        -- We need to do this funny index manipulation here because we've allowed
        -- duplicate certificates all the way until Conway. This prevented second
        -- occurance of a duplicate certificate in the sequence to be used. In order to
        -- preserve this behavior we need to use the index of the first occurrence of a
        -- duplicate certificate.
        --
        -- The `ix + 1` part is to count the actual index of each element. It is only when
        -- we see a duplicate we use the index of the first occurrence of the element, but
        -- that should not affect indices of other elements.
        --
        -- For example if these are our certificates:
        -- cert = [c0, c1, c2, c3, c4, c5]
        --
        -- Let's say `c3` is locked by a native script or a key witness, so it does not
        -- participate in the script purpose
        --
        -- Also, let's say `c1 == c4`. Here is what we should get for the plutus purpose:
        -- plutusPurpose = [(0, c0), (1, c1), (2, c2), (1, c4), (5, c5)]
        --
        -- The count must continue no matter what, thus the counter `ix + 1`, but
        -- whenever we find a duplicate we use the stored `ix'`.
        --
        addUniqueTxCertPurpose :: (Map (TxCert era) Word32, Word32,
 [(PlutusPurpose AsIxItem era, ScriptHash)])
-> TxCert era
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash)])
addUniqueTxCertPurpose (!Map (TxCert era) Word32
seenTxCerts, !Word32
ix, ![(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes) TxCert era
txCert =
          (Map (TxCert era) Word32, Word32,
 [(PlutusPurpose AsIxItem era, ScriptHash)])
-> Maybe
     (Map (TxCert era) Word32, Word32,
      [(PlutusPurpose AsIxItem era, ScriptHash)])
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash)])
forall a. a -> Maybe a -> a
fromMaybe (Map (TxCert era) Word32
seenTxCerts, Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1, [(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes) (Maybe
   (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash)])
 -> (Map (TxCert era) Word32, Word32,
     [(PlutusPurpose AsIxItem era, ScriptHash)]))
-> Maybe
     (Map (TxCert era) Word32, Word32,
      [(PlutusPurpose AsIxItem era, ScriptHash)])
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash)])
forall a b. (a -> b) -> a -> b
$ do
            scriptHash <- TxCert era -> Maybe ScriptHash
forall era. EraTxCert era => TxCert era -> Maybe ScriptHash
getScriptWitnessTxCert TxCert era
txCert
            case Map.lookup txCert seenTxCerts of
              Maybe Word32
Nothing -> do
                let !purpose :: PlutusPurpose AsIxItem era
purpose = AsIxItem Word32 (TxCert era) -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxCert era) -> PlutusPurpose f era
CertifyingPurpose (Word32 -> TxCert era -> AsIxItem Word32 (TxCert era)
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
ix TxCert era
txCert)
                    !certScriptHashes' :: Map (TxCert era) Word32
certScriptHashes' = TxCert era
-> Word32 -> Map (TxCert era) Word32 -> Map (TxCert era) Word32
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxCert era
txCert Word32
ix Map (TxCert era) Word32
seenTxCerts
                (Map (TxCert era) Word32, Word32,
 [(PlutusPurpose AsIxItem era, ScriptHash)])
-> Maybe
     (Map (TxCert era) Word32, Word32,
      [(PlutusPurpose AsIxItem era, ScriptHash)])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (TxCert era) Word32
certScriptHashes', Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1, (PlutusPurpose AsIxItem era
purpose, ScriptHash
scriptHash) (PlutusPurpose AsIxItem era, ScriptHash)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. a -> [a] -> [a]
: [(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes)
              Just Word32
ix' -> do
                let !purpose :: PlutusPurpose AsIxItem era
purpose = AsIxItem Word32 (TxCert era) -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxCert era) -> PlutusPurpose f era
CertifyingPurpose (Word32 -> TxCert era -> AsIxItem Word32 (TxCert era)
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
ix' TxCert era
txCert)
                (Map (TxCert era) Word32, Word32,
 [(PlutusPurpose AsIxItem era, ScriptHash)])
-> Maybe
     (Map (TxCert era) Word32, Word32,
      [(PlutusPurpose AsIxItem era, ScriptHash)])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (TxCert era) Word32
seenTxCerts, Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1, (PlutusPurpose AsIxItem era
purpose, ScriptHash
scriptHash) (PlutusPurpose AsIxItem era, ScriptHash)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. a -> [a] -> [a]
: [(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes)
{-# INLINEABLE getAlonzoScriptsNeeded #-}

zipAsIxItem :: Foldable f => f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem :: forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem f it
xs AsIxItem Word32 it -> c
f =
  -- Past experience showed that enumeration for Int is faster than for Word32
  (it -> Int -> c) -> [it] -> [Int] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\it
it Int
ix -> AsIxItem Word32 it -> c
f (Word32 -> it -> AsIxItem Word32 it
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word32 Int
ix) it
it)) (f it -> [it]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f it
xs) [Int
0 ..]
{-# INLINE zipAsIxItem #-}

getSpendingScriptsNeeded ::
  (AlonzoEraScript era, EraTxBody era) =>
  UTxO era ->
  TxBody l era ->
  AlonzoScriptsNeeded era
getSpendingScriptsNeeded :: forall era (l :: TxLevel).
(AlonzoEraScript era, EraTxBody era) =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getSpendingScriptsNeeded (UTxO Map TxIn (TxOut era)
utxo) TxBody l era
txBody =
  [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded ([(PlutusPurpose AsIxItem era, ScriptHash)]
 -> AlonzoScriptsNeeded era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall a b. (a -> b) -> a -> b
$
    [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
 -> [(PlutusPurpose AsIxItem era, ScriptHash)])
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
      Set TxIn
-> (AsIxItem Word32 TxIn
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (TxBody l era
txBody TxBody l era
-> Getting (Set TxIn) (TxBody l era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody l era) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL) ((AsIxItem Word32 TxIn
  -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
 -> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 TxIn
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
        \asIxItem :: AsIxItem Word32 TxIn
asIxItem@(AsIxItem Word32
_ TxIn
txIn) -> do
          addr <- Getting Addr (TxOut era) Addr -> TxOut era -> Addr
forall a s. Getting a s a -> s -> a
view Getting Addr (TxOut era) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut era) Addr
addrTxOutL (TxOut era -> Addr) -> Maybe (TxOut era) -> Maybe Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIn -> Map TxIn (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
txIn Map TxIn (TxOut era)
utxo
          hash <- getScriptHash addr
          return (SpendingPurpose asIxItem, hash)
{-# INLINEABLE getSpendingScriptsNeeded #-}

getWithdrawingScriptsNeeded ::
  (AlonzoEraScript era, EraTxBody era) =>
  TxBody l era ->
  AlonzoScriptsNeeded era
getWithdrawingScriptsNeeded :: forall era (l :: TxLevel).
(AlonzoEraScript era, EraTxBody era) =>
TxBody l era -> AlonzoScriptsNeeded era
getWithdrawingScriptsNeeded TxBody l era
txBody =
  [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded ([(PlutusPurpose AsIxItem era, ScriptHash)]
 -> AlonzoScriptsNeeded era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall a b. (a -> b) -> a -> b
$
    [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
 -> [(PlutusPurpose AsIxItem era, ScriptHash)])
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
      [AccountAddress]
-> (AsIxItem Word32 AccountAddress
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (Map AccountAddress Coin -> [AccountAddress]
forall k a. Map k a -> [k]
Map.keys (Withdrawals -> Map AccountAddress Coin
unWithdrawals (Withdrawals -> Map AccountAddress Coin)
-> Withdrawals -> Map AccountAddress Coin
forall a b. (a -> b) -> a -> b
$ TxBody l era
txBody TxBody l era
-> Getting Withdrawals (TxBody l era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody l era) Withdrawals
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL)) ((AsIxItem Word32 AccountAddress
  -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
 -> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 AccountAddress
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
        \asIxItem :: AsIxItem Word32 AccountAddress
asIxItem@(AsIxItem Word32
_ AccountAddress
accountAddress) -> (AsIxItem Word32 AccountAddress -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 AccountAddress -> PlutusPurpose f era
WithdrawingPurpose AsIxItem Word32 AccountAddress
asIxItem,) (ScriptHash -> (PlutusPurpose AsIxItem era, ScriptHash))
-> Maybe ScriptHash
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential Staking -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash (AccountAddress
accountAddress AccountAddress
-> Getting (Credential Staking) AccountAddress (Credential Staking)
-> Credential Staking
forall s a. s -> Getting a s a -> a
^. Getting (Credential Staking) AccountAddress (Credential Staking)
Lens' AccountAddress (Credential Staking)
accountAddressCredentialL)
{-# INLINEABLE getWithdrawingScriptsNeeded #-}

getRewardingScriptsNeeded ::
  (AlonzoEraScript era, EraTxBody era) =>
  TxBody l era ->
  AlonzoScriptsNeeded era
getRewardingScriptsNeeded :: forall era (l :: TxLevel).
(AlonzoEraScript era, EraTxBody era) =>
TxBody l era -> AlonzoScriptsNeeded era
getRewardingScriptsNeeded = TxBody l era -> AlonzoScriptsNeeded era
forall era (l :: TxLevel).
(AlonzoEraScript era, EraTxBody era) =>
TxBody l era -> AlonzoScriptsNeeded era
getWithdrawingScriptsNeeded
{-# DEPRECATED getRewardingScriptsNeeded "In favor of `getWithdrawingScriptsNeeded`" #-}

getMintingScriptsNeeded ::
  (AlonzoEraScript era, MaryEraTxBody era) =>
  TxBody l era ->
  AlonzoScriptsNeeded era
getMintingScriptsNeeded :: forall era (l :: TxLevel).
(AlonzoEraScript era, MaryEraTxBody era) =>
TxBody l era -> AlonzoScriptsNeeded era
getMintingScriptsNeeded TxBody l era
txBody =
  [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded ([(PlutusPurpose AsIxItem era, ScriptHash)]
 -> AlonzoScriptsNeeded era)
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
forall a b. (a -> b) -> a -> b
$
    Set PolicyID
-> (AsIxItem Word32 PolicyID
    -> (PlutusPurpose AsIxItem era, ScriptHash))
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (TxBody l era
txBody TxBody l era
-> Getting (Set PolicyID) (TxBody l era) (Set PolicyID)
-> Set PolicyID
forall s a. s -> Getting a s a -> a
^. Getting (Set PolicyID) (TxBody l era) (Set PolicyID)
forall era (l :: TxLevel).
MaryEraTxBody era =>
SimpleGetter (TxBody l era) (Set PolicyID)
forall (l :: TxLevel). SimpleGetter (TxBody l era) (Set PolicyID)
mintedTxBodyF) ((AsIxItem Word32 PolicyID
  -> (PlutusPurpose AsIxItem era, ScriptHash))
 -> [(PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 PolicyID
    -> (PlutusPurpose AsIxItem era, ScriptHash))
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
      \asIxItem :: AsIxItem Word32 PolicyID
asIxItem@(AsIxItem Word32
_ (PolicyID ScriptHash
scriptHash)) -> (AsIxItem Word32 PolicyID -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 PolicyID -> PlutusPurpose f era
MintingPurpose AsIxItem Word32 PolicyID
asIxItem, ScriptHash
scriptHash)
{-# INLINEABLE getMintingScriptsNeeded #-}

-- | Just like `getShelleyWitsVKeyNeeded`, but also requires `reqSignerHashesTxBodyL`.
getAlonzoWitsVKeyNeeded ::
  forall era l.
  ( EraTx era
  , AlonzoEraTxBody era
  , ShelleyEraTxBody era
  , EraCertState era
  , STxLevel l era ~ STxTopLevel l era
  ) =>
  CertState era ->
  UTxO era ->
  TxBody l era ->
  Set.Set (KeyHash Witness)
getAlonzoWitsVKeyNeeded :: forall era (l :: TxLevel).
(EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era,
 EraCertState era, STxLevel l era ~ STxTopLevel l era) =>
CertState era -> UTxO era -> TxBody l era -> Set (KeyHash Witness)
getAlonzoWitsVKeyNeeded CertState era
certState UTxO era
utxo TxBody l era
txBody =
  CertState era -> UTxO era -> TxBody l era -> Set (KeyHash Witness)
forall era (l :: TxLevel).
(EraTx era, ShelleyEraTxBody era, EraCertState era,
 STxLevel l era ~ STxTopLevel l era) =>
CertState era -> UTxO era -> TxBody l era -> Set (KeyHash Witness)
getShelleyWitsVKeyNeeded CertState era
certState UTxO era
utxo TxBody l era
txBody
    Set (KeyHash Witness)
-> Set (KeyHash Witness) -> Set (KeyHash Witness)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (KeyHash Guard -> KeyHash Witness)
-> Set (KeyHash Guard) -> Set (KeyHash Witness)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map KeyHash Guard -> KeyHash Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness (TxBody l era
txBody TxBody l era
-> Getting
     (Set (KeyHash Guard)) (TxBody l era) (Set (KeyHash Guard))
-> Set (KeyHash Guard)
forall s a. s -> Getting a s a -> a
^. Getting (Set (KeyHash Guard)) (TxBody l era) (Set (KeyHash Guard))
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
SimpleGetter (TxBody l era) (Set (KeyHash Guard))
forall (l :: TxLevel).
SimpleGetter (TxBody l era) (Set (KeyHash Guard))
reqSignerHashesTxBodyG)
{-# INLINEABLE getAlonzoWitsVKeyNeeded #-}

resolveNeededPlutusScriptsWithPurpose ::
  EraPlutusContext era =>
  ProtVer ->
  ScriptsProvided era ->
  AlonzoScriptsNeeded era ->
  -- | These are cached scripts. Make sure they were constructed using the exact same protocol
  -- version as the one supplied to this function.
  Map.Map ScriptHash (SupportedPlutusRunnable era) ->
  ( Map.Map ScriptHash (SupportedPlutusRunnable era)
  , [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
  )
resolveNeededPlutusScriptsWithPurpose :: forall era.
EraPlutusContext era =>
ProtVer
-> ScriptsProvided era
-> AlonzoScriptsNeeded era
-> Map ScriptHash (SupportedPlutusRunnable era)
-> (Map ScriptHash (SupportedPlutusRunnable era),
    [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)])
resolveNeededPlutusScriptsWithPurpose ProtVer
protVer ScriptsProvided era
scriptsProvided AlonzoScriptsNeeded era
scriptsNeeded Map ScriptHash (SupportedPlutusRunnable era)
plutusScriptsCache =
  (Map ScriptHash (SupportedPlutusRunnable era)
updatedPlutusScriptCache, [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
neededPlutusScriptsWithPurpose)
  where
    updatedPlutusScriptCache :: Map ScriptHash (SupportedPlutusRunnable era)
updatedPlutusScriptCache = Map ScriptHash (SupportedPlutusRunnable era)
plutusScriptsCache Map ScriptHash (SupportedPlutusRunnable era)
-> Map ScriptHash (SupportedPlutusRunnable era)
-> Map ScriptHash (SupportedPlutusRunnable era)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map ScriptHash (SupportedPlutusRunnable era)
plutusScriptsProvided
    neededPlutusScriptsWithPurpose :: [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
neededPlutusScriptsWithPurpose =
      [ (PlutusPurpose AsIxItem era
sp, SupportedPlutusRunnable era
s)
      | (PlutusPurpose AsIxItem era
sp, ScriptHash
sh) <- AlonzoScriptsNeeded era
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
forall era.
AlonzoScriptsNeeded era
-> [(PlutusPurpose AsIxItem era, ScriptHash)]
unAlonzoScriptsNeeded AlonzoScriptsNeeded era
scriptsNeeded
      , Just SupportedPlutusRunnable era
s <- [ScriptHash -> Maybe (SupportedPlutusRunnable era)
lookupPlutusScriptRunnable ScriptHash
sh]
      ]
    version :: Version
version = ProtVer -> Version
pvMajor ProtVer
protVer
    lookupPlutusScriptRunnable :: ScriptHash -> Maybe (SupportedPlutusRunnable era)
lookupPlutusScriptRunnable ScriptHash
sh =
      -- We must look into `plutusScriptsProvided`, before we can look for the same script in the
      -- `plutusScriptsCache`, since that cache can contain scripts from prior transactions in a
      -- block
      ScriptHash
-> Map ScriptHash (SupportedPlutusRunnable era)
-> Maybe (SupportedPlutusRunnable era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
sh Map ScriptHash (SupportedPlutusRunnable era)
plutusScriptsProvided Maybe (SupportedPlutusRunnable era)
-> (SupportedPlutusRunnable era -> SupportedPlutusRunnable era)
-> Maybe (SupportedPlutusRunnable era)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        SupportedPlutusRunnable PlutusRunnable l
plutusRunnable ->
          case ScriptHash
-> Map ScriptHash (SupportedPlutusRunnable era)
-> Maybe (SupportedPlutusRunnable era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
sh Map ScriptHash (SupportedPlutusRunnable era)
plutusScriptsCache of
            Just SupportedPlutusRunnable era
cachedPlutusRunnable -> SupportedPlutusRunnable era
cachedPlutusRunnable
            Maybe (SupportedPlutusRunnable era)
Nothing ->
              -- Avoid recomputing script hash
              PlutusRunnable l -> SupportedPlutusRunnable era
forall (l :: Language) era.
EraPlutusTxInfo l era =>
PlutusRunnable l -> SupportedPlutusRunnable era
SupportedPlutusRunnable (PlutusRunnable l -> SupportedPlutusRunnable era)
-> PlutusRunnable l -> SupportedPlutusRunnable era
forall a b. (a -> b) -> a -> b
$ PlutusRunnable l
plutusRunnable {plutusRunnableScriptHash = sh}
    plutusScriptsProvided :: Map ScriptHash (SupportedPlutusRunnable era)
plutusScriptsProvided =
      (Script era -> Maybe (SupportedPlutusRunnable era))
-> Map ScriptHash (Script era)
-> Map ScriptHash (SupportedPlutusRunnable era)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe ((PlutusScript era -> SupportedPlutusRunnable era)
-> Maybe (PlutusScript era) -> Maybe (SupportedPlutusRunnable era)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> PlutusScript era -> SupportedPlutusRunnable era
forall era.
EraPlutusContext era =>
Version -> PlutusScript era -> SupportedPlutusRunnable era
mkSupportedPlutusRunnable Version
version) (Maybe (PlutusScript era) -> Maybe (SupportedPlutusRunnable era))
-> (Script era -> Maybe (PlutusScript era))
-> Script era
-> Maybe (SupportedPlutusRunnable era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script era -> Maybe (PlutusScript era)
forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript) (Map ScriptHash (Script era)
 -> Map ScriptHash (SupportedPlutusRunnable era))
-> Map ScriptHash (Script era)
-> Map ScriptHash (SupportedPlutusRunnable era)
forall a b. (a -> b) -> a -> b
$
        ScriptsProvided era -> Map ScriptHash (Script era)
forall era. ScriptsProvided era -> Map ScriptHash (Script era)
unScriptsProvided ScriptsProvided era
scriptsProvided