req 0.2.0 → 3.13.4

raw patch · 8 files changed

Files

• CHANGELOG.md +239/−6
• LICENSE.md +1/−1
• Network/HTTP/Req.hs +2052/−1422
• README.md +63/−162
• Setup.hs +0/−6
• httpbin-tests/Network/HTTP/ReqSpec.hs +346/−228
• pure-tests/Network/HTTP/ReqSpec.hs +382/−214
• req.cabal +116/−121

@@ -1,11 +1,244 @@+## Req 3.13.4++* Fixed empty ciphersuite list when compiling against `tls < 2.0.6`+  (see [PR 175](https://github.com/mrkkrp/req/pull/175)). As a side effect, now+  compatible with older versions of `crypton-connection` (>= 0.3).++## Req 3.13.3++* Works with `crypton-connection-0.4` and newer.++## Req 3.13.2++* Disable the problematic `httpbin-tests` test suite by default. Only enable+  it when the `dev` flag is enabled. In that case it is expected that an+  httpbin server is run locally at `localhost:1234`.++## Req 3.13.1++* Switched the non-pure test suite to use https://httpbun.org instead of+  https://httpbin.org since the latter proved to be highly unreliable+  lately.++* Switched from `connection` to `crypton-connection`.++* Builds with GHC 9.6.1.++## Req 3.13.0++* Add `headerRedacted` function to add header fields, which will be with+  redacted values on print.++## Req 3.12.0++* Add `isStatusCodeException` function.+* Add `instance HttpResponse (Network.HTTP.Client.Response ())`.++## Req 3.11.0++* Add the `queryParamToList` method to the `QueryParam` type class.+* Add the `formToQuery` function. [Issue 126](https://github.com/mrkkrp/req/issues/126).+* Add `FromForm` instances (in the `Web.FormUrlEncoded` module) to the+  `Option` and `FormUrlEncodedParam` types.++## Req 3.10.0++* Add `MonadHttp` instances for `transformers` types.++## Req 3.9.2++* The test suite works with `aeson-2.x.x.x`.++## Req 3.9.1++* Builds with GHC 9.0.++## Req 3.9.0++* The `useHttpURI` and `useHttpsURI` functions now preserve trailing+  slashes.++## Req 3.8.0++* Adjusted the value of the `httpConfigRetryJudgeException` field of+  `defaultHttpConfig` to retry on response timeouts and connection timeouts.++## Req 3.7.0++* Added `reqCb`, a function that allows you to modify the `Request` object+  but otherwise performs the requst for you.++* Derived `MonadThrow`, `MonadCatch`, and `MonadMask` for the `Req` monad.++## Req 3.6.0++* Added the `httpConfigBodyPreviewLength` configuration parameter to+  `HttpConfig`.++## Req 3.5.0++* Made `Req` an instance of `MonadUnliftIO`. [Issue+  100](https://github.com/mrkkrp/req/issues/100).++## Req 3.4.0++* Requests using `DELETE` method can now have a body. [Issue+  89](https://github.com/mrkkrp/req/issues/89).++* Added the `httpConfigRetryJudgeException` field to `HttpConfig` so that+  requests that result in exceptions can be retried. [Issue+  93](https://github.com/mrkkrp/req/issues/93).++* Added the function `renderUrl`. [Issue+  83](https://github.com/mrkkrp/req/issues/83).++## Req 3.3.0++* Derived `Show` instances for response types `IgnoreResponse`,+  `JsonResponse`, `BsResponse`, and `LbsResponse`.++## Req 3.2.0++* Made the tests pass with `http-client-0.7` and later.++* Added a quasiquoter for URL creation, `urlQ`.++## Req 3.1.0++* Changed signature of `httpConfigRetryPolicy` to `RetryPolicyM IO`.++## Req 3.0.0++* Dropped functions `parseUrlHttp`, `parseUrlHttps`, and `parseUrl`. Instead+  we now have `useHttpURI`, `useHttpsURI`, and `useURI` take `URI`s from+  `modern-uri` as their argument. You first parse your URL with the+  `modern-uri` package and then pass it to those functions. This allows us+  to work with typed URI representations and seamlessly convert them to+  something `req` can work with. As a side effect basic auth from the `URI`s+  is now taken into consideration. In the future we may also start to+  respect fragments if `http-client` starts to support this.++* Dropped support for GHC 8.2 and older.++## Req 2.1.0++* Dropped support for GHC 7.10.++* Added the new `acceptHeader` method to the `HttpResponse` type class.+  Notably, the `jsonResponse` method now sets `"Accept"` header to+  `"application/json"`.++## Req 2.0.1++* Fixed the `httpbin` tests (they changed something on the server again).++## Req 2.0.0++* Got rid of `data-default-class` dependency, now we export+  `defaultHttpConfig` instead.++## Req 1.2.1++* Fixed a typo in the type signature of `parseUrl`.++## Req 1.2.0++* Added the `parseUrl` function.++## Req 1.1.0++* Added `customAuth` and `attachHeader` to facilitate creation of custom+  authentication options.++* Added `basicProxyAuth` authentication option.++## Req 1.0.0++* Added the `reqBr` function allowing to consume `Response BodyReader`+  without using a pre-defined instance of `HttpResponse`, in a custom way.++* Now streaming of response body does not happen until we've checked headers+  and status code with `httpConfigCheckResponse`. It also doesn't happen on+  every retry. Streaming and obtaining of final response value happens only+  once when we're happy with everything.++  Previously we first tried to consume and interpret response body before+  checking status code and determining whether we should retry the request.+  This was not good, because we could expect a JSON response but get a+  response with status code 500, and then still we would try to parse it as+  JSON first before letting `httpConfigCheckResponse` throw an exception.++  The corrected behavior should also make retrying more efficient.++* Changed signatures of several fields of `HttpConfig`:+  `httpConfigCheckResponse`, `httpConfigRetryPolicy`, and+  `httpConfigRetryJudge` in order to eliminate redundant `IO` and prevent+  the possibility that these functions could start consuming `BodyReader`.++* Removed the `makeResponsePreview` method from the `HttpResponse` type+  class. Preview business is handled by the library automatically on a lower+  level now. Users do not need to concern themselves with such stuff.++* Changed the type signature of the `getHttpResponse` method of the+  `HttpResponse` type class. Previously it left too much freedom (and+  responsibility) to implementers of the method. In fact, we now limit what+  `getHttpResponse` does to just consuming and interpreting `Response+  BodyReader`, so we can properly control details of connection+  opening/closing etc., for the user.++* Dropped support for GHC 7.8.++* Minor documentation improvements.++## Req 0.5.0++* Changed the signature of the `makeResponseBodyPreview` from `response ->+  IO ByteString` to `response -> ByteString`.++* Minor documentation improvements.++## Req 0.4.0++* Added the `Req` monad and `runReq` function to run it. This allows to use+  `req` without defining new (orphan) instances.++## Req 0.3.1++* Added `basicAuthUnsafe`.++## Req 0.3.0++* Made URL parsing functions `parseUrlHttp` and `parseUrlHttps` recognize+  port numbers.++* Added `req'` function that allows to perform requests via a callback that+  receives pre-constructed request and manager.++* Removed the `ReturnRequest` HTTP response implementation as it was not+  quite safe and was not going to work with retrying. Use `req'` instead for+  “pure” testing.++* Changed the type of `httpConfigCheckResponse`, so the second argument can+  be any instance of `HttpResponse`.++* Added built-in automatic retrying. See `httpConfigRetryPolicy` and+  `httpConfigRetryJudge` in `HttpConfig`. The default configuration retries+  5 times on request timeouts.++* Added the `makeResponseBodyPreview` method to the `HttpResponse` type+  class that allows to specify how to build a “preview” of response body for+  inclusion into exceptions.++* Improved wording in the documentation and `README.md`.+ ## Req 0.2.0 -* Added support for multipart form data in form of `ReqBodyMultipart` body-  option and `reqBodyMultipart` helper function. This also required a change-  in type signature of `getRequestContentType`, which now takes `body`, not-  `Proxy body` because we need to extract boundary from `body` and put it-  into `Content-Type` header. This change, however, shouldn't be too-  dangerous for end-users.+* Added support for multipart form data in the form of `ReqBodyMultipart`+  body option and `reqBodyMultipart` helper function. This also required a+  change in the type signature of `getRequestContentType`, which now takes+  `body`, not `Proxy body` because we need to extract boundary from `body`+  and put it into `Content-Type` header. This change, however, shouldn't be+  too dangerous for end-users.  * Added support for OAuth 1.0 authentication via `oAuth1` option. 

@@ -1,4 +1,4 @@-Copyright © 2016–2017 Mark Karpov+Copyright © 2016–present Mark Karpov  All rights reserved. 

