11{-# LANGUAGE DataKinds #-}
22{-# LANGUAGE DerivingStrategies #-}
3+ {-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE GeneralisedNewtypeDeriving #-}
5+ {-# LANGUAGE ScopedTypeVariables #-}
6+ {-# LANGUAGE TypeApplications #-}
47
58{-# OPTIONS_GHC -Wno-orphans #-}
69
710module Cardano.Node.Configuration.LedgerDB (
8- DeprecatedOptions (.. )
9- , LedgerDbConfiguration (.. )
10- , LedgerDbSelectorFlag (.. )
11- , Gigabytes
12- , noDeprecatedOptions
13- , selectorToArgs
14- ) where
11+ DeprecatedOptions (.. ),
12+ LedgerDbConfiguration (.. ),
13+ LedgerDbSelectorFlag (.. ),
14+ Gigabytes ,
15+ noDeprecatedOptions ,
16+ selectorToArgs ,
17+ ) where
1518
19+ import Ouroboros.Consensus.Ledger.SupportsProtocol
20+ import Ouroboros.Consensus.Storage.LedgerDB.API
1621import Ouroboros.Consensus.Storage.LedgerDB.Args
1722import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
1823import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.Args as V1
19- import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB ( LMDBLimits ( .. ))
20- import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Args as V2
21- import Ouroboros.Consensus.Util.Args
24+ import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB as LMDB
25+ import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as InMemory
26+ import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.LSM as LSM
2227
2328import qualified Data.Aeson.Types as Aeson (FromJSON )
2429import Data.Maybe (fromMaybe )
25- import Data.SOP.Dict
30+ import Data.Proxy
31+ import System.FilePath
32+ import System.Random (StdGen )
2633
2734-- | Choose the LedgerDB Backend
2835--
@@ -34,21 +41,25 @@ import Data.SOP.Dict
3441--
3542-- - 'V1LMDB': uses less memory but is somewhat slower.
3643--
37- -- - 'V1InMemory': Not intended for production. It is an in-memory reproduction
38- -- of the LMDB implementation.
44+ -- - 'V2LSM': Uses the LSM backend.
3945data LedgerDbSelectorFlag =
4046 V1LMDB
4147 V1. FlushFrequency
4248 -- ^ The frequency at which changes are flushed to the disk.
4349 (Maybe FilePath )
44- -- ^ Path for the live tables.
50+ -- ^ Path for the live tables. If not provided the default will be used
51+ -- (@<fast-storage>/lmdb@).
4552 (Maybe Gigabytes )
4653 -- ^ A map size can be specified, this is the maximum disk space the LMDB
4754 -- database can fill. If not provided, the default of 16GB will be used.
4855 (Maybe Int )
4956 -- ^ An override to the max number of readers.
50- | V1InMemory V1. FlushFrequency
5157 | V2InMemory
58+ | V2LSM
59+ (Maybe FilePath )
60+ -- ^ Maybe a custom path to the LSM database. If not provided the default
61+ -- will be used (@<fast-storage>/lsm@).
62+
5263 deriving (Eq , Show )
5364
5465-- | Some options that existed in the TopLevel were now moved to a
@@ -118,24 +129,23 @@ toBytes (Gigabytes x) = x * 1024 * 1024 * 1024
118129-- * The @lmdb-simple@ and @haskell-lmdb@ forked repositories.
119130-- * The official LMDB API documentation at
120131-- <http://www.lmdb.tech/doc/group__mdb.html>.
121- defaultLMDBLimits :: LMDBLimits
122- defaultLMDBLimits = LMDBLimits {
123- lmdbMapSize = 16 * 1024 * 1024 * 1024
124- , lmdbMaxDatabases = 10
125- , lmdbMaxReaders = 16
132+ defaultLMDBLimits :: LMDB. LMDBLimits
133+ defaultLMDBLimits = LMDB. LMDBLimits {
134+ LMDB. lmdbMapSize = 16 * 1024 * 1024 * 1024
135+ , LMDB. lmdbMaxDatabases = 10
136+ , LMDB. lmdbMaxReaders = 16
126137 }
127138
128- defaultLMDBPath :: FilePath
129- defaultLMDBPath = " mainnet/db/ lmdb"
139+ defaultLMDBPath :: FilePath -> FilePath
140+ defaultLMDBPath = ( </> " lmdb" )
130141
131- selectorToArgs :: LedgerDbSelectorFlag -> Complete LedgerDbFlavorArgs IO
132- selectorToArgs (V1InMemory ff) = LedgerDbFlavorArgsV1 $ V1. V1Args ff V1. InMemoryBackingStoreArgs
133- selectorToArgs V2InMemory = LedgerDbFlavorArgsV2 $ V2. V2Args V2. InMemoryHandleArgs
134- selectorToArgs (V1LMDB ff fp l mxReaders) =
135- LedgerDbFlavorArgsV1
136- $ V1. V1Args ff
137- $ V1. LMDBBackingStoreArgs
138- (fromMaybe defaultLMDBPath fp)
139- (maybe id (\ overrideMaxReaders lim -> lim { lmdbMaxReaders = overrideMaxReaders }) mxReaders
140- $ maybe id (\ ll lim -> lim { lmdbMapSize = toBytes ll }) l defaultLMDBLimits)
141- Dict
142+ selectorToArgs :: forall blk . (LedgerSupportsProtocol blk , LedgerSupportsLedgerDB blk ) => LedgerDbSelectorFlag -> FilePath -> StdGen -> (LedgerDbBackendArgs IO blk , StdGen )
143+ selectorToArgs V2InMemory _ = InMemory. mkInMemoryArgs
144+ selectorToArgs (V1LMDB ff fp l mxReaders) fastStoragePath =
145+ LMDB. mkLMDBArgs
146+ ff
147+ (fromMaybe (defaultLMDBPath fastStoragePath) fp)
148+ ( maybe id (\ overrideMaxReaders lim -> lim{LMDB. lmdbMaxReaders = overrideMaxReaders}) mxReaders $
149+ maybe id (\ ll lim -> lim{LMDB. lmdbMapSize = toBytes ll}) l defaultLMDBLimits
150+ )
151+ selectorToArgs (V2LSM fp) fastStoragePath = LSM. mkLSMArgs (Proxy @ blk ) (fromMaybe " lsm" fp) fastStoragePath
0 commit comments