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

module Cardano.Ledger.Dijkstra.UTxO (
  DijkstraEraUTxO (..),
  dijkstraConsumed,
  getDijkstraScriptsNeeded,
  getDijkstraScriptsProvided,
  getDijkstraSupplementalDataHashes,
  getDijkstraMinFeeTxUtxo,
  scriptsProvidedDijkstraStAnnTx,
  batchNonDistinctRefScriptsSize,
  localProducedValue,
  poolOwnersWitnessRequired,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (CollectError)
import Cardano.Ledger.Alonzo.UTxO (
  AlonzoEraUTxO (..),
  AlonzoScriptsNeeded (..),
  getAlonzoScriptsHashesNeeded,
  zipAsIxItem,
 )
import Cardano.Ledger.Babbage.UTxO (
  getBabbageScriptsProvided,
  getBabbageSpendingDatum,
  getBabbageSupplementalDataHashes,
 )
import Cardano.Ledger.BaseTypes (StrictMaybe (..), inject)
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.Tx (getConwayMinFeeTx)
import Cardano.Ledger.Conway.TxBody (conwayProposalsDeposits)
import Cardano.Ledger.Conway.UTxO (
  getConwayScriptsNeeded,
  getConwayWitsVKeyNeededWith,
  txNonDistinctRefScriptsSize,
 )
import Cardano.Ledger.Credential (Credential, credScriptHash)
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
import Cardano.Ledger.Dijkstra.Scripts (DijkstraEraScript (..))
import Cardano.Ledger.Dijkstra.State
import Cardano.Ledger.Dijkstra.Tx (
  DijkstraStAnnTx (..),
  exUnitsDijkstraStAnnTx,
  refScriptsSizeDijkstraStAnnTx,
 )
import Cardano.Ledger.Mary.UTxO (burnedMultiAssets, getConsumedMaryValue)
import Cardano.Ledger.Mary.Value (MaryValue (..))
import Cardano.Ledger.Plutus (Language, PlutusWithContext)
import Control.Exception (assert)
import Data.Foldable (Foldable (..))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid (Sum (..))
import qualified Data.OMap.Strict as OMap
import Data.Set (Set)
import Lens.Micro (SimpleGetter, to, (^.))
import Lens.Micro.Extras (view)

class AlonzoEraUTxO era => DijkstraEraUTxO era where
  subTransactionsStAnnTx :: StAnnTx TopTx era -> [StAnnTx SubTx era]
  plutusLegacyModeStAnnTxG :: SimpleGetter (StAnnTx TopTx era) Bool
  scriptsHashesNeededStAnnTx :: StAnnTx SubTx era -> Set ScriptHash

-- | Unlike `shelleyConsumed`, this function does not need access to `Accounts` to produce accurate
-- information about refunds, hence is this simplification. Note that using `shelleyConsumed` in
-- Dijkstra era onwards will produce the same result as this one.
dijkstraConsumed ::
  EraUTxO era =>
  PParams era ->
  UTxO era ->
  TxBody l era ->
  Value era
dijkstraConsumed :: forall era (l :: TxLevel).
EraUTxO era =>
PParams era -> UTxO era -> TxBody l era -> Value era
dijkstraConsumed PParams era
pp = PParams era
-> (Credential Staking -> Maybe Coin)
-> UTxO era
-> TxBody l era
-> Value era
forall era (t :: TxLevel).
EraUTxO era =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> UTxO era
-> TxBody t era
-> Value era
forall (t :: TxLevel).
PParams era
-> (Credential Staking -> Maybe Coin)
-> UTxO era
-> TxBody t era
-> Value era
getConsumedValue PParams era
pp (Maybe Coin -> Credential Staking -> Maybe Coin
forall a b. a -> b -> a
const Maybe Coin
forall a. Maybe a
Nothing)

getConsumedDijkstraValue ::
  forall era l.
  ( DijkstraEraTxBody era
  , EraUTxO era
  , Value era ~ MaryValue
  , STxLevel l era ~ STxBothLevels l era
  ) =>
  PParams era ->
  (Credential Staking -> 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)
-> UTxO era
-> TxBody l era
-> Value era
getConsumedDijkstraValue PParams era
pp Credential Staking -> Maybe Coin
lookupStakingDeposit 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)
-> UTxO era
-> TxBody m era
-> MaryValue
forall era (l :: TxLevel).
(MaryEraTxBody era, Value era ~ MaryValue) =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> UTxO era
-> TxBody l era
-> MaryValue
getConsumedMaryValue PParams era
pp Credential Staking -> Maybe Coin
lookupStakingDeposit 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)
-> UTxO era
-> TxBody SubTx era
-> Value era
forall era (t :: TxLevel).
EraUTxO era =>
PParams era
-> (Credential Staking -> Maybe Coin)
-> UTxO era
-> TxBody t era
-> Value era
forall (t :: TxLevel).
PParams era
-> (Credential Staking -> Maybe Coin)
-> UTxO era
-> TxBody t era
-> Value era
getConsumedValue PParams era
pp Credential Staking -> Maybe Coin
lookupStakingDeposit 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 ::
  forall era.
  ( 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
topTxBody =
  PParams era -> TxBody TopTx era -> MaryValue
forall era (l :: TxLevel).
(DijkstraEraTxBody era, Value era ~ MaryValue) =>
PParams era -> TxBody l era -> MaryValue
localProducedValue PParams era
pp TxBody TopTx era
topTxBody
    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 -> TxBody SubTx era -> MaryValue
forall era (l :: TxLevel).
(DijkstraEraTxBody era, Value era ~ MaryValue) =>
PParams era -> TxBody l era -> MaryValue
localProducedValue PParams era
pp (TxBody SubTx era -> MaryValue)
-> (Tx SubTx era -> TxBody SubTx era) -> Tx SubTx era -> MaryValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tx SubTx era
-> Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx era)
-> TxBody SubTx era
forall s a. s -> Getting a s a -> a
^. 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)) OMap TxId (Tx SubTx era)
subTxs
    MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (TxBody TopTx era
topTxBody TxBody TopTx era -> Getting Coin (TxBody TopTx era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx era) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx era) Coin
feeTxBodyL)
    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) -> StrictSeq (TxCert era) -> Coin
