{-# LANGUAGE DataKinds #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.UTxO ( getDijkstraScriptsNeeded, ) 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, ) 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 () import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..)) import Cardano.Ledger.Mary.UTxO (burnedMultiAssets, getConsumedMaryValue) import Cardano.Ledger.Mary.Value (MaryValue (..)) import Data.Foldable (Foldable (..)) import Data.Maybe (catMaybes) 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 (t :: TxLevel -> * -> *) era (l :: 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 (t :: TxLevel -> * -> *) era (l :: 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, BabbageEraTxBody era) => UTxO era -> Tx l era -> ScriptsProvided era getBabbageScriptsProvided 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 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 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