Integrate LSM-trees capable Consensus (and upstream dependencies)

cabal.project

@@ -13,7 +13,7 @@ repository cardano-haskell-packages
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2025-10-17T00:26:22Z
+  , hackage.haskell.org 2025-10-23T13:39:53Z
   , cardano-haskell-packages 2025-10-24T13:50:12Z
 
 packages:
@@ -61,14 +61,70 @@ package plutus-scripts-bench
 allow-newer:
   , katip:Win32
 
-if impl (ghc >= 9.12)
-  allow-newer:
-    -- https://github.com/kapralVV/Unique/issues/11
-    , Unique:hashable
-
-    -- https://github.com/Gabriella439/Haskell-Pipes-Safe-Library/pull/70
-    , pipes-safe:base
-
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+source-repository-package
+  type: git
+  location: https://github.com/intersectmbo/cardano-cli.git
+  tag: f6a52ea01bc3d7477c1aac24d0e1aecdd84b7439
+  --sha256: 1flrsxykbc7bdlylig1d1cpbx5r8d8ypv5niv7pr0kzb7q3nkhr4
+  subdir: cardano-cli
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-api
+  tag: f817a055a5b7076e84404d39e8addd6456aa6fa1
+  --sha256: 1rqkyssxs6bcnjk7wai69383m4dwc1kapmm26pda9v1w5xqi76jg
+  subdir:
+    cardano-api
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: 513d27d99b2486bf16d44a9f845ddb358244673f
+  --sha256: 0brlyrvhqxcpya6frx1w5bwbpz5bjjsvxm26951vf2lxah8rx8hp
+  subdir:
+    ouroboros-consensus
+    ouroboros-consensus-cardano
+    ouroboros-consensus-diffusion
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-ledger
+  tag: fb09078fa55015c881303a2ddb609c024cec258f
+  --sha256: sha256-9Y9CRiyMn0AWD+C4aNVMaJgrj3FDAYfCX4VrLvtoMaI=
+  subdir:
+    eras/allegra/impl
+    eras/alonzo/impl
+    eras/alonzo/test-suite
+    eras/babbage/impl
+    eras/conway/impl
+    eras/dijkstra/impl
+    eras/mary/impl
+    eras/shelley/impl
+    eras/shelley/test-suite
+    eras/shelley-ma/test-suite
+    libs/cardano-ledger-api
+    libs/cardano-ledger-core
+    libs/cardano-ledger-binary
+    libs/cardano-protocol-tpraos
+    libs/non-integral
+    libs/small-steps
+    libs/cardano-data
+    libs/set-algebra
+    libs/vector-map
+    eras/byron/chain/executable-spec
+    eras/byron/ledger/executable-spec
+    eras/byron/ledger/impl
+    eras/byron/crypto
+
+-- Backported version of https://github.com/IntersectMBO/ouroboros-network/pull/5161
+source-repository-package
+   type: git
+   location: https://github.com/IntersectMBO/ouroboros-network
+   tag: 1385b53cefb81e79553b6b0252537455833ea9c4
+   --sha256: sha256-zZ7WsMfRs1fG16bmvI5vIh4fhQ8RGyEvYGLSWlrxpg0=
+   subdir:
+     ouroboros-network-api
+     ouroboros-network

cardano-node-chairman/cardano-node-chairman.cabal

@@ -44,7 +44,7 @@ executable cardano-node-chairman
   build-depends:        cardano-api
                       , cardano-crypto-class
                       , cardano-git-rev ^>= 0.2.2
-                      , cardano-ledger-core ^>= 1.18
+                      , cardano-ledger-core ^>= 1.19
                       , cardano-node ^>= 10.5
                       , cardano-prelude
                       , containers

cardano-node/cardano-node.cabal

@@ -188,7 +188,7 @@ library
                       , network-mux >= 0.8
                       , nothunks
                       , optparse-applicative-fork >= 0.18.1
-                      , ouroboros-consensus ^>= 0.28
+                      , ouroboros-consensus:{ouroboros-consensus, ouroboros-consensus-lmdb, ouroboros-consensus-lsm} ^>= 0.28
                       , ouroboros-consensus-cardano ^>= 0.26
                       , ouroboros-consensus-diffusion ^>= 0.24
                       , ouroboros-consensus-protocol

cardano-node/src/Cardano/Node/Configuration/LedgerDB.hs

