-- | 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 -> IO CookieJar
readCookies FilePath
filepath = do
    Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
filepath
    if Bool
exists then do
        ByteString
file <- FilePath -> IO ByteString
B.readFile FilePath
filepath
        UTCTime
now <- IO UTCTime
getCurrentTime
        CookieJar -> IO CookieJar
forall (m :: * -> *) a. Monad m => a -> m a
return (CookieJar -> IO CookieJar) -> CookieJar -> IO CookieJar
forall a b. (a -> b) -> a -> b
$ [Cookie] -> CookieJar
createCookieJar ([Cookie] -> CookieJar) -> [Cookie] -> CookieJar
forall a b. (a -> b) -> a -> b
$ UTCTime -> ByteString -> [Cookie]
readCookies' UTCTime
now ByteString
file
    else CookieJar -> IO CookieJar
forall (m :: * -> *) a. Monad m => a -> m a
return (CookieJar -> IO CookieJar) -> CookieJar -> IO CookieJar
forall a b. (a -> b) -> a -> b
$ [Cookie] -> CookieJar
createCookieJar []
readCookies' :: UTCTime -> B.ByteString -> [Cookie]
readCookies' :: UTCTime -> ByteString -> [Cookie]
readCookies' UTCTime
now = (ByteString -> Maybe Cookie) -> [ByteString] -> [Cookie]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (UTCTime -> ByteString -> Maybe Cookie
readCookie' UTCTime
now) ([ByteString] -> [Cookie])
-> (ByteString -> [ByteString]) -> ByteString -> [Cookie]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
C.lines
readCookie' :: UTCTime -> B.ByteString -> Maybe Cookie
readCookie' :: UTCTime -> ByteString -> Maybe Cookie
readCookie' UTCTime
now = UTCTime -> [ByteString] -> Maybe Cookie
readCookie UTCTime
now ([ByteString] -> Maybe Cookie)
-> (ByteString -> [ByteString]) -> ByteString -> Maybe Cookie
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
C.split Char
'\t'
readCookie :: UTCTime -> [B.ByteString] -> Maybe Cookie
readCookie :: UTCTime -> [ByteString] -> Maybe Cookie
readCookie UTCTime
now [ByteString
domain, ByteString
_, ByteString
path, ByteString
secure, ByteString
expiration, ByteString
name, ByteString
value] =
    Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie :: ByteString
-> ByteString
-> UTCTime
-> ByteString
-> ByteString
-> UTCTime
-> UTCTime
-> Bool
-> Bool
-> Bool
-> Bool
-> Cookie
Cookie {
        cookie_domain :: ByteString
cookie_domain = ByteString
domain,
        cookie_path :: ByteString
cookie_path = ByteString
path,
        cookie_secure_only :: Bool
cookie_secure_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
secure,
        cookie_expiry_time :: UTCTime
cookie_expiry_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
nominalDay UTCTime
now) (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
expiration,
        cookie_name :: ByteString
cookie_name = ByteString
name,
        cookie_value :: ByteString
cookie_value = ByteString
value,

        cookie_creation_time :: UTCTime
cookie_creation_time = UTCTime
now,
        cookie_last_access_time :: UTCTime
cookie_last_access_time = UTCTime
now,
        cookie_persistent :: Bool
cookie_persistent = Bool
True,
        cookie_host_only :: Bool
cookie_host_only = Bool
False,
        cookie_http_only :: Bool
cookie_http_only = Bool
False
    }
readCookie UTCTime
now [ByteString
domain, ByteString
_, ByteString
path, ByteString
secure, ByteString
expiration, ByteString
name, ByteString
value, ByteString
httpOnly, ByteString
session] =
    Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie :: ByteString
-> ByteString
-> UTCTime
-> ByteString
-> ByteString
-> UTCTime
-> UTCTime
-> Bool
-> Bool
-> Bool
-> Bool
-> Cookie
Cookie {
        cookie_domain :: ByteString
cookie_domain = ByteString
domain,
        cookie_path :: ByteString
cookie_path = ByteString
path,
        cookie_secure_only :: Bool
cookie_secure_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
secure,
        cookie_expiry_time :: UTCTime
cookie_expiry_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
nominalDay UTCTime
now) (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
expiration,
        cookie_name :: ByteString
cookie_name = ByteString
name,
        cookie_value :: ByteString
cookie_value = ByteString
value,
        cookie_http_only :: Bool
cookie_http_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
httpOnly,
        cookie_persistent :: Bool
cookie_persistent = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
session,

        cookie_creation_time :: UTCTime
cookie_creation_time = UTCTime
now,
        cookie_last_access_time :: UTCTime
cookie_last_access_time = UTCTime
now,
        cookie_host_only :: Bool
cookie_host_only = Bool
False
    }
