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

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

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

  -- * Datums needed
  getInputDataHashesTxBody,

  -- * WitsVKey needed
  getAlonzoWitsVKeyNeeded,
) where

import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.Scripts (lookupPlutusScript, plutusScriptLanguage)
import Cardano.Ledger.Alonzo.State ()
import Cardano.Ledger.Alonzo.TxWits (unTxDatsL)
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Credential (credScriptHash)
import Cardano.Ledger.Mary.UTxO (getConsumedMaryValue, getProducedMaryValue)
import Cardano.Ledger.Mary.Value (PolicyID (..))
import Cardano.Ledger.Plutus (Language (..))
import Cardano.Ledger.Plutus.Data (Data, Datum (..))
import Cardano.Ledger.Shelley.TxBody (raCredential)
import Cardano.Ledger.Shelley.UTxO (
  getShelleyMinFeeTxUtxo,
  getShelleyWitsVKeyNeeded,
  shelleyConsumed,
 )
import Cardano.Ledger.State (
  EraCertState (..),
  EraUTxO (..),
  ScriptsProvided (..),
  UTxO (..),
  getScriptHash,
 )
import Cardano.Ledger.TxIn
import Control.SetAlgebra (eval, (◁))
import Data.Foldable as F (foldl', toList)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe, isJust)
import qualified Data.Set as Set
import Data.Word (Word32)
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)

-- | Alonzo era style `ScriptsNeeded` require also a `PlutusPurpose`, not only the `ScriptHash`
newtype AlonzoScriptsNeeded era
  = AlonzoScriptsNeeded [(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)

deriving instance AlonzoEraScript era => Eq (AlonzoScriptsNeeded era)

deriving instance AlonzoEraScript era => Show (AlonzoScriptsNeeded era)

instance EraUTxO AlonzoEra where
  type ScriptsNeeded AlonzoEra = AlonzoScriptsNeeded AlonzoEra

  consumed :: PParams AlonzoEra
-> CertState AlonzoEra
-> UTxO AlonzoEra
-> TxBody AlonzoEra
-> Value AlonzoEra
consumed = PParams AlonzoEra
-> CertState AlonzoEra
-> UTxO AlonzoEra
-> TxBody AlonzoEra
-> Value AlonzoEra
forall era.
(EraUTxO era, EraCertState era) =>
PParams era -> CertState era -> UTxO era -> TxBody era -> Value era
shelleyConsumed

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

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

  getScriptsProvided :: UTxO AlonzoEra -> Tx AlonzoEra -> ScriptsProvided AlonzoEra
getScriptsProvided UTxO AlonzoEra
_ Tx AlonzoEra
tx = Map ScriptHash (Script AlonzoEra) -> ScriptsProvided AlonzoEra
forall era. Map ScriptHash (Script era) -> ScriptsProvided era
ScriptsProvided (Tx AlonzoEra
AlonzoTx AlonzoEra
tx AlonzoTx AlonzoEra
-> Getting
     (Map ScriptHash (AlonzoScript AlonzoEra))
     (AlonzoTx 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 AlonzoEra
-> Const (Map ScriptHash (AlonzoScript AlonzoEra)) (Tx AlonzoEra)
(TxWits AlonzoEra
 -> Const
      (Map ScriptHash (AlonzoScript AlonzoEra)) (TxWits AlonzoEra))
-> AlonzoTx AlonzoEra
-> Const
     (Map ScriptHash (AlonzoScript AlonzoEra)) (AlonzoTx AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx AlonzoEra) (TxWits AlonzoEra)
witsTxL ((TxWits AlonzoEra
  -> Const
       (Map ScriptHash (AlonzoScript AlonzoEra)) (TxWits AlonzoEra))
 -> AlonzoTx AlonzoEra
 -> Const
      (Map ScriptHash (AlonzoScript AlonzoEra)) (AlonzoTx AlonzoEra))
-> ((Map ScriptHash (AlonzoScript AlonzoEra)
     -> Const
          (Map ScriptHash (AlonzoScript AlonzoEra))
          (Map ScriptHash (AlonzoScript AlonzoEra)))
    -> TxWits AlonzoEra
    -> Const
         (Map ScriptHash (AlonzoScript AlonzoEra)) (TxWits AlonzoEra))
-> Getting
     (Map ScriptHash (AlonzoScript AlonzoEra))
     (AlonzoTx 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)))
-> TxWits AlonzoEra
-> Const
     (Map ScriptHash (AlonzoScript AlonzoEra)) (TxWits AlonzoEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits AlonzoEra) (Map ScriptHash (Script AlonzoEra))
scriptTxWitsL)

  getScriptsNeeded :: UTxO AlonzoEra -> TxBody AlonzoEra -> ScriptsNeeded AlonzoEra