@@ -1,28 +1,35 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Node.Configuration.LedgerDB (
-    DeprecatedOptions (..)
-  , LedgerDbConfiguration (..)
-  , LedgerDbSelectorFlag(..)
-  , Gigabytes
-  , noDeprecatedOptions
-  , selectorToArgs
-  ) where
+    DeprecatedOptions (..),
+    LedgerDbConfiguration (..),
+    LedgerDbSelectorFlag (..),
+    Gigabytes,
+    noDeprecatedOptions,
+    selectorToArgs,
+) where
 
+import           Ouroboros.Consensus.Ledger.SupportsProtocol
+import           Ouroboros.Consensus.Storage.LedgerDB.API
 import           Ouroboros.Consensus.Storage.LedgerDB.Args
 import           Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Args as V1
-import           Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB (LMDBLimits (..))
-import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Args as V2
-import           Ouroboros.Consensus.Util.Args
+import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB as LMDB
+import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as InMemory
+import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.LSM as LSM
 
 import qualified Data.Aeson.Types as Aeson (FromJSON)
 import           Data.Maybe (fromMaybe)
-import           Data.SOP.Dict
+import           Data.Proxy
+import           System.FilePath
+import           System.Random (StdGen)
 
 -- | Choose the LedgerDB Backend
 --
@@ -34,21 +41,25 @@ import           Data.SOP.Dict
 --
 -- - 'V1LMDB': uses less memory but is somewhat slower.
 --
--- - 'V1InMemory': Not intended for production. It is an in-memory reproduction
---   of the LMDB implementation.
+-- - 'V2LSM': Uses the LSM backend.
 data LedgerDbSelectorFlag =
     V1LMDB
       V1.FlushFrequency
       -- ^ The frequency at which changes are flushed to the disk.
       (Maybe FilePath)
-      -- ^ Path for the live tables.
+      -- ^ Path for the live tables. If not provided the default will be used
+      -- (@<fast-storage>/lmdb@).
       (Maybe Gigabytes)
       -- ^ A map size can be specified, this is the maximum disk space the LMDB
       -- database can fill. If not provided, the default of 16GB will be used.
       (Maybe Int)
       -- ^ An override to the max number of readers.
-  | V1InMemory V1.FlushFrequency
   | V2InMemory
+  | V2LSM
+      (Maybe FilePath)
+      -- ^ Maybe a custom path to the LSM database. If not provided the default
+      -- will be used (@<fast-storage>/lsm@).
+
   deriving (Eq, Show)
 
 -- | Some options that existed in the TopLevel were now moved to a
@@ -118,24 +129,23 @@ toBytes (Gigabytes x) = x * 1024 * 1024 * 1024
 -- * The @lmdb-simple@ and @haskell-lmdb@ forked repositories.
 -- * The official LMDB API documentation at
 --    <http://www.lmdb.tech/doc/group__mdb.html>.
