{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Network.HTTP.Client.Request
    ( parseUrl
    , parseUrlThrow
    , parseRequest
    , parseRequest_
    , requestFromURI
    , requestFromURI_
    , defaultRequest
    , setUriRelative
    , getUri
    , setUri
    , setUriEither
    , browserDecompress
    , alwaysDecompress
    , addProxy
    , applyBasicAuth
    , applyBasicProxyAuth
    , applyBearerAuth
    , urlEncodedBody
    , needsGunzip
    , requestBuilder
    , setRequestIgnoreStatus
    , setRequestCheckStatus
    , setQueryString
#if MIN_VERSION_http_types(0,12,1)
    , setQueryStringPartialEscape
#endif
    , streamFile
    , observedStreamFile
    , extractBasicAuthInfo
    , throwErrorStatusCodes
    , addProxySecureWithoutConnect
    ) where

import Data.Int (Int64)
import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid (mempty, mappend, (<>))
import Data.String (IsString(..))
import Data.Char (toLower)
import Control.Applicative as A ((<$>))
import Control.Monad (unless, guard)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Numeric (showHex)

import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString, toByteStringIO, flush)
import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)

import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Internal (defaultChunkSize)

import qualified Network.HTTP.Types as W
import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, unEscapeString, isAllowedInURI)

import Control.Exception (throw, throwIO, IOException)
import qualified Control.Exception as E
import qualified Data.CaseInsensitive as CI
import qualified Data.ByteString.Base64 as B64

import Network.HTTP.Client.Body
import Network.HTTP.Client.Types
import Network.HTTP.Client.Util

import Control.Monad.Catch (MonadThrow, throwM)

import System.IO (withBinaryFile, hTell, hFileSize, Handle, IOMode (ReadMode))
import Control.Monad (liftM)

-- | Deprecated synonym for 'parseUrlThrow'. You probably want
-- 'parseRequest' or 'parseRequest_' instead.
--
-- @since 0.1.0
parseUrl :: MonadThrow m => String -> m Request
parseUrl :: String -> m Request
parseUrl = String -> m Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow
{-# DEPRECATED parseUrl "Please use parseUrlThrow, parseRequest, or parseRequest_ instead" #-}

-- | Same as 'parseRequest', except will throw an 'HttpException' in the
-- event of a non-2XX response. This uses 'throwErrorStatusCodes' to
-- implement 'checkResponse'.
--
-- @since 0.4.30
parseUrlThrow :: MonadThrow m => String -> m Request
parseUrlThrow :: String -> m Request
parseUrlThrow =
    (Request -> Request) -> m Request -> m Request
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> Request
yesThrow (m Request -> m Request)
-> (String -> m Request) -> String -> m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
  where
    yesThrow :: Request -> Request
yesThrow Request
req = Request
req { checkResponse :: Request -> Response BodyReader -> IO ()
checkResponse = Request -> Response BodyReader -> IO ()
forall (m :: * -> *).
MonadIO m =>
Request -> Response BodyReader -> m ()
throwErrorStatusCodes }

-- | Throws a 'StatusCodeException' wrapped in 'HttpExceptionRequest',
-- if the response's status code indicates an error (if it isn't 2xx).
-- This can be used to implement 'checkResponse'.
--
-- @since 0.5.13
throwErrorStatusCodes :: MonadIO m => Request -> Response BodyReader -> m ()
throwErrorStatusCodes :: Request -> Response BodyReader -> m ()
throwErrorStatusCodes Request
req Response BodyReader
res = do
    let W.Status Int
sci ByteString
_ = Response BodyReader -> Status
forall body. Response body -> Status
responseStatus Response BodyReader
res
    if Int
200 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sci Bool -> Bool -> Bool
&& Int
sci Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300
        then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            ByteString
chunk <- BodyReader -> Int -> IO ByteString
brReadSome (Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody Response BodyReader
res) Int
1024
            let res' :: Response ()
res' = (BodyReader -> ()) -> Response BodyReader -> Response ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> BodyReader -> ()
forall a b. a -> b -> a
const ()) Response BodyReader
res
            let ex :: HttpExceptionContent
ex = Response () -> ByteString -> HttpExceptionContent
StatusCodeException Response ()
res' (ByteString -> ByteString
L.toStrict ByteString
chunk)
            HttpException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HttpException -> IO ()) -> HttpException -> IO ()
forall a b. (a -> b) -> a -> b
$ Request -> HttpExceptionContent -> HttpException
HttpExceptionRequest Request
req HttpExceptionContent
ex

-- | Convert a URL into a 'Request'.
--
-- This function defaults some of the values in 'Request', such as setting 'method' to
-- @"GET"@ and 'requestHeaders' to @[]@.
--
-- Since this function uses 'MonadThrow', the return monad can be anything that is
-- an instance of 'MonadThrow', such as 'IO' or 'Maybe'.
--
-- You can place the request method at the beginning of the URL separated by a
-- space, e.g.:
--
-- @@@
-- parseRequest "POST http://httpbin.org/post"
-- @@@
--
-- Note that the request method must be provided as all capital letters.
--
-- A 'Request' created by this function won't cause exceptions on non-2XX
-- response status codes.
--
-- To create a request which throws on non-2XX status codes, see 'parseUrlThrow'
--
-- @since 0.4.30
parseRequest :: MonadThrow m => String -> m Request
parseRequest :: String -> m Request
parseRequest String
s' =
    case String -> Maybe URI
parseURI (String -> String
encode String
s) of
        Just URI
uri -> (Request -> Request) -> m Request -> m Request
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> Request
setMethod (Request -> URI -> m Request
forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
setUri Request
defaultRequest URI
uri)
        Maybe URI
