Allow for different DB paths for immutable and volatile data (#1199)

Part of IntersectMBO/cardano-node#5925, only pending integration into
the node.

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs

@@ -71,6 +71,7 @@ analyse DBAnalyserConfig{analysis, confLimit, dbDir, selectDB, validation, verbo
                   chunkInfo
                   (const True)
                   (Node.stdMkChainDbHasFS dbDir)
+                  (Node.stdMkChainDbHasFS dbDir)
               $ defaultArgs
           immutableDbArgs = ChainDB.cdbImmDbArgs chainDbArgs
           ledgerDbFS = lgrHasFS $ ChainDB.cdbLgrDbArgs chainDbArgs

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Run.hs

@@ -131,6 +131,7 @@ synthesize genTxs DBSynthesizerConfig{confOptions, confShelleyGenesis, confDbDir
               chunkInfo
               (const True)
               (Node.stdMkChainDbHasFS confDbDir)
+              (Node.stdMkChainDbHasFS confDbDir)
               $ ChainDB.defaultArgs
 
         forgers <- blockForging

ouroboros-consensus-diffusion/changelog.d/js-flexible-databases.md

@@ -0,0 +1,5 @@
+### Breaking
+
+- The `StdRunNodeArgs(srnDatabasePath)` argument becomes of type `NodeDatabasePaths`
+  which will allow storing the immutable db (which doesn't need to be in a very
+  performant device) somewhere different than the volatile data.

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

@@ -42,6 +42,7 @@ module Ouroboros.Consensus.Node (
   , LastShutDownWasClean (..)
   , LowLevelRunNodeArgs (..)
   , MempoolCapacityBytesOverride (..)
+  , NodeDatabasePaths (..)
   , NodeKernel (..)
   , NodeKernelArgs (..)
   , ProtocolInfo (..)
@@ -221,9 +222,13 @@ data LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk
       -- | The " static " ChainDB arguments
     , llrnChainDbArgsDefaults :: Incomplete ChainDbArgs m blk
 
-      -- | File-system on which the directories for the different databases will
+      -- | File-system on which the directory for the ImmutableDB will
       -- be created.
-    , llrnMkHasFS :: ChainDB.RelativeMountPoint -> SomeHasFS m
+    , llrnMkImmutableHasFS :: ChainDB.RelativeMountPoint -> SomeHasFS m
+
+      -- | File-system on which the directories for databases other than the ImmutableDB will
+      -- be created.
+    , llrnMkVolatileHasFS :: ChainDB.RelativeMountPoint -> SomeHasFS m
 
       -- | Customise the 'ChainDbArgs'
     , llrnCustomiseChainDbArgs ::
@@ -285,6 +290,27 @@ data LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk
     , llrnPublicPeerSelectionStateVar :: StrictSTM.StrictTVar m (Diffusion.PublicPeerSelectionState addrNTN)
     }
 
+data NodeDatabasePaths =
+    OnePathForAllDbs
+      FilePath -- ^ Databases will be stored under this path, such that given a
+               -- path @/foo@, databases will be in @/foo/{immutable,volatile,...}@.
+  | MultipleDbPaths
+      FilePath -- ^ Immutable path, usually pointing to a non-necessarily
+               -- performant volume. ImmutableDB will be stored under this path,
+               -- so given @/foo@, the ImmutableDB will be in @/foo/immutable@.
+      FilePath -- ^ Non-immutable (volatile data) path, usually pointing to a
+               -- performant volume. Databases other than the ImmutableDB will
+               -- be stored under this path, so given @/bar@, it will contain
+               -- @/bar/{volatile,ledger,...}@.
+
+immutableDbPath :: NodeDatabasePaths -> FilePath
+immutableDbPath (OnePathForAllDbs f)    = f
+immutableDbPath (MultipleDbPaths imm _) = imm
+
+nonImmutableDbPath :: NodeDatabasePaths -> FilePath
+nonImmutableDbPath (OnePathForAllDbs f)    = f
+nonImmutableDbPath (MultipleDbPaths _ vol) = vol
+
 -- | Higher-level arguments that can determine the 'LowLevelRunNodeArgs' under
 -- some usual assumptions for realistic use cases such as in @cardano-node@.
 --
@@ -295,7 +321,7 @@ data StdRunNodeArgs m blk (p2p :: Diffusion.P2P) = StdRunNodeArgs
   , srnChainDbValidateOverride      :: Bool
     -- ^ If @True@, validate the ChainDB on init no matter what
   , srnDiskPolicyArgs               :: DiskPolicyArgs
-  , srnDatabasePath                 :: FilePath
+  , srnDatabasePath                 :: NodeDatabasePaths
     -- ^ Location of the DBs
   , srnDiffusionArguments           :: Diffusion.Arguments
                                          IO
@@ -431,7 +457,8 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} =
                      inFuture
                      cfg
                      initLedger
-                     llrnMkHasFS
+                     llrnMkImmutableHasFS
+                     llrnMkVolatileHasFS
                      llrnChainDbArgsDefaults
                      (  setLoEinChainDbArgs
                       . maybeValidateAll
@@ -686,20 +713,24 @@ openChainDB ::
   -> ExtLedgerState blk
      -- ^ Initial ledger
   -> (ChainDB.RelativeMountPoint -> SomeHasFS m)
+     -- ^ Immutable FS, see 'NodeDatabasePaths'
+  -> (ChainDB.RelativeMountPoint -> SomeHasFS m)
+     -- ^ Volatile FS, see 'NodeDatabasePaths'
   -> Incomplete ChainDbArgs m blk
      -- ^ A set of default arguments (possibly modified from 'defaultArgs')
   -> (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
       -- ^ Customise the 'ChainDbArgs'
   -> m (ChainDB m blk, Complete ChainDbArgs m blk)
-openChainDB registry inFuture cfg initLedger fs defArgs customiseArgs =
+openChainDB registry inFuture cfg initLedger fsImm fsVol defArgs customiseArgs =
    let args = customiseArgs $ ChainDB.completeChainDbArgs
                registry
                inFuture
                cfg
                initLedger
                (nodeImmutableDbChunkInfo (configStorage cfg))
                (nodeCheckIntegrity (configStorage cfg))
-               fs
+               fsImm
+               fsVol
                defArgs
       in (,args) <$> ChainDB.openDB args
 
@@ -876,7 +907,8 @@ stdLowLevelRunNodeArgsIO RunNodeArgs{ rnProtocolInfo
       , llrnCustomiseHardForkBlockchainTimeArgs = id
       , llrnGsmAntiThunderingHerd
       , llrnKeepAliveRng
-      , llrnMkHasFS = stdMkChainDbHasFS srnDatabasePath
+      , llrnMkImmutableHasFS = stdMkChainDbHasFS $ immutableDbPath srnDatabasePath
+      , llrnMkVolatileHasFS = stdMkChainDbHasFS $ nonImmutableDbPath srnDatabasePath
       , llrnChainDbArgsDefaults = updateChainDbDefaults ChainDB.defaultArgs
       , llrnCustomiseChainDbArgs = id
       , llrnCustomiseNodeKernelArgs
@@ -910,7 +942,9 @@ stdLowLevelRunNodeArgsIO RunNodeArgs{ rnProtocolInfo
             snd
             (supportedNodeToClientVersions (Proxy @blk))
       , llrnWithCheckedDB =
-          stdWithCheckedDB (Proxy @blk) srnTraceChainDB srnDatabasePath networkMagic
+          -- 'stdWithCheckedDB' uses the FS just to check for the clean file.
+          -- We put that one in the immutable path.
+          stdWithCheckedDB (Proxy @blk) srnTraceChainDB (immutableDbPath srnDatabasePath) networkMagic
       , llrnMaxCaughtUpAge = secondsToNominalDiffTime $ 20 * 60   -- 20 min
       , llrnMaxClockSkew =
           InFuture.defaultClockSkew

ouroboros-consensus/changelog.d/js-flexible-databases.md

@@ -0,0 +1,5 @@
+### Breaking
+
+- `completeChainDbArgs` now requires two file-systems. This allows to place the
+  immutable data (which doesn't need to be stored in a very performant device)
+  somewhere else than the volatile data.

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs

@@ -159,6 +159,9 @@ completeChainDbArgs ::
   -> (blk -> Bool)
      -- ^ Check integrity
   -> (RelativeMountPoint -> SomeHasFS m)
+     -- ^ Immutable FS, see 'NodeDatabasePaths'
+  -> (RelativeMountPoint -> SomeHasFS m)
+     -- ^ Volatile  FS, see 'NodeDatabasePaths'
   -> Incomplete ChainDbArgs m blk
      -- ^ A set of incomplete arguments, possibly modified wrt @defaultArgs@
   -> Complete ChainDbArgs m blk
@@ -169,31 +172,32 @@ completeChainDbArgs
   initLedger
   immChunkInfo
   checkIntegrity
-  mkFS
+  mkImmFS
+  mkVolFS
   defArgs
   = defArgs {
       cdbImmDbArgs = (cdbImmDbArgs defArgs) {
             ImmutableDB.immChunkInfo
           , ImmutableDB.immCheckIntegrity = checkIntegrity
           , ImmutableDB.immRegistry       = registry
           , ImmutableDB.immCodecConfig    = configCodec cdbsTopLevelConfig
-          , ImmutableDB.immHasFS          = mkFS $ RelativeMountPoint "immutable"
+          , ImmutableDB.immHasFS          = mkImmFS $ RelativeMountPoint "immutable"
           }
       , cdbVolDbArgs = (cdbVolDbArgs defArgs) {
-            VolatileDB.volHasFS          = mkFS $ RelativeMountPoint "volatile"
+            VolatileDB.volHasFS          = mkVolFS $ RelativeMountPoint "volatile"
           , VolatileDB.volCheckIntegrity = checkIntegrity
           , VolatileDB.volCodecConfig    = configCodec cdbsTopLevelConfig
           }
       , cdbLgrDbArgs = (cdbLgrDbArgs defArgs) {
             LedgerDB.lgrGenesis    = pure initLedger
-          , LedgerDB.lgrHasFS      = mkFS $ RelativeMountPoint "ledger"
+          , LedgerDB.lgrHasFS      = mkVolFS $ RelativeMountPoint "ledger"
           , LedgerDB.lgrConfig     = LedgerDB.configLedgerDb cdbsTopLevelConfig
           }
       , cdbsArgs = (cdbsArgs defArgs) {
             cdbsCheckInFuture
           , cdbsRegistry       = registry
           , cdbsTopLevelConfig
-          , cdbsHasFSGsmDB     = mkFS $ RelativeMountPoint "gsm"
+          , cdbsHasFSGsmDB     = mkVolFS $ RelativeMountPoint "gsm"
           }
       }