-- | Read & write Netscape Navigator cookies format. {-# LANGUAGE OverloadedStrings, RecordWildCards #-} module Network.URI.CookiesDB (readCookies, writeCookies) where import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C import Network.HTTP.Client import System.Directory (doesFileExist) import Web.Cookie (formatCookieExpires, parseCookieExpires) import Data.Maybe (fromMaybe, mapMaybe) import Data.Time.Clock (nominalDay, getCurrentTime, addUTCTime, UTCTime) readCookies :: FilePath -> IO CookieJar readCookies filepath = do exists <- doesFileExist filepath if exists then do file <- B.readFile filepath now <- getCurrentTime return $ createCookieJar $ readCookies' now file else return $ createCookieJar [] readCookies' :: UTCTime -> B.ByteString -> [Cookie] readCookies' now = mapMaybe (readCookie' now) . C.lines readCookie' :: UTCTime -> B.ByteString -> Maybe Cookie readCookie' now = readCookie now . C.split '\t' readCookie :: UTCTime -> [B.ByteString] -> Maybe Cookie readCookie now [domain, _, path, secure, expiration, name, value] = Just Cookie { cookie_domain = domain, cookie_path = path, cookie_secure_only = b secure, cookie_expiry_time = fromMaybe (addUTCTime nominalDay now) $ parseCookieExpires expiration, cookie_name = name, cookie_value = value, cookie_creation_time = now, cookie_last_access_time = now, cookie_persistent = True, cookie_host_only = False, cookie_http_only = False } readCookie now [domain, _, path, secure, expiration, name, value, httpOnly, session] = Just Cookie { cookie_domain = domain, cookie_path = path, cookie_secure_only = b secure, cookie_expiry_time = fromMaybe (addUTCTime nominalDay now) $ parseCookieExpires expiration, cookie_name = name, cookie_value = value, cookie_http_only = b httpOnly, cookie_persistent = not $ b session, cookie_creation_time = now, cookie_last_access_time = now, cookie_host_only = False } readCookie now [domain, _, path, secure, expiration, name, value, httpOnly, session, sameSite] = Just Cookie { cookie_domain = domain, cookie_path = path, cookie_secure_only = b secure, cookie_expiry_time = fromMaybe (addUTCTime nominalDay now) $ parseCookieExpires expiration, cookie_name = name, cookie_value = value, cookie_http_only = b httpOnly, cookie_persistent = not $ b session, cookie_host_only = sameSite == "STRICT", cookie_creation_time = now, cookie_last_access_time = now } readCookie now [domain, _, path, secure, expiration, name, value, httpOnly, session, sameSite, _] = Just Cookie { cookie_domain = domain, cookie_path = path, cookie_secure_only = b secure, cookie_expiry_time = fromMaybe (addUTCTime nominalDay now) $ parseCookieExpires expiration, cookie_name = name, cookie_value = value, cookie_http_only = b httpOnly, cookie_persistent = not $ b session, cookie_host_only = sameSite == "STRICT", cookie_creation_time = now, cookie_last_access_time = now } readCookie now [domain, _, path, secure, expiration, name, value, httpOnly, session, sameSite, _, creation] = Just Cookie { cookie_domain = domain, cookie_path = path, cookie_secure_only = b secure, cookie_expiry_time = fromMaybe (addUTCTime nominalDay now) $ parseCookieExpires expiration, cookie_name = name, cookie_value = value, cookie_http_only = b httpOnly, cookie_persistent = not $ b session, cookie_host_only = sameSite == "STRICT", cookie_creation_time = fromMaybe now $ parseCookieExpires creation, cookie_last_access_time = fromMaybe now $ parseCookieExpires creation } readCookie now (domain:_:path:secure:expiration:name:value: httpOnly:session:sameSite:_:creation:access:_) = Just Cookie { cookie_domain = domain, cookie_path = path, cookie_secure_only = b secure, cookie_expiry_time = fromMaybe (addUTCTime nominalDay now) $ parseCookieExpires expiration, cookie_name = name, cookie_value = value, cookie_http_only = b httpOnly, cookie_persistent = not $ b session, cookie_host_only = sameSite == "STRICT", cookie_creation_time = fromMaybe now $ parseCookieExpires creation, cookie_last_access_time = fromMaybe now $ parseCookieExpires access } readCookie _ _ = Nothing b "TRUE" = True b _ = False writeCookies :: FilePath -> CookieJar -> Bool -> IO () writeCookies filepath cookies isSession = do B.writeFile filepath $ writeCookies' isSession $ destroyCookieJar cookies writeCookies' :: Bool -> [Cookie] -> B.ByteString writeCookies' isSession = C.unlines . map writeCookie' . filter shouldSaveCookie where shouldSaveCookie | isSession = cookie_persistent | otherwise = const True writeCookie' :: Cookie -> B.ByteString writeCookie' Cookie {..} = C.intercalate "\t" [ cookie_domain, "TRUE", cookie_path, b' cookie_secure_only, formatCookieExpires cookie_expiry_time, cookie_name, cookie_value, b' cookie_http_only, b' $ not cookie_persistent, if cookie_host_only then "STRICT" else "LAX", "MEDIUM", formatCookieExpires cookie_creation_time, formatCookieExpires cookie_last_access_time] b' True = "TRUE" b' False = "FALSE"