readCookie UTCTime
now [ByteString
domain, ByteString
_, ByteString
path, ByteString
secure, ByteString
expiration, ByteString
name, ByteString
value,
    ByteString
httpOnly, ByteString
session, ByteString
sameSite] = Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie :: ByteString
-> ByteString
-> UTCTime
-> ByteString
-> ByteString
-> UTCTime
-> UTCTime
-> Bool
-> Bool
-> Bool
-> Bool
-> Cookie
Cookie {
        cookie_domain :: ByteString
cookie_domain = ByteString
domain,
        cookie_path :: ByteString
cookie_path = ByteString
path,
        cookie_secure_only :: Bool
cookie_secure_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
secure,
        cookie_expiry_time :: UTCTime
cookie_expiry_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
nominalDay UTCTime
now) (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
expiration,
        cookie_name :: ByteString
cookie_name = ByteString
name,
        cookie_value :: ByteString
cookie_value = ByteString
value,
        cookie_http_only :: Bool
cookie_http_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
httpOnly,
        cookie_persistent :: Bool
cookie_persistent = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
session,
        cookie_host_only :: Bool
cookie_host_only = ByteString
sameSite ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"STRICT",

        cookie_creation_time :: UTCTime
cookie_creation_time = UTCTime
now,
        cookie_last_access_time :: UTCTime
cookie_last_access_time = UTCTime
now
    }
readCookie UTCTime
now [ByteString
domain, ByteString
_, ByteString
path, ByteString
secure, ByteString
expiration, ByteString
name, ByteString
value,
    ByteString
httpOnly, ByteString
session, ByteString
sameSite, ByteString
_] = Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie :: ByteString
-> ByteString
-> UTCTime
-> ByteString
-> ByteString
-> UTCTime
-> UTCTime
-> Bool
-> Bool
-> Bool
-> Bool
-> Cookie
Cookie {
        cookie_domain :: ByteString
cookie_domain = ByteString
domain,
        cookie_path :: ByteString
cookie_path = ByteString
path,
        cookie_secure_only :: Bool
cookie_secure_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
secure,
        cookie_expiry_time :: UTCTime
cookie_expiry_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
nominalDay UTCTime
now) (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
expiration,
        cookie_name :: ByteString
cookie_name = ByteString
name,
        cookie_value :: ByteString
cookie_value = ByteString
value,
        cookie_http_only :: Bool
cookie_http_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
httpOnly,
        cookie_persistent :: Bool
cookie_persistent = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
session,
        cookie_host_only :: Bool
cookie_host_only = ByteString
sameSite ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"STRICT",

        cookie_creation_time :: UTCTime
cookie_creation_time = UTCTime
now,
        cookie_last_access_time :: UTCTime
cookie_last_access_time = UTCTime
now
    }