Nothing  -> HttpException -> m Request
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HttpException -> m Request) -> HttpException -> m Request
forall a b. (a -> b) -> a -> b
$ String -> String -> HttpException
InvalidUrlException String
s String
"Invalid URL"
  where
    encode :: String -> String
encode = (Char -> Bool) -> String -> String
escapeURIString Char -> Bool
isAllowedInURI
    (Maybe String
mmethod, String
s) =
        case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
s' of
            (String
x, Char
' ':String
y) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') String
x -> (String -> Maybe String
forall a. a -> Maybe a
Just String
x, String
y)
            (String, String)
_ -> (Maybe String
forall a. Maybe a
Nothing, String
s')

    setMethod :: Request -> Request
setMethod Request
req =
        case Maybe String
mmethod of
            Maybe String
Nothing -> Request
req
            Just String
m -> Request
req { method :: ByteString
method = String -> ByteString
S8.pack String
m }

-- | Same as 'parseRequest', but parse errors cause an impure exception.
-- Mostly useful for static strings which are known to be correctly
-- formatted.
parseRequest_ :: String -> Request
parseRequest_ :: String -> Request
parseRequest_ = (SomeException -> Request)
-> (Request -> Request) -> Either SomeException Request -> Request
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Request
forall a e. Exception e => e -> a
throw Request -> Request
forall a. a -> a
id (Either SomeException Request -> Request)
-> (String -> Either SomeException Request) -> String -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either SomeException Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest

-- | Convert a 'URI' into a 'Request'.
--
-- This can fail if the given 'URI' is not absolute, or if the
-- 'URI' scheme is not @"http"@ or @"https"@. In these cases the function
-- will throw an error via 'MonadThrow'.
--
-- This function defaults some of the values in 'Request', such as setting 'method' to
-- @"GET"@ and 'requestHeaders' to @[]@.
--
-- A 'Request' created by this function won't cause exceptions on non-2XX
-- response status codes.
--
-- @since 0.5.12
requestFromURI :: MonadThrow m => URI -> m Request
requestFromURI :: URI -> m Request
requestFromURI = Request -> URI -> m Request
forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
setUri Request
defaultRequest

-- | Same as 'requestFromURI', but if the conversion would fail,
-- throws an impure exception.
--
-- @since 0.5.12
requestFromURI_ :: URI -> Request
requestFromURI_ :: URI -> Request
requestFromURI_ = (SomeException -> Request)
-> (Request -> Request) -> Either SomeException Request -> Request
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Request
forall a e. Exception e => e -> a
throw Request -> Request
forall a. a -> a
id (Either SomeException Request -> Request)
-> (URI -> Either SomeException Request) -> URI -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Either SomeException Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
requestFromURI

-- | Add a 'URI' to the request. If it is absolute (includes a host name), add
-- it as per 'setUri'; if it is relative, merge it with the existing request.
setUriRelative :: MonadThrow m => Request -> URI -> m Request
setUriRelative :: Request -> URI -> m Request
setUriRelative Request
req URI
uri = Request -> URI -> m Request
forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
setUri Request
req (URI -> m Request) -> URI -> m Request
forall a b. (a -> b) -> a -> b
$ URI
uri URI -> URI -> URI
`relativeTo` Request -> URI
getUri Request
req

-- | Extract a 'URI' from the request.
--
-- Since 0.1.0
getUri :: Request -> URI
getUri :: Request -> URI
getUri Request
req = URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI
    { uriScheme :: String
uriScheme = if Request -> Bool
secure Request
req
                    then String
"https:"
                    else String
"http:"
    , uriAuthority :: Maybe URIAuth
uriAuthority = URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just URIAuth :: String -> String -> String -> URIAuth
URIAuth
        { uriUserInfo :: String
uriUserInfo = String
""
        , uriRegName :: String
uriRegName = ByteString -> String
S8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
host Request
req
        , uriPort :: String
uriPort = String
port'
        }
    , uriPath :: String
uriPath = ByteString -> String
S8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
path Request
req
    , uriQuery :: String
uriQuery =
        case ByteString -> Maybe (Char, ByteString)
S8.uncons (ByteString -> Maybe (Char, ByteString))
-> ByteString -> Maybe (Char, ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req of
            Just (Char
c, ByteString
_) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?' -> Char
'?' Char -> String -> String
forall a. a -> [a] -> [a]
: (ByteString -> String
S8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req)
            Maybe (Char, ByteString)
_ -> ByteString -> String
S8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req
    , uriFragment :: String
uriFragment = String
""
    }
  where
    port' :: String
port'
      | Request -> Bool
secure Request
req Bool -> Bool -> Bool
&& (Request -> Int
port Request
req) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
443 = String
""
      | Bool -> Bool
not (Request -> Bool
secure Request
req) Bool -> Bool -> Bool
&& (Request -> Int
port Request
req) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
80 = String
""
      | Bool
otherwise = Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (Request -> Int
port Request
req)

applyAnyUriBasedAuth :: URI -> Request -> Request
applyAnyUriBasedAuth :: URI -> Request -> Request
applyAnyUriBasedAuth URI
uri Request
req =
    case URI -> Maybe (ByteString, ByteString)
extractBasicAuthInfo URI
uri of
        Just (ByteString, ByteString)
auth -> (ByteString -> ByteString -> Request -> Request)
-> (ByteString, ByteString) -> Request -> Request
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Request -> Request
applyBasicAuth (ByteString, ByteString)
auth Request
req
        Maybe (ByteString, ByteString)
Nothing -> Request
req

-- | Extract basic access authentication info in URI.
-- Return Nothing when there is no auth info in URI.
extractBasicAuthInfo :: URI -> Maybe (S8.ByteString, S8.ByteString)
extractBasicAuthInfo :: URI -> Maybe (ByteString, ByteString)
extractBasicAuthInfo URI
uri = do
    String
userInfo <- URIAuth -> String
uriUserInfo (URIAuth -> String) -> Maybe URIAuth -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> URI -> Maybe URIAuth
uriAuthority URI
uri
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char
':' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
userInfo)
    let (String
username, Char
':':String
password) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'@') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
userInfo
    (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ByteString
toLiteral String
username, String -> ByteString
toLiteral String
password)
  where
    toLiteral :: String -> ByteString