-defaultLMDBLimits :: LMDBLimits
-defaultLMDBLimits = LMDBLimits {
-    lmdbMapSize = 16 * 1024 * 1024 * 1024
-  , lmdbMaxDatabases = 10
-  , lmdbMaxReaders = 16
+defaultLMDBLimits :: LMDB.LMDBLimits
+defaultLMDBLimits = LMDB.LMDBLimits {
+    LMDB.lmdbMapSize = 16 * 1024 * 1024 * 1024
+  , LMDB.lmdbMaxDatabases = 10
+  , LMDB.lmdbMaxReaders = 16
   }
 
-defaultLMDBPath :: FilePath
-defaultLMDBPath = "mainnet/db/lmdb"
+defaultLMDBPath :: FilePath -> FilePath
+defaultLMDBPath = (</> "lmdb")
 
-selectorToArgs :: LedgerDbSelectorFlag -> Complete LedgerDbFlavorArgs IO
-selectorToArgs (V1InMemory ff)  = LedgerDbFlavorArgsV1 $ V1.V1Args ff V1.InMemoryBackingStoreArgs
-selectorToArgs V2InMemory      = LedgerDbFlavorArgsV2 $ V2.V2Args V2.InMemoryHandleArgs
-selectorToArgs (V1LMDB ff fp l mxReaders) =
-    LedgerDbFlavorArgsV1
-  $ V1.V1Args ff
-  $ V1.LMDBBackingStoreArgs
-      (fromMaybe defaultLMDBPath fp)
-      (maybe id (\overrideMaxReaders lim -> lim { lmdbMaxReaders = overrideMaxReaders }) mxReaders
-       $ maybe id (\ll lim -> lim { lmdbMapSize = toBytes ll }) l defaultLMDBLimits)
-      Dict
+selectorToArgs :: forall blk. (LedgerSupportsProtocol blk, LedgerSupportsLedgerDB blk) => LedgerDbSelectorFlag -> FilePath -> StdGen -> (LedgerDbBackendArgs IO blk, StdGen)
+selectorToArgs V2InMemory _ = InMemory.mkInMemoryArgs
+selectorToArgs (V1LMDB ff fp l mxReaders) fastStoragePath =
+    LMDB.mkLMDBArgs
+        ff
+        (fromMaybe (defaultLMDBPath fastStoragePath) fp)
+        ( maybe id (\overrideMaxReaders lim -> lim{LMDB.lmdbMaxReaders = overrideMaxReaders}) mxReaders $
+            maybe id (\ll lim -> lim{LMDB.lmdbMapSize = toBytes ll}) l defaultLMDBLimits
+        )
+selectorToArgs (V2LSM fp) fastStoragePath = LSM.mkLSMArgs (Proxy @blk) (fromMaybe "lsm" fp) fastStoragePath

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -466,16 +466,16 @@ instance FromJSON PartialNodeConfiguration where
              qsize           <- (fmap RequestedQueryBatchSize <$> o .:? "QueryBatchSize") .!= DefaultQueryBatchSize
              backend         <- o .:? "Backend" .!= "V2InMemory"
              selector        <- case backend of
-               "V1InMemory" -> do
-                 flush <- (fmap RequestedFlushFrequency <$> o .:? "FlushFrequency")       .!= DefaultFlushFrequency
-                 return $ V1InMemory flush
                "V1LMDB"     -> do
                  flush <- (fmap RequestedFlushFrequency <$> o .:? "FlushFrequency")       .!= DefaultFlushFrequency
                  mapSize :: Maybe Gigabytes <- o .:? "MapSize"
                  lmdbPath :: Maybe FilePath <- o .:? "LiveTablesPath"
                  mxReaders :: Maybe Int <- o .:? "MaxReaders"
                  return $ V1LMDB flush lmdbPath mapSize mxReaders
                "V2InMemory" -> return V2InMemory
+               "V2LSM" -> do
+                 lsmPath :: Maybe FilePath <- o .:? "LSMDatabasePath"
+                 pure $ V2LSM lsmPath
                _ -> fail $ "Malformed LedgerDB Backend: " <> backend
              pure $ Just $ LedgerDbConfiguration ldbSnapNum ldbSnapInterval qsize selector deprecatedOpts
 

cardano-node/src/Cardano/Node/Run.hs

@@ -68,7 +68,7 @@ import           Cardano.Tracing.Tracers
 import qualified Ouroboros.Consensus.Config as Consensus
 import           Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
 import           Ouroboros.Consensus.Node (SnapshotPolicyArgs (..),
-                   NodeDatabasePaths (..), RunNodeArgs (..), StdRunNodeArgs (..))
+                   NodeDatabasePaths (..), nonImmutableDbPath, RunNodeArgs (..), StdRunNodeArgs (..))
 import           Ouroboros.Consensus.Protocol.Praos.AgentClient (KESAgentClientTrace)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
 import           Ouroboros.Consensus.Node (RunNodeArgs (..),
@@ -79,7 +79,6 @@ import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import qualified Ouroboros.Consensus.Node.Tracers as Consensus
 import qualified Ouroboros.Consensus.Storage.LedgerDB.Args as LDBArgs
-import           Ouroboros.Consensus.Storage.LedgerDB.V2.Args
 import           Ouroboros.Consensus.Util.Args
 import           Ouroboros.Consensus.Util.Orphans ()
 
@@ -560,7 +559,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do
           , srnChainSyncIdleTimeout         = customizeChainSyncTimeout
           , srnSnapshotPolicyArgs           = snapshotPolicyArgs
           , srnQueryBatchSize               = queryBatchSize
-          , srnLdbFlavorArgs                = selectorToArgs ldbBackend
+          , srnLedgerDbBackendArgs          = selectorToArgs ldbBackend (nonImmutableDbPath dbPath)
           }
  where
   customizeChainSyncTimeout :: ChainSyncIdleTimeout

cardano-node/src/Cardano/Node/TraceConstraints.hs

@@ -23,6 +23,7 @@ import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, HasTxId
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
                    (HasNetworkProtocolVersion (BlockNodeToClientVersion, BlockNodeToNodeVersion))
 import           Ouroboros.Consensus.Node.Run (RunNode, SerialiseNodeToNodeConstraints)
+import           Ouroboros.Consensus.Peras.SelectView
 import           Ouroboros.Consensus.Protocol.Abstract (SelectView, ValidationErr)
 import           Ouroboros.Consensus.Shelley.Ledger.Mempool (GenTx, TxId)
 import           Ouroboros.Network.Block (Serialised)
