{-# 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.TxWits (unTxDats)
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.CertState (CertState)
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,
 )
import Cardano.Ledger.TxIn
import Cardano.Ledger.UTxO (
  EraUTxO (..),
  ScriptsProvided (..),
  UTxO (..),
  getScriptHash,
 )
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 (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
mconcat :: [AlonzoScriptsNeeded era] -> AlonzoScriptsNeeded era
$cmconcat :: forall era. [AlonzoScriptsNeeded era] -> AlonzoScriptsNeeded era
mappend :: AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
$cmappend :: forall era.
AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
mempty :: AlonzoScriptsNeeded era
$cmempty :: forall era. AlonzoScriptsNeeded era
Monoid, NonEmpty (AlonzoScriptsNeeded era) -> AlonzoScriptsNeeded era
AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> 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
stimes :: forall b.
Integral b =>
b -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
$cstimes :: forall era b.
Integral b =>
b -> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
sconcat :: NonEmpty (AlonzoScriptsNeeded era) -> AlonzoScriptsNeeded era
$csconcat :: forall era.
NonEmpty (AlonzoScriptsNeeded era) -> AlonzoScriptsNeeded era
<> :: AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
$c<> :: forall era.
AlonzoScriptsNeeded era
-> 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

  getConsumedValue :: PParams AlonzoEra
-> (Credential 'Staking -> Maybe Coin)
-> (Credential 'DRepRole -> Maybe Coin)
-> UTxO AlonzoEra
-> TxBody AlonzoEra
-> Value AlonzoEra
getConsumedValue = 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 = 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 = forall era. Map ScriptHash (Script era) -> ScriptsProvided era
ScriptsProvided (Tx AlonzoEra
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL)

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

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

  getWitsVKeyNeeded :: CertState AlonzoEra
-> UTxO AlonzoEra -> TxBody AlonzoEra -> Set (KeyHash 'Witness)
getWitsVKeyNeeded = forall era.
(EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody 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
_ = 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
_ = forall era.
(EraTxBody era, AlonzoEraTxOut era) =>
TxBody era -> Set DataHash
getAlonzoSupplementalDataHashes

  getSpendingDatum :: UTxO AlonzoEra
-> Tx AlonzoEra
-> PlutusPurpose AsItem AlonzoEra
-> Maybe (Data AlonzoEra)
getSpendingDatum = 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 =
  forall a. Ord a => [a] -> Set a
Set.fromList
    [ DataHash
dh
    | TxOut era
txOut <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL
    , SJust DataHash
dh <- [TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxOut era =>
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 <- forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 TxIn)
toSpendingPurpose PlutusPurpose AsItem era
sp
  TxOut era
txOut <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
txIn Map TxIn (TxOut era)
m
  SJust DataHash
hash <- forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
dataHashTxOutL
  forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DataHash
hash (forall era. TxDats era -> Map DataHash (Data era)
unTxDats forall a b. (a -> b) -> a -> b
$ Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
datsTxWitsL)

getAlonzoScriptsHashesNeeded :: AlonzoScriptsNeeded era -> Set.Set ScriptHash
getAlonzoScriptsHashesNeeded :: forall era. AlonzoScriptsNeeded era -> Set ScriptHash
getAlonzoScriptsHashesNeeded (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem era, ScriptHash)]
sn) = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map 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) =
  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 (forall a. Set a
Set.empty, 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 <- forall era.
AlonzoEraScript era =>
ScriptHash
-> Map ScriptHash (Script era) -> Maybe (PlutusScript era)
lookupPlutusScript ScriptHash
scriptHash Map ScriptHash (Script era)
scriptsProvided
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutusScript
    isSpendingPlutusScript :: Addr -> Bool
isSpendingPlutusScript = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Maybe Language
spendingPlutusScriptLanguage
    spendInputs :: Set TxIn
spendInputs = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
    spendUTxO :: Map TxIn (TxOut era)
spendUTxO = forall s t. Embed s t => Exp t -> s
eval (Set TxIn
spendInputs 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 forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) Addr
addrTxOutL
       in case TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxOut 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 forall a. Ord a => a -> a -> Bool
< Language
PlutusV3 ->
                  (Set DataHash
hashSet, forall a. Ord a => a -> Set a -> Set a
Set.insert TxIn
txIn Set TxIn
inputSet)
            DatumHash DataHash
dataHash
              | Addr -> Bool
isSpendingPlutusScript Addr
addr -> (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 =
  forall era.
(AlonzoEraScript era, EraTxBody era) =>
UTxO era -> TxBody era -> AlonzoScriptsNeeded era
getSpendingScriptsNeeded UTxO era
utxo TxBody era
txBody
    forall a. Semigroup a => a -> a -> a
<> forall era.
(AlonzoEraScript era, EraTxBody era) =>
TxBody era -> AlonzoScriptsNeeded era
getRewardingScriptsNeeded TxBody era
txBody
    forall a. Semigroup a => a -> a -> a
<> AlonzoScriptsNeeded era
certifyingScriptsNeeded
    forall a. Semigroup a => a -> a -> a
<> forall era.
(AlonzoEraScript era, MaryEraTxBody era) =>
TxBody era -> AlonzoScriptsNeeded era
getMintingScriptsNeeded TxBody era
txBody
  where
    certifyingScriptsNeeded :: AlonzoScriptsNeeded era
certifyingScriptsNeeded =
      forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded forall a b. (a -> b) -> a -> b
$
        case forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall {era}.
(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 (forall k a. Map k a
Map.empty, Word32
0, []) (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL) of
          (Map (TxCert era) Word32
_, Word32
_, [(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes) -> 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 =
          forall a. a -> Maybe a -> a
fromMaybe (Map (TxCert era) Word32
seenTxCerts, Word32
ix forall a. Num a => a -> a -> a
+ Word32
1, [(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes) forall a b. (a -> b) -> a -> b
$ do
            ScriptHash
scriptHash <- forall era. EraTxCert era => TxCert era -> Maybe ScriptHash
getScriptWitnessTxCert TxCert era
txCert
            case 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 = forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxCert era) -> PlutusPurpose f era
CertifyingPurpose (forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
ix TxCert era
txCert)
                    !certScriptHashes' :: Map (TxCert era) Word32
certScriptHashes' = 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
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (TxCert era) Word32
certScriptHashes', Word32
ix forall a. Num a => a -> a -> a
+ Word32
1, (PlutusPurpose AsIxItem era
purpose, ScriptHash
scriptHash) forall a. a -> [a] -> [a]
: [(PlutusPurpose AsIxItem era, ScriptHash)]
certPurposes)
              Just Word32
ix' -> do
                let !purpose :: PlutusPurpose AsIxItem era
purpose = forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxCert era) -> PlutusPurpose f era
CertifyingPurpose (forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
ix' TxCert era
txCert)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (TxCert era) Word32
seenTxCerts, Word32
ix forall a. Num a => a -> a -> a
+ Word32
1, (PlutusPurpose AsIxItem era
purpose, ScriptHash
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
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\it
it Int
ix -> AsIxItem Word32 it -> c
f (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)) (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 =
  forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded forall a b. (a -> b) -> a -> b
$
    forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
inputsTxBodyL) forall a b. (a -> b) -> a -> b
$
        \asIxItem :: AsIxItem Word32 TxIn
asIxItem@(AsIxItem Word32
_ TxIn
txIn) -> do
          Addr
addr <- forall a s. Getting a s a -> s -> a
view forall era. EraTxOut era => Lens' (TxOut era) Addr
addrTxOutL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
          forall (m :: * -> *) a. Monad m => a -> m a
return (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 =
  forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded forall a b. (a -> b) -> a -> b
$
    forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
      forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (forall k a. Map k a -> [k]
Map.keys (Withdrawals -> Map RewardAccount Coin
unWithdrawals forall a b. (a -> b) -> a -> b
$ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL)) forall a b. (a -> b) -> a -> b
$
        \asIxItem :: AsIxItem Word32 RewardAccount
asIxItem@(AsIxItem Word32
_ RewardAccount
rewardAccount) ->
          (forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 RewardAccount -> PlutusPurpose f era
RewardingPurpose AsIxItem Word32 RewardAccount
asIxItem,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 =
  forall era.
[(PlutusPurpose AsIxItem era, ScriptHash)]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) it c.
Foldable f =>
f it -> (AsIxItem Word32 it -> c) -> [c]
zipAsIxItem (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
SimpleGetter (TxBody era) (Set PolicyID)
mintedTxBodyF) forall a b. (a -> b) -> a -> b
$
      \asIxItem :: AsIxItem Word32 PolicyID
asIxItem@(AsIxItem Word32
_ (PolicyID ScriptHash
scriptHash)) -> (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) =>
  CertState era ->
  UTxO era ->
  TxBody era ->
  Set.Set (KeyHash 'Witness)
getAlonzoWitsVKeyNeeded :: forall era.
(EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era) =>
CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getAlonzoWitsVKeyNeeded CertState era
certState UTxO era
utxo TxBody era
txBody =
  forall era.
(EraTx era, ShelleyEraTxBody era) =>
CertState era -> UTxO era -> TxBody era -> Set (KeyHash 'Witness)
getShelleyWitsVKeyNeeded CertState era
certState UTxO era
utxo TxBody era
txBody
    forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL)
{-# INLINEABLE getAlonzoWitsVKeyNeeded #-}