{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# 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.TxWits (unTxDats)
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.CertState (CertState)
import Cardano.Ledger.Credential (credScriptHash)
import Cardano.Ledger.Crypto
import Cardano.Ledger.Keys (KeyHash, KeyRole (Witness))
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 (EraCrypto era))]
  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 Crypto c => EraUTxO (AlonzoEra c) where
  type ScriptsNeeded (AlonzoEra c) = AlonzoScriptsNeeded (AlonzoEra c)

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

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

  getScriptsProvided :: UTxO (AlonzoEra c)
-> Tx (AlonzoEra c) -> ScriptsProvided (AlonzoEra c)
getScriptsProvided UTxO (AlonzoEra c)
_ Tx (AlonzoEra c)
tx = forall era.
Map (ScriptHash (EraCrypto era)) (Script era)
-> ScriptsProvided era
ScriptsProvided (Tx (AlonzoEra c)
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 (EraCrypto era)) (Script era))
scriptTxWitsL)

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

  getScriptsHashesNeeded :: ScriptsNeeded (AlonzoEra c)
-> Set (ScriptHash (EraCrypto (AlonzoEra c)))
getScriptsHashesNeeded = forall era.
AlonzoScriptsNeeded era -> Set (ScriptHash (EraCrypto era))
getAlonzoScriptsHashesNeeded

  getWitsVKeyNeeded :: CertState (AlonzoEra c)
-> UTxO (AlonzoEra c)
-> TxBody (AlonzoEra c)
-> Set (KeyHash 'Witness (EraCrypto (AlonzoEra c)))
getWitsVKeyNeeded = forall era.
(EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era) =>
CertState era
-> UTxO era -> TxBody era -> Set (KeyHash 'Witness (EraCrypto era))
getAlonzoWitsVKeyNeeded

  getMinFeeTxUtxo :: PParams (AlonzoEra c)
-> Tx (AlonzoEra c) -> UTxO (AlonzoEra c) -> Coin
getMinFeeTxUtxo PParams (AlonzoEra c)
pp Tx (AlonzoEra c)
tx UTxO (AlonzoEra c)
_ = forall era. EraTx era => PParams era -> Tx era -> Coin
getShelleyMinFeeTxUtxo PParams (AlonzoEra c)
pp Tx (AlonzoEra c)
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 (EraCrypto era))

  -- | 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 Crypto c => AlonzoEraUTxO (AlonzoEra c) where
  getSupplementalDataHashes :: UTxO (AlonzoEra c)
-> TxBody (AlonzoEra c) -> Set (DataHash (EraCrypto (AlonzoEra c)))
getSupplementalDataHashes UTxO (AlonzoEra c)
_ = forall era.
(EraTxBody era, AlonzoEraTxOut era) =>
TxBody era -> Set (DataHash (EraCrypto era))
getAlonzoSupplementalDataHashes

  getSpendingDatum :: UTxO (AlonzoEra c)
-> Tx (AlonzoEra c)
-> PlutusPurpose AsItem (AlonzoEra c)
-> Maybe (Data (AlonzoEra c))
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 (EraCrypto era))
getAlonzoSupplementalDataHashes :: forall era.
(EraTxBody era, AlonzoEraTxOut era) =>
TxBody era -> Set (DataHash (EraCrypto era))
getAlonzoSupplementalDataHashes TxBody era
txBody =
  forall a. Ord a => [a] -> Set a
Set.fromList
    [ DataHash (EraCrypto era)
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 (EraCrypto era)
dh <- [TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (DataHash (EraCrypto era)))
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 (EraCrypto era)) (TxOut era)
m) Tx era
tx PlutusPurpose AsItem era
sp = do
  AsItem TxIn (EraCrypto era)
txIn <- forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 (TxIn (EraCrypto era)))
toSpendingPurpose PlutusPurpose AsItem era
sp
  TxOut era