getScriptsNeeded = UTxO AlonzoEra -> TxBody AlonzoEra -> ScriptsNeeded AlonzoEra
UTxO AlonzoEra -> TxBody AlonzoEra -> AlonzoScriptsNeeded AlonzoEra
forall era.
(MaryEraTxBody era, AlonzoEraScript era) =>
UTxO era -> TxBody 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 :: CertState AlonzoEra
-> UTxO AlonzoEra -> TxBody AlonzoEra -> Set (KeyHash 'Witness)
getWitsVKeyNeeded = CertState AlonzoEra
-> UTxO AlonzoEra -> TxBody AlonzoEra -> Set (KeyHash 'Witness)
forall era.
(EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era,
 EraCertState era) =>
CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getAlonzoWitsVKeyNeeded

  getMinFeeTxUtxo :: PParams AlonzoEra -> Tx AlonzoEra -> UTxO AlonzoEra -> Coin
getMinFeeTxUtxo PParams AlonzoEra
pp Tx AlonzoEra
tx UTxO AlonzoEra
_ = PParams AlonzoEra -> Tx AlonzoEra -> Coin
forall era. EraTx era => PParams era -> Tx era -> Coin
getShelleyMinFeeTxUtxo PParams AlonzoEra
pp Tx AlonzoEra
tx

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 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 era ->
    PlutusPurpose AsItem era ->
    Maybe (Data era)

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

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

getAlonzoSupplementalDataHashes ::
  (EraTxBody era, AlonzoEraTxOut era) =>
  TxBody era ->
  Set.Set DataHash
getAlonzoSupplementalDataHashes :: forall era.
(EraTxBody era, AlonzoEraTxOut era) =>
TxBody era -> Set DataHash
getAlonzoSupplementalDataHashes TxBody 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 era
txBody TxBody era
-> Getting
     (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody 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 era ->
  PlutusPurpose AsItem era ->
  Maybe (Data era)
getAlonzoSpendingDatum :: forall era.
(AlonzoEraTxWits era, AlonzoEraTxOut era, EraTx era) =>
UTxO era -> Tx era -> PlutusPurpose AsItem era -> Maybe (Data era)
getAlonzoSpendingDatum (UTxO Map TxIn (TxOut era)
m) Tx era
tx PlutusPurpose AsItem era
sp = do
  AsItem TxIn
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 era
txOut <- 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)
m
  SJust DataHash
hash <- StrictMaybe DataHash -> Maybe (StrictMaybe DataHash)
forall a. a -> Maybe a
Just (StrictMaybe DataHash -> Maybe (StrictMaybe DataHash))
-> StrictMaybe DataHash -> Maybe (StrictMaybe DataHash)
forall a b. (a -> b) -> a -> b
$ 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
  DataHash -> Map DataHash (Data era) -> Maybe (Data era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DataHash
hash (Map DataHash (Data era) -> Maybe (Data era))
-> Map DataHash (Data era) -> Maybe (Data era)
forall a b. (a -> b) -> a -> b
$ Tx era
tx Tx era
-> Getting
     (Map DataHash (Data era)) (Tx era) (Map DataHash (Data era))
-> Map DataHash (Data era)
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
-> Tx era -> Const (Map DataHash (Data era)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
 -> Tx era -> Const (Map DataHash (Data era)) (Tx era))
-> ((Map DataHash (Data era)
     -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
    -> TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
-> Getting
     (Map DataHash (Data era)) (Tx era) (Map DataHash (Data era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
-> TxWits era -> Const (Map DataHash (Data era)) (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
 -> TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
-> ((Map DataHash (Data era)
     -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
    -> TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
-> (Map DataHash (Data era)
    -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
-> TxWits era
-> Const (Map DataHash (Data era)) (TxWits era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map DataHash (Data era)
 -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
-> TxDats era -> Const (Map DataHash (Data era)) (TxDats era)
forall era. Era era => Lens' (TxDats era) (Map DataHash (Data era))
Lens' (TxDats era) (Map DataHash (Data era))
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 era ->
  ScriptsProvided era ->
  (Set.Set DataHash, Set.Set TxIn)
getInputDataHashesTxBody :: forall era.
(EraTxBody era, AlonzoEraTxOut era, AlonzoEraScript era) =>
UTxO era
-> TxBody era -> ScriptsProvided era -> (Set DataHash, Set TxIn)
getInputDataHashesTxBody (UTxO Map TxIn (TxOut era)
utxo) TxBody 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
scriptHash <- Addr -> Maybe ScriptHash
getScriptHash Addr
addr
      PlutusScript era
plutusScript <- ScriptHash
-> Map ScriptHash (Script era) -> Maybe (PlutusScript era)
forall era.
AlonzoEraScript era =>
ScriptHash
-> Map ScriptHash (Script era) -> Maybe (PlutusScript era)
lookupPlutusScript ScriptHash
scriptHash Map ScriptHash (Script era)
scriptsProvided
      Language -> Maybe Language
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Language -> Maybe Language) -> Language -> Maybe Language
forall a b. (a -> b) -> a -> b
$ PlutusScript era -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
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 era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
    spendUTxO :: Map TxIn (TxOut era)
spendUTxO = Exp (Map TxIn (TxOut era)) -> Map TxIn (TxOut era)
forall s t. Embed s t => Exp t -> s
eval (Set TxIn
spendInputs Set TxIn -> Map TxIn (TxOut era) -> Exp (Map TxIn (TxOut era))
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
◁ Map TxIn (TxOut era)
utxo)
    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) Rewarding (Withdrawals),
-- 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 era ->
  AlonzoScriptsNeeded era
getAlonzoScriptsNeeded :: forall era.
(MaryEraTxBody era, AlonzoEraScript era) =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getAlonzoScriptsNeeded UTxO era
utxo TxBody era
txBody =
  UTxO era -> TxBody era -> AlonzoScriptsNeeded era
forall era.
(AlonzoEraScript era, EraTxBody era) =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getSpendingScriptsNeeded UTxO era
utxo TxBody era
txBody
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> TxBody era -> AlonzoScriptsNeeded era
forall era.
(AlonzoEraScript era, EraTxBody era) =>
TxBody era -> AlonzoScriptsNeeded era
getRewardingScriptsNeeded TxBody 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 era -> AlonzoScriptsNeeded era
forall era.
(AlonzoEraScript era, MaryEraTxBody era) =>
TxBody era -> AlonzoScriptsNeeded era
getMintingScriptsNeeded TxBody 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 era
txBody TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody 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
scriptHash <- TxCert era -> Maybe ScriptHash
forall era. EraTxCert era => TxCert era -> Maybe ScriptHash
getScriptWitnessTxCert TxCert era
txCert
            case TxCert era -> Map (TxCert era) Word32 -> Maybe Word32
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxCert era
txCert Map (TxCert era) Word32
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 era ->
  AlonzoScriptsNeeded era
getSpendingScriptsNeeded :: forall era.
(AlonzoEraScript era, EraTxBody era) =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getSpendingScriptsNeeded (UTxO Map TxIn (TxOut era)
utxo) TxBody 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 era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody 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
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
          ScriptHash
hash <- Addr -> Maybe ScriptHash
getScriptHash Addr
addr
          (PlutusPurpose AsIxItem era, ScriptHash)
-> Maybe (PlutusPurpose AsIxItem era, ScriptHash)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (AsIxItem Word32 TxIn -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose AsIxItem Word32 TxIn
asIxItem, ScriptHash
hash)
{-# INLINEABLE getSpendingScriptsNeeded #-}

getRewardingScriptsNeeded ::
  (AlonzoEraScript era, EraTxBody era) =>
  TxBody era ->
  AlonzoScriptsNeeded era
getRewardingScriptsNeeded :: forall era.
(AlonzoEraScript era, EraTxBody era) =>
TxBody era -> AlonzoScriptsNeeded era
getRewardingScriptsNeeded TxBody 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
$
      [RewardAccount]
-> (AsIxItem Word32 RewardAccount
    -> 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 RewardAccount Coin -> [RewardAccount]
forall k a. Map k a -> [k]
Map.keys (Withdrawals -> Map RewardAccount Coin
unWithdrawals (Withdrawals -> Map RewardAccount Coin)
-> Withdrawals -> Map RewardAccount Coin
forall a b. (a -> b) -> a -> b
$ TxBody era
txBody TxBody era
-> Getting Withdrawals (TxBody era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody era) Withdrawals
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL)) ((AsIxItem Word32 RewardAccount
  -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
 -> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 RewardAccount
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
        \asIxItem :: AsIxItem Word32 RewardAccount
asIxItem@(AsIxItem Word32
_ RewardAccount
rewardAccount) ->
          (AsIxItem Word32 RewardAccount -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 RewardAccount -> PlutusPurpose f era
RewardingPurpose AsIxItem Word32 RewardAccount
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 (RewardAccount -> Credential 'Staking
raCredential RewardAccount
rewardAccount)
{-# INLINEABLE getRewardingScriptsNeeded #-}

getMintingScriptsNeeded ::
  (AlonzoEraScript era, MaryEraTxBody era) =>
  TxBody era ->
  AlonzoScriptsNeeded era
getMintingScriptsNeeded :: forall era.
(AlonzoEraScript era, MaryEraTxBody era) =>
TxBody era -> AlonzoScriptsNeeded era
getMintingScriptsNeeded TxBody 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 era
txBody TxBody era
-> Getting (Set PolicyID) (TxBody era) (Set PolicyID)
-> Set PolicyID
forall s a. s -> Getting a s a -> a
^. Getting (Set PolicyID) (TxBody era) (Set PolicyID)
forall era.
MaryEraTxBody era =>
SimpleGetter (TxBody era) (Set PolicyID)
SimpleGetter (TxBody 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.
  (EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era, EraCertState era) =>
  CertState era ->
  UTxO era ->
  TxBody era ->
  Set.Set (KeyHash 'Witness)
getAlonzoWitsVKeyNeeded :: forall era.
(EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era,
 EraCertState era) =>
CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getAlonzoWitsVKeyNeeded CertState era
certState UTxO era
utxo TxBody era
txBody =
  CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
forall era.
(EraTx era, ShelleyEraTxBody era, EraCertState era) =>
CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getShelleyWitsVKeyNeeded CertState era
certState UTxO era
utxo TxBody era
txBody
    Set (KeyHash 'Witness)
-> Set (KeyHash 'Witness) -> Set (KeyHash 'Witness)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (TxBody era
txBody TxBody era
-> Getting
     (Set (KeyHash 'Witness)) (TxBody era) (Set (KeyHash 'Witness))
-> Set (KeyHash 'Witness)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (KeyHash 'Witness)) (TxBody era) (Set (KeyHash 'Witness))
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
Lens' (TxBody era) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL)
{-# INLINEABLE getAlonzoWitsVKeyNeeded #-}