@@ -51,7 +52,7 @@ type TraceConstraints blk =
     , ToObject (LedgerError blk)
     , ToObject (LedgerEvent blk)
     , ToObject (OtherHeaderEnvelopeError blk)
-    , ToObject (SelectView (BlockProtocol blk))
+    , ToObject (WeightedSelectView (BlockProtocol blk))
     , ToObject (ValidationErr (BlockProtocol blk))
     , ToObject (CannotForge blk)
     , ToObject (ForgeStateUpdateError blk)
@@ -66,7 +67,7 @@ type TraceConstraints blk =
     , LogFormatting (LedgerUpdate blk)
     , LogFormatting (LedgerWarning blk)
     , LogFormatting (OtherHeaderEnvelopeError blk)
-    , LogFormatting (SelectView (BlockProtocol blk))
+    , LogFormatting (WeightedSelectView (BlockProtocol blk))
     , LogFormatting (ValidationErr (BlockProtocol blk))
     , LogFormatting (CannotForge blk)
     , LogFormatting (ForgeStateUpdateError blk)

cardano-node/src/Cardano/Node/Tracing/Era/HardFork.hs

@@ -19,7 +19,7 @@ import           Cardano.Logging
 import           Cardano.Slotting.Slot (EpochSize (..))
 import           Cardano.Tracing.OrphanInstances.HardFork ()
 import           Ouroboros.Consensus.Block (BlockProtocol, CannotForge, ForgeStateInfo,
-                   ForgeStateUpdateError)
+                   ForgeStateUpdateError, PerasWeight (..))
 import           Ouroboros.Consensus.BlockchainTime (getSlotLength)
 import           Ouroboros.Consensus.Cardano.Condense ()
 import           Ouroboros.Consensus.HardFork.Combinator
@@ -36,7 +36,8 @@ import           Ouroboros.Consensus.HeaderValidation (OtherHeaderEnvelopeError)
 import           Ouroboros.Consensus.Ledger.Abstract (LedgerError)
 import           Ouroboros.Consensus.Ledger.Inspect (LedgerUpdate, LedgerWarning)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
-import           Ouroboros.Consensus.Protocol.Abstract (ValidationErr, TiebreakerView, SelectView(..))
+import           Ouroboros.Consensus.Peras.SelectView
+import           Ouroboros.Consensus.Protocol.Abstract (TiebreakerView, ValidationErr)
 import           Ouroboros.Consensus.TypeFamilyWrappers
 import           Ouroboros.Consensus.Util.Condense (Condense (..))
 
@@ -352,10 +353,11 @@ instance LogFormatting (ForgeStateUpdateError blk) => LogFormatting (WrapForgeSt
 instance All (LogFormatting `Compose` WrapTiebreakerView) xs => LogFormatting (HardForkTiebreakerView xs) where
     forMachine dtal = forMachine dtal . getHardForkTiebreakerView
 
-instance LogFormatting (TiebreakerView protocol) => LogFormatting (SelectView protocol) where
+instance LogFormatting (TiebreakerView protocol) => LogFormatting (WeightedSelectView protocol) where
     forMachine dtal sv = mconcat
-        [ "blockNo"  .= svBlockNo sv
-        , forMachine dtal (svTiebreakerView sv)
+        [ "blockNo"  .= wsvBlockNo sv
+        , "weightBoost" .= unPerasWeight (wsvWeightBoost sv)
+        , forMachine dtal (wsvTiebreaker sv)
         ]
 
 instance All (LogFormatting `Compose` WrapTiebreakerView) xs => LogFormatting (OneEraTiebreakerView xs) where

cardano-node/src/Cardano/Node/Tracing/Era/Shelley.hs

@@ -1073,6 +1073,8 @@ instance
   , LogFormatting (PredicateFailure (Ledger.EraRule "CERTS" era))
   ) => LogFormatting (Conway.ConwayLedgerPredFailure era) where
   forMachine v (Conway.ConwayUtxowFailure f) = forMachine v f
+  forMachine _verb (Conway.ConwayWithdrawalsMissingAccounts _) = mconcat [ "todo" .= String "todo"]
+  forMachine _verb (Conway.ConwayIncompleteWithdrawals _) = mconcat [ "todo" .= String "todo"]
   forMachine _ (Conway.ConwayTxRefScriptsSizeTooBig  Mismatch {mismatchSupplied, mismatchExpected}) =
     mconcat [ "kind" .= String "ConwayTxRefScriptsSizeTooBig"
             , "actual" .= mismatchSupplied