{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Dijkstra.UTxO (
  getDijkstraScriptsNeeded,
  getDijkstraScriptsProvided,
  scriptsProvidedDijkstraStAnnTx,
  batchNonDistinctRefScriptsSize,
) where

import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO (..),
  AlonzoScriptsNeeded (..),
  getAlonzoScriptsHashesNeeded,
  zipAsIxItem,
 )
import Cardano.Ledger.Babbage.UTxO (
  getBabbageScriptsProvided,
  getBabbageSpendingDatum,
  getBabbageSupplementalDataHashes,
 )
import Cardano.Ledger.BaseTypes (inject)
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.UTxO (
  conwayConsumed,
  conwayProducedValue,
  getConwayMinFeeTxUtxo,
  getConwayScriptsNeeded,
  getConwayWitsVKeyNeeded,
  txNonDistinctRefScriptsSize,
 )
import Cardano.Ledger.Credential (Credential, credScriptHash)
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
import Cardano.Ledger.Dijkstra.Scripts (DijkstraEraScript (..), pattern GuardingPurpose)
import Cardano.Ledger.Dijkstra.State
import Cardano.Ledger.Dijkstra.Tx (DijkstraStAnnTx (..))
import Cardano.Ledger.Mary.UTxO (burnedMultiAssets, getConsumedMaryValue)
import Cardano.Ledger.Mary.Value (MaryValue (..))
import Data.Foldable (Foldable (..))
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import Data.Monoid (Sum (..))
import qualified Data.OMap.Strict as OMap
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)

getConsumedDijkstraValue ::
  forall era l.
  ( DijkstraEraTxBody era
  , EraUTxO era
  , Value era ~ MaryValue
  , STxLevel l era ~ STxBothLevels l era
  ) =>
  PParams era ->
  (Credential Staking -> Maybe Coin) ->
  (Credential DRepRole -> Maybe Coin) ->
  UTxO era ->
  TxBody l era ->
  Value era
getConsumedDijkstraValue :: forall era (l :: TxLevel).
(DijkstraEraTxBody era, EraUTxO era, Value era ~ MaryValue,
 STxLevel l era ~ STxBothLevels l era) =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody l era
-> Value era
getConsumedDijkstraValue PParams era
pp Credential Staking -> Maybe Coin
lookupStakingDeposit Credential DRepRole -> Maybe Coin
lookupDRepDeposit UTxO era
utxo TxBody l era
txBody =
  TxBody l era
-> (TxBody TopTx era -> MaryValue)
-> (TxBody SubTx era -> MaryValue)
-> MaryValue
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxBothLevels l era) =>
t l era -> (t TopTx era -> a) -> (t SubTx era -> a) -> a
withBothTxLevels
    TxBody l era
txBody
    ( \TxBody TopTx era
topTxBody ->
        TxBody TopTx era -> Value era
forall (m :: TxLevel). TxBody m era -> Value era
txBodyConsumedValue TxBody TopTx era
topTxBody MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> TxBody TopTx era -> MaryValue
subTransactionsConsumedValue TxBody TopTx era
topTxBody
    )
    TxBody SubTx era -> Value era
TxBody SubTx era -> MaryValue
forall (m :: TxLevel). TxBody m era -> Value era
txBodyConsumedValue
  where
    txBodyConsumedValue :: forall m. TxBody m era -> Value era
    txBodyConsumedValue :: forall (m :: TxLevel). TxBody m era -> Value era
txBodyConsumedValue = PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody m era
-> 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 PParams era
pp Credential Staking -> Maybe Coin
lookupStakingDeposit Credential DRepRole -> Maybe Coin
lookupDRepDeposit UTxO era
utxo
    subTransactionsConsumedValue :: TxBody TopTx era -> MaryValue
subTransactionsConsumedValue TxBody TopTx era
topTxBody =
      (Tx SubTx era -> MaryValue)
-> OMap TxId (Tx SubTx era) -> MaryValue
forall m a. Monoid m => (a -> m) -> OMap TxId a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap'
        (PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody SubTx era
-> Value era
forall era (t :: TxLevel).
EraUTxO era =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody t era
-> Value era
forall (t :: TxLevel).
PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody t era
-> Value era
getConsumedValue PParams era
pp Credential Staking -> Maybe Coin
lookupStakingDeposit Credential DRepRole -> Maybe Coin
lookupDRepDeposit UTxO era
utxo (TxBody SubTx era -> MaryValue)
-> (Tx SubTx era -> TxBody SubTx era) -> Tx SubTx era -> MaryValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx era)
-> Tx SubTx era -> TxBody SubTx era
forall a s. Getting a s a -> s -> a
view Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL)
        (TxBody TopTx era
topTxBody TxBody TopTx era
-> Getting
     (OMap TxId (Tx SubTx era))
     (TxBody TopTx era)
     (OMap TxId (Tx SubTx era))
-> OMap TxId (Tx SubTx era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OMap TxId (Tx SubTx era))
  (TxBody TopTx era)
  (OMap TxId (Tx SubTx era))
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL)