@@ -1,1422 +1,2052 @@--- |--- Module      :  Network.HTTP.Req--- Copyright   :  © 2016–2017 Mark Karpov--- License     :  BSD 3 clause------ Maintainer  :  Mark Karpov <markkarpov@openmailbox.org>--- Stability   :  experimental--- Portability :  portable------ The documentation below is structured in such a way that most important--- information goes first: you learn how to do HTTP requests, then how to--- embed them in any monad you have, then it goes on giving you details--- about less-common things you may want to know about. The documentation is--- written with sufficient coverage of details and examples, it's designed--- to be a complete tutorial on its own.------ /(A modest intro goes here, click on 'req' to start making requests.)/------ === About the library------ This is an easy-to-use, type-safe, expandable, high-level HTTP library--- that just works without any fooling around.------ What does the “easy-to-use” phrase mean? It means that the library is--- designed to be beginner-friendly, so it's simple to add it to your monad--- stack, intuitive to work with, well-documented, and does not get in your--- way. Doing HTTP requests is a common task and Haskell library for this--- should be very approachable and clear to beginners, thus certain--- compromises were made. For example, one cannot currently modify--- 'L.ManagerSettings' of default manager because the library always uses--- the same implicit global manager for simplicity and maximal connection--- sharing. There is a way to use your own manager with different settings,--- but it requires a bit more typing.------ “Type-safe” means that the library is protective and eliminates certain--- class of errors. For example, we have correct-by-construction 'Url's,--- it's guaranteed that user does not send request body when using methods--- like 'GET' or 'OPTIONS', amount of implicit assumptions is minimized by--- making user specify his\/her intentions in explicit form (for example,--- it's not possible to avoid specifying body or method of a request).--- Authentication methods that assume TLS force user to use TLS on type--- level. The library carefully hides underlying types from lower-level--- @http-client@ package because it's not safe enough (for example--- 'L.Request' is an instance of 'Data.String.IsString' and if it's--- malformed, it will blow up at run-time).------ “Expandable” refers to the ability of the library to be expanded without--- ugly hacking. For example, it's possible to define your own HTTP methods,--- new ways to construct body of request, new authorization options, new--- ways to actually perform request and how to represent\/parse response. As--- user extends the library to satisfy his\/her special needs, the new--- solutions work just like built-ins. That said, all common cases are--- covered by the library out-of-the-box.------ “High-level” means that there are less details to worry about. The--- library is a result of my experiences as a Haskell consultant, working--- for several clients who have very different projects and so the library--- adapts easily to any particular style of writing Haskell applications.--- For example, some people prefer throwing exceptions, while others are--- concerned with purity: just define 'handleHttpException' accordingly when--- making your monad instance of 'MonadHttp' and it will play seamlessly.--- Finally, the library cuts boilerplate considerably and helps write--- concise, easy to read and maintain code.------ === Using with other libraries------     * You won't need low-level interface of @http-client@ most of the---       time, but when you do, it's better import it qualified because it---       has naming conflicts with @req@.---     * For streaming of large request bodies see companion package---       @req-conduit@: <https://hackage.haskell.org/package/req-conduit>.------ === Lightweight, no risk solution------ The library uses the following mature packages under the hood to--- guarantee you best experience without bugs or other funny business:------     * <https://hackage.haskell.org/package/http-client> — low level HTTP---       client used everywhere in Haskell.---     * <https://hackage.haskell.org/package/http-client-tls> — TLS (HTTPS)---       support for @http-client@.------ It's important to note that since we leverage well-known libraries that--- the whole Haskell ecosystem uses, there is no risk in using @req@, as the--- machinery for performing requests is the same as with @http-conduit@ and--- @wreq@, it's just the API is different.--{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures             #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeFamilies               #-}--#if MIN_VERSION_base(4,9,0)-{-# LANGUAGE UndecidableInstances       #-}-#endif--#if __GLASGOW_HASKELL__ <  710-{-# LANGUAGE ConstraintKinds            #-}-#endif--#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif--module Network.HTTP.Req-  ( -- * Making a request-    -- $making-a-request-    req-  , withReqManager-    -- * Embedding requests into your monad-    -- $embedding-requests-  , MonadHttp  (..)-  , HttpConfig (..)-    -- * Request-    -- ** Method-    -- $method-  , GET     (..)-  , POST    (..)-  , HEAD    (..)-  , PUT     (..)-  , DELETE  (..)-  , TRACE   (..)-  , CONNECT (..)-  , OPTIONS (..)-  , PATCH   (..)-  , HttpMethod (..)-    -- ** URL-    -- $url-  , Url-  , http-  , https-  , (/~)-  , (/:)-  , parseUrlHttp-  , parseUrlHttps-    -- ** Body-    -- $body-  , NoReqBody (..)-  , ReqBodyJson (..)-  , ReqBodyFile (..)-  , ReqBodyBs (..)-  , ReqBodyLbs (..)-  , ReqBodyUrlEnc (..)-  , FormUrlEncodedParam-  , ReqBodyMultipart-  , reqBodyMultipart-  , HttpBody (..)-  , ProvidesBody-  , HttpBodyAllowed-    -- ** Optional parameters-    -- $optional-parameters-  , Option-    -- *** Query parameters-    -- $query-parameters-  , (=:)-  , queryFlag-  , QueryParam (..)-    -- *** Headers-  , header-    -- *** Cookies-    -- $cookies-  , cookieJar-    -- *** Authentication-    -- $authentication-  , basicAuth-  , oAuth1-  , oAuth2Bearer-  , oAuth2Token-    -- *** Other-  , port-  , decompress-  , responseTimeout-  , httpVersion-    -- * Response-    -- ** Response interpretations-  , IgnoreResponse-  , ignoreResponse-  , JsonResponse-  , jsonResponse-  , BsResponse-  , bsResponse-  , LbsResponse-  , lbsResponse-  , ReturnRequest-  , returnRequest-    -- ** Inspecting a response-  , responseBody-  , responseStatusCode-  , responseStatusMessage-  , responseHeader-  , responseCookieJar-  , responseRequest-    -- ** Defining your own interpretation-    -- $new-response-interpretation-  , HttpResponse (..)-    -- * Other-  , HttpException (..)-  , CanHaveBody (..)-  , Scheme (..) )-where--import Control.Applicative-import Control.Arrow (first, second)-import Control.Exception (Exception, try, catch, throwIO)-import Control.Monad-import Control.Monad.IO.Class-import Data.Aeson (ToJSON (..), FromJSON (..))-import Data.ByteString (ByteString)-import Data.Data (Data)-import Data.Default.Class-import Data.Function (on)-import Data.IORef-import Data.List (nubBy)-import Data.List.NonEmpty (NonEmpty (..))-import Data.Maybe (fromMaybe)-import Data.Proxy-import Data.Semigroup hiding (Option, option)-import Data.Typeable (Typeable)-import GHC.Generics-import GHC.TypeLits-import System.IO.Unsafe (unsafePerformIO)-import Web.HttpApiData (ToHttpApiData (..))-import qualified Blaze.ByteString.Builder     as BB-import qualified Data.Aeson                   as A-import qualified Data.ByteString              as B-import qualified Data.ByteString.Lazy         as BL-import qualified Data.CaseInsensitive         as CI-import qualified Data.List.NonEmpty           as NE-import qualified Data.Text                    as T-import qualified Data.Text.Encoding           as T-import qualified Network.Connection           as NC-import qualified Network.HTTP.Client          as L-import qualified Network.HTTP.Client.Internal as LI-import qualified Network.HTTP.Client.MultipartFormData as LM-import qualified Network.HTTP.Client.TLS      as L-import qualified Network.HTTP.Types           as Y-import qualified Web.Authenticate.OAuth       as OAuth--#if MIN_VERSION_base(4,9,0)-import Data.Kind (Constraint)-#else-import GHC.Exts (Constraint)-#endif--------------------------------------------------------------------------------- Making a request---- $making-a-request------ To make an HTTP request you need only one function: 'req'.---- | Make an HTTP request. The function takes 5 arguments, 4 of which--- specify required parameters and the final 'Option' argument is a--- collection of optional parameters.------ Let's go through all the arguments first: @req method url body response--- options@.------ @method@ is an HTTP method such as 'GET' or 'POST'. The documentation has--- a dedicated section about HTTP methods below.------ @url@ is a 'Url' that describes location of resource you want to interact--- with.------ @body@ is a body option such as 'NoReqBody' or 'ReqBodyJson'. The--- tutorial has a section about HTTP bodies, but usage is very--- straightforward and should be clear from the examples below.------ @response@ is a type hint how to make and interpret response of HTTP--- request, out-of-the-box it can be the following: 'ignoreResponse',--- 'jsonResponse', 'bsResponse' (to get strict 'ByteString'), 'lbsResponse'--- (to get lazy 'BL.ByteString'), and 'returnRequest' (makes no request,--- just returns response, used for testing).------ Finally @options@ is a 'Monoid' that holds a composite 'Option' for all--- other optional things like query parameters, headers, non-standard port--- number, etc. There are quite a few things you can put there, see--- corresponding section in the documentation. If you don't need anything at--- all, pass 'mempty'.------ __Note__ that if you use 'req' to do all your requests, connection--- sharing and reuse is done for you automatically.------ See the examples below to get on the speed very quickly.------ ==== __Examples__------ First, this is a piece of boilerplate that should be in place before you--- try the examples:------ > {-# LANGUAGE OverloadedStrings #-}--- >--- > module Main (main) where--- >--- > import Control.Exception (throwIO)--- > import Control.Monad--- > import Data.Aeson--- > import Data.Maybe (fromJust)--- > import Data.Monoid ((<>))--- > import Data.Text (Text)--- > import GHC.Generics--- > import Network.HTTP.Req--- > import qualified Data.ByteString.Char8 as B--- >--- > instance MonadHttp IO where--- >   handleHttpException = throwIO------ We will be making requests against the <https://httpbin.org> service.------ Make a GET request, grab 5 random bytes:------ > main :: IO ()--- > main = do--- >   let n :: Int--- >       n = 5--- >   bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse mempty--- >   B.putStrLn (responseBody bs)------ The same, but now we use a query parameter named @\"seed\"@ to control--- seed of the generator:------ > main :: IO ()--- > main = do--- >   let n, seed :: Int--- >       n    = 5--- >       seed = 100--- >   bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse $--- >     "seed" =: seed--- >   B.putStrLn (responseBody bs)------ POST JSON data and get some info about the POST request:------ > data MyData = MyData--- >   { size  :: Int--- >   , color :: Text--- >   } deriving (Show, Generic)--- >--- > instance ToJSON MyData--- > instance FromJSON MyData--- >--- > main :: IO ()--- > main = do--- >   let myData = MyData--- >         { size  = 6--- >         , color = "Green" }--- >   v <- req POST (https "httpbin.org" /: "post") (ReqBodyJson myData) jsonResponse mempty--- >   print (responseBody v :: Value)------ Sending URL-encoded body:------ > main :: IO ()--- > main = do--- >   let params =--- >         "foo" =: ("bar" :: Text) <>--- >         queryFlag "baz"--- >   response <- req POST (https "httpbin.org" /: "post") (ReqBodyUrlEnc params) jsonResponse mempty--- >   print (responseBody response :: Value)------ Using various optional parameters and URL that is not known in advance:------ > main :: IO ()--- > main = do--- >   -- This is an example of what to do when URL is given dynamically. Of--- >   -- course in a real application you may not want to use 'fromJust'.--- >   let (url, options) = fromJust (parseUrlHttps "https://httpbin.org/get?foo=bar")--- >   response <- req GET url NoReqBody jsonResponse $--- >     "from" =: (15 :: Int)           <>--- >     "to"   =: (67 :: Int)           <>--- >     basicAuth "username" "password" <>--- >     options                         <> -- contains the ?foo=bar part--- >     port 443 -- here you can put any port of course--- >   print (responseBody response :: Value)--req-  :: forall m method body response scheme.-     ( MonadHttp    m-     , HttpMethod   method-     , HttpBody     body-     , HttpResponse response-     , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )-  => method            -- ^ HTTP method-  -> Url scheme        -- ^ 'Url' — location of resource-  -> body              -- ^ Body of the request-  -> Proxy response    -- ^ A hint how to interpret response-  -> Option scheme     -- ^ Collection of optional parameters-  -> m response        -- ^ Response-req method url body Proxy options = do-  config  <- getHttpConfig-  manager <- liftIO (readIORef globalManager)-  let -- NOTE First appearance of any given header wins. This allows to-      -- “overwrite” headers when we construct a request by cons-ing.-      nubHeaders = Endo $ \x ->-        x { L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x) }-      request' = flip appEndo L.defaultRequest $-      -- NOTE Order of 'mappend's matters, here method is overwritten first-      -- and 'options' take effect last. In particular, this means that-      -- 'options' can overwrite things set by other request components,-      -- which is useful for setting port number, "Content-Type" header,-      -- etc.-        nubHeaders                                        <>-        getRequestMod options                             <>-        getRequestMod config                              <>-        getRequestMod (Womb body   :: Womb "body"   body) <>-        getRequestMod url                                 <>-        getRequestMod (Womb method :: Womb "method" method)-      wrappingVanilla m = catch m (throwIO . VanillaHttpException)-  request <- finalizeRequest options request'-  (liftIO . try . wrappingVanilla) (getHttpResponse request manager)-    >>= either handleHttpException return---- | Global 'L.Manager' that 'req' uses. Here we just go with the default--- settings, so users don't need to deal with this manager stuff at all, but--- when we create a request, instance 'HttpConfig' can affect the default--- settings via 'getHttpConfig'.------ A note about safety, in case 'unsafePerformIO' looks suspicious to you.--- The value of 'globalManager' is named and lives on top level. This means--- it will be shared, i.e. computed only once on first use of manager. From--- that moment on the 'IORef' will be just reused — exactly the behaviour we--- want here in order to maximize connection sharing. GHC could spoil the--- plan by inlining the definition, hence the @NOINLINE@ pragma.--globalManager :: IORef L.Manager-globalManager = unsafePerformIO $ do-  context <- NC.initConnectionContext-  let settings = L.mkManagerSettingsContext (Just context) def Nothing-  manager <- L.newManager settings-  newIORef manager-{-# NOINLINE globalManager #-}---- | Perform an action using global implicit 'L.Manager' that the rest of--- the library uses. This allows to reuse connections that the 'L.Manager'--- controls.--withReqManager :: MonadIO m => (L.Manager -> m a) -> m a-withReqManager m = liftIO (readIORef globalManager) >>= m--------------------------------------------------------------------------------- Embedding requests into your monad---- $embedding-requests------ To use 'req' in your monad, all you need to do is to make the monad an--- instance of the 'MonadHttp' type class.------ When writing a library, keep your API polymorphic in terms of--- 'MonadHttp', only define instance of 'MonadHttp' in final application.---- | A type class for monads that support performing HTTP requests.--- Typically, you only need to define the 'handleHttpException' method--- unless you want to tweak 'HttpConfig'.--class MonadIO m => MonadHttp m where--  {-# MINIMAL handleHttpException #-}--  -- | This method describes how to deal with 'HttpException' that was-  -- caught by the library. One option is to re-throw it if you are OK with-  -- exceptions, but if you prefer working with something like-  -- 'Control.Monad.Error.MonadError', this is the right place to pass it to-  -- 'Control.Monad.Error.throwError'.--  handleHttpException :: HttpException -> m a--  -- | Return 'HttpConfig' to be used when performing HTTP requests. Default-  -- implementation returns its 'def' value, which is described in the-  -- documentation for the type. Common usage pattern with manually defined-  -- 'getHttpConfig' is to return some hard-coded value, or value extracted-  -- from 'Control.Monad.Reader.MonadReader' if a more flexible approach to-  -- configuration is desirable.--  getHttpConfig :: m HttpConfig-  getHttpConfig = return def---- | 'HttpConfig' contains general and default settings to be used when--- making HTTP requests.--data HttpConfig = HttpConfig-  { httpConfigProxy         :: Maybe L.Proxy-    -- ^ Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@-    -- environment variables are respected, this setting overwrites them.-    -- Default value: 'Nothing'.-  , httpConfigRedirectCount :: Int-    -- ^ How many redirects to follow when getting a resource. Default-    -- value: 10.-  , httpConfigAltManager    :: Maybe L.Manager-    -- ^ Alternative 'L.Manager' to use. 'Nothing' (default value) means-    -- that default implicit manager will be used (that's what you want in-    -- 99% of cases).-  , httpConfigCheckResponse :: L.Request -> L.Response L.BodyReader -> IO ()-    -- ^ Function to check the response immediately after receiving the-    -- status and headers. This is used for throwing exceptions on-    -- non-success status codes by default (set to @\\_ _ -> return ()@ if-    -- this behavior is not desirable). Throwing is better then just-    -- returning a request with non-2xx status code because in that case-    -- something is wrong and we need a way to short-cut execution. The-    -- thrown exception is caught by the library though and is available in-    -- 'handleHttpException'.-  } deriving Typeable--instance Default HttpConfig where-  def = HttpConfig-    { httpConfigProxy         = Nothing-    , httpConfigRedirectCount = 10-    , httpConfigAltManager    = Nothing-    , httpConfigCheckResponse = \_ response ->-        let Y.Status statusCode _ = L.responseStatus response in-          unless (200 <= statusCode && statusCode < 300) $ do-            chunk <- BL.toStrict <$> L.brReadSome (L.responseBody response) 1024-            LI.throwHttp (L.StatusCodeException (void response) chunk) }--instance RequestComponent HttpConfig where-  getRequestMod HttpConfig {..} = Endo $ \x ->-    x { L.proxy                   = httpConfigProxy-      , L.redirectCount           = httpConfigRedirectCount-      , LI.requestManagerOverride = httpConfigAltManager-      , LI.checkResponse          = httpConfigCheckResponse }--------------------------------------------------------------------------------- Request — Method---- $method------ The package supports all methods as defined by RFC 2616, and 'PATCH'--- which is defined by RFC 5789 — that should be enough to talk to RESTful--- APIs. In some cases, however, you may want to add more methods (e.g. you--- work with WebDAV <https://en.wikipedia.org/wiki/WebDAV>); no need to--- compromise on type safety and hack, it only takes a couple of seconds to--- define a new method that will works seamlessly, see 'HttpMethod'.---- | 'GET' method.--data GET = GET--instance HttpMethod GET where-  type AllowsBody GET = 'NoBody-  httpMethodName Proxy = Y.methodGet---- | 'POST' method.--data POST = POST--instance HttpMethod POST where-  type AllowsBody POST = 'CanHaveBody-  httpMethodName Proxy = Y.methodPost---- | 'HEAD' method.--data HEAD = HEAD--instance HttpMethod HEAD where-  type AllowsBody HEAD = 'NoBody-  httpMethodName Proxy = Y.methodHead---- | 'PUT' method.--data PUT = PUT--instance HttpMethod PUT where-  type AllowsBody PUT = 'CanHaveBody-  httpMethodName Proxy = Y.methodPut---- | 'DELETE' method. This data type does not allow having request body with--- 'DELETE' requests, as it should be, however some APIs may expect 'DELETE'--- requests to have bodies, in that case define your own variation of--- 'DELETE' method and allow it to have a body.--data DELETE = DELETE--instance HttpMethod DELETE where-  type AllowsBody DELETE = 'NoBody-  httpMethodName Proxy = Y.methodDelete---- | 'TRACE' method.--data TRACE = TRACE--instance HttpMethod TRACE where-  type AllowsBody TRACE = 'CanHaveBody-  httpMethodName Proxy = Y.methodTrace---- | 'CONNECT' method.--data CONNECT = CONNECT--instance HttpMethod CONNECT where-  type AllowsBody CONNECT = 'CanHaveBody-  httpMethodName Proxy = Y.methodConnect---- | 'OPTIONS' method.--data OPTIONS = OPTIONS--instance HttpMethod OPTIONS where-  type AllowsBody OPTIONS = 'NoBody-  httpMethodName Proxy = Y.methodOptions---- | 'PATCH' method.--data PATCH = PATCH--instance HttpMethod PATCH where-  type AllowsBody PATCH = 'CanHaveBody-  httpMethodName Proxy = Y.methodPatch---- | A type class for types that can be used as an HTTP method. To define a--- non-standard method, follow this example that defines COPY:------ > data COPY = COPY--- >--- > instance HttpMethod COPY where--- >   type AllowsBody COPY = 'CanHaveBody--- >   httpMethodName Proxy = "COPY"--class HttpMethod a where--  -- | Type function 'AllowsBody' returns type of kind 'CanHaveBody' which-  -- tells the rest of the library whether the method can have a body or-  -- not. We use the special type 'CanHaveBody' “lifted” into kind instead-  -- of 'Bool' to get more user-friendly compiler messages.--  type AllowsBody a :: CanHaveBody--  -- | Return name of the method as a 'ByteString'.--  httpMethodName :: Proxy a -> ByteString--instance HttpMethod method => RequestComponent (Womb "method" method) where-  getRequestMod _ = Endo $ \x ->-    x { L.method = httpMethodName (Proxy :: Proxy method) }--------------------------------------------------------------------------------- Request — URL---- $url------ We use 'Url's which are correct by construction, see 'Url'. To build a--- 'Url' from a 'ByteString', use 'parseUrlHttp' or 'parseUrlHttps'.---- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https'--- specifying the scheme and host at the same time. Then use the @('/~')@--- and @('/:')@ operators to grow path one piece at a time. Every single--- piece of path will be url(percent)-encoded, so using @('/~')@ and--- @('/:')@ is the only way to have forward slashes between path segments.--- This approach makes working with dynamic path segments easy and safe. See--- examples below how to represent various 'Url's (make sure the--- @OverloadedStrings@ language extension is enabled).------ ==== __Examples__------ > http "httpbin.org"--- > -- http://httpbin.org------ > https "httpbin.org"--- > -- https://httpbin.org------ > https "httpbin.org" /: "encoding" /: "utf8"--- > -- https://httpbin.org/encoding/utf8------ > https "httpbin.org" /: "foo" /: "bar/baz"--- > -- https://httpbin.org/foo/bar%2Fbaz------ > https "httpbin.org" /: "bytes" /~ (10 :: Int)--- > -- https://httpbin.org/bytes/10------ > https "юникод.рф"--- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84--data Url (scheme :: Scheme) = Url Scheme (NonEmpty T.Text)-  -- NOTE The second value is path segments in reversed order.-  deriving (Eq, Ord, Show, Data, Typeable, Generic)---- | Given host name, produce a 'Url' which have “http” as its scheme and--- empty path. This also sets port to @80@.--http :: T.Text -> Url 'Http-http = Url Http . pure---- | Given host name, produce a 'Url' which have “https” as its scheme and--- empty path. This also sets port to @443@.--https :: T.Text -> Url 'Https-https = Url Https . pure---- | Grow given 'Url' appending a single path segment to it. Note that the--- path segment can be of any type that is an instance of 'ToHttpApiData'.--infixl 5 /~-(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme-Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)---- | Type-constrained version of @('/~')@ to remove ambiguity in cases when--- next URL piece is a 'Text' literal.--infixl 5 /:-(/:) :: Url scheme -> T.Text -> Url scheme-(/:) = (/~)---- | The 'parseUrlHttp' function provides an alternative method to get 'Url'--- (possibly with some 'Option's) from a 'ByteString'. This is useful when--- you are given a URL to query dynamically and don't know it beforehand.--- The function parses 'ByteString' because it's the correct type to--- represent a URL, as 'Url' cannot contain characters outside of ASCII--- range, thus we can consider every character a 'Data.Word.Word8' value.------ This function only parses 'Url' (scheme, host, path) and optional query--- parameters that are returned as 'Option'. It does not parse method name--- or authentication info from given 'ByteString'.--parseUrlHttp :: ByteString -> Maybe (Url 'Http, Option scheme)-parseUrlHttp url' = do-  url <- B.stripPrefix "http://" url'-  (host :| path, option) <- parseUrlHelper url-  return (foldl (/:) (http host) path, option)---- | Just like 'parseUrlHttp', but expects “https” scheme.--parseUrlHttps :: ByteString -> Maybe (Url 'Https, Option scheme)-parseUrlHttps url' = do-  url <- B.stripPrefix "https://" url'-  (host :| path, option) <- parseUrlHelper url-  return (foldl (/:) (https host) path, option)---- | Get host\/collection of path pieces and possibly query parameters--- already converted to 'Option'. This function is not public.--parseUrlHelper :: ByteString -> Maybe (NonEmpty T.Text, Option scheme)-parseUrlHelper url = do-  let (path', query') = B.break (== 0x3f) url-      query = mconcat (uncurry queryParam <$> Y.parseQueryText query')-  path <- NE.nonEmpty (Y.decodePathSegments path')-  return (path, query)--instance RequestComponent (Url scheme) where-  getRequestMod (Url scheme segments) = Endo $ \x ->-    let (host :| path) = NE.reverse segments in-    x { L.secure = case scheme of-          Http  -> False-          Https -> True-      , L.port   = case scheme of-          Http  -> 80-          Https -> 443-      , L.host   = Y.urlEncode False (T.encodeUtf8 host)-      , L.path   =-          (BL.toStrict . BB.toLazyByteString . Y.encodePathSegments) path }--------------------------------------------------------------------------------- Request — Body---- $body------ A number of options for request bodies are available. The @Content-Type@--- header is set for you automatically according to body option you use--- (it's always specified in documentation for given body option). To add--- your own way to represent request body, see 'HttpBody'.---- | This data type represents empty body of an HTTP request. This is the--- data type to use with 'HttpMethod's that cannot have a body, as it's the--- only type for which 'ProvidesBody' returns 'NoBody'.------ Using of this body option does not set the @Content-Type@ header.--data NoReqBody = NoReqBody--instance HttpBody NoReqBody where-  getRequestBody NoReqBody = L.RequestBodyBS B.empty---- | This body option allows to use a JSON object as request body — probably--- the most popular format right now. Just wrap a data type that is an--- instance of 'ToJSON' type class and you are done: it will be converted to--- JSON and inserted as request body.------ This body option sets the @Content-Type@ header to @\"application/json;--- charset=utf-8\"@ value.--newtype ReqBodyJson a = ReqBodyJson a--instance ToJSON a => HttpBody (ReqBodyJson a) where-  getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)-  getRequestContentType _ = pure "application/json; charset=utf-8"---- | This body option streams request body from a file. It is expected that--- the file size does not change during the streaming.------ Using of this body option does not set the @Content-Type@ header.--newtype ReqBodyFile = ReqBodyFile FilePath--instance HttpBody ReqBodyFile where-  getRequestBody (ReqBodyFile path) =-    LI.RequestBodyIO (L.streamFile path)---- | HTTP request body represented by a strict 'ByteString'.------ Using of this body option does not set the @Content-Type@ header.--newtype ReqBodyBs = ReqBodyBs ByteString--instance HttpBody ReqBodyBs where-  getRequestBody (ReqBodyBs bs) = L.RequestBodyBS bs---- | HTTP request body represented by a lazy 'BL.ByteString'.------ Using of this body option does not set the @Content-Type@ header.--newtype ReqBodyLbs = ReqBodyLbs BL.ByteString--instance HttpBody ReqBodyLbs where-  getRequestBody (ReqBodyLbs bs) = L.RequestBodyLBS bs---- | Form URL-encoded body. This can hold a collection of parameters which--- are encoded similarly to query parameters at the end of query string,--- with the only difference that they are stored in request body. The--- similarity is reflected in the API as well, as you can use the same--- combinators you would use to add query parameters: @('=:')@ and--- 'queryFlag'.------ This body option sets the @Content-Type@ header to--- @\"application/x-www-from-urlencoded\"@ value.--newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam--instance HttpBody ReqBodyUrlEnc where-  getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam params)) =-    (L.RequestBodyLBS . BB.toLazyByteString) (Y.renderQueryText False params)-  getRequestContentType _ = pure "application/x-www-form-urlencoded"---- | An opaque monoidal value that allows to collect URL-encoded parameters--- to be wrapped in 'ReqBodyUrlEnc'.--newtype FormUrlEncodedParam = FormUrlEncodedParam [(T.Text, Maybe T.Text)]-  deriving (Semigroup, Monoid)--instance QueryParam FormUrlEncodedParam where-  queryParam name mvalue =-    FormUrlEncodedParam [(name, toQueryParam <$> mvalue)]---- | Multipart form data. Please consult the--- "Network.HTTP.Client.MultipartFormData" module for how to construct--- parts, then use 'reqBodyMultipart' to create actual request body from the--- parts. 'reqBodyMultipart' is the only way to get a value of type--- 'ReqBodyMultipart', as its constructor is not exported on purpose.------ @since 0.2.0--data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody--instance HttpBody ReqBodyMultipart where-  getRequestBody (ReqBodyMultipart _ body) = body-  getRequestContentType (ReqBodyMultipart boundary _) =-    pure ("multipart/form-data; boundary=" <> boundary)---- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.------ @since 0.2.0--reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart-reqBodyMultipart parts = liftIO $ do-  boundary <- LM.webkitBoundary-  body     <- LM.renderParts boundary parts-  return (ReqBodyMultipart boundary body)---- | A type class for things that can be interpreted as HTTP--- 'L.RequestBody'.--class HttpBody body where--  {-# MINIMAL getRequestBody #-}--  -- | How to get actual 'L.RequestBody'.--  getRequestBody :: body -> L.RequestBody--  -- | This method allows to optionally specify value of @Content-Type@-  -- header that should be used with particular body option. By default it-  -- returns 'Nothing' and so @Content-Type@ is not set.--  getRequestContentType :: body -> Maybe ByteString-  getRequestContentType = const Nothing---- | The type function recognizes 'NoReqBody' as having 'NoBody', while any--- other body option 'CanHaveBody'. This forces user to use 'NoReqBody' with--- 'GET' method and other methods that should not send a body.--type family ProvidesBody body :: CanHaveBody where-  ProvidesBody NoReqBody = 'NoBody-  ProvidesBody body      = 'CanHaveBody---- | This type function allows any HTTP body if method says it--- 'CanHaveBody'. When method says it should have 'NoBody', the only body--- option to use is 'NoReqBody'.------ __Note__: users of GHC 8.0.1 will see slightly more friendly error--- messages when method does not allow a body and body is provided.--type family HttpBodyAllowed-  (allowsBody   :: CanHaveBody)-  (providesBody :: CanHaveBody) :: Constraint where-  HttpBodyAllowed 'NoBody      'NoBody = ()-  HttpBodyAllowed 'CanHaveBody body    = ()-#if MIN_VERSION_base(4,9,0)-  HttpBodyAllowed 'NoBody 'CanHaveBody = TypeError-    ('Text "This HTTP method does not allow attaching a request body.")-#endif--instance HttpBody body => RequestComponent (Womb "body" body) where-  getRequestMod (Womb body) = Endo $ \x ->-    x { L.requestBody = getRequestBody body-      , L.requestHeaders =-        let old = L.requestHeaders x in-          case getRequestContentType body of-            Nothing -> old-            Just contentType ->-              (Y.hContentType, contentType) : old }--------------------------------------------------------------------------------- Request — Optional parameters---- $optional-parameters------ Optional parameters to a request include things like query parameters,--- headers, port number, etc. All optional parameters have the type--- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as--- the last argument of 'req' to specify no optional parameters, or combine--- 'Option's using 'mappend' (or @('<>')@) to have several of them at once.---- | Opaque 'Option' type is a 'Monoid' you can use to pack collection of--- optional parameters like query parameters and headers. See sections below--- to learn which 'Option' primitives are available.--data Option (scheme :: Scheme) =-  Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))-  -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with-  -- Request to avoid appending to existing query string in request every-  -- time new parameter is added. Additional Maybe (Endo Request) is a-  -- finalizer that will be applied after all other transformations. This is-  -- for authentication methods that sign requests based on data in Request.--instance Semigroup (Option scheme) where-  Option er0 mr0 <> Option er1 mr1 = Option-    (er0 <> er1) (mr0 <|> mr1)--instance Monoid (Option scheme) where-  mempty  = Option mempty Nothing-  mappend = (<>)---- | A helper to create an 'Option' that modifies only collection of query--- parameters. This helper is not a part of public API.--withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme-withQueryParams f = Option (Endo (first f)) Nothing---- | A helper to create an 'Option' that modifies only 'L.Request'. This--- helper is not a part of public API.--withRequest :: (L.Request -> L.Request) -> Option scheme-withRequest f = Option (Endo (second f)) Nothing---- | A helper to create an 'Option' that adds a finalizer (request--- endomorphism that is run after all other modifications).--asFinalizer :: (L.Request -> IO L.Request) -> Option scheme-asFinalizer = Option mempty . pure--instance RequestComponent (Option scheme) where-  getRequestMod (Option f _) = Endo $ \x ->-    let (qparams, x') = appEndo f ([], x)-        query         = Y.renderQuery True (Y.queryTextToQuery qparams)-    in x' { L.queryString = query }---- | Finalize given 'L.Request' by applying a finalizer from given 'Option'--- (if it has any).--finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request-finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer--------------------------------------------------------------------------------- Request — Optional parameters — Query Parameters---- $query-parameters------ This section describes a polymorphic interface that can be used to--- construct query parameters (of type 'Option') and form URL-encoded bodies--- (of type 'FormUrlEncodedParam').---- | This operator builds a query parameter that will be included in URL of--- your request after question sign @?@. This is the same syntax you use--- with form URL encoded request bodies.------ This operator is defined in terms of 'queryParam':------ > name =: value = queryParam name (pure value)--infix 7 =:-(=:) :: (QueryParam param, ToHttpApiData a) => T.Text -> a -> param-name =: value = queryParam name (pure value)---- | Construct a flag, that is, valueless query parameter. For example, in--- the following URL @a@ is a flag, @b@ is a query parameter with a value:------ > https://httpbin.org/foo/bar?a&b=10------ This operator is defined in terms of 'queryParam':------ > queryFlag name = queryParam name Nothing--queryFlag :: QueryParam param => T.Text -> param-queryFlag name = queryParam name (Nothing :: Maybe ())---- | A type class for query-parameter-like things. The reason to have--- overloaded 'queryParam' is to be able to use it as an 'Option' and as a--- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.--- Having the same syntax for these cases seems natural and user-friendly.--class QueryParam param where--  -- | Create a query parameter with given name and value. If value is-  -- 'Nothing', it won't be included at all (i.e. you create a flag this-  -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this-  -- method, because they are easier to read.--  queryParam :: ToHttpApiData a => T.Text -> Maybe a -> param--instance QueryParam (Option scheme) where-  queryParam name mvalue =-    withQueryParams ((:) (name, toQueryParam <$> mvalue))--------------------------------------------------------------------------------- Request — Optional parameters — Headers---- | Create an 'Option' that adds a header. Note that if you 'mappend' two--- headers with the same names the leftmost header will win. This means, in--- particular, that you cannot create a request with several headers of the--- same name.--header-  :: ByteString        -- ^ Header name-  -> ByteString        -- ^ Header value-  -> Option scheme-header name value = withRequest (attachHeader name value)---- | A non-public helper that attaches a header with given name and content--- to a 'L.Request'.--attachHeader :: ByteString -> ByteString -> L.Request -> L.Request-attachHeader name value x =-  x { L.requestHeaders = (CI.mk name, value) : L.requestHeaders x }--------------------------------------------------------------------------------- Request — Optional parameters — Cookies---- $cookies------ Support for cookies is quite minimalistic at the moment, its' possible to--- specify which cookies to send using 'cookieJar' and inspect 'L.Response'--- to extract 'L.CookieJar' from it (see 'responseCookieJar').---- | Use the given 'L.CookieJar'. A 'L.CookieJar' can be obtained from a--- 'L.Response' record.--cookieJar :: L.CookieJar -> Option scheme-cookieJar jar = withRequest $ \x ->-  x { L.cookieJar = Just jar }--------------------------------------------------------------------------------- Request — Optional parameters — Authentication---- $authentication------ This section provides common authentication helpers in form of 'Option's.--- You should always prefer the provided authentication 'Option's to manual--- construction of headers because it ensures that you only use one--- authentication method at a time (they overwrite each other) and provides--- additional type safety that prevents leaking of credentials in cases when--- authentication relies on TLS for encrypting sensitive data.---- | The 'Option' adds basic authentication.------ See also: <https://en.wikipedia.org/wiki/Basic_access_authentication>.--basicAuth-  :: ByteString        -- ^ Username-  -> ByteString        -- ^ Password-  -> Option 'Https     -- ^ Auth 'Option'-basicAuth username password = asFinalizer-  (pure . L.applyBasicAuth username password)---- | The 'Option' adds OAuth1 authentication.------ @since 0.2.0--oAuth1-  :: ByteString        -- ^ Consumer token-  -> ByteString        -- ^ Consumer secret-  -> ByteString        -- ^ OAuth token-  -> ByteString        -- ^ OAuth token secret-  -> Option scheme     -- ^ Auth 'Option'-oAuth1 consumerToken consumerSecret token tokenSecret =-  asFinalizer (OAuth.signOAuth app creds)-  where-    app = OAuth.newOAuth-      { OAuth.oauthConsumerKey    = consumerToken-      , OAuth.oauthConsumerSecret = consumerSecret }-    creds = OAuth.newCredential token tokenSecret---- | The 'Option' adds an OAuth2 bearer token. This is treated by many--- services as the equivalent of a username and password.------ The 'Option' is defined as:------ > oAuth2Bearer token = header "Authorization" ("Bearer " <> token)------ See also: <https://en.wikipedia.org/wiki/OAuth>.--oAuth2Bearer-  :: ByteString        -- ^ Token-  -> Option 'Https     -- ^ Auth 'Option'-oAuth2Bearer token = asFinalizer-  (pure . attachHeader "Authorization" ("Bearer " <> token))---- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems--- to be used only by GitHub). This will be treated by whatever services--- accept it as the equivalent of a username and password.------ The 'Option' is defined as:------ > oAuth2Token token = header "Authorization" ("token" <> token)------ See also: <https://developer.github.com/v3/oauth#3-use-the-access-token-to-access-the-api>.--oAuth2Token-  :: ByteString        -- ^ Token-  -> Option 'Https     -- ^ Auth 'Option'-oAuth2Token token = asFinalizer-  (pure . attachHeader "Authorization" ("token " <> token))--------------------------------------------------------------------------------- Request — Optional parameters — Other---- | Specify the port to connect to explicitly. Normally, 'Url' you use--- determines default port, @80@ for HTTP and @443@ for HTTPS, this 'Option'--- allows to choose arbitrary port overwriting the defaults.--port :: Int -> Option scheme-port n = withRequest $ \x ->-  x { L.port = n }---- | This 'Option' controls whether gzipped data should be decompressed on--- the fly. By default everything except for @application\/x-tar@ is--- decompressed, i.e. we have:------ > decompress (/= "application/x-tar")------ You can also choose to decompress everything like this:------ > decompress (const True)--decompress-  :: (ByteString -> Bool) -- ^ Predicate that is given MIME type, it-     -- returns 'True' when content should be decompressed on the fly.-  -> Option scheme-decompress f = withRequest $ \x ->-  x { L.decompress = f }---- | Specify number of microseconds to wait for response. Default is 30--- seconds.--responseTimeout-  :: Int               -- ^ Number of microseconds to wait-  -> Option scheme-responseTimeout n = withRequest $ \x ->-  x { L.responseTimeout = LI.ResponseTimeoutMicro n }---- | HTTP version to send to server, default is HTTP 1.1.--httpVersion-  :: Int               -- ^ Major version number-  -> Int               -- ^ Minor version number-  -> Option scheme-httpVersion major minor = withRequest $ \x ->-  x { L.requestVersion = Y.HttpVersion major minor }--------------------------------------------------------------------------------- Response interpretations---- | Make a request and ignore body of response.--data IgnoreResponse = IgnoreResponse (L.Response ())--instance HttpResponse IgnoreResponse where-  type HttpResponseBody IgnoreResponse = ()-  toVanillaResponse (IgnoreResponse response) = response-  getHttpResponse request manager =-    IgnoreResponse <$> liftIO (L.httpNoBody request manager)---- | Use this as the fourth argument of 'req' to specify that you want it to--- return the 'IgnoreResponse' interpretation.--ignoreResponse :: Proxy IgnoreResponse-ignoreResponse = Proxy---- | Make a request and interpret body of response as JSON. The--- 'handleHttpException' method of 'MonadHttp' instance corresponding to--- monad in which you use 'req' will determine what to do in the case when--- parsing fails ('JsonHttpException' constructor will be used).--newtype JsonResponse a = JsonResponse (L.Response a)--instance FromJSON a => HttpResponse (JsonResponse a) where-  type HttpResponseBody (JsonResponse a) = a-  toVanillaResponse (JsonResponse response) = response-  getHttpResponse request manager = do-    response <- L.httpLbs request manager-    case A.eitherDecode (L.responseBody response) of-      Left e -> throwIO (JsonHttpException e)-      Right x -> return $ JsonResponse response { L.responseBody = x }---- | Use this as the forth argument of 'req' to specify that you want it to--- return the 'JsonResponse' interpretation.--jsonResponse :: Proxy (JsonResponse a)-jsonResponse = Proxy---- | Make a request and interpret body of response as a strict 'ByteString'.--newtype BsResponse = BsResponse (L.Response ByteString)--instance HttpResponse BsResponse where-  type HttpResponseBody BsResponse = ByteString-  toVanillaResponse (BsResponse response) = response-  getHttpResponse request manager =-    L.withResponse request manager $ \response -> do-      chunks <- L.brConsume (L.responseBody response)-      return $ BsResponse response { L.responseBody = B.concat chunks }---- | Use this as the forth argument of 'req' to specify that you want to--- interpret response body as a strict 'ByteString'.--bsResponse :: Proxy BsResponse-bsResponse = Proxy---- | Make a request and interpret body of response as a lazy--- 'BL.ByteString'.--newtype LbsResponse = LbsResponse (L.Response BL.ByteString)--instance HttpResponse LbsResponse where-  type HttpResponseBody LbsResponse = BL.ByteString-  toVanillaResponse (LbsResponse response) = response-  getHttpResponse request manager =-    LbsResponse <$> L.httpLbs request manager---- | Use this as the forth argument of 'req' to specify that you want to--- interpret response body as a lazy 'BL.ByteString'.--lbsResponse :: Proxy LbsResponse-lbsResponse = Proxy---- | This interpretation does not result in any call at all, but you can use--- the 'responseRequest' function to extract 'L.Request' that 'req' has--- prepared. This is useful primarily for testing.------ Note that when you use this interpretation inspecting response will--- diverge (i.e. it'll blow up with an error, don't do that).--newtype ReturnRequest = ReturnRequest L.Request--instance HttpResponse ReturnRequest where-  type HttpResponseBody ReturnRequest = ()-  toVanillaResponse (ReturnRequest _) = error-    "Network.HTTP.Req.ReturnRequest interpretation does not make requests"-  getHttpResponse request _ = return (ReturnRequest request)---- | Use this as the forth argument of 'req' to specify that you want it to--- just return the request it consturcted without making any requests.--returnRequest :: Proxy ReturnRequest-returnRequest = Proxy--------------------------------------------------------------------------------- Inspecting a response---- | Get response body.--responseBody-  :: HttpResponse response-  => response-  -> HttpResponseBody response-responseBody = L.responseBody . toVanillaResponse---- | Get response status code.--responseStatusCode-  :: HttpResponse response-  => response-  -> Int-responseStatusCode =-  Y.statusCode . L.responseStatus . toVanillaResponse---- | Get response status message.--responseStatusMessage-  :: HttpResponse response-  => response-  -> ByteString-responseStatusMessage =-  Y.statusMessage . L.responseStatus . toVanillaResponse---- | Look a particular header from a response.--responseHeader-  :: HttpResponse response-  => response          -- ^ Response interpretation-  -> ByteString        -- ^ Header to lookup-  -> Maybe ByteString  -- ^ Header value if found-responseHeader r h =-  (lookup (CI.mk h) . L.responseHeaders . toVanillaResponse) r---- | Get response 'L.CookieJar'.--responseCookieJar-  :: HttpResponse response-  => response-  -> L.CookieJar-responseCookieJar = L.responseCookieJar . toVanillaResponse---- | Get the original request from 'ReturnRequest' response interpretation.--responseRequest :: ReturnRequest -> L.Request-responseRequest (ReturnRequest request) = request--------------------------------------------------------------------------------- Response — defining your own interpretation---- $new-response-interpretation------ To create a new response interpretation you just need to make your data--- type an instance of 'HttpResponse' type class.---- | A type class for response interpretations. It allows to fully control--- how request is made and how its body is parsed.--class HttpResponse response where--  -- | The associated type is the type of body that can be extracted from a-  -- instance of 'HttpResponse'.--  type HttpResponseBody response :: *--  -- | The method describes how to get underlying 'L.Response' record.--  toVanillaResponse :: response -> L.Response (HttpResponseBody response)--  -- | This method describes how to make an HTTP request given 'L.Request'-  -- (prepared by the rest of the library) and 'L.Manager'.--  getHttpResponse :: L.Request -> L.Manager -> IO response--------------------------------------------------------------------------------- Other---- | The main class for things that are “parts” of 'L.Request' in the sense--- that if we have a 'L.Request', then we know how to apply an instance of--- 'RequestComponent' changing\/overwriting something in it. 'Endo' is a--- monoid of endomorphisms under composition, it's used to chain different--- request components easier using @('<>')@.--class RequestComponent a where--  -- | Get a function that takes a 'L.Request' and changes it somehow-  -- returning another 'L.Request'. For example HTTP method instance of-  -- 'RequestComponent' just overwrites method. The function is wrapped in-  -- 'Endo' so it's easier to chain such “modifying applications” together-  -- building bigger and bigger 'RequestComponent's.--  getRequestMod :: a -> Endo L.Request---- | This wrapper is only used to attach a type-level tag to given type.--- This is necessary to define instances of 'RequestComponent' for any thing--- that implements 'HttpMethod' or 'HttpBody'. Without the tag, GHC can't--- see the difference between @'HttpMethod' method => 'RequestComponent'--- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides--- which instance to use (i.e. constraints are taken into account later,--- when instance is already chosen).--newtype Womb (tag :: Symbol) a = Womb a---- | Exceptions that this library throws.--data HttpException-  = VanillaHttpException L.HttpException-    -- ^ A wrapper with an 'L.HttpException' from "Network.HTTP.Client"-  | JsonHttpException String-    -- ^ A wrapper with Aeson-produced 'String' describing why decoding failed-  deriving (Show, Typeable, Generic)--instance Exception HttpException---- | A simple 'Bool'-like type we only have for better error messages. We--- use it as a kind and its data constructors as type-level tags.------ See also: 'HttpMethod' and 'HttpBody'.--data CanHaveBody-  = CanHaveBody        -- ^ Indeed can have a body-  | NoBody             -- ^ Should not have a body---- | A type-level tag that specifies URL scheme used (and thus if TLS is--- enabled). This is used to force TLS requirement for some authentication--- 'Option's.--data Scheme-  = Http               -- ^ HTTP, no TLS-  | Https              -- ^ HTTPS-  deriving (Eq, Ord, Show, Data, Typeable, Generic)+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      :  Network.HTTP.Req+-- Copyright   :  © 2016–present Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- The documentation below is structured in such a way that the most+-- important information is presented first: you learn how to do HTTP+-- requests, how to embed them in the monad you have, and then it gives you+-- details about less-common things you may want to know about. The+-- documentation is written with sufficient coverage of details and+-- examples, and it's designed to be a complete tutorial on its own.+--+-- === About the library+--+-- Req is an HTTP client library that attempts to be easy-to-use, type-safe,+-- and expandable.+--+-- “Easy-to-use” means that the library is designed to be beginner-friendly+-- so it's simple to add to your monad stack, intuitive to work with,+-- well-documented, and does not get in your way. Doing HTTP requests is a+-- common task and a Haskell library for this should be approachable and+-- clear to beginners, thus certain compromises were made. For example, one+-- cannot currently modify 'L.ManagerSettings' of the default manager+-- because the library always uses the same implicit global manager for+-- simplicity and maximal connection sharing. There is a way to use your own+-- manager with different settings, but it requires more typing.+--+-- “Type-safe” means that the library tries to eliminate certain classes of+-- errors. For example, we have correct-by-construction URLs; it is+-- guaranteed that the user does not send the request body when using+-- methods like GET or OPTIONS, and the amount of implicit assumptions is+-- minimized by making the user specify their intentions in an explicit+-- form. For example, it's not possible to avoid specifying the body or the+-- method of a request. Authentication methods that assume HTTPS force the+-- user to use HTTPS at the type level.+--+-- “Expandable” refers to the ability to create new components without+-- having to resort to hacking. For example, it's possible to define your+-- own HTTP methods, create new ways to construct the body of a request,+-- create new authorization options, perform a request in a different way,+-- and create your own methods to parse a response.+--+-- === Using with other libraries+--+--     * You won't need the low-level interface of @http-client@ most of the+--       time, but when you do, it's better to do a qualified import,+--       because @http-client@ has naming conflicts with @req@.+--     * For streaming of large request bodies see the companion package+--       @req-conduit@: <https://hackage.haskell.org/package/req-conduit>.+--+-- === Lightweight, no risk solution+--+-- The library uses the following mature packages under the hood to+-- guarantee you the best experience:+--+--     * <https://hackage.haskell.org/package/http-client>—low level HTTP+--       client used everywhere in Haskell.+--     * <https://hackage.haskell.org/package/http-client-tls>—TLS (HTTPS)+--       support for @http-client@.+--+-- It's important to note that since we leverage well-known libraries that+-- the whole Haskell ecosystem uses, there is no risk in using @req@. The+-- machinery for performing requests is the same as with @http-conduit@ and+-- @wreq@. The only difference is the API.+module Network.HTTP.Req+  ( -- * Making a request+    -- $making-a-request+    req,+    reqBr,+    reqCb,+    req',+    withReqManager,++    -- * Embedding requests in your monad+    -- $embedding-requests+    MonadHttp (..),+    HttpConfig (..),+    defaultHttpConfig,+    Req,+    runReq,++    -- * Request++    -- ** Method+    -- $method+    GET (..),+    POST (..),+    HEAD (..),+    PUT (..),+    DELETE (..),+    TRACE (..),+    CONNECT (..),+    OPTIONS (..),+    PATCH (..),+    HttpMethod (..),++    -- ** URL+    -- $url+    Url,+    http,+    https,+    (/~),+    (/:),+    useHttpURI,+    useHttpsURI,+    useURI,+    urlQ,+    renderUrl,++    -- ** Body+    -- $body+    NoReqBody (..),+    ReqBodyJson (..),+    ReqBodyFile (..),+    ReqBodyBs (..),+    ReqBodyLbs (..),+    ReqBodyUrlEnc (..),+    FormUrlEncodedParam,+    ReqBodyMultipart,+    reqBodyMultipart,+    HttpBody (..),+    ProvidesBody,+    HttpBodyAllowed,++    -- ** Optional parameters+    -- $optional-parameters+    Option,++    -- *** Query parameters+    -- $query-parameters+    (=:),+    queryFlag,+    formToQuery,+    QueryParam (..),++    -- *** Headers+    header,+    attachHeader,+    headerRedacted,++    -- *** Cookies+    -- $cookies+    cookieJar,++    -- *** Authentication+    -- $authentication+    basicAuth,+    basicAuthUnsafe,+    basicProxyAuth,+    oAuth1,+    oAuth2Bearer,+    oAuth2Token,+    customAuth,++    -- *** Other+    port,+    decompress,+    responseTimeout,+    httpVersion,++    -- * Response++    -- ** Response interpretations+    IgnoreResponse,+    ignoreResponse,+    JsonResponse,+    jsonResponse,+    BsResponse,+    bsResponse,+    LbsResponse,+    lbsResponse,++    -- ** Inspecting a response+    responseBody,+    responseStatusCode,+    responseStatusMessage,+    responseHeader,+    responseCookieJar,++    -- ** Defining your own interpretation+    -- $new-response-interpretation+    HttpResponse (..),++    -- * Other+    HttpException (..),+    isStatusCodeException,+    CanHaveBody (..),+    Scheme (..),+  )+where++import Blaze.ByteString.Builder qualified as BB+import Control.Applicative+import Control.Arrow (first, second)+import Control.Exception hiding (Handler (..), TypeError)+import Control.Monad (guard, void, (>=>))+import Control.Monad.Base+import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)+import Control.Monad.IO.Class+import Control.Monad.IO.Unlift+import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)+import Control.Monad.Trans.Accum (AccumT)+import Control.Monad.Trans.Cont (ContT)+import Control.Monad.Trans.Control+import Control.Monad.Trans.Except (ExceptT)+import Control.Monad.Trans.Identity (IdentityT)+import Control.Monad.Trans.Maybe (MaybeT)+import Control.Monad.Trans.RWS.CPS qualified as RWS.CPS+import Control.Monad.Trans.RWS.Lazy qualified as RWS.Lazy+import Control.Monad.Trans.RWS.Strict qualified as RWS.Strict+import Control.Monad.Trans.Select (SelectT)+import Control.Monad.Trans.State.Lazy qualified as State.Lazy+import Control.Monad.Trans.State.Strict qualified as State.Strict+import Control.Monad.Trans.Writer.CPS qualified as Writer.CPS+import Control.Monad.Trans.Writer.Lazy qualified as Writer.Lazy+import Control.Monad.Trans.Writer.Strict qualified as Writer.Strict+import Control.Retry+import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Aeson qualified as A+import Data.ByteString (ByteString)+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as BL+import Data.CaseInsensitive qualified as CI+import Data.Data (Data)+import Data.Default.Class (def)+import Data.Function (on)+import Data.IORef+import Data.Kind (Constraint, Type)+import Data.List (foldl', nubBy)+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE+import Data.Maybe (fromMaybe)+import Data.Proxy+import Data.Semigroup (Endo (..))+import Data.Set qualified as S+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Typeable (Typeable, cast)+import GHC.Generics+import GHC.TypeLits+import Language.Haskell.TH qualified as TH+import Language.Haskell.TH.Quote qualified as TH+import Language.Haskell.TH.Syntax qualified as TH+import Network.Connection qualified as NC+import Network.HTTP.Client qualified as L+import Network.HTTP.Client.Internal qualified as LI+import Network.HTTP.Client.MultipartFormData qualified as LM+import Network.HTTP.Client.TLS qualified as L+import Network.HTTP.Types qualified as Y+import System.IO.Unsafe (unsafePerformIO)+import Text.URI (URI)+import Text.URI qualified as URI+import Text.URI.QQ qualified as QQ+import Web.Authenticate.OAuth qualified as OAuth+import Web.FormUrlEncoded (FromForm (..), ToForm (..))+import Web.FormUrlEncoded qualified as Form+import Web.HttpApiData (ToHttpApiData (..))++----------------------------------------------------------------------------+-- Making a request++-- $making-a-request+--+-- To make an HTTP request you normally need only one function: 'req'.++-- | Make an HTTP request. The function takes 5 arguments, 4 of which+-- specify required parameters and the final 'Option' argument is a+-- collection of optional parameters.+--+-- Let's go through all the arguments first: @req method url body response+-- options@.+--+-- @method@ is an HTTP method such as 'GET' or 'POST'. The documentation has+-- a dedicated section about HTTP methods below.+--+-- @url@ is a 'Url' that describes location of resource you want to interact+-- with.+--+-- @body@ is a body option such as 'NoReqBody' or 'ReqBodyJson'. The+-- tutorial has a section about HTTP bodies, but usage is very+-- straightforward and should be clear from the examples.+--+-- @response@ is a type hint how to make and interpret response of an HTTP+-- request. Out-of-the-box it can be the following:+--+--     * 'ignoreResponse'+--     * 'jsonResponse'+--     * 'bsResponse' (to get a strict 'ByteString')+--     * 'lbsResponse' (to get a lazy 'BL.ByteString')+--+-- Finally, @options@ is a 'Monoid' that holds a composite 'Option' for all+-- other optional settings like query parameters, headers, non-standard port+-- number, etc. There are quite a few things you can put there, see the+-- corresponding section in the documentation. If you don't need anything at+-- all, pass 'mempty'.+--+-- __Note__ that if you use 'req' to do all your requests, connection+-- sharing and reuse is done for you automatically.+--+-- See the examples below to get on the speed quickly.+--+-- ==== __Examples__+--+-- First, this is a piece of boilerplate that should be in place before you+-- try the examples:+--+-- > {-# LANGUAGE DeriveGeneric     #-}+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > module Main (main) where+-- >+-- > import Control.Monad+-- > import Control.Monad.IO.Class+-- > import Data.Aeson+-- > import Data.Maybe (fromJust)+-- > import Data.Monoid ((<>))+-- > import Data.Text (Text)+-- > import GHC.Generics+-- > import Network.HTTP.Req+-- > import qualified Data.ByteString.Char8 as B+-- > import qualified Text.URI as URI+--+-- We will be making requests against the <https://httpbin.org> service.+--+-- Make a GET request, grab 5 random bytes:+--+-- > main :: IO ()+-- > main = runReq defaultHttpConfig $ do+-- >   let n :: Int+-- >       n = 5+-- >   bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse mempty+-- >   liftIO $ B.putStrLn (responseBody bs)+--+-- The same, but now we use a query parameter named @\"seed\"@ to control+-- seed of the generator:+--+-- > main :: IO ()+-- > main = runReq defaultHttpConfig $ do+-- >   let n, seed :: Int+-- >       n    = 5+-- >       seed = 100+-- >   bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse $+-- >     "seed" =: seed+-- >   liftIO $ B.putStrLn (responseBody bs)+--+-- POST JSON data and get some info about the POST request:+--+-- > data MyData = MyData+-- >   { size  :: Int+-- >   , color :: Text+-- >   } deriving (Show, Generic)+-- >+-- > instance ToJSON MyData+-- > instance FromJSON MyData+-- >+-- > main :: IO ()+-- > main = runReq defaultHttpConfig $ do+-- >   let myData = MyData+-- >         { size  = 6+-- >         , color = "Green" }+-- >   v <- req POST (https "httpbin.org" /: "post") (ReqBodyJson myData) jsonResponse mempty+-- >   liftIO $ print (responseBody v :: Value)+--+-- Sending URL-encoded body:+--+-- > main :: IO ()+-- > main = runReq defaultHttpConfig $ do+-- >   let params =+-- >         "foo" =: ("bar" :: Text) <>+-- >         queryFlag "baz"+-- >   response <- req POST (https "httpbin.org" /: "post") (ReqBodyUrlEnc params) jsonResponse mempty+-- >   liftIO $ print (responseBody response :: Value)+--+-- Using various optional parameters and URL that is not known in advance:+--+-- > main :: IO ()+-- > main = runReq defaultHttpConfig $ do+-- >   -- This is an example of what to do when URL is given dynamically. Of+-- >   -- course in a real application you may not want to use 'fromJust'.+-- >   uri <- URI.mkURI "https://httpbin.org/get?foo=bar"+-- >   let (url, options) = fromJust (useHttpsURI uri)+-- >   response <- req GET url NoReqBody jsonResponse $+-- >     "from" =: (15 :: Int)           <>+-- >     "to"   =: (67 :: Int)           <>+-- >     basicAuth "username" "password" <>+-- >     options                         <> -- contains the ?foo=bar part+-- >     port 443 -- here you can put any port of course+-- >   liftIO $ print (responseBody response :: Value)+req ::+  ( MonadHttp m,+    HttpMethod method,+    HttpBody body,+    HttpResponse response,+    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)+  ) =>+  -- | HTTP method+  method ->+  -- | 'Url'—location of resource+  Url scheme ->+  -- | Body of the request+  body ->+  -- | A hint how to interpret response+  Proxy response ->+  -- | Collection of optional parameters+  Option scheme ->+  -- | Response+  m response+req method url body responseProxy options =+  reqCb method url body responseProxy options pure++-- | A version of 'req' that does not use one of the predefined instances of+-- 'HttpResponse' but instead allows the user to consume @'L.Response'+-- 'L.BodyReader'@ manually, in a custom way.+--+-- @since 1.0.0+reqBr ::+  ( MonadHttp m,+    HttpMethod method,+    HttpBody body,+    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)+  ) =>+  -- | HTTP method+  method ->+  -- | 'Url'—location of resource+  Url scheme ->+  -- | Body of the request+  body ->+  -- | Collection of optional parameters+  Option scheme ->+  -- | How to consume response+  (L.Response L.BodyReader -> IO a) ->+  -- | Result+  m a+reqBr method url body options consume =+  req' method url body options (reqHandler consume)++-- | A version of 'req' that takes a callback to modify the 'L.Request', but+-- otherwise performs the request identically.+--+-- @since 3.7.0+reqCb ::+  ( MonadHttp m,+    HttpMethod method,+    HttpBody body,+    HttpResponse response,+    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)+  ) =>+  -- | HTTP method+  method ->+  -- | 'Url'—location of resource+  Url scheme ->+  -- | Body of the request+  body ->+  -- | A hint how to interpret response+  Proxy response ->+  -- | Collection of optional parameters+  Option scheme ->+  -- | Callback to modify the request+  (L.Request -> m L.Request) ->+  -- | Response+  m response+reqCb method url body responseProxy options adjustRequest =+  req' method url body (options <> extraOptions) $ \request manager -> do+    request' <- adjustRequest request+    reqHandler getHttpResponse request' manager+  where+    extraOptions =+      case acceptHeader responseProxy of+        Nothing -> mempty+        Just accept -> header "Accept" accept++-- | The default handler function that the higher-level request functions+-- pass to 'req''. Internal function.+--+-- @since 3.7.0+reqHandler ::+  (MonadHttp m) =>+  -- | How to get final result from a 'L.Response'+  (L.Response L.BodyReader -> IO b) ->+  -- | 'L.Request' to perform+  L.Request ->+  -- | 'L.Manager' to use+  L.Manager ->+  m b+reqHandler consume request manager = do+  HttpConfig {..} <- getHttpConfig+  let wrapVanilla = handle (throwIO . VanillaHttpException)+      wrapExc = handle (throwIO . LI.toHttpException request)+      withRRef =+        bracket+          (newIORef Nothing)+          (readIORef >=> mapM_ L.responseClose)+  (liftIO . try . wrapVanilla . wrapExc)+    ( withRRef $ \rref -> do+        let openResponse = mask_ $ do+              r <- readIORef rref+              mapM_ L.responseClose r+              r' <- L.responseOpen request manager+              writeIORef rref (Just r')+              return r'+            exceptionRetryPolicies =+              skipAsyncExceptions+                ++ [ \retryStatus -> Handler $ \e ->+                       return $ httpConfigRetryJudgeException retryStatus e+                   ]+        r <-+          retrying+            httpConfigRetryPolicy+            (\retryStatus r -> return $ httpConfigRetryJudge retryStatus r)+            ( const+                ( recovering+                    httpConfigRetryPolicy+                    exceptionRetryPolicies+                    (const openResponse)+                )+            )+        (preview, r') <- grabPreview httpConfigBodyPreviewLength r+        mapM_ LI.throwHttp (httpConfigCheckResponse request r' preview)+        consume r'+    )+    >>= either handleHttpException return++-- | Mostly like 'req' with respect to its arguments, but accepts a callback+-- that allows to perform a request in arbitrary fashion.+--+-- This function /does not/ perform handling\/wrapping exceptions, checking+-- response (with 'httpConfigCheckResponse'), and retrying. It only prepares+-- 'L.Request' and allows you to use it.+--+-- @since 0.3.0+req' ::+  forall m method body scheme a.+  ( MonadHttp m,+    HttpMethod method,+    HttpBody body,+    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)+  ) =>+  -- | HTTP method+  method ->+  -- | 'Url'—location of resource+  Url scheme ->+  -- | Body of the request+  body ->+  -- | Collection of optional parameters+  Option scheme ->+  -- | How to perform request+  (L.Request -> L.Manager -> m a) ->+  -- | Result+  m a+req' method url body options m = do+  config <- getHttpConfig+  let -- NOTE First appearance of any given header wins. This allows to+      -- “overwrite” headers when we construct a request by cons-ing.+      nubHeaders = Endo $ \x ->+        x {L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x)}+      request' =+        flip appEndo L.defaultRequest $+          -- NOTE The order of 'mappend's matters, here method is overwritten+          -- first and 'options' take effect last. In particular, this means+          -- that 'options' can overwrite things set by other request+          -- components, which is useful for setting port number,+          -- "Content-Type" header, etc.+          nubHeaders+            <> getRequestMod options+            <> getRequestMod config+            <> getRequestMod (Tagged body :: Tagged "body" body)+            <> getRequestMod url+            <> getRequestMod (Tagged method :: Tagged "method" method)+  request <- finalizeRequest options request'+  withReqManager (m request)++-- | Perform an action using the global implicit 'L.Manager' that the rest+-- of the library uses. This allows to reuse connections that the+-- 'L.Manager' controls.+withReqManager :: (MonadIO m) => (L.Manager -> m a) -> m a+withReqManager m = liftIO (readIORef globalManager) >>= m++-- | The global 'L.Manager' that 'req' uses. Here we just go with the+-- default settings, so users don't need to deal with this manager stuff at+-- all, but when we create a request, instance 'HttpConfig' can affect the+-- default settings via 'getHttpConfig'.+--+-- A note about safety, in case 'unsafePerformIO' looks suspicious to you.+-- The value of 'globalManager' is named and lives on top level. This means+-- it will be shared, i.e. computed only once on the first use of the+-- manager. From that moment on the 'IORef' will be just reused—exactly the+-- behavior we want here in order to maximize connection sharing. GHC could+-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.+globalManager :: IORef L.Manager+globalManager = unsafePerformIO $ do+  context <- NC.initConnectionContext+  let settings =+        L.mkManagerSettingsContext+          (Just context)+          def+          Nothing+  manager <- L.newManager settings+  newIORef manager+{-# NOINLINE globalManager #-}++----------------------------------------------------------------------------+-- Embedding requests in your monad++-- $embedding-requests+--+-- To use 'req' in your monad, all you need to do is to make the monad an+-- instance of the 'MonadHttp' type class.+--+-- When writing a library, keep your API polymorphic in terms of+-- 'MonadHttp', only define instance of 'MonadHttp' in final application.+-- Another option is to use a @newtype@-wrapped monad stack and define+-- 'MonadHttp' for it. As of the version /0.4.0/, the 'Req' monad that+-- follows this strategy is provided out-of-the-box (see below).++-- | A type class for monads that support performing HTTP requests.+-- Typically, you only need to define the 'handleHttpException' method+-- unless you want to tweak 'HttpConfig'.+class (MonadIO m) => MonadHttp m where+  -- | This method describes how to deal with 'HttpException' that was+  -- caught by the library. One option is to re-throw it if you are OK with+  -- exceptions, but if you prefer working with something like+  -- 'Control.Monad.Except.MonadError', this is the right place to pass it to+  -- 'Control.Monad.Except.throwError'.+  handleHttpException :: HttpException -> m a++  -- | Return the 'HttpConfig' to be used when performing HTTP requests.+  -- Default implementation returns its 'def' value, which is described in+  -- the documentation for the type. Common usage pattern with manually+  -- defined 'getHttpConfig' is to return some hard-coded value, or a value+  -- extracted from 'Control.Monad.Reader.MonadReader' if a more flexible+  -- approach to configuration is desirable.+  getHttpConfig :: m HttpConfig+  getHttpConfig = return defaultHttpConfig++-- | 'HttpConfig' contains settings to be used when making HTTP requests.+data HttpConfig = HttpConfig+  { -- | Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@+    -- environment variables are respected, this setting overwrites them.+    -- Default value: 'Nothing'.+    httpConfigProxy :: Maybe L.Proxy,+    -- | How many redirects to follow when getting a resource. Default+    -- value: 10.+    httpConfigRedirectCount :: Int,+    -- | Alternative 'L.Manager' to use. 'Nothing' (default value) means+    -- that the default implicit manager will be used (that's what you want+    -- in 99% of cases).+    httpConfigAltManager :: Maybe L.Manager,+    -- | Function to check the response immediately after receiving the+    -- status and headers, before streaming of response body. The third+    -- argument is the beginning of response body (typically first 1024+    -- bytes). This is used for throwing exceptions on non-success status+    -- codes by default (set to @\\_ _ _ -> Nothing@ if this behavior is not+    -- desirable).+    --+    -- When the value this function returns is 'Nothing', nothing will+    -- happen. When it there is 'L.HttpExceptionContent' inside 'Just', it+    -- will be thrown.+    --+    -- Throwing is better then just returning a request with non-2xx status+    -- code because in that case something is wrong and we need a way to+    -- short-cut execution (also remember that Req retries automatically on+    -- request timeouts and such, so when your request fails, it's certainly+    -- something exceptional). The thrown exception is caught by the library+    -- though and is available in 'handleHttpException'.+    --+    -- __Note__: signature of this function was changed in the version+    -- /1.0.0/.+    --+    -- @since 0.3.0+    httpConfigCheckResponse ::+      forall b.+      L.Request ->+      L.Response b ->+      ByteString ->+      Maybe L.HttpExceptionContent,+    -- | The retry policy to use for request retrying. By default 'def' is+    -- used (see 'RetryPolicyM').+    --+    -- __Note__: signature of this function was changed to disallow 'IO' in+    -- version /1.0.0/ and then changed back to its current form in /3.1.0/.+    --+    -- @since 0.3.0+    httpConfigRetryPolicy :: RetryPolicyM IO,+    -- | The function is used to decide whether to retry a request. 'True'+    -- means that the request should be retried.+    --+    -- __Note__: signature of this function was changed in the version+    -- /1.0.0/.+    --+    -- @since 0.3.0+    httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool,+    -- | Similar to 'httpConfigRetryJudge', but is used to decide when to+    -- retry requests that resulted in an exception. By default it retries+    -- on response timeout and connection timeout (changed in version+    -- /3.8.0/).+    --+    -- @since 3.4.0+    httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool,+    -- | Max length of preview fragment of response body.+    --+    -- @since 3.6.0+    httpConfigBodyPreviewLength :: forall a. (Num a) => a+  }+  deriving (Typeable)++-- | The default value of 'HttpConfig'.+--+-- @since 2.0.0+defaultHttpConfig :: HttpConfig+defaultHttpConfig =+  HttpConfig+    { httpConfigProxy = Nothing,+      httpConfigRedirectCount = 10,+      httpConfigAltManager = Nothing,+      httpConfigCheckResponse = \_ response preview ->+        let scode = statusCode response+         in if 200 <= scode && scode < 300+              then Nothing+              else Just (L.StatusCodeException (void response) preview),+      httpConfigRetryPolicy = retryPolicyDefault,+      httpConfigRetryJudge = \_ response ->+        statusCode response+          `elem` [ 408, -- Request timeout+                   504, -- Gateway timeout+                   524, -- A timeout occurred+                   598, -- (Informal convention) Network read timeout error+                   599 -- (Informal convention) Network connect timeout error+                 ],+      httpConfigRetryJudgeException = \_ e ->+        case fromException e of+          Just (L.HttpExceptionRequest _ c) ->+            case c of+              L.ResponseTimeout -> True+              L.ConnectionTimeout -> True+              _ -> False+          _ -> False,+      httpConfigBodyPreviewLength = 1024+    }+  where+    statusCode = Y.statusCode . L.responseStatus++instance RequestComponent HttpConfig where+  getRequestMod HttpConfig {..} = Endo $ \x ->+    x+      { L.proxy = httpConfigProxy,+        L.redirectCount = httpConfigRedirectCount,+        LI.requestManagerOverride = httpConfigAltManager+      }++-- | A monad that allows us to run 'req' in any 'IO'-enabled monad without+-- having to define new instances.+--+-- @since 0.4.0+newtype Req a = Req (ReaderT HttpConfig IO a)+  deriving+    ( Functor,+      Applicative,+      Monad,+      MonadIO,+      MonadUnliftIO+    )++-- | @since 3.7.0+deriving instance MonadThrow Req++-- | @since 3.7.0+deriving instance MonadCatch Req++-- | @since 3.7.0+deriving instance MonadMask Req++instance MonadBase IO Req where+  liftBase = liftIO++instance MonadBaseControl IO Req where+  type StM Req a = a+  liftBaseWith f = Req . ReaderT $ \r -> f (runReq r)+  {-# INLINEABLE liftBaseWith #-}+  restoreM = Req . ReaderT . const . return+  {-# INLINEABLE restoreM #-}++instance MonadHttp Req where+  handleHttpException = Req . lift . throwIO+  getHttpConfig = Req ask++-- | @since 3.10.0+instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m) => MonadHttp (ContT r m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m) => MonadHttp (ExceptT e m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m) => MonadHttp (IdentityT m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m) => MonadHttp (MaybeT m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m) => MonadHttp (ReaderT r m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.CPS.RWST r w s m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Lazy.RWST r w s m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Strict.RWST r w s m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m) => MonadHttp (SelectT r m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m) => MonadHttp (State.Lazy.StateT s m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m) => MonadHttp (State.Strict.StateT s m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.CPS.WriterT w m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Lazy.WriterT w m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | @since 3.10.0+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Strict.WriterT w m) where+  handleHttpException = lift . handleHttpException+  getHttpConfig = lift getHttpConfig++-- | Run a computation in the 'Req' monad with the given 'HttpConfig'. In+-- the case of an exceptional situation an 'HttpException' will be thrown.+--+-- @since 0.4.0+runReq ::+  (MonadIO m) =>+  -- | 'HttpConfig' to use+  HttpConfig ->+  -- | Computation to run+  Req a ->+  m a+runReq config (Req m) = liftIO (runReaderT m config)++----------------------------------------------------------------------------+-- Request—Method++-- $method+--+-- The package supports all methods as defined by RFC 2616, and 'PATCH'+-- which is defined by RFC 5789—that should be enough to talk to RESTful+-- APIs. In some cases, however, you may want to add more methods (e.g. you+-- work with WebDAV <https://en.wikipedia.org/wiki/WebDAV>); no need to+-- compromise on type safety and hack, it only takes a couple of seconds to+-- define a new method that will works seamlessly, see 'HttpMethod'.++-- | 'GET' method.+data GET = GET++instance HttpMethod GET where+  type AllowsBody GET = 'NoBody+  httpMethodName Proxy = Y.methodGet++-- | 'POST' method.+data POST = POST++instance HttpMethod POST where+  type AllowsBody POST = 'CanHaveBody+  httpMethodName Proxy = Y.methodPost++-- | 'HEAD' method.+data HEAD = HEAD++instance HttpMethod HEAD where+  type AllowsBody HEAD = 'NoBody+  httpMethodName Proxy = Y.methodHead++-- | 'PUT' method.+data PUT = PUT++instance HttpMethod PUT where+  type AllowsBody PUT = 'CanHaveBody+  httpMethodName Proxy = Y.methodPut++-- | 'DELETE' method. RFC 7231 allows a payload in DELETE but without+-- semantics.+--+-- __Note__: before version /3.4.0/ this method did not allow request+-- bodies.+data DELETE = DELETE++instance HttpMethod DELETE where+  type AllowsBody DELETE = 'CanHaveBody+  httpMethodName Proxy = Y.methodDelete++-- | 'TRACE' method.+data TRACE = TRACE++instance HttpMethod TRACE where+  type AllowsBody TRACE = 'CanHaveBody+  httpMethodName Proxy = Y.methodTrace++-- | 'CONNECT' method.+data CONNECT = CONNECT++instance HttpMethod CONNECT where+  type AllowsBody CONNECT = 'CanHaveBody+  httpMethodName Proxy = Y.methodConnect++-- | 'OPTIONS' method.+data OPTIONS = OPTIONS++instance HttpMethod OPTIONS where+  type AllowsBody OPTIONS = 'NoBody+  httpMethodName Proxy = Y.methodOptions++-- | 'PATCH' method.+data PATCH = PATCH++instance HttpMethod PATCH where+  type AllowsBody PATCH = 'CanHaveBody+  httpMethodName Proxy = Y.methodPatch++-- | A type class for types that can be used as an HTTP method. To define a+-- non-standard method, follow this example that defines @COPY@:+--+-- > data COPY = COPY+-- >+-- > instance HttpMethod COPY where+-- >   type AllowsBody COPY = 'CanHaveBody+-- >   httpMethodName Proxy = "COPY"+class HttpMethod a where+  -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which+  -- tells the rest of the library whether the method can have body or not.+  -- We use the special type 'CanHaveBody' lifted to the kind level instead+  -- of 'Bool' to get more user-friendly compiler messages.+  type AllowsBody a :: CanHaveBody++  -- | Return name of the method as a 'ByteString'.+  httpMethodName :: Proxy a -> ByteString++instance (HttpMethod method) => RequestComponent (Tagged "method" method) where+  getRequestMod _ = Endo $ \x ->+    x {L.method = httpMethodName (Proxy :: Proxy method)}++----------------------------------------------------------------------------+-- Request—URL++-- $url+--+-- We use 'Url's which are correct by construction, see 'Url'. To build a+-- 'Url' from a 'URI', use 'useHttpURI', 'useHttpsURI', or generic 'useURI'.++-- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https'+-- specifying the scheme and host at the same time. Then use the @('/~')@+-- and @('/:')@ operators to grow the path one piece at a time. Every single+-- piece of path will be url(percent)-encoded, so using @('/~')@ and+-- @('/:')@ is the only way to have forward slashes between path segments.+-- This approach makes working with dynamic path segments easy and safe. See+-- examples below how to represent various 'Url's (make sure the+-- @OverloadedStrings@ language extension is enabled).+--+-- ==== __Examples__+--+-- > http "httpbin.org"+-- > -- http://httpbin.org+--+-- > https "httpbin.org"+-- > -- https://httpbin.org+--+-- > https "httpbin.org" /: "encoding" /: "utf8"+-- > -- https://httpbin.org/encoding/utf8+--+-- > https "httpbin.org" /: "foo" /: "bar/baz"+-- > -- https://httpbin.org/foo/bar%2Fbaz+--+-- > https "httpbin.org" /: "bytes" /~ (10 :: Int)+-- > -- https://httpbin.org/bytes/10+--+-- > https "юникод.рф"+-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84+data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)+  -- NOTE The second value is the path segments in reversed order.+  deriving (Eq, Ord, Show, Data, Typeable, Generic)++type role Url nominal++-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however+-- the derived lift forgets the type of the scheme.+instance (Typeable scheme) => TH.Lift (Url scheme) where+  lift url =+    TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of+      Url Http _ -> [t|Url 'Http|]+      Url Https _ -> [t|Url 'Https|]+    where+      liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)+  liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift++-- | Given host name, produce a 'Url' which has “http” as its scheme and+-- empty path. This also sets port to @80@.+http :: Text -> Url 'Http+http = Url Http . pure++-- | Given host name, produce a 'Url' which has “https” as its scheme and+-- empty path. This also sets port to @443@.+https :: Text -> Url 'Https+https = Url Https . pure++-- | Grow a given 'Url' appending a single path segment to it. Note that the+-- path segment can be of any type that is an instance of 'ToHttpApiData'.+infixl 5 /~++(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme+Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)++-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases+-- when next URL piece is a 'Data.Text.Text' literal.+infixl 5 /:++(/:) :: Url scheme -> Text -> Url scheme+(/:) = (/~)++-- | Render a 'Url' as 'Text'.+--+-- @since 3.4.0+renderUrl :: Url scheme -> Text+renderUrl = \case+  Url Https parts ->+    "https://" <> renderParts parts+  Url Http parts ->+    "http://" <> renderParts parts+  where+    renderParts parts =+      T.intercalate "/" (reverse $ NE.toList parts)++-- | The 'useHttpURI' function provides an alternative method to get 'Url'+-- (possibly with some 'Option's) from a 'URI'. This is useful when you are+-- given a URL to query dynamically and don't know it beforehand.+--+-- This function expects the scheme to be “http” and host to be present.+--+-- @since 3.0.0+useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)+useHttpURI uri = do+  guard (URI.uriScheme uri == Just [QQ.scheme|http|])+  urlHead <- http <$> uriHost uri+  let url = case URI.uriPath uri of+        Nothing -> urlHead+        Just uriPath -> uriPathToUrl uriPath urlHead+  return (url, uriOptions uri)++-- | Just like 'useHttpURI', but expects the “https” scheme.+--+-- @since 3.0.0+useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)+useHttpsURI uri = do+  guard (URI.uriScheme uri == Just [QQ.scheme|https|])+  urlHead <- https <$> uriHost uri+  let url = case URI.uriPath uri of+        Nothing -> urlHead+        Just uriPath -> uriPathToUrl uriPath urlHead+  return (url, uriOptions uri)++-- | Convert URI path to a 'Url'. Internal.+--+-- @since 3.9.0+uriPathToUrl ::+  (Bool, NonEmpty (URI.RText 'URI.PathPiece)) ->+  Url scheme ->+  Url scheme+uriPathToUrl (trailingSlash, xs) urlHead =+  if trailingSlash then path /: T.empty else path+  where+    path = foldl' (/:) urlHead (URI.unRText <$> NE.toList xs)++-- | A combination of 'useHttpURI' and 'useHttpsURI' for cases when scheme+-- is not known in advance.+--+-- @since 3.0.0+useURI ::+  URI ->+  Maybe+    ( Either+        (Url 'Http, Option scheme0)+        (Url 'Https, Option scheme1)+    )+useURI uri =+  (Left <$> useHttpURI uri) <|> (Right <$> useHttpsURI uri)++-- | An internal helper function to extract host from a 'URI'.+uriHost :: URI -> Maybe Text+uriHost uri = case URI.uriAuthority uri of+  Left _ -> Nothing+  Right URI.Authority {..} ->+    Just (URI.unRText authHost)++-- | A quasiquoter to build an 'Url' and 'Option' tuple. The type of the+-- generated expression is @('Url' scheme0, 'Option' scheme1)@ with+-- @scheme0@ being either 'Http' or 'Https' depending on the input.+--+-- @since 3.2.0+urlQ :: TH.QuasiQuoter+urlQ =+  TH.QuasiQuoter+    { quoteExp = \str ->+        case URI.mkURI (T.pack str) of+          Left err -> fail (displayException err)+          Right uri -> case useURI uri of+            Nothing -> fail "Not a HTTP or HTTPS URL"+            Just eurl ->+              TH.tupE+                [ either (TH.lift . fst) (TH.lift . fst) eurl,+                  [|uriOptions uri|]+                ],+      quotePat = error "This usage is not supported",+      quoteType = error "This usage is not supported",+      quoteDec = error "This usage is not supported"+    }++-- | An internal helper function to extract 'Option's from a 'URI'.+uriOptions :: forall scheme. URI -> Option scheme+uriOptions uri =+  mconcat+    [ auth,+      query,+      port'+      -- , fragment'+    ]+  where+    (auth, port') =+      case URI.uriAuthority uri of+        Left _ -> (mempty, mempty)+        Right URI.Authority {..} ->+          let auth0 = case authUserInfo of+                Nothing -> mempty+                Just URI.UserInfo {..} ->+                  let username = T.encodeUtf8 (URI.unRText uiUsername)+                      password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword+                   in basicAuthUnsafe username password+              port0 = case authPort of+                Nothing -> mempty+                Just port'' -> port (fromIntegral port'')+           in (auth0, port0)+    query =+      let liftQueryParam = \case+            URI.QueryFlag t -> queryFlag (URI.unRText t)+            URI.QueryParam k v -> URI.unRText k =: URI.unRText v+       in mconcat (liftQueryParam <$> URI.uriQuery uri)++-- TODO Blocked on upstream: https://github.com/snoyberg/http-client/issues/424+-- fragment' =+--   case URI.uriFragment uri of+--     Nothing -> mempty+--     Just fragment'' -> fragment (URI.unRText fragment'')++instance RequestComponent (Url scheme) where+  getRequestMod (Url scheme segments) = Endo $ \x ->+    let (host :| path) = NE.reverse segments+     in x+          { L.secure = case scheme of+              Http -> False+              Https -> True,+            L.port = case scheme of+              Http -> 80+              Https -> 443,+            L.host = Y.urlEncode False (T.encodeUtf8 host),+            L.path =+              (BL.toStrict . BB.toLazyByteString . Y.encodePathSegments) path+          }++----------------------------------------------------------------------------+-- Request—Body++-- $body+--+-- A number of options for request bodies are available. The @Content-Type@+-- header is set for you automatically according to the body option you use+-- (it's always specified in the documentation for a given body option). To+-- add your own way to represent request body, define an instance of+-- 'HttpBody'.++-- | This data type represents empty body of an HTTP request. This is the+-- data type to use with 'HttpMethod's that cannot have a body, as it's the+-- only type for which 'ProvidesBody' returns 'NoBody'.+--+-- Using of this body option does not set the @Content-Type@ header.+data NoReqBody = NoReqBody++instance HttpBody NoReqBody where+  getRequestBody NoReqBody = L.RequestBodyBS B.empty++-- | This body option allows us to use a JSON object as the request+-- body—probably the most popular format right now. Just wrap a data type+-- that is an instance of 'ToJSON' type class and you are done: it will be+-- converted to JSON and inserted as request body.+--+-- This body option sets the @Content-Type@ header to @\"application/json;+-- charset=utf-8\"@ value.+newtype ReqBodyJson a = ReqBodyJson a++instance (ToJSON a) => HttpBody (ReqBodyJson a) where+  getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)+  getRequestContentType _ = pure "application/json; charset=utf-8"++-- | This body option streams request body from a file. It is expected that+-- the file size does not change during streaming.+--+-- Using of this body option does not set the @Content-Type@ header.+newtype ReqBodyFile = ReqBodyFile FilePath++instance HttpBody ReqBodyFile where+  getRequestBody (ReqBodyFile path) =+    LI.RequestBodyIO (L.streamFile path)++-- | HTTP request body represented by a strict 'ByteString'.+--+-- Using of this body option does not set the @Content-Type@ header.+newtype ReqBodyBs = ReqBodyBs ByteString++instance HttpBody ReqBodyBs where+  getRequestBody (ReqBodyBs bs) = L.RequestBodyBS bs++-- | HTTP request body represented by a lazy 'BL.ByteString'.+--+-- Using of this body option does not set the @Content-Type@ header.+newtype ReqBodyLbs = ReqBodyLbs BL.ByteString++instance HttpBody ReqBodyLbs where+  getRequestBody (ReqBodyLbs bs) = L.RequestBodyLBS bs++-- | URL-encoded body. This can hold a collection of parameters which are+-- encoded similarly to query parameters at the end of query string, with+-- the only difference that they are stored in request body. The similarity+-- is reflected in the API as well, as you can use the same combinators you+-- would use to add query parameters: @('=:')@ and 'queryFlag'.+--+-- This body option sets the @Content-Type@ header to+-- @\"application/x-www-form-urlencoded\"@ value.+newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam++instance HttpBody ReqBodyUrlEnc where+  getRequestBody (ReqBodyUrlEnc (FormUrlEncodedParam params)) =+    (L.RequestBodyLBS . BB.toLazyByteString) (Y.renderQueryText False params)+  getRequestContentType _ = pure "application/x-www-form-urlencoded"++-- | An opaque monoidal value that allows to collect URL-encoded parameters+-- to be wrapped in 'ReqBodyUrlEnc'.+newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]+  deriving (Semigroup, Monoid)++instance QueryParam FormUrlEncodedParam where+  queryParam name mvalue =+    FormUrlEncodedParam [(name, toQueryParam <$> mvalue)]+  queryParamToList (FormUrlEncodedParam p) = p++-- | Use 'formToQuery'.+--+-- @since 3.11.0+instance FromForm FormUrlEncodedParam where+  fromForm = Right . formToQuery++-- | Multipart form data. Please consult the+-- "Network.HTTP.Client.MultipartFormData" module for how to construct+-- parts, then use 'reqBodyMultipart' to create actual request body from the+-- parts. 'reqBodyMultipart' is the only way to get a value of the type+-- 'ReqBodyMultipart', as its constructor is not exported on purpose.+--+-- @since 0.2.0+--+-- ==== __Examples__+--+-- > import Control.Monad.IO.Class+-- > import Data.Default.Class+-- > import Network.HTTP.Req+-- > import qualified Network.HTTP.Client.MultipartFormData as LM+-- >+-- > main :: IO ()+-- > main = runReq def $ do+-- >   body <-+-- >     reqBodyMultipart+-- >       [ LM.partBS "title" "My Image"+-- >       , LM.partFileSource "file1" "/tmp/image.jpg"+-- >       ]+-- >   response <-+-- >     req POST (http "example.com" /: "post")+-- >       body+-- >       bsResponse+-- >       mempty+-- >   liftIO $ print (responseBody response)+data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody++instance HttpBody ReqBodyMultipart where+  getRequestBody (ReqBodyMultipart _ body) = body+  getRequestContentType (ReqBodyMultipart boundary _) =+    pure ("multipart/form-data; boundary=" <> boundary)++-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.+--+-- @since 0.2.0+reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart+reqBodyMultipart parts = liftIO $ do+  boundary <- LM.webkitBoundary+  body <- LM.renderParts boundary parts+  return (ReqBodyMultipart boundary body)++-- | A type class for things that can be interpreted as an HTTP+-- 'L.RequestBody'.+class HttpBody body where+  -- | How to get actual 'L.RequestBody'.+  getRequestBody :: body -> L.RequestBody++  -- | This method allows us to optionally specify the value of+  -- @Content-Type@ header that should be used with particular body option.+  -- By default it returns 'Nothing' and so @Content-Type@ is not set.+  getRequestContentType :: body -> Maybe ByteString+  getRequestContentType = const Nothing++-- | The type function recognizes 'NoReqBody' as having 'NoBody', while any+-- other body option 'CanHaveBody'. This forces the user to use 'NoReqBody'+-- with 'GET' method and other methods that should not have body.+type family ProvidesBody body :: CanHaveBody where+  ProvidesBody NoReqBody = 'NoBody+  ProvidesBody body = 'CanHaveBody++-- | This type function allows any HTTP body if method says it+-- 'CanHaveBody'. When the method says it should have 'NoBody', the only+-- body option to use is 'NoReqBody'.+type family+  HttpBodyAllowed+    (allowsBody :: CanHaveBody)+    (providesBody :: CanHaveBody) ::+    Constraint+  where+  HttpBodyAllowed 'NoBody 'NoBody = ()+  HttpBodyAllowed 'CanHaveBody body = ()+  HttpBodyAllowed 'NoBody 'CanHaveBody =+    TypeError+      ('Text "This HTTP method does not allow attaching a request body.")++instance (HttpBody body) => RequestComponent (Tagged "body" body) where+  getRequestMod (Tagged body) = Endo $ \x ->+    x+      { L.requestBody = getRequestBody body,+        L.requestHeaders =+          let old = L.requestHeaders x+           in case getRequestContentType body of+                Nothing -> old+                Just contentType ->+                  (Y.hContentType, contentType) : old+      }++----------------------------------------------------------------------------+-- Request—Optional parameters++-- $optional-parameters+--+-- Optional parameters of request include things like query parameters,+-- headers, port number, etc. All optional parameters have the type+-- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as+-- the last argument of 'req' to specify no optional parameters, or combine+-- 'Option's using 'mappend' or @('<>')@ to have several of them at once.++-- | The opaque 'Option' type is a 'Monoid' you can use to pack collection+-- of optional parameters like query parameters and headers. See sections+-- below to learn which 'Option' primitives are available.+data Option (scheme :: Scheme)+  = Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))++-- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with+-- Request to avoid appending to an existing query string in request every+-- time new parameter is added. The additional Maybe (L.Request -> IO+-- L.Request) is a finalizer that will be applied after all other+-- transformations. This is for authentication methods that sign requests+-- based on data in Request.++instance Semigroup (Option scheme) where+  Option er0 mr0 <> Option er1 mr1 =+    Option+      (er0 <> er1)+      (mr0 <|> mr1)++instance Monoid (Option scheme) where+  mempty = Option mempty Nothing+  mappend = (<>)++-- | Use 'formToQuery'.+--+-- @since 3.11.0+instance FromForm (Option scheme) where+  fromForm = Right . formToQuery++-- | A helper to create an 'Option' that modifies only collection of query+-- parameters. This helper is not a part of the public API.+withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme+withQueryParams f = Option (Endo (first f)) Nothing++-- | A helper to create an 'Option' that modifies only 'L.Request'. This+-- helper is not a part of public API.+withRequest :: (L.Request -> L.Request) -> Option scheme+withRequest f = Option (Endo (second f)) Nothing++instance RequestComponent (Option scheme) where+  getRequestMod (Option f _) = Endo $ \x ->+    let (qparams, x') = appEndo f ([], x)+        query = Y.renderQuery True (Y.queryTextToQuery qparams)+     in x' {L.queryString = query}++-- | Finalize given 'L.Request' by applying a finalizer from the given+-- 'Option' (if it has any).+finalizeRequest :: (MonadIO m) => Option scheme -> L.Request -> m L.Request+finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer++----------------------------------------------------------------------------+-- Request—Optional parameters—Query Parameters++-- $query-parameters+--+-- This section describes a polymorphic interface that can be used to+-- construct query parameters (of the type 'Option') and form URL-encoded+-- bodies (of the type 'FormUrlEncodedParam').++-- | This operator builds a query parameter that will be included in URL of+-- your request after the question sign @?@. This is the same syntax you use+-- with form URL encoded request bodies.+--+-- This operator is defined in terms of 'queryParam':+--+-- > name =: value = queryParam name (pure value)+infix 7 =:++(=:) :: (QueryParam param, ToHttpApiData a) => Text -> a -> param+name =: value = queryParam name (pure value)++-- | Construct a flag, that is, a valueless query parameter. For example, in+-- the following URL @\"a\"@ is a flag, while @\"b\"@ is a query parameter+-- with a value:+--+-- > https://httpbin.org/foo/bar?a&b=10+--+-- This operator is defined in terms of 'queryParam':+--+-- > queryFlag name = queryParam name (Nothing :: Maybe ())+queryFlag :: (QueryParam param) => Text -> param+queryFlag name = queryParam name (Nothing :: Maybe ())++-- | Construct query parameters from a 'ToForm' instance. This function+-- produces the same query params as 'Form.urlEncodeAsFormStable'.+--+-- Note that 'Form.Form' doesn't have the concept of parameters with the+-- empty value (i.e. what you can get by @key =: ""@). If the value is+-- empty, it will be encoded as a valueless parameter (i.e. what you can get+-- by @queryFlag key@).+--+-- @since 3.11.0+formToQuery :: (QueryParam param, Monoid param, ToForm f) => f -> param+formToQuery f = mconcat . fmap toParam . Form.toListStable $ toForm f+  where+    toParam (key, val) =+      queryParam key $+        if val == ""+          then Nothing+          else Just val++-- | A type class for query-parameter-like things. The reason to have an+-- overloaded 'queryParam' is to be able to use it as an 'Option' and as a+-- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.+-- Having the same syntax for these cases seems natural and user-friendly.+class QueryParam param where+  -- | Create a query parameter with given name and value. If value is+  -- 'Nothing', it won't be included at all (i.e. you create a flag this+  -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this+  -- method, because they are easier to read.+  queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param++  -- | Get the query parameter names and values set by 'queryParam'.+  --+  -- @since 3.11.0+  queryParamToList :: param -> [(Text, Maybe Text)]++instance QueryParam (Option scheme) where+  queryParam name mvalue =+    withQueryParams ((:) (name, toQueryParam <$> mvalue))+  queryParamToList (Option f _) = fst $ appEndo f ([], L.defaultRequest)++----------------------------------------------------------------------------+-- Request—Optional parameters—Headers++-- | Create an 'Option' that adds a header. Note that if you 'mappend' two+-- headers with the same names the leftmost header will win. This means, in+-- particular, that you cannot create a request with several headers of the+-- same name.+header ::+  -- | Header name+  ByteString ->+  -- | Header value+  ByteString ->+  Option scheme+header name value = withRequest (attachHeader name value)++-- | Attach a header with given name and content to a 'L.Request'.+--+-- @since 1.1.0+attachHeader :: ByteString -> ByteString -> L.Request -> L.Request+attachHeader name value x =+  x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}++-- | Same as 'header', but with redacted values on print.+--+-- @since 3.13.0+headerRedacted :: ByteString -> ByteString -> Option scheme+headerRedacted name value = withRequest $ \x ->+  let y = attachHeader name value x+   in y {L.redactHeaders = CI.mk name `S.insert` L.redactHeaders y}++----------------------------------------------------------------------------+-- Request—Optional parameters—Cookies++-- $cookies+--+-- Support for cookies is quite minimalistic at the moment. It's possible to+-- specify which cookies to send using 'cookieJar' and inspect 'L.Response'+-- to extract 'L.CookieJar' from it (see 'responseCookieJar').++-- | Use the given 'L.CookieJar'. A 'L.CookieJar' can be obtained from a+-- 'L.Response' record.+cookieJar :: L.CookieJar -> Option scheme+cookieJar jar = withRequest $ \x ->+  x {L.cookieJar = Just jar}++----------------------------------------------------------------------------+-- Request—Optional parameters—Authentication++-- $authentication+--+-- This section provides the common authentication helpers in the form of+-- 'Option's. You should always prefer the provided authentication 'Option's+-- to manual construction of headers because it ensures that you only use+-- one authentication method at a time (they overwrite each other) and+-- provides additional type safety that prevents leaking of credentials in+-- the cases when authentication relies on HTTPS for encrypting sensitive+-- data.++-- | The 'Option' adds basic authentication.+--+-- See also: <https://en.wikipedia.org/wiki/Basic_access_authentication>.+basicAuth ::+  -- | Username+  ByteString ->+  -- | Password+  ByteString ->+  -- | Auth 'Option'+  Option 'Https+basicAuth = basicAuthUnsafe++-- | An alternative to 'basicAuth' which works for any scheme. Note that+-- using basic access authentication without SSL\/TLS is vulnerable to+-- attacks. Use 'basicAuth' instead unless you know what you are doing.+--+-- @since 0.3.1+basicAuthUnsafe ::+  -- | Username+  ByteString ->+  -- | Password+  ByteString ->+  -- | Auth 'Option'+  Option scheme+basicAuthUnsafe username password =+  customAuth+    (pure . L.applyBasicAuth username password)++-- | The 'Option' set basic proxy authentication header.+--+-- @since 1.1.0+basicProxyAuth ::+  -- | Username+  ByteString ->+  -- | Password+  ByteString ->+  -- | Auth 'Option'+  Option scheme+basicProxyAuth username password =+  withRequest (L.applyBasicProxyAuth username password)++-- | The 'Option' adds OAuth1 authentication.+--+-- @since 0.2.0+oAuth1 ::+  -- | Consumer token+  ByteString ->+  -- | Consumer secret+  ByteString ->+  -- | OAuth token+  ByteString ->+  -- | OAuth token secret+  ByteString ->+  -- | Auth 'Option'+  Option scheme+oAuth1 consumerToken consumerSecret token tokenSecret =+  customAuth (OAuth.signOAuth app creds)+  where+    app =+      OAuth.newOAuth+        { OAuth.oauthConsumerKey = consumerToken,+          OAuth.oauthConsumerSecret = consumerSecret+        }+    creds = OAuth.newCredential token tokenSecret++-- | The 'Option' adds an OAuth2 bearer token. This is treated by many+-- services as the equivalent of a username and password.+--+-- The 'Option' is defined as:+--+-- > oAuth2Bearer token = header "Authorization" ("Bearer " <> token)+--+-- See also: <https://en.wikipedia.org/wiki/OAuth>.+oAuth2Bearer ::+  -- | Token+  ByteString ->+  -- | Auth 'Option'+  Option 'Https+oAuth2Bearer token =+  customAuth+    (pure . attachHeader "Authorization" ("Bearer " <> token))++-- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems+-- to be used only by GitHub). This will be treated by whatever services+-- accept it as the equivalent of a username and password.+--+-- The 'Option' is defined as:+--+-- > oAuth2Token token = header "Authorization" ("token" <> token)+--+-- See also: <https://developer.github.com/v3/oauth#3-use-the-access-token-to-access-the-api>.+oAuth2Token ::+  -- | Token+  ByteString ->+  -- | Auth 'Option'+  Option 'Https+oAuth2Token token =+  customAuth+    (pure . attachHeader "Authorization" ("token " <> token))++-- | A helper to create custom authentication 'Option's. The given+-- 'IO'-enabled request transformation is applied after all other+-- modifications when constructing a request. Use wisely.+--+-- @since 1.1.0+customAuth :: (L.Request -> IO L.Request) -> Option scheme+customAuth = Option mempty . pure++----------------------------------------------------------------------------+-- Request—Optional parameters—Other++-- | Specify the port to connect to explicitly. Normally, 'Url' you use+-- determines the default port: @80@ for HTTP and @443@ for HTTPS. This+-- 'Option' allows us to choose an arbitrary port overwriting the defaults.+port :: Int -> Option scheme+port n = withRequest $ \x ->+  x {L.port = n}++-- | This 'Option' controls whether gzipped data should be decompressed on+-- the fly. By default everything except for @\"application\/x-tar\"@ is+-- decompressed, i.e. we have:+--+-- > decompress (/= "application/x-tar")+--+-- You can also choose to decompress everything like this:+--+-- > decompress (const True)+decompress ::+  -- | Predicate that is given MIME type, it returns 'True' when content+  -- should be decompressed on the fly.+  (ByteString -> Bool) ->+  Option scheme+decompress f = withRequest $ \x ->+  x {L.decompress = f}++-- | Specify the number of microseconds to wait for response. The default+-- value is 30 seconds (defined in 'L.ManagerSettings' of connection+-- 'L.Manager').+responseTimeout ::+  -- | Number of microseconds to wait+  Int ->+  Option scheme+responseTimeout n = withRequest $ \x ->+  x {L.responseTimeout = LI.ResponseTimeoutMicro n}++-- | HTTP version to send to the server, the default is HTTP 1.1.+httpVersion ::+  -- | Major version number+  Int ->+  -- | Minor version number+  Int ->+  Option scheme+httpVersion major minor = withRequest $ \x ->+  x {L.requestVersion = Y.HttpVersion major minor}++----------------------------------------------------------------------------+-- Response interpretations++-- | Make a request and ignore the body of the response.+newtype IgnoreResponse = IgnoreResponse (L.Response ())+  deriving (Show)++instance HttpResponse IgnoreResponse where+  type HttpResponseBody IgnoreResponse = ()+  toVanillaResponse (IgnoreResponse r) = r+  getHttpResponse r = return $ IgnoreResponse (void r)++-- | Use this as the fourth argument of 'req' to specify that you want it to+-- ignore the response body.+ignoreResponse :: Proxy IgnoreResponse+ignoreResponse = Proxy++-- | Make a request and interpret the body of the response as JSON. The+-- 'handleHttpException' method of 'MonadHttp' instance corresponding to+-- monad in which you use 'req' will determine what to do in the case when+-- parsing fails (the 'JsonHttpException' constructor will be used).+newtype JsonResponse a = JsonResponse (L.Response a)+  deriving (Show)++instance (FromJSON a) => HttpResponse (JsonResponse a) where+  type HttpResponseBody (JsonResponse a) = a+  toVanillaResponse (JsonResponse r) = r+  getHttpResponse r = do+    chunks <- L.brConsume (L.responseBody r)+    case A.eitherDecode (BL.fromChunks chunks) of+      Left e -> throwIO (JsonHttpException e)+      Right x -> return $ JsonResponse (x <$ r)+  acceptHeader Proxy = Just "application/json"++-- | Use this as the fourth argument of 'req' to specify that you want it to+-- return the 'JsonResponse' interpretation.+jsonResponse :: Proxy (JsonResponse a)+jsonResponse = Proxy++-- | Make a request and interpret the body of the response as a strict+-- 'ByteString'.+newtype BsResponse = BsResponse (L.Response ByteString)+  deriving (Show)++instance HttpResponse BsResponse where+  type HttpResponseBody BsResponse = ByteString+  toVanillaResponse (BsResponse r) = r+  getHttpResponse r = do+    chunks <- L.brConsume (L.responseBody r)+    return $ BsResponse (B.concat chunks <$ r)++-- | Use this as the fourth argument of 'req' to specify that you want to+-- interpret the response body as a strict 'ByteString'.+bsResponse :: Proxy BsResponse+bsResponse = Proxy++-- | Make a request and interpret the body of the response as a lazy+-- 'BL.ByteString'.+newtype LbsResponse = LbsResponse (L.Response BL.ByteString)+  deriving (Show)++instance HttpResponse LbsResponse where+  type HttpResponseBody LbsResponse = BL.ByteString+  toVanillaResponse (LbsResponse r) = r+  getHttpResponse r = do+    chunks <- L.brConsume (L.responseBody r)+    return $ LbsResponse (BL.fromChunks chunks <$ r)++-- | Use this as the fourth argument of 'req' to specify that you want to+-- interpret the response body as a lazy 'BL.ByteString'.+lbsResponse :: Proxy LbsResponse+lbsResponse = Proxy++----------------------------------------------------------------------------+-- Helpers for response interpretations++-- | Fetch beginning of the response and return it together with a new+-- @'L.Response' 'L.BodyReader'@ that can be passed to 'getHttpResponse' and+-- such.+grabPreview ::+  -- | How many bytes to fetch+  Int ->+  -- | Response with body reader inside+  L.Response L.BodyReader ->+  -- | Preview 'ByteString' and new response with body reader inside+  IO (ByteString, L.Response L.BodyReader)+grabPreview nbytes r = do+  let br = L.responseBody r+  (target, leftover, done) <- brReadN br nbytes+  nref <- newIORef (0 :: Int)+  let br' = do+        n <- readIORef nref+        let incn = modifyIORef' nref (+ 1)+        case n of+          0 -> do+            incn+            if B.null target+              then br'+              else return target+          1 -> do+            incn+            if B.null leftover+              then br'+              else return leftover+          _ ->+            if done+              then return B.empty+              else br+  return (target, r {L.responseBody = br'})++-- | Consume N bytes from 'L.BodyReader', return the target chunk, the+-- leftover (may be empty), and whether we're done consuming the body.+brReadN ::+  -- | Body reader to stream from+  L.BodyReader ->+  -- | How many bytes to consume+  Int ->+  -- | Target chunk, the leftover, whether we're done+  IO (ByteString, ByteString, Bool)+brReadN br n = go 0 id id+  where+    go !tlen t l = do+      chunk <- br+      if B.null chunk+        then return (r t, r l, True)+        else do+          let (target, leftover) = B.splitAt (n - tlen) chunk+              tlen' = B.length target+              t' = t . (target :)+              l' = l . (leftover :)+          if tlen + tlen' < n+            then go (tlen + tlen') t' l'+            else return (r t', r l', False)+    r f = B.concat (f [])++----------------------------------------------------------------------------+-- Inspecting a response++-- | Get the response body.+responseBody ::+  (HttpResponse response) =>+  response ->+  HttpResponseBody response+responseBody = L.responseBody . toVanillaResponse++-- | Get the response status code.+responseStatusCode ::+  (HttpResponse response) =>+  response ->+  Int+responseStatusCode =+  Y.statusCode . L.responseStatus . toVanillaResponse++-- | Get the response status message.+responseStatusMessage ::+  (HttpResponse response) =>+  response ->+  ByteString+responseStatusMessage =+  Y.statusMessage . L.responseStatus . toVanillaResponse++-- | Lookup a particular header from a response.+responseHeader ::+  (HttpResponse response) =>+  -- | Response interpretation+  response ->+  -- | Header to lookup+  ByteString ->+  -- | Header value if found+  Maybe ByteString+responseHeader r h =+  (lookup (CI.mk h) . L.responseHeaders . toVanillaResponse) r++-- | Get the response 'L.CookieJar'.+responseCookieJar ::+  (HttpResponse response) =>+  response ->+  L.CookieJar+responseCookieJar = L.responseCookieJar . toVanillaResponse++----------------------------------------------------------------------------+-- Response—Defining your own interpretation++-- $new-response-interpretation+--+-- To create a new response interpretation you just need to make your data+-- type an instance of the 'HttpResponse' type class.++-- | A type class for response interpretations. It allows us to describe how+-- to consume the response from a @'L.Response' 'L.BodyReader'@ and produce+-- the final result that is to be returned to the user.+class HttpResponse response where+  -- | The associated type is the type of body that can be extracted from an+  -- instance of 'HttpResponse'.+  type HttpResponseBody response :: Type++  -- | The method describes how to get the underlying 'L.Response' record.+  toVanillaResponse :: response -> L.Response (HttpResponseBody response)++  -- | This method describes how to consume response body and, more+  -- generally, obtain @response@ value from @'L.Response' 'L.BodyReader'@.+  --+  -- __Note__: 'L.BodyReader' is nothing but @'IO' 'ByteString'@. You should+  -- call this action repeatedly until it yields the empty 'ByteString'. In+  -- that case streaming of response is finished (which apparently leads to+  -- closing of the connection, so don't call the reader after it has+  -- returned the empty 'ByteString' once) and you can concatenate the+  -- chunks to obtain the final result. (Of course you could as well stream+  -- the contents to a file or do whatever you want.)+  --+  -- __Note__: signature of this function was changed in the version+  -- /1.0.0/.+  getHttpResponse ::+    -- | Response with body reader inside+    L.Response L.BodyReader ->+    -- | The final result+    IO response++  -- | The value of @\"Accept\"@ header. This is useful, for example, if a+  -- website supports both @XML@ and @JSON@ responses, and decides what to+  -- reply with based on what @Accept@ headers you have sent.+  --+  -- __Note__: manually specified 'Options' that set the @\"Accept\"@ header+  -- will take precedence.+  --+  -- @since 2.1.0+  acceptHeader :: Proxy response -> Maybe ByteString+  acceptHeader Proxy = Nothing++-- | This instance has been added to make it easier to inspect 'L.Response'+-- using Req's functions like 'responseStatusCode', 'responseStatusMessage',+-- etc.+--+-- @since 3.12.0+instance HttpResponse (L.Response ()) where+  type HttpResponseBody (L.Response ()) = ()+  toVanillaResponse = id+  getHttpResponse = return . void++----------------------------------------------------------------------------+-- Other++-- | The main class for things that are “parts” of 'L.Request' in the sense+-- that if we have a 'L.Request', then we know how to apply an instance of+-- 'RequestComponent' changing\/overwriting something in it. 'Endo' is a+-- monoid of endomorphisms under composition, it's used to chain different+-- request components easier using @('<>')@.+--+-- __Note__: this type class is not a part of the public API.+class RequestComponent a where+  -- | Get a function that takes a 'L.Request' and changes it somehow+  -- returning another 'L.Request'. For example, the 'HttpMethod' instance+  -- of 'RequestComponent' just overwrites method. The function is wrapped+  -- in 'Endo' so it's easier to chain such “modifying applications”+  -- together building bigger and bigger 'RequestComponent's.+  getRequestMod :: a -> Endo L.Request++-- | This wrapper is only used to attach a type-level tag to a given type.+-- This is necessary to define instances of 'RequestComponent' for any thing+-- that implements 'HttpMethod' or 'HttpBody'. Without the tag, GHC can't+-- see the difference between @'HttpMethod' method => 'RequestComponent'+-- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides+-- which instance to use (i.e. the constraints are taken into account later,+-- when instance is already chosen).+newtype Tagged (tag :: Symbol) a = Tagged a++-- | Exceptions that this library throws.+data HttpException+  = -- | A wrapper with an 'L.HttpException' from "Network.HTTP.Client"+    VanillaHttpException L.HttpException+  | -- | A wrapper with Aeson-produced 'String' describing why decoding+    -- failed+    JsonHttpException String+  deriving (Show, Typeable, Generic)++instance Exception HttpException++-- | Return 'Just' if the given 'HttpException' is wrapping a http-client's+-- 'L.StatusCodeException'. Otherwise, return 'Nothing'.+--+-- @since 3.12.0+isStatusCodeException :: HttpException -> Maybe (L.Response ())+isStatusCodeException+  ( VanillaHttpException+      ( L.HttpExceptionRequest+          _+          (L.StatusCodeException r _)+        )+    ) = Just r+isStatusCodeException _ = Nothing++-- | A simple type isomorphic to 'Bool' that we only have for better error+-- messages. We use it as a kind and its data constructors as type-level+-- tags.+--+-- See also: 'HttpMethod' and 'HttpBody'.+data CanHaveBody+  = -- | Indeed can have a body+    CanHaveBody+  | -- | Should not have a body+    NoBody++-- | A type-level tag that specifies URL scheme used (and thus if HTTPS is+-- enabled). This is used to force TLS requirement for some authentication+-- 'Option's.+data Scheme+  = -- | HTTP+    Http+  | -- | HTTPS+    Https+  deriving (Eq, Ord, Show, Data, Typeable, Generic, TH.Lift)

@@ -4,206 +4,107 @@ [![Hackage](https://img.shields.io/hackage/v/req.svg?style=flat)](https://hackage.haskell.org/package/req) [![Stackage Nightly](http://stackage.org/package/req/badge/nightly)](http://stackage.org/nightly/package/req) [![Stackage LTS](http://stackage.org/package/req/badge/lts)](http://stackage.org/lts/package/req)-[![Build Status](https://travis-ci.org/mrkkrp/req.svg?branch=master)](https://travis-ci.org/mrkkrp/req)-[![Coverage Status](https://coveralls.io/repos/mrkkrp/req/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/req?branch=master)+![CI](https://github.com/mrkkrp/req/workflows/CI/badge.svg?branch=master) -* [Motivation and Req vs other libraries](#motivation-and-req-vs-other-libraries)-* [Unsolved problems](#unsolved-problems) * [Related packages](#related-packages)+* [Blog posts](#blog-posts) * [Contribution](#contribution) * [License](#license)  ```haskell-{-# LANGUAGE OverloadedStrings    #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-}  module Main (main) where -import Control.Exception (throwIO)-import Network.HTTP.Req+import Control.Monad.IO.Class import Data.Aeson---- Just make your monad stack an instance of MonadHttp in your application--- and start making requests, enjoy automatic connection sharing.--instance MonadHttp IO where-  handleHttpException = throwIO+import Network.HTTP.Req  main :: IO ()-main = do-  let payload = object-        [ "foo" .= (10 :: Int)-        , "bar" .= (20 :: Int) ]-  -- One function, full power and flexibility.-  r <- req POST -- method-    (https "httpbin.org" /: "post") -- safe by construction URL-    (ReqBodyJson payload) -- use built-in options or add your own-    jsonResponse -- specify how to interpret response-    mempty       -- query params, headers, explicit port number, etc.-  print (responseBody r :: Value)+-- You can either make your monad an instance of 'MonadHttp', or use+-- 'runReq' in any IO-enabled monad without defining new instances.+main = runReq defaultHttpConfig $ do+  let payload =+        object+          [ "foo" .= (10 :: Int),+            "bar" .= (20 :: Int)+          ]+  -- One function—full power and flexibility, automatic retrying on timeouts+  -- and such, automatic connection sharing.+  r <-+    req+      POST -- method+      (https "httpbin.org" /: "post") -- safe by construction URL+      (ReqBodyJson payload) -- use built-in options or add your own+      jsonResponse -- specify how to interpret response+      mempty -- query params, headers, explicit port number, etc.+  liftIO $ print (responseBody r :: Value) ``` -This is an easy-to-use, type-safe, expandable, high-level HTTP library that-just works without any fooling around.--What does the “easy-to-use” phrase mean? It means that the library is-designed to be beginner-friendly, so it's simple to add it to your monad-stack, intuitive to work with, well-documented, and does not get in your-way. Doing HTTP requests is a common task and Haskell library for this-should be very approachable and clear to beginners, thus certain compromises-were made. For example, one cannot currently modify `ManagerSettings` of-default manager because the library always uses the same implicit global-manager for simplicity and maximal connection sharing. There is a way to use-your own manager with different settings, but it requires a bit more typing.+Req is an HTTP client library that attempts to be easy-to-use, type-safe,+and expandable. -“Type-safe” means that the library is protective and eliminates certain-class of errors. For example, we have correct-by-construction URLs, it's-guaranteed that user does not send request body when using methods like GET-or OPTIONS, amount of implicit assumptions is minimized by making user-specify his/her intentions in explicit form (for example, it's not possible-to avoid specifying body or method of a request). Authentication methods-that assume TLS force user to use TLS on type level. The library carefully-hides underlying types from lower-level `http-client` package because it's-not safe enough (for example `Request` is an instance of `IsString` and if-it's malformed, it will blow up at run-time).+“Easy-to-use” means that the library is designed to be beginner-friendly so+it's simple to add to your monad stack, intuitive to work with,+well-documented, and does not get in your way. Doing HTTP requests is a+common task and a Haskell library for this should be approachable and clear+to beginners, thus certain compromises were made. For example, one cannot+currently modify `ManagerSettings` of the default manager because the+library always uses the same implicit global manager for simplicity and+maximal connection sharing. There is a way to use your own manager with+different settings, but it requires more typing. -“Expandable” refers to the ability of the library to be expanded without-ugly hacking. For example, it's possible to define your own HTTP methods,-new ways to construct body of request, new authorization options, new ways-to actually perform request and how to represent/parse response. As user-extends the library to satisfy his/her special needs, the new solutions work-just like built-ins. That said, all common cases are covered by the library-out-of-the-box.+“Type-safe” means that the library tries to eliminate certain classes of+errors. For example, we have correct-by-construction URLs; it is guaranteed+that the user does not send the request body when using methods like GET or+OPTIONS, and the amount of implicit assumptions is minimized by making the+user specify their intentions in an explicit form. For example, it's not+possible to avoid specifying the body or the method of a request.+Authentication methods that assume HTTPS force the user to use HTTPS at the+type level. -“High-level” means that there are less details to worry about. The library-is a result of my experiences as a Haskell consultant, working for several-clients who have very different projects and so the library adapts easily to-any particular style of writing Haskell applications. For example, some-people prefer throwing exceptions, while others are concerned with purity:-just define `handleHttpException` accordingly when making your monad-instance of `MonadHttp` and it will play seamlessly. Finally, the library-cuts boilerplate considerably and helps write concise, easy to read and-maintain code.+“Expandable” refers to the ability to create new components without having+to resort to hacking. For example, it's possible to define your own HTTP+methods, create new ways to construct the body of a request, create new+authorization options, perform a request in a different way, and create your+own methods to parse a response.  The library uses the following mature packages under the hood to guarantee-you best experience without bugs or other funny business:--* [`http-client`](https://hackage.haskell.org/package/http-client) — low-  level HTTP client used everywhere in Haskell.--* [`http-client-tls`](https://hackage.haskell.org/package/http-client-tls) —-  TLS (HTTPS) support for `http-client`.--It's important to note that since we leverage well-known libraries that the-whole Haskell ecosystem uses, there is no risk in using Req, as the-machinery for performing requests is the same as with `http-conduit` and-Wreq, it's just the API is different.--## Motivation and Req vs other libraries--*This section is my opinion and it contains criticisms of other well-known-libraries. If you're user/fan of one of these libraries, please remember not-to react aggressively and respect the fact that I may have different views-on API design from yours.*--I have spent time to write the library because sending HTTP requests is such-a common thing and still there is no high-level library for that in Haskell-that I could use with pleasure. I'll explain why.--First of all there is `http-client` and `http-client-tls`. They just work. I-have no issues with the libraries except that they are too low-level for my-taste. Indeed, even the docs say that they are low-level and “intended as a-base layer for more user-friendly packages”. This is exactly how I use them-in Req, as base level. Req is nothing but a different API to `http-client`,-so it only works because of hard work put into `http-client`.--`http-conduit` definitely has its place. For one thing it allows you to-stream request and response bodies in constant memory, what other library-allows you to do that? On the other hand if you take a look at-`Network.HTTP.Simple`, then although it's said that it's a “higher level-API”, it's mostly the same as vanilla `http-client` in spirit/approach and-just adds `conduit`-powered functions to perform requests and allows to use-global implicit `Manager` (super-cool idea, BTW, Req does the same). If I-tried to frame what exactly I don't like about `http-conduit` in words, then-it would be “the way requests are constructed”. You set, set, set instead of-*being forced* to declare necessary bits and *being allowed* to declare-optional bits in a way that their combination is certainly valid. And you-parse request from a string without the protection of TH that otherwise-saves the day as in Yesod.--Then there is Wreq.-`wreq`-[doesn't see much development lately](https://github.com/bos/wreq/issues/93).-`wreq` is by itself a weird library, IMO. You have functions per method —-not very good, as there may be new methods, like PATCH which is not new but-still missing (well you have `customMethod`, but what is the point of having-per-method functions if you have a more general way to use any method? you-should be able to just insert methods in the “argument slot” of-`customMethod` and end up with a more general solution). Now every method-function has a companion that takes `Options` (like you have `get` and-`getWith`). Why the duplication? Where is generality and flexibility? This-is not all though, because you cannot really use `get` you see in the main-module, because you want to have connection sharing. Wreq's author does not-take the gift of automatic connection re-use `Manager` from `http-client`-provides, he invents the whole new thing of “sessions”. Only inside a-session your connections will be shared and re-used. However with the-session stuff you have yet another set of per-method functions like `get`-and `getWith` — these are different ones, to be used with sessions! Now if-you have multi-threaded app, here is a surprise for you: you can't share-connections between threads as connections are shared only inside-`withSession` friend and “session will no longer be valid after that-function returns”. Disclaimer: I don't use Wreq, see below. If something in-this paragraph is not correct, please let me know and I'll remove it. Also-there are valid uses for sessions, but the point is that they are too-inconvenient for common tasks.--It's funny that one client I worked for had to have his own little wrapper-around `http-client` just because he could not possibly use `wreq` and-`http-client` and friends were too low-level. The previous paragraph is-extracted from a talk with a Haskell developer who works for that client. I-thought to myself “something is wrong with HTTP client libraries in Haskell-if they had to make a wrapper”.--What else? I used `servant-client` a couple of times but amount of-boilerplate is too high. If you have several query parameters, and you use-just one of them, good luck passing lots of `Nothing`s.+you the best experience: -## Unsolved problems+* [`http-client`](https://hackage.haskell.org/package/http-client)—low level+  HTTP client used everywhere in Haskell.+* [`http-client-tls`](https://hackage.haskell.org/package/http-client-tls)—TLS+  (HTTPS) support for `http-client`. -AWS request signing is problematic because request body can be in form of-action to execute (and all that “popper” stuff for streaming), not just-`ByteString` and so getting its digest (hash) is not trivial without running-the action and consuming body in its entirety before the request in made. In-Wreq the author chose to just use `error` when body is not a (strict or-lazy) `ByteString`. Maybe it's OK for Wreq, but I don't consider this proper-solution for Req as we support full variety of body options. For example-what if I want to upload 1 Gb file to S3? I want to stream it in constant-memory but at the same time I need to calculate its hash before I start-streaming. One solution to the problem seems to be in taking the hash-explicitly (as an argument of hypothetical `awsAuth`) and making it-responsibility of library user to calculate the hash correctly. I don't like-this because it's not user-friendly. So the question stays open, for now-there is no AWS signing functionality provided out-of-the-box.+It is important to note that since we leverage well-known libraries that the+whole Haskell ecosystem uses, there is no risk in using Req. The machinery+for performing requests is the same as with `http-conduit` and Wreq. The+only difference is the API.  ## Related packages  The following packages are designed to be used with Req: -* [`req-conduit`](https://hackage.haskell.org/package/req-conduit) — support+* [`req-conduit`](https://hackage.haskell.org/package/req-conduit)—support   for streaming request and response bodies in constant memory.  If you happen to have written a package that adds new features to Req, please submit a PR to include it in this list. +## Blog posts++* [Req 1.0.0, HTTP client, and streaming](https://markkarpov.com/post/req-1.0.0-http-client-and-streaming.html)+ ## Contribution  Issues, bugs, and questions may be reported in [the GitHub issue tracker for this project](https://github.com/mrkkrp/req/issues). -Pull requests are also welcome and will be reviewed quickly.+Pull requests are also welcome.  ## License -Copyright © 2016–2017 Mark Karpov+Copyright © 2016–present Mark Karpov  Distributed under BSD 3 clause license.

@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain

@@ -1,126 +1,110 @@------ Tests for ‘req’ package. This test suite tests sending actual requests--- using the <https://httpbin.org> service.------ Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org>------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are--- met:------ * Redistributions of source code must retain the above copyright notice,---   this list of conditions and the following disclaimer.------ * Redistributions in binary form must reproduce the above copyright---   notice, this list of conditions and the following disclaimer in the---   documentation and/or other materials provided with the distribution.------ * Neither the name Mark Karpov nor the names of contributors may be used---   to endorse or promote products derived from this software without---   specific prior written permission.------ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY--- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED--- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE--- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY--- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS--- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)--- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,--- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN--- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE--- POSSIBILITY OF SUCH DAMAGE.--{-# LANGUAGE CPP                  #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Network.HTTP.ReqSpec-  ( spec )-where+module Network.HTTP.ReqSpec (spec) where -import Control.Exception (throwIO)-import Control.Monad.Reader-import Data.Aeson (Value (..), ToJSON (..), object, (.=))-import Data.Default.Class-import Data.Monoid ((<>))+import Control.Exception+import Control.Monad (forM_)+import Control.Monad.Trans.Control+import Data.Aeson (ToJSON (..), Value (..), object, (.=))+import Data.Aeson qualified as A+import Data.Aeson.KeyMap qualified as Aeson.KeyMap+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as BL+import Data.Functor.Identity (runIdentity)+import Data.Maybe (fromJust) import Data.Proxy import Data.Text (Text)-import Network.HTTP.Req+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Text.IO qualified as TIO+import Network.HTTP.Client qualified as L+import Network.HTTP.Client.MultipartFormData qualified as LM+import Network.HTTP.Req hiding (req)+import Network.HTTP.Req qualified as Req+import Network.HTTP.Types qualified as Y import Test.Hspec import Test.QuickCheck-import qualified Data.Aeson           as A-import qualified Data.ByteString      as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.HashMap.Strict  as HM-import qualified Data.Text            as T-import qualified Data.Text.Encoding   as T-import qualified Data.Text.IO         as TIO-import qualified Network.HTTP.Client  as L-import qualified Network.HTTP.Client.MultipartFormData as LM-import qualified Network.HTTP.Types   as Y -#if !MIN_VERSION_base(4,8,0)-import Data.Monoid (mempty)-import Data.Word (Word)-#endif- spec :: Spec spec = do--  describe "exception throwing on non 2xx-status codes" $-    it "throws indeed for non-2xx" $ do-      let selector :: HttpException -> Bool-          selector (VanillaHttpException-                    (L.HttpExceptionRequest _-                     (L.StatusCodeException response chunk))) =-            L.responseStatus response == Y.status404 && not (B.null chunk)-          selector _ = False+  describe "exception throwing on non-2xx status codes" $+    it "throws indeed for non-2xx" $       req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty-        `shouldThrow` selector+        `shouldThrow` selector404 +  describe "exception throwing on non-2xx status codes (Req monad)" $+    it "throws indeed for non-2xx" $+      asIO . runReq defaultHttpConfig $+        liftBaseWith $ \run ->+          run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)+            `shouldThrow` selector404+   describe "response check via httpConfigCheckResponse" $     context "if it's set to always throw" $       it "throws indeed" $         blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)           `shouldThrow` anyException +  describe "isStatusCodeException" $+    it "extracts non-2xx response" $+      req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty+        `shouldThrow` selector404ByStatusCodeException+   describe "receiving user-agent header back" $     it "works" $ do-      r <- req GET (httpbin /: "user-agent")-        NoReqBody jsonResponse (header "user-agent" "Req")-      responseBody          r `shouldBe` object-        ["user-agent" .= ("Req" :: Text)]-      responseStatusCode    r `shouldBe` 200+      r <-+        req+          GET+          (httpbin /: "user-agent")+          NoReqBody+          jsonResponse+          (header "user-agent" "Req")+      responseBody r+        `shouldBe` object+          ["user-agent" .= ("Req" :: Text)]+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    describe "receiving request headers back" $     it "works" $ do-      r <- req GET (httpbin /: "headers")-        NoReqBody jsonResponse (header "Foo" "bar" <> header "Baz" "quux")-      responseBody          r `shouldBe` object-        [ "headers" .= object-          [ "Accept-Encoding" .= ("gzip"        :: Text)-          , "Foo"             .= ("bar"         :: Text)-          , "Baz"             .= ("quux"        :: Text)-          , "Host"            .= ("httpbin.org" :: Text) ] ]-      responseStatusCode    r `shouldBe` 200+      r <-+        req+          GET+          (httpbin /: "headers")+          NoReqBody+          jsonResponse+          (header "Foo" "bar" <> header "Baz" "quux")+      stripFunnyHeaders (responseBody r)+        `shouldBe` object+          [ "headers"+              .= object+                [ "Accept-Encoding" .= ("gzip" :: Text),+                  "Foo" .= ("bar" :: Text),+                  "Baz" .= ("quux" :: Text)+                ]+          ]+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    describe "receiving GET data back" $     it "works" $ do       r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty-      stripOrigin (responseBody r) `shouldBe` object-        [ "args" .= emptyObject-        , "url"  .= ("https://httpbin.org/get" :: Text)-        , "headers" .= object-          [ "Accept-Encoding" .= ("gzip"        :: Text)-          , "Host"            .= ("httpbin.org" :: Text) ] ]+      (stripFunnyHeaders . stripOrigin) (responseBody r)+        `shouldBe` object+          [ "args" .= emptyObject,+            "url" .= ("http://localhost:1234/get" :: Text),+            "headers"+              .= object+                [ "Accept-Encoding" .= ("gzip" :: Text)+                ]+          ]       responseHeader r "Content-Type" `shouldBe` return "application/json"-      responseStatusCode    r `shouldBe` 200+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    describe "receiving POST JSON data back" $@@ -128,47 +112,55 @@       let text = "foo" :: Text           reflected = reflectJSON text       r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty-      stripOrigin (responseBody r) `shouldBe` object-        [ "args"  .= emptyObject-        , "json"  .= text-        , "data"  .= reflected-        , "url"   .= ("https://httpbin.org/post" :: Text)-        , "headers" .= object-          [ "Content-Type"   .= ("application/json; charset=utf-8" :: Text)-          , "Accept-Encoding" .= ("gzip"       :: Text)-          , "Host"           .= ("httpbin.org" :: Text)-          , "Content-Length" .= show (T.length reflected) ]-        , "files" .= emptyObject-        , "form"  .= emptyObject ]+      (stripFunnyHeaders . stripOrigin) (responseBody r)+        `shouldBe` object+          [ "args" .= emptyObject,+            "json" .= text,+            "data" .= reflected,+            "url" .= ("http://localhost:1234/post" :: Text),+            "headers"+              .= object+                [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),+                  "Accept-Encoding" .= ("gzip" :: Text),+                  "Content-Length" .= show (T.length reflected)+                ],+            "files" .= emptyObject,+            "form" .= emptyObject+          ]       responseHeader r "Content-Type" `shouldBe` return "application/json"-      responseStatusCode    r `shouldBe` 200+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    describe "receiving POST data back (multipart form data)" $     it "works" $ do-      body <- reqBodyMultipart-        [ LM.partBS "foo" "foo data!"-        , LM.partBS "bar" "bar data!" ]+      body <-+        reqBodyMultipart+          [ LM.partBS "foo" "foo data!",+            LM.partBS "bar" "bar data!"+          ]       r <- req POST (httpbin /: "post") body jsonResponse mempty-      let Just contentType = getRequestContentType body-      stripOrigin (responseBody r) `shouldBe` object-        [ "args"  .= emptyObject-        , "json"  .= Null-        , "data"  .= ("" :: Text)-        , "url"   .= ("https://httpbin.org/post" :: Text)-        , "headers" .= object-          [ "Content-Type"    .= T.decodeUtf8 contentType-          , "Accept-Encoding" .= ("gzip"       :: Text)-          , "Host"            .= ("httpbin.org" :: Text)-          , "Content-Length"  .= ("242" :: Text)+      let contentType = fromJust (getRequestContentType body)+      (stripFunnyHeaders . stripOrigin) (responseBody r)+        `shouldBe` object+          [ "args" .= emptyObject,+            "json" .= Null,+            "data" .= ("" :: Text),+            "url" .= ("http://localhost:1234/post" :: Text),+            "headers"+              .= object+                [ "Content-Type" .= T.decodeUtf8 contentType,+                  "Accept-Encoding" .= ("gzip" :: Text),+                  "Content-Length" .= ("242" :: Text)+                ],+            "files" .= emptyObject,+            "form"+              .= object+                [ "foo" .= ("foo data!" :: Text),+                  "bar" .= ("bar data!" :: Text)+                ]           ]-        , "files" .= emptyObject-        , "form"  .= object-          [ "foo" .= ("foo data!" :: Text)-          , "bar" .= ("bar data!" :: Text) ]-        ]       responseHeader r "Content-Type" `shouldBe` return "application/json"-      responseStatusCode    r `shouldBe` 200+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    describe "receiving PATCHed file back" $@@ -177,74 +169,108 @@           file = "httpbin-data/robots.txt"       contents <- TIO.readFile file       r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty-      stripOrigin (responseBody r) `shouldBe` object-        [ "args"  .= emptyObject-        , "json"  .= Null-        , "data"  .= contents-        , "url"   .= ("https://httpbin.org/patch" :: Text)-        , "headers" .= object-          [ "Accept-Encoding" .= ("gzip"       :: Text)-          , "Host"           .= ("httpbin.org" :: Text)-          , "Content-Length" .= show (T.length contents) ]-        , "files" .= emptyObject-        , "form"  .= emptyObject ]+      (stripFunnyHeaders . stripOrigin) (responseBody r)+        `shouldBe` object+          [ "args" .= emptyObject,+            "json" .= Null,+            "data" .= contents,+            "url" .= ("http://localhost:1234/patch" :: Text),+            "headers"+              .= object+                [ "Accept-Encoding" .= ("gzip" :: Text),+                  "Content-Length" .= show (T.length contents)+                ],+            "files" .= emptyObject,+            "form" .= emptyObject+          ]       responseHeader r "Content-Type" `shouldBe` return "application/json"-      responseStatusCode    r `shouldBe` 200+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    describe "receiving PUT form URL-encoded data back" $     it "works" $ do-      let params = "foo" =: ("bar" :: Text) <>-            "baz" =: (5 :: Int) <>-            queryFlag "quux"+      let params =+            "foo" =: ("bar" :: Text)+              <> "baz" =: (5 :: Int)+              <> queryFlag "quux"       r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty-      stripOrigin (responseBody r) `shouldBe` object-        [ "args"  .= emptyObject-        , "json"  .= Null-        , "data"  .= ("" :: Text)-        , "url"   .= ("https://httpbin.org/put" :: Text)-        , "headers" .= object-          [ "Content-Type"   .= ("application/x-www-form-urlencoded" :: Text)-          , "Accept-Encoding" .= ("gzip"       :: Text)-          , "Host"           .= ("httpbin.org" :: Text)-          , "Content-Length" .= ("18"          :: Text) ]-        , "files" .= emptyObject-        , "form"  .= object-          [ "foo" .= ("bar" :: Text)-          , "baz" .= ("5"   :: Text)-          , "quux" .= (""   :: Text) ] ]+      (stripFunnyHeaders . stripOrigin) (responseBody r)+        `shouldBe` object+          [ "args" .= emptyObject,+            "json" .= Null,+            "data" .= ("" :: Text),+            "url" .= ("http://localhost:1234/put" :: Text),+            "headers"+              .= object+                [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),+                  "Accept-Encoding" .= ("gzip" :: Text),+                  "Content-Length" .= ("18" :: Text)+                ],+            "files" .= emptyObject,+            "form"+              .= object+                [ "foo" .= ("bar" :: Text),+                  "baz" .= ("5" :: Text),+                  "quux" .= ("" :: Text)+                ]+          ]       responseHeader r "Content-Type" `shouldBe` return "application/json"-      responseStatusCode    r `shouldBe` 200+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    -- TODO /delete    describe "receiving UTF-8 encoded Unicode data" $     it "works" $ do-      r <- req GET (httpbin /: "encoding" /: "utf8")-        NoReqBody bsResponse mempty+      r <-+        req+          GET+          (httpbin /: "encoding" /: "utf8")+          NoReqBody+          bsResponse+          mempty       utf8data <- B.readFile "httpbin-data/utf8.html"-      responseBody          r `shouldBe` utf8data-      responseStatusCode    r `shouldBe` 200+      responseBody r `shouldBe` utf8data+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    -- TODO /gzip   -- TODO /deflate -  forM_ [101..102] checkStatusCode-  forM_ [200..208] checkStatusCode+  describe "retrying" $+    it "retries as many times as specified" $ do+      -- FIXME We no longer can count retries because all the functions+      -- responsible for controlling retrying are pure now.+      let status = 408 :: Int+      r <-+        prepareForShit $+          req+            GET+            (httpbin /: "status" /~ status)+            NoReqBody+            ignoreResponse+            mempty+      responseStatusCode r `shouldBe` status++  -- forM_ [101..102] checkStatusCode+  forM_ [200 .. 208] checkStatusCode   -- forM_ [300..308] checkStatusCode-  forM_ [400..431] checkStatusCode-  forM_ [500..511] checkStatusCode+  forM_ [400 .. 431] checkStatusCode+  forM_ [500 .. 511] checkStatusCode    -- TODO /response-headers   -- TODO /redirect    describe "redirects" $     it "follows redirects" $ do-      r <- req GET (httpbin /: "redirect-to") NoReqBody ignoreResponse-        ("url" =: ("https://httpbin.org" :: Text))-      responseStatusCode    r `shouldBe` 200+      r <-+        req+          GET+          (httpbin /: "redirect-to")+          NoReqBody+          ignoreResponse+          ("url" =: ("https://httpbin.org" :: Text))+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    -- TODO /relative-redicet@@ -253,21 +279,30 @@    describe "basicAuth" $ do     let user, password :: Text-        user     = "Scooby"+        user = "Scooby"         password = "Doo"     context "when we do not send appropriate basic auth data" $       it "fails with 401" $ do-        r <- prepareForShit $ req GET-          (httpbin /: "basic-auth" /~ user /~ password)-          NoReqBody ignoreResponse mempty-        responseStatusCode    r `shouldBe` 401+        r <-+          prepareForShit $+            req+              GET+              (httpbin /: "basic-auth" /~ user /~ password)+              NoReqBody+              ignoreResponse+              mempty+        responseStatusCode r `shouldBe` 401         responseStatusMessage r `shouldBe` "UNAUTHORIZED"     context "when we provide appropriate basic auth data" $       it "succeeds" $ do-        r <- req GET (httpbin /: "basic-auth" /~ user /~ password)-          NoReqBody ignoreResponse-          (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))-        responseStatusCode    r `shouldBe` 200+        r <-+          req+            GET+            (httpbin /: "basic-auth" /~ user /~ password)+            NoReqBody+            ignoreResponse+            (basicAuthUnsafe (T.encodeUtf8 user) (T.encodeUtf8 password))+        responseStatusCode r `shouldBe` 200         responseStatusMessage r `shouldBe` "OK"    -- TODO /hidden-basic-auth@@ -282,8 +317,8 @@     it "works" $ do       r <- req GET (httpbin /: "robots.txt") NoReqBody bsResponse mempty       robots <- B.readFile "httpbin-data/robots.txt"-      responseBody          r `shouldBe` robots-      responseStatusCode    r `shouldBe` 200+      responseBody r `shouldBe` robots+      responseStatusCode r `shouldBe` 200       responseStatusMessage r `shouldBe` "OK"    -- TODO /deny@@ -294,10 +329,15 @@       property $ \n' -> do         let n :: Word             n = getSmall n'-        r <- req GET (httpbin /: "bytes" /~ n)-          NoReqBody lbsResponse mempty+        r <-+          req+            GET+            (httpbin /: "bytes" /~ n)+            NoReqBody+            lbsResponse+            mempty         responseBody r `shouldSatisfy` ((== n) . fromIntegral . BL.length)-        responseStatusCode    r `shouldBe` 200+        responseStatusCode r `shouldBe` 200         responseStatusMessage r `shouldBe` "OK"     context "when we try to interpret 1000 random bytes as JSON" $       it "throws correct exception" $ do@@ -306,29 +346,38 @@             selector _ = False             n :: Int             n = 1000-        req GET (httpbin /: "bytes" /~ n) NoReqBody-          (Proxy :: Proxy (JsonResponse Value)) mempty-            `shouldThrow` selector+        req+          GET+          (httpbin /: "bytes" /~ n)+          NoReqBody+          (Proxy :: Proxy (JsonResponse Value))+          mempty+          `shouldThrow` selector    describe "streaming random bytes" $     it "works" $       property $ \n' -> do         let n :: Word             n = getSmall n'-        r <- req GET (httpbin /: "stream-bytes" /~ n)-          NoReqBody bsResponse mempty+        r <-+          req+            GET+            (httpbin /: "stream-bytes" /~ n)+            NoReqBody+            bsResponse+            mempty         responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)-        responseStatusCode    r `shouldBe` 200+        responseStatusCode r `shouldBe` 200         responseStatusMessage r `shouldBe` "OK" -  -- TODO /links-  -- TODO /image-  -- TODO /image/png-  -- TODO /image/jpeg-  -- TODO /image/webp-  -- TODO /image/svg-  -- TODO /forms/post-  -- TODO /xml+-- TODO /links+-- TODO /image+-- TODO /image/png+-- TODO /image/jpeg+-- TODO /image/webp+-- TODO /image/svg+-- TODO /forms/post+-- TODO /xml  ---------------------------------------------------------------------------- -- Instances@@ -336,59 +385,128 @@ instance MonadHttp IO where   handleHttpException = throwIO -instance MonadHttp (ReaderT HttpConfig IO) where-  handleHttpException = liftIO . throwIO-  getHttpConfig       = ask- ---------------------------------------------------------------------------- -- Helpers --- | Run request with such settings that it does not signal error on adverse--- response status codes.--prepareForShit-  :: (forall m. MonadHttp m => m a)-  -> IO a-prepareForShit m = runReaderT m def { httpConfigCheckResponse = noNoise }-  where noNoise _ _ = return ()---- | Run request with such settings that it throws on any response.+-- | Run a request with such settings that it does not signal errors.+prepareForShit :: Req a -> IO a+prepareForShit = runReq defaultHttpConfig {httpConfigCheckResponse = noNoise}+  where+    noNoise _ _ _ = Nothing -blindlyThrowing-  :: (forall m. MonadHttp m => m a)-  -> IO a-blindlyThrowing m = runReaderT m def { httpConfigCheckResponse = doit }-  where doit _ _ = error "Oops!"+-- | Run a request with such settings that it throws on any response.+blindlyThrowing :: Req a -> IO a+blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}+  where+    doit _ _ = error "Oops!"  -- | 'Url' representing <https://httpbin.org>.+httpbin :: Url 'Http+httpbin = http "localhost" -httpbin :: Url 'Https-httpbin = https "httpbin.org"+req ::+  ( MonadHttp m,+    HttpMethod method,+    HttpBody body,+    HttpResponse response,+    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)+  ) =>+  method ->+  Url scheme ->+  body ->+  Proxy response ->+  Option scheme ->+  m response+req method url body responseProxy options =+  Req.req method url body responseProxy (options <> defaultOptions) +-- | Options to apply by default.+defaultOptions :: Option scheme+defaultOptions = port 1234+ -- | Remove “origin” field from JSON value. Origin may change, we don't want -- to depend on that.- stripOrigin :: Value -> Value-stripOrigin (Object m) = Object (HM.delete "origin" m)-stripOrigin value      = value+stripOrigin (Object m) = Object (Aeson.KeyMap.delete "origin" m)+stripOrigin value = value +-- | Remove funny headers that might break the tests.+stripFunnyHeaders :: Value -> Value+stripFunnyHeaders = \case+  Object m ->+    Object+      ( runIdentity+          ( Aeson.KeyMap.alterF+              (pure . fmap stripFunnyHeaders')+              "headers"+              m+          )+      )+  value -> value++-- | Similar to 'stripFunnyHeaders', but acts directly on the argument+-- without trying to access its "headers" field.+stripFunnyHeaders' :: Value -> Value+stripFunnyHeaders' = \case+  Object p ->+    Object $+      Aeson.KeyMap.filterWithKey+        (\k _ -> k `elem` whitelistedHeaders)+        p+  value -> value+  where+    whitelistedHeaders =+      [ "Content-Type",+        "Accept-Encoding",+        "Content-Length",+        "Foo",+        "Baz"+      ]+ -- | This is a complete test case that makes use of <https://httpbin.org> to -- get various response status codes.- checkStatusCode :: Int -> SpecWith () checkStatusCode code =   describe ("receiving status code " ++ show code) $     it "works" $ do-      r <- prepareForShit $ req GET (httpbin /: "status" /~ code)-        NoReqBody ignoreResponse mempty+      r <-+        prepareForShit $+          req+            GET+            (httpbin /: "status" /~ code)+            NoReqBody+            ignoreResponse+            mempty       responseStatusCode r `shouldBe` code --- | Empty JSON 'Object'.+-- | Exception selector that selects only 404 “Not found” exceptions.+selector404 :: HttpException -> Bool+selector404+  ( VanillaHttpException+      ( L.HttpExceptionRequest+          _+          (L.StatusCodeException response chunk)+        )+    ) =+    L.responseStatus response == Y.status404 && not (B.null chunk)+selector404 _ = False -emptyObject :: Value-emptyObject = Object HM.empty+-- | Same as 'selector404' except that it uses 'isStatusCodeException'.+selector404ByStatusCodeException :: HttpException -> Bool+selector404ByStatusCodeException e =+  case isStatusCodeException e of+    Nothing -> False+    Just r -> responseStatusCode r == 404 --- | Get rendered JSON value as 'Text'.+-- | The empty JSON 'Object'.+emptyObject :: Value+emptyObject = Object Aeson.KeyMap.empty -reflectJSON :: ToJSON a => a -> Text+-- | Get a rendered JSON value as 'Text'.+reflectJSON :: (ToJSON a) => a -> Text reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode++-- | Clarify to the type checker that the inner computation is in the 'IO'+-- monad.+asIO :: IO a -> IO a+asIO = id

@@ -1,102 +1,71 @@------ Tests for ‘req’ package. This test suite tests correctness of constructed--- requests.------ Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org>------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are--- met:------ * Redistributions of source code must retain the above copyright notice,---   this list of conditions and the following disclaimer.------ * Redistributions in binary form must reproduce the above copyright---   notice, this list of conditions and the following disclaimer in the---   documentation and/or other materials provided with the distribution.------ * Neither the name Mark Karpov nor the names of contributors may be used---   to endorse or promote products derived from this software without---   specific prior written permission.------ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY--- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED--- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE--- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY--- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS--- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)--- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,--- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN--- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE--- POSSIBILITY OF SUCH DAMAGE.--{-# LANGUAGE CPP                  #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE DeriveGeneric        #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE RankNTypes           #-}-{-# LANGUAGE RecordWildCards      #-}-{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -#if __GLASGOW_HASKELL__ <  710-{-# LANGUAGE ConstraintKinds      #-}-#endif--module Network.HTTP.ReqSpec-  ( spec )-where+module Network.HTTP.ReqSpec (spec) where +import Blaze.ByteString.Builder qualified as BB import Control.Exception (throwIO)-import Control.Monad.Reader+import Control.Monad+import Control.Retry import Data.Aeson (ToJSON (..))+import Data.Aeson qualified as A import Data.ByteString (ByteString)-import Data.Maybe (isNothing, fromJust)-import Data.Monoid ((<>))+import Data.ByteString qualified as B+import Data.ByteString.Char8 qualified as B8+import Data.ByteString.Lazy qualified as BL+import Data.CaseInsensitive qualified as CI+import Data.Either (isRight)+import Data.List.NonEmpty qualified as NE+import Data.Maybe (fromJust, fromMaybe, isJust, isNothing) import Data.Proxy import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Data.Time+import Data.Typeable (Typeable, eqT)+import GHC.Exts (IsList (..)) import GHC.Generics+import Language.Haskell.TH qualified as TH+import Language.Haskell.TH.Quote qualified as TH+import Network.HTTP.Client qualified as L import Network.HTTP.Req+import Network.HTTP.Types qualified as Y+import Network.HTTP.Types.Header qualified as Y import Test.Hspec import Test.Hspec.Core.Spec (SpecM) import Test.QuickCheck-import qualified Blaze.ByteString.Builder as BB-import qualified Data.Aeson               as A-import qualified Data.ByteString          as B-import qualified Data.ByteString.Char8    as B8-import qualified Data.ByteString.Lazy     as BL-import qualified Data.CaseInsensitive     as CI-import qualified Data.Text                as T-import qualified Data.Text.Encoding       as T-import qualified Network.HTTP.Client      as L-import qualified Network.HTTP.Types       as Y--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-import Data.Foldable (foldMap)-import Data.Monoid (mempty)-#endif+import Text.URI (URI)+import Text.URI qualified as URI+import Text.URI.QQ qualified as QQ+import Web.FormUrlEncoded qualified as F  spec :: Spec spec = do-   describe "config" $     it "getHttpConfig has effect on resulting request" $       property $ \config -> do-        request <- runReaderT (req_ GET url NoReqBody mempty) config-        L.proxy         request `shouldBe` httpConfigProxy         config+        request <- runReq config (req_ GET url NoReqBody mempty)+        L.proxy request `shouldBe` httpConfigProxy config         L.redirectCount request `shouldBe` httpConfigRedirectCount config    describe "methods" $ do-    let mnth-          :: forall method.-             ( HttpMethod method-             , HttpBodyAllowed (AllowsBody method) 'NoBody )-          => method-          -> SpecM () ()+    let mnth ::+          forall method.+          ( HttpMethod method,+            HttpBodyAllowed (AllowsBody method) 'NoBody+          ) =>+          method ->+          SpecM () ()         mnth method = do           let name = httpMethodName (Proxy :: Proxy method)           describe (B8.unpack name) $@@ -119,15 +88,15 @@         property $ \host -> do           request <- req_ GET (http host) NoReqBody mempty           L.secure request `shouldBe` False-          L.port   request `shouldBe` 80-          L.host   request `shouldBe` urlEncode host+          L.port request `shouldBe` 80+          L.host request `shouldBe` urlEncode host     describe "https" $       it "sets all the params correctly" $         property $ \host -> do           request <- req_ GET (https host) NoReqBody mempty           L.secure request `shouldBe` True-          L.port   request `shouldBe` 443-          L.host   request `shouldBe` urlEncode host+          L.port request `shouldBe` 443+          L.host request `shouldBe` urlEncode host     describe "(/~)" $       it "attaches a path piece that is URL-encoded" $         property $ \host pieces -> do@@ -142,33 +111,96 @@           request <- req_ GET url' NoReqBody mempty           L.host request `shouldBe` urlEncode host           L.path request `shouldBe` encodePathPieces pieces-    describe "parseUrlHttp" $ do++    describe "useHttpURI" $ do       it "does not recognize non-http schemes" $-        parseUrlHttp "https://httpbin.org" `shouldSatisfy` isNothing-      it "parses correct URLs" $-        property $ \host pieces queryParams ->-          not (T.null host) && wellFormed queryParams ==> do-          let (url', path, queryString) =-                assembleUrl Http host pieces queryParams-              (url'', options) = fromJust (parseUrlHttp url')-          request <- req_ GET url'' NoReqBody options-          L.host        request `shouldBe` urlEncode host-          L.path        request `shouldBe` path-          L.queryString request `shouldBe` queryString-    describe "parseUrlHttps" $ do+        property $ \uri ->+          when (URI.uriScheme uri /= Just [QQ.scheme|http|]) $+            useHttpURI uri `shouldSatisfy` isNothing+      it "accepts correct URLs" $+        property $ \uri' -> do+          unless (isRight (URI.uriAuthority uri')) discard+          let uri = uri' {URI.uriScheme = Just [QQ.scheme|http|]}+              (url', options) = fromJust (useHttpURI uri)+          request <- req_ GET url' NoReqBody options+          L.host request `shouldBe` uriHost uri+          L.port request `shouldBe` uriPort 80 uri+          L.path request `shouldBe` uriPath uri+          L.queryString request `shouldBe` uriQuery uri+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` uriBasicAuth uri+    describe "useHttpsURI" $ do       it "does not recognize non-https schemes" $-        parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing+        property $ \uri ->+          when (URI.uriScheme uri /= Just [QQ.scheme|https|]) $+            useHttpsURI uri `shouldSatisfy` isNothing       it "parses correct URLs" $-        property $ \host pieces queryParams ->-          not (T.null host) && wellFormed queryParams ==> do-          let (url', path, queryString) =-                assembleUrl Https host pieces queryParams-              (url'', options) = fromJust (parseUrlHttps url')-          request <- req_ GET url'' NoReqBody options-          L.host        request `shouldBe` urlEncode host-          L.path        request `shouldBe` path-          L.queryString request `shouldBe` queryString+        property $ \uri' -> do+          unless (isRight (URI.uriAuthority uri')) discard+          let uri = uri' {URI.uriScheme = Just [QQ.scheme|https|]}+              (url', options) = fromJust (useHttpsURI uri)+          request <- req_ GET url' NoReqBody options+          L.host request `shouldBe` uriHost uri+          L.port request `shouldBe` uriPort 443 uri+          L.path request `shouldBe` uriPath uri+          L.queryString request `shouldBe` uriQuery uri+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` uriBasicAuth uri+    describe "useURI" $ do+      it "does not recognize non-http and non-https schemes" $+        property $ \uri ->+          when+            ( ( URI.uriScheme uri /= Just [QQ.scheme|http|]+                  && (URI.uriScheme uri /= Just [QQ.scheme|https|])+              )+            )+            $ useURI uri `shouldSatisfy` isNothing+      it "parses correct URLs" $+        property $ \uri' -> do+          unless (isRight (URI.uriAuthority uri')) discard+          let uriHttp = uri' {URI.uriScheme = Just [QQ.scheme|http|]}+              uriHttps = uri' {URI.uriScheme = Just [QQ.scheme|https|]}+          requestHttp <-+            case fromJust (useURI uriHttp) of+              Left (url', options) -> req_ GET url' NoReqBody options+              _ -> error "(useURI uriHttp) should have returned Left"+          requestHttps <-+            case fromJust (useURI uriHttps) of+              Right (url', options) -> req_ GET url' NoReqBody options+              _ -> error "(useURI uriHttps) should have returned Right"+          L.host requestHttp `shouldBe` uriHost uriHttp+          L.host requestHttps `shouldBe` uriHost uriHttps+          L.port requestHttp `shouldBe` uriPort 80 uriHttp+          L.port requestHttps `shouldBe` uriPort 443 uriHttps+          L.path requestHttp `shouldBe` uriPath uriHttp+          L.path requestHttps `shouldBe` uriPath uriHttps+          L.queryString requestHttp `shouldBe` uriQuery uriHttp+          L.queryString requestHttps `shouldBe` uriQuery uriHttps+          lookup "Authorization" (L.requestHeaders requestHttp)+            `shouldBe` uriBasicAuth uriHttp+          lookup "Authorization" (L.requestHeaders requestHttps)+            `shouldBe` uriBasicAuth uriHttps +    describe "renderUrl" $ do+      context "http" $ do+        context "empty path" $+          it "renders correctly" $ do+            let (uriHttp, _) = [urlQ|http://httpbin.org|]+            renderUrl uriHttp `shouldBe` "http://httpbin.org"+        context "non-empty path" $+          it "renders correctly" $ do+            let (uriHttp, _) = [urlQ|http://httpbin.org/here/we/go|]+            renderUrl uriHttp `shouldBe` "http://httpbin.org/here/we/go"+      context "http" $ do+        context "empty path" $+          it "renders correctly" $ do+            let (uriHttp, _) = [urlQ|https://httpbin.org|]+            renderUrl uriHttp `shouldBe` "https://httpbin.org"+        context "non-empty path" $+          it "renders correctly" $ do+            let (uriHttp, _) = [urlQ|https://httpbin.org/here/we/go|]+            renderUrl uriHttp `shouldBe` "https://httpbin.org/here/we/go"+   describe "bodies" $ do     describe "NoReqBody" $       it "sets body to empty byte string" $ do@@ -191,7 +223,7 @@             L.RequestBodyBS x -> x `shouldBe` bs             _ -> expectationFailure "Wrong request body constructor."     describe "ReqBodyLbs" $-     it "sets body to specified lazy byte string" $+      it "sets body to specified lazy byte string" $         property $ \lbs -> do           request <- req_ POST url (ReqBodyLbs lbs) mempty           case L.requestBody request of@@ -205,6 +237,19 @@             L.RequestBodyLBS x -> x `shouldBe` renderQuery params             _ -> expectationFailure "Wrong request body constructor." +  describe "query params" $ do+    describe "FormUrlEncodedParam" $ do+      describe "formToQuery" $ do+        it "should produce the same parameters as F.urlEncodeFormStable" $+          property $ \form -> do+            request <- req_ POST url (ReqBodyUrlEnc $ formToQuery form) mempty+            case L.requestBody request of+              L.RequestBodyLBS x -> x `shouldBe` F.urlEncodeFormStable form+              _ -> expectationFailure "Wrong request body constructor"+      specParamToList (Proxy :: Proxy FormUrlEncodedParam)+    describe "Option" $ do+      specParamToList (Proxy :: Proxy (Option 'Http))+   describe "optional parameters" $ do     describe "header" $ do       it "sets specified header value" $@@ -213,88 +258,136 @@           lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value       it "left header wins" $         property $ \name value0 value1 -> do-          request <- req_ GET url NoReqBody-            (header name value0 <> header name value1)+          request <-+            req_+              GET+              url+              NoReqBody+              (header name value0 <> header name value1)           lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value0       it "overwrites headers set by other parts of the lib" $         property $ \value -> do-          request <- req_ POST url (ReqBodyUrlEnc mempty)-            (header "Content-Type" value)+          request <-+            req_+              POST+              url+              (ReqBodyUrlEnc mempty)+              (header "Content-Type" value)           lookup "Content-Type" (L.requestHeaders request) `shouldBe` pure value     describe "cookieJar" $       it "cookie jar is set without modifications" $         property $ \cjar -> do           request <- req_ GET url NoReqBody (cookieJar cjar)-          L.cookieJar request `shouldBe` pure cjar+          L.cookieJar request `shouldSatisfy` (maybe False (L.equalCookieJar cjar))     describe "basicAuth" $ do       it "sets Authorization header to correct value" $         property $ \username password -> do           request <- req_ GET url NoReqBody (basicAuth username password)-          lookup "Authorization" (L.requestHeaders request) `shouldBe`-            pure (basicAuthHeader username password)+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` Just (basicAuthHeader username password)       it "overwrites manual setting of header" $         property $ \username password value -> do-          request0 <- req_ GET url NoReqBody-            (basicAuth username password <> header "Authorization" value)-          request1 <- req_ GET url NoReqBody-            (header "Authorization" value <> basicAuth username password)-          let result = basicAuthHeader username password-          lookup "Authorization" (L.requestHeaders request0) `shouldBe`-            pure result-          lookup "Authorization" (L.requestHeaders request1) `shouldBe`-            pure result+          request0 <-+            req_+              GET+              url+              NoReqBody+              (basicAuth username password <> header "Authorization" value)+          request1 <-+            req_+              GET+              url+              NoReqBody+              (header "Authorization" value <> basicAuth username password)+          let result = Just (basicAuthHeader username password)+          lookup "Authorization" (L.requestHeaders request0) `shouldBe` result+          lookup "Authorization" (L.requestHeaders request1) `shouldBe` result       it "left auth option wins" $         property $ \username0 password0 username1 password1 -> do-          request <- req_ GET url NoReqBody-            (basicAuth username0 password0 <> basicAuth username1 password1)-          lookup "Authorization" (L.requestHeaders request) `shouldBe`-            pure (basicAuthHeader username0 password0)+          request <-+            req_+              GET+              url+              NoReqBody+              (basicAuth username0 password0 <> basicAuth username1 password1)+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` Just (basicAuthHeader username0 password0)     describe "oAuth2Bearer" $ do       it "sets Authorization header to correct value" $         property $ \token -> do           request <- req_ GET url NoReqBody (oAuth2Bearer token)-          lookup "Authorization" (L.requestHeaders request) `shouldBe`-            pure ("Bearer " <> token)+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` pure ("Bearer " <> token)       it "overwrites manual setting of header" $         property $ \token value -> do-          request0 <- req_ GET url NoReqBody-            (oAuth2Bearer token <> header "Authorization" value)-          request1 <- req_ GET url NoReqBody-            (header "Authorization" value <> oAuth2Bearer token)+          request0 <-+            req_+              GET+              url+              NoReqBody+              (oAuth2Bearer token <> header "Authorization" value)+          request1 <-+            req_+              GET+              url+              NoReqBody+              (header "Authorization" value <> oAuth2Bearer token)           let result = "Bearer " <> token-          lookup "Authorization" (L.requestHeaders request0) `shouldBe`-            pure result-          lookup "Authorization" (L.requestHeaders request1) `shouldBe`-            pure result+          lookup "Authorization" (L.requestHeaders request0)+            `shouldBe` pure result+          lookup "Authorization" (L.requestHeaders request1)+            `shouldBe` pure result       it "left auth option wins" $         property $ \token0 token1 -> do-          request <- req_ GET url NoReqBody-            (oAuth2Bearer token0 <> oAuth2Bearer token1)-          lookup "Authorization" (L.requestHeaders request) `shouldBe`-            pure ("Bearer " <> token0)+          request <-+            req_+              GET+              url+              NoReqBody+              (oAuth2Bearer token0 <> oAuth2Bearer token1)+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` pure ("Bearer " <> token0)+    describe "ProxyAuthorization" $+      it "sets Authorization header to correct value" $+        property $ \username password -> do+          request <- req_ GET url NoReqBody (basicProxyAuth username password)+          lookup "Proxy-Authorization" (L.requestHeaders request)+            `shouldBe` pure (basicProxyAuthHeader username password)     describe "oAuth2Token" $ do       it "sets Authorization header to correct value" $         property $ \token -> do           request <- req_ GET url NoReqBody (oAuth2Token token)-          lookup "Authorization" (L.requestHeaders request) `shouldBe`-            pure ("token " <> token)+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` pure ("token " <> token)       it "overwrites manual setting of header" $         property $ \token value -> do-          request0 <- req_ GET url NoReqBody-            (oAuth2Token token <> header "Authorization" value)-          request1 <- req_ GET url NoReqBody-            (header "Authorization" value <> oAuth2Token token)+          request0 <-+            req_+              GET+              url+              NoReqBody+              (oAuth2Token token <> header "Authorization" value)+          request1 <-+            req_+              GET+              url+              NoReqBody+              (header "Authorization" value <> oAuth2Token token)           let result = "token " <> token-          lookup "Authorization" (L.requestHeaders request0) `shouldBe`-            pure result-          lookup "Authorization" (L.requestHeaders request1) `shouldBe`-            pure result+          lookup "Authorization" (L.requestHeaders request0)+            `shouldBe` pure result+          lookup "Authorization" (L.requestHeaders request1)+            `shouldBe` pure result       it "left auth option wins" $         property $ \token0 token1 -> do-          request <- req_ GET url NoReqBody-            (oAuth2Token token0 <> oAuth2Token token1)-          lookup "Authorization" (L.requestHeaders request) `shouldBe`-            pure ("token " <> token0)+          request <-+            req_+              GET+              url+              NoReqBody+              (oAuth2Token token0 <> oAuth2Token token1)+          lookup "Authorization" (L.requestHeaders request)+            `shouldBe` pure ("token " <> token0)     describe "port" $       it "sets port overwriting the defaults" $         property $ \n -> do@@ -314,31 +407,48 @@           request <- req_ GET url NoReqBody (httpVersion major minor)           L.requestVersion request `shouldBe` Y.HttpVersion major minor +    describe "quasiquoter" $ do+      it "works for valid urls" $+        -- Doing it this way instead of just checking if [urlQ|...|] :: (Url+        -- 'Https, Option _) type checks, so we can catch if the type of scheme+        -- is unspecified.+        let testTypeOfQuoterResult ::+              forall a s. (Typeable a) => (a, Option s) -> Bool+            testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https)+         in property $ testTypeOfQuoterResult [urlQ|https://example.org/|]+      it "doesn't work for invalid urls" $+        property $+          TH.runQ (TH.quoteExp urlQ "not a url") `shouldThrow` anyIOException+ ---------------------------------------------------------------------------- -- Instances  instance MonadHttp IO where   handleHttpException = throwIO -instance MonadHttp (ReaderT HttpConfig IO) where-  handleHttpException = liftIO . throwIO-  getHttpConfig       = ask- instance Arbitrary HttpConfig where   arbitrary = do-    httpConfigProxy         <- arbitrary+    httpConfigProxy <- arbitrary     httpConfigRedirectCount <- arbitrary     let httpConfigAltManager = Nothing-        httpConfigCheckResponse _ _ = return ()+        httpConfigCheckResponse _ _ _ = Nothing+        httpConfigRetryPolicy = retryPolicyDefault+        httpConfigRetryJudge _ _ = False+        httpConfigRetryJudgeException _ _ = False+        httpConfigBodyPreviewLength = 1024     return HttpConfig {..}  instance Show HttpConfig where   show HttpConfig {..} =-    "HttpConfig\n" ++-    "{ httpConfigProxy=" ++ show httpConfigProxy ++ "\n" ++-    ", httpRedirectCount=" ++ show httpConfigRedirectCount ++ "\n" ++-    ", httpConfigAltManager=<cannot be shown>\n" ++-    ", httpConfigCheckResponse=<cannot be shown>}\n"+    "HttpConfig\n"+      ++ "{ httpConfigProxy="+      ++ show httpConfigProxy+      ++ "\n"+      ++ ", httpRedirectCount="+      ++ show httpConfigRedirectCount+      ++ "\n"+      ++ ", httpConfigAltManager=<cannot be shown>\n"+      ++ ", httpConfigCheckResponse=<cannot be shown>}\n"  instance Arbitrary L.Proxy where   arbitrary = L.Proxy <$> arbitrary <*> arbitrary@@ -356,9 +466,10 @@   show _ = "<cannot be shown>"  data Thing = Thing-  { _thingBool :: Bool-  , _thingText :: Text-  } deriving (Eq, Show, Generic)+  { _thingBool :: Bool,+    _thingText :: Text+  }+  deriving (Eq, Show, Generic)  instance ToJSON Thing @@ -370,17 +481,17 @@  instance Arbitrary L.Cookie where   arbitrary = do-    cookie_name          <- arbitrary-    cookie_value         <- arbitrary-    cookie_expiry_time   <- arbitrary-    cookie_domain        <- arbitrary-    cookie_path          <- arbitrary+    cookie_name <- arbitrary+    cookie_value <- arbitrary+    cookie_expiry_time <- arbitrary+    cookie_domain <- arbitrary+    cookie_path <- arbitrary     cookie_creation_time <- arbitrary     cookie_last_access_time <- arbitrary-    cookie_persistent    <- arbitrary-    cookie_host_only     <- arbitrary-    cookie_secure_only   <- arbitrary-    cookie_http_only     <- arbitrary+    cookie_persistent <- arbitrary+    cookie_host_only <- arbitrary+    cookie_secure_only <- arbitrary+    cookie_http_only <- arbitrary     return L.Cookie {..}  instance Arbitrary UTCTime where@@ -392,73 +503,130 @@ instance Arbitrary DiffTime where   arbitrary = secondsToDiffTime <$> arbitrary +instance Arbitrary F.Form where+  arbitrary = (F.Form . fromList) <$> arbitrary+ ----------------------------------------------------------------------------+-- Helper types++-- | A wrapper to generate correct hosts.+newtype Host = Host {unHost :: Text}+  deriving (Eq, Show)++instance Arbitrary Host where+  arbitrary = Host . T.pack <$> listOf1 (arbitrary `suchThat` (/= ':'))++-- | A wrapper to generate correct query parameters.+newtype QueryParams = QueryParams [(Text, Maybe Text)]+  deriving (Eq, Show)++instance Arbitrary QueryParams where+  arbitrary = QueryParams <$> (arbitrary `suchThat` wellFormed)+    where+      wellFormed = all (not . T.null . fst)++---------------------------------------------------------------------------- -- Helpers  -- | 'req' that just returns the prepared 'L.Request'.--req_-  :: ( MonadHttp   m-     , HttpMethod  method-     , HttpBody    body-     , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )-  => method            -- ^ HTTP method-  -> Url scheme        -- ^ 'Url' — location of resource-  -> body              -- ^ Body of the request-  -> Option scheme     -- ^ Collection of optional parameters-  -> m L.Request       -- ^ Vanilla request-req_ method url' body options =-  responseRequest `liftM` req method url' body returnRequest options+req_ ::+  ( MonadHttp m,+    HttpMethod method,+    HttpBody body,+    HttpBodyAllowed (AllowsBody method) (ProvidesBody body)+  ) =>+  -- | HTTP method+  method ->+  -- | 'Url' — location of resource+  Url scheme ->+  -- | Body of the request+  body ->+  -- | Collection of optional parameters+  Option scheme ->+  -- | Vanilla request+  m L.Request+req_ method url' body options = req' method url' body options $+  \request _ -> return request  -- | A dummy 'Url'.- url :: Url 'Https url = https "httpbin.org"  -- | Percent encode given 'Text'.- urlEncode :: Text -> ByteString urlEncode = Y.urlEncode False . T.encodeUtf8  -- | Build URL path from given path pieces.- encodePathPieces :: [Text] -> ByteString encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments --- | Assemble entire URL.+-- | Get host from a 'URI'. This function is not total.+uriHost :: URI -> ByteString+uriHost uri =+  fromJust $+    urlEncode . URI.unRText . URI.authHost+      <$> either (const Nothing) Just (URI.uriAuthority uri) -assembleUrl-  :: Scheme            -- ^ Scheme-  -> Text              -- ^ Host-  -> [Text]            -- ^ Path pieces-  -> [(Text, Maybe Text)] -- ^ Query parameters-  -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string-assembleUrl scheme' host' pathPieces queryParams =-  (scheme <> host <> path <> queryString, path, queryString)-  where-    scheme = case scheme' of-      Http  -> "http://"-      Https -> "https://"-    host        = urlEncode host'-    path        = encodePathPieces pathPieces-    queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)+-- | Get part from a 'URI' defaulting to the provided value.+uriPort :: Int -> URI -> Int+uriPort def uri =+  maybe def (fromIntegral) $+    either (const Nothing) Just (URI.uriAuthority uri) >>= URI.authPort -renderQuery :: [(Text, Maybe Text)] -> BL.ByteString-renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery+-- | Get the path from a 'URI'.+uriPath :: URI -> ByteString+uriPath uri = fromMaybe "" $ do+  (trailingSlash, xs) <- URI.uriPath uri+  let pref = (encodePathPieces . fmap URI.unRText . NE.toList) xs+  return $ if trailingSlash then pref <> "/" else pref --- | Check if collection of query params is well-formed.+-- | Get the query string from a 'URI'.+uriQuery :: URI -> ByteString+uriQuery uri = do+  let liftQueryParam = \case+        URI.QueryFlag t -> (URI.unRText t, Nothing)+        URI.QueryParam k v -> (URI.unRText k, Just (URI.unRText v))+  Y.renderQuery True (Y.queryTextToQuery (liftQueryParam <$> (URI.uriQuery uri))) -wellFormed :: [(Text, Maybe Text)] -> Bool-wellFormed = all (not . T.null . fst)+-- | Predict the headrs that should be set if the given 'URI' has username+-- and password in it.+uriBasicAuth :: URI -> Maybe ByteString+uriBasicAuth uri = do+  auth <- either (const Nothing) Just (URI.uriAuthority uri)+  URI.UserInfo {..} <- URI.authUserInfo auth+  let username = T.encodeUtf8 (URI.unRText uiUsername)+      password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword+  return (basicAuthHeader username password) --- | Convert collection of query parameters to 'FormUrlEncodedParam' thing.+-- | Render a query as lazy 'BL.ByteString'.+renderQuery :: [(Text, Maybe Text)] -> BL.ByteString+renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery +-- | Convert collection of query parameters to 'FormUrlEncodedParam' thing. formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam formUrlEnc = foldMap (uncurry queryParam)  -- | Get “Authorization” basic auth header given username and password.- basicAuthHeader :: ByteString -> ByteString -> ByteString basicAuthHeader username password =   fromJust . lookup Y.hAuthorization . L.requestHeaders $     L.applyBasicAuth username password L.defaultRequest++-- | Get "Proxy-Authorization" basic proxy auth header given username and+-- password.+basicProxyAuthHeader :: ByteString -> ByteString -> ByteString+basicProxyAuthHeader username password =+  fromJust . lookup Y.hProxyAuthorization . L.requestHeaders $+    L.applyBasicProxyAuth username password L.defaultRequest++-- | Spec about 'paramToList' for the type @p@.+specParamToList :: (QueryParam p, Monoid p) => Proxy p -> Spec+specParamToList typeProxy = do+  describe "paramToList" $ do+    it "should reproduce the parameters given by queryParam" $+      property $ \(QueryParams params) -> do+        let queryParam0 =+              (mconcat $ fmap (uncurry queryParam) params)+                `asProxyTypeOf` typeProxy+            got = queryParamToList queryParam0+        got `shouldBe` params

@@ -1,132 +1,127 @@------ Cabal configuration for ‘req’ package.------ Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org>------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are--- met:------ * Redistributions of source code must retain the above copyright notice,---   this list of conditions and the following disclaimer.------ * Redistributions in binary form must reproduce the above copyright---   notice, this list of conditions and the following disclaimer in the---   documentation and/or other materials provided with the distribution.------ * Neither the name Mark Karpov nor the names of contributors may be used---   to endorse or promote products derived from this software without---   specific prior written permission.------ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY--- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED--- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE--- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY--- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL--- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS--- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)--- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,--- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN--- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE--- POSSIBILITY OF SUCH DAMAGE.+cabal-version:   2.4+name:            req+version:         3.13.4+license:         BSD-3-Clause+license-file:    LICENSE.md+maintainer:      Mark Karpov <markkarpov92@gmail.com>+author:          Mark Karpov <markkarpov92@gmail.com>+tested-with:     ghc ==9.6.3 ghc ==9.8.2 ghc ==9.10.1+homepage:        https://github.com/mrkkrp/req+bug-reports:     https://github.com/mrkkrp/req/issues+synopsis:        HTTP client library+description:     HTTP client library.+category:        Network, Web+build-type:      Simple+data-files:+    httpbin-data/utf8.html+    httpbin-data/robots.txt -name:                 req-version:              0.2.0-cabal-version:        >= 1.10-license:              BSD3-license-file:         LICENSE.md-author:               Mark Karpov <markkarpov@openmailbox.org>-maintainer:           Mark Karpov <markkarpov@openmailbox.org>-homepage:             https://github.com/mrkkrp/req-bug-reports:          https://github.com/mrkkrp/req/issues-category:             Network, Web-synopsis:             Easy-to-use, type-safe, expandable, high-level HTTP library-build-type:           Simple-description:          Easy-to-use, type-safe, expandable, high-level HTTP library.-extra-doc-files:      CHANGELOG.md-                    , README.md-data-files:           httpbin-data/utf8.html-                    , httpbin-data/robots.txt+extra-doc-files:+    CHANGELOG.md+    README.md  source-repository head-  type:               git-  location:           https://github.com/mrkkrp/req.git+    type:     git+    location: https://github.com/mrkkrp/req.git  flag dev-  description:        Turn on development settings.-  manual:             True-  default:            False+    description: Turn on development settings.+    default:     False+    manual:      True  library-  build-depends:      aeson            >= 0.9    && < 1.2-                    , authenticate-oauth >= 1.5  && < 1.7-                    , base             >= 4.7    && < 5.0-                    , blaze-builder    >= 0.3    && < 0.5-                    , bytestring       >= 0.10.8 && < 0.11-                    , case-insensitive >= 0.2    && < 1.3-                    , connection       >= 0.2.2  && < 0.3-                    , data-default-class-                    , http-api-data    >= 0.2    && < 0.4-                    , http-client      >= 0.5    && < 0.6-                    , http-client-tls  >= 0.3.2  && < 0.4-                    , http-types       >= 0.8    && < 10.0-                    , mtl              >= 2.0    && < 3.0-                    , text             >= 0.2    && < 1.3-                    , time             >= 1.2    && < 1.8-                    , transformers     >= 0.4    && < 0.6-  if !impl(ghc >= 8.0)-    build-depends:    semigroups   == 0.18.*-  exposed-modules:    Network.HTTP.Req-  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  default-language:   Haskell2010+    exposed-modules:  Network.HTTP.Req+    default-language: GHC2021+    build-depends:+        aeson >=0.9 && <3,+        authenticate-oauth >=1.5 && <1.8,+        base >=4.15 && <5,+        blaze-builder >=0.3 && <0.5,+        bytestring >=0.10.8 && <0.13,+        case-insensitive >=0.2 && <1.3,+        containers >=0.5 && <0.7,+        crypton-connection >=0.3 && <0.5,+        data-default-class,+        exceptions >=0.6 && <0.11,+        http-api-data >=0.2 && <0.7,+        http-client >=0.7.13.1 && <0.8,+        http-client-tls >=0.3.2 && <0.4,+        http-types >=0.8 && <10,+        modern-uri >=0.3 && <0.4,+        monad-control >=1.0 && <1.1,+        mtl >=2.0 && <3.0,+        retry >=0.8 && <0.10,+        template-haskell >=2.19 && <2.23,+        text >=0.2 && <2.2,+        transformers >=0.5.3.0 && <0.7,+        transformers-base,+        unliftio-core >=0.1.1 && <0.3 +    if flag(dev)+        ghc-options:+            -Wall -Werror -Wpartial-fields -Wunused-packages+            -Wno-unused-imports++    else+        ghc-options: -O2 -Wall+ test-suite pure-tests-  main-is:            Spec.hs-  other-modules:      Network.HTTP.ReqSpec-  hs-source-dirs:     pure-tests-  type:               exitcode-stdio-1.0-  build-depends:      QuickCheck       >= 2.7    && < 3.0-                    , aeson            >= 0.9    && < 1.2-                    , base             >= 4.7    && < 5.0-                    , blaze-builder    >= 0.3    && < 0.5-                    , bytestring       >= 0.10.8 && < 0.11-                    , case-insensitive >= 0.2    && < 1.3-                    , hspec            >= 2.0    && < 3.0-                    , hspec-core       >= 2.0    && < 3.0-                    , http-client      >= 0.5    && < 0.6-                    , http-types       >= 0.8    && < 10.0-                    , mtl              >= 2.0    && < 3.0-                    , req              >= 0.2.0-                    , text             >= 0.2    && < 1.3-                    , time             >= 1.2    && < 1.8-  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  default-language:   Haskell2010+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    build-tool-depends: hspec-discover:hspec-discover >=2 && <3+    hs-source-dirs:     pure-tests+    other-modules:      Network.HTTP.ReqSpec+    default-language:   GHC2021+    build-depends:+        QuickCheck >=2.7 && <3,+        aeson >=0.9 && <3,+        base >=4.15 && <5.0,+        blaze-builder >=0.3 && <0.5,+        bytestring >=0.10.8 && <0.13,+        case-insensitive >=0.2 && <1.3,+        hspec >=2.0 && <3,+        hspec-core >=2.0 && <3,+        http-api-data >=0.2 && <0.7,+        http-client >=0.7 && <0.8,+        http-types >=0.8 && <10,+        modern-uri >=0.3 && <0.4,+        req,+        retry >=0.8 && <0.10,+        template-haskell >=2.19 && <2.23,+        text >=0.2 && <2.2,+        time >=1.2 && <1.13 +    if flag(dev)+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages++    else+        ghc-options: -O2 -Wall+ test-suite httpbin-tests-  main-is:            Spec.hs-  other-modules:      Network.HTTP.ReqSpec-  hs-source-dirs:     httpbin-tests-  type:               exitcode-stdio-1.0-  build-depends:      QuickCheck       >= 2.7    && < 3.0-                    , aeson            >= 0.9    && < 1.2-                    , base             >= 4.7    && < 5.0-                    , bytestring       >= 0.10.8 && < 0.11-                    , data-default-class-                    , hspec            >= 2.0    && < 3.0-                    , http-client      >= 0.5    && < 0.6-                    , http-types       >= 0.8    && < 10.0-                    , mtl              >= 2.0    && < 3.0-                    , req              >= 0.2.0-                    , text             >= 0.2    && < 1.3-                    , unordered-containers >= 0.2.5 && < 0.2.8-  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  default-language:   Haskell2010+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    build-tool-depends: hspec-discover:hspec-discover >=2 && <3+    hs-source-dirs:     httpbin-tests+    other-modules:      Network.HTTP.ReqSpec+    default-language:   GHC2021+    build-depends:+        QuickCheck >=2.7 && <3,+        aeson >=2 && <3,+        base >=4.15 && <5,+        bytestring >=0.10.8 && <0.13,+        hspec >=2.0 && <3.0,+        http-client >=0.7 && <0.8,+        http-types >=0.8 && <10,+        monad-control >=1.0 && <1.1,+        req,+        text >=0.2 && <2.2++    if flag(dev)+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages++    else+        buildable: False