forall era (f :: * -> *).
(EraTxCert era, Foldable f) =>
PParams era
-> (KeyHash StakePool -> Bool) -> f (TxCert era) -> Coin
forall (f :: * -> *).
Foldable f =>
PParams era
-> (KeyHash StakePool -> Bool) -> f (TxCert era) -> Coin
getTotalDepositsTxCerts PParams era
pp KeyHash StakePool -> Bool
isRegPoolId StrictSeq (TxCert era)
batchTxCerts)
  where
    -- add all values that are produced by both top and sub-transactions
    -- Certs are excluded, since they need to be processed separately
    -- while maintaining the state through all of the certs of a transactions.
    batchTxCerts :: StrictSeq (TxCert era)
batchTxCerts =
      (Tx SubTx era -> StrictSeq (TxCert era))
-> OMap TxId (Tx SubTx era) -> StrictSeq (TxCert era)
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' (Tx SubTx era
-> Getting
     (StrictSeq (TxCert era)) (Tx SubTx era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. (TxBody SubTx era
 -> Const (StrictSeq (TxCert era)) (TxBody SubTx era))
-> Tx SubTx era -> Const (StrictSeq (TxCert era)) (Tx 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 SubTx era
  -> Const (StrictSeq (TxCert era)) (TxBody SubTx era))
 -> Tx SubTx era -> Const (StrictSeq (TxCert era)) (Tx SubTx era))
-> ((StrictSeq (TxCert era)
     -> Const (StrictSeq (TxCert era)) (StrictSeq (TxCert era)))
    -> TxBody SubTx era
    -> Const (StrictSeq (TxCert era)) (TxBody SubTx era))
-> Getting
     (StrictSeq (TxCert era)) (Tx SubTx era) (StrictSeq (TxCert era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era)
 -> Const (StrictSeq (TxCert era)) (StrictSeq (TxCert era)))
-> TxBody SubTx era
-> Const (StrictSeq (TxCert era)) (TxBody SubTx 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) OMap TxId (Tx SubTx era)
subTxs
        StrictSeq (TxCert era)