dijkstraProducedValue ::
  ( DijkstraEraTxBody era
  , EraUTxO era
  , Value era ~ MaryValue
  ) =>
  PParams era ->
  (KeyHash StakePool -> Bool) ->
  TxBody TopTx era ->
  MaryValue
dijkstraProducedValue :: forall era.
(DijkstraEraTxBody era, EraUTxO era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> MaryValue
dijkstraProducedValue PParams era
pp KeyHash StakePool -> Bool
isRegPoolId TxBody TopTx era
txBody =
  PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> Value era
forall era.
(ConwayEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> Value era
conwayProducedValue PParams era
pp KeyHash StakePool -> Bool
isRegPoolId TxBody TopTx era
txBody
    MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> (Tx SubTx era -> MaryValue)
-> OMap TxId (Tx SubTx era) -> MaryValue
forall m a. Monoid m => (a -> m) -> OMap TxId a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap'
      (PParams era
-> (KeyHash StakePool -> Bool) -> TxBody SubTx era -> Value era
forall era (t :: TxLevel).
EraUTxO era =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody t era -> Value era
forall (t :: TxLevel).
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody t era -> Value era
getProducedValue PParams era
pp KeyHash StakePool -> Bool
isRegPoolId (TxBody SubTx era -> MaryValue)
-> (Tx SubTx era -> TxBody SubTx era) -> Tx SubTx era -> MaryValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx era)
-> Tx SubTx era -> TxBody SubTx era
forall a s. Getting a s a -> s -> a
view Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL)
      (TxBody TopTx era
txBody TxBody TopTx era
-> Getting
     (OMap TxId (Tx SubTx era))
     (TxBody TopTx era)
     (OMap TxId (Tx SubTx era))
-> OMap TxId (Tx SubTx era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OMap TxId (Tx SubTx era))
  (TxBody TopTx era)
  (OMap TxId (Tx SubTx era))
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL)

getProducedDijkstraValue ::
  ( STxLevel l era ~ STxBothLevels l era
  , DijkstraEraTxBody era
  , EraUTxO era
  , Value era ~ MaryValue
  ) =>
  PParams era ->
  (KeyHash StakePool -> Bool) ->
  TxBody l era ->
  MaryValue
getProducedDijkstraValue :: forall (l :: TxLevel) era.
(STxLevel l era ~ STxBothLevels l era, DijkstraEraTxBody era,
 EraUTxO era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody l era -> MaryValue
getProducedDijkstraValue PParams era
pp KeyHash StakePool -> Bool
isRegPoolId TxBody l era
txBody =
  TxBody l era
-> (TxBody TopTx era -> MaryValue)
-> (TxBody SubTx era -> MaryValue)
-> MaryValue
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxBothLevels l era) =>
t l era -> (t TopTx era -> a) -> (t SubTx era -> a) -> a
withBothTxLevels
    TxBody l era
txBody
    (PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> MaryValue
forall era.
(DijkstraEraTxBody era, EraUTxO era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> MaryValue
dijkstraProducedValue PParams era
pp KeyHash StakePool -> Bool
isRegPoolId)
    (PParams era
-> (KeyHash StakePool -> Bool) -> TxBody SubTx era -> Value era
forall era.
(ConwayEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody SubTx era -> Value era
dijkstraSubTxProducedValue PParams era
pp KeyHash StakePool -> Bool
isRegPoolId)

instance EraUTxO DijkstraEra where
  type ScriptsNeeded DijkstraEra = AlonzoScriptsNeeded DijkstraEra

  consumed :: forall (t :: TxLevel).
PParams DijkstraEra
-> CertState DijkstraEra
-> UTxO DijkstraEra
-> TxBody t DijkstraEra
-> Value DijkstraEra
consumed = PParams DijkstraEra
-> CertState DijkstraEra
-> UTxO DijkstraEra
-> TxBody t DijkstraEra
-> Value DijkstraEra
forall era (l :: TxLevel).
(EraUTxO era, ConwayEraCertState era) =>
PParams era
-> CertState era -> UTxO era -> TxBody l era -> Value era
conwayConsumed

  getConsumedValue :: forall (t :: TxLevel).
PParams DijkstraEra
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO DijkstraEra
-> TxBody t DijkstraEra
-> Value DijkstraEra
getConsumedValue = PParams DijkstraEra
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO DijkstraEra
-> TxBody t DijkstraEra
-> Value DijkstraEra
forall era (l :: TxLevel).
(DijkstraEraTxBody era, EraUTxO era, Value era ~ MaryValue,
 STxLevel l era ~ STxBothLevels l era) =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> (Credential DRepRole -> Maybe Coin)
-> UTxO era
-> TxBody l era
-> Value era
getConsumedDijkstraValue

  getProducedValue :: forall (t :: TxLevel).
PParams DijkstraEra
-> (KeyHash StakePool -> Bool)
-> TxBody t DijkstraEra
-> Value DijkstraEra
getProducedValue = PParams DijkstraEra
-> (KeyHash StakePool -> Bool)
-> TxBody t DijkstraEra
-> Value DijkstraEra
PParams DijkstraEra
-> (KeyHash StakePool -> Bool) -> TxBody t DijkstraEra -> MaryValue
forall (l :: TxLevel) era.
(STxLevel l era ~ STxBothLevels l era, DijkstraEraTxBody era,
 EraUTxO era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody l era -> MaryValue
getProducedDijkstraValue

  getScriptsProvided :: forall (t :: TxLevel).
UTxO DijkstraEra -> Tx t DijkstraEra -> ScriptsProvided DijkstraEra
getScriptsProvided = UTxO DijkstraEra -> Tx t DijkstraEra -> ScriptsProvided DijkstraEra
forall era (l :: TxLevel).
(EraTx era, DijkstraEraTxBody era,
 STxLevel l era ~ STxBothLevels l era) =>
UTxO era -> Tx l era -> ScriptsProvided era
getDijkstraScriptsProvided

  getScriptsNeeded :: forall (t :: TxLevel).
UTxO DijkstraEra
-> TxBody t DijkstraEra -> ScriptsNeeded DijkstraEra
getScriptsNeeded = UTxO DijkstraEra
-> TxBody t DijkstraEra -> ScriptsNeeded DijkstraEra
UTxO DijkstraEra
-> TxBody t DijkstraEra -> AlonzoScriptsNeeded DijkstraEra
forall era (l :: TxLevel).
(DijkstraEraTxBody era, DijkstraEraScript era) =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getDijkstraScriptsNeeded

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

  getWitsVKeyNeeded :: forall (t :: TxLevel).
CertState DijkstraEra
-> UTxO DijkstraEra
-> TxBody t DijkstraEra
-> Set (KeyHash Witness)
getWitsVKeyNeeded CertState DijkstraEra
_ = UTxO DijkstraEra -> TxBody t DijkstraEra -> Set (KeyHash Witness)
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era) =>
UTxO era -> TxBody l era -> Set (KeyHash Witness)
getConwayWitsVKeyNeeded

  getMinFeeTxUtxo :: forall (t :: TxLevel).
PParams DijkstraEra -> Tx t DijkstraEra -> UTxO DijkstraEra -> Coin
getMinFeeTxUtxo = PParams DijkstraEra -> Tx t DijkstraEra -> UTxO DijkstraEra -> Coin
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
PParams era -> Tx l era -> UTxO era -> Coin
getConwayMinFeeTxUtxo

-- | Like 'getBabbageScriptsProvided', but for 'TopTx' also aggregates
-- scripts from all subtransactions.
getDijkstraScriptsProvided ::
  ( EraTx era
  , DijkstraEraTxBody era
  , STxLevel l era ~ STxBothLevels l era
  ) =>
  UTxO era ->
  Tx l era ->
  ScriptsProvided era
getDijkstraScriptsProvided :: forall era (l :: TxLevel).
(EraTx era, DijkstraEraTxBody era,
 STxLevel l era ~ STxBothLevels l era) =>
UTxO era -> Tx l era -> ScriptsProvided era
getDijkstraScriptsProvided UTxO era
utxo Tx l era
tx =
  Tx l era
-> (Tx TopTx era -> ScriptsProvided era)
-> (Tx SubTx era -> ScriptsProvided era)
-> ScriptsProvided era
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxBothLevels l era) =>
t l era -> (t TopTx era -> a) -> (t SubTx era -> a) -> a
withBothTxLevels
    Tx l era
tx
    ( \Tx TopTx era
topTx ->
        Map ScriptHash (Script era) -> ScriptsProvided era
forall era. Map ScriptHash (Script era) -> ScriptsProvided era
ScriptsProvided (Map ScriptHash (Script era) -> ScriptsProvided era)
-> Map ScriptHash (Script era) -> ScriptsProvided era
forall a b. (a -> b) -> a -> b
$
          [Map ScriptHash (Script era)] -> Map ScriptHash (Script era)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map ScriptHash (Script era)] -> Map ScriptHash (Script era))
-> [Map ScriptHash (Script era)] -> Map ScriptHash (Script era)
forall a b. (a -> b) -> a -> b
$
            ScriptsProvided era -> Map ScriptHash (Script era)
forall era. ScriptsProvided era -> Map ScriptHash (Script era)
unScriptsProvided (UTxO era -> Tx TopTx era -> ScriptsProvided era
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> ScriptsProvided era
getBabbageScriptsProvided UTxO era
utxo Tx TopTx era
topTx)
              Map ScriptHash (Script era)
-> [Map ScriptHash (Script era)] -> [Map ScriptHash (Script era)]
forall a. a -> [a] -> [a]
: [ ScriptsProvided era -> Map ScriptHash (Script era)
forall era. ScriptsProvided era -> Map ScriptHash (Script era)
unScriptsProvided (UTxO era -> Tx SubTx era -> ScriptsProvided era
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> ScriptsProvided era
getBabbageScriptsProvided UTxO era
utxo Tx SubTx era
subTx)
                | Tx SubTx era
subTx <- OMap TxId (Tx SubTx era) -> [Tx SubTx era]
forall k v. Ord k => OMap k v -> [v]
OMap.elems (Tx TopTx era
topTx Tx TopTx era
-> Getting
     (OMap TxId (Tx SubTx era))
     (Tx TopTx era)
     (OMap TxId (Tx SubTx era))
-> OMap TxId (Tx SubTx era)
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era
 -> Const (OMap TxId (Tx SubTx era)) (TxBody TopTx era))
-> Tx TopTx era -> Const (OMap TxId (Tx SubTx era)) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era
  -> Const (OMap TxId (Tx SubTx era)) (TxBody TopTx era))
 -> Tx TopTx era -> Const (OMap TxId (Tx SubTx era)) (Tx TopTx era))
