rewrite deleteLocalStorage using streams
This commit is contained in:
parent
a074cad2fe
commit
0ab048b795
43
Main.hs
43
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
|
||||
--
|
||||
|
Loading…
Reference in New Issue
Block a user