-> StrictSeq (TxCert era) -> StrictSeq (TxCert era)
forall a. Semigroup a => a -> a -> a
<> (TxBody TopTx era
topTxBody TxBody TopTx era
-> Getting
     (StrictSeq (TxCert era))
     (TxBody TopTx era)
     (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era))
  (TxBody TopTx 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)
    subTxs :: OMap TxId (Tx SubTx era)
subTxs = 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

-- | Produced value that is local to a single transaction body, that is, the part
-- that can be summed independently for each body in a batch.
-- Excludes fees and certificate deposits, which are accounted for once per
-- batch.
localProducedValue ::
  ( DijkstraEraTxBody era
  , Value era ~ MaryValue
  ) =>
  PParams era ->
  TxBody l era ->
  MaryValue
localProducedValue :: forall era (l :: TxLevel).
(DijkstraEraTxBody era, Value era ~ MaryValue) =>
PParams era -> TxBody l era -> MaryValue
localProducedValue PParams era
pp TxBody l era
txBody =
  StrictSeq (TxOut era) -> Value era
forall era (f :: * -> *).
(EraTxOut era, Foldable f) =>
f (TxOut era) -> Value era
sumAllValue (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)
    MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (TxBody l era
txBody TxBody l era -> Getting Coin (TxBody l era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody l 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
<> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (PParams era -> TxBody l era -> Coin
forall era (l :: TxLevel).
ConwayEraTxBody era =>
PParams era -> TxBody l era -> Coin
conwayProposalsDeposits PParams era
pp TxBody l era
txBody)
    MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> TxBody l era -> MaryValue
forall era (l :: TxLevel).
MaryEraTxBody era =>
TxBody l era -> MaryValue
burnedMultiAssets TxBody l era
txBody
    MaryValue -> MaryValue -> MaryValue
forall a. Semigroup a => a -> a -> a
<> Coin -> MaryValue
forall t s. Inject t s => t -> s
inject (Map AccountAddress Coin -> Coin
forall m. Monoid m => Map AccountAddress m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (DirectDeposits -> Map AccountAddress Coin
unDirectDeposits (TxBody l era
txBody TxBody l era
-> Getting DirectDeposits (TxBody l era) DirectDeposits
-> DirectDeposits
forall s a. s -> Getting a s a -> a
^. Getting DirectDeposits (TxBody l era) DirectDeposits
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL)))

instance EraUTxO DijkstraEra where
  type ScriptsNeeded DijkstraEra = AlonzoScriptsNeeded DijkstraEra

  getConsumedValue :: forall (t :: TxLevel).
PParams DijkstraEra
-> (Credential Staking -> Maybe Coin)
-> UTxO DijkstraEra
-> TxBody t DijkstraEra
-> Value DijkstraEra
getConsumedValue = PParams DijkstraEra
-> (Credential Staking -> 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)
-> UTxO era
-> TxBody l era
-> Value era
getConsumedDijkstraValue

  getProducedValue :: PParams DijkstraEra
-> (KeyHash StakePool -> Bool)
-> TxBody TopTx DijkstraEra
-> Value DijkstraEra
getProducedValue = PParams DijkstraEra
-> (KeyHash StakePool -> Bool)
-> TxBody TopTx DijkstraEra
-> Value DijkstraEra
PParams DijkstraEra
-> (KeyHash StakePool -> Bool)
-> TxBody TopTx DijkstraEra
-> MaryValue
forall era.
(DijkstraEraTxBody era, EraUTxO era, Value era ~ MaryValue) =>
PParams era
-> (KeyHash StakePool -> Bool) -> TxBody TopTx era -> MaryValue
dijkstraProducedValue

  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
certState =
    (StakePoolParams DijkstraEra -> Bool)
-> UTxO DijkstraEra
-> TxBody t DijkstraEra
-> Set (KeyHash Witness)
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era) =>
(StakePoolParams era -> Bool)
-> UTxO era -> TxBody l era -> Set (KeyHash Witness)
getConwayWitsVKeyNeededWith (PState DijkstraEra -> StakePoolParams DijkstraEra -> Bool
forall era. PState era -> StakePoolParams era -> Bool
poolOwnersWitnessRequired (CertState DijkstraEra
ConwayCertState DijkstraEra
certState ConwayCertState DijkstraEra
-> Getting
     (PState DijkstraEra)
     (ConwayCertState DijkstraEra)
     (PState DijkstraEra)
-> PState DijkstraEra
forall s a. s -> Getting a s a -> a
^. (PState DijkstraEra
 -> Const (PState DijkstraEra) (PState DijkstraEra))
-> CertState DijkstraEra
-> Const (PState DijkstraEra) (CertState DijkstraEra)
Getting
  (PState DijkstraEra)
  (ConwayCertState DijkstraEra)
  (PState DijkstraEra)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState DijkstraEra) (PState DijkstraEra)
certPStateL))

  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, DijkstraEraTxBody era,
 STxLevel l era ~ STxBothLevels l era) =>
