From ecc1dd42e3a97475e47df6a3a7cd900f1af8f047 Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Sat, 19 Oct 2024 19:24:59 +0200 Subject: [PATCH 1/6] Erase every map from LMDB when cleaning cache --- src/RPKI/Store/Base/LMDB.hs | 27 ++++++++++++++++++++---- src/RPKI/Store/Base/Map.hs | 3 --- src/RPKI/Store/Base/MultiMap.hs | 3 --- src/RPKI/Store/Base/Storage.hs | 4 ---- src/RPKI/Store/Database.hs | 10 +-------- src/RPKI/Store/MakeLmdb.hs | 37 +++++++++++++-------------------- 6 files changed, 38 insertions(+), 46 deletions(-) diff --git a/src/RPKI/Store/Base/LMDB.hs b/src/RPKI/Store/Base/LMDB.hs index 660bb16e..84b8ad6c 100644 --- a/src/RPKI/Store/Base/LMDB.hs +++ b/src/RPKI/Store/Base/LMDB.hs @@ -9,7 +9,7 @@ module RPKI.Store.Base.LMDB where -import Control.Monad (forM, forever) +import Control.Monad import Control.Concurrent.STM import qualified Data.ByteString as BS @@ -35,7 +35,6 @@ import qualified Lmdb.Map as LMap import qualified Lmdb.Multimap as LMMap import qualified Lmdb.Types as Lmdb - import Pipes type Env = Lmdb.Environment 'Lmdb.ReadWrite @@ -314,5 +313,25 @@ getMapNames tx db = void $ runEffect $ LMap.firstForward c >-> do forever $ do Lmdb.KeyValue name _ <- await - lift $ modifyIORef' maps ([name] <>) - readIORef maps \ No newline at end of file + lift $ modifyIORef' maps (name :) + readIORef maps + + +eraseEnv :: Env -> IO [BS.ByteString] +eraseEnv env = do + withTransaction env $ \tx -> do + db <- openDatabase tx Nothing defaultDbSettings + mapNames <- getMapNames tx db + forM_ mapNames $ \mapName -> do + -- first open it as is + m <- openDatabase tx (Just $ convert mapName) defaultDbSettings + isMulti <- isMultiDatabase tx m + if isMulti + then do + -- close and reopen as multi map + closeDatabase env m + m' <- openMultiDatabase tx (Just $ convert mapName) defaultMultiDbSettngs + LMMap.clear tx m' + else + LMap.clear tx m + pure mapNames \ No newline at end of file diff --git a/src/RPKI/Store/Base/Map.hs b/src/RPKI/Store/Base/Map.hs index 6dce6ef7..5261dca4 100644 --- a/src/RPKI/Store/Base/Map.hs +++ b/src/RPKI/Store/Base/Map.hs @@ -18,9 +18,6 @@ data SMap (name :: Symbol) s k v where instance Storage s => WithStorage s (SMap name s k v) where storage (SMap s _) = s -instance WithTx s => CanErase s (SMap name s k v) where - erase tx (SMap _ s) = S.clear tx s - put :: (AsStorable k, AsStorable v) => Tx s 'RW -> SMap name s k v -> k -> v -> IO () put tx (SMap _ s) k v = S.put tx s (storableKey k) (storableValue v) diff --git a/src/RPKI/Store/Base/MultiMap.hs b/src/RPKI/Store/Base/MultiMap.hs index 003af1dd..00ae509c 100644 --- a/src/RPKI/Store/Base/MultiMap.hs +++ b/src/RPKI/Store/Base/MultiMap.hs @@ -14,9 +14,6 @@ data SMultiMap (name :: Symbol) s k v where instance Storage s => WithStorage s (SMultiMap name s k v) where storage (SMultiMap s _) = s -instance WithTx s => CanErase s (SMultiMap name s k v) where - erase tx (SMultiMap _ s) = S.clearMu tx s - put :: (AsStorable k, AsStorable v) => Tx s 'RW -> SMultiMap name s k v -> k -> v -> IO () put tx (SMultiMap _ s) k v = S.putMu tx s (storableKey k) (storableValue v) diff --git a/src/RPKI/Store/Base/Storage.hs b/src/RPKI/Store/Base/Storage.hs index adb253ae..329cf9f2 100644 --- a/src/RPKI/Store/Base/Storage.hs +++ b/src/RPKI/Store/Base/Storage.hs @@ -63,7 +63,3 @@ rwTxT :: (MonadIO m, WithStorage s ws) rwTxT tdb f = liftIO $ do db <- readTVarIO tdb rwTx db $ \tx -> f tx db - - -class WithTx s => CanErase s a where - erase :: Tx s 'RW -> a -> IO () \ No newline at end of file diff --git a/src/RPKI/Store/Database.hs b/src/RPKI/Store/Database.hs index 4d48e939..927c5e73 100644 --- a/src/RPKI/Store/Database.hs +++ b/src/RPKI/Store/Database.hs @@ -76,9 +76,6 @@ databaseVersionKey = "database-version" forAsyncFetchKey = "for-async-fetch" validatedByVersionKey = "validated-by-version-map" -data EraseWrapper s where - EraseWrapper :: forall t s . (Storage s, CanErase s t) => t -> EraseWrapper s - -- All of the stores of the application in one place data DB s = DB { taStore :: TAStore s, @@ -95,8 +92,7 @@ data DB s = DB { slurmStore :: SlurmStore s, jobStore :: JobStore s, sequences :: SequenceMap s, - metadataStore :: MetadataStore s, - erasables :: [EraseWrapper s] + metadataStore :: MetadataStore s } deriving stock (Generic) instance Storage s => WithStorage s (DB s) where @@ -963,10 +959,6 @@ getRtrPayloads tx db worldVersion = -- Get all SStats and `<>` them totalStats :: StorageStats -> SStats totalStats (StorageStats s) = mconcat $ Map.elems s - -emptyDBMaps :: (MonadIO m, Storage s) => Tx s 'RW -> DB s -> m () -emptyDBMaps tx DB {..} = liftIO $ - forM_ erasables $ \(EraseWrapper t) -> erase tx t -- Utilities to have storage transaction in ValidatorT monad. diff --git a/src/RPKI/Store/MakeLmdb.hs b/src/RPKI/Store/MakeLmdb.hs index 9755587e..1588b086 100644 --- a/src/RPKI/Store/MakeLmdb.hs +++ b/src/RPKI/Store/MakeLmdb.hs @@ -8,7 +8,6 @@ module RPKI.Store.MakeLmdb where import Control.Lens import Control.Concurrent.STM -import Data.IORef import Data.String.Interpolate.IsString import GHC.TypeLits @@ -35,9 +34,8 @@ data DbCheckResult = WasIncompatible | WasCompatible | DidntHaveVersion createDatabase :: LmdbEnv -> AppLogger -> IncompatibleDbCheck -> IO (DB LmdbStorage, DbCheckResult) createDatabase env logger checkAction = do - - erasables <- newIORef [] - db <- doCreateDb erasables + + db <- doCreateDb case checkAction of CheckVersion -> @@ -51,24 +49,26 @@ createDatabase env logger checkAction = do dbVersion <- getDatabaseVersion tx db case dbVersion of Nothing -> do - logInfo logger [i|Cache version is not set, setting it to #{currentDatabaseVersion}, cleaning up the cache.|] - (_, ms) <- timedMS $ emptyDBMaps tx db - logDebug logger [i|Erasing cache took #{ms}ms.|] + logInfo logger [i|Cache version is not set, will set the version to #{currentDatabaseVersion} and clean up the cache.|] + nativeEnv <- atomically $ getNativeEnv env + (_, ms) <- timedMS $ eraseEnv nativeEnv + logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db pure DidntHaveVersion Just version -> if version /= currentDatabaseVersion then do -- We are seeing incompatible storage. The only option -- now is to erase all the maps and start from scratch. - logInfo logger [i|Persisted cache version is #{version} and expected version is #{currentDatabaseVersion}, dropping the cache.|] - (_, ms) <- timedMS $ emptyDBMaps tx db - logDebug logger [i|Erasing cache took #{ms}ms.|] + logInfo logger [i|Persisted cache version is #{version} and expected version is #{currentDatabaseVersion}, will drop the cache.|] + nativeEnv <- atomically $ getNativeEnv env + (_, ms) <- timedMS $ eraseEnv nativeEnv + logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db pure WasIncompatible else pure WasCompatible - doCreateDb erasablesRef = do + doCreateDb = do sequences <- createMap taStore <- TAStore <$> createMap validationsStore <- ValidationsStore <$> createMap @@ -83,10 +83,7 @@ createDatabase env logger checkAction = do jobStore <- JobStore <$> createMap metadataStore <- MetadataStore <$> createMap repositoryStore <- createRepositoryStore - objectStore <- createObjectStore sequences - - erasables <- readIORef erasablesRef - + objectStore <- createObjectStore sequences pure DB {..} where @@ -112,16 +109,10 @@ createDatabase env logger checkAction = do lmdb = LmdbStorage env createMap :: forall k v name . (KnownSymbol name) => IO (SMap name LmdbStorage k v) - createMap = do - sm <- SMap lmdb <$> createLmdbStore env - modifyIORef' erasablesRef (EraseWrapper sm :) - pure sm + createMap = SMap lmdb <$> createLmdbStore env createMultiMap :: forall k v name . (KnownSymbol name) => IO (SMultiMap name LmdbStorage k v) - createMultiMap = do - sm <- SMultiMap lmdb <$> createLmdbMultiStore env - modifyIORef' erasablesRef (EraseWrapper sm :) - pure sm + createMultiMap = SMultiMap lmdb <$> createLmdbMultiStore env mkLmdb :: FilePath -> Config -> IO LmdbEnv From 18158f53254b22f885e3d8218b8645eeb6792e3a Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Sat, 19 Oct 2024 19:35:44 +0200 Subject: [PATCH 2/6] Formatting --- src/RPKI/Store/Base/LMDB.hs | 2 +- src/RPKI/Store/MakeLmdb.hs | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/RPKI/Store/Base/LMDB.hs b/src/RPKI/Store/Base/LMDB.hs index 84b8ad6c..46137463 100644 --- a/src/RPKI/Store/Base/LMDB.hs +++ b/src/RPKI/Store/Base/LMDB.hs @@ -53,7 +53,7 @@ data LmdbStore (name :: Symbol) = LmdbStore { } data LmdbMultiStore (name :: Symbol) = LmdbMultiStore { - db :: Lmdb.MultiDatabase BS.ByteString BS.ByteString, + db :: Lmdb.MultiDatabase BS.ByteString BS.ByteString, env :: LmdbEnv } diff --git a/src/RPKI/Store/MakeLmdb.hs b/src/RPKI/Store/MakeLmdb.hs index 1588b086..ba6f3090 100644 --- a/src/RPKI/Store/MakeLmdb.hs +++ b/src/RPKI/Store/MakeLmdb.hs @@ -55,8 +55,10 @@ createDatabase env logger checkAction = do logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db pure DidntHaveVersion - Just version -> - if version /= currentDatabaseVersion then do + Just version + | version == currentDatabaseVersion -> + pure WasCompatible + | otherwise -> do -- We are seeing incompatible storage. The only option -- now is to erase all the maps and start from scratch. logInfo logger [i|Persisted cache version is #{version} and expected version is #{currentDatabaseVersion}, will drop the cache.|] @@ -64,9 +66,7 @@ createDatabase env logger checkAction = do (_, ms) <- timedMS $ eraseEnv nativeEnv logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db - pure WasIncompatible - else - pure WasCompatible + pure WasIncompatible doCreateDb = do sequences <- createMap From 25eca95eb36f75fe8b0a45e9d79e99828b87fedb Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Sat, 19 Oct 2024 19:43:18 +0200 Subject: [PATCH 3/6] Bump Db version --- src/RPKI/Store/Database.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/RPKI/Store/Database.hs b/src/RPKI/Store/Database.hs index 927c5e73..ca1bcad1 100644 --- a/src/RPKI/Store/Database.hs +++ b/src/RPKI/Store/Database.hs @@ -68,7 +68,7 @@ import RPKI.Time -- It is brittle and inconvenient, but so far seems to be -- the only realistic option. currentDatabaseVersion :: Integer -currentDatabaseVersion = 34 +currentDatabaseVersion = 36 -- Some constant keys databaseVersionKey, forAsyncFetchKey, validatedByVersionKey :: Text From 4787cea243cb724e0fb37ac4fed735c6d38980ff Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Sat, 19 Oct 2024 19:49:51 +0200 Subject: [PATCH 4/6] Reuse transaction --- src/RPKI/Store/Base/LMDB.hs | 35 +++++++++++++++++------------------ src/RPKI/Store/MakeLmdb.hs | 4 ++-- 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/src/RPKI/Store/Base/LMDB.hs b/src/RPKI/Store/Base/LMDB.hs index 46137463..e3ae45f1 100644 --- a/src/RPKI/Store/Base/LMDB.hs +++ b/src/RPKI/Store/Base/LMDB.hs @@ -317,21 +317,20 @@ getMapNames tx db = readIORef maps -eraseEnv :: Env -> IO [BS.ByteString] -eraseEnv env = do - withTransaction env $ \tx -> do - db <- openDatabase tx Nothing defaultDbSettings - mapNames <- getMapNames tx db - forM_ mapNames $ \mapName -> do - -- first open it as is - m <- openDatabase tx (Just $ convert mapName) defaultDbSettings - isMulti <- isMultiDatabase tx m - if isMulti - then do - -- close and reopen as multi map - closeDatabase env m - m' <- openMultiDatabase tx (Just $ convert mapName) defaultMultiDbSettngs - LMMap.clear tx m' - else - LMap.clear tx m - pure mapNames \ No newline at end of file +eraseEnv :: Env -> Tx LmdbStorage 'RW -> IO [BS.ByteString] +eraseEnv env (LmdbTx tx) = do + db <- openDatabase tx Nothing defaultDbSettings + mapNames <- getMapNames tx db + forM_ mapNames $ \mapName -> do + -- first open it as is + m <- openDatabase tx (Just $ convert mapName) defaultDbSettings + isMulti <- isMultiDatabase tx m + if isMulti + then do + -- close and reopen as multi map + closeDatabase env m + m' <- openMultiDatabase tx (Just $ convert mapName) defaultMultiDbSettngs + LMMap.clear tx m' + else + LMap.clear tx m + pure mapNames \ No newline at end of file diff --git a/src/RPKI/Store/MakeLmdb.hs b/src/RPKI/Store/MakeLmdb.hs index ba6f3090..bd31ff05 100644 --- a/src/RPKI/Store/MakeLmdb.hs +++ b/src/RPKI/Store/MakeLmdb.hs @@ -51,7 +51,7 @@ createDatabase env logger checkAction = do Nothing -> do logInfo logger [i|Cache version is not set, will set the version to #{currentDatabaseVersion} and clean up the cache.|] nativeEnv <- atomically $ getNativeEnv env - (_, ms) <- timedMS $ eraseEnv nativeEnv + (_, ms) <- timedMS $ eraseEnv nativeEnv tx logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db pure DidntHaveVersion @@ -63,7 +63,7 @@ createDatabase env logger checkAction = do -- now is to erase all the maps and start from scratch. logInfo logger [i|Persisted cache version is #{version} and expected version is #{currentDatabaseVersion}, will drop the cache.|] nativeEnv <- atomically $ getNativeEnv env - (_, ms) <- timedMS $ eraseEnv nativeEnv + (_, ms) <- timedMS $ eraseEnv nativeEnv tx logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db pure WasIncompatible From 85dcc5ba6e681dc221f3e4d80f0036d10886e332 Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Sat, 19 Oct 2024 19:53:23 +0200 Subject: [PATCH 5/6] Make it prettier --- src/RPKI/Store/MakeLmdb.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/RPKI/Store/MakeLmdb.hs b/src/RPKI/Store/MakeLmdb.hs index bd31ff05..179d1161 100644 --- a/src/RPKI/Store/MakeLmdb.hs +++ b/src/RPKI/Store/MakeLmdb.hs @@ -49,9 +49,8 @@ createDatabase env logger checkAction = do dbVersion <- getDatabaseVersion tx db case dbVersion of Nothing -> do - logInfo logger [i|Cache version is not set, will set the version to #{currentDatabaseVersion} and clean up the cache.|] - nativeEnv <- atomically $ getNativeEnv env - (_, ms) <- timedMS $ eraseEnv nativeEnv tx + logInfo logger [i|Cache version is not set, will set the version to #{currentDatabaseVersion} and clean up the cache.|] + ms <- eraseCache tx logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db pure DidntHaveVersion @@ -62,12 +61,16 @@ createDatabase env logger checkAction = do -- We are seeing incompatible storage. The only option -- now is to erase all the maps and start from scratch. logInfo logger [i|Persisted cache version is #{version} and expected version is #{currentDatabaseVersion}, will drop the cache.|] - nativeEnv <- atomically $ getNativeEnv env - (_, ms) <- timedMS $ eraseEnv nativeEnv tx + ms <- eraseCache tx logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db pure WasIncompatible + eraseCache tx = do + nativeEnv <- atomically $ getNativeEnv env + (_, ms) <- timedMS $ eraseEnv nativeEnv tx + pure ms + doCreateDb = do sequences <- createMap taStore <- TAStore <$> createMap From 151b0cbfd7d27a49f03816f13969c2d06c94302a Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Sat, 19 Oct 2024 19:58:22 +0200 Subject: [PATCH 6/6] Comment --- src/RPKI/Store/MakeLmdb.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/RPKI/Store/MakeLmdb.hs b/src/RPKI/Store/MakeLmdb.hs index 179d1161..c83b8902 100644 --- a/src/RPKI/Store/MakeLmdb.hs +++ b/src/RPKI/Store/MakeLmdb.hs @@ -61,6 +61,8 @@ createDatabase env logger checkAction = do -- We are seeing incompatible storage. The only option -- now is to erase all the maps and start from scratch. logInfo logger [i|Persisted cache version is #{version} and expected version is #{currentDatabaseVersion}, will drop the cache.|] + -- NOTE: We erase every map in the cache, including metadata, but that's not an problem, + -- since we'll set new DB version here ms <- eraseCache tx logDebug logger [i|Erased cache in #{ms}ms.|] saveCurrentDatabaseVersion tx db