diff --git a/Main.hs b/Main.hs index c4ee567..4d663db 100644 --- a/Main.hs +++ b/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 - log ("Deleted " <> num n <> " cookies from:") - log (prettyPrint bad) - else log ("Nothing to delete.") + +deleteLocalStore :: [Text] -> IO (Int, [Text]) +deleteLocalStore whitelist = do + entries <- getDirectoryFiles =<< localStorePath + 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) diff --git a/bisc.cabal b/bisc.cabal index 592dfcc..47e8ae9 100644 --- a/bisc.cabal +++ b/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 diff --git a/default.nix b/default.nix index 86ed289..1516d93 100644 --- a/default.nix +++ b/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;