    --
    -- HTTP types for use with io-streams and pipes
    --
    -- Copyright © 2012-2014 Operational Dynamics Consulting, Pty Ltd
    --
    -- The code in this file, and the program it is a part of, is
    -- made available to you by its authors as open source software:
    -- you can redistribute it and/or modify it under the terms of
    -- the BSD licence.
    --
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# OPTIONS_HADDOCK hide, prune #-}

    --

    {- | If you're not http-streams or pipes-http and you're importing this,
     you're Doing It Wrong.
    -}
    module Network.Http.Internal (
        Hostname,
        Port,
        ContentType,
        FieldName,
        Request (..),
        EntityBody (..),
        ExpectMode (..),
        Boundary,
        unBoundary,
        emptyBoundary,
        randomBoundary,
        packBoundary,
        Response (..),
        StatusCode,
        TransferEncoding (..),
        ContentEncoding (..),
        getStatusCode,
        getStatusMessage,
        getHeader,
        Method (..),
        Headers,
        emptyHeaders,
        updateHeader,
        removeHeader,
        buildHeaders,
        lookupHeader,
        retrieveHeaders,
        HttpType (getHeaders),
        HttpParseException (..),
        composeMultipartBytes,
        composeMultipartEnding,
        -- for testing
        composeRequestBytes,
        composeResponseBytes,
    ) where

    import Prelude hiding (lookup)

    import Blaze.ByteString.Builder (Builder)
    import qualified Blaze.ByteString.Builder as Builder (
        copyByteString,
        fromByteString,
        toByteString,
     )
    import qualified Blaze.ByteString.Builder.Char8 as Builder (
        fromChar,
        fromShow,
        fromString,
     )
    import Control.Exception (Exception)
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Char8 as S
    import Data.CaseInsensitive (CI, mk, original)
    import Data.Char (chr)
    import Data.HashMap.Strict (
        HashMap,
        delete,
        empty,
        foldrWithKey,
        insert,
        insertWith,
        lookup,
        toList,
     )
    import Data.Int (Int64)
    import Data.List (foldl')
    import Data.Typeable (Typeable)
    import Data.Word (Word16)
    import System.Random (newStdGen, randomRs)

    type Hostname = ByteString

    type Port = Word16

    type ContentType = ByteString

    type FieldName = ByteString

    -- | HTTP Methods, as per RFC 2616
    data Method
        = GET
        | HEAD
        | POST
        | PUT
        | DELETE
        | TRACE
        | OPTIONS
        | CONNECT
        | PATCH
        | Method ByteString
        deriving (Int -> Method -> ShowS
    [Method] -> ShowS
    Method -> String
    (Int -> Method -> ShowS)
    -> (Method -> String) -> ([Method] -> ShowS) -> Show Method
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Method -> ShowS
    showsPrec :: Int -> Method -> ShowS
    $cshow :: Method -> String
    show :: Method -> String
    $cshowList :: [Method] -> ShowS
    showList :: [Method] -> ShowS
    Show, ReadPrec [Method]
    ReadPrec Method
    Int -> ReadS Method
    ReadS [Method]
    (Int -> ReadS Method)
    -> ReadS [Method]
    -> ReadPrec Method
    -> ReadPrec [Method]
    -> Read Method
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Method
    readsPrec :: Int -> ReadS Method
    $creadList :: ReadS [Method]
    readList :: ReadS [Method]
    $creadPrec :: ReadPrec Method
    readPrec :: ReadPrec Method
    $creadListPrec :: ReadPrec [Method]
    readListPrec :: ReadPrec [Method]
    Read, Eq Method
    Eq Method =>
    (Method -> Method -> Ordering)
    -> (Method -> Method -> Bool)
    -> (Method -> Method -> Bool)
    -> (Method -> Method -> Bool)
    -> (Method -> Method -> Bool)
    -> (Method -> Method -> Method)
    -> (Method -> Method -> Method)
    -> Ord Method
    Method -> Method -> Bool
    Method -> Method -> Ordering
    Method -> Method -> Method
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Method -> Method -> Ordering
    compare :: Method -> Method -> Ordering
    $c< :: Method -> Method -> Bool
    < :: Method -> Method -> Bool
    $c<= :: Method -> Method -> Bool
    <= :: Method -> Method -> Bool
    $c> :: Method -> Method -> Bool
    > :: Method -> Method -> Bool
    $c>= :: Method -> Method -> Bool
    >= :: Method -> Method -> Bool
    $cmax :: Method -> Method -> Method
    max :: Method -> Method -> Method
    $cmin :: Method -> Method -> Method
    min :: Method -> Method -> Method
    Ord)

    instance Eq Method where
        Method
    GET == :: Method -> Method -> Bool
    == Method
    GET = Bool
    True
        Method
    HEAD == Method
    HEAD = Bool
    True
        Method
    POST == Method
    POST = Bool
    True
        Method
    PUT == Method
    PUT = Bool
    True
        Method
    DELETE == Method
    DELETE = Bool
    True
        Method
    TRACE == Method
    TRACE = Bool
    True
        Method
    OPTIONS == Method
    OPTIONS = Bool
    True
        Method
    CONNECT == Method
    CONNECT = Bool
    True
        Method
    PATCH == Method
    PATCH = Bool
    True
        Method
    GET == Method ByteString
    "GET" = Bool
    True
        Method
    HEAD == Method ByteString
    "HEAD" = Bool
    True
        Method
    POST == Method ByteString
    "POST" = Bool
    True
        Method
    PUT == Method ByteString
    "PUT" = Bool
    True
        Method
    DELETE == Method ByteString
    "DELETE" = Bool
    True
        Method
    TRACE == Method ByteString
    "TRACE" = Bool
    True
        Method
    OPTIONS == Method ByteString
    "OPTIONS" = Bool
    True
        Method
    CONNECT == Method ByteString
    "CONNECT" = Bool
    True
        Method
    PATCH == Method ByteString
    "PATCH" = Bool
    True
        Method ByteString
    a == Method ByteString
    b = ByteString
    a ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    b
        m :: Method
    m@(Method ByteString
    _) == Method
    other = Method
    other Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    == Method
    m
        Method
    _ == Method
    _ = Bool
    False

    --

    {- |
    A description of the request that will be sent to the server. Note
    unlike other HTTP libraries, the request body is /not/ a part of this
    object; that will be streamed out by you when actually sending the
    request with 'sendRequest'.

    'Request' has a useful @Show@ instance that will output the request
    line and headers (as it will be sent over the wire but with the @\\r@
    characters stripped) which can be handy for debugging.

    Note that the actual @Host:@ header is not set until the request is sent,
    so you will not see it in the Show instance (unless you call 'setHostname'
     to override the value inherited from the @Connection@).
    -}
    data Request = Request
        { Request -> Method
    qMethod :: !Method
        , Request -> Maybe ByteString
    qHost :: !(Maybe ByteString)
        , Request -> ByteString
    qPath :: !ByteString
        , Request -> EntityBody
    qBody :: !EntityBody
        , Request -> ExpectMode
    qExpect :: !ExpectMode
        , Request -> Headers
    qHeaders :: !Headers
        , Request -> Boundary
    qBoundary :: !Boundary
        }
        deriving (Request -> Request -> Bool
    (Request -> Request -> Bool)
    -> (Request -> Request -> Bool) -> Eq Request
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Request -> Request -> Bool
    == :: Request -> Request -> Bool
    $c/= :: Request -> Request -> Bool
    /= :: Request -> Request -> Bool
    Eq)

    instance Show Request where
        show :: Request -> String
    show Request
    q =
            {-# SCC "Request.show" #-}
            ByteString -> String
    S.unpack (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ByteString -> ByteString
    S.filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r') (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> ByteString
    Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Request -> ByteString -> Builder
    composeRequestBytes Request
    q ByteString
    "<to be determined>"

    data EntityBody = Empty | Chunking | Static Int64 deriving (Int -> EntityBody -> ShowS
    [EntityBody] -> ShowS
    EntityBody -> String
    (Int -> EntityBody -> ShowS)
    -> (EntityBody -> String)
    -> ([EntityBody] -> ShowS)
    -> Show EntityBody
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> EntityBody -> ShowS
    showsPrec :: Int -> EntityBody -> ShowS
    $cshow :: EntityBody -> String
    show :: EntityBody -> String
    $cshowList :: [EntityBody] -> ShowS
    showList :: [EntityBody] -> ShowS
    Show, EntityBody -> EntityBody -> Bool
    (EntityBody -> EntityBody -> Bool)
    -> (EntityBody -> EntityBody -> Bool) -> Eq EntityBody
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: EntityBody -> EntityBody -> Bool
    == :: EntityBody -> EntityBody -> Bool
    $c/= :: EntityBody -> EntityBody -> Bool
    /= :: EntityBody -> EntityBody -> Bool
    Eq, Eq EntityBody
    Eq EntityBody =>
    (EntityBody -> EntityBody -> Ordering)
    -> (EntityBody -> EntityBody -> Bool)
    -> (EntityBody -> EntityBody -> Bool)
    -> (EntityBody -> EntityBody -> Bool)
    -> (EntityBody -> EntityBody -> Bool)
    -> (EntityBody -> EntityBody -> EntityBody)
    -> (EntityBody -> EntityBody -> EntityBody)
    -> Ord EntityBody
    EntityBody -> EntityBody -> Bool
    EntityBody -> EntityBody -> Ordering
    EntityBody -> EntityBody -> EntityBody
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: EntityBody -> EntityBody -> Ordering
    compare :: EntityBody -> EntityBody -> Ordering
    $c< :: EntityBody -> EntityBody -> Bool
    < :: EntityBody -> EntityBody -> Bool
    $c<= :: EntityBody -> EntityBody -> Bool
    <= :: EntityBody -> EntityBody -> Bool
    $c> :: EntityBody -> EntityBody -> Bool
    > :: EntityBody -> EntityBody -> Bool
    $c>= :: EntityBody -> EntityBody -> Bool
    >= :: EntityBody -> EntityBody -> Bool
    $cmax :: EntityBody -> EntityBody -> EntityBody
    max :: EntityBody -> EntityBody -> EntityBody
    $cmin :: EntityBody -> EntityBody -> EntityBody
    min :: EntityBody -> EntityBody -> EntityBody
    Ord)

    data ExpectMode = Normal | Continue deriving (Int -> ExpectMode -> ShowS
    [ExpectMode] -> ShowS
    ExpectMode -> String
    (Int -> ExpectMode -> ShowS)
    -> (ExpectMode -> String)
    -> ([ExpectMode] -> ShowS)
    -> Show ExpectMode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ExpectMode -> ShowS
    showsPrec :: Int -> ExpectMode -> ShowS
    $cshow :: ExpectMode -> String
    show :: ExpectMode -> String
    $cshowList :: [ExpectMode] -> ShowS
    showList :: [ExpectMode] -> ShowS
    Show, ExpectMode -> ExpectMode -> Bool
    (ExpectMode -> ExpectMode -> Bool)
    -> (ExpectMode -> ExpectMode -> Bool) -> Eq ExpectMode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ExpectMode -> ExpectMode -> Bool
    == :: ExpectMode -> ExpectMode -> Bool
    $c/= :: ExpectMode -> ExpectMode -> Bool
    /= :: ExpectMode -> ExpectMode -> Bool
    Eq, Eq ExpectMode
    Eq ExpectMode =>
    (ExpectMode -> ExpectMode -> Ordering)
    -> (ExpectMode -> ExpectMode -> Bool)
    -> (ExpectMode -> ExpectMode -> Bool)
    -> (ExpectMode -> ExpectMode -> Bool)
    -> (ExpectMode -> ExpectMode -> Bool)
    -> (ExpectMode -> ExpectMode -> ExpectMode)
    -> (ExpectMode -> ExpectMode -> ExpectMode)
    -> Ord ExpectMode
    ExpectMode -> ExpectMode -> Bool
    ExpectMode -> ExpectMode -> Ordering
    ExpectMode -> ExpectMode -> ExpectMode
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ExpectMode -> ExpectMode -> Ordering
    compare :: ExpectMode -> ExpectMode -> Ordering
    $c< :: ExpectMode -> ExpectMode -> Bool
    < :: ExpectMode -> ExpectMode -> Bool
    $c<= :: ExpectMode -> ExpectMode -> Bool
    <= :: ExpectMode -> ExpectMode -> Bool
    $c> :: ExpectMode -> ExpectMode -> Bool
    > :: ExpectMode -> ExpectMode -> Bool
    $c>= :: ExpectMode -> ExpectMode -> Bool
    >= :: ExpectMode -> ExpectMode -> Bool
    $cmax :: ExpectMode -> ExpectMode -> ExpectMode
    max :: ExpectMode -> ExpectMode -> ExpectMode
    $cmin :: ExpectMode -> ExpectMode -> ExpectMode
    min :: ExpectMode -> ExpectMode -> ExpectMode
    Ord)

    newtype Boundary = Boundary ByteString deriving (Int -> Boundary -> ShowS
    [Boundary] -> ShowS
    Boundary -> String
    (Int -> Boundary -> ShowS)
    -> (Boundary -> String) -> ([Boundary] -> ShowS) -> Show Boundary
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Boundary -> ShowS
    showsPrec :: Int -> Boundary -> ShowS
    $cshow :: Boundary -> String
    show :: Boundary -> String
    $cshowList :: [Boundary] -> ShowS
    showList :: [Boundary] -> ShowS
    Show, Boundary -> Boundary -> Bool
    (Boundary -> Boundary -> Bool)
    -> (Boundary -> Boundary -> Bool) -> Eq Boundary
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Boundary -> Boundary -> Bool
    == :: Boundary -> Boundary -> Bool
    $c/= :: Boundary -> Boundary -> Bool
    /= :: Boundary -> Boundary -> Bool
    Eq)

    unBoundary :: Boundary -> ByteString
    unBoundary :: Boundary -> ByteString
    unBoundary (Boundary ByteString
    b') = ByteString
    b'

    emptyBoundary :: Boundary
    emptyBoundary :: Boundary
    emptyBoundary = ByteString -> Boundary
    Boundary ByteString
    S.empty

    represent :: Int -> Char
    represent :: Int -> Char
    represent Int
    x
        | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10 = Int -> Char
    chr (Int
    48 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x)
        | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    36 = Int -> Char
    chr (Int
    65 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    10)
        | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    62 = Int -> Char
    chr (Int
    97 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    36)
        | Bool
    otherwise = Char
    '@'

    {- |
    Generate a random string to be used as an inter-part boundary in RFC 7578
    multipart form data. You pass this value to
    'Network.Http.Client.setContentMultipart' and subsequently to
    'Network.Http.Client.multipartFormBody'.
    -}
    randomBoundary :: IO Boundary
    randomBoundary :: IO Boundary
    randomBoundary = do
        gen <- IO StdGen
    forall (m :: * -> *). MonadIO m => m StdGen
    newStdGen
        let result = String -> ByteString
    S.pack (String -> ByteString)
    -> (StdGen -> String) -> StdGen -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Char) -> [Int] -> String
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> Char
    represent ([Int] -> String) -> (StdGen -> [Int]) -> StdGen -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take Int
    20 ([Int] -> [Int]) -> (StdGen -> [Int]) -> StdGen -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Int) -> StdGen -> [Int]
    forall g. RandomGen g => (Int, Int) -> g -> [Int]
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
    randomRs (Int
    0, Int
    61) (StdGen -> ByteString) -> StdGen -> ByteString
    forall a b. (a -> b) -> a -> b
    $ StdGen
    gen
        pure (Boundary result)

    {- |
    If you want to fix the multipart boundary to a known value (for testing
    purposes) you can use this. The ideal such string, in case you are wondering,
    is @\"bEacHV0113YB\@ll\"@.

    This isn't safe for use in production; you need to use an unpredictable value
    as the boundary separtor so prefer 'randomBoundary'.
    -}
    packBoundary :: String -> Boundary
    packBoundary :: String -> Boundary
    packBoundary = ByteString -> Boundary
    Boundary (ByteString -> Boundary)
    -> (String -> ByteString) -> String -> Boundary
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    S.pack

    {-
        The bit that builds up the actual string to be transmitted. This
        is on the critical path for every request, so we'll want to revisit
        this to improve performance.

        - Rewrite rule for Method?
        - How can serializing the Headers be made efficient?

        This code includes the RFC compliant CR-LF sequences as line
        terminators, which is why the Show instance above has to bother
        with removing them.
    -}

    composeRequestBytes :: Request -> ByteString -> Builder
    composeRequestBytes :: Request -> ByteString -> Builder
    composeRequestBytes Request
    q ByteString
    h' =
        [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
            [ Builder
    requestline
            , Builder
    hostLine
            , Builder
    headerFields
            , Builder
    crlf
            ]
      where
        requestline :: Builder
    requestline =
            [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
                [ Builder
    method
                , Builder
    sp
                , Builder
    uri
                , Builder
    sp
                , Builder
    version
                , Builder
    crlf
                ]

        method :: Builder
    method = case Request -> Method
    qMethod Request
    q of
            Method
    GET -> String -> Builder
    Builder.fromString String
    "GET"
            Method
    HEAD -> String -> Builder
    Builder.fromString String
    "HEAD"
            Method
    POST -> String -> Builder
    Builder.fromString String
    "POST"
            Method
    PUT -> String -> Builder
    Builder.fromString String
    "PUT"
            Method
    DELETE -> String -> Builder
    Builder.fromString String
    "DELETE"
            Method
    TRACE -> String -> Builder
    Builder.fromString String
    "TRACE"
            Method
    OPTIONS -> String -> Builder
    Builder.fromString String
    "OPTIONS"
            Method
    CONNECT -> String -> Builder
    Builder.fromString String
    "CONNECT"
            Method
    PATCH -> String -> Builder
    Builder.fromString String
    "PATCH"
            (Method ByteString
    x) -> ByteString -> Builder
    Builder.fromByteString ByteString
    x

        uri :: Builder
    uri = case Request -> ByteString
    qPath Request
    q of
            ByteString
    "" -> Char -> Builder
    Builder.fromChar Char
    '/'
            ByteString
    path -> ByteString -> Builder
    Builder.copyByteString ByteString
    path

        version :: Builder
    version = String -> Builder
    Builder.fromString String
    "HTTP/1.1"

        hostLine :: Builder
    hostLine =
            [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
                [ String -> Builder
    Builder.fromString String
    "Host: "
                , Builder
    hostname
                , Builder
    crlf
                ]

        hostname :: Builder
    hostname = case Request -> Maybe ByteString
    qHost Request
    q of
            Just ByteString
    x' -> ByteString -> Builder
    Builder.copyByteString ByteString
    x'
            Maybe ByteString
    Nothing -> ByteString -> Builder
    Builder.copyByteString ByteString
    h'

        headerFields :: Builder
    headerFields = HashMap (CI ByteString) ByteString -> Builder
    joinHeaders (HashMap (CI ByteString) ByteString -> Builder)
    -> HashMap (CI ByteString) ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ Headers -> HashMap (CI ByteString) ByteString
    unWrap (Headers -> HashMap (CI ByteString) ByteString)
    -> Headers -> HashMap (CI ByteString) ByteString
    forall a b. (a -> b) -> a -> b
    $ Request -> Headers
    qHeaders Request
    q

    crlf :: Builder
    crlf = String -> Builder
    Builder.fromString String
    "\r\n"

    sp :: Builder
    sp = Char -> Builder
    Builder.fromChar Char
    ' '

    dashdash :: Builder
    dashdash = String -> Builder
    Builder.fromString String
    "--"

    composeMultipartBytes :: Boundary -> FieldName -> Maybe FilePath -> Maybe ContentType -> Builder
    composeMultipartBytes :: Boundary
    -> ByteString -> Maybe String -> Maybe ByteString -> Builder
    composeMultipartBytes Boundary
    boundary ByteString
    name Maybe String
    possibleFilename Maybe ByteString
    possibleContentType =
        [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
            [ Builder
    boundaryLine
            , Builder
    dispositionLine
            , Builder
    mimetypeLine
            , Builder
    crlf -- second CR LF
            ]
      where
        boundaryLine :: Builder
    boundaryLine =
            Builder
    crlf
                Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    dashdash
                Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    Builder.copyByteString (Boundary -> ByteString
    unBoundary Boundary
    boundary)
                Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    crlf
        dispositionLine :: Builder
    dispositionLine =
            Builder
    "Content-Disposition: form-data; name=\""
                Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    Builder.copyByteString ByteString
    name
                Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    "\""
                Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> case Maybe String
    possibleFilename of
                    Just String
    filename ->
                        Builder
    "; filename=\""
                            Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Builder
    Builder.fromString String
    filename
                            Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    "\""
                    Maybe String
    Nothing -> Builder
    forall a. Monoid a => a
    mempty
                Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    crlf
        mimetypeLine :: Builder
    mimetypeLine =
            case Maybe ByteString
    possibleContentType of
                Just ByteString
    mimetype ->
                    Builder
    "Content-Type: " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    Builder.copyByteString ByteString
    mimetype
                        Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    crlf
                Maybe ByteString
    Nothing -> Builder
    forall a. Monoid a => a
    mempty

    composeMultipartEnding :: Boundary -> Builder
    composeMultipartEnding :: Boundary -> Builder
    composeMultipartEnding Boundary
    boundary =
        Builder
    crlf
            Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    dashdash
            Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    Builder.copyByteString (Boundary -> ByteString
    unBoundary Boundary
    boundary)
            Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    dashdash
            Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    crlf

    type StatusCode = Int

    {- |
    A description of the response received from the server. Note
    unlike other HTTP libraries, the response body is /not/ a part
    of this object; that will be streamed in by you when calling
    'receiveResponse'.

    Like 'Request', 'Response' has a @Show@ instance that will output
    the status line and response headers as they were received from the
    server.
    -}
    data Response = Response
        { Response -> Int
    pStatusCode :: !StatusCode
        , Response -> ByteString
    pStatusMsg :: !ByteString
        , Response -> TransferEncoding
    pTransferEncoding :: !TransferEncoding
        , Response -> ContentEncoding
    pContentEncoding :: !ContentEncoding
        , Response -> Maybe Int64
    pContentLength :: !(Maybe Int64)
        , Response -> Headers
    pHeaders :: !Headers
        }

    instance Show Response where
        show :: Response -> String
    show Response
    p =
            {-# SCC "Response.show" #-}
            ByteString -> String
    S.unpack (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ByteString -> ByteString
    S.filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r') (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> ByteString
    Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Response -> Builder
    composeResponseBytes Response
    p

    data TransferEncoding = None | Chunked

    data ContentEncoding = Identity | Gzip | Deflate
        deriving (Int -> ContentEncoding -> ShowS
    [ContentEncoding] -> ShowS
    ContentEncoding -> String
    (Int -> ContentEncoding -> ShowS)
    -> (ContentEncoding -> String)
    -> ([ContentEncoding] -> ShowS)
    -> Show ContentEncoding
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ContentEncoding -> ShowS
    showsPrec :: Int -> ContentEncoding -> ShowS
    $cshow :: ContentEncoding -> String
    show :: ContentEncoding -> String
    $cshowList :: [ContentEncoding] -> ShowS
    showList :: [ContentEncoding] -> ShowS
    Show)

    -- | Get the HTTP response status code.
    getStatusCode :: Response -> StatusCode
    getStatusCode :: Response -> Int
    getStatusCode = Response -> Int
    pStatusCode
    {-# INLINE getStatusCode #-}

    {- |
    Get the HTTP response status message. Keep in mind that this is
    /not/ normative; whereas 'getStatusCode' values are authoritative.
    -}
    getStatusMessage :: Response -> ByteString
    getStatusMessage :: Response -> ByteString
    getStatusMessage = Response -> ByteString
    pStatusMsg
    {-# INLINE getStatusMessage #-}

    {- |
    Lookup a header in the response. HTTP header field names are
    case-insensitive, so you can specify the name to lookup however you
    like. If the header is not present @Nothing@ will be returned.

    >     let n = case getHeader p "Content-Length" of
    >                Just x' -> read x' :: Int
    >                Nothing -> 0

    which of course is essentially what goes on inside the client library when
    it receives a response from the server and has to figure out how many bytes
    to read.

    There is a fair bit of complexity in some of the other HTTP response
    fields, so there are a number of specialized functions for reading
    those values where we've found them useful.
    -}
    getHeader :: Response -> ByteString -> Maybe ByteString
    getHeader :: Response -> ByteString -> Maybe ByteString
    getHeader Response
    p ByteString
    k =
        Headers -> ByteString -> Maybe ByteString
    lookupHeader Headers
    h ByteString
    k
      where
        h :: Headers
    h = Response -> Headers
    pHeaders Response
    p

    {- |
    Accessors common to both the outbound and return sides of an HTTP connection.

    Most people do not need this; for most cases you just need to get a header or
    two from the response, for which you can use 'getHeader'. On the other hand,
    if you do need to poke around in the raw headers,

    @
    import Network.Http.Types
    @

    will give you functions like 'lookupHeader' and 'updateHeader' to to work
    with.
    -}
    class HttpType τ where
        -- | Get the Headers from a Request or Response.y
        getHeaders :: τ -> Headers

    instance HttpType Request where
        getHeaders :: Request -> Headers
    getHeaders Request
    q = Request -> Headers
    qHeaders Request
    q

    instance HttpType Response where
        getHeaders :: Response -> Headers
    getHeaders Response
    p = Response -> Headers
    pHeaders Response
    p

    composeResponseBytes :: Response -> Builder
    composeResponseBytes :: Response -> Builder
    composeResponseBytes Response
    p =
        [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
            [ Builder
    statusline
            , Builder
    headerFields
            , Builder
    crlf
            ]
      where
        statusline :: Builder
    statusline =
            [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
                [ Builder
    version
                , Builder
    sp
                , Builder
    code
                , Builder
    sp
                , Builder
    message
                , Builder
    crlf
                ]

        code :: Builder
    code = Int -> Builder
    forall a. Show a => a -> Builder
    Builder.fromShow (Int -> Builder) -> Int -> Builder
    forall a b. (a -> b) -> a -> b
    $ Response -> Int
    pStatusCode Response
    p

        message :: Builder
    message = ByteString -> Builder
    Builder.copyByteString (ByteString -> Builder) -> ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ Response -> ByteString
    pStatusMsg Response
    p

        version :: Builder
    version = String -> Builder
    Builder.fromString String
    "HTTP/1.1"

        headerFields :: Builder
    headerFields = HashMap (CI ByteString) ByteString -> Builder
    joinHeaders (HashMap (CI ByteString) ByteString -> Builder)
    -> HashMap (CI ByteString) ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ Headers -> HashMap (CI ByteString) ByteString
    unWrap (Headers -> HashMap (CI ByteString) ByteString)
    -> Headers -> HashMap (CI ByteString) ByteString
    forall a b. (a -> b) -> a -> b
    $ Response -> Headers
    pHeaders Response
    p

    {- |
    The map of headers in a 'Request' or 'Response'. Note that HTTP
    header field names are case insensitive, so if you call 'setHeader'
    on a field that's already defined but with a different capitalization
    you will replace the existing value.
    -}

    {-
        This is a fair bit of trouble just to avoid using a typedef here.
        Probably worth it, though; every other HTTP client library out there
        exposes the gory details of the underlying map implementation, and
        to use it you need to figure out all kinds of crazy imports. Indeed,
        this code used here in the Show instance for debugging has been
        copied & pasted around various projects of mine since I started
        writing Haskell. It's quite tedious, and very arcane! So, wrap it
        up.
    -}
    newtype Headers = Wrap
        { Headers -> HashMap (CI ByteString) ByteString
    unWrap :: HashMap (CI ByteString) ByteString
        }
        deriving (Headers -> Headers -> Bool
    (Headers -> Headers -> Bool)
    -> (Headers -> Headers -> Bool) -> Eq Headers
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Headers -> Headers -> Bool
    == :: Headers -> Headers -> Bool
    $c/= :: Headers -> Headers -> Bool
    /= :: Headers -> Headers -> Bool
    Eq)

    instance Show Headers where
        show :: Headers -> String
    show Headers
    x = ByteString -> String
    S.unpack (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ByteString -> ByteString
    S.filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r') (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> ByteString
    Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $ HashMap (CI ByteString) ByteString -> Builder
    joinHeaders (HashMap (CI ByteString) ByteString -> Builder)
    -> HashMap (CI ByteString) ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ Headers -> HashMap (CI ByteString) ByteString
    unWrap Headers
    x

    joinHeaders :: HashMap (CI ByteString) ByteString -> Builder
    joinHeaders :: HashMap (CI ByteString) ByteString -> Builder
    joinHeaders HashMap (CI ByteString) ByteString
    m = (CI ByteString -> ByteString -> Builder -> Builder)
    -> Builder -> HashMap (CI ByteString) ByteString -> Builder
    forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
    foldrWithKey CI ByteString -> ByteString -> Builder -> Builder
    combine Builder
    forall a. Monoid a => a
    mempty HashMap (CI ByteString) ByteString
    m

    combine :: CI ByteString -> ByteString -> Builder -> Builder
    combine :: CI ByteString -> ByteString -> Builder -> Builder
    combine CI ByteString
    k ByteString
    v Builder
    acc =
        [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [Builder
    acc, Builder
    key, String -> Builder
    Builder.fromString String
    ": ", Builder
    value, Builder
    crlf]
      where
        key :: Builder
    key = ByteString -> Builder
    Builder.copyByteString (ByteString -> Builder) -> ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> ByteString
    forall s. CI s -> s
    original CI ByteString
    k
        value :: Builder
    value = ByteString -> Builder
    Builder.fromByteString ByteString
    v
    {-# INLINE combine #-}

    emptyHeaders :: Headers
    emptyHeaders :: Headers
    emptyHeaders =
        HashMap (CI ByteString) ByteString -> Headers
    Wrap HashMap (CI ByteString) ByteString
    forall k v. HashMap k v
    empty

    {- |
    Set a header field to the specified value. This will overwrite
    any existing value for the field. Remember that HTTP fields names
    are case insensitive!
    -}
    updateHeader :: Headers -> ByteString -> ByteString -> Headers
    updateHeader :: Headers -> ByteString -> ByteString -> Headers
    updateHeader Headers
    x ByteString
    k ByteString
    v =
        HashMap (CI ByteString) ByteString -> Headers
    Wrap HashMap (CI ByteString) ByteString
    result
      where
        !result :: HashMap (CI ByteString) ByteString
    result = CI ByteString
    -> ByteString
    -> HashMap (CI ByteString) ByteString
    -> HashMap (CI ByteString) ByteString
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    insert (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    mk ByteString
    k) ByteString
    v HashMap (CI ByteString) ByteString
    m
        !m :: HashMap (CI ByteString) ByteString
    m = Headers -> HashMap (CI ByteString) ByteString
    unWrap Headers
    x

    {- |
    Remove a header from the map. If a field with that name is not present,
    then this will have no effect.
    -}
    removeHeader :: Headers -> ByteString -> Headers
    removeHeader :: Headers -> ByteString -> Headers
    removeHeader Headers
    x ByteString
    k =
        HashMap (CI ByteString) ByteString -> Headers
    Wrap HashMap (CI ByteString) ByteString
    result
      where
        !result :: HashMap (CI ByteString) ByteString
    result = CI ByteString
    -> HashMap (CI ByteString) ByteString
    -> HashMap (CI ByteString) ByteString
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
    delete (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    mk ByteString
    k) HashMap (CI ByteString) ByteString
    m
        !m :: HashMap (CI ByteString) ByteString
    m = Headers -> HashMap (CI ByteString) ByteString
    unWrap Headers
    x

    -- | Given a list of field-name,field-value pairs, construct a Headers map.

    {-
        This is only going to be used by RequestBuilder and ResponseParser,
        obviously. And yes, as usual, we go to a lot of trouble to splice out the
        function doing the work, in the name of type sanity.
    -}
    buildHeaders :: [(ByteString, ByteString)] -> Headers
    buildHeaders :: [(ByteString, ByteString)] -> Headers
    buildHeaders [(ByteString, ByteString)]
    hs =
        HashMap (CI ByteString) ByteString -> Headers
    Wrap HashMap (CI ByteString) ByteString
    result
      where
        result :: HashMap (CI ByteString) ByteString
    result = (HashMap (CI ByteString) ByteString
     -> (ByteString, ByteString) -> HashMap (CI ByteString) ByteString)
    -> HashMap (CI ByteString) ByteString
    -> [(ByteString, ByteString)]
    -> HashMap (CI ByteString) ByteString
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' HashMap (CI ByteString) ByteString
    -> (ByteString, ByteString) -> HashMap (CI ByteString) ByteString
    addHeader HashMap (CI ByteString) ByteString
    forall k v. HashMap k v
    empty [(ByteString, ByteString)]
    hs

    {-
        insertWith is used here for the case where a header is repeated
        (for example, Set-Cookie) and the values need to be intercalated
        with ',' as per RFC 2616 §4.2.
    -}
    addHeader ::
        HashMap (CI ByteString) ByteString ->
        (ByteString, ByteString) ->
        HashMap (CI ByteString) ByteString
    addHeader :: HashMap (CI ByteString) ByteString
    -> (ByteString, ByteString) -> HashMap (CI ByteString) ByteString
    addHeader HashMap (CI ByteString) ByteString
    m (ByteString
    k, ByteString
    v) =
        (ByteString -> ByteString -> ByteString)
    -> CI ByteString
    -> ByteString
    -> HashMap (CI ByteString) ByteString
    -> HashMap (CI ByteString) ByteString
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
    insertWith ByteString -> ByteString -> ByteString
    f (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    mk ByteString
    k) ByteString
    v HashMap (CI ByteString) ByteString
    m
      where
        f :: ByteString -> ByteString -> ByteString
    f ByteString
    new ByteString
    old = [ByteString] -> ByteString
    S.concat [ByteString
    old, ByteString
    ",", ByteString
    new]

    lookupHeader :: Headers -> ByteString -> Maybe ByteString
    lookupHeader :: Headers -> ByteString -> Maybe ByteString
    lookupHeader Headers
    x ByteString
    k =
        CI ByteString
    -> HashMap (CI ByteString) ByteString -> Maybe ByteString
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    lookup (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    mk ByteString
    k) HashMap (CI ByteString) ByteString
    m
      where
        !m :: HashMap (CI ByteString) ByteString
    m = Headers -> HashMap (CI ByteString) ByteString
    unWrap Headers
    x

    -- | Get the headers as a field-name,field-value association list.
    retrieveHeaders :: Headers -> [(ByteString, ByteString)]
    retrieveHeaders :: Headers -> [(ByteString, ByteString)]
    retrieveHeaders Headers
    x =
        ((CI ByteString, ByteString) -> (ByteString, ByteString))
    -> [(CI ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (CI ByteString, ByteString) -> (ByteString, ByteString)
    down ([(CI ByteString, ByteString)] -> [(ByteString, ByteString)])
    -> [(CI ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ HashMap (CI ByteString) ByteString -> [(CI ByteString, ByteString)]
    forall k v. HashMap k v -> [(k, v)]
    toList HashMap (CI ByteString) ByteString
    m
      where
        !m :: HashMap (CI ByteString) ByteString
    m = Headers -> HashMap (CI ByteString) ByteString
    unWrap Headers
    x

    down :: (CI ByteString, ByteString) -> (ByteString, ByteString)
    down :: (CI ByteString, ByteString) -> (ByteString, ByteString)
    down (CI ByteString
    k, ByteString
    v) =
        (CI ByteString -> ByteString
    forall s. CI s -> s
    original CI ByteString
    k, ByteString
    v)

    data HttpParseException = HttpParseException String
        deriving (Typeable, Int -> HttpParseException -> ShowS
    [HttpParseException] -> ShowS
    HttpParseException -> String
    (Int -> HttpParseException -> ShowS)
    -> (HttpParseException -> String)
    -> ([HttpParseException] -> ShowS)
    -> Show HttpParseException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HttpParseException -> ShowS
    showsPrec :: Int -> HttpParseException -> ShowS
    $cshow :: HttpParseException -> String
    show :: HttpParseException -> String
    $cshowList :: [HttpParseException] -> ShowS
    showList :: [HttpParseException] -> ShowS
    Show)

    instance Exception HttpParseException