    --
    -- HTTP types for use with io-streams and pipes
    --
    -- Copyright © 2012-2014 Operational Dynamics Consulting, Pty Ltd and Others
    --
    -- 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 GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# OPTIONS_HADDOCK hide #-}

    module Network.Http.RequestBuilder (
        RequestBuilder,
        buildRequest,
        buildRequest1,
        http,
        setHostname,
        setAccept,
        setAccept',
        setAuthorizationBasic,
        setContentType,
        setContentLength,
        setExpectContinue,
        setTransferEncoding,
        setHeader,
        setContentMultipart
    ) where

    import Blaze.ByteString.Builder (Builder)
    import qualified Blaze.ByteString.Builder as Builder (fromByteString,
                                                          toByteString)
    import qualified Blaze.ByteString.Builder.Char8 as Builder (fromShow,
                                                                fromString)
    import Control.Monad.State
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Base64 as BS64
    import Data.ByteString.Char8 ()
    import qualified Data.ByteString.Char8 as S
    import Data.Int (Int64)
    import Data.List (intersperse)

    import Network.Http.Internal

    --
    -- | The RequestBuilder monad allows you to abuse do-notation to
    -- conveniently setup a 'Request' object.
    --
    newtype RequestBuilder α = RequestBuilder (State Request α)
      deriving ((forall a b. (a -> b) -> RequestBuilder a -> RequestBuilder b)
    -> (forall a b. a -> RequestBuilder b -> RequestBuilder a)
    -> Functor RequestBuilder
    forall a b. a -> RequestBuilder b -> RequestBuilder a
    forall a b. (a -> b) -> RequestBuilder a -> RequestBuilder b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> RequestBuilder a -> RequestBuilder b
    fmap :: forall a b. (a -> b) -> RequestBuilder a -> RequestBuilder b
    $c<$ :: forall a b. a -> RequestBuilder b -> RequestBuilder a
    <$ :: forall a b. a -> RequestBuilder b -> RequestBuilder a
    Functor, Functor RequestBuilder
    Functor RequestBuilder =>
    (forall a. a -> RequestBuilder a)
    -> (forall a b.
        RequestBuilder (a -> b) -> RequestBuilder a -> RequestBuilder b)
    -> (forall a b c.
        (a -> b -> c)
        -> RequestBuilder a -> RequestBuilder b -> RequestBuilder c)
    -> (forall a b.
        RequestBuilder a -> RequestBuilder b -> RequestBuilder b)
    -> (forall a b.
        RequestBuilder a -> RequestBuilder b -> RequestBuilder a)
    -> Applicative RequestBuilder
    forall a. a -> RequestBuilder a
    forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder a
    forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder b
    forall a b.
    RequestBuilder (a -> b) -> RequestBuilder a -> RequestBuilder b
    forall a b c.
    (a -> b -> c)
    -> RequestBuilder a -> RequestBuilder b -> RequestBuilder c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> RequestBuilder a
    pure :: forall a. a -> RequestBuilder a
    $c<*> :: forall a b.
    RequestBuilder (a -> b) -> RequestBuilder a -> RequestBuilder b
    <*> :: forall a b.
    RequestBuilder (a -> b) -> RequestBuilder a -> RequestBuilder b
    $cliftA2 :: forall a b c.
    (a -> b -> c)
    -> RequestBuilder a -> RequestBuilder b -> RequestBuilder c
    liftA2 :: forall a b c.
    (a -> b -> c)
    -> RequestBuilder a -> RequestBuilder b -> RequestBuilder c
    $c*> :: forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder b
    *> :: forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder b
    $c<* :: forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder a
    <* :: forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder a
    Applicative, Applicative RequestBuilder
    Applicative RequestBuilder =>
    (forall a b.
     RequestBuilder a -> (a -> RequestBuilder b) -> RequestBuilder b)
    -> (forall a b.
        RequestBuilder a -> RequestBuilder b -> RequestBuilder b)
    -> (forall a. a -> RequestBuilder a)
    -> Monad RequestBuilder
    forall a. a -> RequestBuilder a
    forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder b
    forall a b.
    RequestBuilder a -> (a -> RequestBuilder b) -> RequestBuilder b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b.
    RequestBuilder a -> (a -> RequestBuilder b) -> RequestBuilder b
    >>= :: forall a b.
    RequestBuilder a -> (a -> RequestBuilder b) -> RequestBuilder b
    $c>> :: forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder b
    >> :: forall a b.
    RequestBuilder a -> RequestBuilder b -> RequestBuilder b
    $creturn :: forall a. a -> RequestBuilder a
    return :: forall a. a -> RequestBuilder a
    Monad, MonadState Request)

    --
    -- | Run a RequestBuilder, yielding a Request object you can use on the
    -- given connection.
    --
    -- >     let q = buildRequest1 $ do
    -- >                 http POST "/api/v1/messages"
    -- >                 setContentType "application/json"
    -- >                 setHostname "clue.example.com" 80
    -- >                 setAccept "text/html"
    -- >                 setHeader "X-WhoDoneIt" "The Butler"
    --
    -- Obviously it's up to you to later actually /send/ JSON data.
    --
    buildRequest1 :: RequestBuilder α -> Request
    buildRequest1 :: forall α. RequestBuilder α -> Request
    buildRequest1 RequestBuilder α
    mm = do
        let (RequestBuilder State Request α
    s) = (RequestBuilder α
    mm)
        let q :: Request
    q = Request {
            qHost :: Maybe ByteString
    qHost = Maybe ByteString
    forall a. Maybe a
    Nothing,
            qMethod :: Method
    qMethod = Method
    GET,
            qPath :: ByteString
    qPath = ByteString
    "/",
            qBody :: EntityBody
    qBody = EntityBody
    Empty,
            qExpect :: ExpectMode
    qExpect = ExpectMode
    Normal,
            qHeaders :: Headers
    qHeaders = Headers
    emptyHeaders,
            qBoundary :: Boundary
    qBoundary = Boundary
    emptyBoundary
        }
        State Request α -> Request -> Request
    forall s a. State s a -> s -> s
    execState State Request α
    s Request
    q

    --
    -- | Run a RequestBuilder from within a monadic action.
    --
    -- Older versions of this library had 'buildRequest' in IO; there's
    -- no longer a need for that, but this code path will continue to
    -- work for existing users.
    --
    -- >     q <- buildRequest $ do
    -- >              http GET "/"
    --
    buildRequest :: Monad ν => RequestBuilder α -> ν Request
    buildRequest :: forall (ν :: * -> *) α. Monad ν => RequestBuilder α -> ν Request
    buildRequest = Request -> ν Request
    forall a. a -> ν a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Request -> ν Request)
    -> (RequestBuilder α -> Request) -> RequestBuilder α -> ν Request
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RequestBuilder α -> Request
    forall α. RequestBuilder α -> Request
    buildRequest1
    {-# INLINE buildRequest #-}

    --
    -- | Begin constructing a Request, starting with the request line.
    --
    http :: Method -> ByteString -> RequestBuilder ()
    http :: Method -> ByteString -> RequestBuilder ()
    http Method
    m ByteString
    p' = do
        q <- RequestBuilder Request
    forall s (m :: * -> *). MonadState s m => m s
    get
        let h1 = Request -> Headers
    qHeaders Request
    q
        let h2 = Headers -> ByteString -> ByteString -> Headers
    updateHeader Headers
    h1 ByteString
    "Accept-Encoding" ByteString
    "gzip"

        let e  = case Method
    m of
                Method
    PUT  -> EntityBody
    Chunking
                Method
    POST -> EntityBody
    Chunking
                Method
    _    -> EntityBody
    Empty

        let h3 = case EntityBody
    e of
                EntityBody
    Chunking    -> Headers -> ByteString -> ByteString -> Headers
    updateHeader Headers
    h2 ByteString
    "Transfer-Encoding" ByteString
    "chunked"
                EntityBody
    _           -> Headers
    h2

        put q {
            qMethod = m,
            qPath = p',
            qBody = e,
            qHeaders = h3
        }

    --
    -- | Set the [virtual] hostname for the request. In ordinary conditions
    -- you won't need to call this, as the @Host:@ header is a required
    -- header in HTTP 1.1 and is set directly from the name of the server
    -- you connected to when calling 'Network.Http.Connection.openConnection'.
    --
    setHostname :: Hostname -> Port -> RequestBuilder ()
    setHostname :: ByteString -> Port -> RequestBuilder ()
    setHostname ByteString
    h' Port
    p = do
        q <- RequestBuilder Request
    forall s (m :: * -> *). MonadState s m => m s
    get
        put q {
            qHost = Just v'
        }
      where
        v' :: ByteString
        v' :: ByteString
    v' = if Port
    p Port -> Port -> Bool
    forall a. Eq a => a -> a -> Bool
    == Port
    80
            then ByteString
    h'
            else Builder -> ByteString
    Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
               [ByteString -> Builder
    Builder.fromByteString ByteString
    h',
                String -> Builder
    Builder.fromString String
    ":",
                Port -> Builder
    forall a. Show a => a -> Builder
    Builder.fromShow Port
    p]

    --
    -- | Set a generic header to be sent in the HTTP request. The other
    -- methods in the RequestBuilder API are expressed in terms of this
    -- function, but we recommend you use them where offered for their
    -- stronger types.
    --
    setHeader :: ByteString -> ByteString -> RequestBuilder ()
    setHeader :: ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    k' ByteString
    v' = do
        q <- RequestBuilder Request
    forall s (m :: * -> *). MonadState s m => m s
    get
        let h0 = Request -> Headers
    qHeaders Request
    q
        let h1 = Headers -> ByteString -> ByteString -> Headers
    updateHeader Headers
    h0 ByteString
    k' ByteString
    v'
        put q {
            qHeaders = h1
        }

    deleteHeader :: ByteString -> RequestBuilder ()
    deleteHeader :: ByteString -> RequestBuilder ()
    deleteHeader ByteString
    k' = do
        q <- RequestBuilder Request
    forall s (m :: * -> *). MonadState s m => m s
    get
        let h0 = Request -> Headers
    qHeaders Request
    q
        let h1 = Headers -> ByteString -> Headers
    removeHeader Headers
    h0 ByteString
    k'
        put q {
            qHeaders = h1
        }

    {-# INLINE setEntityBody #-}
    setEntityBody :: EntityBody -> RequestBuilder ()
    setEntityBody :: EntityBody -> RequestBuilder ()
    setEntityBody EntityBody
    e = do
        q <- RequestBuilder Request
    forall s (m :: * -> *). MonadState s m => m s
    get
        put q {
            qBody = e
        }

    {-# INLINE setExpectMode #-}
    setExpectMode :: ExpectMode -> RequestBuilder ()
    setExpectMode :: ExpectMode -> RequestBuilder ()
    setExpectMode ExpectMode
    e = do
        q <- RequestBuilder Request
    forall s (m :: * -> *). MonadState s m => m s
    get
        put q {
            qExpect = e
        }

    --
    -- | Indicate the content type you are willing to receive in a reply
    -- from the server. For more complex @Accept:@ headers, use
    -- 'setAccept''.
    --
    setAccept :: ByteString -> RequestBuilder ()
    setAccept :: ByteString -> RequestBuilder ()
    setAccept ByteString
    v' = do
        ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Accept" ByteString
    v'

    --
    -- | Indicate the content types you are willing to receive in a reply
    -- from the server in order of preference. A call of the form:
    --
    -- >         setAccept' [("text/html", 1.0),
    -- >                     ("application/xml", 0.8),
    -- >                     ("*/*", 0)]
    --
    -- will result in an @Accept:@ header value of
    -- @text\/html; q=1.0, application\/xml; q=0.8, \*\/\*; q=0.0@ as you
    -- would expect.
    --
    setAccept' :: [(ByteString,Float)] -> RequestBuilder ()
    setAccept' :: [(ByteString, Float)] -> RequestBuilder ()
    setAccept' [(ByteString, Float)]
    tqs = do
        ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Accept" ByteString
    v'
      where
        v' :: ByteString
    v' = Builder -> ByteString
    Builder.toByteString Builder
    v
        v :: Builder
    v  = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Builder] -> Builder) -> [Builder] -> Builder
    forall a b. (a -> b) -> a -> b
    $ Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    intersperse (String -> Builder
    Builder.fromString String
    ", ") ([Builder] -> [Builder]) -> [Builder] -> [Builder]
    forall a b. (a -> b) -> a -> b
    $ ((ByteString, Float) -> Builder)
    -> [(ByteString, Float)] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString, Float) -> Builder
    format [(ByteString, Float)]
    tqs

        format :: (ByteString,Float) -> Builder
        format :: (ByteString, Float) -> Builder
    format (ByteString
    t',Float
    q) =
            [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat
               [ByteString -> Builder
    Builder.fromByteString ByteString
    t',
                String -> Builder
    Builder.fromString String
    "; q=",
                Float -> Builder
    forall a. Show a => a -> Builder
    Builder.fromShow Float
    q]

    --
    -- | Set username and password credentials per the HTTP basic
    -- authentication method.
    --
    -- >         setAuthorizationBasic "Aladdin" "open sesame"
    --
    -- will result in an @Authorization:@ header value of
    -- @Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==@.
    --
    -- Basic authentication does /not/ use a message digest function to
    -- encipher the password; the above string is only base-64 encoded and
    -- is thus plain-text visible to any observer on the wire and all
    -- caches and servers at the other end, making basic authentication
    -- completely insecure. A number of web services, however, use SSL to
    -- encrypt the connection that then use HTTP basic authentication to
    -- validate requests. Keep in mind in these cases the secret is still
    -- sent to the servers on the other side and passes in clear through
    -- all layers after the SSL termination. Do /not/ use basic
    -- authentication to protect secure or user-originated privacy-sensitve
    -- information.
    --
    {-
        This would be better using Builder, right?
    -}
    setAuthorizationBasic :: ByteString -> ByteString -> RequestBuilder ()
    setAuthorizationBasic :: ByteString -> ByteString -> RequestBuilder ()
    setAuthorizationBasic ByteString
    user' ByteString
    passwd' = do
        ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Authorization" ByteString
    v'
      where
        v' :: ByteString
    v'   = [ByteString] -> ByteString
    S.concat [ByteString
    "Basic ", ByteString
    msg']
        msg' :: ByteString
    msg' = ByteString -> ByteString
    BS64.encode ByteString
    str'
        str' :: ByteString
    str' = [ByteString] -> ByteString
    S.concat [ByteString
    user', ByteString
    ":", ByteString
    passwd']

    --
    -- | Set the MIME type corresponding to the body of the request you are
    -- sending. Defaults to @\"text\/plain\"@, so usually you need to set
    -- this if 'PUT'ting.
    --
    setContentType :: ContentType -> RequestBuilder ()
    setContentType :: ByteString -> RequestBuilder ()
    setContentType ByteString
    v' = do
        ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Content-Type" ByteString
    v'

    --
    -- | If sending multipart form data (RFC 7578), you need to set the MIME type
    -- to @\"multipart/form-data\"@ and specify the boundary separator that will
    -- be used.
    --
    -- This function is special: you must subsequently use
    -- 'Network.Http.Client.multipartFormBody' to sequence the individual body
    -- parts. When sending the request it will separate the individual parts by
    -- the boundary value set by this function.
    --
    setContentMultipart :: Boundary -> RequestBuilder ()
    setContentMultipart :: Boundary -> RequestBuilder ()
    setContentMultipart Boundary
    boundary = do
        ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Content-Type" (ByteString -> ByteString -> ByteString
    S.append ByteString
    "multipart/form-data; boundary=" (Boundary -> ByteString
    unBoundary Boundary
    boundary))
        Boundary -> RequestBuilder ()
    setBoundary Boundary
    boundary

    setBoundary :: Boundary -> RequestBuilder ()
    setBoundary :: Boundary -> RequestBuilder ()
    setBoundary Boundary
    boundary = do
        q <- RequestBuilder Request
    forall s (m :: * -> *). MonadState s m => m s
    get
        put q {
            qBoundary = boundary
        }

    --
    -- | Specify the length of the request body, in bytes.
    --
    -- RFC 2616 requires that we either send a @Content-Length@ header or
    -- use @Transfer-Encoding: chunked@. If you know the exact size ahead
    -- of time, then call this function; the body content will still be
    -- streamed out by @io-streams@ in more-or-less constant space.
    --
    -- This function is special: in a PUT or POST request, @http-streams@
    -- will assume chunked transfer-encoding /unless/ you specify a content
    -- length here, in which case you need to ensure your body function
    -- writes precisely that many bytes.
    --
    --
    setContentLength :: Int64 -> RequestBuilder ()
    setContentLength :: Int64 -> RequestBuilder ()
    setContentLength Int64
    n = do
        ByteString -> RequestBuilder ()
    deleteHeader ByteString
    "Transfer-Encoding"
        ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Content-Length" (String -> ByteString
    S.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int64 -> String
    forall a. Show a => a -> String
    show Int64
    n)
        EntityBody -> RequestBuilder ()
    setEntityBody (EntityBody -> RequestBuilder ())
    -> EntityBody -> RequestBuilder ()
    forall a b. (a -> b) -> a -> b
    $ Int64 -> EntityBody
    Static Int64
    n

    --
    -- | Override the default setting about how the entity body will be sent.
    --
    -- This function is special: this explicitly sets the @Transfer-Encoding:@
    -- header to @chunked@ and will instruct the library to actually tranfer the
    -- body as a stream ("chunked transfer encoding"). See 'setContentLength' for
    -- forcing the opposite. You /really/ won't need this in normal operation, but
    -- some people are control freaks.
    --
    setTransferEncoding :: RequestBuilder ()
    setTransferEncoding :: RequestBuilder ()
    setTransferEncoding = do
        ByteString -> RequestBuilder ()
    deleteHeader ByteString
    "Content-Length"
        EntityBody -> RequestBuilder ()
    setEntityBody EntityBody
    Chunking
        ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Transfer-Encoding" ByteString
    "chunked"

    --
    -- | Specify that this request should set the expectation that the
    -- server needs to approve the request before you send it.
    --
    -- This function is special: in a PUT or POST request, @http-streams@
    -- will wait for the server to reply with an HTTP/1.1 100 Continue
    -- status before sending the entity body. This is handled internally;
    -- you will get the real response (be it successful 2xx, client error,
    -- 4xx, or server error 5xx) in 'receiveResponse'. In theory, it
    -- should be 417 if the expectation failed.
    --
    -- Only bother with this if you know the service you're talking to
    -- requires clients to send an @Expect: 100-continue@ header and will
    -- handle it properly. Most servers don't do any precondition checking,
    -- automatically send an intermediate 100 response, and then just read
    -- the body regardless, making this a bit of a no-op in most cases.
    --
    setExpectContinue :: RequestBuilder ()
    setExpectContinue :: RequestBuilder ()
    setExpectContinue = do
        ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Expect" ByteString
    "100-continue"
        ExpectMode -> RequestBuilder ()
    setExpectMode ExpectMode
    Continue