PParams era -> Tx l era -> UTxO era -> Coin
getDijkstraMinFeeTxUtxo

  calcMinFeeStAnnTx :: PParams DijkstraEra -> StAnnTx TopTx DijkstraEra -> Coin
calcMinFeeStAnnTx PParams DijkstraEra
pp DijkstraStAnnTopTx {Tx TopTx DijkstraEra
dsattTx :: Tx TopTx DijkstraEra
dsattTx :: forall era. DijkstraStAnnTx TopTx era -> Tx TopTx era
dsattTx, Int
dsattRefScriptsSize :: Int
dsattRefScriptsSize :: forall era. DijkstraStAnnTx TopTx era -> Int
dsattRefScriptsSize, ExUnits
dsattExUnits :: ExUnits
dsattExUnits :: forall era. DijkstraStAnnTx TopTx era -> ExUnits
dsattExUnits, UTxO DijkstraEra
dsattUTxO :: UTxO DijkstraEra
dsattUTxO :: forall era. DijkstraStAnnTx TopTx era -> UTxO era
dsattUTxO} =
    Bool -> Coin -> Coin
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PParams DijkstraEra
-> Tx TopTx DijkstraEra -> UTxO DijkstraEra -> Coin
forall era (t :: TxLevel).
EraUTxO era =>
PParams era -> Tx t era -> UTxO era -> Coin
forall (t :: TxLevel).
PParams DijkstraEra -> Tx t DijkstraEra -> UTxO DijkstraEra -> Coin
getMinFeeTxUtxo PParams DijkstraEra
pp Tx TopTx DijkstraEra
dsattTx UTxO DijkstraEra
dsattUTxO Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
minFee) Coin
minFee
    where
      minFee :: Coin
minFee = PParams DijkstraEra
-> Tx TopTx DijkstraEra -> Int -> ExUnits -> Coin
forall era (l :: TxLevel).
(AlonzoEraTx era, ConwayEraPParams era) =>
PParams era -> Tx l era -> Int -> ExUnits -> Coin
getConwayMinFeeTx PParams DijkstraEra
pp Tx TopTx DijkstraEra
dsattTx Int
dsattRefScriptsSize ExUnits
dsattExUnits

-- | The pool owners are required to witness a transaction, unless the certificate
-- is re-registering an already registered pool and matches the latest params
-- (that includes future updates that are signed and pending) for everything
-- except the BLS key.
-- That is, the owners are not required to sign if only the BLS key is being updated.
-- Note: this predicate will also exempt owners from signing either (a) re-registrations
-- where all params match since they are no-op, and (b) unretiring a pool
poolOwnersWitnessRequired :: PState era -> StakePoolParams era -> Bool
poolOwnersWitnessRequired :: forall era. PState era -> StakePoolParams era -> Bool
poolOwnersWitnessRequired PState {Map (KeyHash StakePool) StakePoolState
psStakePools :: Map (KeyHash StakePool) StakePoolState
psStakePools :: forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psStakePools, Map (KeyHash StakePool) (StakePoolParams era)
psFutureStakePoolParams :: Map (KeyHash StakePool) (StakePoolParams era)
psFutureStakePoolParams :: forall era.
PState era -> Map (KeyHash StakePool) (StakePoolParams era)
psFutureStakePoolParams} StakePoolParams era
stakePoolParams =
  case KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolState -> Maybe StakePoolState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash StakePool
poolId Map (KeyHash StakePool) StakePoolState
psStakePools of
    -- new pool
    Maybe StakePoolState
