Define mk*Args for all backends

Author: jasagredo

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

@@ -173,11 +173,11 @@ import Ouroboros.Network.Protocol.ChainSync.Codec (timeLimitsChainSync)
 import Ouroboros.Network.RethrowPolicy
 import qualified SafeWildCards
 import System.Exit (ExitCode (..))
-import System.FS.API (SomeHasFS (..), mkFsPath)
+import System.FS.API (SomeHasFS (..))
 import System.FS.API.Types (MountPoint (..))
 import System.FS.IO (ioHasFS)
-import System.FilePath (splitDirectories, (</>))
-import System.Random (StdGen, genWord64, newStdGen, randomIO, split)
+import System.FilePath ((</>))
+import System.Random (StdGen, newStdGen, randomIO, split)
 
 {-------------------------------------------------------------------------------
   The arguments to the Consensus Layer node functionality
@@ -1050,20 +1050,6 @@ stdLowLevelRunNodeArgsIO
         , llrnPublicPeerSelectionStateVar =
             Diffusion.dcPublicPeerSelectionVar srnDiffusionConfiguration
         , llrnLdbFlavorArgs = srnLedgerDbBackendArgs
-        -- case srnLedgerDbBackendArgs of
-        --   V1LMDB args -> LedgerDbFlavorArgsV1 args
-        --   V2InMemory -> LedgerDbFlavorArgsV2 (V2.V2Args V2.InMemoryHandleArgs)
-        --   V2LSM path ->
-        --     LedgerDbFlavorArgsV2
-        --       ( V2.V2Args
-        --           ( V2.LSMHandleArgs
-        --               ( V2.LSMArgs
-        --                   (mkFsPath $ splitDirectories path)
-        --                   lsmSalt
-        --                   (LSM.stdMkBlockIOFS (nonImmutableDbPath srnDatabasePath))
-        --               )
-        --           )
-        --       )
         }
    where
     networkMagic :: NetworkMagic

ouroboros-consensus/ouroboros-consensus.cabal

@@ -373,6 +373,7 @@ library ouroboros-consensus-lsm
     Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
 
   build-depends:
+    FailT,
     base >=4.14 && <4.22,
     blockio,
     cardano-binary,

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

@@ -21,6 +21,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB
   , Backend (..)
   , Args (LMDBBackingStoreArgs)
   , LMDBLimits (LMDBLimits, lmdbMapSize, lmdbMaxDatabases, lmdbMaxReaders)
+  , mkLMDBArgs
 
     -- * Streaming
   , YieldArgs (YieldLMDB)
@@ -62,9 +63,11 @@ import Ouroboros.Consensus.Ledger.Basics
 import qualified Ouroboros.Consensus.Ledger.Tables.Diff as Diff
 import Ouroboros.Consensus.Ledger.Tables.Utils (emptyLedgerTables)
 import Ouroboros.Consensus.Storage.LedgerDB.API
+import Ouroboros.Consensus.Storage.LedgerDB.Args
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
   ( SnapshotBackend (..)
   )
+import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Args as V1
 import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API as API
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB.Bridge as Bridge
@@ -813,6 +816,20 @@ instance
       limits
       (LiveLMDBFS $ FS.SomeHasFS $ ioHasFS $ FS.MountPoint fs)
 
+-- | Create arguments for initializing the LedgerDB using the LMDB backend.
+mkLMDBArgs ::
+  ( MonadIOPrim m
+  , HasLedgerTables (LedgerState blk)
+  , IOLike m
+  ) =>
+  V1.FlushFrequency -> FilePath -> LMDBLimits -> a -> (LedgerDbBackendArgs m blk, a)
+mkLMDBArgs flushing lmdbPath limits =
+  (,) $
+    LedgerDbBackendArgsV1 $
+      V1.V1Args flushing $
+        SomeBackendArgs $
+          LMDBBackingStoreArgs lmdbPath limits Dict.Dict
+
 class (MonadIO m, PrimState m ~ PrimState IO) => MonadIOPrim m
 instance (MonadIO m, PrimState m ~ PrimState IO) => MonadIOPrim m
 

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

@@ -76,6 +76,7 @@ import Ouroboros.Consensus.Ledger.SupportsProtocol
 import qualified Ouroboros.Consensus.Ledger.Tables.Diff as Diff
 import Ouroboros.Consensus.Ledger.Tables.Utils
 import Ouroboros.Consensus.Storage.LedgerDB.API
+import Ouroboros.Consensus.Storage.LedgerDB.Args
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.V2
 import Ouroboros.Consensus.Storage.LedgerDB.V2.Backend
@@ -475,10 +476,19 @@ stdMkBlockIOFS fastStoragePath rr = do
 
 data LSM
 
