64 lines
1.7 KiB
Haskell
64 lines
1.7 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE OverloadedLabels #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
import System.Environment.XDG.BaseDir (getUserDataDir, getUserConfigDir)
|
|
import System.FilePath (joinPath)
|
|
import System.IO (readFile)
|
|
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
|
|
|
|
data Cookie = Cookie
|
|
{ host_key :: Text
|
|
, creation_utc :: Int
|
|
} deriving (Generic, Show)
|
|
|
|
instance SqlRow Cookie
|
|
|
|
cookies :: Table Cookie
|
|
cookies = table "cookies" []
|
|
|
|
databasePath :: IO FilePath
|
|
databasePath = do
|
|
datadir <- getUserDataDir "qutebrowser"
|
|
return $ joinPath [datadir, "webengine", "Cookies"]
|
|
|
|
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
|
|
where bullet = map (" * " <>)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
database <- databasePath
|
|
whitelist <- makeWhitelist <$> (T.readFile =<< whitelistPath)
|
|
|
|
withSQLite database $ do
|
|
bad <- query $ do
|
|
cookie <- select cookies
|
|
restrict (by whitelist cookie)
|
|
return (cookie ! #host_key)
|
|
n <- deleteFrom cookies (by whitelist)
|
|
|
|
if (n > 0)
|
|
then do
|
|
log ("Deleted " <> num n <> " cookies from:")
|
|
log (prettyPrint bad)
|
|
else log ("Nothing to delete.")
|
|
|
|
where log = liftIO . T.putStrLn
|
|
num = T.pack . show
|
|
by set x = not_ (x ! #host_key `isIn` set)
|