{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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,
  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.Keys (asWitness)
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 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 [(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)

instance EraUTxO AlonzoEra where
  type ScriptsNeeded AlonzoEra = AlonzoScriptsNeeded AlonzoEra

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

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

  getProducedValue :: forall (t :: TxLevel).
PParams AlonzoEra
-> (KeyHash StakePool -> Bool)
-> TxBody t AlonzoEra
-> Value AlonzoEra
getProducedValue PParams AlonzoEra
pp KeyHash StakePool -> Bool
isRegPoolId TxBody t AlonzoEra
txBody =
    TxBody t AlonzoEra
-> (TxBody TopTx AlonzoEra -> MaryValue) -> MaryValue
forall (t :: TxLevel -> * -> *) era (l :: TxLevel) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly TxBody t AlonzoEra
txBody (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 PParams AlonzoEra
pp KeyHash StakePool -> Bool
isRegPoolId)

  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

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)

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

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 = 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 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
getRewardingScriptsNeeded 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 #-}

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
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 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 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 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 #-}