-> ((OMap TxId (Tx SubTx era)
     -> Const (OMap TxId (Tx SubTx era)) (OMap TxId (Tx SubTx era)))
    -> TxBody TopTx era
    -> Const (OMap TxId (Tx SubTx era)) (TxBody TopTx era))
-> Getting
     (OMap TxId (Tx SubTx era))
     (Tx TopTx era)
     (OMap TxId (Tx SubTx era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OMap TxId (Tx SubTx era)
 -> Const (OMap TxId (Tx SubTx era)) (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era
-> Const (OMap TxId (Tx SubTx era)) (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL)
                ]
    )
    (UTxO era -> Tx SubTx era -> ScriptsProvided era
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> ScriptsProvided era
getBabbageScriptsProvided UTxO era
utxo)

getDijkstraScriptsNeeded ::
  (DijkstraEraTxBody era, DijkstraEraScript era) =>
  UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getDijkstraScriptsNeeded :: forall era (l :: TxLevel).
(DijkstraEraTxBody era, DijkstraEraScript era) =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getDijkstraScriptsNeeded UTxO era
utxo TxBody l era
txb =
  UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
forall era (l :: TxLevel).
ConwayEraTxBody era =>
UTxO era -> TxBody l era -> AlonzoScriptsNeeded era
getConwayScriptsNeeded UTxO era
utxo TxBody l era
txb
    AlonzoScriptsNeeded era
-> AlonzoScriptsNeeded era -> AlonzoScriptsNeeded era
forall a. Semigroup a => a -> a -> a
<> AlonzoScriptsNeeded era
guardingScriptsNeeded
  where
    guardingScriptsNeeded :: AlonzoScriptsNeeded era
guardingScriptsNeeded = [(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
$
        OSet (Credential Guard)
-> (AsIxItem Word32 (Credential Guard)
    -> 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
txb TxBody l era
-> Getting
     (OSet (Credential Guard)) (TxBody l era) (OSet (Credential Guard))
-> OSet (Credential Guard)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (Credential Guard)) (TxBody l era) (OSet (Credential Guard))
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (OSet (Credential Guard))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (Credential Guard))
guardsTxBodyL) ((AsIxItem Word32 (Credential Guard)
  -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
 -> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)])
