-------------------------------------------------------------------------------}
-
data DbErr = DbErrStr !String
+
-- | The sequence number of a @`Db`@ should be monotonically increasing
+
-- across calls to @`bsWrite`@, since we use @`bsWrite`@ to flush
+
-- /immutable/ changes.
| DbErrNonMonotonicSeq !(WithOrigin SlotNo) !(WithOrigin SlotNo)
| DbErrBadDynamic !String
-------------------------------------------------------------------------------}
-
{ dbEnv :: !(LMDB.Environment LMDB.ReadWrite) -- ^ The LMDB environment is a pointer to the directory that contains the DB.
-
, dbSettings :: !(LMDB.Database () DbState) -- ^ A database with only one key and one value, for the current sequence number on the DB.
-
, dbBackingTables :: !(LedgerTables l LMDBMK) -- ^ The LMDB database with the key-value store
+
-- | The LMDB environment is a pointer to the directory that contains the DB.
+
dbEnv :: !(LMDB.Environment LMDB.ReadWrite)
+
, dbSettings :: !(LMDB.Database () DbSettings)
+
-- | The on-disk state of the @`Db`@.
+
-- The state is itself an LDMB database with only one key and one value:
+
-- The current sequence number of the DB.
+
, dbState :: !(LMDB.Database () DbState)
+
-- | The LMDB database with the key-value store.
+
, dbBackingTables :: !(LedgerTables l LMDBMK)
, dbFilePath :: !FilePath
, dbTracer :: !(Trace.Tracer m TraceDb)
, dbOpenHandles :: !(IOLike.TVar m (Map Int (ValueHandle m)))
-
newtype DbState = DbState
-
{ dbsSeq :: WithOrigin SlotNo -- TODO a version field
+
-- TODO a version field.
+
-- TODO(jdral): I've made a distinction between DbSettings and DbState because
+
-- /settings/ should probably not be updated on every flush.
+
data DbSettings = DbSettings
+
newtype DbState = DbState {
+
dbsSeq :: WithOrigin SlotNo
} deriving (Show, Generic)
instance S.Serialise DbState
rangeReadLMDBTable count (LMDBMK _ db) (ApplyKeysMK keys) = ApplyValuesMK <$> lmdbRangeReadTable count db keys
{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
-
readDbSettingsMaybeNull ::
-> LMDB.Transaction mode (Maybe DbState)
-
readDbSettingsMaybeNull db = LMDB.get db ()
+
readDbStateMaybeNull db = LMDB.get db ()
-> (DbState -> LMDB.Transaction LMDB.ReadWrite (a, DbState))
-> LMDB.Transaction LMDB.ReadWrite a
-
withDbSettingsRW db f = withDbSettingsRWMaybeNull db $ maybe (Exn.throw DbErrNoSettings) f
+
withDbStateRW db f = withDbStateRWMaybeNull db $ maybe (Exn.throw DbErrNoDbState) f
-
withDbSettingsRWMaybeNull ::
+
withDbStateRWMaybeNull ::
-> (Maybe DbState -> LMDB.Transaction LMDB.ReadWrite (a, DbState))
-> LMDB.Transaction LMDB.ReadWrite a
-
withDbSettingsRWMaybeNull db f =
-
readDbSettingsMaybeNull db >>= f >>= \(r, new_s) -> LMDB.put db () (Just new_s) $> r
+
withDbStateRWMaybeNull db f =
+
readDbStateMaybeNull db >>= f >>= \(r, new_s) -> LMDB.put db () (Just new_s) $> r
data GuardDbDir = GDDMustExist | GDDMustNotExist
initFromVals dbsSeq vals Db{..} = liftIO $ LMDB.readWriteTransaction dbEnv $
-
withDbSettingsRWMaybeNull dbSettings $ \case
+
withDbStateRWMaybeNull dbState $ \case
Nothing -> zipLedgerTablesA initLMDBTable dbBackingTables vals $> ((), DbState{dbsSeq})
Just _ -> Exn.throw $ DbErrStr "initFromVals: db already had state"
dbEnv <- liftIO $ LMDB.openEnvironment dbFilePath limits
-
-- the LMDB.Database that holds the DbState (i.e. sequence number)
+
dbSettings <- liftIO $ LMDB.readWriteTransaction dbEnv $ LMDB.getDatabase (Just "_dbsettings")
+
-- The LMDB.Database that holds the @`DbState`@ (i.e. sequence number)
-- This transaction must be read-write because on initialisation it creates the database
-
dbSettings <- liftIO $ LMDB.readWriteTransaction dbEnv $ LMDB.getDatabase (Just "_dbstate")
+
dbState <- liftIO $ LMDB.readWriteTransaction dbEnv $ LMDB.getDatabase (Just "_dbstate")
-- TODO: at some point Javier was able to get an LMDB which didn't have this
-- database. How is it possible? maybe some copy function is not copying this
bsWrite :: SlotNo -> LedgerTables l DiffMK -> m ()
-
old_slot <- liftIO $ LMDB.readWriteTransaction dbEnv $ withDbSettingsRW dbSettings $ \[email protected]{dbsSeq} -> do
+
old_slot <- liftIO $ LMDB.readWriteTransaction dbEnv $ withDbStateRW dbState $ \[email protected]{dbsSeq} -> do
-- TODO This should be <. However the test harness does call bsWrite with the same slot
unless (dbsSeq <= At slot) $ Exn.throw $ DbErrNonMonotonicSeq (At slot) dbsSeq
void $ zipLedgerTablesA writeLMDBTable dbBackingTables diffs
dbe = LMDB.readOnlyEnvironment dbEnv
vh <- mkValueHandle dbTracer dbe dbOpenHandles
-
mb_init_slot <- vhSubmit vh $ readDbSettingsMaybeNull dbSettings
+
mb_init_slot <- vhSubmit vh $ readDbStateMaybeNull dbState
init_slot <- liftIO $ maybe (Exn.throwIO $ DbErrStr "mkLMDBBackingStoreValueHandle ") (pure . dbsSeq) mb_init_slot