txOut <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn (EraCrypto era)
txIn Map (TxIn (EraCrypto era)) (TxOut era)
m
  SJust DataHash (EraCrypto era)
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 (EraCrypto era)))
dataHashTxOutL
  forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DataHash (EraCrypto era)
hash (forall era. TxDats era -> Map (DataHash (EraCrypto era)) (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 (EraCrypto era))
getAlonzoScriptsHashesNeeded :: forall era.
AlonzoScriptsNeeded era -> Set (ScriptHash (EraCrypto era))
getAlonzoScriptsHashesNeeded (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
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 (EraCrypto era))]
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 (EraCrypto era)), Set.Set (TxIn (EraCrypto era)))
getInputDataHashesTxBody :: forall era.
(EraTxBody era, AlonzoEraTxOut era, AlonzoEraScript era) =>
UTxO era
-> TxBody era
-> ScriptsProvided era
-> (Set (DataHash (EraCrypto era)), Set (TxIn (EraCrypto era)))
getInputDataHashesTxBody (UTxO Map (TxIn (EraCrypto era)) (TxOut era)
utxo) TxBody era
txBody (ScriptsProvided Map (ScriptHash (EraCrypto era)) (Script era)
scriptsProvided) =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Set (DataHash (EraCrypto era)), Set (TxIn (EraCrypto era)))
-> TxIn (EraCrypto era)
-> TxOut era
-> (Set (DataHash (EraCrypto era)), Set (TxIn (EraCrypto era)))
accum (forall a. Set a
Set.empty, forall a. Set a
Set.empty) Map (TxIn (EraCrypto era)) (TxOut era)
spendUTxO
  where
    spendingPlutusScriptLanguage :: Addr (EraCrypto era) -> Maybe Language
spendingPlutusScriptLanguage Addr (EraCrypto era)
addr = do
      ScriptHash (EraCrypto era)
scriptHash <- forall c. Addr c -> Maybe (ScriptHash c)
getScriptHash Addr (EraCrypto era)
addr
      PlutusScript era
plutusScript <- forall era.
AlonzoEraScript era =>
ScriptHash (EraCrypto era)
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Maybe (PlutusScript era)
lookupPlutusScript ScriptHash (EraCrypto era)
scriptHash Map (ScriptHash (EraCrypto era)) (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 (EraCrypto era) -> Bool
isSpendingPlutusScript = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr (EraCrypto era) -> Maybe Language
spendingPlutusScriptLanguage
    spendInputs :: Set (TxIn (EraCrypto era))
spendInputs = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL
    spendUTxO :: Map (TxIn (EraCrypto era)) (TxOut era)
spendUTxO = forall s t. Embed s t => Exp t -> s
eval (Set (TxIn (EraCrypto era))
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 (EraCrypto era)) (TxOut era)
utxo)
    accum :: (Set (DataHash (EraCrypto era)), Set (TxIn (EraCrypto era)))
-> TxIn (EraCrypto era)
-> TxOut era
-> (Set (DataHash (EraCrypto era)), Set (TxIn (EraCrypto era)))
accum ans :: (Set (DataHash (EraCrypto era)), Set (TxIn (EraCrypto era)))
ans@(!Set (DataHash (EraCrypto era))
hashSet, !Set (TxIn (EraCrypto era))
inputSet) TxIn (EraCrypto era)
txIn TxOut era
txOut =
      let addr :: Addr (EraCrypto era)
addr = TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
EraTxOut era =>
Lens' (TxOut era) (Addr (EraCrypto era))
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 (EraCrypto era) -> Maybe Language
spendingPlutusScriptLanguage Addr (EraCrypto era)
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 (EraCrypto era))
hashSet, forall a. Ord a => a -> Set a -> Set a
Set.insert TxIn (EraCrypto era)
txIn Set (TxIn (EraCrypto era))
inputSet)
            DatumHash DataHash (EraCrypto era)
dataHash
              | Addr (EraCrypto era) -> Bool