Nothing -> Bool
True
    Just StakePoolState
stakePoolState ->
      let activeParams :: StakePoolParams era
activeParams =
            Network
-> KeyHash StakePool -> StakePoolState -> StakePoolParams era
forall era.
Network
-> KeyHash StakePool -> StakePoolState -> StakePoolParams era
stakePoolStateToStakePoolParams
              (AccountAddress -> Network
aaNetworkId (StakePoolParams era -> AccountAddress
forall era. StakePoolParams era -> AccountAddress
sppAccountAddress StakePoolParams era
stakePoolParams))
              KeyHash StakePool
poolId
              StakePoolState
stakePoolState
          -- if there are params that are pending then we select those instead
          latestParams :: StakePoolParams era
latestParams = StakePoolParams era
-> Maybe (StakePoolParams era) -> StakePoolParams era
forall a. a -> Maybe a -> a
fromMaybe StakePoolParams era
activeParams (Maybe (StakePoolParams era) -> StakePoolParams era)
-> Maybe (StakePoolParams era) -> StakePoolParams era
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool
-> Map (KeyHash StakePool) (StakePoolParams era)
-> Maybe (StakePoolParams era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash StakePool
poolId Map (KeyHash StakePool) (StakePoolParams era)
psFutureStakePoolParams
       in StakePoolParams era -> StakePoolParams (ZonkAny 0)
forall {era} {era}. StakePoolParams era -> StakePoolParams era
withoutBlsKey StakePoolParams era
stakePoolParams StakePoolParams (ZonkAny 0) -> StakePoolParams (ZonkAny 0) -> Bool
forall a. Eq a => a -> a -> Bool
/= StakePoolParams era -> StakePoolParams (ZonkAny 0)
forall {era} {era}. StakePoolParams era -> StakePoolParams era
withoutBlsKey StakePoolParams era
latestParams
  where
    poolId :: KeyHash StakePool
poolId = StakePoolParams era -> KeyHash StakePool
forall era. StakePoolParams era -> KeyHash StakePool
sppId StakePoolParams era
stakePoolParams
    withoutBlsKey :: StakePoolParams era -> StakePoolParams era
withoutBlsKey StakePoolParams era
params = StakePoolParams era
params {sppBlsKey = SNothing}

-- | 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).
(EraTx era, DijkstraEraTxBody era,
 STxLevel l era ~ STxBothLevels l era) =>
UTxO era -> TxBody l era -> Set DataHash
getDijkstraSupplementalDataHashes

  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

  scriptsNeededStAnnTx :: forall (l :: TxLevel).
StAnnTx l DijkstraEra -> ScriptsNeeded DijkstraEra
scriptsNeededStAnnTx = StAnnTx l DijkstraEra -> ScriptsNeeded DijkstraEra
DijkstraStAnnTx l DijkstraEra -> ScriptsNeeded 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 -> ScriptsNeeded era
scriptsNeededDijkstraStAnnTx

  plutusScriptsWithContextStAnnTx :: forall (l :: TxLevel).
StAnnTx l DijkstraEra
-> Either (NonEmpty (CollectError DijkstraEra)) [PlutusWithContext]
plutusScriptsWithContextStAnnTx = StAnnTx l DijkstraEra
-> Either (NonEmpty (CollectError DijkstraEra)) [PlutusWithContext]
DijkstraStAnnTx l DijkstraEra
-> Either (NonEmpty (CollectError DijkstraEra)) [PlutusWithContext]
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
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
plutusScriptsWithContextDijkstraStAnnTx

  plutusLanguagesUsedStAnnTx :: forall (l :: TxLevel). StAnnTx l DijkstraEra -> Set Language
plutusLanguagesUsedStAnnTx = StAnnTx l DijkstraEra -> Set Language
DijkstraStAnnTx l DijkstraEra -> Set Language
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 -> Set Language
plutusLanguagesUsedDijkstraStAnnTx

  refScriptsSizeStAnnTx :: StAnnTx TopTx DijkstraEra -> Int
