-- | 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"