Expose hidden entities and small tweaks for integrating LSM-trees into the node

ouroboros-consensus-diffusion/changelog.d/20251023_154349_javier.sagredo_expose_for_node.md

@@ -0,0 +1,23 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+
+### Breaking
+
+- `srnLedgerDbBackendArgs` now receives and returns a `StdGen` argument.

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs

@@ -42,6 +42,8 @@ module Ouroboros.Consensus.Node
   , LowLevelRunNodeArgs (..)
   , MempoolCapacityBytesOverride (..)
   , NodeDatabasePaths (..)
+  , immutableDbPath
+  , nonImmutableDbPath
   , NodeKernel (..)
   , NodeKernelArgs (..)
   , ProtocolInfo (..)
@@ -375,7 +377,7 @@ data
   , -- Ad hoc values to replace default ChainDB configurations
     srnSnapshotPolicyArgs :: SnapshotPolicyArgs
   , srnQueryBatchSize :: QueryBatchSize
-  , srnLedgerDbBackendArgs :: LedgerDbBackendArgs m blk
+  , srnLedgerDbBackendArgs :: (StdGen -> (LedgerDbBackendArgs m blk, StdGen))
   }
 
 {-------------------------------------------------------------------------------
@@ -1004,7 +1006,7 @@ stdLowLevelRunNodeArgsIO
     }
   $(SafeWildCards.fields 'StdRunNodeArgs) = do
     llrnBfcSalt <- stdBfcSaltIO
-    llrnRng <- newStdGen
+    (ldbBackendArgs, llrnRng) <- srnLedgerDbBackendArgs <$> newStdGen
     pure
       LowLevelRunNodeArgs
         { llrnBfcSalt
@@ -1049,7 +1051,7 @@ stdLowLevelRunNodeArgsIO
             InFutureCheck.defaultClockSkew
         , llrnPublicPeerSelectionStateVar =
             Diffusion.dcPublicPeerSelectionVar srnDiffusionConfiguration
-        , llrnLdbFlavorArgs = srnLedgerDbBackendArgs
+        , llrnLdbFlavorArgs = ldbBackendArgs
         }
    where
     networkMagic :: NetworkMagic

ouroboros-consensus/changelog.d/20251023_154344_javier.sagredo_expose_for_node.md

@@ -0,0 +1,18 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+### Patch
+
+- LSM-trees database directory is now created on startup.
+
+### Non-Breaking
+
+- Expose `Ouroboros.Consensus.Storage.LedgerDB.(V1.BackingStore|V2).Backend(Trace)` constructors.
+
+### Breaking
+
+- `Ouroboros.Consensus.Storage.LedgerDB.(V1.BackingStore|V2).Backend(Trace)` no longer depends on the running monad `m`.

ouroboros-consensus/src/ouroboros-consensus-lmdb/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/LMDB.hs

@@ -22,6 +22,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB
     LMDB
   , Backend (..)
   , Args (LMDBBackingStoreArgs)
+  , Trace (OnDiskBackingStoreInitialise, OnDiskBackingStoreTrace)
   , LMDBLimits (LMDBLimits, lmdbMapSize, lmdbMaxDatabases, lmdbMaxReaders)
   , mkLMDBArgs
 
@@ -832,7 +833,7 @@ instance
   where
   data Args m LMDB
     = LMDBBackingStoreArgs FilePath LMDBLimits (Dict.Dict MonadIOPrim m)
-  data Trace m LMDB
+  data Trace LMDB
     = OnDiskBackingStoreInitialise LMDB.Limits
     | OnDiskBackingStoreTrace BackingStoreTrace
     deriving (Eq, Show)

ouroboros-consensus/src/ouroboros-consensus-lsm/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs

@@ -25,6 +25,8 @@ module Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
     LSM
   , Backend (..)
   , Args (LSMArgs)
+  , Trace (LSMTreeTrace)
+  , LSM.LSMTreeTrace (..)
   , mkLSMArgs
   , stdMkBlockIOFS
 
@@ -571,12 +573,13 @@ instance
     }
     deriving Generic
 
-  data Trace m LSM
+  data Trace LSM
     = LSMTreeTrace !LSM.LSMTreeTrace
     deriving Show
 
   mkResources _ trcr (LSMArgs path salt mkFS) reg _ = do
     (rk1, SomeHasFSAndBlockIO fs blockio) <- mkFS reg
+    createDirectoryIfMissing fs True path
     session <-
       allocate
         reg

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore.hs

@@ -32,6 +32,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore
 import Cardano.Slotting.Slot
 import Control.Tracer
 import Data.Proxy
+import Data.Typeable
 import Ouroboros.Consensus.Ledger.Basics
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API
@@ -67,15 +68,15 @@ data SomeBackendArgs m l where
   SomeBackendArgs :: Backend m backend l => Args m backend -> SomeBackendArgs m l
 
 data SomeBackendTrace where
-  SomeBackendTrace :: Show (Trace m backend) => Trace m backend -> SomeBackendTrace
+  SomeBackendTrace :: (Show (Trace backend), Typeable backend) => Trace backend -> SomeBackendTrace
 
 instance Show SomeBackendTrace where
   show (SomeBackendTrace tr) = show tr
 
 class Backend m backend l where
   data Args m backend
 
-  data Trace m backend
+  data Trace backend
 
   isRightBackendForSnapshot ::
     Proxy l ->

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/BackingStore/Impl/InMemory.hs

@@ -360,7 +360,7 @@ instance
   Backend m Mem l
   where
   data Args m Mem = InMemArgs
-  data Trace m Mem
+  data Trace Mem
     = InMemoryBackingStoreInitialise
     | InMemoryBackingStoreTrace BackingStoreTrace
     deriving (Eq, Show)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/Backend.hs

@@ -23,6 +23,7 @@ import Control.Monad.Except
 import Control.ResourceRegistry
 import Control.Tracer
 import Data.Proxy
+import Data.Typeable
 import NoThunks.Class
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.Ledger.Abstract
@@ -41,7 +42,7 @@ class NoThunks (Resources m backend) => Backend m backend blk where
   data Resources m backend
 
   -- | A trace dependent on the particular backend.
-  data Trace m backend
+  data Trace backend
 
   -- | Transform 'Args' into 'Resources', with some context made up of
   -- 'LedgerDbArgs'.
@@ -89,7 +90,8 @@ class NoThunks (Resources m backend) => Backend m backend blk where
 -------------------------------------------------------------------------------}
 
 data SomeBackendTrace where
-  SomeBackendTrace :: Show (Trace m backend) => Trace m backend -> SomeBackendTrace
+  SomeBackendTrace ::
+    (Show (Trace backend), Typeable backend) => Trace backend -> SomeBackendTrace
 
 instance Show SomeBackendTrace where
   show (SomeBackendTrace tr) = show tr

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs

@@ -18,6 +18,7 @@
 module Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
   ( Backend (..)
   , Args (InMemArgs)
+  , Trace (NoTrace)
   , Mem
   , YieldArgs (YieldInMemory)
   , SinkArgs (SinkInMemory)
@@ -363,7 +364,7 @@ instance
   data Args m Mem = InMemArgs
   newtype Resources m Mem = Resources (SomeHasFS m)
     deriving newtype NoThunks
-  newtype Trace m Mem = NoTrace Void
+  newtype Trace Mem = NoTrace Void
     deriving newtype Show
 
   mkResources _ _ _ _ = pure . Resources