rnhmjoj/bisc
1
1
Fork 0
Code Issues Pull Requests Releases 5 Wiki Activity

fix IndexedDB directories not being deleted

Browse Source
This commit is contained in:
Michele Guerini Rocco 2019-06-02 10:40:13 +02:00
parent 62953174b4
commit ff66f6705c
Signed by: rnhmjoj
GPG Key ID: 91BE884FBA4B591A
1 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Main.hs
View File

@ -82,16 +82,19 @@ deleteCookies domains = do
deleteData :: [Text] -> Action (Int, [Text]) deleteData :: [Text] -> Action (Int, [Text])
deleteData whitelist = do deleteData whitelist = do
webengine <- asks webenginePath webengine <- asks webenginePath
appCache <- liftIO $ getDirectoryFiles (webengine </> "Application Cache") appCache <- liftIO $ listDirectoryAbs (webengine </> "Application Cache")
indexedDB <- liftIO $ getDirectoryFiles (webengine </> "IndexedDB") indexedDB <- liftIO $ listDirectoryAbs (webengine </> "IndexedDB")
localStorage <- liftIO $ getDirectoryFiles (webengine </> "Local Storage") localStorage <- liftIO $ listDirectoryAbs (webengine </> "Local Storage")
let let
entries = appCache ++ indexedDB ++ localStorage entries = appCache ++ indexedDB ++ localStorage
badFiles = filterMaybe (fmap unlisted . domain) entries badFiles = filterMaybe (fmap unlisted . domain) entries
badDomains = mapMaybe domain badFiles badDomains = mapMaybe domain badFiles
liftIO $ mapM_ removeFile badFiles liftIO $ mapM_ removePathForcibly badFiles
return (length badFiles, nub badDomains) return (length badFiles, nub badDomains)
where where
listDirectoryAbs :: FilePath -> IO [FilePath]
listDirectoryAbs dir = map (dir </>) <$> listDirectory dir
maybeToBool :: Maybe Bool -> Bool maybeToBool :: Maybe Bool -> Bool
maybeToBool Nothing = False maybeToBool Nothing = False
maybeToBool (Just x) = x maybeToBool (Just x) = x