handle local storage

Main.hs

@@ -4,12 +4,15 @@
 {-# LANGUAGE FlexibleContexts  #-}
 
 import System.Environment.XDG.BaseDir (getUserDataDir, getUserConfigDir)
-import System.FilePath                (joinPath)
+import System.FilePath                (joinPath, takeBaseName, (</>))
 import System.IO                      (readFile)
+import System.Directory               (removeFile, getDirectoryContents, doesFileExist)
+import Control.Monad                  (mapM_, filterM)
+import Data.List                      (nub)
+import Data.Maybe                     (mapMaybe)
+import Data.Monoid                    ((<>))
 import Database.Selda
 import Database.Selda.SQLite
-import Data.Monoid
-import Data.List
 import qualified Data.Text            as T
 import qualified Data.Text.IO         as T
 
@@ -23,41 +26,90 @@ instance SqlRow Cookie
 cookies :: Table Cookie
 cookies = table "cookies" []
 
+
 databasePath :: IO FilePath
 databasePath = do
   datadir <- getUserDataDir "qutebrowser"
   return $ joinPath [datadir, "webengine", "Cookies"]
 
+localStorePath :: IO FilePath
+localStorePath = do
+  datadir <- getUserDataDir "qutebrowser"
+  return $ joinPath [datadir, "webengine", "Local Storage"]
+
 whitelistPath :: IO FilePath
 whitelistPath = do
   configdir <- getUserConfigDir "qutebrowser"
   return $ joinPath [configdir, "whitelists", "cookies"]
 
-makeWhitelist :: Text -> [Col s Text]
-makeWhitelist = map text . T.lines
 
 prettyPrint :: [Text] -> Text
-prettyPrint = T.unlines . bullet . nub
+prettyPrint = T.unlines . bullet
   where bullet = map ("  * " <>)
 
-main :: IO ()
-main = do
-  database  <- databasePath
-  whitelist <- makeWhitelist <$> (T.readFile =<< whitelistPath)
 
+getDirectoryFiles :: FilePath -> IO [FilePath]
+getDirectoryFiles path = map (path </>) <$>
+  getDirectoryContents path >>= filterM doesFileExist
+
+
+deleteCookies :: [Text] -> IO (Int, [Text])
+deleteCookies domains = do
+  database <- databasePath
   withSQLite database $ do
     bad <- query $ do
       cookie <- select cookies
       restrict (by whitelist cookie)
       return (cookie ! #host_key)
     n <- deleteFrom cookies (by whitelist)
+    return (n, nub bad)
+  where
+    by set x = not_ (x ! #host_key `isIn` set)
+    whitelist = map text domains
 
-    if (n > 0)
+
-      then do
+deleteLocalStore :: [Text] -> IO (Int, [Text])
-        log ("Deleted " <> num n <> " cookies from:")
+deleteLocalStore whitelist = do
-        log (prettyPrint bad)
+  entries <- getDirectoryFiles =<< localStorePath
-      else log ("Nothing to delete.")
+  let
+    badFiles   = filterMaybe (fmap unlisted . domain) entries
+    badDomains = mapMaybe domain badFiles
+  mapM_ removeFile badFiles
+  return (length badFiles, nub badDomains)
+  where
+    maybeToBool :: Maybe Bool -> Bool
+    maybeToBool Nothing  = False
+    maybeToBool (Just x) = x
+
+    filterMaybe :: (a -> Maybe Bool) -> [a] -> [a]
+    filterMaybe f = filter (maybeToBool . f)
+
+    domain :: FilePath -> Maybe Text
+    domain = extract . url where
+      extract    []  = Nothing
+      extract (x:[]) = Nothing
+      extract (x:xs) = Just $ T.unwords (init xs)
+      url = T.splitOn "_" . T.pack . takeBaseName
+
+    unlisted = not . (`elem` whitelist)
+
+
+main :: IO ()
+main = do
+  whitelist <- T.lines <$> (T.readFile =<< whitelistPath)
+  (n, bad)  <- deleteCookies whitelist
+  if (n > 0)
+    then do
+      log ("Cookies: deleted " <> num n <> " from:")
+      log (prettyPrint bad)
+    else log ("Cookies: nothing to delete.")
+
+  (n, bad) <- deleteLocalStore whitelist
+  if (n > 0)
+    then do
+      log ("Local storage: deleted " <> num n <> " entries:")
+      log (prettyPrint bad)
+    else log ("Local storage: nothing to delete.")
 
   where log = liftIO . T.putStrLn
         num = T.pack . show
-        by set x = not_ (x ! #host_key `isIn` set)

bisc.cabal

@@ -13,7 +13,7 @@ executable bisc
   main-is:             Main.hs
   build-depends:       base ==4.10.* , selda ==0.3.*,
                        selda-sqlite ==0.1.*,
-                       xdg-basedir, filepath, text
+                       xdg-basedir, filepath, directory, text
   default-language:    Haskell2010
   default-extensions:  DeriveGeneric, OverloadedStrings
                        OverloadedLabels, FlexibleContexts

default.nix

@@ -41,7 +41,7 @@ let
          }) {};
 
       bisc = self.callPackage
-        ({ mkDerivation, base, filepath, stdenv, xdg-basedir
+        ({ mkDerivation, base, filepath, directory, stdenv, xdg-basedir
          , selda, selda-sqlite, text }:
         mkDerivation {
           pname = "bisc";
@@ -50,7 +50,7 @@ let
           isLibrary = false;
           isExecutable = true;
           executableHaskellDepends = [
-            base filepath selda selda-sqlite xdg-basedir text
+            base filepath directory selda selda-sqlite xdg-basedir text
           ];
           description = "A small tool that clears qutebrowser cookies";
           license = stdenv.lib.licenses.gpl3;