isSpendingPlutusScript Addr (EraCrypto era)
addr -> (forall a. Ord a => a -> Set a -> Set a
Set.insert DataHash (EraCrypto era)
dataHash Set (DataHash (EraCrypto era))
hashSet, Set (TxIn (EraCrypto era))
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 (EraCrypto era)), Set (TxIn (EraCrypto era)))
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 (EraCrypto era))]
-> 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 (EraCrypto era))])
-> TxCert era
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))])
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 (EraCrypto era))]
certPurposes) -> forall a. [a] -> [a]
reverse [(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
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 (EraCrypto era))])
-> TxCert era
-> (Map (TxCert era) Word32, Word32,
    [(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))])
addUniqueTxCertPurpose (!Map (TxCert era) Word32
seenTxCerts, !Word32
ix, ![(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
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 (EraCrypto era))]
certPurposes) forall a b. (a -> b) -> a -> b
$ do
            ScriptHash (EraCrypto era)
scriptHash <- forall era.
EraTxCert era =>
TxCert era -> Maybe (ScriptHash (EraCrypto era))
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 (EraCrypto era)
scriptHash) forall a. a -> [a] -> [a]
: [(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
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 (EraCrypto era)
scriptHash) forall a. a -> [a] -> [a]
: [(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
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 (EraCrypto era)) (TxOut era)
utxo) TxBody era
txBody =
  forall era.
[(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
-> 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 (EraCrypto era)))
inputsTxBodyL) forall a b. (a -> b) -> a -> b
$
        \asIxItem :: AsIxItem Word32 (TxIn (EraCrypto era))
asIxItem@(AsIxItem Word32
_ TxIn (EraCrypto era)
txIn) -> do
          Addr (EraCrypto era)
addr <- forall a s. Getting a s a -> s -> a
view forall era.
EraTxOut era =>
Lens' (TxOut era) (Addr (EraCrypto era))
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 (EraCrypto era)
txIn Map (TxIn (EraCrypto era)) (TxOut era)
utxo
          ScriptHash (EraCrypto era)
hash <- forall c. Addr c -> Maybe (ScriptHash c)
getScriptHash Addr (EraCrypto era)
addr
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxIn (EraCrypto era)) -> PlutusPurpose f era
SpendingPurpose AsIxItem Word32 (TxIn (EraCrypto era))
asIxItem, ScriptHash (EraCrypto era)
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 (EraCrypto era))]
-> 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 (forall c. Withdrawals c -> Map (RewardAccount c) 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 (EraCrypto era))
withdrawalsTxBodyL)) forall a b. (a -> b) -> a -> b
$
        \asIxItem :: AsIxItem Word32 (RewardAccount (EraCrypto era))
asIxItem@(AsIxItem Word32
_ RewardAccount (EraCrypto era)
rewardAccount) ->
          (forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (RewardAccount (EraCrypto era)) -> PlutusPurpose f era
RewardingPurpose AsIxItem Word32 (RewardAccount (EraCrypto era))
asIxItem,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (kr :: KeyRole) c. Credential kr c -> Maybe (ScriptHash c)
credScriptHash (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
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 (EraCrypto era))]
-> 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 (EraCrypto era)))
mintedTxBodyF) forall a b. (a -> b) -> a -> b
$
      \asIxItem :: AsIxItem Word32 (PolicyID (EraCrypto era))
asIxItem@(AsIxItem Word32
_ (PolicyID ScriptHash (EraCrypto era)
scriptHash)) -> (forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (PolicyID (EraCrypto era)) -> PlutusPurpose f era
MintingPurpose AsIxItem Word32 (PolicyID (EraCrypto era))
asIxItem, ScriptHash (EraCrypto era)
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 (EraCrypto era))
getAlonzoWitsVKeyNeeded :: forall era.
(EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era) =>
CertState era
-> UTxO era -> TxBody era -> Set (KeyHash 'Witness (EraCrypto era))
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 (EraCrypto era))
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 (EraCrypto era)))
reqSignerHashesTxBodyL)
{-# INLINEABLE getAlonzoWitsVKeyNeeded #-}