diff --git a/cabal.project b/cabal.project index 68004dbf75..570740f6b1 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2024-03-25T10:39:21Z - , cardano-haskell-packages 2024-03-22T16:27:41Z + , cardano-haskell-packages 2024-04-05T11:01:53Z packages: cardano-api @@ -47,15 +47,11 @@ source-repository-package subdir: latex-svg-image -if impl(ghc >= 9.6) - allow-newer: - cardano-lmdb-simple:bytestring - source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: ef26a50893c65f346ea0a3b865632b014692db3f - --sha256: 0c3pd7zdriid7n6a5n86f2c009lygls10qjawmdiih8rvpvr51d3 + tag: 33881548e70d619e652cb5334e31ee59ceefcc55 + --sha256: 1a64976szdvp0vmpjm974l955i18cjzqgcbyfgwjma8zh07r4347 subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index f2aecc2cca..f69324e062 100644 --- a/cardano-api/internal/Cardano/Api/LedgerState.hs +++ b/cardano-api/internal/Cardano/Api/LedgerState.hs @@ -33,6 +33,7 @@ module Cardano.Api.LedgerState , applyBlockWithEvents , AnyNewEpochState(..) , getAnyNewEpochState + , getUTxOValues -- * Traversing the block chain , foldBlocks @@ -108,6 +109,7 @@ import Cardano.Api.Query (CurrentEpochState (..), PoolDistribution (un decodeCurrentEpochState, decodePoolDistribution, decodeProtocolState) import qualified Cardano.Api.ReexposeLedger as Ledger import Cardano.Api.SpecialByron as Byron +import Cardano.Api.Tx.Body import Cardano.Api.Utils (textShow) import qualified Cardano.Binary as CBOR @@ -150,8 +152,7 @@ import qualified Ouroboros.Consensus.Cardano.CanHardFork as Consensus import qualified Ouroboros.Consensus.Cardano.Node as Consensus import qualified Ouroboros.Consensus.Config as Consensus import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus -import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as HFC -import qualified Ouroboros.Consensus.HardFork.Combinator.Basics as HFC +import qualified Ouroboros.Consensus.HardFork.Combinator as HFC import qualified Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common as HFC import Ouroboros.Consensus.HardFork.Combinator.State.Types import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger @@ -206,6 +207,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.SOP (K (K), (:.:) (Comp)) import Data.SOP.Functors (Flip (..)) +import Data.SOP.Index import Data.SOP.Strict (NP (..), fn) import Data.SOP.Strict.NS import qualified Data.SOP.Telescope as Telescope @@ -1056,8 +1058,8 @@ getAnyNewEpochState :: ShelleyBasedEra era -> LedgerState -> Either LedgerStateError AnyNewEpochState -getAnyNewEpochState sbe (LedgerState ls _) = - AnyNewEpochState sbe <$> getNewEpochState sbe ls +getAnyNewEpochState sbe (LedgerState ls tbs) = + flip (AnyNewEpochState sbe) tbs <$> getNewEpochState sbe ls getNewEpochState :: ShelleyBasedEra era @@ -1177,8 +1179,8 @@ toLedgerStateEvents :: ( Ledger.LedgerState (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) ) - ( LedgerState - ) -> + LedgerState + -> LedgerStateEvents toLedgerStateEvents lr = (ledgerState, ledgerEvents) where @@ -1910,12 +1912,30 @@ data AnyNewEpochState where AnyNewEpochState :: ShelleyBasedEra era -> ShelleyAPI.NewEpochState (ShelleyLedgerEra era) + -> Ledger.LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.ValuesMK -> AnyNewEpochState instance Show AnyNewEpochState where - showsPrec p (AnyNewEpochState sbe ledgerNewEpochState) = + showsPrec p (AnyNewEpochState sbe ledgerNewEpochState _) = shelleyBasedEraConstraints sbe $ showsPrec p ledgerNewEpochState +getUTxOValues :: forall era. ShelleyBasedEra era + -> Ledger.LedgerTables (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) Ledger.ValuesMK + -> Map TxIn (TxOut CtxUTxO era) +getUTxOValues sbe tbs = + let + distribTables :: Shelley.EraCrypto (ShelleyLedgerEra era) ~ Consensus.StandardCrypto + => Index (Consensus.CardanoEras Consensus.StandardCrypto) (Shelley.ShelleyBlock proto (ShelleyLedgerEra era)) + -> Map TxIn (TxOut CtxUTxO era) + distribTables idx = let LedgerTables (Ledger.ValuesMK values) = HFC.distribLedgerTables idx tbs + in Map.mapKeys fromShelleyTxIn $ Map.map (fromShelleyTxOut sbe) values + in case sbe of + ShelleyBasedEraShelley -> distribTables (IS IZ) + ShelleyBasedEraAllegra -> distribTables (IS (IS IZ)) + ShelleyBasedEraMary -> distribTables (IS (IS (IS IZ))) + ShelleyBasedEraAlonzo -> distribTables (IS (IS (IS (IS IZ)))) + ShelleyBasedEraBabbage -> distribTables (IS (IS (IS (IS (IS IZ))))) + ShelleyBasedEraConway -> distribTables (IS (IS (IS (IS (IS (IS IZ)))))) -- | Reconstructs the ledger's new epoch state and applies a supplied condition to it for every block. This -- function only terminates if the condition is met or we have reached the termination epoch. We need to @@ -2068,12 +2088,11 @@ foldEpochState nodeConfigFilePath socketPath validationMode terminationEpoch ini let (knownLedgerStates', _) = pushLedgerState env knownLedgerStates slotNo new blockInMode newClientTip = At currBlockNo newServerTip = fromChainTip serverChainTip - case getNewEpochState sbe $ clsState newLedgerState of + case getAnyNewEpochState sbe newLedgerState of Left e -> let !err = Just e in clientIdle_DoneNwithMaybeError n err - Right lState -> do - let newEpochState = AnyNewEpochState sbe lState + Right newEpochState -> do -- Run the condition function in an exclusive lock. -- There can be only one place where `takeMVar stateMv` exists otherwise this -- code will deadlock! diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index cec503be7e..1404dd998b 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -750,6 +750,7 @@ module Cardano.Api ( AnyNewEpochState(..), foldEpochState, getAnyNewEpochState, + getUTxOValues, -- *** Errors LedgerStateError(..), diff --git a/flake.lock b/flake.lock index 15656e4f13..78a4fdba2e 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1710529033, - "narHash": "sha256-vcxum8uDTGEGV1/h8UWRJmdPXcLhrAqpty/N2LbxRb4=", + "lastModified": 1712315807, + "narHash": "sha256-RdUQH5Wvm6jda6kM+rVgiz/qfpUXDJ2cXjIXdweh6NQ=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "a744b5fe534c57a42cbc2645b9211bb619c7c243", + "rev": "c6ae66cd05e72715d474da8f5469946b5db374ca", "type": "github" }, "original": {