Make LMDBLimits a newtype for ease of importing its interface.

Also: Fix `db-analyser` and `ledger-db-backends-checker` CI failures.
IntersectMBO · Jun 21, 2022 · dec711b · dec711b
1 parent 5346dad
commit dec711b
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 13 deletions.
diff --git a/ouroboros-consensus-cardano/tools/db-analyser/Main.hs b/ouroboros-consensus-cardano/tools/db-analyser/Main.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE NumericUnderscores  #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -31,8 +32,7 @@ import           Ouroboros.Consensus.Storage.ChainDB.Impl.Args (fromChainDbArgs)
 import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
                      (SnapshotInterval (..), defaultDiskPolicy)
-import           Ouroboros.Consensus.Storage.LedgerDB.HD.LMDB
-                     (defaultLMDBLimits, mapSize)
+import           Ouroboros.Consensus.Storage.LedgerDB.HD.LMDB (LMDBLimits (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.OnDisk
                      (BackingStoreSelector (..), DiskSnapshot (..))
 import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
@@ -288,7 +288,7 @@ analyse CmdLine {..} args =
                 LMDB mapsize ->
                   maybe
                     (LMDBBackingStore defaultLMDBLimits)
-                    (\n -> LMDBBackingStore (defaultLMDBLimits { mapSize = n }))
+                    (\n -> LMDBBackingStore (defaultLMDBLimits { lmdbMapSize = n }))
                     mapsize
 
           ImmutableDB.withDB (ImmutableDB.openDB immutableDbArgs runWithTempRegistry) $ \immutableDB -> do
@@ -337,3 +337,9 @@ analyse CmdLine {..} args =
       (_, Just MinimumBlockValidation) -> VolatileDB.NoValidation
       (OnlyValidation, _ )             -> VolatileDB.ValidateAll
       _                                -> VolatileDB.NoValidation
+
+    defaultLMDBLimits = LMDBLimits {
+      lmdbMapSize      = 16_000_000_000
+    , lmdbMaxDatabases = 10
+    , lmdbMaxReaders   = 16
+    }
diff --git a/ouroboros-consensus-cardano/tools/ledger-db-backends-checker/Main.hs b/ouroboros-consensus-cardano/tools/ledger-db-backends-checker/Main.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE MonoLocalBinds      #-}
+{-# LANGUAGE NumericUnderscores  #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections       #-}
 -- | This tiny executable loads an in-mem backing store and an lmdb backing store and checks:
@@ -80,7 +81,7 @@ getMemDb f = do
 
 getLMDB :: (TranslateProto (TPraos StandardCrypto) (Praos StandardCrypto)) => FilePath -> IO (WithOrigin SlotNo, LedgerTables (ExtLedgerState (CardanoBlock StandardCrypto)) ValuesMK)
 getLMDB dbFilePath = do
-  dbEnv <- LMDB.openEnvironment dbFilePath Consensus.LMDB.defaultLMDBLimits
+  dbEnv <- LMDB.openEnvironment dbFilePath (LMDB.Limits 16_000_000_000 10 16)
   Just dbSettings <- LMDB.readWriteTransaction dbEnv $ (LMDB.getDatabase (Just "_dbstate") :: LMDB.Transaction LMDB.ReadWrite (LMDB.Database () Consensus.LMDB.DbState)) >>= flip LMDB.get ()
   dbBackingTables <- LMDB.readWriteTransaction dbEnv $ traverseLedgerTables (\(NameMK name) -> Consensus.LMDB.LMDBMK name <$> LMDB.getDatabase (Just name)) namesLedgerTables
   (Consensus.LMDB.dbsSeq dbSettings,) <$> (LMDB.readWriteTransaction dbEnv (zipLedgerTablesA f dbBackingTables codecLedgerTables) :: IO (LedgerTables (ExtLedgerState (CardanoBlock StandardCrypto)) ValuesMK))

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/HD/LMDB.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/HD/LMDB.hs
@@ -16,11 +16,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.HD.LMDB (
   , TraceDb (..)
   , newLMDBBackingStore
     -- * Configuration
-  , LMDBLimits
-  , lmdbMapSize
-  , lmdbMaxDatabases
-  , lmdbMaxReaders
-  , pattern LMDBLimits
+  , LMDBLimits (LMDBLimits, lmdbMapSize, lmdbMaxDatabases, lmdbMaxReaders)
     -- * Exported for ledger-db-backends-checker
   , DbState (..)
   , LMDBMK (..)
@@ -198,8 +194,9 @@ data Db m l = Db {
 newVHId :: Map Int (ValueHandle m) -> Int
 newVHId openHdls = maybe 0 ((+1) . fst) $ Map.lookupMax openHdls
 
-type LMDBLimits = LMDB.Limits
+newtype LMDBLimits = MkLMDBLimits {unLMDBLimits :: LMDB.Limits}
 
+{-# COMPLETE LMDBLimits #-}
 -- | Configuration to use for LMDB backing store initialisation.
 --
 -- Keep the following in mind:
@@ -209,7 +206,7 @@ type LMDBLimits = LMDB.Limits
 --    @'DbSettings'@, and 1 for the database state @'DbState'@.
 pattern LMDBLimits :: Int -> Int -> Int -> LMDBLimits
 pattern LMDBLimits{lmdbMapSize, lmdbMaxDatabases, lmdbMaxReaders} =
-  LMDB.Limits {
+  MkLMDBLimits LMDB.Limits {
     LMDB.mapSize = lmdbMapSize
   , LMDB.maxDatabases = lmdbMaxDatabases
   , LMDB.maxReaders = lmdbMaxReaders
@@ -593,7 +590,7 @@ initFromLMDBs tracer limits shfs from0 to0 = do
     from <- guardDbDir GDDMustExist shfs from0
     to <- guardDbDirWithRetry GDDMustNotExist shfs to0
     bracket
-      (liftIO $ LMDB.openEnvironment from limits)
+      (liftIO $ LMDB.openEnvironment from (unLMDBLimits limits))
       (liftIO . LMDB.closeEnvironment)
       (flip (lmdbCopy tracer) to)
     Trace.traceWith tracer $ TDBInitialisedFromLMDBD to0
@@ -652,7 +649,7 @@ newLMDBBackingStore dbTracer limits sfs initDb = do
   copyDbAction
 
   -- open this database
-  dbEnv <- liftIO $ LMDB.openEnvironment dbFilePath limits
+  dbEnv <- liftIO $ LMDB.openEnvironment dbFilePath (unLMDBLimits limits)
 
   -- Create the settings table.
   dbSettings <- liftIO $ LMDB.readWriteTransaction dbEnv $ LMDB.getDatabase (Just "_dbsettings")