toLiteral = String -> ByteString
S8.pack (String -> ByteString)
-> (String -> String) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
unEscapeString

-- | Validate a 'URI', then add it to the request.
setUri :: MonadThrow m => Request -> URI -> m Request
setUri :: Request -> URI -> m Request
setUri Request
req URI
uri = (String -> m Request)
-> (Request -> m Request) -> Either String Request -> m Request
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m Request
forall a. String -> m a
throwInvalidUrlException Request -> m Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> URI -> Either String Request
setUriEither Request
req URI
uri)
  where
    throwInvalidUrlException :: String -> m a
throwInvalidUrlException = HttpException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HttpException -> m a)
-> (String -> HttpException) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> HttpException
InvalidUrlException (URI -> String
forall a. Show a => a -> String
show URI
uri)

-- | A variant of `setUri` that returns an error message on validation errors,
-- instead of propagating them with `throwM`.
--
-- @since 0.6.1
setUriEither :: Request -> URI -> Either String Request
setUriEither :: Request -> URI -> Either String Request
setUriEither Request
req URI
uri = do
    Bool
sec <- URI -> Either String Bool
forall a. IsString a => URI -> Either a Bool
parseScheme URI
uri
    URIAuth
auth <- Either String URIAuth
-> (URIAuth -> Either String URIAuth)
-> Maybe URIAuth
-> Either String URIAuth
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String URIAuth
forall a b. a -> Either a b
Left String
"URL must be absolute") URIAuth -> Either String URIAuth
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URIAuth -> Either String URIAuth)
-> Maybe URIAuth -> Either String URIAuth
forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
uriAuthority URI
uri
    Int
port' <- Bool -> URIAuth -> Either String Int
forall a. IsString a => Bool -> URIAuth -> Either a Int
parsePort Bool
sec URIAuth
auth
    Request -> Either String Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> Either String Request)
-> Request -> Either String Request
forall a b. (a -> b) -> a -> b
$ URI -> Request -> Request
applyAnyUriBasedAuth URI
uri Request
req
        { host :: ByteString
host = String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ URIAuth -> String
uriRegName URIAuth
auth
        , port :: Int
port = Int
port'
        , secure :: Bool
secure = Bool
sec
        , path :: ByteString
path = String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
                    if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ URI -> String
uriPath URI
uri
                        then String
"/"
                        else URI -> String
uriPath URI
uri
        , queryString :: ByteString
queryString = String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ URI -> String
uriQuery URI
uri
        }
  where
    parseScheme :: URI -> Either a Bool
parseScheme URI{uriScheme :: URI -> String
uriScheme = String
scheme} =
        case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
scheme of
            String
"http:"  -> Bool -> Either a Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            String
"https:" -> Bool -> Either a Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            String
_        -> a -> Either a Bool
forall a b. a -> Either a b
Left a
"Invalid scheme"

    parsePort :: Bool -> URIAuth -> Either a Int
parsePort Bool
sec URIAuth{uriPort :: URIAuth -> String
uriPort = String
portStr} =
        case String
portStr of
            -- If the user specifies a port, then use it
            Char
':':String
rest -> Either a Int -> (Int -> Either a Int) -> Maybe Int -> Either a Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (a -> Either a Int
forall a b. a -> Either a b
Left a
"Invalid port")
                Int -> Either a Int
forall (m :: * -> *) a. Monad m => a -> m a
return
                (String -> Maybe Int
readPositiveInt String
rest)
            -- Otherwise, use the default port
            String
_ -> case Bool
sec of
                    Bool
False {- HTTP -} -> Int -> Either a Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
80
                    Bool
True {- HTTPS -} -> Int -> Either a Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
443

