rewrite deleteLocalStorage using streams

master
Michele Guerini Rocco 2021-03-23 19:52:50 +01:00
parent a074cad2fe
commit 0ab048b795
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
1 changed files with 16 additions and 27 deletions

43
Main.hs
View File

@ -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
--