-mkLSMArgs :: FilePath -> StdGen -> FilePath -> (Args IO LSM, StdGen)
-mkLSMArgs fp gen fastStorage =
+-- | Create arguments for initializing the LedgerDB using the LSM-trees backend.
+mkLSMArgs ::
+  ( LedgerSupportsProtocol blk
+  , LedgerDbSerialiseConstraints blk
+  ) =>
+  Proxy blk -> FilePath -> FilePath -> StdGen -> (LedgerDbBackendArgs IO blk, StdGen)
+mkLSMArgs _ fp fastStorage gen =
   let (lsmSalt, gen') = genWord64 gen
-   in (LSMArgs (mkFsPath $ splitDirectories fp) lsmSalt (stdMkBlockIOFS fastStorage), gen')
+   in ( LedgerDbBackendArgsV2 $
+          SomeBackendArgs $
+            LSMArgs (mkFsPath $ splitDirectories fp) lsmSalt (stdMkBlockIOFS fastStorage)
+      , gen'
+      )
 
 instance
   ( LedgerSupportsProtocol blk

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

@@ -42,6 +42,8 @@ import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
 import Ouroboros.Consensus.Storage.LedgerDB (LedgerDbBackendArgs)
 import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
+import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Backend as LedgerDB
+import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as InMemory
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import Ouroboros.Consensus.Util.Args
 import Ouroboros.Consensus.Util.IOLike
@@ -142,7 +144,7 @@ defaultArgs =
   ChainDbArgs
     ImmutableDB.defaultArgs
     VolatileDB.defaultArgs
-    LedgerDB.defaultArgs
+    (LedgerDB.defaultArgs $ LedgerDB.SomeBackendArgs InMemory.InMemArgs)
     defaultSpecificArgs
 
 ensureValidateAll ::

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Args.hs

@@ -22,15 +22,12 @@ import GHC.Generics (Generic)
 import NoThunks.Class
 import Ouroboros.Consensus.Ledger.Abstract
 import Ouroboros.Consensus.Ledger.Extended
-import Ouroboros.Consensus.Ledger.SupportsProtocol
 import Ouroboros.Consensus.Storage.LedgerDB.API
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.TraceEvent
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Args as V1
 import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Backend as V2
-import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
 import Ouroboros.Consensus.Util.Args
-import Ouroboros.Consensus.Util.IOLike
 import System.FS.API
 
 {-------------------------------------------------------------------------------
@@ -60,13 +57,10 @@ data LedgerDbArgs f m blk = LedgerDbArgs
 
 -- | Default arguments
 defaultArgs ::
-  ( IOLike m
-  , LedgerDbSerialiseConstraints blk
-  , LedgerSupportsProtocol blk
-  , LedgerSupportsInMemoryLedgerDB (LedgerState blk)
-  ) =>
+  Applicative m =>
+  V2.SomeBackendArgs m blk ->
   Incomplete LedgerDbArgs m blk
-defaultArgs =
+defaultArgs backendArgs =
   LedgerDbArgs
     { lgrSnapshotPolicyArgs = defaultSnapshotPolicyArgs
     , lgrGenesis = NoDefault
@@ -76,7 +70,7 @@ defaultArgs =
     , lgrTracer = nullTracer
     , -- This value is the closest thing to a pre-UTxO-HD node, and as such it
       -- will be the default for end-users.
-      lgrBackendArgs = LedgerDbBackendArgsV2 $ V2.SomeBackendArgs InMemArgs
+      lgrBackendArgs = LedgerDbBackendArgsV2 backendArgs
     , lgrRegistry = NoDefault
     , lgrStartSnapshot = Nothing
     }

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

@@ -20,6 +20,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
   , Mem
   , YieldArgs (YieldInMemory)
   , SinkArgs (SinkInMemory)
+  , mkInMemoryArgs
   ) where
 
 import Cardano.Binary as CBOR
@@ -57,6 +58,7 @@ import Ouroboros.Consensus.Ledger.SupportsProtocol
 import qualified Ouroboros.Consensus.Ledger.Tables.Diff as Diff
 import Ouroboros.Consensus.Ledger.Tables.Utils
 import Ouroboros.Consensus.Storage.LedgerDB.API
+import Ouroboros.Consensus.Storage.LedgerDB.Args
 import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
 import Ouroboros.Consensus.Storage.LedgerDB.V2.Backend
 import Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq
@@ -298,6 +300,16 @@ instance
   snapshotManager _ _ =
     Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory.snapshotManager
 
+-- | Create arguments for initializing the LedgerDB using the InMemory backend.
+mkInMemoryArgs ::
+  ( IOLike m
+  , LedgerDbSerialiseConstraints blk
+  , LedgerSupportsProtocol blk
+  , LedgerSupportsInMemoryLedgerDB (LedgerState blk)
+  ) =>
+  a -> (LedgerDbBackendArgs m blk, a)
+mkInMemoryArgs = (,) $ LedgerDbBackendArgsV2 $ SomeBackendArgs InMemArgs
+
 instance IOLike m => StreamingBackend m Mem l where
   data YieldArgs m Mem l
     = -- \| Yield an in-memory snapshot