-> (AsIxItem Word32 (Credential Guard)
    -> Maybe (PlutusPurpose AsIxItem era, ScriptHash))
-> [Maybe (PlutusPurpose AsIxItem era, ScriptHash)]
forall a b. (a -> b) -> a -> b
$
          \(AsIxItem Word32
idx Credential Guard
cred) -> (\ScriptHash
sh -> (AsIxItem Word32 ScriptHash -> PlutusPurpose AsIxItem era
forall era (f :: * -> * -> *).
DijkstraEraScript era =>
f Word32 ScriptHash -> PlutusPurpose f era
GuardingPurpose (Word32 -> ScriptHash -> AsIxItem Word32 ScriptHash
forall ix it. ix -> it -> AsIxItem ix it
AsIxItem Word32
idx ScriptHash
sh), ScriptHash
sh)) (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 Guard -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential Guard
cred

instance AlonzoEraUTxO DijkstraEra where
  getSupplementalDataHashes :: forall (l :: TxLevel).
UTxO DijkstraEra -> TxBody l DijkstraEra -> Set DataHash
getSupplementalDataHashes = UTxO DijkstraEra -> TxBody l DijkstraEra -> Set DataHash
forall era (l :: TxLevel).
BabbageEraTxBody era =>
UTxO era -> TxBody l era -> Set DataHash
getBabbageSupplementalDataHashes

  getSpendingDatum :: forall (l :: TxLevel).
UTxO DijkstraEra
-> Tx l DijkstraEra
-> PlutusPurpose AsItem DijkstraEra
-> Maybe (Data DijkstraEra)
getSpendingDatum = UTxO DijkstraEra
-> Tx l DijkstraEra
-> PlutusPurpose AsItem DijkstraEra
-> Maybe (Data DijkstraEra)
forall era (l :: TxLevel).
(AlonzoEraTx era, BabbageEraTxOut era) =>
UTxO era
-> Tx l era -> PlutusPurpose AsItem era -> Maybe (Data era)
getBabbageSpendingDatum

  scriptsProvidedStAnnTx :: forall (l :: TxLevel).
StAnnTx l DijkstraEra -> ScriptsProvided DijkstraEra
scriptsProvidedStAnnTx = StAnnTx l DijkstraEra -> ScriptsProvided DijkstraEra
DijkstraStAnnTx l DijkstraEra -> ScriptsProvided DijkstraEra
forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxBothLevels l era,
 STxLevel SubTx era ~ STxBothLevels SubTx era,
 STxLevel TopTx era ~ STxBothLevels TopTx era) =>
