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")
|
version <- withDB path (\db -> L.get db def "VERSION")
|
||||||
when (version /= Just "1") (throwError "Unsupported schema version")
|
when (version /= Just "1") (throwError "Unsupported schema version")
|
||||||
|
|
||||||
withDB path $ \db ->
|
withDB path $ \db -> do
|
||||||
L.withIterator db def $ \iter -> do
|
badDomains <- L.withIterator db def $ \i ->
|
||||||
L.iterFirst iter
|
LS.keySlice i LS.AllKeys LS.Asc
|
||||||
scanKeys db (by whitelist) iter
|
& 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
|
where
|
||||||
-- extract domains from the keys
|
-- extract domains from the keys
|
||||||
domain = snd . T.breakOnEnd "://" . decodeUtf8
|
domain = snd . T.breakOnEnd "://" . decodeUtf8
|
||||||
metaDomain = domain . B.drop 5
|
metaDomain = domain . B.drop 5
|
||||||
recDomain = domain . head . B.split 0 . B.drop 1
|
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
|
-- | Deletes records from the session storage levelDB database
|
||||||
--
|
--
|
||||||
|
Loading…
Reference in New Issue
Block a user