From 0ab048b7959a4a532867e7c4b4c509629b3dec3f Mon Sep 17 00:00:00 2001
From: rnhmjoj <rnhmjoj@inventati.org>
Date: Tue, 23 Mar 2021 19:52:50 +0100
Subject: [PATCH] rewrite deleteLocalStorage using streams

---
 Main.hs | 43 ++++++++++++++++---------------------------
 1 file changed, 16 insertions(+), 27 deletions(-)

diff --git a/Main.hs b/Main.hs
index 0928698..64df6ff 100644
--- a/Main.hs
+++ b/Main.hs
@@ -195,40 +195,29 @@ deleteLocalStorage = do
   version <- withDB path (\db -> L.get db def "VERSION")
   when (version /= Just "1") (throwError "Unsupported schema version")
 
-  withDB path $ \db ->
-    L.withIterator db def $ \iter -> do
-      L.iterFirst iter
-      scanKeys db (by whitelist) iter
+  withDB path $ \db -> do
+    badDomains <- L.withIterator db def $ \i ->
+         LS.keySlice i LS.AllKeys LS.Asc
+       & LS.filter (\k -> "META:" `B.isPrefixOf ` k
+                       && (metaDomain k) `notElem` whitelist )
+       & LS.mapM (\k -> L.delete db def k >> return (metaDomain k))
+       & LS.toList
 
+    n <- L.withIterator db def $ \i ->
+         LS.keySlice i LS.AllKeys LS.Asc
+       & LS.filter (\k -> "_" `B.isPrefixOf` k
+                       && "\NUL\SOH" `B.isInfixOf` k
+                       && (recDomain k) `notElem` whitelist)
+       & LS.mapM (L.delete db def)
+       & LS.length
+
+    return (n, badDomains)
   where
     -- extract domains from the keys
     domain = snd . T.breakOnEnd "://" . decodeUtf8
     metaDomain = domain . B.drop 5
     recDomain  = domain . head . B.split 0 . B.drop 1
 
-    -- scan the database and delete keys from unlisted domain
-    scanKeys db checker i = go 0 [] where
-      go n domains = do
-        mkey <- L.iterKey i
-        case mkey of
-          -- end of database
-          Nothing -> return (n, domains)
-          Just key -> do
-            let (bad, origin) = checker key
-            let m = if bad then n+1 else n
-            when bad (L.delete db def key)
-            L.iterNext i
-            go m (maybe domains (:domains) origin)
-
-    -- check if unlisted and return the domain if a meta record
-    by whitelist key
-      | "META:" `B.isPrefixOf` key
-        && not (metaDomain key `elem` whitelist) = (True, Just (metaDomain key))
-      | "_" `B.isPrefixOf` key
-        && "\NUL\SOH" `B.isInfixOf` key
-        && not (recDomain key `elem` whitelist) = (True, Nothing)
-      | otherwise = (False, Nothing)
-
 
 -- | Deletes records from the session storage levelDB database
 --