refScriptsSizeStAnnTx = StAnnTx TopTx DijkstraEra -> Int
DijkstraStAnnTx TopTx DijkstraEra -> Int
forall era. DijkstraStAnnTx TopTx era -> Int
refScriptsSizeDijkstraStAnnTx
  exUnitsStAnnTx :: StAnnTx TopTx DijkstraEra -> ExUnits
exUnitsStAnnTx = StAnnTx TopTx DijkstraEra -> ExUnits
DijkstraStAnnTx TopTx DijkstraEra -> ExUnits
forall era. DijkstraStAnnTx TopTx era -> ExUnits
exUnitsDijkstraStAnnTx

getDijkstraSupplementalDataHashes ::
  ( EraTx era
  , DijkstraEraTxBody era
  , STxLevel l era ~ STxBothLevels l era
  ) =>
  UTxO era ->
  TxBody l era ->
  Set DataHash
getDijkstraSupplementalDataHashes :: forall era (l :: TxLevel).
(EraTx era, DijkstraEraTxBody era,
 STxLevel l era ~ STxBothLevels l era) =>
UTxO era -> TxBody l era -> Set DataHash
getDijkstraSupplementalDataHashes UTxO era
utxo TxBody l era
txBody =
  TxBody l era
-> (TxBody TopTx era -> Set DataHash)
-> (TxBody SubTx era -> Set DataHash)
-> Set DataHash
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 ->
        UTxO era -> TxBody TopTx era -> Set DataHash
forall era (l :: TxLevel).
BabbageEraTxBody era =>
UTxO era -> TxBody l era -> Set DataHash
getBabbageSupplementalDataHashes UTxO era
utxo TxBody TopTx era
topTxBody
          Set DataHash -> Set DataHash -> Set DataHash
forall a. Semigroup a => a -> a -> a
<> (Tx SubTx era -> Set DataHash)
-> OMap TxId (Tx SubTx era) -> Set DataHash
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'
            (UTxO era -> TxBody SubTx era -> Set DataHash
forall era (l :: TxLevel).
BabbageEraTxBody era =>
UTxO era -> TxBody l era -> Set DataHash
getBabbageSupplementalDataHashes UTxO era
utxo (TxBody SubTx era -> Set DataHash)
-> (Tx SubTx era -> TxBody SubTx era)
-> Tx SubTx era
-> Set DataHash
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)
    )
    (UTxO era -> TxBody SubTx era -> Set DataHash
forall era (l :: TxLevel).
BabbageEraTxBody era =>
UTxO era -> TxBody l era -> Set DataHash
getBabbageSupplementalDataHashes UTxO era
utxo)

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)

scriptsNeededDijkstraStAnnTx ::
  ( EraTxLevel era
  , STxLevel l era ~ STxBothLevels l era
  , STxLevel SubTx era ~ STxBothLevels SubTx era
  , STxLevel TopTx era ~ STxBothLevels TopTx era
  ) =>
  DijkstraStAnnTx l era -> ScriptsNeeded era
scriptsNeededDijkstraStAnnTx :: 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 -> ScriptsNeeded era
scriptsNeededDijkstraStAnnTx DijkstraStAnnTx l era
stAnnTx =
  DijkstraStAnnTx l era
-> (DijkstraStAnnTx TopTx era -> ScriptsNeeded era)
-> (DijkstraStAnnTx SubTx era -> ScriptsNeeded era)
-> ScriptsNeeded 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 {ScriptsNeeded era
dsattScriptsNeeded :: ScriptsNeeded era
dsattScriptsNeeded :: forall era. DijkstraStAnnTx TopTx era -> ScriptsNeeded era
dsattScriptsNeeded} -> ScriptsNeeded era
dsattScriptsNeeded)
    (\DijkstraStAnnSubTx {ScriptsNeeded era
dsastScriptsNeeded :: ScriptsNeeded era
dsastScriptsNeeded :: forall era. DijkstraStAnnTx SubTx era -> ScriptsNeeded era
dsastScriptsNeeded} -> ScriptsNeeded era
dsastScriptsNeeded)

plutusScriptsWithContextDijkstraStAnnTx ::
  ( EraTxLevel era
  , STxLevel l era ~ STxBothLevels l era
  , STxLevel SubTx era ~ STxBothLevels SubTx era
  , STxLevel TopTx era ~ STxBothLevels TopTx era
  ) =>
  DijkstraStAnnTx l era ->
  Either (NonEmpty (CollectError era)) [PlutusWithContext]