DijkstraStAnnTx l era -> ScriptsProvided era
scriptsProvidedDijkstraStAnnTx

scriptsProvidedDijkstraStAnnTx ::
  ( EraTxLevel era
  , STxLevel l era ~ STxBothLevels l era
  , STxLevel SubTx era ~ STxBothLevels SubTx era
  , STxLevel TopTx era ~ STxBothLevels TopTx era
  ) =>
  DijkstraStAnnTx l era -> ScriptsProvided era
scriptsProvidedDijkstraStAnnTx :: forall era (l :: TxLevel).
(EraTxLevel era, STxLevel l era ~ STxBothLevels l era,
 STxLevel SubTx era ~ STxBothLevels SubTx era,
 STxLevel TopTx era ~ STxBothLevels TopTx era) =>
DijkstraStAnnTx l era -> ScriptsProvided era
scriptsProvidedDijkstraStAnnTx DijkstraStAnnTx l era
stAnnTx =
  DijkstraStAnnTx l era
-> (DijkstraStAnnTx TopTx era -> ScriptsProvided era)
-> (DijkstraStAnnTx SubTx era -> ScriptsProvided era)
-> ScriptsProvided era
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxBothLevels l era) =>
t l era -> (t TopTx era -> a) -> (t SubTx era -> a) -> a
withBothTxLevels
    DijkstraStAnnTx l era
stAnnTx
    (\DijkstraStAnnTopTx {ScriptsProvided era
dsattScriptsProvided :: ScriptsProvided era
dsattScriptsProvided :: forall era. DijkstraStAnnTx TopTx era -> ScriptsProvided era
dsattScriptsProvided} -> ScriptsProvided era
dsattScriptsProvided)
    (\DijkstraStAnnSubTx {ScriptsProvided era
dsastScriptsProvided :: ScriptsProvided era
dsastScriptsProvided :: forall era. DijkstraStAnnTx SubTx era -> ScriptsProvided era
dsastScriptsProvided} -> ScriptsProvided era
dsastScriptsProvided)

