    {-# LANGUAGE OverloadedStrings #-}
    -- | This module implements the algorithms described in RFC 6265 for the Network.HTTP.Conduit library.
    module Network.HTTP.Client.Cookies
        ( updateCookieJar
        , receiveSetCookie
        , generateCookie
        , insertCheckedCookie
        , insertCookiesIntoRequest
        , computeCookieString
        , evictExpiredCookies
        , createCookieJar
        , destroyCookieJar
        , pathMatches
        , removeExistingCookieFromCookieJar
        , domainMatches
        , isIpAddress
        , isPotentiallyTrustworthyOrigin
        , defaultPath
        ) where

    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Char8 as S8
    import Data.Maybe
    import qualified Data.List as L
    import Data.Time.Clock
    import Data.Time.Calendar
    import Web.Cookie
    import qualified Data.CaseInsensitive as CI
    import Blaze.ByteString.Builder
    import qualified Network.PublicSuffixList.Lookup as PSL
    import Data.Text.Encoding (decodeUtf8With)
    import Data.Text.Encoding.Error (lenientDecode)
    import qualified Data.IP as IP
    import Text.Read (readMaybe)

    import Network.HTTP.Client.Types as Req

    slash :: Integral a => a
    slash :: forall a. Integral a => a
    slash = a
    47 -- '/'

    isIpAddress :: BS.ByteString -> Bool
    isIpAddress :: ByteString -> Bool
    isIpAddress =
        Int -> ByteString -> Bool
    forall {t}. (Eq t, Num t) => t -> ByteString -> Bool
    go (Int
    4 :: Int)
      where
        go :: t -> ByteString -> Bool
    go t
    0 ByteString
    bs = ByteString -> Bool
    BS.null ByteString
    bs
        go t
    rest ByteString
    bs =
            case ByteString -> Maybe (Int, ByteString)
    S8.readInt ByteString
    x of
                Just (Int
    i, ByteString
    x') | ByteString -> Bool
    BS.null ByteString
    x' Bool -> Bool -> Bool
    && Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    256 -> t -> ByteString -> Bool
    go (t
    rest t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1) ByteString
    y
                Maybe (Int, ByteString)
    _ -> Bool
    False
          where
            (ByteString
    x, ByteString
    y') = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
    BS.break (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    46) ByteString
    bs -- period
            y :: ByteString
    y = Int -> ByteString -> ByteString
    BS.drop Int
    1 ByteString
    y'

    -- | This corresponds to the subcomponent algorithm entitled \"Domain Matching\" detailed
    -- in section 5.1.3
    domainMatches :: BS.ByteString -- ^ Domain to test
                  -> BS.ByteString -- ^ Domain from a cookie
                  -> Bool
    domainMatches :: ByteString -> ByteString -> Bool
    domainMatches ByteString
    string' ByteString
    domainString'
      | ByteString
    string ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    domainString = Bool
    True
      | ByteString -> Int
    BS.length ByteString
    string Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < ByteString -> Int
    BS.length ByteString
    domainString Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 = Bool
    False
      | ByteString
    domainString ByteString -> ByteString -> Bool
    `BS.isSuffixOf` ByteString
    string Bool -> Bool -> Bool
    && Word8 -> ByteString
    BS.singleton (HasCallStack => ByteString -> Word8
    ByteString -> Word8
    BS.last ByteString
    difference) ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "." Bool -> Bool -> Bool
    && Bool -> Bool
    not (ByteString -> Bool
    isIpAddress ByteString
    string) = Bool
    True
      | Bool
    otherwise = Bool
    False
      where difference :: ByteString
    difference = Int -> ByteString -> ByteString
    BS.take (ByteString -> Int
    BS.length ByteString
    string Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - ByteString -> Int
    BS.length ByteString
    domainString) ByteString
    string
            string :: ByteString
    string = ByteString -> ByteString
    forall s. FoldCase s => s -> s
    CI.foldCase ByteString
    string'
            domainString :: ByteString
    domainString = ByteString -> ByteString
    forall s. FoldCase s => s -> s
    CI.foldCase ByteString
    domainString'

    -- | This corresponds to the subcomponent algorithm entitled \"Paths\" detailed
    -- in section 5.1.4
    defaultPath :: Req.Request   -> BS.ByteString
    defaultPath :: Request -> ByteString
    defaultPath Request
    req
      | ByteString -> Bool
    BS.null ByteString
    uri_path = ByteString
    "/"
      | Word8 -> ByteString
    BS.singleton (HasCallStack => ByteString -> Word8
    ByteString -> Word8
    BS.head ByteString
    uri_path) ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    "/" = ByteString
    "/"
      | Word8 -> ByteString -> Int
    BS.count Word8
    forall a. Integral a => a
    slash ByteString
    uri_path Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1 = ByteString
    "/"
      | Bool
    otherwise = ByteString -> ByteString
    BS.reverse (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => ByteString -> ByteString
    ByteString -> ByteString
    BS.tail (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Bool) -> ByteString -> ByteString
    BS.dropWhile (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    forall a. Integral a => a
    slash) (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    BS.reverse ByteString
    uri_path
      where uri_path :: ByteString
    uri_path = Request -> ByteString
    Req.path Request
    req

    -- | This corresponds to the subcomponent algorithm entitled \"Path-Match\" detailed
    -- in section 5.1.4
    pathMatches :: BS.ByteString -> BS.ByteString -> Bool
    pathMatches :: ByteString -> ByteString -> Bool
    pathMatches ByteString
    requestPath ByteString
    cookiePath
      | ByteString
    cookiePath ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    path' = Bool
    True
      | ByteString
    cookiePath ByteString -> ByteString -> Bool
    `BS.isPrefixOf` ByteString
    path' Bool -> Bool -> Bool
    && Word8 -> ByteString
    BS.singleton (HasCallStack => ByteString -> Word8
    ByteString -> Word8
    BS.last ByteString
    cookiePath) ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "/" = Bool
    True
      | ByteString
    cookiePath ByteString -> ByteString -> Bool
    `BS.isPrefixOf` ByteString
    path' Bool -> Bool -> Bool
    && Word8 -> ByteString
    BS.singleton (HasCallStack => ByteString -> Word8
    ByteString -> Word8
    BS.head ByteString
    remainder)  ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "/" = Bool
    True
      | Bool
    otherwise = Bool
    False
      where remainder :: ByteString
    remainder = Int -> ByteString -> ByteString
    BS.drop (ByteString -> Int
    BS.length ByteString
    cookiePath) ByteString
    requestPath
            path' :: ByteString
    path' = case ByteString -> Maybe (Char, ByteString)
    S8.uncons ByteString
    requestPath of
                     Just (Char
    '/', ByteString
    _) -> ByteString
    requestPath
                     Maybe (Char, ByteString)
    _             -> Char
    '/' Char -> ByteString -> ByteString
    `S8.cons` ByteString
    requestPath

    createCookieJar :: [Cookie] -> CookieJar
    createCookieJar :: [Cookie] -> CookieJar
    createCookieJar = [Cookie] -> CookieJar
    CJ

    destroyCookieJar :: CookieJar -> [Cookie]
    destroyCookieJar :: CookieJar -> [Cookie]
    destroyCookieJar = CookieJar -> [Cookie]
    expose

    insertIntoCookieJar :: Cookie -> CookieJar -> CookieJar
    insertIntoCookieJar :: Cookie -> CookieJar -> CookieJar
    insertIntoCookieJar Cookie
    cookie CookieJar
    cookie_jar' = [Cookie] -> CookieJar
    CJ ([Cookie] -> CookieJar) -> [Cookie] -> CookieJar
    forall a b. (a -> b) -> a -> b
    $ Cookie
    cookie Cookie -> [Cookie] -> [Cookie]
    forall a. a -> [a] -> [a]
    : [Cookie]
    cookie_jar
      where cookie_jar :: [Cookie]
    cookie_jar = CookieJar -> [Cookie]
    expose CookieJar
    cookie_jar'

    removeExistingCookieFromCookieJar :: Cookie -> CookieJar -> (Maybe Cookie, CookieJar)
    removeExistingCookieFromCookieJar :: Cookie -> CookieJar -> (Maybe Cookie, CookieJar)
    removeExistingCookieFromCookieJar Cookie
    cookie CookieJar
    cookie_jar' = (Maybe Cookie
    mc, [Cookie] -> CookieJar
    CJ [Cookie]
    lc)
      where (Maybe Cookie
    mc, [Cookie]
    lc) = Cookie -> [Cookie] -> (Maybe Cookie, [Cookie])
    removeExistingCookieFromCookieJarHelper Cookie
    cookie (CookieJar -> [Cookie]
    expose CookieJar
    cookie_jar')
            removeExistingCookieFromCookieJarHelper :: Cookie -> [Cookie] -> (Maybe Cookie, [Cookie])
    removeExistingCookieFromCookieJarHelper Cookie
    _ [] = (Maybe Cookie
    forall a. Maybe a
    Nothing, [])
            removeExistingCookieFromCookieJarHelper Cookie
    c (Cookie
    c' : [Cookie]
    cs)
              | Cookie
    c Cookie -> Cookie -> Bool
    `equivCookie` Cookie
    c' = (Cookie -> Maybe Cookie
    forall a. a -> Maybe a
    Just Cookie
    c', [Cookie]
    cs)
              | Bool
    otherwise = (Maybe Cookie
    cookie', Cookie
    c' Cookie -> [Cookie] -> [Cookie]
    forall a. a -> [a] -> [a]
    : [Cookie]
    cookie_jar'')
              where (Maybe Cookie
    cookie', [Cookie]
    cookie_jar'') = Cookie -> [Cookie] -> (Maybe Cookie, [Cookie])
    removeExistingCookieFromCookieJarHelper Cookie
    c [Cookie]
    cs

    -- | Are we configured to reject cookies for domains such as \"com\"?
    rejectPublicSuffixes :: Bool
    rejectPublicSuffixes :: Bool
    rejectPublicSuffixes = Bool
    True

    isPublicSuffix :: BS.ByteString -> Bool
    isPublicSuffix :: ByteString -> Bool
    isPublicSuffix = Text -> Bool
    PSL.isSuffix (Text -> Bool) -> (ByteString -> Text) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OnDecodeError -> ByteString -> Text
    decodeUtf8With OnDecodeError
    lenientDecode

    -- | Algorithm described in \"Secure Contexts\", Section 3.1, \"Is origin potentially trustworthy?\"
    --
    -- Note per RFC6265 section 5.4 user agent is free to define the meaning of "secure" protocol.
    --
    -- See:
    -- https://w3c.github.io/webappsec-secure-contexts/#is-origin-trustworthy
    isPotentiallyTrustworthyOrigin :: Bool          -- ^ True if HTTPS
                                   -> BS.ByteString -- ^ Host
                                   -> Bool          -- ^ Whether or not the origin is potentially trustworthy
    isPotentiallyTrustworthyOrigin :: Bool -> ByteString -> Bool
    isPotentiallyTrustworthyOrigin Bool
    secure ByteString
    host
      | Bool
    secure = Bool
    True             -- step 3
      | Bool
    isLoopbackAddr4 = Bool
    True    -- step 4, part 1
      | Bool
    isLoopbackAddr6 = Bool
    True    -- step 4, part 2
      | Bool
    isLoopbackHostname = Bool
    True -- step 5
      | Bool
    otherwise = Bool
    False
      where isLoopbackHostname :: Bool
    isLoopbackHostname =
                   ByteString
    host ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "localhost"
                Bool -> Bool -> Bool
    || ByteString
    host ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "localhost."
                Bool -> Bool -> Bool
    || ByteString -> ByteString -> Bool
    BS.isSuffixOf ByteString
    ".localhost" ByteString
    host
                Bool -> Bool -> Bool
    || ByteString -> ByteString -> Bool
    BS.isSuffixOf ByteString
    ".localhost." ByteString
    host
            isLoopbackAddr4 :: Bool
    isLoopbackAddr4 =
              (IPv4 -> [Int]) -> Maybe IPv4 -> Maybe [Int]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([Int] -> [Int]) -> (IPv4 -> [Int]) -> IPv4 -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IPv4 -> [Int]
    IP.fromIPv4) (String -> Maybe IPv4
    forall a. Read a => String -> Maybe a
    readMaybe (ByteString -> String
    S8.unpack ByteString
    host)) Maybe [Int] -> Maybe [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Int] -> Maybe [Int]
    forall a. a -> Maybe a
    Just [Int
    127]
            isLoopbackAddr6 :: Bool
    isLoopbackAddr6 =
              (IPv6 -> HostAddress6) -> Maybe IPv6 -> Maybe HostAddress6
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap IPv6 -> HostAddress6
    IP.toHostAddress6 Maybe IPv6
    maddr6 Maybe HostAddress6 -> Maybe HostAddress6 -> Bool
    forall a. Eq a => a -> a -> Bool
    == HostAddress6 -> Maybe HostAddress6
    forall a. a -> Maybe a
    Just (Word32
    0, Word32
    0, Word32
    0, Word32
    1)
            maddr6 :: Maybe IPv6
    maddr6 = do
              (c1, rest1) <- ByteString -> Maybe (Char, ByteString)
    S8.uncons ByteString
    host
              (rest2, c2) <- S8.unsnoc rest1
              case [c1, c2] of
                String
    "[]" -> String -> Maybe IPv6
    forall a. Read a => String -> Maybe a
    readMaybe (ByteString -> String
    S8.unpack ByteString
    rest2)
                String
    _ -> Maybe IPv6
    forall a. Maybe a
    Nothing

    -- | This corresponds to the eviction algorithm described in Section 5.3 \"Storage Model\"
    evictExpiredCookies :: CookieJar  -- ^ Input cookie jar
                        -> UTCTime    -- ^ Value that should be used as \"now\"
                        -> CookieJar  -- ^ Filtered cookie jar
    evictExpiredCookies :: CookieJar -> UTCTime -> CookieJar
    evictExpiredCookies CookieJar
    cookie_jar' UTCTime
    now = [Cookie] -> CookieJar
    CJ ([Cookie] -> CookieJar) -> [Cookie] -> CookieJar
    forall a b. (a -> b) -> a -> b
    $ (Cookie -> Bool) -> [Cookie] -> [Cookie]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\ Cookie
    cookie -> Cookie -> UTCTime
    cookie_expiry_time Cookie
    cookie UTCTime -> UTCTime -> Bool
    forall a. Ord a => a -> a -> Bool
    >= UTCTime
    now) ([Cookie] -> [Cookie]) -> [Cookie] -> [Cookie]
    forall a b. (a -> b) -> a -> b
    $ CookieJar -> [Cookie]
    expose CookieJar
    cookie_jar'

    -- | This applies the 'computeCookieString' to a given Request
    insertCookiesIntoRequest :: Req.Request                 -- ^ The request to insert into
                             -> CookieJar                   -- ^ Current cookie jar
                             -> UTCTime                     -- ^ Value that should be used as \"now\"
                             -> (Req.Request, CookieJar)    -- ^ (Output request, Updated cookie jar (last-access-time is updated))
    insertCookiesIntoRequest :: Request -> CookieJar -> UTCTime -> (Request, CookieJar)
    insertCookiesIntoRequest Request
    request CookieJar
    cookie_jar UTCTime
    now
      | ByteString -> Bool
    BS.null ByteString
    cookie_string = (Request
    request, CookieJar
    cookie_jar')
      | Bool
    otherwise = (Request
    request {Req.requestHeaders = cookie_header : purgedHeaders}, CookieJar
    cookie_jar')
      where purgedHeaders :: [(CI ByteString, ByteString)]
    purgedHeaders = ((CI ByteString, ByteString)
     -> (CI ByteString, ByteString) -> Bool)
    -> (CI ByteString, ByteString)
    -> [(CI ByteString, ByteString)]
    -> [(CI ByteString, ByteString)]
    forall a. (a -> a -> Bool) -> a -> [a] -> [a]
    L.deleteBy (\ (CI ByteString
    a, ByteString
    _) (CI ByteString
    b, ByteString
    _) -> CI ByteString
    a CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString
    b) (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    "Cookie", ByteString
    BS.empty) ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)])
    -> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ Request -> [(CI ByteString, ByteString)]
    Req.requestHeaders Request
    request
            (ByteString
    cookie_string, CookieJar
    cookie_jar') = Request -> CookieJar -> UTCTime -> Bool -> (ByteString, CookieJar)
    computeCookieString Request
    request CookieJar
    cookie_jar UTCTime
    now Bool
    True
            cookie_header :: (CI ByteString, ByteString)
    cookie_header = (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    "Cookie", ByteString
    cookie_string)

    -- | This corresponds to the algorithm described in Section 5.4 \"The Cookie Header\"
    computeCookieString :: Req.Request           -- ^ Input request
                        -> CookieJar             -- ^ Current cookie jar
                        -> UTCTime               -- ^ Value that should be used as \"now\"
                        -> Bool                  -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that)
                        -> (BS.ByteString, CookieJar)  -- ^ (Contents of a \"Cookie\" header, Updated cookie jar (last-access-time is updated))
    computeCookieString :: Request -> CookieJar -> UTCTime -> Bool -> (ByteString, CookieJar)
    computeCookieString Request
    request CookieJar
    cookie_jar UTCTime
    now Bool
    is_http_api = (ByteString
    output_line, CookieJar
    cookie_jar')
      where matching_cookie :: Cookie -> Bool
    matching_cookie Cookie
    cookie = Bool
    condition1 Bool -> Bool -> Bool
    && Bool
    condition2 Bool -> Bool -> Bool
    && Bool
    condition3 Bool -> Bool -> Bool
    && Bool
    condition4
              where condition1 :: Bool
    condition1
                      | Cookie -> Bool
    cookie_host_only Cookie
    cookie = ByteString -> ByteString
    forall s. FoldCase s => s -> s
    CI.foldCase (Request -> ByteString
    Req.host Request
    request) ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString -> ByteString
    forall s. FoldCase s => s -> s
    CI.foldCase (Cookie -> ByteString
    cookie_domain Cookie
    cookie)
                      | Bool
    otherwise = ByteString -> ByteString -> Bool
    domainMatches (Request -> ByteString
    Req.host Request
    request) (Cookie -> ByteString
    cookie_domain Cookie
    cookie)
                    condition2 :: Bool
    condition2 = ByteString -> ByteString -> Bool
    pathMatches (Request -> ByteString
    Req.path Request
    request) (Cookie -> ByteString
    cookie_path Cookie
    cookie)
                    condition3 :: Bool
    condition3
                      | Bool -> Bool
    not (Cookie -> Bool
    cookie_secure_only Cookie
    cookie) = Bool
    True
                      | Bool
    otherwise = Bool -> ByteString -> Bool
    isPotentiallyTrustworthyOrigin (Request -> Bool
    Req.secure Request
    request) (Request -> ByteString
    Req.host Request
    request)
                    condition4 :: Bool
    condition4
                      | Bool -> Bool
    not (Cookie -> Bool
    cookie_http_only Cookie
    cookie) = Bool
    True
                      | Bool
    otherwise = Bool
    is_http_api
            matching_cookies :: [Cookie]
    matching_cookies = (Cookie -> Bool) -> [Cookie] -> [Cookie]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Cookie -> Bool
    matching_cookie ([Cookie] -> [Cookie]) -> [Cookie] -> [Cookie]
    forall a b. (a -> b) -> a -> b
    $ CookieJar -> [Cookie]
    expose CookieJar
    cookie_jar
            output_cookies :: [(ByteString, ByteString)]
    output_cookies =  (Cookie -> (ByteString, ByteString))
    -> [Cookie] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ Cookie
    c -> (Cookie -> ByteString
    cookie_name Cookie
    c, Cookie -> ByteString
    cookie_value Cookie
    c)) ([Cookie] -> [(ByteString, ByteString)])
    -> [Cookie] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ (Cookie -> Cookie -> Ordering) -> [Cookie] -> [Cookie]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    L.sortBy Cookie -> Cookie -> Ordering
    compareCookies [Cookie]
    matching_cookies
            output_line :: ByteString
    output_line = Builder -> ByteString
    toByteString (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [(ByteString, ByteString)] -> Builder
    renderCookies ([(ByteString, ByteString)] -> Builder)
    -> [(ByteString, ByteString)] -> Builder
    forall a b. (a -> b) -> a -> b
    $ [(ByteString, ByteString)]
    output_cookies
            folding_function :: CookieJar -> Cookie -> CookieJar
    folding_function CookieJar
    cookie_jar'' Cookie
    cookie = case Cookie -> CookieJar -> (Maybe Cookie, CookieJar)
    removeExistingCookieFromCookieJar Cookie
    cookie CookieJar
    cookie_jar'' of
              (Just Cookie
    c, CookieJar
    cookie_jar''') -> Cookie -> CookieJar -> CookieJar
    insertIntoCookieJar (Cookie
    c {cookie_last_access_time = now}) CookieJar
    cookie_jar'''
              (Maybe Cookie
    Nothing, CookieJar
    cookie_jar''') -> CookieJar
    cookie_jar'''
            cookie_jar' :: CookieJar
    cookie_jar' = (CookieJar -> Cookie -> CookieJar)
    -> CookieJar -> [Cookie] -> CookieJar
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl CookieJar -> Cookie -> CookieJar
    folding_function CookieJar
    cookie_jar [Cookie]
    matching_cookies

    -- | This applies 'receiveSetCookie' to a given Response
    updateCookieJar :: Response a                   -- ^ Response received from server
                    -> Request                      -- ^ Request which generated the response
                    -> UTCTime                      -- ^ Value that should be used as \"now\"
                    -> CookieJar                    -- ^ Current cookie jar
                    -> (CookieJar, Response a)      -- ^ (Updated cookie jar with cookies from the Response, The response stripped of any \"Set-Cookie\" header)
    updateCookieJar :: forall a.
    Response a
    -> Request -> UTCTime -> CookieJar -> (CookieJar, Response a)
    updateCookieJar Response a
    response Request
    request UTCTime
    now CookieJar
    cookie_jar = (CookieJar
    cookie_jar', Response a
    response { responseHeaders = other_headers })
      where ([(CI ByteString, ByteString)]
    set_cookie_headers, [(CI ByteString, ByteString)]
    other_headers) = ((CI ByteString, ByteString) -> Bool)
    -> [(CI ByteString, ByteString)]
    -> ([(CI ByteString, ByteString)], [(CI ByteString, ByteString)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    L.partition ((CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    "Set-Cookie")) (CI ByteString -> Bool)
    -> ((CI ByteString, ByteString) -> CI ByteString)
    -> (CI ByteString, ByteString)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CI ByteString, ByteString) -> CI ByteString
    forall a b. (a, b) -> a
    fst) ([(CI ByteString, ByteString)]
     -> ([(CI ByteString, ByteString)], [(CI ByteString, ByteString)]))
    -> [(CI ByteString, ByteString)]
    -> ([(CI ByteString, ByteString)], [(CI ByteString, ByteString)])
    forall a b. (a -> b) -> a -> b
    $ Response a -> [(CI ByteString, ByteString)]
    forall body. Response body -> [(CI ByteString, ByteString)]
    responseHeaders Response a
    response
            set_cookie_data :: [ByteString]
    set_cookie_data = ((CI ByteString, ByteString) -> ByteString)
    -> [(CI ByteString, ByteString)] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (CI ByteString, ByteString) -> ByteString
    forall a b. (a, b) -> b
    snd [(CI ByteString, ByteString)]
    set_cookie_headers
            set_cookies :: [SetCookie]
    set_cookies = (ByteString -> SetCookie) -> [ByteString] -> [SetCookie]
    forall a b. (a -> b) -> [a] -> [b]
    map ByteString -> SetCookie
    parseSetCookie [ByteString]
    set_cookie_data
            cookie_jar' :: CookieJar
    cookie_jar' = (CookieJar -> SetCookie -> CookieJar)
    -> CookieJar -> [SetCookie] -> CookieJar
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\ CookieJar
    cj SetCookie
    sc -> SetCookie -> Request -> UTCTime -> Bool -> CookieJar -> CookieJar
    receiveSetCookie SetCookie
    sc Request
    request UTCTime
    now Bool
    True CookieJar
    cj) CookieJar
    cookie_jar [SetCookie]
    set_cookies

    -- | This corresponds to the algorithm described in Section 5.3 \"Storage Model\"
    -- This function consists of calling 'generateCookie' followed by 'insertCheckedCookie'.
    -- Use this function if you plan to do both in a row.
    -- 'generateCookie' and 'insertCheckedCookie' are only provided for more fine-grained control.
    receiveSetCookie :: SetCookie      -- ^ The 'SetCookie' the cookie jar is receiving
                     -> Req.Request    -- ^ The request that originated the response that yielded the 'SetCookie'
                     -> UTCTime        -- ^ Value that should be used as \"now\"
                     -> Bool           -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that)
                     -> CookieJar      -- ^ Input cookie jar to modify
                     -> CookieJar      -- ^ Updated cookie jar
    receiveSetCookie :: SetCookie -> Request -> UTCTime -> Bool -> CookieJar -> CookieJar
    receiveSetCookie SetCookie
    set_cookie Request
    request UTCTime
    now Bool
    is_http_api CookieJar
    cookie_jar = case (do
      cookie <- SetCookie -> Request -> UTCTime -> Bool -> Maybe Cookie
    generateCookie SetCookie
    set_cookie Request
    request UTCTime
    now Bool
    is_http_api
      return $ insertCheckedCookie cookie cookie_jar is_http_api) of
      Just CookieJar
    cj -> CookieJar
    cj
      Maybe CookieJar
    Nothing -> CookieJar
    cookie_jar

    -- | Insert a cookie created by generateCookie into the cookie jar (or not if it shouldn't be allowed in)
    insertCheckedCookie :: Cookie    -- ^ The 'SetCookie' the cookie jar is receiving
                        -> CookieJar -- ^ Input cookie jar to modify
                        -> Bool      -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that)
                        -> CookieJar -- ^ Updated (or not) cookie jar
    insertCheckedCookie :: Cookie -> CookieJar -> Bool -> CookieJar
    insertCheckedCookie Cookie
    c CookieJar
    cookie_jar Bool
    is_http_api = case (do
      (cookie_jar', cookie') <- Cookie -> CookieJar -> Maybe (CookieJar, Cookie)
    existanceTest Cookie
    c CookieJar
    cookie_jar
      return $ insertIntoCookieJar cookie' cookie_jar') of
      Just CookieJar
    cj -> CookieJar
    cj
      Maybe CookieJar
    Nothing -> CookieJar
    cookie_jar
      where existanceTest :: Cookie -> CookieJar -> Maybe (CookieJar, Cookie)
    existanceTest Cookie
    cookie CookieJar
    cookie_jar' = Cookie -> (Maybe Cookie, CookieJar) -> Maybe (CookieJar, Cookie)
    forall {a}. Cookie -> (Maybe Cookie, a) -> Maybe (a, Cookie)
    existanceTestHelper Cookie
    cookie ((Maybe Cookie, CookieJar) -> Maybe (CookieJar, Cookie))
    -> (Maybe Cookie, CookieJar) -> Maybe (CookieJar, Cookie)
    forall a b. (a -> b) -> a -> b
    $ Cookie -> CookieJar -> (Maybe Cookie, CookieJar)
    removeExistingCookieFromCookieJar Cookie
    cookie CookieJar
    cookie_jar'
            existanceTestHelper :: Cookie -> (Maybe Cookie, a) -> Maybe (a, Cookie)
    existanceTestHelper Cookie
    new_cookie (Just Cookie
    old_cookie, a
    cookie_jar')
              | Bool -> Bool
    not Bool
    is_http_api Bool -> Bool -> Bool
    && Cookie -> Bool
    cookie_http_only Cookie
    old_cookie = Maybe (a, Cookie)
    forall a. Maybe a
    Nothing
              | Bool
    otherwise = (a, Cookie) -> Maybe (a, Cookie)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    cookie_jar', Cookie
    new_cookie {cookie_creation_time = cookie_creation_time old_cookie})
            existanceTestHelper Cookie
    new_cookie (Maybe Cookie
    Nothing, a
    cookie_jar') = (a, Cookie) -> Maybe (a, Cookie)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    cookie_jar', Cookie
    new_cookie)

    -- | Turn a SetCookie into a Cookie, if it is valid
    generateCookie :: SetCookie      -- ^ The 'SetCookie' we are encountering
                   -> Req.Request    -- ^ The request that originated the response that yielded the 'SetCookie'
                   -> UTCTime        -- ^ Value that should be used as \"now\"
                   -> Bool           -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that)
                   -> Maybe Cookie   -- ^ The optional output cookie
    generateCookie :: SetCookie -> Request -> UTCTime -> Bool -> Maybe Cookie
    generateCookie SetCookie
    set_cookie Request
    request UTCTime
    now Bool
    is_http_api = do
              domain_sanitized <- ByteString -> Maybe ByteString
    sanitizeDomain (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Maybe ByteString -> ByteString
    step4 (SetCookie -> Maybe ByteString
    setCookieDomain SetCookie
    set_cookie)
              domain_intermediate <- step5 domain_sanitized
              (domain_final, host_only') <- step6 domain_intermediate
              http_only' <- step10
              return $ Cookie { cookie_name = setCookieName set_cookie
                              , cookie_value = setCookieValue set_cookie
                              , cookie_expiry_time = getExpiryTime (setCookieExpires set_cookie) (setCookieMaxAge set_cookie)
                              , cookie_domain = domain_final
                              , cookie_path = getPath $ setCookiePath set_cookie
                              , cookie_creation_time = now
                              , cookie_last_access_time = now
                              , cookie_persistent = getPersistent
                              , cookie_host_only = host_only'
                              , cookie_secure_only = setCookieSecure set_cookie
                              , cookie_http_only = http_only'
                              }
      where sanitizeDomain :: ByteString -> Maybe ByteString
    sanitizeDomain ByteString
    domain'
              | Bool
    has_a_character Bool -> Bool -> Bool
    && Word8 -> ByteString
    BS.singleton (HasCallStack => ByteString -> Word8
    ByteString -> Word8
    BS.last ByteString
    domain') ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "." = Maybe ByteString
    forall a. Maybe a
    Nothing
              | Bool
    has_a_character Bool -> Bool -> Bool
    && Word8 -> ByteString
    BS.singleton (HasCallStack => ByteString -> Word8
    ByteString -> Word8
    BS.head ByteString
    domain') ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "." = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => ByteString -> ByteString
    ByteString -> ByteString
    BS.tail ByteString
    domain'
              | Bool
    otherwise = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    domain'
              where has_a_character :: Bool
    has_a_character = Bool -> Bool
    not (ByteString -> Bool
    BS.null ByteString
    domain')
            step4 :: Maybe ByteString -> ByteString
    step4 (Just ByteString
    set_cookie_domain) = ByteString
    set_cookie_domain
            step4 Maybe ByteString
    Nothing = ByteString
    BS.empty
            step5 :: ByteString -> Maybe ByteString
    step5 ByteString
    domain'
              | Bool
    firstCondition Bool -> Bool -> Bool
    && ByteString
    domain' ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Request -> ByteString
    Req.host Request
    request) = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    BS.empty
              | Bool
    firstCondition = Maybe ByteString
    forall a. Maybe a
    Nothing
              | Bool
    otherwise = ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    domain'
              where firstCondition :: Bool
    firstCondition = Bool
    rejectPublicSuffixes Bool -> Bool -> Bool
    && Bool
    has_a_character Bool -> Bool -> Bool
    && ByteString -> Bool
    isPublicSuffix ByteString
    domain'
                    has_a_character :: Bool
    has_a_character = Bool -> Bool
    not (ByteString -> Bool
    BS.null ByteString
    domain')
            step6 :: ByteString -> Maybe (ByteString, Bool)
    step6 ByteString
    domain'
              | Bool
    firstCondition Bool -> Bool -> Bool
    && Bool -> Bool
    not (ByteString -> ByteString -> Bool
    domainMatches (Request -> ByteString
    Req.host Request
    request) ByteString
    domain') = Maybe (ByteString, Bool)
    forall a. Maybe a
    Nothing
              | Bool
    firstCondition = (ByteString, Bool) -> Maybe (ByteString, Bool)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString
    domain', Bool
    False)
              | Bool
    otherwise = (ByteString, Bool) -> Maybe (ByteString, Bool)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Request -> ByteString
    Req.host Request
    request, Bool
    True)
              where firstCondition :: Bool
    firstCondition = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Bool
    BS.null ByteString
    domain'
            step10 :: Maybe Bool
    step10
              | Bool -> Bool
    not Bool
    is_http_api Bool -> Bool -> Bool
    && SetCookie -> Bool
    setCookieHttpOnly SetCookie
    set_cookie = Maybe Bool
    forall a. Maybe a
    Nothing
              | Bool
    otherwise = Bool -> Maybe Bool
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
    forall a b. (a -> b) -> a -> b
    $ SetCookie -> Bool
    setCookieHttpOnly SetCookie
    set_cookie
            getExpiryTime :: Maybe UTCTime -> Maybe DiffTime -> UTCTime
            getExpiryTime :: Maybe UTCTime -> Maybe DiffTime -> UTCTime
    getExpiryTime Maybe UTCTime
    _ (Just DiffTime
    t) = (Rational -> NominalDiffTime
    forall a. Fractional a => Rational -> a
    fromRational (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
    forall a b. (a -> b) -> a -> b
    $ DiffTime -> Rational
    forall a. Real a => a -> Rational
    toRational DiffTime
    t) NominalDiffTime -> UTCTime -> UTCTime
    `addUTCTime` UTCTime
    now
            getExpiryTime (Just UTCTime
    t) Maybe DiffTime
    Nothing = UTCTime
    t
            getExpiryTime Maybe UTCTime
    Nothing Maybe DiffTime
    Nothing = Day -> DiffTime -> UTCTime
    UTCTime (Integer
    365000 Integer -> Day -> Day
    `addDays` UTCTime -> Day
    utctDay UTCTime
    now) (Integer -> DiffTime
    secondsToDiffTime Integer
    0)
            getPath :: Maybe ByteString -> ByteString
    getPath (Just ByteString
    p) = ByteString
    p
            getPath Maybe ByteString
    Nothing = Request -> ByteString
    defaultPath Request
    request
            getPersistent :: Bool
    getPersistent = Maybe UTCTime -> Bool
    forall a. Maybe a -> Bool
    isJust (SetCookie -> Maybe UTCTime
    setCookieExpires SetCookie
    set_cookie) Bool -> Bool -> Bool
    || Maybe DiffTime -> Bool
    forall a. Maybe a -> Bool
    isJust (SetCookie -> Maybe DiffTime
    setCookieMaxAge SetCookie
    set_cookie)