plutusScriptsWithContextDijkstraStAnnTx :: 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
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
plutusScriptsWithContextDijkstraStAnnTx DijkstraStAnnTx l era
stAnnTx =
  DijkstraStAnnTx l era
-> (DijkstraStAnnTx TopTx era
    -> Either (NonEmpty (CollectError era)) [PlutusWithContext])
-> (DijkstraStAnnTx SubTx era
    -> Either (NonEmpty (CollectError era)) [PlutusWithContext])
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
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 {Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsattPlutusScriptsWithContext :: Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsattPlutusScriptsWithContext :: forall era.
DijkstraStAnnTx TopTx era
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsattPlutusScriptsWithContext, [DijkstraStAnnTx SubTx era]
dsattSubTransactions :: [DijkstraStAnnTx SubTx era]
dsattSubTransactions :: forall era.
DijkstraStAnnTx TopTx era -> [DijkstraStAnnTx SubTx era]
dsattSubTransactions} ->
        -- Evaluate the whole batch together, after all phase-1 checks have passed.
        -- Collection errors in a sub-transaction must also reject the batch.
        [[PlutusWithContext]] -> [PlutusWithContext]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          ([[PlutusWithContext]] -> [PlutusWithContext])
-> Either (NonEmpty (CollectError era)) [[PlutusWithContext]]
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either (NonEmpty (CollectError era)) [PlutusWithContext]]
-> Either (NonEmpty (CollectError era)) [[PlutusWithContext]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
            (Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsattPlutusScriptsWithContext Either (NonEmpty (CollectError era)) [PlutusWithContext]
-> [Either (NonEmpty (CollectError era)) [PlutusWithContext]]
-> [Either (NonEmpty (CollectError era)) [PlutusWithContext]]
forall a. a -> [a] -> [a]
: (DijkstraStAnnTx SubTx era
 -> Either (NonEmpty (CollectError era)) [PlutusWithContext])
-> [DijkstraStAnnTx SubTx era]
-> [Either (NonEmpty (CollectError era)) [PlutusWithContext]]
forall a b. (a -> b) -> [a] -> [b]
map DijkstraStAnnTx SubTx era
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
forall era.
DijkstraStAnnTx SubTx era
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsastPlutusScriptsWithContext [DijkstraStAnnTx SubTx era]
dsattSubTransactions)
    )
    (\DijkstraStAnnSubTx {Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsastPlutusScriptsWithContext :: forall era.
DijkstraStAnnTx SubTx era
-> Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsastPlutusScriptsWithContext :: Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsastPlutusScriptsWithContext} -> Either (NonEmpty (CollectError era)) [PlutusWithContext]
dsastPlutusScriptsWithContext)

plutusLanguagesUsedDijkstraStAnnTx ::
  ( EraTxLevel era
  , STxLevel l era ~ STxBothLevels l era
  , STxLevel SubTx era ~ STxBothLevels SubTx era
  , STxLevel TopTx era ~ STxBothLevels TopTx era
  ) =>
  DijkstraStAnnTx l era -> Set Language
plutusLanguagesUsedDijkstraStAnnTx :: 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 -> Set Language
plutusLanguagesUsedDijkstraStAnnTx DijkstraStAnnTx l era
stAnnTx =
  DijkstraStAnnTx l era
-> (DijkstraStAnnTx TopTx era -> Set Language)
-> (DijkstraStAnnTx SubTx era -> Set Language)
-> Set Language
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 {Set Language
dsattPlutusLanguagesUsed :: Set Language
dsattPlutusLanguagesUsed :: forall era. DijkstraStAnnTx TopTx era -> Set Language
dsattPlutusLanguagesUsed} -> Set Language
dsattPlutusLanguagesUsed)
    (\DijkstraStAnnSubTx {Set Language
dsastPlutusLanguagesUsed :: Set Language
dsastPlutusLanguagesUsed :: forall era. DijkstraStAnnTx SubTx era -> Set Language
dsastPlutusLanguagesUsed} -> Set Language
dsastPlutusLanguagesUsed)