dijkstraSubTxProducedValue ::
  (ConwayEraTxBody era, Value era ~ MaryValue) =>
  PParams era ->
  (KeyHash StakePool -> Bool) ->
  TxBody SubTx era ->
  Value era
dijkstraSubTxProducedValue :: forall era.
(ConwayEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody SubTx era -> Value era
dijkstraSubTxProducedValue PParams era
pp KeyHash StakePool -> Bool
isRegPoolId TxBody SubTx era
txBody =
  StrictSeq (TxOut era) -> Value era
forall era (f :: * -> *).
(EraTxOut era, Foldable f) =>
f (TxOut era) -> Value era
sumAllValue (TxBody SubTx era
txBody TxBody SubTx era
-> Getting
     (StrictSeq (TxOut era)) (TxBody SubTx era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody SubTx 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)
    MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (PParams era
-> (KeyHash StakePool -> Bool) -> TxBody SubTx era -> Coin
forall era (l :: TxLevel).
EraTxBody era =>
PParams era -> (KeyHash StakePool -> Bool) -> TxBody l era -> Coin
forall (l :: TxLevel).
PParams era -> (KeyHash StakePool -> Bool) -> TxBody l era -> Coin
getTotalDepositsTxBody PParams era
pp KeyHash StakePool -> Bool
isRegPoolId TxBody SubTx era
txBody Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> TxBody SubTx era
txBody TxBody SubTx era -> Getting Coin (TxBody SubTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody SubTx era) Coin
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) Coin
forall (l :: TxLevel). Lens' (TxBody l era) Coin
treasuryDonationTxBodyL)
    MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> TxBody SubTx era -> MaryValue
forall era (l :: TxLevel).
MaryEraTxBody era =>
TxBody l era -> MaryValue
burnedMultiAssets TxBody SubTx era
txBody

-- | Total size of reference scripts across a top-level transaction and all its subtransactions.
batchNonDistinctRefScriptsSize ::
  ( EraTx era
  , DijkstraEraTxBody era
  ) =>
  UTxO era ->
  Tx TopTx era ->
  Int
batchNonDistinctRefScriptsSize :: forall era.
(EraTx era, DijkstraEraTxBody era) =>
UTxO era -> Tx TopTx era -> Int
batchNonDistinctRefScriptsSize UTxO era
utxo Tx TopTx era
tx =
  UTxO era -> Tx TopTx era -> Int
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> Int
txNonDistinctRefScriptsSize UTxO era
utxo Tx TopTx era
tx
    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Sum Int -> Int
forall a. Sum a -> a
getSum
      ( (Tx SubTx era -> Sum Int) -> OMap TxId (Tx SubTx era) -> Sum Int
forall m a. Monoid m => (a -> m) -> OMap TxId a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap'
          (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int)
-> (Tx SubTx era -> Int) -> Tx SubTx era -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO era -> Tx SubTx era -> Int
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> Int
txNonDistinctRefScriptsSize UTxO era
utxo)
          (Tx TopTx era
tx Tx TopTx era
-> Getting
     (OMap TxId (Tx SubTx era))
     (Tx TopTx era)
     (OMap TxId (Tx SubTx era))
-> OMap TxId (Tx SubTx era)
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era
 -> Const (OMap TxId (Tx SubTx era)) (TxBody TopTx era))
-> Tx TopTx era -> Const (OMap TxId (Tx SubTx era)) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era
  -> Const (OMap TxId (Tx SubTx era)) (TxBody TopTx era))
 -> Tx TopTx era -> Const (OMap TxId (Tx SubTx era)) (Tx TopTx era))
-> ((OMap TxId (Tx SubTx era)
     -> Const (OMap TxId (Tx SubTx era)) (OMap TxId (Tx SubTx era)))
    -> TxBody TopTx era
    -> Const (OMap TxId (Tx SubTx era)) (TxBody TopTx era))
-> Getting
     (OMap TxId (Tx SubTx era))
     (Tx TopTx era)
     (OMap TxId (Tx SubTx era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OMap TxId (Tx SubTx era)
 -> Const (OMap TxId (Tx SubTx era)) (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era
-> Const (OMap TxId (Tx SubTx era)) (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL)
      )