{-# 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 qualified Data.Set as Set

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 :: forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrl = 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 :: forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow =
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> Request
yesThrow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
  where
    yesThrow :: Request -> Request
yesThrow Request
req = Request
req { checkResponse :: Request -> Response BodyReader -> IO ()
checkResponse = 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 :: forall (m :: * -> *).
MonadIO m =>
Request -> Response BodyReader -> m ()
throwErrorStatusCodes Request
req Response BodyReader
res = do
    let W.Status Int
sci ByteString
_ = forall body. Response body -> Status
responseStatus Response BodyReader
res
    if Int
200 forall a. Ord a => a -> a -> Bool
<= Int
sci Bool -> Bool -> Bool
&& Int
sci forall a. Ord a => a -> a -> Bool
< Int
300
        then forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            ByteString
chunk <- BodyReader -> Int -> IO ByteString
brReadSome (forall body. Response body -> body
responseBody Response BodyReader
res) Int
1024
            let res' :: Response ()
res' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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)
            forall e a. Exception e => e -> IO a
throwIO 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 :: forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
s' =
    case String -> Maybe URI
parseURI (String -> String
encode String
s) of
        Just URI
uri -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> Request
setMethod (forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
setUri Request
defaultRequest URI
uri)
        Maybe URI
Nothing  -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
' ') String
s' of
            (String
x, Char
' ':String
y) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char
'A' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z') String
x -> (forall a. a -> Maybe a
Just String
x, String
y)
            (String, 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_ = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *). MonadThrow m => URI -> m Request
requestFromURI = 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_ = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
setUriRelative Request
req URI
uri = forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
setUri Request
req 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
    { uriScheme :: String
uriScheme = if Request -> Bool
secure Request
req
                    then String
"https:"
                    else String
"http:"
    , uriAuthority :: Maybe URIAuth
uriAuthority = forall a. a -> Maybe a
Just URIAuth
        { uriUserInfo :: String
uriUserInfo = String
""
        , uriRegName :: String
uriRegName = ByteString -> String
S8.unpack forall a b. (a -> b) -> a -> b
$ Request -> ByteString
host Request
req
        , uriPort :: String
uriPort = String
port'
        }
    , uriPath :: String
uriPath = ByteString -> String
S8.unpack forall a b. (a -> b) -> a -> b
$ Request -> ByteString
path Request
req
    , uriQuery :: String
uriQuery =
        case ByteString -> Maybe (Char, ByteString)
S8.uncons forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req of
            Just (Char
c, ByteString
_) | Char
c forall a. Eq a => a -> a -> Bool
/= Char
'?' -> Char
'?' forall a. a -> [a] -> [a]
: (ByteString -> String
S8.unpack forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req)
            Maybe (Char, ByteString)
_ -> ByteString -> String
S8.unpack 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) 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) forall a. Eq a => a -> a -> Bool
== Int
80 = String
""
      | Bool
otherwise = Char
':' forall a. a -> [a] -> [a]
: 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 -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> URI -> Maybe URIAuth
uriAuthority URI
uri
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char
':' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
userInfo)
    let (String
username, Char
':':String
password) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
':') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'@') forall a b. (a -> b) -> a -> b
$ String
userInfo
    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 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 :: forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
setUri Request
req URI
uri = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. String -> m a
throwInvalidUrlException 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 = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> HttpException
InvalidUrlException (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 <- forall {a}. IsString a => URI -> Either a Bool
parseScheme URI
uri
    URIAuth
auth <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
"URL must be absolute") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ URI -> Maybe URIAuth
uriAuthority URI
uri
    Int
port' <- forall {a}. IsString a => Bool -> URIAuth -> Either a Int
parsePort Bool
sec URIAuth
auth
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ URI -> Request -> Request
applyAnyUriBasedAuth URI
uri Request
req
        { host :: ByteString
host = String -> ByteString
S8.pack 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 forall a b. (a -> b) -> a -> b
$
                    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null 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 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 forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
scheme of
            String
"http:"  -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            String
"https:" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            String
_        -> 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 -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (forall a b. a -> Either a b
Left a
"Invalid port")
                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 -} -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
80
                    Bool
