From 3c592a21e670d28e487f00d398c8d2b9581f0e5d Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Wed, 9 Oct 2024 11:10:00 +0200 Subject: [PATCH 1/6] Do no store many older version of payloads, refactor --- src/RPKI/Config.hs | 2 +- src/RPKI/Store/Database.hs | 87 ++++++++++++++++++++------------------ 2 files changed, 48 insertions(+), 41 deletions(-) diff --git a/src/RPKI/Config.hs b/src/RPKI/Config.hs index 7ba65c86..c9d7902e 100644 --- a/src/RPKI/Config.hs +++ b/src/RPKI/Config.hs @@ -268,7 +268,7 @@ defaultConfig = Config { rtrConfig = Nothing, cacheCleanupInterval = Seconds $ 60 * 60 * 6, cacheLifeTime = Seconds $ 60 * 60 * 24, - versionNumberToKeep = 100, + versionNumberToKeep = 3, storageCompactionInterval = Seconds $ 60 * 60 * 120, rsyncCleanupInterval = Seconds $ 60 * 60 * 24 * 30, lmdbSizeMb = Size $ 32 * 1024, diff --git a/src/RPKI/Store/Database.hs b/src/RPKI/Store/Database.hs index 41bc71b8..d9ab746a 100644 --- a/src/RPKI/Store/Database.hs +++ b/src/RPKI/Store/Database.hs @@ -68,13 +68,13 @@ import RPKI.Time -- It is brittle and inconvenient, but so far seems to be -- the only realistic option. currentDatabaseVersion :: Integer -currentDatabaseVersion = 33 +currentDatabaseVersion = 34 -- Some constant keys -databaseVersionKey, lastValidMftKey, forAsyncFetchKey :: Text +databaseVersionKey, forAsyncFetchKey, validatedByVersionKey :: Text databaseVersionKey = "database-version" -lastValidMftKey = "last-valid-mft" 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 @@ -122,7 +122,8 @@ data RpkiObjectStore s = RpkiObjectStore { certBySKI :: SMap "cert-by-ski" s SKI ObjectKey, objectMetas :: SMap "object-meta" s ObjectKey ObjectMeta, - validatedByVersion :: SMap "validated-by-version" s WorldVersion (Compressed (Set.Set ObjectKey)), + -- validatedByVersion :: SMap "validated-by-version" s WorldVersion (Compressed (Set.Set ObjectKey)), + validatedByVersion :: SMap "validated-by-version" s Text (Compressed (Map.Map ObjectKey WorldVersion)), -- Object URL mapping uriToUriKey :: SMap "uri-to-uri-key" s SafeUrlAsKey UrlKey, @@ -516,21 +517,9 @@ markAsValidated :: (MonadIO m, Storage s) => Tx s 'RW -> DB s -> Set.Set ObjectKey -> WorldVersion -> m () -markAsValidated tx db@DB { objectStore = RpkiObjectStore {..} } allKeys worldVersion = liftIO $ do - existingVersions <- validationVersions tx db - - M.put tx validatedByVersion worldVersion (Compressed allKeys) - case existingVersions of - [] -> pure () - _ -> do - -- This is an optimisation, but a necessary one: - -- Delete 'validatedKeys' from the previous version if - -- they are present in the last one. In most cases it - -- will delete most of the entries. - let previousVersion = List.maximum existingVersions - ifJustM (M.get tx validatedByVersion previousVersion) $ \(Compressed previousKeys) -> - M.put tx validatedByVersion previousVersion $ - Compressed $ previousKeys `Set.difference` allKeys +markAsValidated tx db allKeys worldVersion = + liftIO $ void $ updateValidatedByVersionMap tx db $ \m -> + foldr (\k -> Map.insert k worldVersion) (fromMaybe mempty m) allKeys -- This is for testing purposes mostly @@ -784,6 +773,28 @@ saveCurrentDatabaseVersion tx DB { metadataStore = MetadataStore s } = liftIO $ M.put tx s databaseVersionKey (Text.pack $ show currentDatabaseVersion) +updateValidatedByVersionMap :: (MonadIO m, Storage s) + => Tx s 'RW + -> DB s + -> (Maybe (Map.Map ObjectKey WorldVersion) -> Map.Map ObjectKey WorldVersion) + -> m (Map.Map ObjectKey WorldVersion) +updateValidatedByVersionMap tx DB { objectStore = RpkiObjectStore {..} } f = liftIO $ do + m <- M.get tx validatedByVersion validatedByVersionKey + let m' = f $ fmap unCompressed m + M.put tx validatedByVersion validatedByVersionKey $ Compressed m' + pure m' + + +cleanupValidatedByVersionMap :: (MonadIO m, Storage s) => + Tx s RW + -> DB s + -> [WorldVersion] + -> m (Map.Map ObjectKey WorldVersion) +cleanupValidatedByVersionMap tx db versionsToDelete = liftIO $ do + let deleteSet = Set.fromList versionsToDelete + updateValidatedByVersionMap tx db $ + maybe mempty $ Map.filter (not . (`Set.member` deleteSet)) + -- More complicated operations data CleanUpResult = CleanUpResult { @@ -821,11 +832,12 @@ deleteOldestVersionsIfNeeded tx db versionNumberToKeep = let reallyToKeep = max 2 (fromIntegral versionNumberToKeep) if length versions > reallyToKeep then do - let toDelete = drop reallyToKeep $ List.sortOn Down versions - forM_ toDelete $ \v -> do + let versionsToDelete = drop reallyToKeep $ List.sortOn Down versions + forM_ versionsToDelete $ \v -> do deletePayloads tx db v - deleteVersion tx db v - pure toDelete + deleteVersion tx db v + void $ cleanupValidatedByVersionMap tx db versionsToDelete + pure versionsToDelete else pure [] @@ -842,36 +854,31 @@ deleteStaleContent db@DB { objectStore = RpkiObjectStore {..} } tooOld = deleteOldNonValidationVersions tx db tooOld versions <- roTx db (`validationVersions` db) - let (toDelete, toKeep) = List.partition tooOld versions + let versionsToDelete = filter tooOld versions rwTx db $ \tx -> do -- delete versions and payloads associated with them, -- e.g. VRPs, ASPAs, BGPSec certificatees, etc. - forM_ toDelete $ \version -> do + forM_ versionsToDelete $ \version -> do deleteVersion tx db version - deletePayloads tx db version - M.delete tx validatedByVersion version - - (deletedObjects, keptObjects) <- deleteStaleObjects tx toKeep + deletePayloads tx db version + + validatedByRecentVersions <- cleanupValidatedByVersionMap tx db versionsToDelete + + (deletedObjects, keptObjects) <- deleteStaleObjects tx validatedByRecentVersions -- Delete URLs that are now not referred by any object deletedURLs <- deleteDanglingUrls db tx pure CleanUpResult {..} where - deleteStaleObjects tx versionsToKeep = do + deleteStaleObjects tx validatedByRecentVersions = do -- Set of all objects touched by validation with versions -- that are not "too old". - touchedObjectKeys <- foldM - (\allKeys version -> - M.get tx validatedByVersion version >>= \case - Nothing -> pure $! allKeys - Just (Compressed keys') -> pure $! allKeys <> keys') - mempty - versionsToKeep - - -- Objects inserted by validation with version that is not too old. - -- We want to preseve these objects in the cache even if they are + let touchedObjectKeys = Map.keysSet validatedByRecentVersions + + -- Objects inserted by validation with version that is not "too old". + -- We want to preseve these objects in the cache even if they were -- never used, they may still be used later. That may happens if -- a repository updates a manifest aftert updating its children. recentlyInsertedObjectKeys <- M.fold tx objectMetas From 0050e27f0b4dd99773369b93a1c2c9a5184d035f Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Wed, 9 Oct 2024 11:17:45 +0200 Subject: [PATCH 2/6] Fix weird log message --- src/RPKI/Store/AppLmdbStorage.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/RPKI/Store/AppLmdbStorage.hs b/src/RPKI/Store/AppLmdbStorage.hs index 512c73dc..2c8cb392 100644 --- a/src/RPKI/Store/AppLmdbStorage.hs +++ b/src/RPKI/Store/AppLmdbStorage.hs @@ -206,7 +206,7 @@ compactStorageWithTmpDir appContext@AppContext {..} = do Size lmdbFileSize <- cacheFsSize appContext let fileSizeMb :: Integer = fromIntegral $ lmdbFileSize `div` (1024 * 1024) - logInfo logger [i|New LMDB file size is #{fileSizeMb}mb, will perform compaction.|] + logInfo logger [i|New LMDB file size is #{fileSizeMb}mb.|] Size lmdbFileSize <- cacheFsSize appContext From 3b8b0d1f2e3809c29f4653994a09c7319c502b6d Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Thu, 10 Oct 2024 10:07:40 +0200 Subject: [PATCH 3/6] Do not rely on existing versions when deleting old objects --- src/RPKI/Store/Database.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/RPKI/Store/Database.hs b/src/RPKI/Store/Database.hs index d9ab746a..46f017d9 100644 --- a/src/RPKI/Store/Database.hs +++ b/src/RPKI/Store/Database.hs @@ -788,12 +788,11 @@ updateValidatedByVersionMap tx DB { objectStore = RpkiObjectStore {..} } f = lif cleanupValidatedByVersionMap :: (MonadIO m, Storage s) => Tx s RW -> DB s - -> [WorldVersion] + -> (WorldVersion -> Bool) -> m (Map.Map ObjectKey WorldVersion) -cleanupValidatedByVersionMap tx db versionsToDelete = liftIO $ do - let deleteSet = Set.fromList versionsToDelete +cleanupValidatedByVersionMap tx db toDelete = liftIO $ do updateValidatedByVersionMap tx db $ - maybe mempty $ Map.filter (not . (`Set.member` deleteSet)) + maybe mempty $ Map.filter (not . toDelete) -- More complicated operations @@ -835,8 +834,9 @@ deleteOldestVersionsIfNeeded tx db versionNumberToKeep = let versionsToDelete = drop reallyToKeep $ List.sortOn Down versions forM_ versionsToDelete $ \v -> do deletePayloads tx db v - deleteVersion tx db v - void $ cleanupValidatedByVersionMap tx db versionsToDelete + deleteVersion tx db v + let toDeleteSet = Set.fromList versionsToDelete + void $ cleanupValidatedByVersionMap tx db (`Set.member` toDeleteSet) pure versionsToDelete else pure [] @@ -863,7 +863,7 @@ deleteStaleContent db@DB { objectStore = RpkiObjectStore {..} } tooOld = deleteVersion tx db version deletePayloads tx db version - validatedByRecentVersions <- cleanupValidatedByVersionMap tx db versionsToDelete + validatedByRecentVersions <- cleanupValidatedByVersionMap tx db tooOld (deletedObjects, keptObjects) <- deleteStaleObjects tx validatedByRecentVersions From 33440d515a0cdc8722c9322fcebc9f3ecc4a0d88 Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Thu, 10 Oct 2024 14:04:39 +0200 Subject: [PATCH 4/6] Cleanup --- src/RPKI/Store/Database.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/RPKI/Store/Database.hs b/src/RPKI/Store/Database.hs index 46f017d9..b0925911 100644 --- a/src/RPKI/Store/Database.hs +++ b/src/RPKI/Store/Database.hs @@ -122,8 +122,7 @@ data RpkiObjectStore s = RpkiObjectStore { certBySKI :: SMap "cert-by-ski" s SKI ObjectKey, objectMetas :: SMap "object-meta" s ObjectKey ObjectMeta, - -- validatedByVersion :: SMap "validated-by-version" s WorldVersion (Compressed (Set.Set ObjectKey)), - validatedByVersion :: SMap "validated-by-version" s Text (Compressed (Map.Map ObjectKey WorldVersion)), + validatedByVersion :: SMap "validated-by-version" s Text (Compressed (Map.Map ObjectKey WorldVersion)), -- Object URL mapping uriToUriKey :: SMap "uri-to-uri-key" s SafeUrlAsKey UrlKey, From 981d1b86c8eb8661fde7648ffac96097a32799b9 Mon Sep 17 00:00:00 2001 From: Mikhail Puzanov Date: Thu, 10 Oct 2024 14:09:12 +0200 Subject: [PATCH 5/6] Naming --- src/RPKI/Store/Database.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/RPKI/Store/Database.hs b/src/RPKI/Store/Database.hs index b0925911..4d48e939 100644 --- a/src/RPKI/Store/Database.hs +++ b/src/RPKI/Store/Database.hs @@ -778,10 +778,10 @@ updateValidatedByVersionMap :: (MonadIO m, Storage s) -> (Maybe (Map.Map ObjectKey WorldVersion) -> Map.Map ObjectKey WorldVersion) -> m (Map.Map ObjectKey WorldVersion) updateValidatedByVersionMap tx DB { objectStore = RpkiObjectStore {..} } f = liftIO $ do - m <- M.get tx validatedByVersion validatedByVersionKey - let m' = f $ fmap unCompressed m - M.put tx validatedByVersion validatedByVersionKey $ Compressed m' - pure m' + validatedBy <- M.get tx validatedByVersion validatedByVersionKey + let validatedBy' = f $ fmap unCompressed validatedBy + M.put tx validatedByVersion validatedByVersionKey $ Compressed validatedBy' + pure validatedBy' cleanupValidatedByVersionMap :: (MonadIO m, Storage s) => From 111ef46f1fe54a165cf702295364f0ba42f589db Mon Sep 17 00:00:00 2001 From: Misha Puzanov Date: Thu, 10 Oct 2024 23:40:14 +0200 Subject: [PATCH 6/6] Log message --- src/RPKI/Store/AppLmdbStorage.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/RPKI/Store/AppLmdbStorage.hs b/src/RPKI/Store/AppLmdbStorage.hs index 2c8cb392..239a14c8 100644 --- a/src/RPKI/Store/AppLmdbStorage.hs +++ b/src/RPKI/Store/AppLmdbStorage.hs @@ -206,7 +206,7 @@ compactStorageWithTmpDir appContext@AppContext {..} = do Size lmdbFileSize <- cacheFsSize appContext let fileSizeMb :: Integer = fromIntegral $ lmdbFileSize `div` (1024 * 1024) - logInfo logger [i|New LMDB file size is #{fileSizeMb}mb.|] + logInfo logger [i|LMDB file size after compaction is #{fileSizeMb}mb.|] Size lmdbFileSize <- cacheFsSize appContext