instance DijkstraEraUTxO DijkstraEra where
  subTransactionsStAnnTx :: StAnnTx TopTx DijkstraEra -> [StAnnTx SubTx DijkstraEra]
subTransactionsStAnnTx = StAnnTx TopTx DijkstraEra -> [StAnnTx SubTx DijkstraEra]
DijkstraStAnnTx TopTx DijkstraEra
-> [DijkstraStAnnTx SubTx DijkstraEra]
forall era.
DijkstraStAnnTx TopTx era -> [DijkstraStAnnTx SubTx era]
subTransactionsDijkstraStAnnTx
  plutusLegacyModeStAnnTxG :: SimpleGetter (StAnnTx TopTx DijkstraEra) Bool
plutusLegacyModeStAnnTxG = (DijkstraStAnnTx TopTx DijkstraEra -> Bool)
-> SimpleGetter (DijkstraStAnnTx TopTx DijkstraEra) Bool
forall s a. (s -> a) -> SimpleGetter s a
to (\DijkstraStAnnTopTx {Bool
dsattPlutusLegacyMode :: Bool
dsattPlutusLegacyMode :: forall era. DijkstraStAnnTx TopTx era -> Bool
dsattPlutusLegacyMode} -> Bool
dsattPlutusLegacyMode)
  scriptsHashesNeededStAnnTx :: StAnnTx SubTx DijkstraEra -> Set ScriptHash
scriptsHashesNeededStAnnTx = StAnnTx SubTx DijkstraEra -> Set ScriptHash
DijkstraStAnnTx SubTx DijkstraEra -> Set ScriptHash
forall era. DijkstraStAnnTx SubTx era -> Set ScriptHash
dsastScriptsHashesNeeded

subTransactionsDijkstraStAnnTx ::
  DijkstraStAnnTx TopTx era -> [DijkstraStAnnTx SubTx era]
subTransactionsDijkstraStAnnTx :: forall era.
DijkstraStAnnTx TopTx era -> [DijkstraStAnnTx SubTx era]
subTransactionsDijkstraStAnnTx DijkstraStAnnTopTx {[DijkstraStAnnTx SubTx era]
dsattSubTransactions :: forall era.
DijkstraStAnnTx TopTx era -> [DijkstraStAnnTx SubTx era]
dsattSubTransactions :: [DijkstraStAnnTx SubTx era]
dsattSubTransactions} = [DijkstraStAnnTx SubTx era]
dsattSubTransactions

-- | Minimum fee calculation for a transaction.
--
-- For a top-level transaction the fee covers the entire batch, including the size,
-- execution units and reference scripts of every sub-transaction.
getDijkstraMinFeeTxUtxo ::
  ( EraTx era
  , DijkstraEraTxBody era
  , STxLevel l era ~ STxBothLevels l era
  ) =>
  PParams era ->
  Tx l era ->
  UTxO era ->
  Coin
getDijkstraMinFeeTxUtxo :: forall era (l :: TxLevel).
(EraTx era, DijkstraEraTxBody era,
 STxLevel l era ~ STxBothLevels l era) =>
PParams era -> Tx l era -> UTxO era -> Coin
getDijkstraMinFeeTxUtxo PParams era
pparams Tx l era
tx UTxO era
utxo =
  PParams era -> Tx l era -> Int -> Coin
forall era (l :: TxLevel).
EraTx era =>
PParams era -> Tx l era -> Int -> Coin
forall (l :: TxLevel). PParams era -> Tx l era -> Int -> Coin
getMinFeeTx PParams era
pparams Tx l era
tx (Int -> Coin) -> Int -> Coin
forall a b. (a -> b) -> a -> b
$
    Tx l era -> (Tx TopTx era -> Int) -> (Tx SubTx era -> Int) -> Int
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
      (UTxO era -> Tx TopTx era -> Int
forall era.
(EraTx era, DijkstraEraTxBody era) =>
UTxO era -> Tx TopTx era -> Int
batchNonDistinctRefScriptsSize UTxO era
utxo)
      (UTxO era -> Tx SubTx era -> Int
forall era (l :: TxLevel).
(EraTx era, BabbageEraTxBody era) =>
UTxO era -> Tx l era -> Int
txNonDistinctRefScriptsSize UTxO era
utxo)

-- | 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)
      )