True {- HTTPS -} -> 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
        { 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 = forall a. Maybe a
Nothing
        , hostAddress :: Maybe HostAddress
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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , responseTimeout :: ResponseTimeout
responseTimeout = ResponseTimeout
ResponseTimeoutDefault
        , cookieJar :: Maybe CookieJar
cookieJar = forall a. a -> Maybe a
Just forall a. Monoid a => a
Data.Monoid.mempty
        , requestVersion :: HttpVersion
requestVersion = HttpVersion
W.http11
        , onRequestBodyException :: SomeException -> IO ()
onRequestBodyException = \SomeException
se ->
            case forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
se of
                Just (IOException
_ :: IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe IOException
Nothing -> forall e a. Exception e => e -> IO a
throwIO SomeException
se
        , requestManagerOverride :: Maybe Manager
requestManagerOverride = forall a. Maybe a
Nothing
        , shouldStripHeaderOnRedirect :: HeaderName -> Bool
shouldStripHeaderOnRedirect = forall a b. a -> b -> a
const Bool
False
        , shouldStripHeaderOnRedirectIfOnDifferentHostOnly :: Bool
shouldStripHeaderOnRedirectIfOnDifferentHostOnly = Bool
False
        , proxySecureMode :: ProxySecureMode
proxySecureMode = ProxySecureMode
ProxySecureWithConnect
        , redactHeaders :: Set HeaderName
redactHeaders = forall a. a -> Set a
Set.singleton HeaderName
"Authorization"
        , earlyHintHeadersReceived :: RequestHeaders -> IO ()
earlyHintHeadersReceived = \RequestHeaders
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }

-- | 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 = 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 = (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 forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req }
  where
    authHeader :: (HeaderName, ByteString)
authHeader = (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 forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req }
  where
    authHeader :: (HeaderName, ByteString)
authHeader = (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 = forall a. a -> Maybe a
Just 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 forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req }
  where
    authHeader :: (HeaderName, ByteString)
authHeader = (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")
      forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
x, ByteString
_) -> HeaderName
x 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return 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") forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RequestHeaders
hs'
     Bool -> Bool -> Bool
&& Request -> ByteString -> Bool
decompress Request
req (forall a. a -> Maybe a -> a
fromMaybe ByteString
"" forall a b. (a -> b) -> a -> b
$ 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
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 :: forall a. IO a -> IO a
encapsulatePopperException IO a
action =
    IO a
action forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\(SomeException
ex :: E.SomeException) -> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (IO () -> IO ()
checkBadSend IO ()
sendLater))
        else IO ()
sendNow forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  where
    expectContinue :: Bool
expectContinue   = forall a. a -> Maybe a
Just ByteString
"100-continue" forall a. Eq a => a -> a -> Bool
== 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 forall a. IO a -> [Handler a] -> IO a
`E.catches` [
        forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler (\(EncapsulatedPopperException SomeException
ex) -> forall e a. Exception e => e -> IO a
throwIO SomeException
ex)
      , 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int64 -> Builder
builder Maybe Int64
contentLength 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   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
lbs
            now :: IO ()
now   = IO () -> IO ()
checkBadSend 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
        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   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs
            now :: IO ()
now   = IO () -> IO ()
checkBadSend 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
        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 forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> Builder -> IO ()
writeHeadersWith (forall a. a -> Maybe a
Just Int64
len) Builder
body
            later :: IO ()
later = Builder -> IO ()
writeBuilder Builder
body
        forall (m :: * -> *) a. Monad m => a -> m a
return (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 = forall {t}. Maybe Int -> ((BodyReader -> IO ()) -> t) -> t
writeStream (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 (forall a. a -> Maybe a
Just Int64
len) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO ()
checkBadSend IO ()
body
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Int64
len, IO ()
now, IO ()
body)
    toTriple (RequestBodyStreamChunked GivesPopper ()
stream) = do
        let body :: IO ()
body = forall {t}. Maybe Int -> ((BodyReader -> IO ()) -> t) -> t
writeStream forall a. Maybe a
Nothing GivesPopper ()
stream
            now :: IO ()
now  = Maybe Int64 -> IO ()
flushHeaders forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO ()
checkBadSend IO ()
body
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, IO ()
now, IO ()
body)
    toTriple (RequestBodyIO IO RequestBody
mbody) = IO RequestBody
mbody 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 <- 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 Int
len -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
len forall a. Eq a => a -> a -> Bool
== Int
n) forall a b. (a -> b) -> a -> b
$ forall a. HttpExceptionContent -> IO a
throwHttp forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> HttpExceptionContent
WrongRequestBodyStreamSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
                else do
                    ByteString -> IO ()
connectionWrite forall a b. (a -> b) -> a -> b
$
                        if (forall a. Maybe a -> Bool
isNothing Maybe Int
mlen) -- Chunked
                            then [ByteString] -> ByteString
S.concat
                                [ String -> ByteString
S8.pack forall a b. (a -> b) -> a -> b
$ 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 forall a. Num a => a -> a -> a
+ (ByteString -> Int
S.length ByteString
bs)) BodyReader
stream

    hh :: ByteString
hh
        | Request -> Int
port Request
req 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 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 forall a. Semigroup a => a -> a -> a
<> String -> ByteString
S8.pack (Char
':' forall a. a -> [a] -> [a]
: 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 }) = forall a. Monoid a => a
mempty
    requestHostname (Request { proxy :: Request -> Maybe Proxy
proxy = Just Proxy
_,
                               secure :: Request -> Bool
secure = Bool
False }) =
            Builder
