{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE TupleSections      #-}
{-# LANGUAGE OverloadedStrings  #-}
-- | Simplified interface for common HTTP client interactions. Tutorial
-- available at
-- <https://haskell-lang.org/library/http-client>
--
-- Important note: 'H.Request' is an instance of 'Data.String.IsString', and
-- therefore recommended usage is to turn on @OverloadedStrings@, e.g.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import Network.HTTP.Simple
-- > import qualified Data.ByteString.Char8 as B8
-- >
-- > main :: IO ()
-- > main = httpBS "http://example.com" >>= B8.putStrLn . getResponseBody
--
-- The `Data.String.IsString` instance uses `H.parseRequest` behind the scenes and inherits its behavior.
module Network.HTTP.Simple
    ( -- * Perform requests
      httpBS
    , httpLBS
    , httpNoBody
#ifdef VERSION_aeson
    , httpJSON
    , httpJSONEither
#endif
    , httpSink
    , httpSource
    , withResponse
      -- * Types
    , H.Header
    , H.Query
    , H.QueryItem
    , H.Request
    , H.RequestHeaders
    , H.Response
    , H.ResponseHeaders
#ifdef VERSION_aeson
    , JSONException (..)
#endif
    , H.HttpException (..)
    , H.Proxy (..)
      -- * Request constructions
    , H.defaultRequest
    , H.parseRequest
    , H.parseRequest_
    , parseRequestThrow
    , parseRequestThrow_
      -- * Request lenses
      -- ** Basics
    , setRequestMethod
    , setRequestSecure
    , setRequestHost
    , setRequestPort
    , setRequestPath
    , addRequestHeader
    , getRequestHeader
    , setRequestHeader
    , setRequestHeaders
    , setRequestQueryString
    , getRequestQueryString
    , addToRequestQueryString
      -- ** Request body
    , setRequestBody
#ifdef VERSION_aeson
    , setRequestBodyJSON
#endif
    , setRequestBodyLBS
    , setRequestBodySource
    , setRequestBodyFile
    , setRequestBodyURLEncoded
      -- ** Special fields
    , H.setRequestIgnoreStatus
    , H.setRequestCheckStatus
    , setRequestBasicAuth
#if MIN_VERSION_http_client(0,7,6)
    , setRequestBearerAuth
#endif
    , setRequestManager
    , setRequestProxy
    , setRequestResponseTimeout
      -- * Response lenses
    , getResponseStatus
    , getResponseStatusCode
    , getResponseHeader
    , getResponseHeaders
    , getResponseBody
      -- * Alternate spellings
    , httpLbs
    ) where

import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Network.HTTP.Client as H
import qualified Network.HTTP.Client.Internal as HI
import qualified Network.HTTP.Client.TLS as H
import Network.HTTP.Client.Conduit (bodyReaderSource)
import qualified Network.HTTP.Client.Conduit as HC
import Control.Monad.IO.Unlift (MonadIO, liftIO, MonadUnliftIO, withRunInIO)

#ifdef VERSION_aeson
import Data.Aeson (FromJSON (..), Value)
import Data.Aeson.Parser (json')
import qualified Data.Aeson.Types as A
import qualified Data.Aeson as A
#endif

import qualified Data.Traversable as T
import Control.Exception (throw, throwIO, Exception)
import Data.Monoid
import Data.Typeable (Typeable)
import qualified Data.Conduit as C
import Data.Conduit (runConduit, (.|), ConduitM)
import qualified Data.Conduit.Attoparsec as C
import qualified Network.HTTP.Types as H
import Data.Int (Int64)
import Control.Monad.Trans.Resource (MonadResource, MonadThrow)
import qualified Control.Exception as E (bracket)
import Data.Void (Void)
import qualified Data.Attoparsec.ByteString as Atto
import qualified Data.Attoparsec.ByteString.Char8 as Atto8

-- | Perform an HTTP request and return the body as a @ByteString@.
--
-- @since 2.2.4
httpBS :: MonadIO m => H.Request -> m (H.Response S.ByteString)
httpBS :: Request -> m (Response ByteString)
httpBS Request
req = IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Manager
man <- IO Manager
H.getGlobalManager
    (ByteString -> ByteString)
-> Response ByteString -> Response ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
L.toStrict (Response ByteString -> Response ByteString)
-> IO (Response ByteString) -> IO (Response ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Request -> Manager -> IO (Response ByteString)
H.httpLbs Request
req Manager
man

-- | Perform an HTTP request and return the body as a lazy
-- @ByteString@. Note that the entire value will be read into memory
-- at once (no lazy I\/O will be performed). The advantage of a lazy
-- @ByteString@ here (versus using 'httpBS') is--if needed--a better
-- in-memory representation.
--
-- @since 2.1.10
httpLBS :: MonadIO m => H.Request -> m (H.Response L.ByteString)
httpLBS :: Request -> m (Response ByteString)
httpLBS Request
req = IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Manager
man <- IO Manager
H.getGlobalManager
    Request -> Manager -> IO (Response ByteString)
H.httpLbs Request
req Manager
man

-- | Perform an HTTP request and ignore the response body.
--
-- @since 2.2.2
httpNoBody :: MonadIO m => H.Request -> m (H.Response ())
httpNoBody :: Request -> m (Response ())
httpNoBody Request
req = IO (Response ()) -> m (Response ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ()) -> m (Response ()))
-> IO (Response ()) -> m (Response ())
forall a b. (a -> b) -> a -> b
$ do
    Manager
man <- IO Manager
H.getGlobalManager
    Request -> Manager -> IO (Response ())
H.httpNoBody Request
req Manager
man

#ifdef VERSION_aeson
-- | Perform an HTTP request and parse the body as JSON. In the event of an
-- JSON parse errors, a 'JSONException' runtime exception will be thrown.
--
-- NOTE: Depends on the @aeson@ cabal flag being enabled
--
-- @since 2.1.10
httpJSON :: (MonadIO m, FromJSON a) => H.Request -> m (H.Response a)
httpJSON :: Request -> m (Response a)
httpJSON Request
req = IO (Response a) -> m (Response a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response a) -> m (Response a))
-> IO (Response a) -> m (Response a)
forall a b. (a -> b) -> a -> b
$ Request -> IO (Response (Either JSONException a))
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response (Either JSONException a))
httpJSONEither Request
req IO (Response (Either JSONException a))
-> (Response (Either JSONException a) -> IO (Response a))
-> IO (Response a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either JSONException a -> IO a)
-> Response (Either JSONException a) -> IO (Response a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM ((JSONException -> IO a)
-> (a -> IO a) -> Either JSONException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either JSONException -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | Perform an HTTP request and parse the body as JSON. In the event of an
-- JSON parse errors, a @Left@ value will be returned.
--
-- NOTE: Depends on the @aeson@ cabal flag being enabled
--
-- @since 2.1.10
httpJSONEither :: (MonadIO m, FromJSON a)
               => H.Request
               -> m (H.Response (Either JSONException a))
httpJSONEither :: Request -> m (Response (Either JSONException a))
httpJSONEither Request
req = IO (Response (Either JSONException a))
-> m (Response (Either JSONException a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response (Either JSONException a))
 -> m (Response (Either JSONException a)))
-> IO (Response (Either JSONException a))
-> m (Response (Either JSONException a))
forall a b. (a -> b) -> a -> b
$ Request
-> (Response ()
    -> ConduitM ByteString Void IO (Response (Either JSONException a)))
-> IO (Response (Either JSONException a))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Request -> (Response () -> ConduitM ByteString Void m a) -> m a
httpSink Request
req' Response ()
-> ConduitM ByteString Void IO (Response (Either JSONException a))
forall (m :: * -> *) b o.
(Monad m, FromJSON b) =>
Response ()
-> ConduitT ByteString o m (Response (Either JSONException b))
sink
  where
    req' :: Request
req' = HeaderName -> ByteString -> Request -> Request
addRequestHeader HeaderName
H.hAccept ByteString
"application/json" Request
req
    sink :: Response ()
-> ConduitT ByteString o m (Response (Either JSONException b))
sink Response ()
orig = (Either JSONException b -> Response (Either JSONException b))
-> ConduitT ByteString o m (Either JSONException b)
-> ConduitT ByteString o m (Response (Either JSONException b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Either JSONException b
x -> (() -> Either JSONException b)
-> Response () -> Response (Either JSONException b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either JSONException b -> () -> Either JSONException b
forall a b. a -> b -> a
const Either JSONException b
x) Response ()
orig) (ConduitT ByteString o m (Either JSONException b)
 -> ConduitT ByteString o m (Response (Either JSONException b)))
-> ConduitT ByteString o m (Either JSONException b)
-> ConduitT ByteString o m (Response (Either JSONException b))
forall a b. (a -> b) -> a -> b
$ do
        Either ParseError Value
eres1 <- Parser ByteString Value
-> ConduitT ByteString o m (Either ParseError Value)
forall a (m :: * -> *) b o.
(AttoparsecInput a, Monad m) =>
Parser a b -> ConduitT a o m (Either ParseError b)
C.sinkParserEither (Parser ByteString Value
json' Parser ByteString Value
-> Parser ByteString () -> Parser ByteString Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ByteString ()
Atto8.skipSpace Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
forall t. Chunk t => Parser t ()
Atto.endOfInput))

        case Either ParseError Value
eres1 of
            Left ParseError
e -> Either JSONException b
-> ConduitT ByteString o m (Either JSONException b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either JSONException b
 -> ConduitT ByteString o m (Either JSONException b))
-> Either JSONException b
-> ConduitT ByteString o m (Either JSONException b)
forall a b. (a -> b) -> a -> b
$ JSONException -> Either JSONException b
forall a b. a -> Either a b
Left (JSONException -> Either JSONException b)
-> JSONException -> Either JSONException b
forall a b. (a -> b) -> a -> b
$ Request -> Response () -> ParseError -> JSONException
JSONParseException Request
req' Response ()
orig ParseError
e
            Right Value
value ->
                case Value -> Result b
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
                    A.Error String
e -> Either JSONException b
-> ConduitT ByteString o m (Either JSONException b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either JSONException b
 -> ConduitT ByteString o m (Either JSONException b))
-> Either JSONException b
-> ConduitT ByteString o m (Either JSONException b)
forall a b. (a -> b) -> a -> b
$ JSONException -> Either JSONException b
forall a b. a -> Either a b
Left (JSONException -> Either JSONException b)
-> JSONException -> Either JSONException b
forall a b. (a -> b) -> a -> b
$ Request -> Response Value -> String -> JSONException
JSONConversionException
                        Request
req' ((() -> Value) -> Response () -> Response Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> () -> Value
forall a b. a -> b -> a
const Value
value) Response ()
orig) String
e
                    A.Success b
x -> Either JSONException b
-> ConduitT ByteString o m (Either JSONException b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either JSONException b
 -> ConduitT ByteString o m (Either JSONException b))
-> Either JSONException b
-> ConduitT ByteString o m (Either JSONException b)
forall a b. (a -> b) -> a -> b
$ b -> Either JSONException b
forall a b. b -> Either a b
Right b
x

-- | An exception that can occur when parsing JSON
--
-- NOTE: Depends on the @aeson@ cabal flag being enabled
--
-- @since 2.1.10
data JSONException
    = JSONParseException H.Request (H.Response ()) C.ParseError
    | JSONConversionException H.Request (H.Response Value) String
  deriving (Int -> JSONException -> ShowS
[JSONException] -> ShowS
JSONException -> String
(Int -> JSONException -> ShowS)
-> (JSONException -> String)
-> ([JSONException] -> ShowS)
-> Show JSONException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONException] -> ShowS
$cshowList :: [JSONException] -> ShowS
show :: JSONException -> String
$cshow :: JSONException -> String
showsPrec :: Int -> JSONException -> ShowS
$cshowsPrec :: Int -> JSONException -> ShowS
Show, Typeable)
instance Exception JSONException
#endif