readCookie UTCTime
now [ByteString
domain, ByteString
_, ByteString
path, ByteString
secure, ByteString
expiration, ByteString
name, ByteString
value,
    ByteString
httpOnly, ByteString
session, ByteString
sameSite, ByteString
_, ByteString
creation] = Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie :: ByteString
-> ByteString
-> UTCTime
-> ByteString
-> ByteString
-> UTCTime
-> UTCTime
-> Bool
-> Bool
-> Bool
-> Bool
-> Cookie
Cookie {
        cookie_domain :: ByteString
cookie_domain = ByteString
domain,
        cookie_path :: ByteString
cookie_path = ByteString
path,
        cookie_secure_only :: Bool
cookie_secure_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
secure,
        cookie_expiry_time :: UTCTime
cookie_expiry_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
nominalDay UTCTime
now) (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
expiration,
        cookie_name :: ByteString
cookie_name = ByteString
name,
        cookie_value :: ByteString
cookie_value = ByteString
value,
        cookie_http_only :: Bool
cookie_http_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
httpOnly,
        cookie_persistent :: Bool
cookie_persistent = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
session,
        cookie_host_only :: Bool
cookie_host_only = ByteString
sameSite ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"STRICT",
        cookie_creation_time :: UTCTime
cookie_creation_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe UTCTime
now (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
creation,
        cookie_last_access_time :: UTCTime
cookie_last_access_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe UTCTime
now (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
creation
    }
readCookie UTCTime
now (ByteString
domain:ByteString
_:ByteString
path:ByteString
secure:ByteString
expiration:ByteString
name:ByteString
value:
    ByteString
httpOnly:ByteString
session:ByteString
sameSite:ByteString
_:ByteString
creation:ByteString
access:[ByteString]
_) = Cookie -> Maybe Cookie
forall a. a -> Maybe a
Just Cookie :: ByteString
-> ByteString
-> UTCTime
-> ByteString
-> ByteString
-> UTCTime
-> UTCTime
-> Bool
-> Bool
-> Bool
-> Bool
-> Cookie
Cookie {
        cookie_domain :: ByteString
cookie_domain = ByteString
domain,
        cookie_path :: ByteString
cookie_path = ByteString
path,
        cookie_secure_only :: Bool
cookie_secure_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
secure,
        cookie_expiry_time :: UTCTime
cookie_expiry_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
nominalDay UTCTime
now) (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
expiration,
        cookie_name :: ByteString
cookie_name = ByteString
name,
        cookie_value :: ByteString
cookie_value = ByteString
value,
        cookie_http_only :: Bool
cookie_http_only = ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
httpOnly,
        cookie_persistent :: Bool
cookie_persistent = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
b ByteString
session,
        cookie_host_only :: Bool
cookie_host_only = ByteString
sameSite ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"STRICT",
        cookie_creation_time :: UTCTime
cookie_creation_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe UTCTime
now (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
creation,
        cookie_last_access_time :: UTCTime
cookie_last_access_time = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe UTCTime
now (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UTCTime
parseCookieExpires ByteString
access
    }
readCookie UTCTime
_ [ByteString]
_ = Maybe Cookie
forall a. Maybe a
Nothing
b :: a -> Bool
b a
"TRUE" = Bool
True
b a
_ = Bool
False

writeCookies :: FilePath -> CookieJar -> Bool -> IO ()
writeCookies :: FilePath -> CookieJar -> Bool -> IO ()
writeCookies FilePath
filepath CookieJar
cookies Bool
isSession = do
    FilePath -> ByteString -> IO ()
B.writeFile FilePath
filepath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> [Cookie] -> ByteString
writeCookies' Bool
isSession ([Cookie] -> ByteString) -> [Cookie] -> ByteString
forall a b. (a -> b) -> a -> b
$ CookieJar -> [Cookie]
destroyCookieJar CookieJar
cookies
writeCookies' :: Bool -> [Cookie] -> B.ByteString
writeCookies' :: Bool -> [Cookie] -> ByteString
writeCookies' Bool
isSession = [ByteString] -> ByteString
C.unlines ([ByteString] -> ByteString)
-> ([Cookie] -> [ByteString]) -> [Cookie] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cookie -> ByteString) -> [Cookie] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Cookie -> ByteString
writeCookie' ([Cookie] -> [ByteString])
-> ([Cookie] -> [Cookie]) -> [Cookie] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cookie -> Bool) -> [Cookie] -> [Cookie]
forall a. (a -> Bool) -> [a] -> [a]
filter Cookie -> Bool
shouldSaveCookie
    where
        shouldSaveCookie :: Cookie -> Bool
shouldSaveCookie | Bool
isSession = Cookie -> Bool
cookie_persistent
            | Bool
otherwise = Bool -> Cookie -> Bool
forall a b. a -> b -> a
const Bool
True
writeCookie' :: Cookie -> B.ByteString
writeCookie' :: Cookie -> ByteString
writeCookie' Cookie {Bool
ByteString
UTCTime
cookie_http_only :: Bool
cookie_secure_only :: Bool
cookie_host_only :: Bool
cookie_persistent :: Bool
cookie_last_access_time :: UTCTime
cookie_creation_time :: UTCTime
cookie_path :: ByteString
cookie_domain :: ByteString
cookie_expiry_time :: UTCTime
cookie_value :: ByteString
cookie_name :: ByteString
cookie_http_only :: Cookie -> Bool
cookie_host_only :: Cookie -> Bool
cookie_persistent :: Cookie -> Bool
cookie_last_access_time :: Cookie -> UTCTime
cookie_creation_time :: Cookie -> UTCTime
cookie_value :: Cookie -> ByteString
cookie_name :: Cookie -> ByteString
cookie_expiry_time :: Cookie -> UTCTime
cookie_secure_only :: Cookie -> Bool
cookie_path :: Cookie -> ByteString
cookie_domain :: Cookie -> ByteString
..} = ByteString -> [ByteString] -> ByteString
C.intercalate ByteString
"\t" [
    ByteString
cookie_domain, ByteString
"TRUE", ByteString
cookie_path, Bool -> ByteString
forall {p}. IsString p => Bool -> p
b' Bool
cookie_secure_only,
    UTCTime -> ByteString
formatCookieExpires UTCTime
cookie_expiry_time, ByteString
cookie_name, ByteString
cookie_value,
    Bool -> ByteString
forall {p}. IsString p => Bool -> p
b' Bool
cookie_http_only, Bool -> ByteString
forall {p}. IsString p => Bool -> p
b' (Bool -> ByteString) -> Bool -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
cookie_persistent,
    if Bool
cookie_host_only then ByteString
"STRICT" else ByteString
"LAX", ByteString
"MEDIUM",
    UTCTime -> ByteString
formatCookieExpires UTCTime
cookie_creation_time,
    UTCTime -> ByteString
formatCookieExpires UTCTime
cookie_last_access_time]
b' :: Bool -> p
b' Bool
True = p
"TRUE"
b' Bool
False = p
"FALSE"