requestProtocol 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 }) = 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 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"GET", ByteString
"HEAD"] Bool -> Bool -> Bool
&& a
contentLength' forall a. Eq a => a -> a -> Bool
== a
0
                then forall a. a -> a
id
                else (:) (a
"Content-Length", String -> ByteString
S8.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
contentLength')
    contentLengthHeader Maybe a
Nothing = (:) (a
"Transfer-Encoding", ByteString
"chunked")

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

    hostHeader :: [(a, ByteString)] -> [(a, ByteString)]
hostHeader [(a, ByteString)]
x =
        case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
"Host" [(a, ByteString)]
x of
            Maybe ByteString
Nothing -> (a
"Host", ByteString
hh) 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
                = forall {a}.
(Eq a, IsString a) =>
[(a, ByteString)] -> [(a, ByteString)]
hostHeader
                forall a b. (a -> b) -> a -> b
$ RequestHeaders -> RequestHeaders
acceptEncodingHeader
                forall a b. (a -> b) -> a -> b
$ forall {a} {a}.
(Eq a, Num a, IsString a, Show a) =>
Maybe a -> [(a, ByteString)] -> [(a, ByteString)]
contentLengthHeader Maybe Int64
contentLength
                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)
            forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
" "
            forall a. Semigroup a => a -> a -> a
<> Request -> Builder
requestHostname Request
req
            forall a. Semigroup a => a -> a -> a
<> (case ByteString -> Maybe (Char, ByteString)
S8.uncons forall a b. (a -> b) -> a -> b
$ Request -> ByteString
path Request
req of
                    Just (Char
'/', ByteString
_) -> ByteString -> Builder
fromByteString forall a b. (a -> b) -> a -> b
$ Request -> ByteString
path Request
req
                    Maybe (Char, ByteString)
_ -> Char -> Builder
fromChar Char
'/' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString (Request -> ByteString
path Request
req))
            forall a. Semigroup a => a -> a -> a
<> (case ByteString -> Maybe (Char, ByteString)
S8.uncons forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req of
                    Maybe (Char, ByteString)
Nothing -> forall a. Monoid a => a
mempty
                    Just (Char
'?', ByteString
_) -> ByteString -> Builder
fromByteString forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req
                    Maybe (Char, ByteString)
_ -> Char -> Builder
fromChar Char
'?' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString (Request -> ByteString
queryString Request
req))
            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
' ' forall a. Semigroup a => a -> a -> a
<>
                        forall a. Show a => a -> Builder
fromShow HttpVersion
version forall a. Semigroup a => a -> a -> a
<>
                        ByteString -> Builder
fromByteString ByteString
"\r\n")
            forall a. Semigroup a => a -> a -> a
<> 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 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 (forall s. CI s -> s
CI.original HeaderName
k)
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
": "
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
v
        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
_ -> 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 = 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
_ -> 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hTell Handle
h
            StreamFileStatus -> IO ()
obs forall a b. (a -> b) -> a -> b
$ StreamFileStatus
                { fileSize :: Int64
fileSize = Int64
size
                , readSoFar :: Int64
readSoFar = Int64
currentPosition
                , thisChunkSize :: Int
thisChunkSize = ByteString -> Int
S.length ByteString
bs
                }
            forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs

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

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