-- | Perform an HTTP request and consume the body with the given 'C.Sink'
--
-- @since 2.1.10
httpSink :: MonadUnliftIO m
         => H.Request
         -> (H.Response () -> ConduitM S.ByteString Void m a)
         -> m a
httpSink :: Request -> (Response () -> ConduitM ByteString Void m a) -> m a
httpSink Request
req Response () -> ConduitM ByteString Void m a
sink = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
    Manager
man <- IO Manager
H.getGlobalManager
    IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> (Response BodyReader -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
        (Request -> Manager -> IO (Response BodyReader)
H.responseOpen Request
req Manager
man)
        Response BodyReader -> IO ()
forall a. Response a -> IO ()
H.responseClose
        ((Response BodyReader -> IO a) -> IO a)
-> (Response BodyReader -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Response BodyReader
res -> m a -> IO a
forall a. m a -> IO a
run
            (m a -> IO a) -> m a -> IO a
forall a b. (a -> b) -> a -> b
$ ConduitT () Void m a -> m a
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit
            (ConduitT () Void m a -> m a) -> ConduitT () Void m a -> m a
forall a b. (a -> b) -> a -> b
$ BodyReader -> ConduitM () ByteString m ()
forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource (Response BodyReader -> BodyReader
forall a. Response a -> a
getResponseBody Response BodyReader
res)
           ConduitM () ByteString m ()
-> ConduitM ByteString Void m a -> ConduitT () Void m a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Response () -> ConduitM ByteString Void m a
sink ((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)

-- | Perform an HTTP request, and get the response body as a Source.
--
-- The second argument to this function tells us how to make the
-- Source from the Response itself. This allows you to perform actions
-- with the status or headers, for example, in addition to the raw
-- bytes themselves. If you just care about the response body, you can
-- use 'getResponseBody' as the second argument here.
--
-- @
-- \{\-# LANGUAGE OverloadedStrings \#\-}
-- import           Control.Monad.IO.Class       (liftIO)
-- import           Control.Monad.Trans.Resource (runResourceT)
-- import           Data.Conduit                 (($$))
-- import qualified Data.Conduit.Binary          as CB
-- import qualified Data.Conduit.List            as CL
-- import           Network.HTTP.Simple
-- import           System.IO                    (stdout)
--
-- main :: IO ()
-- main =
--     runResourceT
--         $ httpSource "http://httpbin.org/robots.txt" getSrc
--        $$ CB.sinkHandle stdout
--   where
--     getSrc res = do
--         liftIO $ print (getResponseStatus res, getResponseHeaders res)
--         getResponseBody res
-- @
--
-- @since 2.2.1
httpSource :: (MonadResource m, MonadIO n)
           => H.Request
           -> (H.Response (C.ConduitM i S.ByteString n ())
                -> C.ConduitM i o m r)
           -> C.ConduitM i o m r
httpSource :: Request
-> (Response (ConduitM i ByteString n ()) -> ConduitM i o m r)
-> ConduitM i o m r
httpSource Request
req Response (ConduitM i ByteString n ()) -> ConduitM i o m r
withRes = do
    Manager
man <- IO Manager -> ConduitT i o m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Manager
H.getGlobalManager
    IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> (Response BodyReader -> ConduitM i o m r)
-> ConduitM i o m r
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
C.bracketP (Request -> Manager -> IO (Response BodyReader)
H.responseOpen Request
req Manager
man) Response BodyReader -> IO ()
forall a. Response a -> IO ()
H.responseClose
        (Response (ConduitM i ByteString n ()) -> ConduitM i o m r
withRes (Response (ConduitM i ByteString n ()) -> ConduitM i o m r)
-> (Response BodyReader -> Response (ConduitM i ByteString n ()))
-> Response BodyReader
-> ConduitM i o m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyReader -> ConduitM i ByteString n ())
-> Response BodyReader -> Response (ConduitM i ByteString n ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BodyReader -> ConduitM i ByteString n ()
forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource)

-- | Perform an action with the given request. This employes the
-- bracket pattern.
--
-- This is similar to 'httpSource', but does not require
-- 'MonadResource' and allows the result to not contain a 'C.ConduitM'
-- value.
--
-- @since 2.2.3
withResponse :: (MonadUnliftIO m, MonadIO n)
             => H.Request
             -> (H.Response (C.ConduitM i S.ByteString n ()) -> m a)
             -> m a
withResponse :: Request -> (Response (ConduitM i ByteString n ()) -> m a) -> m a
withResponse Request
req Response (ConduitM i ByteString n ()) -> m a
withRes = ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
    Manager
man <- IO Manager
H.getGlobalManager
    IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> (Response BodyReader -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
        (Request -> Manager -> IO (Response BodyReader)
H.responseOpen Request
req Manager
man)
        Response BodyReader -> IO ()
forall a. Response a -> IO ()
H.responseClose
        (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (Response BodyReader -> m a) -> Response BodyReader -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (ConduitM i ByteString n ()) -> m a
withRes (Response (ConduitM i ByteString n ()) -> m a)
-> (Response BodyReader -> Response (ConduitM i ByteString n ()))
-> Response BodyReader
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyReader -> ConduitM i ByteString n ())
-> Response BodyReader -> Response (ConduitM i ByteString n ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BodyReader -> ConduitM i ByteString n ()
forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource)

-- | Same as 'parseRequest', except will throw an 'HttpException' in the
-- event of a non-2XX response. This uses 'throwErrorStatusCodes' to
-- implement 'checkResponse'.
--
-- Exactly the same as 'parseUrlThrow', but has a name that is more
-- consistent with the other parseRequest functions.
--
-- @since 2.3.2
parseRequestThrow :: MonadThrow m => String -> m HC.Request
parseRequestThrow :: String -> m Request
parseRequestThrow = String -> m Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HC.parseUrlThrow

-- | Same as 'parseRequestThrow', but parse errors cause an impure
-- exception. Mostly useful for static strings which are known to be
-- correctly formatted.
--
-- @since 2.3.2
parseRequestThrow_ :: String -> HC.Request
parseRequestThrow_ :: String -> Request
parseRequestThrow_ = (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
HC.parseUrlThrow

-- | Alternate spelling of 'httpLBS'
--
-- @since 2.1.10
httpLbs :: MonadIO m => H.Request -> m (H.Response L.ByteString)
httpLbs :: Request -> m (Response ByteString)
httpLbs = Request -> m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS

-- | Set the request method
--
-- @since 2.1.10
setRequestMethod :: S.ByteString -> H.Request -> H.Request
setRequestMethod :: ByteString -> Request -> Request
setRequestMethod ByteString
x Request
req = Request
req { method :: ByteString
H.method = ByteString
x }

-- | Set whether this is a secure/HTTPS (@True@) or insecure/HTTP
-- (@False@) request
--
-- @since 2.1.10
setRequestSecure :: Bool -> H.Request -> H.Request
setRequestSecure :: Bool -> Request -> Request
setRequestSecure Bool
x Request
req = Request
req { secure :: Bool
H.secure = Bool
x }

-- | Set the destination host of the request
--
-- @since 2.1.10
setRequestHost :: S.ByteString -> H.Request -> H.Request
setRequestHost :: ByteString -> Request -> Request
setRequestHost ByteString
x Request
r = Request
r { host :: ByteString
H.host = ByteString
x }

-- | Set the destination port of the request
--
-- @since 2.1.10
setRequestPort :: Int -> H.Request -> H.Request
setRequestPort :: Int -> Request -> Request
setRequestPort Int
x Request
r = Request
r { port :: Int
H.port = Int
x }

-- | Lens for the requested path info of the request
--
-- @since 2.1.10
setRequestPath :: S.ByteString -> H.Request -> H.Request
setRequestPath :: ByteString -> Request -> Request
setRequestPath ByteString
x Request
r = Request
r { path :: ByteString
H.path = ByteString
x }

-- | Add a request header name/value combination
--
-- @since 2.1.10
addRequestHeader :: H.HeaderName -> S.ByteString -> H.Request -> H.Request
addRequestHeader :: HeaderName -> ByteString -> Request -> Request
addRequestHeader HeaderName
name ByteString
val Request
req =
    Request
req { requestHeaders :: RequestHeaders
H.requestHeaders = (HeaderName
name, ByteString
val) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
H.requestHeaders Request
req }

-- | Get all request header values for the given name
--
-- @since 2.1.10
getRequestHeader :: H.HeaderName -> H.Request -> [S.ByteString]
getRequestHeader :: HeaderName -> Request -> [ByteString]
getRequestHeader HeaderName
name =
    ((HeaderName, ByteString) -> ByteString)
-> RequestHeaders -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (RequestHeaders -> [ByteString])
-> (Request -> RequestHeaders) -> Request -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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
name) (RequestHeaders -> RequestHeaders)
-> (Request -> RequestHeaders) -> Request -> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> RequestHeaders
H.requestHeaders

-- | Set the given request header to the given list of values. Removes any
-- previously set header values with the same name.
--
-- @since 2.1.10
setRequestHeader :: H.HeaderName -> [S.ByteString] -> H.Request -> H.Request
setRequestHeader :: HeaderName -> [ByteString] -> Request -> Request
setRequestHeader HeaderName
name [ByteString]
vals Request
req =
    Request
req { requestHeaders :: RequestHeaders
H.requestHeaders =
            ((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
name) (Request -> RequestHeaders
H.requestHeaders Request
req)
         RequestHeaders -> RequestHeaders -> RequestHeaders
forall a. [a] -> [a] -> [a]
++ ((ByteString -> (HeaderName, ByteString))
-> [ByteString] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName
name, ) [ByteString]
vals)
        }

-- | Set the request headers, wiping out __all__ previously set headers. This
-- means if you use 'setRequestHeaders' to set some headers and also use one of
-- the other setters that modifies the @content-type@ header (such as
-- 'setRequestBodyJSON'), be sure that 'setRequestHeaders' is evaluated
-- __first__.
--
-- @since 2.1.10
setRequestHeaders :: H.RequestHeaders -> H.Request -> H.Request
setRequestHeaders :: RequestHeaders -> Request -> Request
setRequestHeaders RequestHeaders
x Request
req = Request
req { requestHeaders :: RequestHeaders
H.requestHeaders = RequestHeaders
x }

-- | Get the query string parameters
--
-- @since 2.1.10
getRequestQueryString :: H.Request -> H.Query
getRequestQueryString :: Request -> Query
getRequestQueryString = ByteString -> Query
H.parseQuery (ByteString -> Query)
-> (Request -> ByteString) -> Request -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
H.queryString

-- | Set the query string parameters
--
-- @since 2.1.10
setRequestQueryString :: H.Query -> H.Request -> H.Request
setRequestQueryString :: Query -> Request -> Request
setRequestQueryString = Query -> Request -> Request
H.setQueryString

-- | Add to the existing query string parameters.
--
-- @since 2.3.5
addToRequestQueryString :: H.Query -> H.Request -> H.Request
addToRequestQueryString :: Query -> Request -> Request
addToRequestQueryString Query
additions Request
req = Query -> Request -> Request
setRequestQueryString Query
q Request
req
    where q :: Query
q = Query
additions Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Request -> Query
getRequestQueryString Request
req

-- | Set the request body to the given 'H.RequestBody'. You may want to
-- consider using one of the convenience functions in the modules, e.g.
-- 'requestBodyJSON'.
--
-- /Note/: This will not modify the request method. For that, please use
-- 'requestMethod'. You likely don't want the default of @GET@.
--
-- @since 2.1.10
setRequestBody :: H.RequestBody -> H.Request -> H.Request
setRequestBody :: RequestBody -> Request -> Request
setRequestBody RequestBody
x Request
req = Request
req { requestBody :: RequestBody
H.requestBody = RequestBody
x }

#ifdef VERSION_aeson
-- | Set the request body as a JSON value
--
-- /Note/: This will not modify the request method. For that, please use
-- 'requestMethod'. You likely don't want the default of @GET@.
--
-- This also sets the @Content-Type@ to @application/json; charset=utf-8@
--
-- NOTE: Depends on the @aeson@ cabal flag being enabled
--
-- @since 2.1.10
setRequestBodyJSON :: A.ToJSON a => a -> H.Request -> H.Request
setRequestBodyJSON :: a -> Request -> Request
setRequestBodyJSON a
x Request
req =
    Request
req { requestHeaders :: RequestHeaders
H.requestHeaders
            = (HeaderName
H.hContentType, ByteString
"application/json; charset=utf-8")
            (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: ((HeaderName, ByteString) -> Bool)
-> RequestHeaders -> RequestHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
y, ByteString
_) -> HeaderName
y HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
H.hContentType) (Request -> RequestHeaders
H.requestHeaders Request
req)
        , requestBody :: RequestBody
H.requestBody = ByteString -> RequestBody
H.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
x
        }
#endif

-- | Set the request body as a lazy @ByteString@
--
-- /Note/: This will not modify the request method. For that, please use
-- 'requestMethod'. You likely don't want the default of @GET@.
--
-- @since 2.1.10
setRequestBodyLBS :: L.ByteString -> H.Request -> H.Request
setRequestBodyLBS :: ByteString -> Request -> Request
setRequestBodyLBS = RequestBody -> Request -> Request
setRequestBody (RequestBody -> Request -> Request)
-> (ByteString -> RequestBody) -> ByteString -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RequestBody
H.RequestBodyLBS

-- | Set the request body as a 'C.Source'
--
-- /Note/: This will not modify the request method. For that, please use
-- 'requestMethod'. You likely don't want the default of @GET@.
--
-- @since 2.1.10
setRequestBodySource :: Int64 -- ^ length of source
                     -> ConduitM () S.ByteString IO ()
                     -> H.Request
                     -> H.Request
setRequestBodySource :: Int64 -> ConduitM () ByteString IO () -> Request -> Request
setRequestBodySource Int64
len ConduitM () ByteString IO ()
src Request
req = Request
req { requestBody :: RequestBody
H.requestBody = Int64 -> ConduitM () ByteString IO () -> RequestBody
HC.requestBodySource Int64
len ConduitM () ByteString IO ()
src }

-- | Set the request body as a file
--
-- /Note/: This will not modify the request method. For that, please use
-- 'requestMethod'. You likely don't want the default of @GET@.
--
-- @since 2.1.10
setRequestBodyFile :: FilePath -> H.Request -> H.Request
setRequestBodyFile :: String -> Request -> Request
setRequestBodyFile = RequestBody -> Request -> Request
setRequestBody (RequestBody -> Request -> Request)
-> (String -> RequestBody) -> String -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO RequestBody -> RequestBody
HI.RequestBodyIO (IO RequestBody -> RequestBody)
-> (String -> IO RequestBody) -> String -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO RequestBody
H.streamFile

-- | Set the request body as URL encoded data
--
-- /Note/: This will change the request method to @POST@ and set the @content-type@
-- to @application/x-www-form-urlencoded@
--
-- @since 2.1.10
setRequestBodyURLEncoded :: [(S.ByteString, S.ByteString)] -> H.Request -> H.Request
setRequestBodyURLEncoded :: [(ByteString, ByteString)] -> Request -> Request
setRequestBodyURLEncoded = [(ByteString, ByteString)] -> Request -> Request
H.urlEncodedBody

-- | Set basic auth with the given username and password
--
-- @since 2.1.10
setRequestBasicAuth :: S.ByteString -- ^ username
                    -> S.ByteString -- ^ password
                    -> H.Request
                    -> H.Request
setRequestBasicAuth :: ByteString -> ByteString -> Request -> Request
setRequestBasicAuth = ByteString -> ByteString -> Request -> Request
H.applyBasicAuth

#if MIN_VERSION_http_client(0,7,6)
-- | Set bearer auth with the given token
--
-- @since 2.3.8
setRequestBearerAuth :: S.ByteString -- ^ token
                    -> H.Request
                    -> H.Request
setRequestBearerAuth :: ByteString -> Request -> Request
setRequestBearerAuth = ByteString -> Request -> Request
H.applyBearerAuth
#endif

-- | Instead of using the default global 'H.Manager', use the supplied
-- @Manager@.
--
-- @since 2.1.10
setRequestManager :: H.Manager -> H.Request -> H.Request
setRequestManager :: Manager -> Request -> Request
setRequestManager Manager
x Request
req = Request
req { requestManagerOverride :: Maybe Manager
HI.requestManagerOverride = Manager -> Maybe Manager
forall a. a -> Maybe a
Just Manager
x }

-- | Override the default proxy server settings
--
-- @since 2.1.10
setRequestProxy :: Maybe H.Proxy -> H.Request -> H.Request
setRequestProxy :: Maybe Proxy -> Request -> Request
setRequestProxy Maybe Proxy
x Request
req = Request
req { proxy :: Maybe Proxy
H.proxy = Maybe Proxy
x }

-- | Set the maximum time to wait for a response
--
-- @since 2.3.8
setRequestResponseTimeout :: H.ResponseTimeout -> H.Request -> H.Request
setRequestResponseTimeout :: ResponseTimeout -> Request -> Request
setRequestResponseTimeout ResponseTimeout
x Request
req = Request
req { responseTimeout :: ResponseTimeout
H.responseTimeout = ResponseTimeout
x }

-- | Get the status of the response
--
-- @since 2.1.10
getResponseStatus :: H.Response a -> H.Status
getResponseStatus :: Response a -> Status
getResponseStatus = Response a -> Status
forall body. Response body -> Status
H.responseStatus

-- | Get the integral status code of the response
--
-- @since 2.1.10
getResponseStatusCode :: H.Response a -> Int
getResponseStatusCode :: Response a -> Int
getResponseStatusCode = Status -> Int
H.statusCode (Status -> Int) -> (Response a -> Status) -> Response a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> Status
forall body. Response body -> Status
getResponseStatus

-- | Get all response header values with the given name
--
-- @since 2.1.10
getResponseHeader :: H.HeaderName -> H.Response a -> [S.ByteString]
getResponseHeader :: HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
name = ((HeaderName, ByteString) -> ByteString)
-> RequestHeaders -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (RequestHeaders -> [ByteString])
-> (Response a -> RequestHeaders) -> Response a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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
name) (RequestHeaders -> RequestHeaders)
-> (Response a -> RequestHeaders) -> Response a -> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> RequestHeaders
forall body. Response body -> RequestHeaders
H.responseHeaders

-- | Get all response headers
--
-- @since 2.1.10
getResponseHeaders :: H.Response a -> [(H.HeaderName, S.ByteString)]
getResponseHeaders :: Response a -> RequestHeaders
getResponseHeaders = Response a -> RequestHeaders
forall body. Response body -> RequestHeaders
H.responseHeaders

-- | Get the response body
--
-- @since 2.1.10
getResponseBody :: H.Response a -> a
getResponseBody :: Response a -> a
getResponseBody = Response a -> a
forall a. Response a -> a
H.responseBody