-- | A default request value, a GET request of localhost/:80, with an
-- empty request body.
--
-- Note that the default 'checkResponse' does nothing.
--
-- @since 0.4.30
defaultRequest :: Request
defaultRequest :: Request
defaultRequest = Request :: ByteString
-> Bool
-> ByteString
-> Int
-> ByteString
-> ByteString
-> RequestHeaders
-> RequestBody
-> Maybe Proxy
-> Maybe HostAddress
-> Bool
-> (ByteString -> Bool)
-> Int
-> (Request -> Response BodyReader -> IO ())
-> ResponseTimeout
-> Maybe CookieJar
-> HttpVersion
-> (SomeException -> IO ())
-> Maybe Manager
-> (HeaderName -> Bool)
-> ProxySecureMode
-> Request
Request
        { host :: ByteString
host = ByteString
"localhost"
        , port :: Int
port = Int
80
        , secure :: Bool
secure = Bool
False
        , requestHeaders :: RequestHeaders
requestHeaders = []
        , path :: ByteString
path = ByteString
"/"
        , queryString :: ByteString
queryString = ByteString
S8.empty
        , requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
L.empty
        , method :: ByteString
method = ByteString
"GET"
        , proxy :: Maybe Proxy
proxy = Maybe Proxy
forall a. Maybe a
Nothing
        , hostAddress :: Maybe HostAddress
hostAddress = Maybe HostAddress
forall a. Maybe a
Nothing
        , rawBody :: Bool
rawBody = Bool
False
        , decompress :: ByteString -> Bool
decompress = ByteString -> Bool
browserDecompress
        , redirectCount :: Int
redirectCount = Int
10
        , checkResponse :: Request -> Response BodyReader -> IO ()
checkResponse = \Request
_ Response BodyReader
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , responseTimeout :: ResponseTimeout
responseTimeout = ResponseTimeout
ResponseTimeoutDefault
        , cookieJar :: Maybe CookieJar
cookieJar = CookieJar -> Maybe CookieJar
forall a. a -> Maybe a
Just CookieJar
forall a. Monoid a => a
Data.Monoid.mempty
        , requestVersion :: HttpVersion
requestVersion = HttpVersion
W.http11
        , onRequestBodyException :: SomeException -> IO ()
onRequestBodyException = \SomeException
se ->
            case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
se of
                Just (IOException
_ :: IOException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe IOException
Nothing -> SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
se
        , requestManagerOverride :: Maybe Manager
requestManagerOverride = Maybe Manager
forall a. Maybe a
Nothing
        , shouldStripHeaderOnRedirect :: HeaderName -> Bool
shouldStripHeaderOnRedirect = Bool -> HeaderName -> Bool
forall a b. a -> b -> a
const Bool
False
        , proxySecureMode :: ProxySecureMode
proxySecureMode = ProxySecureMode
ProxySecureWithConnect
        }

-- | Parses a URL via 'parseRequest_'
--
-- /NOTE/: Prior to version 0.5.0, this instance used 'parseUrlThrow'
-- instead.
instance IsString Request where
    fromString :: String -> Request
fromString = String -> Request
parseRequest_
    {-# INLINE fromString #-}

-- | Always decompress a compressed stream.
alwaysDecompress :: S.ByteString -> Bool
alwaysDecompress :: ByteString -> Bool
alwaysDecompress = Bool -> ByteString -> Bool
forall a b. a -> b -> a
const Bool
True

-- | Decompress a compressed stream unless the content-type is 'application/x-tar'.
browserDecompress :: S.ByteString -> Bool
browserDecompress :: ByteString -> Bool
browserDecompress = (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"application/x-tar")

-- | Build a basic-auth header value
buildBasicAuth ::
    S8.ByteString -- ^ Username
    -> S8.ByteString -- ^ Password
    -> S8.ByteString
buildBasicAuth :: ByteString -> ByteString -> ByteString
buildBasicAuth ByteString
user ByteString
passwd =
    ByteString -> ByteString -> ByteString
S8.append ByteString
"Basic " (ByteString -> ByteString
B64.encode ([ByteString] -> ByteString
S8.concat [ ByteString
user, ByteString
":", ByteString
passwd ]))

-- | Add a Basic Auth header (with the specified user name and password) to the
-- given Request. Ignore error handling:
--
-- >  applyBasicAuth "user" "pass" $ parseRequest_ url
--
-- NOTE: The function @applyDigestAuth@ is provided by the @http-client-tls@
-- package instead of this package due to extra dependencies. Please use that
-- package if you need to use digest authentication.
--
-- Since 0.1.0
applyBasicAuth :: S.ByteString -> S.ByteString -> Request -> Request
applyBasicAuth :: ByteString -> ByteString -> Request -> Request
applyBasicAuth ByteString
user ByteString
passwd Request
req =
    Request
req { requestHeaders :: RequestHeaders
requestHeaders = (HeaderName, ByteString)
authHeader (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req }
  where
    authHeader :: (HeaderName, ByteString)
authHeader = (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk ByteString
"Authorization", ByteString -> ByteString -> ByteString
buildBasicAuth ByteString
user ByteString
passwd)

-- | Build a bearer-auth header value
buildBearerAuth ::
    S8.ByteString -- ^ Token
    -> S8.ByteString
buildBearerAuth :: ByteString -> ByteString
buildBearerAuth ByteString
token =
    ByteString -> ByteString -> ByteString
S8.append ByteString
"Bearer " ByteString
token

-- | Add a Bearer Auth header to the given 'Request'
--
-- @since 0.7.6
applyBearerAuth :: S.ByteString -> Request -> Request
applyBearerAuth :: ByteString -> Request -> Request
applyBearerAuth ByteString
bearerToken Request
req =
    Request
req { requestHeaders :: RequestHeaders
requestHeaders = (HeaderName, ByteString)
authHeader (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req }
  where
    authHeader :: (HeaderName, ByteString)
authHeader = (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk ByteString
"Authorization", ByteString -> ByteString
buildBearerAuth ByteString
bearerToken)

-- | Add a proxy to the Request so that the Request when executed will use
-- the provided proxy.
--
-- Since 0.1.0
addProxy :: S.ByteString -> Int -> Request -> Request
addProxy :: ByteString -> Int -> Request -> Request
addProxy ByteString
hst Int
prt Request
req =
    Request
req { proxy :: Maybe Proxy
proxy = Proxy -> Maybe Proxy
forall a. a -> Maybe a
Just (Proxy -> Maybe Proxy) -> Proxy -> Maybe Proxy
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Proxy
Proxy ByteString
hst Int
prt }


-- | Send secure requests to the proxy in plain text rather than using CONNECT.
--
-- @since 0.7.2
addProxySecureWithoutConnect :: Request -> Request
addProxySecureWithoutConnect :: Request -> Request
addProxySecureWithoutConnect Request
req = Request
req { proxySecureMode :: ProxySecureMode
proxySecureMode = ProxySecureMode
ProxySecureWithoutConnect }

-- | Add a Proxy-Authorization header (with the specified username and
-- password) to the given 'Request'. Ignore error handling:
--
-- > applyBasicProxyAuth "user" "pass" <$> parseRequest "http://example.org"
--
-- Since 0.3.4

applyBasicProxyAuth :: S.ByteString -> S.ByteString -> Request -> Request
applyBasicProxyAuth :: ByteString -> ByteString -> Request -> Request
applyBasicProxyAuth ByteString
user ByteString
passwd Request
req =
    Request
req { requestHeaders :: RequestHeaders
requestHeaders = (HeaderName, ByteString)
authHeader (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req }
  where
    authHeader :: (HeaderName, ByteString)
authHeader = (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk ByteString
"Proxy-Authorization", ByteString -> ByteString -> ByteString
buildBasicAuth ByteString
user ByteString
passwd)

-- | Add url-encoded parameters to the 'Request'.
--
-- This sets a new 'requestBody', adds a content-type request header and
-- changes the 'method' to POST.
--
-- Since 0.1.0
urlEncodedBody :: [(S.ByteString, S.ByteString)] -> Request -> Request
urlEncodedBody :: [(ByteString, ByteString)] -> Request -> Request
urlEncodedBody [(ByteString, ByteString)]
headers Request
req = Request
req
    { requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS ByteString
body
    , method :: ByteString
method = ByteString
"POST"
    , requestHeaders :: RequestHeaders
requestHeaders =
        (HeaderName
ct, ByteString
"application/x-www-form-urlencoded")
      (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: ((HeaderName, ByteString) -> Bool)
-> RequestHeaders -> RequestHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
x, ByteString
_) -> HeaderName
x HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
ct) (Request -> RequestHeaders
requestHeaders Request
req)
    }
  where
    ct :: HeaderName
ct = HeaderName
"Content-Type"
    body :: ByteString
body = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> [(ByteString, ByteString)] -> ByteString
W.renderSimpleQuery Bool
False [(ByteString, ByteString)]
headers

needsGunzip :: Request
            -> [W.Header] -- ^ response headers
            -> Bool
needsGunzip :: Request -> RequestHeaders -> Bool
needsGunzip Request
req RequestHeaders
hs' =
        Bool -> Bool
not (Request -> Bool
rawBody Request
req)
     Bool -> Bool -> Bool
&& (HeaderName
"content-encoding", ByteString
"gzip") (HeaderName, ByteString) -> RequestHeaders -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RequestHeaders
hs'
     Bool -> Bool -> Bool
&& Request -> ByteString -> Bool
decompress Request
req (ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"content-type" RequestHeaders
hs')

data EncapsulatedPopperException = EncapsulatedPopperException E.SomeException
    deriving (Int -> EncapsulatedPopperException -> String -> String
[EncapsulatedPopperException] -> String -> String
EncapsulatedPopperException -> String
(Int -> EncapsulatedPopperException -> String -> String)
-> (EncapsulatedPopperException -> String)
-> ([EncapsulatedPopperException] -> String -> String)
-> Show EncapsulatedPopperException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EncapsulatedPopperException] -> String -> String
$cshowList :: [EncapsulatedPopperException] -> String -> String
show :: EncapsulatedPopperException -> String
$cshow :: EncapsulatedPopperException -> String
showsPrec :: Int -> EncapsulatedPopperException -> String -> String
$cshowsPrec :: Int -> EncapsulatedPopperException -> String -> String
Show)
instance E.Exception EncapsulatedPopperException

-- | Encapsulate a thrown exception into a custom type
--
-- During streamed body sending, both the Popper and the connection may throw IO exceptions;
-- however, we don't want to route the Popper exceptions through onRequestBodyException.
-- https://github.com/snoyberg/http-client/issues/469
encapsulatePopperException :: IO a -> IO a
encapsulatePopperException :: IO a -> IO a
encapsulatePopperException IO a
action =
    IO a
action IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(SomeException
ex :: E.SomeException) -> EncapsulatedPopperException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (SomeException -> EncapsulatedPopperException
EncapsulatedPopperException SomeException
ex))

requestBuilder :: Request -> Connection -> IO (Maybe (IO ()))
requestBuilder :: Request -> Connection -> IO (Maybe (IO ()))
requestBuilder Request
req Connection {IO ()
BodyReader
ByteString -> IO ()
connectionClose :: Connection -> IO ()
connectionWrite :: Connection -> ByteString -> IO ()
connectionUnread :: Connection -> ByteString -> IO ()
connectionRead :: Connection -> BodyReader
connectionClose :: IO ()
connectionWrite :: ByteString -> IO ()
connectionUnread :: ByteString -> IO ()
connectionRead :: BodyReader
..} = do
    (Maybe Int64
contentLength, IO ()
sendNow, IO ()
sendLater) <- RequestBody -> IO (Maybe Int64, IO (), IO ())
toTriple (Request -> RequestBody
requestBody Request
req)
    if Bool
expectContinue
        then Maybe Int64 -> IO ()
flushHeaders Maybe Int64
contentLength IO () -> IO (Maybe (IO ())) -> IO (Maybe (IO ()))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (IO ()) -> IO (Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> IO ()
checkBadSend IO ()
sendLater))
        else IO ()
sendNow IO () -> IO (Maybe (IO ())) -> IO (Maybe (IO ()))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (IO ()) -> IO (Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IO ())
forall a. Maybe a
Nothing
  where
    expectContinue :: Bool
expectContinue   = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"100-continue" Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Expect" (Request -> RequestHeaders
requestHeaders Request
req)
    checkBadSend :: IO () -> IO ()
checkBadSend IO ()
f   = IO ()
f IO () -> [Handler ()] -> IO ()
forall a. IO a -> [Handler a] -> IO a
`E.catches` [
        (EncapsulatedPopperException -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler (\(EncapsulatedPopperException SomeException
ex) -> SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
ex)
      , (SomeException -> IO ()) -> Handler ()
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler (Request -> SomeException -> IO ()
onRequestBodyException Request
req)
      ]
    writeBuilder :: Builder -> IO ()
writeBuilder     = (ByteString -> IO ()) -> Builder -> IO ()
toByteStringIO ByteString -> IO ()
connectionWrite
    writeHeadersWith :: Maybe Int64 -> Builder -> IO ()
writeHeadersWith Maybe Int64
contentLength = Builder -> IO ()
writeBuilder (Builder -> IO ()) -> (Builder -> Builder) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int64 -> Builder
builder Maybe Int64
contentLength Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`Data.Monoid.mappend`)
    flushHeaders :: Maybe Int64 -> IO ()
flushHeaders Maybe Int64
contentLength     = Maybe Int64 -> Builder -> IO ()
writeHeadersWith Maybe Int64
contentLength Builder
flush

    toTriple :: RequestBody -> IO (Maybe Int64, IO (), IO ())
toTriple (RequestBodyLBS ByteString
lbs) = do
        let body :: Builder
body  = ByteString -> Builder
fromLazyByteString ByteString
lbs
            len :: Maybe Int64
len   = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
lbs
            now :: IO ()
now   = IO () -> IO ()
checkBadSend (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> Builder -> IO ()
writeHeadersWith Maybe Int64
len Builder
body
            later :: IO ()
later = Builder -> IO ()
writeBuilder Builder
body
        (Maybe Int64, IO (), IO ()) -> IO (Maybe Int64, IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int64
len, IO ()
now, IO ()
later)
    toTriple (RequestBodyBS ByteString
bs) = do
        let body :: Builder
body  = ByteString -> Builder
fromByteString ByteString
bs
            len :: Maybe Int64
len   = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs
            now :: IO ()
now   = IO () -> IO ()
checkBadSend (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> Builder -> IO ()
writeHeadersWith Maybe Int64
len Builder
body
            later :: IO ()
later = Builder -> IO ()
writeBuilder Builder
body
        (Maybe Int64, IO (), IO ()) -> IO (Maybe Int64, IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int64
len, IO ()
now, IO ()
later)
    toTriple (RequestBodyBuilder Int64
len Builder
body) = do
        let now :: IO ()
now   = IO () -> IO ()
checkBadSend (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> Builder -> IO ()
writeHeadersWith (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
len) Builder
body
            later :: IO ()
later = Builder -> IO ()
writeBuilder Builder
body
        (Maybe Int64, IO (), IO ()) -> IO (Maybe Int64, IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
len, IO ()
now, IO ()
later)
    toTriple (RequestBodyStream Int64
len GivesPopper ()
stream) = do
        -- See https://github.com/snoyberg/http-client/issues/74 for usage
        -- of flush here.
        let body :: IO ()
body = Maybe Int -> GivesPopper () -> IO ()
forall t. Maybe Int -> ((BodyReader -> IO ()) -> t) -> t
writeStream (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Int64 -> Int) -> Int64 -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Int) -> Int64 -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int64
len) GivesPopper ()
stream
            -- Don't check for a bad send on the headers themselves.
            -- Ideally, we'd do the same thing for the other request body
            -- types, but it would also introduce a performance hit since
            -- we couldn't merge request headers and bodies together.
            now :: IO ()
now  = Maybe Int64 -> IO ()
flushHeaders (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
len) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO ()
checkBadSend IO ()
body
        (Maybe Int64, IO (), IO ()) -> IO (Maybe Int64, IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
len, IO ()
now, IO ()
body)
    toTriple (RequestBodyStreamChunked GivesPopper ()
stream) = do
        let body :: IO ()
body = Maybe Int -> GivesPopper () -> IO ()
forall t. Maybe Int -> ((BodyReader -> IO ()) -> t) -> t
writeStream Maybe Int
forall a. Maybe a
Nothing GivesPopper ()
stream
            now :: IO ()
now  = Maybe Int64 -> IO ()
flushHeaders Maybe Int64
forall a. Maybe a
Nothing IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO ()
checkBadSend IO ()
body
        (Maybe Int64, IO (), IO ()) -> IO (Maybe Int64, IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int64
forall a. Maybe a
Nothing, IO ()
now, IO ()
body)
    toTriple (RequestBodyIO IO RequestBody
mbody) = IO RequestBody
mbody IO RequestBody
-> (RequestBody -> IO (Maybe Int64, IO (), IO ()))
-> IO (Maybe Int64, IO (), IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RequestBody -> IO (Maybe Int64, IO (), IO ())
toTriple

    writeStream :: Maybe Int -> ((BodyReader -> IO ()) -> t) -> t
writeStream Maybe Int
mlen (BodyReader -> IO ()) -> t
withStream =
        (BodyReader -> IO ()) -> t
withStream (Int -> BodyReader -> IO ()
loop Int
0)
      where
        loop :: Int -> BodyReader -> IO ()
loop !Int
n BodyReader
stream = do
            ByteString
bs <- BodyReader -> BodyReader
forall a. IO a -> IO a
encapsulatePopperException BodyReader
stream
            if ByteString -> Bool
S.null ByteString
bs
                then case Maybe Int
mlen of
                    -- If stream is chunked, no length argument
                    Maybe Int
Nothing -> ByteString -> IO ()
connectionWrite ByteString
"0\r\n\r\n"
                    -- Not chunked - validate length argument
                    Just len -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HttpExceptionContent -> IO ()
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO ()) -> HttpExceptionContent -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> HttpExceptionContent
WrongRequestBodyStreamSize (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
                else do
                    ByteString -> IO ()
connectionWrite (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
                        if (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
mlen) -- Chunked
                            then [ByteString] -> ByteString
S.concat
                                [ String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (ByteString -> Int
S.length ByteString
bs) String
"\r\n"
                                , ByteString
bs
                                , ByteString
"\r\n"
                                ]
                            else ByteString
bs
                    Int -> BodyReader -> IO ()
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (ByteString -> Int
S.length ByteString
bs)) BodyReader
stream

    hh :: ByteString
hh
        | Request -> Int
port Request
req Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
80 Bool -> Bool -> Bool
&& Bool -> Bool
not (Request -> Bool
secure Request
req) = Request -> ByteString
host Request
req
        | Request -> Int
port Request
req Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
443 Bool -> Bool -> Bool
&& Request -> Bool
secure Request
req = Request -> ByteString
host Request
req
        | Bool
otherwise = Request -> ByteString
host Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
S8.pack (Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (Request -> Int
port Request
req))

    requestProtocol :: Builder
requestProtocol
        | Request -> Bool
secure Request
req = ByteString -> Builder
fromByteString ByteString
"https://"
        | Bool
otherwise  = ByteString -> Builder
fromByteString ByteString
"http://"

    requestHostname :: Request -> Builder
requestHostname (Request { proxy :: Request -> Maybe Proxy
proxy = Maybe Proxy
Nothing }) = Builder
forall a. Monoid a => a
mempty
    requestHostname (Request { proxy :: Request -> Maybe Proxy
proxy = Just Proxy
_,
                               secure :: Request -> Bool
secure = Bool
False }) =
            Builder
requestProtocol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
hh
    requestHostname (Request { proxy :: Request -> Maybe Proxy
proxy = Just Proxy
_,
                               secure :: Request -> Bool
secure = Bool
True,
                               proxySecureMode :: Request -> ProxySecureMode
proxySecureMode = ProxySecureMode
ProxySecureWithConnect }) = Builder
forall a. Monoid a => a
mempty
    requestHostname (Request { proxy :: Request -> Maybe Proxy
proxy = Just Proxy
_,
                               secure :: Request -> Bool
secure = Bool
True,
                               proxySecureMode :: Request -> ProxySecureMode
proxySecureMode = ProxySecureMode
ProxySecureWithoutConnect }) =
            Builder
requestProtocol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
hh

    contentLengthHeader :: Maybe a -> [(a, ByteString)] -> [(a, ByteString)]
contentLengthHeader (Just a
contentLength') =
            if Request -> ByteString
method Request
req ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"GET", ByteString
"HEAD"] Bool -> Bool -> Bool
&& a
contentLength' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
                then [(a, ByteString)] -> [(a, ByteString)]
forall a. a -> a
id
                else (:) (a
"Content-Length", String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
contentLength')
    contentLengthHeader Maybe a
Nothing = (:) (a
"Transfer-Encoding", ByteString
"chunked")

    acceptEncodingHeader :: RequestHeaders -> RequestHeaders
acceptEncodingHeader =
        case HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Accept-Encoding" (RequestHeaders -> Maybe ByteString)
-> RequestHeaders -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Request -> RequestHeaders
requestHeaders Request
req of
            Maybe ByteString
Nothing -> ((HeaderName
"Accept-Encoding", ByteString
"gzip")(HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:)
            Just ByteString
"" -> ((HeaderName, ByteString) -> Bool)
-> RequestHeaders -> RequestHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
k, ByteString
_) -> HeaderName
k HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
"Accept-Encoding")
            Just ByteString
_ -> RequestHeaders -> RequestHeaders
forall a. a -> a
id

    hostHeader :: [(a, ByteString)] -> [(a, ByteString)]
hostHeader [(a, ByteString)]
x =
        case a -> [(a, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"Host" [(a, ByteString)]
x of
            Maybe ByteString
Nothing -> (a
"Host", ByteString
hh) (a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
forall a. a -> [a] -> [a]
: [(a, ByteString)]
x
            Just{} -> [(a, ByteString)]
x

    headerPairs :: Maybe Int64 -> W.RequestHeaders
    headerPairs :: Maybe Int64 -> RequestHeaders
headerPairs Maybe Int64
contentLength
                = RequestHeaders -> RequestHeaders
forall a.
(Eq a, IsString a) =>
[(a, ByteString)] -> [(a, ByteString)]
hostHeader
                (RequestHeaders -> RequestHeaders)
-> RequestHeaders -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ RequestHeaders -> RequestHeaders
acceptEncodingHeader
                (RequestHeaders -> RequestHeaders)
-> RequestHeaders -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> RequestHeaders -> RequestHeaders
forall a a.
(Eq a, Num a, IsString a, Show a) =>
Maybe a -> [(a, ByteString)] -> [(a, ByteString)]
contentLengthHeader Maybe Int64
contentLength
                (RequestHeaders -> RequestHeaders)
-> RequestHeaders -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ Request -> RequestHeaders
requestHeaders Request
req

    builder :: Maybe Int64 -> Builder
    builder :: Maybe Int64 -> Builder
builder Maybe Int64
contentLength =
            ByteString -> Builder
fromByteString (Request -> ByteString
method Request
req)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
" "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Request -> Builder
requestHostname Request
req
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (case ByteString -> Maybe (Char, ByteString)
S8.uncons (ByteString -> Maybe (Char, ByteString))
-> ByteString -> Maybe (Char, ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
path Request
req of
                    Just (Char
'/', ByteString
_) -> ByteString -> Builder
fromByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
path Request
req
                    Maybe (Char, ByteString)
_ -> Char -> Builder
fromChar Char
'/' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString (Request -> ByteString
path Request
req))
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (case ByteString -> Maybe (Char, ByteString)
S8.uncons (ByteString -> Maybe (Char, ByteString))
-> ByteString -> Maybe (Char, ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req of
                    Maybe (Char, ByteString)
Nothing -> Builder
forall a. Monoid a => a
mempty
                    Just (Char
'?', ByteString
_) -> ByteString -> Builder
fromByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req
                    Maybe (Char, ByteString)
_ -> Char -> Builder
fromChar Char
'?' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString (Request -> ByteString
queryString Request
req))
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (case Request -> HttpVersion
requestVersion Request
req of
                    W.HttpVersion Int
1 Int
1 -> ByteString -> Builder
fromByteString ByteString
" HTTP/1.1\r\n"
                    W.HttpVersion Int
1 Int
0 -> ByteString -> Builder
fromByteString ByteString
" HTTP/1.0\r\n"
                    HttpVersion
version ->
                        Char -> Builder
fromChar Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                        HttpVersion -> Builder
forall a. Show a => a -> Builder
fromShow HttpVersion
version Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                        ByteString -> Builder
fromByteString ByteString
"\r\n")
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((HeaderName, ByteString) -> Builder -> Builder)
-> Builder -> RequestHeaders -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\(HeaderName, ByteString)
a Builder
b -> (HeaderName, ByteString) -> Builder
headerPairToBuilder (HeaderName, ByteString)
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)
                (ByteString -> Builder
fromByteString ByteString
"\r\n")
                (Maybe Int64 -> RequestHeaders
headerPairs Maybe Int64
contentLength)

    headerPairToBuilder :: (HeaderName, ByteString) -> Builder
headerPairToBuilder (HeaderName
k, ByteString
v) =
           ByteString -> Builder
fromByteString (HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
k)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
": "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
v
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
"\r\n"

-- | Modify the request so that non-2XX status codes do not generate a runtime
-- 'StatusCodeException'.
--
-- @since 0.4.29
setRequestIgnoreStatus :: Request -> Request
setRequestIgnoreStatus :: Request -> Request
setRequestIgnoreStatus Request
req = Request
req { checkResponse :: Request -> Response BodyReader -> IO ()
checkResponse = \Request
_ Response BodyReader
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }

-- | Modify the request so that non-2XX status codes generate a runtime
-- 'StatusCodeException', by using 'throwErrorStatusCodes'
--
-- @since 0.5.13
setRequestCheckStatus :: Request -> Request
setRequestCheckStatus :: Request -> Request
setRequestCheckStatus Request
req = Request
req { checkResponse :: Request -> Response BodyReader -> IO ()
checkResponse = Request -> Response BodyReader -> IO ()
forall (m :: * -> *).
MonadIO m =>
Request -> Response BodyReader -> m ()
throwErrorStatusCodes }

-- | Set the query string to the given key/value pairs.
--
-- Since 0.3.6
setQueryString :: [(S.ByteString, Maybe S.ByteString)] -> Request -> Request
setQueryString :: [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString [(ByteString, Maybe ByteString)]
qs Request
req = Request
req { queryString :: ByteString
queryString = Bool -> [(ByteString, Maybe ByteString)] -> ByteString
W.renderQuery Bool
True [(ByteString, Maybe ByteString)]
qs }

#if MIN_VERSION_http_types(0,12,1)
-- | Set the query string to the given key/value pairs.
--
-- @since 0.5.10
setQueryStringPartialEscape :: [(S.ByteString, [W.EscapeItem])] -> Request -> Request
setQueryStringPartialEscape :: [(ByteString, [EscapeItem])] -> Request -> Request
setQueryStringPartialEscape [(ByteString, [EscapeItem])]
qs Request
req = Request
req { queryString :: ByteString
queryString = Bool -> [(ByteString, [EscapeItem])] -> ByteString
W.renderQueryPartialEscape Bool
True [(ByteString, [EscapeItem])]
qs }
#endif

-- | Send a file as the request body.
--
-- It is expected that the file size does not change between calling
-- `streamFile` and making any requests using this request body.
--
-- Since 0.4.9
streamFile :: FilePath -> IO RequestBody
streamFile :: String -> IO RequestBody
streamFile = (StreamFileStatus -> IO ()) -> String -> IO RequestBody
observedStreamFile (\StreamFileStatus
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Send a file as the request body, while observing streaming progress via
-- a `PopObserver`. Observations are made between reading and sending a chunk.
--
-- It is expected that the file size does not change between calling
-- `observedStreamFile` and making any requests using this request body.
--
-- Since 0.4.9
observedStreamFile :: (StreamFileStatus -> IO ()) -> FilePath -> IO RequestBody
observedStreamFile :: (StreamFileStatus -> IO ()) -> String -> IO RequestBody
observedStreamFile StreamFileStatus -> IO ()
obs String
path = do
    Int64
size <- Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> IO Integer -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path IOMode
ReadMode Handle -> IO Integer
hFileSize

    let filePopper :: Handle -> Popper
        filePopper :: Handle -> BodyReader
filePopper Handle
h = do
            ByteString
bs <- Handle -> Int -> BodyReader
S.hGetSome Handle
h Int
defaultChunkSize
            Int64
currentPosition <- Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> IO Integer -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hTell Handle
h
            StreamFileStatus -> IO ()
obs (StreamFileStatus -> IO ()) -> StreamFileStatus -> IO ()
forall a b. (a -> b) -> a -> b
$ StreamFileStatus :: Int64 -> Int64 -> Int -> StreamFileStatus
StreamFileStatus
                { fileSize :: Int64
fileSize = Int64
size
                , readSoFar :: Int64
readSoFar = Int64
currentPosition
                , thisChunkSize :: Int
thisChunkSize = ByteString -> Int
S.length ByteString
bs
                }
            ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs

        givesFilePopper :: GivesPopper ()
        givesFilePopper :: GivesPopper ()
givesFilePopper BodyReader -> IO ()
k = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
            BodyReader -> IO ()
k (Handle -> BodyReader
filePopper Handle
h)

    RequestBody -> IO RequestBody
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestBody -> IO RequestBody) -> RequestBody -> IO RequestBody
forall a b. (a -> b) -> a -> b
$ Int64 -> GivesPopper () -> RequestBody
RequestBodyStream Int64
size GivesPopper ()
givesFilePopper