    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Network.HTTP.Cookie
    -- Copyright   :  See LICENSE file
    -- License     :  BSD
    --
    -- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
    -- Stability   :  experimental
    -- Portability :  non-portable (not tested)
    --
    -- This module provides the data types and functions for working with HTTP cookies.
    -- Right now, it contains mostly functionality needed by 'Network.Browser'.
    --
    -----------------------------------------------------------------------------
    module Network.HTTP.Cookie
           ( Cookie(..)
           , cookieMatch          -- :: (String,String) -> Cookie -> Bool

              -- functions for translating cookies and headers.
           , cookiesToHeader      -- :: [Cookie] -> Header
           , processCookieHeaders -- :: String -> [Header] -> ([String], [Cookie])
           ) where

    import Network.HTTP.Headers

    import Data.Char
    import Data.List
    import Data.Maybe

    import Text.ParserCombinators.Parsec
       ( Parser, char, many, many1, satisfy, parse, option, try
       , (<|>), sepBy1
       )

    ------------------------------------------------------------------
    ----------------------- Cookie Stuff -----------------------------
    ------------------------------------------------------------------

    -- | @Cookie@ is the Haskell representation of HTTP cookie values.
    -- See its relevant specs for authoritative details.
    data Cookie
     = MkCookie
        { Cookie -> String
    ckDomain  :: String
        , Cookie -> String
    ckName    :: String
        , Cookie -> String
    ckValue   :: String
        , Cookie -> Maybe String
    ckPath    :: Maybe String
        , Cookie -> Maybe String
    ckComment :: Maybe String
        , Cookie -> Maybe String
    ckVersion :: Maybe String
        }
        deriving(Int -> Cookie -> ShowS
    [Cookie] -> ShowS
    Cookie -> String
    (Int -> Cookie -> ShowS)
    -> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Cookie -> ShowS
    showsPrec :: Int -> Cookie -> ShowS
    $cshow :: Cookie -> String
    show :: Cookie -> String
    $cshowList :: [Cookie] -> ShowS
    showList :: [Cookie] -> ShowS
    Show,ReadPrec [Cookie]
    ReadPrec Cookie
    Int -> ReadS Cookie
    ReadS [Cookie]
    (Int -> ReadS Cookie)
    -> ReadS [Cookie]
    -> ReadPrec Cookie
    -> ReadPrec [Cookie]
    -> Read Cookie
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Cookie
    readsPrec :: Int -> ReadS Cookie
    $creadList :: ReadS [Cookie]
    readList :: ReadS [Cookie]
    $creadPrec :: ReadPrec Cookie
    readPrec :: ReadPrec Cookie
    $creadListPrec :: ReadPrec [Cookie]
    readListPrec :: ReadPrec [Cookie]
    Read)

    instance Eq Cookie where
        Cookie
    a == :: Cookie -> Cookie -> Bool
    == Cookie
    b  =  Cookie -> String
    ckDomain Cookie
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Cookie -> String
    ckDomain Cookie
    b
                Bool -> Bool -> Bool
    && Cookie -> String
    ckName Cookie
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Cookie -> String
    ckName Cookie
    b
                Bool -> Bool -> Bool
    && Cookie -> Maybe String
    ckPath Cookie
    a Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Cookie -> Maybe String
    ckPath Cookie
    b

    -- | @cookieToHeaders ck@ serialises @Cookie@s to an HTTP request header.
    cookiesToHeader :: [Cookie] -> Header
    cookiesToHeader :: [Cookie] -> Header
    cookiesToHeader [Cookie]
    cs = HeaderName -> String -> Header
    Header HeaderName
    HdrCookie ([Cookie] -> String
    mkCookieHeaderValue [Cookie]
    cs)

    -- | Turn a list of cookies into a key=value pair list, separated by
    -- semicolons.
    mkCookieHeaderValue :: [Cookie] -> String
    mkCookieHeaderValue :: [Cookie] -> String
    mkCookieHeaderValue = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "; " ([String] -> String)
    -> ([Cookie] -> [String]) -> [Cookie] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Cookie -> String) -> [Cookie] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Cookie -> String
    mkCookieHeaderValue1
      where
        mkCookieHeaderValue1 :: Cookie -> String
    mkCookieHeaderValue1 Cookie
    c = Cookie -> String
    ckName Cookie
    c String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Cookie -> String
    ckValue Cookie
    c

    -- | @cookieMatch (domain,path) ck@ performs the standard cookie
    -- match wrt the given domain and path.
    cookieMatch :: (String, String) -> Cookie -> Bool
    cookieMatch :: (String, String) -> Cookie -> Bool
    cookieMatch (String
    dom,String
    path) Cookie
    ck =
     Cookie -> String
    ckDomain Cookie
    ck String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    dom Bool -> Bool -> Bool
    &&
     case Cookie -> Maybe String
    ckPath Cookie
    ck of
       Maybe String
    Nothing -> Bool
    True
       Just String
    p  -> String
    p String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    path

    -- | @processCookieHeaders dom hdrs@
    processCookieHeaders :: String -> [Header] -> ([String], [Cookie])
    processCookieHeaders :: String -> [Header] -> ([String], [Cookie])
    processCookieHeaders String
    dom [Header]
    hdrs = (Header -> ([String], [Cookie]) -> ([String], [Cookie]))
    -> ([String], [Cookie]) -> [Header] -> ([String], [Cookie])
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (String -> Header -> ([String], [Cookie]) -> ([String], [Cookie])
    headerToCookies String
    dom) ([],[]) [Header]
    hdrs

    -- | @headerToCookies dom hdr acc@
    headerToCookies :: String -> Header -> ([String], [Cookie]) -> ([String], [Cookie])
    headerToCookies :: String -> Header -> ([String], [Cookie]) -> ([String], [Cookie])
    headerToCookies String
    dom (Header HeaderName
    HdrSetCookie String
    val) ([String]
    accErr, [Cookie]
    accCookie) =
        case Parsec String () [Cookie]
    -> String -> String -> Either ParseError [Cookie]
    forall s t a.
    Stream s Identity t =>
    Parsec s () a -> String -> s -> Either ParseError a
    parse Parsec String () [Cookie]
    cookies String
    "" String
    val of
            Left{}  -> (String
    valString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    accErr, [Cookie]
    accCookie)
            Right [Cookie]
    x -> ([String]
    accErr, [Cookie]
    x [Cookie] -> [Cookie] -> [Cookie]
    forall a. [a] -> [a] -> [a]
    ++ [Cookie]
    accCookie)
      where
       cookies :: Parser [Cookie]
       cookies :: Parsec String () [Cookie]
    cookies = ParsecT String () Identity Cookie
    -> ParsecT String () Identity Char -> Parsec String () [Cookie]
    forall s (m :: * -> *) t u a sep.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
    sepBy1 ParsecT String () Identity Cookie
    cookie (Char -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ',')

       cookie :: Parser Cookie
       cookie :: ParsecT String () Identity Cookie
    cookie =
           do name <- Parser String
    word
              _    <- spaces_l
              _    <- char '='
              _    <- spaces_l
              val1 <- cvalue
              args <- cdetail
              return $ mkCookie name val1 args

       cvalue :: Parser String

       spaces_l :: ParsecT String u Identity String
    spaces_l = ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ((Char -> Bool) -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy Char -> Bool
    isSpace)

       cvalue :: Parser String
    cvalue = Parser String
    quotedstring Parser String -> Parser String -> Parser String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> ParsecT String () Identity Char -> Parser String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 ((Char -> Bool) -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy ((Char -> Bool) -> ParsecT String () Identity Char)
    -> (Char -> Bool) -> ParsecT String () Identity Char
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ';')) Parser String -> Parser String -> Parser String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> String -> Parser String
    forall a. a -> ParsecT String () Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""

       -- all keys in the result list MUST be in lower case
       cdetail :: Parser [(String,String)]
       cdetail :: Parser [(String, String)]
    cdetail = ParsecT String () Identity (String, String)
    -> Parser [(String, String)]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many (ParsecT String () Identity (String, String)
     -> Parser [(String, String)])
    -> ParsecT String () Identity (String, String)
    -> Parser [(String, String)]
    forall a b. (a -> b) -> a -> b
    $
           ParsecT String () Identity (String, String)
    -> ParsecT String () Identity (String, String)
    forall tok st a. GenParser tok st a -> GenParser tok st a
    try (do _  <- Parser String
    forall {u}. ParsecT String u Identity String
    spaces_l
                   _  <- char ';'
                   _  <- spaces_l
                   s1 <- word
                   _  <- spaces_l
                   s2 <- option "" (char '=' >> spaces_l >> cvalue)
                   return (map toLower s1,s2)
               )

       mkCookie :: String -> String -> [(String,String)] -> Cookie
       mkCookie :: String -> String -> [(String, String)] -> Cookie
    mkCookie String
    nm String
    cval [(String, String)]
    more =
              MkCookie { ckName :: String
    ckName    = String
    nm
                       , ckValue :: String
    ckValue   = String
    cval
                       , ckDomain :: String
    ckDomain  = (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    dom (String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "domain" [(String, String)]
    more))
                       , ckPath :: Maybe String
    ckPath    = String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "path" [(String, String)]
    more
                       , ckVersion :: Maybe String
    ckVersion = String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "version" [(String, String)]
    more
                       , ckComment :: Maybe String
    ckComment = String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "comment" [(String, String)]
    more
                       }
    headerToCookies String
    _ Header
    _ ([String], [Cookie])
    acc = ([String], [Cookie])
    acc

    word, quotedstring :: Parser String
    quotedstring :: Parser String
    quotedstring =
        do _   <- Char -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '"'  -- "
           str <- many (satisfy $ not . (=='"'))
           _   <- char '"'
           return str

    word :: Parser String
    word = ParsecT String () Identity Char -> Parser String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 ((Char -> Bool) -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy (\Char
    x -> Char -> Bool
    isAlphaNum Char
    x Bool -> Bool -> Bool
    || Char
    xChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '_' Bool -> Bool -> Bool
    || Char
    xChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '.' Bool -> Bool -> Bool
    || Char
    xChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '-' Bool -> Bool -> Bool
    || Char
    xChar -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ':'))