on master help sign in
.github/dependabot.ymlnew file+6
since splitsnapshots
unifiedsplit
@@ -0,0 +1,6 @@
1+version: 2
2+updates:
3+ - package-ecosystem: "github-actions"
4+ directory: "/"
5+ schedule:
6+ interval: "weekly"
.github/workflows/ci.yamlnew file+47
@@ -0,0 +1,47 @@
1+name: CI
2+on:
3+ push:
4+ branches:
5+ - master
6+ pull_request:
7+ types:
8+ - opened
9+ - synchronize
10+jobs:
11+ ormolu:
12+ runs-on: ubuntu-latest
13+ steps:
14+ - uses: actions/checkout@v4
15+ - uses: haskell-actions/run-ormolu@v17
16+ build:
17+ runs-on: ubuntu-latest
18+ needs: ormolu
19+ strategy:
20+ matrix:
21+ cabal: ["3.12"]
22+ ghc: ["9.6.3", "9.8.2", "9.10.1"]
23+ steps:
24+ - uses: actions/checkout@v4
25+ - uses: haskell-actions/setup@v2
26+ id: setup-haskell-cabal
27+ with:
28+ ghc-version: ${{ matrix.ghc }}
29+ cabal-version: ${{ matrix.cabal }}
30+ - run: cabal update
31+ - run: cabal freeze
32+ - uses: actions/cache@v4.2.3
33+ with:
34+ path: |
35+ ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
36+ dist-newstyle
37+ key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
38+ restore-keys: |
39+ ${{ runner.os }}-${{ matrix.ghc }}-
40+ - run: cabal format && git diff --exit-code --color=always
41+ - run: cabal build
42+ - run: |
43+ docker pull kennethreitz/httpbin
44+ docker run -p 1234:80 kennethreitz/httpbin &
45+ cabal test
46+ - run: cabal haddock
47+ - run: cabal sdist
.gitignore+14
@@ -1,10 +1,19 @@
1*#
1*#
2+*.aux
2*.chi
3*.chi
3*.chs.h
4*.chs.h
5+*.dyn_hi
6+*.dyn_o
7+*.eventlog
4*.hi
8*.hi
9+*.hp
5*.o
10*.o
11+*.prof
6*~
12*~
13+.HTF/
7.cabal-sandbox/
14.cabal-sandbox/
15+.ghc.environment.*
16+.hpc
8.hsenv
17.hsenv
9.stack-work/
18.stack-work/
10.virtualenv
19.virtualenv
@@ -12,5 +21,10 @@ TAGS
12benchmarks.tix
21benchmarks.tix
13cabal-dev
22cabal-dev
14cabal.config
23cabal.config
24+cabal.project.local
15cabal.sandbox.config
25cabal.sandbox.config
26+dist-*/
16dist/
27dist/
28+hie.yaml
29+stack.yaml
30+stack.yaml.lock
.travis.ymldeleted−44
@@ -1,44 +0,0 @@
1−language: c
2−
3−sudo: false
4−
5−cache:
6− directories:
7− - ~/.ghc
8− - ~/.cabal
9−
10−matrix:
11− include:
12− - env: CABALVER=1.24 GHCVER=7.8.4
13− addons: {apt: {packages: [cabal-install-1.24,ghc-7.8.4], sources: [hvr-ghc]}}
14− - env: CABALVER=1.24 GHCVER=7.10.3
15− addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3],sources: [hvr-ghc]}}
16− - env: CABALVER=1.24 GHCVER=8.0.2
17− addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}
18−
19−before_install:
20− - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
21−
22−install:
23− - cabal --version
24− - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
25− - travis_retry cabal update
26− - cabal install --only-dependencies --enable-tests
27− - cabal install hpc-coveralls
28−
29−script:
30− - cabal configure --enable-tests --enable-coverage -v2 -f dev
31− - cabal build
32− - cabal test --show-details=always
33− - cabal sdist
34− - cabal haddock | grep "100%" | wc -l | grep "1"
35−
36−after_script:
37− - export PATH=~/.cabal/bin:$PATH
38− - hpc-coveralls --coverage-mode=StrictlyFullLines
39− --exclude-dir=pure-tests
40− --exclude-dir=httpbin-tests
41− pure-tests httpbin-tests
42−
43−notifications:
44− email: false
CHANGELOG.md+235−6
@@ -1,15 +1,244 @@
1+## Req 3.13.4
2+
3+* Fixed empty ciphersuite list when compiling against `tls < 2.0.6`
4+ (see [PR 175](https://github.com/mrkkrp/req/pull/175)). As a side effect, now
5+ compatible with older versions of `crypton-connection` (>= 0.3).
6+
7+## Req 3.13.3
8+
9+* Works with `crypton-connection-0.4` and newer.
10+
11+## Req 3.13.2
12+
13+* Disable the problematic `httpbin-tests` test suite by default. Only enable
14+ it when the `dev` flag is enabled. In that case it is expected that an
15+ httpbin server is run locally at `localhost:1234`.
16+
17+## Req 3.13.1
18+
19+* Switched the non-pure test suite to use https://httpbun.org instead of
20+ https://httpbin.org since the latter proved to be highly unreliable
21+ lately.
22+
23+* Switched from `connection` to `crypton-connection`.
24+
25+* Builds with GHC 9.6.1.
26+
27+## Req 3.13.0
28+
29+* Add `headerRedacted` function to add header fields, which will be with
30+ redacted values on print.
31+
32+## Req 3.12.0
33+
34+* Add `isStatusCodeException` function.
35+* Add `instance HttpResponse (Network.HTTP.Client.Response ())`.
36+
37+## Req 3.11.0
38+
39+* Add the `queryParamToList` method to the `QueryParam` type class.
40+* Add the `formToQuery` function. [Issue 126](https://github.com/mrkkrp/req/issues/126).
41+* Add `FromForm` instances (in the `Web.FormUrlEncoded` module) to the
42+ `Option` and `FormUrlEncodedParam` types.
43+
44+## Req 3.10.0
45+
46+* Add `MonadHttp` instances for `transformers` types.
47+
48+## Req 3.9.2
49+
50+* The test suite works with `aeson-2.x.x.x`.
51+
52+## Req 3.9.1
53+
54+* Builds with GHC 9.0.
55+
56+## Req 3.9.0
57+
58+* The `useHttpURI` and `useHttpsURI` functions now preserve trailing
59+ slashes.
60+
61+## Req 3.8.0
62+
63+* Adjusted the value of the `httpConfigRetryJudgeException` field of
64+ `defaultHttpConfig` to retry on response timeouts and connection timeouts.
65+
66+## Req 3.7.0
67+
68+* Added `reqCb`, a function that allows you to modify the `Request` object
69+ but otherwise performs the requst for you.
70+
71+* Derived `MonadThrow`, `MonadCatch`, and `MonadMask` for the `Req` monad.
72+
73+## Req 3.6.0
74+
75+* Added the `httpConfigBodyPreviewLength` configuration parameter to
76+ `HttpConfig`.
77+
78+## Req 3.5.0
79+
80+* Made `Req` an instance of `MonadUnliftIO`. [Issue
81+ 100](https://github.com/mrkkrp/req/issues/100).
82+
83+## Req 3.4.0
84+
85+* Requests using `DELETE` method can now have a body. [Issue
86+ 89](https://github.com/mrkkrp/req/issues/89).
87+
88+* Added the `httpConfigRetryJudgeException` field to `HttpConfig` so that
89+ requests that result in exceptions can be retried. [Issue
90+ 93](https://github.com/mrkkrp/req/issues/93).
91+
92+* Added the function `renderUrl`. [Issue
93+ 83](https://github.com/mrkkrp/req/issues/83).
94+
95+## Req 3.3.0
96+
97+* Derived `Show` instances for response types `IgnoreResponse`,
98+ `JsonResponse`, `BsResponse`, and `LbsResponse`.
99+
100+## Req 3.2.0
101+
102+* Made the tests pass with `http-client-0.7` and later.
103+
104+* Added a quasiquoter for URL creation, `urlQ`.
105+
106+## Req 3.1.0
107+
108+* Changed signature of `httpConfigRetryPolicy` to `RetryPolicyM IO`.
109+
110+## Req 3.0.0
111+
112+* Dropped functions `parseUrlHttp`, `parseUrlHttps`, and `parseUrl`. Instead
113+ we now have `useHttpURI`, `useHttpsURI`, and `useURI` take `URI`s from
114+ `modern-uri` as their argument. You first parse your URL with the
115+ `modern-uri` package and then pass it to those functions. This allows us
116+ to work with typed URI representations and seamlessly convert them to
117+ something `req` can work with. As a side effect basic auth from the `URI`s
118+ is now taken into consideration. In the future we may also start to
119+ respect fragments if `http-client` starts to support this.
120+
121+* Dropped support for GHC 8.2 and older.
122+
123+## Req 2.1.0
124+
125+* Dropped support for GHC 7.10.
126+
127+* Added the new `acceptHeader` method to the `HttpResponse` type class.
128+ Notably, the `jsonResponse` method now sets `"Accept"` header to
129+ `"application/json"`.
130+
131+## Req 2.0.1
132+
133+* Fixed the `httpbin` tests (they changed something on the server again).
134+
135+## Req 2.0.0
136+
137+* Got rid of `data-default-class` dependency, now we export
138+ `defaultHttpConfig` instead.
139+
140+## Req 1.2.1
141+
142+* Fixed a typo in the type signature of `parseUrl`.
143+
144+## Req 1.2.0
145+
146+* Added the `parseUrl` function.
147+
148+## Req 1.1.0
149+
150+* Added `customAuth` and `attachHeader` to facilitate creation of custom
151+ authentication options.
152+
153+* Added `basicProxyAuth` authentication option.
154+
155+## Req 1.0.0
156+
157+* Added the `reqBr` function allowing to consume `Response BodyReader`
158+ without using a pre-defined instance of `HttpResponse`, in a custom way.
159+
160+* Now streaming of response body does not happen until we've checked headers
161+ and status code with `httpConfigCheckResponse`. It also doesn't happen on
162+ every retry. Streaming and obtaining of final response value happens only
163+ once when we're happy with everything.
164+
165+ Previously we first tried to consume and interpret response body before
166+ checking status code and determining whether we should retry the request.
167+ This was not good, because we could expect a JSON response but get a
168+ response with status code 500, and then still we would try to parse it as
169+ JSON first before letting `httpConfigCheckResponse` throw an exception.
170+
171+ The corrected behavior should also make retrying more efficient.
172+
173+* Changed signatures of several fields of `HttpConfig`:
174+ `httpConfigCheckResponse`, `httpConfigRetryPolicy`, and
175+ `httpConfigRetryJudge` in order to eliminate redundant `IO` and prevent
176+ the possibility that these functions could start consuming `BodyReader`.
177+
178+* Removed the `makeResponsePreview` method from the `HttpResponse` type
179+ class. Preview business is handled by the library automatically on a lower
180+ level now. Users do not need to concern themselves with such stuff.
181+
182+* Changed the type signature of the `getHttpResponse` method of the
183+ `HttpResponse` type class. Previously it left too much freedom (and
184+ responsibility) to implementers of the method. In fact, we now limit what
185+ `getHttpResponse` does to just consuming and interpreting `Response
186+ BodyReader`, so we can properly control details of connection
187+ opening/closing etc., for the user.
188+
189+* Dropped support for GHC 7.8.
190+
191+* Minor documentation improvements.
192+
193+## Req 0.5.0
194+
195+* Changed the signature of the `makeResponseBodyPreview` from `response ->
196+ IO ByteString` to `response -> ByteString`.
197+
198+* Minor documentation improvements.
199+
200+## Req 0.4.0
201+
202+* Added the `Req` monad and `runReq` function to run it. This allows to use
203+ `req` without defining new (orphan) instances.
204+
205+## Req 0.3.1
206+
207+* Added `basicAuthUnsafe`.
208+
1## Req 0.3.0
209## Req 0.3.0
2
210
211+* Made URL parsing functions `parseUrlHttp` and `parseUrlHttps` recognize
212+ port numbers.
213+
214+* Added `req'` function that allows to perform requests via a callback that
215+ receives pre-constructed request and manager.
216+
217+* Removed the `ReturnRequest` HTTP response implementation as it was not
218+ quite safe and was not going to work with retrying. Use `req'` instead for
219+ “pure” testing.
220+
221+* Changed the type of `httpConfigCheckResponse`, so the second argument can
222+ be any instance of `HttpResponse`.
223+
224+* Added built-in automatic retrying. See `httpConfigRetryPolicy` and
225+ `httpConfigRetryJudge` in `HttpConfig`. The default configuration retries
226+ 5 times on request timeouts.
227+
228+* Added the `makeResponseBodyPreview` method to the `HttpResponse` type
229+ class that allows to specify how to build a “preview” of response body for
230+ inclusion into exceptions.
231+
3* Improved wording in the documentation and `README.md`.
232* Improved wording in the documentation and `README.md`.
4
233
5## Req 0.2.0
234## Req 0.2.0
6
235
7−* Added support for multipart form data in form of `ReqBodyMultipart` body
236+* Added support for multipart form data in the form of `ReqBodyMultipart`
8− option and `reqBodyMultipart` helper function. This also required a change
237+ body option and `reqBodyMultipart` helper function. This also required a
9− in type signature of `getRequestContentType`, which now takes `body`, not
238+ change in the type signature of `getRequestContentType`, which now takes
10− `Proxy body` because we need to extract boundary from `body` and put it
239+ `body`, not `Proxy body` because we need to extract boundary from `body`
11− into `Content-Type` header. This change, however, shouldn't be too
240+ and put it into `Content-Type` header. This change, however, shouldn't be
12− dangerous for end-users.
241+ too dangerous for end-users.
13
242
14* Added support for OAuth 1.0 authentication via `oAuth1` option.
243* Added support for OAuth 1.0 authentication via `oAuth1` option.
15
244
LICENSE.md+1−1
@@ -1,4 +1,4 @@
1−Copyright © 2016–2017 Mark Karpov
1+Copyright © 2016–present Mark Karpov
2
2
3All rights reserved.
3All rights reserved.
4
4
Network/HTTP/Req.hs+1329−727
@@ -1,69 +1,58 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE LambdaCase #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE QuasiQuotes #-}
5+{-# LANGUAGE RecordWildCards #-}
6+{-# LANGUAGE RoleAnnotations #-}
7+{-# LANGUAGE TemplateHaskellQuotes #-}
8+{-# LANGUAGE TypeFamilies #-}
9+{-# LANGUAGE UndecidableInstances #-}
10+
1-- |
11-- |
2-- Module : Network.HTTP.Req
12-- Module : Network.HTTP.Req
3−-- Copyright : © 2016–2017 Mark Karpov
13+-- Copyright : © 2016–present Mark Karpov
4-- License : BSD 3 clause
14-- License : BSD 3 clause
5--
15--
6−-- Maintainer : Mark Karpov <markkarpov@openmailbox.org>
16+-- Maintainer : Mark Karpov <markkarpov92@gmail.com>
7-- Stability : experimental
17-- Stability : experimental
8-- Portability : portable
18-- Portability : portable
9--
19--
10-- The documentation below is structured in such a way that the most
20-- The documentation below is structured in such a way that the most
11-- important information is presented first: you learn how to do HTTP
21-- important information is presented first: you learn how to do HTTP
12−-- requests, how to embed them in any monad you have, and then it gives you
22+-- requests, how to embed them in the monad you have, and then it gives you
13-- details about less-common things you may want to know about. The
23-- details about less-common things you may want to know about. The
14-- documentation is written with sufficient coverage of details and
24-- documentation is written with sufficient coverage of details and
15-- examples, and it's designed to be a complete tutorial on its own.
25-- examples, and it's designed to be a complete tutorial on its own.
16--
26--
17−-- /(A modest intro goes here, click on 'req' to start making requests.)/
18−--
19-- === About the library
27-- === About the library
20--
28--
21−-- Req is an easy-to-use, type-safe, expandable, high-level HTTP library
29+-- Req is an HTTP client library that attempts to be easy-to-use, type-safe,
22−-- that just works without any fooling around.
30+-- and expandable.
23−--
31+--
24−-- What does the phrase “easy-to-use” mean? It means that the library is
32+-- “Easy-to-use” means that the library is designed to be beginner-friendly
25−-- designed to be beginner-friendly so it's simple to add to your monad
33+-- so it's simple to add to your monad stack, intuitive to work with,
26−-- stack, intuitive to work with, well-documented, and does not get in your
34+-- well-documented, and does not get in your way. Doing HTTP requests is a
27−-- way. Doing HTTP requests is a common task and a Haskell library for this
35+-- common task and a Haskell library for this should be approachable and
28−-- should be very approachable and clear to beginners, thus certain
29−-- compromises were made. For example, one cannot currently modify
36+-- clear to beginners, thus certain compromises were made. For example, one
30−-- 'L.ManagerSettings' of the default manager because the library always
37+-- cannot currently modify 'L.ManagerSettings' of the default manager
31−-- uses the same implicit global manager for simplicity and maximal
38+-- because the library always uses the same implicit global manager for
32−-- connection sharing. There is a way to use your own manager with different
39+-- simplicity and maximal connection sharing. There is a way to use your own
33−-- settings, but it requires a bit more typing.
40+-- manager with different settings, but it requires more typing.
34−--
41+--
35−-- “Type-safe” means that the library is protective and eliminates certain
42+-- “Type-safe” means that the library tries to eliminate certain classes of
36−-- classes of errors. For example, we have correct-by-construction 'Url's,
43+-- errors. For example, we have correct-by-construction URLs; it is
37−-- it's guaranteed that the user does not send the request body when using
44+-- guaranteed that the user does not send the request body when using
38−-- methods like 'GET' or 'OPTIONS', and the amount of implicit assumptions
45+-- methods like GET or OPTIONS, and the amount of implicit assumptions is
39−-- is minimized by making the user specify his\/her intentions in an
46+-- minimized by making the user specify their intentions in an explicit
40−-- explicit form (for example, it's not possible to avoid specifying the
47+-- form. For example, it's not possible to avoid specifying the body or the
41−-- body or method of a request). Authentication methods that assume TLS
48+-- method of a request. Authentication methods that assume HTTPS force the
42−-- force the user to use TLS at the type level. The library also carefully
49+-- user to use HTTPS at the type level.
43−-- hides underlying types from the lower-level @http-client@ package because
44−-- those types are not safe enough (for example 'L.Request' is an instance
45−-- of 'Data.String.IsString' and, if it's malformed, it will blow up at
46−-- run-time).
47−--
50+--
48−-- “Expandable” refers to the ability of the library to be expanded without
51+-- “Expandable” refers to the ability to create new components without
49−-- having to resort to ugly hacking. For example, it's possible to define
52+-- having to resort to hacking. For example, it's possible to define your
50−-- your own HTTP methods, create new ways to construct the body of a
53+-- own HTTP methods, create new ways to construct the body of a request,
51−-- request, create new authorization options, perform a request in a
54+-- create new authorization options, perform a request in a different way,
52−-- different way, and create your own methods to parse and represent a
55+-- and create your own methods to parse a response.
53−-- response. As a user extends the library to satisfy his\/her special
54−-- needs, the new solutions will work just like the built-ins. However, all
55−-- of the common cases are also covered by the library out-of-the-box.
56−--
57−-- “High-level” means that there are less details to worry about. The
58−-- library is a result of my experiences as a Haskell consultant. Working
59−-- for several clients, who had very different projects, showed me that the
60−-- library should adapt easily to any particular style of writing Haskell
61−-- applications. For example, some people prefer throwing exceptions, while
62−-- others are concerned with purity. Just define 'handleHttpException'
63−-- accordingly when making your monad instance of 'MonadHttp' and it will
64−-- play together seamlessly. Finally, the library cuts boilerplate down
65−-- considerably, and helps you write concise, easy to read, and maintainable
66−-- code.
67--
56--
68-- === Using with other libraries
57-- === Using with other libraries
69--
58--
@@ -76,189 +65,218 @@
76-- === Lightweight, no risk solution
65-- === Lightweight, no risk solution
77--
66--
78-- The library uses the following mature packages under the hood to
67-- The library uses the following mature packages under the hood to
79−-- guarantee you the best experience that doesn't have any bugs or other
68+-- guarantee you the best experience:
80−-- funny business:
81--
69--
82−-- * <https://hackage.haskell.org/package/http-client> — low level HTTP
70+-- * <https://hackage.haskell.org/package/http-client>—low level HTTP
83-- client used everywhere in Haskell.
71-- client used everywhere in Haskell.
84−-- * <https://hackage.haskell.org/package/http-client-tls> — TLS (HTTPS)
72+-- * <https://hackage.haskell.org/package/http-client-tls>—TLS (HTTPS)
85-- support for @http-client@.
73-- support for @http-client@.
86--
74--
87-- It's important to note that since we leverage well-known libraries that
75-- It's important to note that since we leverage well-known libraries that
88-- the whole Haskell ecosystem uses, there is no risk in using @req@. The
76-- the whole Haskell ecosystem uses, there is no risk in using @req@. The
89-- machinery for performing requests is the same as with @http-conduit@ and
77-- machinery for performing requests is the same as with @http-conduit@ and
90-- @wreq@. The only difference is the API.
78-- @wreq@. The only difference is the API.
91−
92−{-# LANGUAGE CPP #-}
93−{-# LANGUAGE DataKinds #-}
94−{-# LANGUAGE DeriveDataTypeable #-}
95−{-# LANGUAGE DeriveGeneric #-}
96−{-# LANGUAGE FlexibleInstances #-}
97−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
98−{-# LANGUAGE KindSignatures #-}
99−{-# LANGUAGE OverloadedStrings #-}
100−{-# LANGUAGE RecordWildCards #-}
101−{-# LANGUAGE ScopedTypeVariables #-}
102−{-# LANGUAGE TypeFamilies #-}
103−
104−#if MIN_VERSION_base(4,9,0)
105−{-# LANGUAGE UndecidableInstances #-}
106−#endif
107−
108−#if __GLASGOW_HASKELL__ < 710
109−{-# LANGUAGE ConstraintKinds #-}
110−#endif
111−
112−#if __GLASGOW_HASKELL__ >= 800
113−{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
114−#endif
115−
116module Network.HTTP.Req
79module Network.HTTP.Req
117 ( -- * Making a request
80 ( -- * Making a request
118 -- $making-a-request
81 -- $making-a-request
119− req
82+ req,
83+ reqBr,
84+ reqCb,
85+ req',
120− , withReqManager
86+ withReqManager,
87+
121− -- * Embedding requests into your monad
88+ -- * Embedding requests in your monad
122 -- $embedding-requests
89 -- $embedding-requests
123− , MonadHttp (..)
90+ MonadHttp (..),
124− , HttpConfig (..)
91+ HttpConfig (..),
92+ defaultHttpConfig,
93+ Req,
94+ runReq,
95+
125 -- * Request
96 -- * Request
97+
126 -- ** Method
98 -- ** Method
127 -- $method
99 -- $method
128− , GET (..)
100+ GET (..),
129− , POST (..)
101+ POST (..),
130− , HEAD (..)
102+ HEAD (..),
131− , PUT (..)
103+ PUT (..),
132− , DELETE (..)
104+ DELETE (..),
133− , TRACE (..)
105+ TRACE (..),
134− , CONNECT (..)
106+ CONNECT (..),
135− , OPTIONS (..)
107+ OPTIONS (..),
136− , PATCH (..)
108+ PATCH (..),
137− , HttpMethod (..)
109+ HttpMethod (..),
110+
138 -- ** URL
111 -- ** URL
139 -- $url
112 -- $url
140− , Url
113+ Url,
141− , http
114+ http,
142− , https
115+ https,
143− , (/~)
116+ (/~),
144− , (/:)
117+ (/:),
145− , parseUrlHttp
118+ useHttpURI,
146− , parseUrlHttps
119+ useHttpsURI,
120+ useURI,
121+ urlQ,
122+ renderUrl,
123+
147 -- ** Body
124 -- ** Body
148 -- $body
125 -- $body
149− , NoReqBody (..)
126+ NoReqBody (..),
150− , ReqBodyJson (..)
127+ ReqBodyJson (..),
151− , ReqBodyFile (..)
128+ ReqBodyFile (..),
152− , ReqBodyBs (..)
129+ ReqBodyBs (..),
153− , ReqBodyLbs (..)
130+ ReqBodyLbs (..),
154− , ReqBodyUrlEnc (..)
131+ ReqBodyUrlEnc (..),
155− , FormUrlEncodedParam
132+ FormUrlEncodedParam,
156− , ReqBodyMultipart
133+ ReqBodyMultipart,
157− , reqBodyMultipart
134+ reqBodyMultipart,
158− , HttpBody (..)
135+ HttpBody (..),
159− , ProvidesBody
136+ ProvidesBody,
160− , HttpBodyAllowed
137+ HttpBodyAllowed,
138+
161 -- ** Optional parameters
139 -- ** Optional parameters
162 -- $optional-parameters
140 -- $optional-parameters
163− , Option
141+ Option,
142+
164 -- *** Query parameters
143 -- *** Query parameters
165 -- $query-parameters
144 -- $query-parameters
166− , (=:)
145+ (=:),
167− , queryFlag
146+ queryFlag,
147+ formToQuery,
168− , QueryParam (..)
148+ QueryParam (..),
149+
169 -- *** Headers
150 -- *** Headers
170− , header
151+ header,
152+ attachHeader,
153+ headerRedacted,
154+
171 -- *** Cookies
155 -- *** Cookies
172 -- $cookies
156 -- $cookies
173− , cookieJar
157+ cookieJar,
158+
174 -- *** Authentication
159 -- *** Authentication
175 -- $authentication
160 -- $authentication
176− , basicAuth
161+ basicAuth,
162+ basicAuthUnsafe,
163+ basicProxyAuth,
177− , oAuth1
164+ oAuth1,
178− , oAuth2Bearer
165+ oAuth2Bearer,
179− , oAuth2Token
166+ oAuth2Token,
167+ customAuth,
168+
180 -- *** Other
169 -- *** Other
181− , port
170+ port,
182− , decompress
171+ decompress,
183− , responseTimeout
172+ responseTimeout,
184− , httpVersion
173+ httpVersion,
174+
185 -- * Response
175 -- * Response
176+
186 -- ** Response interpretations
177 -- ** Response interpretations
187− , IgnoreResponse
178+ IgnoreResponse,
188− , ignoreResponse
179+ ignoreResponse,
189− , JsonResponse
180+ JsonResponse,
190− , jsonResponse
181+ jsonResponse,
191− , BsResponse
182+ BsResponse,
192− , bsResponse
183+ bsResponse,
193− , LbsResponse
184+ LbsResponse,
194− , lbsResponse
185+ lbsResponse,
195− , ReturnRequest
186+
196− , returnRequest
197 -- ** Inspecting a response
187 -- ** Inspecting a response
198− , responseBody
188+ responseBody,
199− , responseStatusCode
189+ responseStatusCode,
200− , responseStatusMessage
190+ responseStatusMessage,
201− , responseHeader
191+ responseHeader,
202− , responseCookieJar
192+ responseCookieJar,
203− , responseRequest
193+
204 -- ** Defining your own interpretation
194 -- ** Defining your own interpretation
205 -- $new-response-interpretation
195 -- $new-response-interpretation
206− , HttpResponse (..)
196+ HttpResponse (..),
197+
207 -- * Other
198 -- * Other
208− , HttpException (..)
199+ HttpException (..),
200+ isStatusCodeException,
209− , CanHaveBody (..)
201+ CanHaveBody (..),
210− , Scheme (..) )
202+ Scheme (..),
203+ )
211where
204where
212
205
206+import Blaze.ByteString.Builder qualified as BB
213import Control.Applicative
207import Control.Applicative
214import Control.Arrow (first, second)
208import Control.Arrow (first, second)
215−import Control.Exception (Exception, try, catch, throwIO)
209+import Control.Exception hiding (Handler (..), TypeError)
210+import Control.Monad (guard, void, (>=>))
216−import Control.Monad
211+import Control.Monad.Base
212+import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
217import Control.Monad.IO.Class
213import Control.Monad.IO.Class
218−import Data.Aeson (ToJSON (..), FromJSON (..))
214+import Control.Monad.IO.Unlift
215+import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)
216+import Control.Monad.Trans.Accum (AccumT)
217+import Control.Monad.Trans.Cont (ContT)
218+import Control.Monad.Trans.Control
219+import Control.Monad.Trans.Except (ExceptT)
220+import Control.Monad.Trans.Identity (IdentityT)
221+import Control.Monad.Trans.Maybe (MaybeT)
222+import Control.Monad.Trans.RWS.CPS qualified as RWS.CPS
223+import Control.Monad.Trans.RWS.Lazy qualified as RWS.Lazy
224+import Control.Monad.Trans.RWS.Strict qualified as RWS.Strict
225+import Control.Monad.Trans.Select (SelectT)
226+import Control.Monad.Trans.State.Lazy qualified as State.Lazy
227+import Control.Monad.Trans.State.Strict qualified as State.Strict
228+import Control.Monad.Trans.Writer.CPS qualified as Writer.CPS
229+import Control.Monad.Trans.Writer.Lazy qualified as Writer.Lazy
230+import Control.Monad.Trans.Writer.Strict qualified as Writer.Strict
231+import Control.Retry
232+import Data.Aeson (FromJSON (..), ToJSON (..))
233+import Data.Aeson qualified as A
219import Data.ByteString (ByteString)
234import Data.ByteString (ByteString)
235+import Data.ByteString qualified as B
236+import Data.ByteString.Lazy qualified as BL
237+import Data.CaseInsensitive qualified as CI
220import Data.Data (Data)
238import Data.Data (Data)
221−import Data.Default.Class
239+import Data.Default.Class (def)
222import Data.Function (on)
240import Data.Function (on)
223import Data.IORef
241import Data.IORef
224−import Data.List (nubBy)
242+import Data.Kind (Constraint, Type)
243+import Data.List (foldl', nubBy)
225import Data.List.NonEmpty (NonEmpty (..))
244import Data.List.NonEmpty (NonEmpty (..))
245+import Data.List.NonEmpty qualified as NE
226import Data.Maybe (fromMaybe)
246import Data.Maybe (fromMaybe)
227import Data.Proxy
247import Data.Proxy
228−import Data.Semigroup hiding (Option, option)
248+import Data.Semigroup (Endo (..))
229−import Data.Typeable (Typeable)
249+import Data.Set qualified as S
250+import Data.Text (Text)
251+import Data.Text qualified as T
252+import Data.Text.Encoding qualified as T
253+import Data.Typeable (Typeable, cast)
230import GHC.Generics
254import GHC.Generics
231import GHC.TypeLits
255import GHC.TypeLits
256+import Language.Haskell.TH qualified as TH
257+import Language.Haskell.TH.Quote qualified as TH
258+import Language.Haskell.TH.Syntax qualified as TH
259+import Network.Connection qualified as NC
260+import Network.HTTP.Client qualified as L
261+import Network.HTTP.Client.Internal qualified as LI
262+import Network.HTTP.Client.MultipartFormData qualified as LM
263+import Network.HTTP.Client.TLS qualified as L
264+import Network.HTTP.Types qualified as Y
232import System.IO.Unsafe (unsafePerformIO)
265import System.IO.Unsafe (unsafePerformIO)
266+import Text.URI (URI)
267+import Text.URI qualified as URI
268+import Text.URI.QQ qualified as QQ
269+import Web.Authenticate.OAuth qualified as OAuth
270+import Web.FormUrlEncoded (FromForm (..), ToForm (..))
271+import Web.FormUrlEncoded qualified as Form
233import Web.HttpApiData (ToHttpApiData (..))
272import Web.HttpApiData (ToHttpApiData (..))
234−import qualified Blaze.ByteString.Builder as BB
235−import qualified Data.Aeson as A
236−import qualified Data.ByteString as B
237−import qualified Data.ByteString.Lazy as BL
238−import qualified Data.CaseInsensitive as CI
239−import qualified Data.List.NonEmpty as NE
240−import qualified Data.Text as T
241−import qualified Data.Text.Encoding as T
242−import qualified Network.Connection as NC
243−import qualified Network.HTTP.Client as L
244−import qualified Network.HTTP.Client.Internal as LI
245−import qualified Network.HTTP.Client.MultipartFormData as LM
246−import qualified Network.HTTP.Client.TLS as L
247−import qualified Network.HTTP.Types as Y
248−import qualified Web.Authenticate.OAuth as OAuth
249−
250−#if MIN_VERSION_base(4,9,0)
251−import Data.Kind (Constraint)
252−#else
253−import GHC.Exts (Constraint)
254−#endif
255
273
256----------------------------------------------------------------------------
274----------------------------------------------------------------------------
257-- Making a request
275-- Making a request
258
276
259-- $making-a-request
277-- $making-a-request
260--
278--
261−-- To make an HTTP request you need only one function: 'req'.
279+-- To make an HTTP request you normally need only one function: 'req'.
262
280
263-- | Make an HTTP request. The function takes 5 arguments, 4 of which
281-- | Make an HTTP request. The function takes 5 arguments, 4 of which
264-- specify required parameters and the final 'Option' argument is a
282-- specify required parameters and the final 'Option' argument is a
@@ -275,36 +293,39 @@ import GHC.Exts (Constraint)
275--
293--
276-- @body@ is a body option such as 'NoReqBody' or 'ReqBodyJson'. The
294-- @body@ is a body option such as 'NoReqBody' or 'ReqBodyJson'. The
277-- tutorial has a section about HTTP bodies, but usage is very
295-- tutorial has a section about HTTP bodies, but usage is very
278−-- straightforward and should be clear from the examples below.
296+-- straightforward and should be clear from the examples.
279--
297--
280−-- @response@ is a type hint how to make and interpret response of HTTP
298+-- @response@ is a type hint how to make and interpret response of an HTTP
281−-- request, out-of-the-box it can be the following: 'ignoreResponse',
299+-- request. Out-of-the-box it can be the following:
282−-- 'jsonResponse', 'bsResponse' (to get strict 'ByteString'), 'lbsResponse'
283−-- (to get lazy 'BL.ByteString'), and 'returnRequest' (makes no request,
284−-- just returns response, used for testing).
285--
300--
301+-- * 'ignoreResponse'
302+-- * 'jsonResponse'
303+-- * 'bsResponse' (to get a strict 'ByteString')
304+-- * 'lbsResponse' (to get a lazy 'BL.ByteString')
305+--
286−-- Finally @options@ is a 'Monoid' that holds a composite 'Option' for all
306+-- Finally, @options@ is a 'Monoid' that holds a composite 'Option' for all
287−-- other optional things like query parameters, headers, non-standard port
307+-- other optional settings like query parameters, headers, non-standard port
288−-- number, etc. There are quite a few things you can put there, see
308+-- number, etc. There are quite a few things you can put there, see the
289-- corresponding section in the documentation. If you don't need anything at
309-- corresponding section in the documentation. If you don't need anything at
290-- all, pass 'mempty'.
310-- all, pass 'mempty'.
291--
311--
292-- __Note__ that if you use 'req' to do all your requests, connection
312-- __Note__ that if you use 'req' to do all your requests, connection
293-- sharing and reuse is done for you automatically.
313-- sharing and reuse is done for you automatically.
294--
314--
295−-- See the examples below to get on the speed very quickly.
315+-- See the examples below to get on the speed quickly.
296--
316--
297-- ==== __Examples__
317-- ==== __Examples__
298--
318--
299-- First, this is a piece of boilerplate that should be in place before you
319-- First, this is a piece of boilerplate that should be in place before you
300-- try the examples:
320-- try the examples:
301--
321--
322+-- > {-# LANGUAGE DeriveGeneric #-}
302-- > {-# LANGUAGE OverloadedStrings #-}
323-- > {-# LANGUAGE OverloadedStrings #-}
303-- >
324-- >
304-- > module Main (main) where
325-- > module Main (main) where
305-- >
326-- >
306−-- > import Control.Exception (throwIO)
307-- > import Control.Monad
327-- > import Control.Monad
328+-- > import Control.Monad.IO.Class
308-- > import Data.Aeson
329-- > import Data.Aeson
309-- > import Data.Maybe (fromJust)
330-- > import Data.Maybe (fromJust)
310-- > import Data.Monoid ((<>))
331-- > import Data.Monoid ((<>))
@@ -312,32 +333,30 @@ import GHC.Exts (Constraint)
312-- > import GHC.Generics
333-- > import GHC.Generics
313-- > import Network.HTTP.Req
334-- > import Network.HTTP.Req
314-- > import qualified Data.ByteString.Char8 as B
335-- > import qualified Data.ByteString.Char8 as B
315−-- >
336+-- > import qualified Text.URI as URI
316−-- > instance MonadHttp IO where
317−-- > handleHttpException = throwIO
318--
337--
319-- We will be making requests against the <https://httpbin.org> service.
338-- We will be making requests against the <https://httpbin.org> service.
320--
339--
321-- Make a GET request, grab 5 random bytes:
340-- Make a GET request, grab 5 random bytes:
322--
341--
323-- > main :: IO ()
342-- > main :: IO ()
324−-- > main = do
343+-- > main = runReq defaultHttpConfig $ do
325-- > let n :: Int
344-- > let n :: Int
326-- > n = 5
345-- > n = 5
327-- > bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse mempty
346-- > bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse mempty
328−-- > B.putStrLn (responseBody bs)
347+-- > liftIO $ B.putStrLn (responseBody bs)
329--
348--
330-- The same, but now we use a query parameter named @\"seed\"@ to control
349-- The same, but now we use a query parameter named @\"seed\"@ to control
331-- seed of the generator:
350-- seed of the generator:
332--
351--
333-- > main :: IO ()
352-- > main :: IO ()
334−-- > main = do
353+-- > main = runReq defaultHttpConfig $ do
335-- > let n, seed :: Int
354-- > let n, seed :: Int
336-- > n = 5
355-- > n = 5
337-- > seed = 100
356-- > seed = 100
338-- > bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse $
357-- > bs <- req GET (https "httpbin.org" /: "bytes" /~ n) NoReqBody bsResponse $
339-- > "seed" =: seed
358-- > "seed" =: seed
340−-- > B.putStrLn (responseBody bs)
359+-- > liftIO $ B.putStrLn (responseBody bs)
341--
360--
342-- POST JSON data and get some info about the POST request:
361-- POST JSON data and get some info about the POST request:
343--
362--
@@ -350,104 +369,252 @@ import GHC.Exts (Constraint)
350-- > instance FromJSON MyData
369-- > instance FromJSON MyData
351-- >
370-- >
352-- > main :: IO ()
371-- > main :: IO ()
353−-- > main = do
372+-- > main = runReq defaultHttpConfig $ do
354-- > let myData = MyData
373-- > let myData = MyData
355-- > { size = 6
374-- > { size = 6
356-- > , color = "Green" }
375-- > , color = "Green" }
357-- > v <- req POST (https "httpbin.org" /: "post") (ReqBodyJson myData) jsonResponse mempty
376-- > v <- req POST (https "httpbin.org" /: "post") (ReqBodyJson myData) jsonResponse mempty
358−-- > print (responseBody v :: Value)
377+-- > liftIO $ print (responseBody v :: Value)
359--
378--
360-- Sending URL-encoded body:
379-- Sending URL-encoded body:
361--
380--
362-- > main :: IO ()
381-- > main :: IO ()
363−-- > main = do
382+-- > main = runReq defaultHttpConfig $ do
364-- > let params =
383-- > let params =
365-- > "foo" =: ("bar" :: Text) <>
384-- > "foo" =: ("bar" :: Text) <>
366-- > queryFlag "baz"
385-- > queryFlag "baz"
367-- > response <- req POST (https "httpbin.org" /: "post") (ReqBodyUrlEnc params) jsonResponse mempty
386-- > response <- req POST (https "httpbin.org" /: "post") (ReqBodyUrlEnc params) jsonResponse mempty
368−-- > print (responseBody response :: Value)
387+-- > liftIO $ print (responseBody response :: Value)
369--
388--
370-- Using various optional parameters and URL that is not known in advance:
389-- Using various optional parameters and URL that is not known in advance:
371--
390--
372-- > main :: IO ()
391-- > main :: IO ()
373−-- > main = do
392+-- > main = runReq defaultHttpConfig $ do
374-- > -- This is an example of what to do when URL is given dynamically. Of
393-- > -- This is an example of what to do when URL is given dynamically. Of
375-- > -- course in a real application you may not want to use 'fromJust'.
394-- > -- course in a real application you may not want to use 'fromJust'.
376−-- > let (url, options) = fromJust (parseUrlHttps "https://httpbin.org/get?foo=bar")
395+-- > uri <- URI.mkURI "https://httpbin.org/get?foo=bar"
396+-- > let (url, options) = fromJust (useHttpsURI uri)
377-- > response <- req GET url NoReqBody jsonResponse $
397-- > response <- req GET url NoReqBody jsonResponse $
378-- > "from" =: (15 :: Int) <>
398-- > "from" =: (15 :: Int) <>
379-- > "to" =: (67 :: Int) <>
399-- > "to" =: (67 :: Int) <>
380-- > basicAuth "username" "password" <>
400-- > basicAuth "username" "password" <>
381-- > options <> -- contains the ?foo=bar part
401-- > options <> -- contains the ?foo=bar part
382-- > port 443 -- here you can put any port of course
402-- > port 443 -- here you can put any port of course
383−-- > print (responseBody response :: Value)
403+-- > liftIO $ print (responseBody response :: Value)
384−
404+req ::
385−req
405+ ( MonadHttp m,
406+ HttpMethod method,
407+ HttpBody body,
408+ HttpResponse response,
409+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
410+ ) =>
411+ -- | HTTP method
412+ method ->
413+ -- | 'Url'—location of resource
414+ Url scheme ->
415+ -- | Body of the request
416+ body ->
417+ -- | A hint how to interpret response
418+ Proxy response ->
419+ -- | Collection of optional parameters
420+ Option scheme ->
421+ -- | Response
422+ m response
423+req method url body responseProxy options =
424+ reqCb method url body responseProxy options pure
425+
426+-- | A version of 'req' that does not use one of the predefined instances of
427+-- 'HttpResponse' but instead allows the user to consume @'L.Response'
428+-- 'L.BodyReader'@ manually, in a custom way.
429+--
430+-- @since 1.0.0
431+reqBr ::
432+ ( MonadHttp m,
433+ HttpMethod method,
434+ HttpBody body,
435+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
436+ ) =>
437+ -- | HTTP method
438+ method ->
439+ -- | 'Url'—location of resource
440+ Url scheme ->
441+ -- | Body of the request
442+ body ->
443+ -- | Collection of optional parameters
444+ Option scheme ->
445+ -- | How to consume response
446+ (L.Response L.BodyReader -> IO a) ->
447+ -- | Result
448+ m a
449+reqBr method url body options consume =
450+ req' method url body options (reqHandler consume)
451+
452+-- | A version of 'req' that takes a callback to modify the 'L.Request', but
453+-- otherwise performs the request identically.
454+--
455+-- @since 3.7.0
456+reqCb ::
457+ ( MonadHttp m,
458+ HttpMethod method,
459+ HttpBody body,
460+ HttpResponse response,
461+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
462+ ) =>
463+ -- | HTTP method
464+ method ->
465+ -- | 'Url'—location of resource
466+ Url scheme ->
467+ -- | Body of the request
468+ body ->
469+ -- | A hint how to interpret response
470+ Proxy response ->
471+ -- | Collection of optional parameters
472+ Option scheme ->
473+ -- | Callback to modify the request
474+ (L.Request -> m L.Request) ->
475+ -- | Response
476+ m response
477+reqCb method url body responseProxy options adjustRequest =
478+ req' method url body (options <> extraOptions) $ \request manager -> do
479+ request' <- adjustRequest request
480+ reqHandler getHttpResponse request' manager
481+ where
482+ extraOptions =
483+ case acceptHeader responseProxy of
484+ Nothing -> mempty
485+ Just accept -> header "Accept" accept
486+
487+-- | The default handler function that the higher-level request functions
488+-- pass to 'req''. Internal function.
489+--
490+-- @since 3.7.0
491+reqHandler ::
492+ (MonadHttp m) =>
493+ -- | How to get final result from a 'L.Response'
494+ (L.Response L.BodyReader -> IO b) ->
495+ -- | 'L.Request' to perform
496+ L.Request ->
497+ -- | 'L.Manager' to use
498+ L.Manager ->
499+ m b
500+reqHandler consume request manager = do
501+ HttpConfig {..} <- getHttpConfig
502+ let wrapVanilla = handle (throwIO . VanillaHttpException)
503+ wrapExc = handle (throwIO . LI.toHttpException request)
504+ withRRef =
505+ bracket
506+ (newIORef Nothing)
507+ (readIORef >=> mapM_ L.responseClose)
508+ (liftIO . try . wrapVanilla . wrapExc)
509+ ( withRRef $ \rref -> do
510+ let openResponse = mask_ $ do
511+ r <- readIORef rref
512+ mapM_ L.responseClose r
513+ r' <- L.responseOpen request manager
514+ writeIORef rref (Just r')
515+ return r'
516+ exceptionRetryPolicies =
517+ skipAsyncExceptions
518+ ++ [ \retryStatus -> Handler $ \e ->
519+ return $ httpConfigRetryJudgeException retryStatus e
520+ ]
521+ r <-
522+ retrying
523+ httpConfigRetryPolicy
524+ (\retryStatus r -> return $ httpConfigRetryJudge retryStatus r)
525+ ( const
526+ ( recovering
527+ httpConfigRetryPolicy
528+ exceptionRetryPolicies
529+ (const openResponse)
530+ )
531+ )
532+ (preview, r') <- grabPreview httpConfigBodyPreviewLength r
533+ mapM_ LI.throwHttp (httpConfigCheckResponse request r' preview)
534+ consume r'
535+ )
536+ >>= either handleHttpException return
537+
538+-- | Mostly like 'req' with respect to its arguments, but accepts a callback
539+-- that allows to perform a request in arbitrary fashion.
540+--
541+-- This function /does not/ perform handling\/wrapping exceptions, checking
542+-- response (with 'httpConfigCheckResponse'), and retrying. It only prepares
543+-- 'L.Request' and allows you to use it.
544+--
545+-- @since 0.3.0
546+req' ::
386− :: forall m method body response scheme.
547+ forall m method body scheme a.
387− ( MonadHttp m
548+ ( MonadHttp m,
388− , HttpMethod method
549+ HttpMethod method,
389− , HttpBody body
550+ HttpBody body,
390− , HttpResponse response
391− , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )
551+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
552+ ) =>
392− => method -- ^ HTTP method
553+ -- | HTTP method
554+ method ->
393− -> Url scheme -- ^ 'Url' — location of resource
555+ -- | 'Url'—location of resource
556+ Url scheme ->
394− -> body -- ^ Body of the request
557+ -- | Body of the request
395− -> Proxy response -- ^ A hint how to interpret response
558+ body ->
559+ -- | Collection of optional parameters
396− -> Option scheme -- ^ Collection of optional parameters
560+ Option scheme ->
397− -> m response -- ^ Response
561+ -- | How to perform request
562+ (L.Request -> L.Manager -> m a) ->
563+ -- | Result
564+ m a
398−req method url body Proxy options = do
565+req' method url body options m = do
399− config <- getHttpConfig
566+ config <- getHttpConfig
400− manager <- liftIO (readIORef globalManager)
401 let -- NOTE First appearance of any given header wins. This allows to
567 let -- NOTE First appearance of any given header wins. This allows to
402 -- “overwrite” headers when we construct a request by cons-ing.
568 -- “overwrite” headers when we construct a request by cons-ing.
403 nubHeaders = Endo $ \x ->
569 nubHeaders = Endo $ \x ->
404− x { L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x) }
570+ x {L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x)}
571+ request' =
405− request' = flip appEndo L.defaultRequest $
572+ flip appEndo L.defaultRequest $
406− -- NOTE Order of 'mappend's matters, here method is overwritten first
573+ -- NOTE The order of 'mappend's matters, here method is overwritten
407− -- and 'options' take effect last. In particular, this means that
574+ -- first and 'options' take effect last. In particular, this means
408− -- 'options' can overwrite things set by other request components,
575+ -- that 'options' can overwrite things set by other request
409− -- which is useful for setting port number, "Content-Type" header,
576+ -- components, which is useful for setting port number,
410− -- etc.
577+ -- "Content-Type" header, etc.
411− nubHeaders <>
578+ nubHeaders
412− getRequestMod options <>
579+ <> getRequestMod options
413− getRequestMod config <>
580+ <> getRequestMod config
414− getRequestMod (Womb body :: Womb "body" body) <>
581+ <> getRequestMod (Tagged body :: Tagged "body" body)
415− getRequestMod url <>
582+ <> getRequestMod url
416− getRequestMod (Womb method :: Womb "method" method)
583+ <> getRequestMod (Tagged method :: Tagged "method" method)
417− wrappingVanilla m = catch m (throwIO . VanillaHttpException)
418 request <- finalizeRequest options request'
584 request <- finalizeRequest options request'
419− (liftIO . try . wrappingVanilla) (getHttpResponse request manager)
585+ withReqManager (m request)
420− >>= either handleHttpException return
586+
587+-- | Perform an action using the global implicit 'L.Manager' that the rest
588+-- of the library uses. This allows us to reuse connections that the
589+-- 'L.Manager' controls.
590+withReqManager :: (MonadIO m) => (L.Manager -> m a) -> m a
591+withReqManager m = m globalManager
421
592
422−-- | Global 'L.Manager' that 'req' uses. Here we just go with the default
593+-- | The global 'L.Manager' that 'req' uses. Here we just go with the
423−-- settings, so users don't need to deal with this manager stuff at all, but
594+-- default settings, so users don't need to deal with this manager stuff at
424−-- when we create a request, instance 'HttpConfig' can affect the default
595+-- all, but when we create a request, instance 'HttpConfig' can affect the
425−-- settings via 'getHttpConfig'.
596+-- default settings via 'getHttpConfig'.
426--
597--
427-- A note about safety, in case 'unsafePerformIO' looks suspicious to you.
598-- A note about safety, in case 'unsafePerformIO' looks suspicious to you.
428-- The value of 'globalManager' is named and lives on top level. This means
599-- The value of 'globalManager' is named and lives on top level. This means
429−-- it will be shared, i.e. computed only once on first use of manager. From
600+-- it will be shared, i.e. computed only once on the first use of the
430−-- that moment on the 'IORef' will be just reused — exactly the behavior we
601+-- manager. From that moment on the 'IORef' will be just reused—exactly the
431−-- want here in order to maximize connection sharing. GHC could spoil the
602+-- behavior we want here in order to maximize connection sharing. GHC could
432−-- plan by inlining the definition, hence the @NOINLINE@ pragma.
603+-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
433−
434−globalManager :: IORef L.Manager
604+globalManager :: L.Manager
435globalManager = unsafePerformIO $ do
605globalManager = unsafePerformIO $ do
436 context <- NC.initConnectionContext
606 context <- NC.initConnectionContext
607+ let settings =
437− let settings = L.mkManagerSettingsContext (Just context) def Nothing
608+ L.mkManagerSettingsContext
609+ (Just context)
610+ def
611+ Nothing
438 manager <- L.newManager settings
612 manager <- L.newManager settings
439− newIORef manager
613+ return manager
440{-# NOINLINE globalManager #-}
614{-# NOINLINE globalManager #-}
441
615
442−-- | Perform an action using global implicit 'L.Manager' that the rest of
443−-- the library uses. This allows to reuse connections that the 'L.Manager'
444−-- controls.
445−
446−withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
447−withReqManager m = liftIO (readIORef globalManager) >>= m
448−
449----------------------------------------------------------------------------
616----------------------------------------------------------------------------
450−-- Embedding requests into your monad
617+-- Embedding requests in your monad
451
618
452-- $embedding-requests
619-- $embedding-requests
453--
620--
@@ -456,91 +623,281 @@ withReqManager m = liftIO (readIORef globalManager) >>= m
456--
623--
457-- When writing a library, keep your API polymorphic in terms of
624-- When writing a library, keep your API polymorphic in terms of
458-- 'MonadHttp', only define instance of 'MonadHttp' in final application.
625-- 'MonadHttp', only define instance of 'MonadHttp' in final application.
626+-- Another option is to use a @newtype@-wrapped monad stack and define
627+-- 'MonadHttp' for it. As of the version /0.4.0/, the 'Req' monad that
628+-- follows this strategy is provided out-of-the-box (see below).
459
629
460-- | A type class for monads that support performing HTTP requests.
630-- | A type class for monads that support performing HTTP requests.
461-- Typically, you only need to define the 'handleHttpException' method
631-- Typically, you only need to define the 'handleHttpException' method
462-- unless you want to tweak 'HttpConfig'.
632-- unless you want to tweak 'HttpConfig'.
463−
464−class MonadIO m => MonadHttp m where
633+class (MonadIO m) => MonadHttp m where
465−
466− {-# MINIMAL handleHttpException #-}
467−
468 -- | This method describes how to deal with 'HttpException' that was
634 -- | This method describes how to deal with 'HttpException' that was
469 -- caught by the library. One option is to re-throw it if you are OK with
635 -- caught by the library. One option is to re-throw it if you are OK with
470 -- exceptions, but if you prefer working with something like
636 -- exceptions, but if you prefer working with something like
471− -- 'Control.Monad.Error.MonadError', this is the right place to pass it to
637+ -- 'Control.Monad.Except.MonadError', this is the right place to pass it to
472− -- 'Control.Monad.Error.throwError'.
638+ -- 'Control.Monad.Except.throwError'.
473−
474 handleHttpException :: HttpException -> m a
639 handleHttpException :: HttpException -> m a
475
640
476− -- | Return 'HttpConfig' to be used when performing HTTP requests. Default
641+ -- | Return the 'HttpConfig' to be used when performing HTTP requests.
477− -- implementation returns its 'def' value, which is described in the
642+ -- Default implementation returns its 'def' value, which is described in
478− -- documentation for the type. Common usage pattern with manually defined
643+ -- the documentation for the type. Common usage pattern with manually
479− -- 'getHttpConfig' is to return some hard-coded value, or value extracted
644+ -- defined 'getHttpConfig' is to return some hard-coded value, or a value
480− -- from 'Control.Monad.Reader.MonadReader' if a more flexible approach to
645+ -- extracted from 'Control.Monad.Reader.MonadReader' if a more flexible
481− -- configuration is desirable.
646+ -- approach to configuration is desirable.
482−
483 getHttpConfig :: m HttpConfig
647 getHttpConfig :: m HttpConfig
484− getHttpConfig = return def
648+ getHttpConfig = return defaultHttpConfig
485−
486−-- | 'HttpConfig' contains general and default settings to be used when
487−-- making HTTP requests.
488
649
650+-- | 'HttpConfig' contains settings to be used when making HTTP requests.
489data HttpConfig = HttpConfig
651data HttpConfig = HttpConfig
490− { httpConfigProxy :: Maybe L.Proxy
491− -- ^ Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
652+ { -- | Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
492 -- environment variables are respected, this setting overwrites them.
653 -- environment variables are respected, this setting overwrites them.
493 -- Default value: 'Nothing'.
654 -- Default value: 'Nothing'.
494− , httpConfigRedirectCount :: Int
655+ httpConfigProxy :: Maybe L.Proxy,
495− -- ^ How many redirects to follow when getting a resource. Default
656+ -- | How many redirects to follow when getting a resource. Default
496 -- value: 10.
657 -- value: 10.
497− , httpConfigAltManager :: Maybe L.Manager
658+ httpConfigRedirectCount :: Int,
498− -- ^ Alternative 'L.Manager' to use. 'Nothing' (default value) means
659+ -- | Alternative 'L.Manager' to use. 'Nothing' (default value) means
499− -- that default implicit manager will be used (that's what you want in
660+ -- that the default implicit manager will be used (that's what you want
500− -- 99% of cases).
661+ -- in 99% of cases).
501− , httpConfigCheckResponse :: L.Request -> L.Response L.BodyReader -> IO ()
662+ httpConfigAltManager :: Maybe L.Manager,
502− -- ^ Function to check the response immediately after receiving the
663+ -- | Function to check the response immediately after receiving the
664+ -- status and headers, before streaming of response body. The third
665+ -- argument is the beginning of response body (typically first 1024
503− -- status and headers. This is used for throwing exceptions on
666+ -- bytes). This is used for throwing exceptions on non-success status
504− -- non-success status codes by default (set to @\\_ _ -> return ()@ if
667+ -- codes by default (set to @\\_ _ _ -> Nothing@ if this behavior is not
505− -- this behavior is not desirable). Throwing is better then just
668+ -- desirable).
669+ --
670+ -- When the value this function returns is 'Nothing', nothing will
671+ -- happen. When it there is 'L.HttpExceptionContent' inside 'Just', it
672+ -- will be thrown.
673+ --
506− -- returning a request with non-2xx status code because in that case
674+ -- Throwing is better then just returning a request with non-2xx status
507− -- something is wrong and we need a way to short-cut execution. The
675+ -- code because in that case something is wrong and we need a way to
676+ -- short-cut execution (also remember that Req retries automatically on
677+ -- request timeouts and such, so when your request fails, it's certainly
508− -- thrown exception is caught by the library though and is available in
678+ -- something exceptional). The thrown exception is caught by the library
509− -- 'handleHttpException'.
679+ -- though and is available in 'handleHttpException'.
510− } deriving Typeable
680+ --
511−
681+ -- __Note__: signature of this function was changed in the version
512−instance Default HttpConfig where
682+ -- /1.0.0/.
683+ --
684+ -- @since 0.3.0
685+ httpConfigCheckResponse ::
686+ forall b.
687+ L.Request ->
688+ L.Response b ->
689+ ByteString ->
690+ Maybe L.HttpExceptionContent,
691+ -- | The retry policy to use for request retrying. By default 'def' is
692+ -- used (see 'RetryPolicyM').
693+ --
694+ -- __Note__: signature of this function was changed to disallow 'IO' in
695+ -- version /1.0.0/ and then changed back to its current form in /3.1.0/.
696+ --
697+ -- @since 0.3.0
698+ httpConfigRetryPolicy :: RetryPolicyM IO,
699+ -- | The function is used to decide whether to retry a request. 'True'
700+ -- means that the request should be retried.
701+ --
702+ -- __Note__: signature of this function was changed in the version
703+ -- /1.0.0/.
704+ --
705+ -- @since 0.3.0
706+ httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool,
707+ -- | Similar to 'httpConfigRetryJudge', but is used to decide when to
708+ -- retry requests that resulted in an exception. By default it retries
709+ -- on response timeout and connection timeout (changed in version
710+ -- /3.8.0/).
711+ --
712+ -- @since 3.4.0
713+ httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool,
714+ -- | Max length of preview fragment of response body.
715+ --
716+ -- @since 3.6.0
717+ httpConfigBodyPreviewLength :: forall a. (Num a) => a
718+ }
719+
720+-- | The default value of 'HttpConfig'.
721+--
722+-- @since 2.0.0
723+defaultHttpConfig :: HttpConfig
724+defaultHttpConfig =
513− def = HttpConfig
725+ HttpConfig
514− { httpConfigProxy = Nothing
726+ { httpConfigProxy = Nothing,
515− , httpConfigRedirectCount = 10
727+ httpConfigRedirectCount = 10,
516− , httpConfigAltManager = Nothing
728+ httpConfigAltManager = Nothing,
517− , httpConfigCheckResponse = \_ response ->
729+ httpConfigCheckResponse = \_ response preview ->
518− let Y.Status statusCode _ = L.responseStatus response in
730+ let scode = statusCode response
519− unless (200 <= statusCode && statusCode < 300) $ do
731+ in if 200 <= scode && scode < 300
520− chunk <- BL.toStrict <$> L.brReadSome (L.responseBody response) 1024
732+ then Nothing
521− LI.throwHttp (L.StatusCodeException (void response) chunk) }
733+ else Just (L.StatusCodeException (void response) preview),
734+ httpConfigRetryPolicy = retryPolicyDefault,
735+ httpConfigRetryJudge = \_ response ->
736+ statusCode response
737+ `elem` [ 408, -- Request timeout
738+ 504, -- Gateway timeout
739+ 524, -- A timeout occurred
740+ 598, -- (Informal convention) Network read timeout error
741+ 599 -- (Informal convention) Network connect timeout error
742+ ],
743+ httpConfigRetryJudgeException = \_ e ->
744+ case fromException e of
745+ Just (L.HttpExceptionRequest _ c) ->
746+ case c of
747+ L.ResponseTimeout -> True
748+ L.ConnectionTimeout -> True
749+ _ -> False
750+ _ -> False,
751+ httpConfigBodyPreviewLength = 1024
752+ }
753+ where
754+ statusCode = Y.statusCode . L.responseStatus
522
755
523instance RequestComponent HttpConfig where
756instance RequestComponent HttpConfig where
524 getRequestMod HttpConfig {..} = Endo $ \x ->
757 getRequestMod HttpConfig {..} = Endo $ \x ->
758+ x
525− x { L.proxy = httpConfigProxy
759+ { L.proxy = httpConfigProxy,
526− , L.redirectCount = httpConfigRedirectCount
760+ L.redirectCount = httpConfigRedirectCount,
527− , LI.requestManagerOverride = httpConfigAltManager
761+ LI.requestManagerOverride = httpConfigAltManager
528− , LI.checkResponse = httpConfigCheckResponse }
762+ }
763+
764+-- | A monad that allows us to run 'req' in any 'IO'-enabled monad without
765+-- having to define new instances.
766+--
767+-- @since 0.4.0
768+newtype Req a = Req (ReaderT HttpConfig IO a)
769+ deriving
770+ ( Functor,
771+ Applicative,
772+ Monad,
773+ MonadIO,
774+ MonadUnliftIO
775+ )
776+
777+-- | @since 3.7.0
778+deriving instance MonadThrow Req
779+
780+-- | @since 3.7.0
781+deriving instance MonadCatch Req
782+
783+-- | @since 3.7.0
784+deriving instance MonadMask Req
785+
786+instance MonadBase IO Req where
787+ liftBase = liftIO
788+
789+instance MonadBaseControl IO Req where
790+ type StM Req a = a
791+ liftBaseWith f = Req . ReaderT $ \r -> f (runReq r)
792+ {-# INLINEABLE liftBaseWith #-}
793+ restoreM = Req . ReaderT . const . return
794+ {-# INLINEABLE restoreM #-}
795+
796+instance MonadHttp Req where
797+ handleHttpException = Req . lift . throwIO
798+ getHttpConfig = Req ask
799+
800+-- | @since 3.10.0
801+instance (MonadHttp m, Monoid w) => MonadHttp (AccumT w m) where
802+ handleHttpException = lift . handleHttpException
803+ getHttpConfig = lift getHttpConfig
804+
805+-- | @since 3.10.0
806+instance (MonadHttp m) => MonadHttp (ContT r m) where
807+ handleHttpException = lift . handleHttpException
808+ getHttpConfig = lift getHttpConfig
809+
810+-- | @since 3.10.0
811+instance (MonadHttp m) => MonadHttp (ExceptT e m) where
812+ handleHttpException = lift . handleHttpException
813+ getHttpConfig = lift getHttpConfig
814+
815+-- | @since 3.10.0
816+instance (MonadHttp m) => MonadHttp (IdentityT m) where
817+ handleHttpException = lift . handleHttpException
818+ getHttpConfig = lift getHttpConfig
819+
820+-- | @since 3.10.0
821+instance (MonadHttp m) => MonadHttp (MaybeT m) where
822+ handleHttpException = lift . handleHttpException
823+ getHttpConfig = lift getHttpConfig
824+
825+-- | @since 3.10.0
826+instance (MonadHttp m) => MonadHttp (ReaderT r m) where
827+ handleHttpException = lift . handleHttpException
828+ getHttpConfig = lift getHttpConfig
829+
830+-- | @since 3.10.0
831+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.CPS.RWST r w s m) where
832+ handleHttpException = lift . handleHttpException
833+ getHttpConfig = lift getHttpConfig
834+
835+-- | @since 3.10.0
836+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Lazy.RWST r w s m) where
837+ handleHttpException = lift . handleHttpException
838+ getHttpConfig = lift getHttpConfig
839+
840+-- | @since 3.10.0
841+instance (MonadHttp m, Monoid w) => MonadHttp (RWS.Strict.RWST r w s m) where
842+ handleHttpException = lift . handleHttpException
843+ getHttpConfig = lift getHttpConfig
844+
845+-- | @since 3.10.0
846+instance (MonadHttp m) => MonadHttp (SelectT r m) where
847+ handleHttpException = lift . handleHttpException
848+ getHttpConfig = lift getHttpConfig
849+
850+-- | @since 3.10.0
851+instance (MonadHttp m) => MonadHttp (State.Lazy.StateT s m) where
852+ handleHttpException = lift . handleHttpException
853+ getHttpConfig = lift getHttpConfig
854+
855+-- | @since 3.10.0
856+instance (MonadHttp m) => MonadHttp (State.Strict.StateT s m) where
857+ handleHttpException = lift . handleHttpException
858+ getHttpConfig = lift getHttpConfig
859+
860+-- | @since 3.10.0
861+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.CPS.WriterT w m) where
862+ handleHttpException = lift . handleHttpException
863+ getHttpConfig = lift getHttpConfig
864+
865+-- | @since 3.10.0
866+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Lazy.WriterT w m) where
867+ handleHttpException = lift . handleHttpException
868+ getHttpConfig = lift getHttpConfig
869+
870+-- | @since 3.10.0
871+instance (MonadHttp m, Monoid w) => MonadHttp (Writer.Strict.WriterT w m) where
872+ handleHttpException = lift . handleHttpException
873+ getHttpConfig = lift getHttpConfig
874+
875+-- | Run a computation in the 'Req' monad with the given 'HttpConfig'. In
876+-- the case of an exceptional situation an 'HttpException' will be thrown.
877+--
878+-- @since 0.4.0
879+runReq ::
880+ (MonadIO m) =>
881+ -- | 'HttpConfig' to use
882+ HttpConfig ->
883+ -- | Computation to run
884+ Req a ->
885+ m a
886+runReq config (Req m) = liftIO (runReaderT m config)
529
887
530----------------------------------------------------------------------------
888----------------------------------------------------------------------------
531−-- Request — Method
889+-- Request—Method
532
890
533-- $method
891-- $method
534--
892--
535-- The package supports all methods as defined by RFC 2616, and 'PATCH'
893-- The package supports all methods as defined by RFC 2616, and 'PATCH'
536−-- which is defined by RFC 5789 — that should be enough to talk to RESTful
894+-- which is defined by RFC 5789—that should be enough to talk to RESTful
537-- APIs. In some cases, however, you may want to add more methods (e.g. you
895-- APIs. In some cases, however, you may want to add more methods (e.g. you
538-- work with WebDAV <https://en.wikipedia.org/wiki/WebDAV>); no need to
896-- work with WebDAV <https://en.wikipedia.org/wiki/WebDAV>); no need to
539-- compromise on type safety and hack, it only takes a couple of seconds to
897-- compromise on type safety and hack, it only takes a couple of seconds to
540-- define a new method that will works seamlessly, see 'HttpMethod'.
898-- define a new method that will works seamlessly, see 'HttpMethod'.
541
899
542-- | 'GET' method.
900-- | 'GET' method.
543−
544data GET = GET
901data GET = GET
545
902
546instance HttpMethod GET where
903instance HttpMethod GET where
@@ -548,7 +905,6 @@ instance HttpMethod GET where
548 httpMethodName Proxy = Y.methodGet
905 httpMethodName Proxy = Y.methodGet
549
906
550-- | 'POST' method.
907-- | 'POST' method.
551−
552data POST = POST
908data POST = POST
553
909
554instance HttpMethod POST where
910instance HttpMethod POST where
@@ -556,7 +912,6 @@ instance HttpMethod POST where
556 httpMethodName Proxy = Y.methodPost
912 httpMethodName Proxy = Y.methodPost
557
913
558-- | 'HEAD' method.
914-- | 'HEAD' method.
559−
560data HEAD = HEAD
915data HEAD = HEAD
561
916
562instance HttpMethod HEAD where
917instance HttpMethod HEAD where
@@ -564,26 +919,24 @@ instance HttpMethod HEAD where
564 httpMethodName Proxy = Y.methodHead
919 httpMethodName Proxy = Y.methodHead
565
920
566-- | 'PUT' method.
921-- | 'PUT' method.
567−
568data PUT = PUT
922data PUT = PUT
569
923
570instance HttpMethod PUT where
924instance HttpMethod PUT where
571 type AllowsBody PUT = 'CanHaveBody
925 type AllowsBody PUT = 'CanHaveBody
572 httpMethodName Proxy = Y.methodPut
926 httpMethodName Proxy = Y.methodPut
573
927
574−-- | 'DELETE' method. This data type does not allow having request body with
928+-- | 'DELETE' method. RFC 7231 allows a payload in DELETE but without
575−-- 'DELETE' requests, as it should be, however some APIs may expect 'DELETE'
929+-- semantics.
576−-- requests to have bodies, in that case define your own variation of
930+--
577−-- 'DELETE' method and allow it to have a body.
931+-- __Note__: before version /3.4.0/ this method did not allow request
578−
932+-- bodies.
579data DELETE = DELETE
933data DELETE = DELETE
580
934
581instance HttpMethod DELETE where
935instance HttpMethod DELETE where
582− type AllowsBody DELETE = 'NoBody
936+ type AllowsBody DELETE = 'CanHaveBody
583 httpMethodName Proxy = Y.methodDelete
937 httpMethodName Proxy = Y.methodDelete
584
938
585-- | 'TRACE' method.
939-- | 'TRACE' method.
586−
587data TRACE = TRACE
940data TRACE = TRACE
588
941
589instance HttpMethod TRACE where
942instance HttpMethod TRACE where
@@ -591,7 +944,6 @@ instance HttpMethod TRACE where
591 httpMethodName Proxy = Y.methodTrace
944 httpMethodName Proxy = Y.methodTrace
592
945
593-- | 'CONNECT' method.
946-- | 'CONNECT' method.
594−
595data CONNECT = CONNECT
947data CONNECT = CONNECT
596
948
597instance HttpMethod CONNECT where
949instance HttpMethod CONNECT where
@@ -599,7 +951,6 @@ instance HttpMethod CONNECT where
599 httpMethodName Proxy = Y.methodConnect
951 httpMethodName Proxy = Y.methodConnect
600
952
601-- | 'OPTIONS' method.
953-- | 'OPTIONS' method.
602−
603data OPTIONS = OPTIONS
954data OPTIONS = OPTIONS
604
955
605instance HttpMethod OPTIONS where
956instance HttpMethod OPTIONS where
@@ -607,7 +958,6 @@ instance HttpMethod OPTIONS where
607 httpMethodName Proxy = Y.methodOptions
958 httpMethodName Proxy = Y.methodOptions
608
959
609-- | 'PATCH' method.
960-- | 'PATCH' method.
610−
611data PATCH = PATCH
961data PATCH = PATCH
612
962
613instance HttpMethod PATCH where
963instance HttpMethod PATCH where
@@ -615,42 +965,38 @@ instance HttpMethod PATCH where
615 httpMethodName Proxy = Y.methodPatch
965 httpMethodName Proxy = Y.methodPatch
616
966
617-- | A type class for types that can be used as an HTTP method. To define a
967-- | A type class for types that can be used as an HTTP method. To define a
618−-- non-standard method, follow this example that defines COPY:
968+-- non-standard method, follow this example that defines @COPY@:
619--
969--
620-- > data COPY = COPY
970-- > data COPY = COPY
621-- >
971-- >
622-- > instance HttpMethod COPY where
972-- > instance HttpMethod COPY where
623-- > type AllowsBody COPY = 'CanHaveBody
973-- > type AllowsBody COPY = 'CanHaveBody
624-- > httpMethodName Proxy = "COPY"
974-- > httpMethodName Proxy = "COPY"
625−
626class HttpMethod a where
975class HttpMethod a where
627−
628− -- | Type function 'AllowsBody' returns type of kind 'CanHaveBody' which
976+ -- | Type function 'AllowsBody' returns a type of kind 'CanHaveBody' which
629− -- tells the rest of the library whether the method can have a body or
977+ -- tells the rest of the library whether the method can have body or not.
630− -- not. We use the special type 'CanHaveBody' “lifted” into kind instead
978+ -- We use the special type 'CanHaveBody' lifted to the kind level instead
631 -- of 'Bool' to get more user-friendly compiler messages.
979 -- of 'Bool' to get more user-friendly compiler messages.
632−
633 type AllowsBody a :: CanHaveBody
980 type AllowsBody a :: CanHaveBody
634
981
635 -- | Return name of the method as a 'ByteString'.
982 -- | Return name of the method as a 'ByteString'.
636−
637 httpMethodName :: Proxy a -> ByteString
983 httpMethodName :: Proxy a -> ByteString
638
984
639−instance HttpMethod method => RequestComponent (Womb "method" method) where
985+instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
640 getRequestMod _ = Endo $ \x ->
986 getRequestMod _ = Endo $ \x ->
641− x { L.method = httpMethodName (Proxy :: Proxy method) }
987+ x {L.method = httpMethodName (Proxy :: Proxy method)}
642
988
643----------------------------------------------------------------------------
989----------------------------------------------------------------------------
644−-- Request — URL
990+-- Request—URL
645
991
646-- $url
992-- $url
647--
993--
648-- We use 'Url's which are correct by construction, see 'Url'. To build a
994-- We use 'Url's which are correct by construction, see 'Url'. To build a
649−-- 'Url' from a 'ByteString', use 'parseUrlHttp' or 'parseUrlHttps'.
995+-- 'Url' from a 'URI', use 'useHttpURI', 'useHttpsURI', or generic 'useURI'.
650
996
651-- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https'
997-- | Request's 'Url'. Start constructing your 'Url' with 'http' or 'https'
652-- specifying the scheme and host at the same time. Then use the @('/~')@
998-- specifying the scheme and host at the same time. Then use the @('/~')@
653−-- and @('/:')@ operators to grow path one piece at a time. Every single
999+-- and @('/:')@ operators to grow the path one piece at a time. Every single
654-- piece of path will be url(percent)-encoded, so using @('/~')@ and
1000-- piece of path will be url(percent)-encoded, so using @('/~')@ and
655-- @('/:')@ is the only way to have forward slashes between path segments.
1001-- @('/:')@ is the only way to have forward slashes between path segments.
656-- This approach makes working with dynamic path segments easy and safe. See
1002-- This approach makes working with dynamic path segments easy and safe. See
@@ -676,125 +1022,233 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where
676--
1022--
677-- > https "юникод.рф"
1023-- > https "юникод.рф"
678-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
1024-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
679−
680−data Url (scheme :: Scheme) = Url Scheme (NonEmpty T.Text)
1025+data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
681− -- NOTE The second value is path segments in reversed order.
1026+ -- NOTE The second value is the path segments in reversed order.
682− deriving (Eq, Ord, Show, Data, Typeable, Generic)
1027+ deriving (Eq, Ord, Show, Data, Generic)
683−
1028+
1029+type role Url nominal
1030+
1031+-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however
1032+-- the derived lift forgets the type of the scheme.
1033+instance (Typeable scheme) => TH.Lift (Url scheme) where
1034+ lift url =
1035+ TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of
1036+ Url Http _ -> [t|Url 'Http|]
1037+ Url Https _ -> [t|Url 'Https|]
1038+ where
1039+ liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
1040+ liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
1041+
684−-- | Given host name, produce a 'Url' which have “http” as its scheme and
1042+-- | Given host name, produce a 'Url' which has “http” as its scheme and
685-- empty path. This also sets port to @80@.
1043-- empty path. This also sets port to @80@.
686−
687−http :: T.Text -> Url 'Http
1044+http :: Text -> Url 'Http
688http = Url Http . pure
1045http = Url Http . pure
689
1046
690−-- | Given host name, produce a 'Url' which have “https” as its scheme and
1047+-- | Given host name, produce a 'Url' which has “https” as its scheme and
691-- empty path. This also sets port to @443@.
1048-- empty path. This also sets port to @443@.
692−
693−https :: T.Text -> Url 'Https
1049+https :: Text -> Url 'Https
694https = Url Https . pure
1050https = Url Https . pure
695
1051
696−-- | Grow given 'Url' appending a single path segment to it. Note that the
1052+-- | Grow a given 'Url' appending a single path segment to it. Note that the
697-- path segment can be of any type that is an instance of 'ToHttpApiData'.
1053-- path segment can be of any type that is an instance of 'ToHttpApiData'.
698−
699infixl 5 /~
1054infixl 5 /~
700−(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
701−Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
702
1055
703−-- | Type-constrained version of @('/~')@ to remove ambiguity in cases when
1056+(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme
704−-- next URL piece is a 'Text' literal.
1057+Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
705
1058
1059+-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases
1060+-- when next URL piece is a 'Data.Text.Text' literal.
706infixl 5 /:
1061infixl 5 /:
1062+
707−(/:) :: Url scheme -> T.Text -> Url scheme
1063+(/:) :: Url scheme -> Text -> Url scheme
708(/:) = (/~)
1064(/:) = (/~)
709
1065
1066+-- | Render a 'Url' as 'Text'.
1067+--
1068+-- @since 3.4.0
1069+renderUrl :: Url scheme -> Text
1070+renderUrl = \case
1071+ Url Https parts ->
1072+ "https://" <> renderParts parts
1073+ Url Http parts ->
1074+ "http://" <> renderParts parts
1075+ where
1076+ renderParts parts =
1077+ T.intercalate "/" (reverse $ NE.toList parts)
1078+
710−-- | The 'parseUrlHttp' function provides an alternative method to get 'Url'
1079+-- | The 'useHttpURI' function provides an alternative method to get 'Url'
711−-- (possibly with some 'Option's) from a 'ByteString'. This is useful when
1080+-- (possibly with some 'Option's) from a 'URI'. This is useful when you are
712−-- you are given a URL to query dynamically and don't know it beforehand.
1081+-- given a URL to query dynamically and don't know it beforehand.
713−-- The function parses 'ByteString' because it's the correct type to
1082+--
714−-- represent a URL, as 'Url' cannot contain characters outside of ASCII
1083+-- This function expects the scheme to be “http” and host to be present.
715−-- range, thus we can consider every character a 'Data.Word.Word8' value.
1084+--
716−--
1085+-- @since 3.0.0
717−-- This function only parses 'Url' (scheme, host, path) and optional query
1086+useHttpURI :: URI -> Maybe (Url 'Http, Option scheme)
718−-- parameters that are returned as 'Option'. It does not parse method name
1087+useHttpURI uri = do
719−-- or authentication info from given 'ByteString'.
1088+ guard (URI.uriScheme uri == Just [QQ.scheme|http|])
720−
1089+ urlHead <- http <$> uriHost uri
721−parseUrlHttp :: ByteString -> Maybe (Url 'Http, Option scheme)
1090+ let url = case URI.uriPath uri of
722−parseUrlHttp url' = do
1091+ Nothing -> urlHead
723− url <- B.stripPrefix "http://" url'
1092+ Just uriPath -> uriPathToUrl uriPath urlHead
724− (host :| path, option) <- parseUrlHelper url
1093+ return (url, uriOptions uri)
725− return (foldl (/:) (http host) path, option)
1094+
726−
727−-- | Just like 'parseUrlHttp', but expects “https” scheme.
1095+-- | Just like 'useHttpURI', but expects the “https” scheme.
728−
1096+--
1097+-- @since 3.0.0
729−parseUrlHttps :: ByteString -> Maybe (Url 'Https, Option scheme)
1098+useHttpsURI :: URI -> Maybe (Url 'Https, Option scheme)
730−parseUrlHttps url' = do
1099+useHttpsURI uri = do
731− url <- B.stripPrefix "https://" url'
1100+ guard (URI.uriScheme uri == Just [QQ.scheme|https|])
732− (host :| path, option) <- parseUrlHelper url
1101+ urlHead <- https <$> uriHost uri
733− return (foldl (/:) (https host) path, option)
1102+ let url = case URI.uriPath uri of
734−
1103+ Nothing -> urlHead
735−-- | Get host\/collection of path pieces and possibly query parameters
1104+ Just uriPath -> uriPathToUrl uriPath urlHead
736−-- already converted to 'Option'. This function is not public.
1105+ return (url, uriOptions uri)
737−
1106+
738−parseUrlHelper :: ByteString -> Maybe (NonEmpty T.Text, Option scheme)
1107+-- | Convert URI path to a 'Url'. Internal.
739−parseUrlHelper url = do
1108+--
740− let (path', query') = B.break (== 0x3f) url
1109+-- @since 3.9.0
741− query = mconcat (uncurry queryParam <$> Y.parseQueryText query')
1110+uriPathToUrl ::
742− path <- NE.nonEmpty (Y.decodePathSegments path')
1111+ (Bool, NonEmpty (URI.RText 'URI.PathPiece)) ->
743− return (path, query)
1112+ Url scheme ->
1113+ Url scheme
1114+uriPathToUrl (trailingSlash, xs) urlHead =
1115+ if trailingSlash then path /: T.empty else path
1116+ where
1117+ path = foldl' (/:) urlHead (URI.unRText <$> NE.toList xs)
1118+
1119+-- | A combination of 'useHttpURI' and 'useHttpsURI' for cases when scheme
1120+-- is not known in advance.
1121+--
1122+-- @since 3.0.0
1123+useURI ::
1124+ URI ->
1125+ Maybe
1126+ ( Either
1127+ (Url 'Http, Option scheme0)
1128+ (Url 'Https, Option scheme1)
1129+ )
1130+useURI uri =
1131+ (Left <$> useHttpURI uri) <|> (Right <$> useHttpsURI uri)
1132+
1133+-- | An internal helper function to extract host from a 'URI'.
1134+uriHost :: URI -> Maybe Text
1135+uriHost uri = case URI.uriAuthority uri of
1136+ Left _ -> Nothing
1137+ Right URI.Authority {..} ->
1138+ Just (URI.unRText authHost)
1139+
1140+-- | A quasiquoter to build an 'Url' and 'Option' tuple. The type of the
1141+-- generated expression is @('Url' scheme0, 'Option' scheme1)@ with
1142+-- @scheme0@ being either 'Http' or 'Https' depending on the input.
1143+--
1144+-- @since 3.2.0
1145+urlQ :: TH.QuasiQuoter
1146+urlQ =
1147+ TH.QuasiQuoter
1148+ { quoteExp = \str ->
1149+ case URI.mkURI (T.pack str) of
1150+ Left err -> fail (displayException err)
1151+ Right uri -> case useURI uri of
1152+ Nothing -> fail "Not a HTTP or HTTPS URL"
1153+ Just eurl ->
1154+ TH.tupE
1155+ [ either (TH.lift . fst) (TH.lift . fst) eurl,
1156+ [|uriOptions uri|]
1157+ ],
1158+ quotePat = error "This usage is not supported",
1159+ quoteType = error "This usage is not supported",
1160+ quoteDec = error "This usage is not supported"
1161+ }
1162+
1163+-- | An internal helper function to extract 'Option's from a 'URI'.
1164+uriOptions :: forall scheme. URI -> Option scheme
1165+uriOptions uri =
1166+ mconcat
1167+ [ auth,
1168+ query,
1169+ port'
1170+ -- , fragment'
1171+ ]
1172+ where
1173+ (auth, port') =
1174+ case URI.uriAuthority uri of
1175+ Left _ -> (mempty, mempty)
1176+ Right URI.Authority {..} ->
1177+ let auth0 = case authUserInfo of
1178+ Nothing -> mempty
1179+ Just URI.UserInfo {..} ->
1180+ let username = T.encodeUtf8 (URI.unRText uiUsername)
1181+ password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword
1182+ in basicAuthUnsafe username password
1183+ port0 = case authPort of
1184+ Nothing -> mempty
1185+ Just port'' -> port (fromIntegral port'')
1186+ in (auth0, port0)
1187+ query =
1188+ let liftQueryParam = \case
1189+ URI.QueryFlag t -> queryFlag (URI.unRText t)
1190+ URI.QueryParam k v -> URI.unRText k =: URI.unRText v
1191+ in mconcat (liftQueryParam <$> URI.uriQuery uri)
1192+
1193+-- TODO Blocked on upstream: https://github.com/snoyberg/http-client/issues/424
1194+-- fragment' =
1195+-- case URI.uriFragment uri of
1196+-- Nothing -> mempty
1197+-- Just fragment'' -> fragment (URI.unRText fragment'')
744
1198
745instance RequestComponent (Url scheme) where
1199instance RequestComponent (Url scheme) where
746 getRequestMod (Url scheme segments) = Endo $ \x ->
1200 getRequestMod (Url scheme segments) = Endo $ \x ->
747− let (host :| path) = NE.reverse segments in
1201+ let (host :| path) = NE.reverse segments
1202+ in x
748− x { L.secure = case scheme of
1203+ { L.secure = case scheme of
749− Http -> False
1204+ Http -> False
750− Https -> True
1205+ Https -> True,
751− , L.port = case scheme of
1206+ L.port = case scheme of
752− Http -> 80
1207+ Http -> 80
753− Https -> 443
1208+ Https -> 443,
754− , L.host = Y.urlEncode False (T.encodeUtf8 host)
1209+ L.host = Y.urlEncode False (T.encodeUtf8 host),
755− , L.path =
1210+ L.path =
756− (BL.toStrict . BB.toLazyByteString . Y.encodePathSegments) path }
1211+ (BL.toStrict . BB.toLazyByteString . Y.encodePathSegments) path
1212+ }
757
1213
758----------------------------------------------------------------------------
1214----------------------------------------------------------------------------
759−-- Request — Body
1215+-- Request—Body
760
1216
761-- $body
1217-- $body
762--
1218--
763-- A number of options for request bodies are available. The @Content-Type@
1219-- A number of options for request bodies are available. The @Content-Type@
764−-- header is set for you automatically according to body option you use
1220+-- header is set for you automatically according to the body option you use
765−-- (it's always specified in documentation for given body option). To add
1221+-- (it's always specified in the documentation for a given body option). To
766−-- your own way to represent request body, see 'HttpBody'.
1222+-- add your own way to represent request body, define an instance of
1223+-- 'HttpBody'.
767
1224
768-- | This data type represents empty body of an HTTP request. This is the
1225-- | This data type represents empty body of an HTTP request. This is the
769-- data type to use with 'HttpMethod's that cannot have a body, as it's the
1226-- data type to use with 'HttpMethod's that cannot have a body, as it's the
770-- only type for which 'ProvidesBody' returns 'NoBody'.
1227-- only type for which 'ProvidesBody' returns 'NoBody'.
771--
1228--
772-- Using of this body option does not set the @Content-Type@ header.
1229-- Using of this body option does not set the @Content-Type@ header.
773−
774data NoReqBody = NoReqBody
1230data NoReqBody = NoReqBody
775
1231
776instance HttpBody NoReqBody where
1232instance HttpBody NoReqBody where
777 getRequestBody NoReqBody = L.RequestBodyBS B.empty
1233 getRequestBody NoReqBody = L.RequestBodyBS B.empty
778
1234
779−-- | This body option allows to use a JSON object as request body — probably
1235+-- | This body option allows us to use a JSON object as the request
780−-- the most popular format right now. Just wrap a data type that is an
1236+-- body—probably the most popular format right now. Just wrap a data type
781−-- instance of 'ToJSON' type class and you are done: it will be converted to
1237+-- that is an instance of 'ToJSON' type class and you are done: it will be
782−-- JSON and inserted as request body.
1238+-- converted to JSON and inserted as request body.
783--
1239--
784-- This body option sets the @Content-Type@ header to @\"application/json;
1240-- This body option sets the @Content-Type@ header to @\"application/json;
785-- charset=utf-8\"@ value.
1241-- charset=utf-8\"@ value.
786−
787newtype ReqBodyJson a = ReqBodyJson a
1242newtype ReqBodyJson a = ReqBodyJson a
788
1243
789−instance ToJSON a => HttpBody (ReqBodyJson a) where
1244+instance (ToJSON a) => HttpBody (ReqBodyJson a) where
790 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)
1245 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)
791 getRequestContentType _ = pure "application/json; charset=utf-8"
1246 getRequestContentType _ = pure "application/json; charset=utf-8"
792
1247
793-- | This body option streams request body from a file. It is expected that
1248-- | This body option streams request body from a file. It is expected that
794−-- the file size does not change during the streaming.
1249+-- the file size does not change during streaming.
795--
1250--
796-- Using of this body option does not set the @Content-Type@ header.
1251-- Using of this body option does not set the @Content-Type@ header.
797−
798newtype ReqBodyFile = ReqBodyFile FilePath
1252newtype ReqBodyFile = ReqBodyFile FilePath
799
1253
800instance HttpBody ReqBodyFile where
1254instance HttpBody ReqBodyFile where
@@ -804,7 +1258,6 @@ instance HttpBody ReqBodyFile where
804-- | HTTP request body represented by a strict 'ByteString'.
1258-- | HTTP request body represented by a strict 'ByteString'.
805--
1259--
806-- Using of this body option does not set the @Content-Type@ header.
1260-- Using of this body option does not set the @Content-Type@ header.
807−
808newtype ReqBodyBs = ReqBodyBs ByteString
1261newtype ReqBodyBs = ReqBodyBs ByteString
809
1262
810instance HttpBody ReqBodyBs where
1263instance HttpBody ReqBodyBs where
@@ -813,22 +1266,19 @@ instance HttpBody ReqBodyBs where
813-- | HTTP request body represented by a lazy 'BL.ByteString'.
1266-- | HTTP request body represented by a lazy 'BL.ByteString'.
814--
1267--
815-- Using of this body option does not set the @Content-Type@ header.
1268-- Using of this body option does not set the @Content-Type@ header.
816−
817newtype ReqBodyLbs = ReqBodyLbs BL.ByteString
1269newtype ReqBodyLbs = ReqBodyLbs BL.ByteString
818
1270
819instance HttpBody ReqBodyLbs where
1271instance HttpBody ReqBodyLbs where
820 getRequestBody (ReqBodyLbs bs) = L.RequestBodyLBS bs
1272 getRequestBody (ReqBodyLbs bs) = L.RequestBodyLBS bs
821
1273
822−-- | Form URL-encoded body. This can hold a collection of parameters which
1274+-- | URL-encoded body. This can hold a collection of parameters which are
823−-- are encoded similarly to query parameters at the end of query string,
1275+-- encoded similarly to query parameters at the end of query string, with
824−-- with the only difference that they are stored in request body. The
1276+-- the only difference that they are stored in request body. The similarity
825−-- similarity is reflected in the API as well, as you can use the same
1277+-- is reflected in the API as well, as you can use the same combinators you
826−-- combinators you would use to add query parameters: @('=:')@ and
1278+-- would use to add query parameters: @('=:')@ and 'queryFlag'.
827−-- 'queryFlag'.
828--
1279--
829-- This body option sets the @Content-Type@ header to
1280-- This body option sets the @Content-Type@ header to
830−-- @\"application/x-www-from-urlencoded\"@ value.
1281+-- @\"application/x-www-form-urlencoded\"@ value.
831−
832newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam
1282newtype ReqBodyUrlEnc = ReqBodyUrlEnc FormUrlEncodedParam
833
1283
834instance HttpBody ReqBodyUrlEnc where
1284instance HttpBody ReqBodyUrlEnc where
@@ -838,33 +1288,37 @@ instance HttpBody ReqBodyUrlEnc where
838
1288
839-- | An opaque monoidal value that allows to collect URL-encoded parameters
1289-- | An opaque monoidal value that allows to collect URL-encoded parameters
840-- to be wrapped in 'ReqBodyUrlEnc'.
1290-- to be wrapped in 'ReqBodyUrlEnc'.
841−
842−newtype FormUrlEncodedParam = FormUrlEncodedParam [(T.Text, Maybe T.Text)]
1291+newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]
843 deriving (Semigroup, Monoid)
1292 deriving (Semigroup, Monoid)
844
1293
845instance QueryParam FormUrlEncodedParam where
1294instance QueryParam FormUrlEncodedParam where
846 queryParam name mvalue =
1295 queryParam name mvalue =
847 FormUrlEncodedParam [(name, toQueryParam <$> mvalue)]
1296 FormUrlEncodedParam [(name, toQueryParam <$> mvalue)]
1297+ queryParamToList (FormUrlEncodedParam p) = p
1298+
1299+-- | Use 'formToQuery'.
1300+--
1301+-- @since 3.11.0
1302+instance FromForm FormUrlEncodedParam where
1303+ fromForm = Right . formToQuery
848
1304
849-- | Multipart form data. Please consult the
1305-- | Multipart form data. Please consult the
850-- "Network.HTTP.Client.MultipartFormData" module for how to construct
1306-- "Network.HTTP.Client.MultipartFormData" module for how to construct
851-- parts, then use 'reqBodyMultipart' to create actual request body from the
1307-- parts, then use 'reqBodyMultipart' to create actual request body from the
852−-- parts. 'reqBodyMultipart' is the only way to get a value of type
1308+-- parts. 'reqBodyMultipart' is the only way to get a value of the type
853-- 'ReqBodyMultipart', as its constructor is not exported on purpose.
1309-- 'ReqBodyMultipart', as its constructor is not exported on purpose.
854--
1310--
855-- @since 0.2.0
1311-- @since 0.2.0
856--
1312--
857−-- ==== __Example__
1313+-- ==== __Examples__
858--
1314--
859−-- > import Control.Exception (throwIO)
1315+-- > import Control.Monad.IO.Class
860−-- > import qualified Network.HTTP.Client.MultipartFormData as LM
1316+-- > import Data.Default.Class
861-- > import Network.HTTP.Req
1317-- > import Network.HTTP.Req
862−-- >
1318+-- > import qualified Network.HTTP.Client.MultipartFormData as LM
863−-- > instance MonadHttp IO where
864−-- > handleHttpException = throwIO
865-- >
1319-- >
866-- > main :: IO ()
1320-- > main :: IO ()
867−-- > main = do
1321+-- > main = runReq def $ do
868-- > body <-
1322-- > body <-
869-- > reqBodyMultipart
1323-- > reqBodyMultipart
870-- > [ LM.partBS "title" "My Image"
1324-- > [ LM.partBS "title" "My Image"
@@ -875,8 +1329,7 @@ instance QueryParam FormUrlEncodedParam where
875-- > body
1329-- > body
876-- > bsResponse
1330-- > bsResponse
877-- > mempty
1331-- > mempty
878−-- > print $ responseBody response
1332+-- > liftIO $ print (responseBody response)
879−
880data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody
1333data ReqBodyMultipart = ReqBodyMultipart ByteString LI.RequestBody
881
1334
882instance HttpBody ReqBodyMultipart where
1335instance HttpBody ReqBodyMultipart where
@@ -887,217 +1340,238 @@ instance HttpBody ReqBodyMultipart where
887-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
1340-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
888--
1341--
889-- @since 0.2.0
1342-- @since 0.2.0
890−
891−reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
1343+reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart
892reqBodyMultipart parts = liftIO $ do
1344reqBodyMultipart parts = liftIO $ do
893 boundary <- LM.webkitBoundary
1345 boundary <- LM.webkitBoundary
894− body <- LM.renderParts boundary parts
1346+ body <- LM.renderParts boundary parts
895 return (ReqBodyMultipart boundary body)
1347 return (ReqBodyMultipart boundary body)
896
1348
897−-- | A type class for things that can be interpreted as HTTP
1349+-- | A type class for things that can be interpreted as an HTTP
898-- 'L.RequestBody'.
1350-- 'L.RequestBody'.
899−
900class HttpBody body where
1351class HttpBody body where
901−
902− {-# MINIMAL getRequestBody #-}
903−
904 -- | How to get actual 'L.RequestBody'.
1352 -- | How to get actual 'L.RequestBody'.
905−
906 getRequestBody :: body -> L.RequestBody
1353 getRequestBody :: body -> L.RequestBody
907
1354
908− -- | This method allows to optionally specify value of @Content-Type@
1355+ -- | This method allows us to optionally specify the value of
909− -- header that should be used with particular body option. By default it
1356+ -- @Content-Type@ header that should be used with particular body option.
910− -- returns 'Nothing' and so @Content-Type@ is not set.
1357+ -- By default it returns 'Nothing' and so @Content-Type@ is not set.
911−
912 getRequestContentType :: body -> Maybe ByteString
1358 getRequestContentType :: body -> Maybe ByteString
913 getRequestContentType = const Nothing
1359 getRequestContentType = const Nothing
914
1360
915-- | The type function recognizes 'NoReqBody' as having 'NoBody', while any
1361-- | The type function recognizes 'NoReqBody' as having 'NoBody', while any
916−-- other body option 'CanHaveBody'. This forces user to use 'NoReqBody' with
1362+-- other body option 'CanHaveBody'. This forces the user to use 'NoReqBody'
917−-- 'GET' method and other methods that should not send a body.
1363+-- with 'GET' method and other methods that should not have body.
918−
919type family ProvidesBody body :: CanHaveBody where
1364type family ProvidesBody body :: CanHaveBody where
920 ProvidesBody NoReqBody = 'NoBody
1365 ProvidesBody NoReqBody = 'NoBody
921− ProvidesBody body = 'CanHaveBody
1366+ ProvidesBody body = 'CanHaveBody
922
1367
923-- | This type function allows any HTTP body if method says it
1368-- | This type function allows any HTTP body if method says it
924−-- 'CanHaveBody'. When method says it should have 'NoBody', the only body
1369+-- 'CanHaveBody'. When the method says it should have 'NoBody', the only
925−-- option to use is 'NoReqBody'.
1370+-- body option to use is 'NoReqBody'.
926−--
927−-- __Note__: users of GHC 8.0.1 and later will see a slightly more friendly
928−-- error message when method does not allow a body and body is provided.
929−
930−type family HttpBodyAllowed
1371+type family
1372+ HttpBodyAllowed
931− (allowsBody :: CanHaveBody)
1373+ (allowsBody :: CanHaveBody)
932− (providesBody :: CanHaveBody) :: Constraint where
1374+ (providesBody :: CanHaveBody) ::
1375+ Constraint
1376+ where
933− HttpBodyAllowed 'NoBody 'NoBody = ()
1377+ HttpBodyAllowed 'NoBody 'NoBody = ()
934− HttpBodyAllowed 'CanHaveBody body = ()
1378+ HttpBodyAllowed 'CanHaveBody body = ()
935−#if MIN_VERSION_base(4,9,0)
936− HttpBodyAllowed 'NoBody 'CanHaveBody = TypeError
1379+ HttpBodyAllowed 'NoBody 'CanHaveBody =
1380+ TypeError
937− ('Text "This HTTP method does not allow attaching a request body.")
1381+ ('Text "This HTTP method does not allow attaching a request body.")
938−#endif
1382+
939−
940−instance HttpBody body => RequestComponent (Womb "body" body) where
1383+instance (HttpBody body) => RequestComponent (Tagged "body" body) where
941− getRequestMod (Womb body) = Endo $ \x ->
1384+ getRequestMod (Tagged body) = Endo $ \x ->
1385+ x
942− x { L.requestBody = getRequestBody body
1386+ { L.requestBody = getRequestBody body,
943− , L.requestHeaders =
1387+ L.requestHeaders =
944− let old = L.requestHeaders x in
1388+ let old = L.requestHeaders x
945− case getRequestContentType body of
1389+ in case getRequestContentType body of
946− Nothing -> old
1390+ Nothing -> old
947− Just contentType ->
1391+ Just contentType ->
948− (Y.hContentType, contentType) : old }
1392+ (Y.hContentType, contentType) : old
1393+ }
949
1394
950----------------------------------------------------------------------------
1395----------------------------------------------------------------------------
951−-- Request — Optional parameters
1396+-- Request—Optional parameters
952
1397
953-- $optional-parameters
1398-- $optional-parameters
954--
1399--
955−-- Optional parameters to a request include things like query parameters,
1400+-- Optional parameters of request include things like query parameters,
956-- headers, port number, etc. All optional parameters have the type
1401-- headers, port number, etc. All optional parameters have the type
957-- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as
1402-- 'Option', which is a 'Monoid'. This means that you can use 'mempty' as
958-- the last argument of 'req' to specify no optional parameters, or combine
1403-- the last argument of 'req' to specify no optional parameters, or combine
959−-- 'Option's using 'mappend' (or @('<>')@) to have several of them at once.
1404+-- 'Option's using 'mappend' or @('<>')@ to have several of them at once.
960
1405
961−-- | Opaque 'Option' type is a 'Monoid' you can use to pack collection of
1406+-- | The opaque 'Option' type is a 'Monoid' you can use to pack collection
962−-- optional parameters like query parameters and headers. See sections below
1407+-- of optional parameters like query parameters and headers. See sections
963−-- to learn which 'Option' primitives are available.
1408+-- below to learn which 'Option' primitives are available.
1409+data Option (scheme :: Scheme)
1410+ = Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))
964
1411
965−data Option (scheme :: Scheme) =
966− Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))
967− -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
1412+-- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
968− -- Request to avoid appending to existing query string in request every
1413+-- Request to avoid appending to an existing query string in request every
969− -- time new parameter is added. Additional Maybe (Endo Request) is a
1414+-- time new parameter is added. The additional Maybe (L.Request -> IO
970− -- finalizer that will be applied after all other transformations. This is
1415+-- L.Request) is a finalizer that will be applied after all other
971− -- for authentication methods that sign requests based on data in Request.
1416+-- transformations. This is for authentication methods that sign requests
1417+-- based on data in Request.
972
1418
973instance Semigroup (Option scheme) where
1419instance Semigroup (Option scheme) where
974− Option er0 mr0 <> Option er1 mr1 = Option
1420+ Option er0 mr0 <> Option er1 mr1 =
1421+ Option
975− (er0 <> er1) (mr0 <|> mr1)
1422+ (er0 <> er1)
1423+ (mr0 <|> mr1)
976
1424
977instance Monoid (Option scheme) where
1425instance Monoid (Option scheme) where
978− mempty = Option mempty Nothing
1426+ mempty = Option mempty Nothing
979 mappend = (<>)
1427 mappend = (<>)
980
1428
981−-- | A helper to create an 'Option' that modifies only collection of query
1429+-- | Use 'formToQuery'.
982−-- parameters. This helper is not a part of public API.
1430+--
1431+-- @since 3.11.0
1432+instance FromForm (Option scheme) where
1433+ fromForm = Right . formToQuery
983
1434
1435+-- | A helper to create an 'Option' that modifies only collection of query
1436+-- parameters. This helper is not a part of the public API.
984withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
1437withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
985withQueryParams f = Option (Endo (first f)) Nothing
1438withQueryParams f = Option (Endo (first f)) Nothing
986
1439
987-- | A helper to create an 'Option' that modifies only 'L.Request'. This
1440-- | A helper to create an 'Option' that modifies only 'L.Request'. This
988-- helper is not a part of public API.
1441-- helper is not a part of public API.
989−
990withRequest :: (L.Request -> L.Request) -> Option scheme
1442withRequest :: (L.Request -> L.Request) -> Option scheme
991withRequest f = Option (Endo (second f)) Nothing
1443withRequest f = Option (Endo (second f)) Nothing
992
1444
993−-- | A helper to create an 'Option' that adds a finalizer (request
994−-- endomorphism that is run after all other modifications).
995−
996−asFinalizer :: (L.Request -> IO L.Request) -> Option scheme
997−asFinalizer = Option mempty . pure
998−
999instance RequestComponent (Option scheme) where
1445instance RequestComponent (Option scheme) where
1000 getRequestMod (Option f _) = Endo $ \x ->
1446 getRequestMod (Option f _) = Endo $ \x ->
1001 let (qparams, x') = appEndo f ([], x)
1447 let (qparams, x') = appEndo f ([], x)
1002− query = Y.renderQuery True (Y.queryTextToQuery qparams)
1448+ query = Y.renderQuery True (Y.queryTextToQuery qparams)
1003− in x' { L.queryString = query }
1449+ in x' {L.queryString = query}
1004
1450
1005−-- | Finalize given 'L.Request' by applying a finalizer from given 'Option'
1451+-- | Finalize given 'L.Request' by applying a finalizer from the given
1006−-- (if it has any).
1452+-- 'Option' (if it has any).
1007−
1008−finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
1453+finalizeRequest :: (MonadIO m) => Option scheme -> L.Request -> m L.Request
1009finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
1454finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
1010
1455
1011----------------------------------------------------------------------------
1456----------------------------------------------------------------------------
1012−-- Request — Optional parameters — Query Parameters
1457+-- Request—Optional parameters—Query Parameters
1013
1458
1014-- $query-parameters
1459-- $query-parameters
1015--
1460--
1016-- This section describes a polymorphic interface that can be used to
1461-- This section describes a polymorphic interface that can be used to
1017−-- construct query parameters (of type 'Option') and form URL-encoded bodies
1462+-- construct query parameters (of the type 'Option') and form URL-encoded
1018−-- (of type 'FormUrlEncodedParam').
1463+-- bodies (of the type 'FormUrlEncodedParam').
1019
1464
1020-- | This operator builds a query parameter that will be included in URL of
1465-- | This operator builds a query parameter that will be included in URL of
1021−-- your request after question sign @?@. This is the same syntax you use
1466+-- your request after the question sign @?@. This is the same syntax you use
1022-- with form URL encoded request bodies.
1467-- with form URL encoded request bodies.
1023--
1468--
1024-- This operator is defined in terms of 'queryParam':
1469-- This operator is defined in terms of 'queryParam':
1025--
1470--
1026-- > name =: value = queryParam name (pure value)
1471-- > name =: value = queryParam name (pure value)
1027−
1028infix 7 =:
1472infix 7 =:
1473+
1029−(=:) :: (QueryParam param, ToHttpApiData a) => T.Text -> a -> param
1474+(=:) :: (QueryParam param, ToHttpApiData a) => Text -> a -> param
1030name =: value = queryParam name (pure value)
1475name =: value = queryParam name (pure value)
1031
1476
1032−-- | Construct a flag, that is, valueless query parameter. For example, in
1477+-- | Construct a flag, that is, a valueless query parameter. For example, in
1033−-- the following URL @a@ is a flag, @b@ is a query parameter with a value:
1478+-- the following URL @\"a\"@ is a flag, while @\"b\"@ is a query parameter
1479+-- with a value:
1034--
1480--
1035-- > https://httpbin.org/foo/bar?a&b=10
1481-- > https://httpbin.org/foo/bar?a&b=10
1036--
1482--
1037-- This operator is defined in terms of 'queryParam':
1483-- This operator is defined in terms of 'queryParam':
1038--
1484--
1039−-- > queryFlag name = queryParam name Nothing
1485+-- > queryFlag name = queryParam name (Nothing :: Maybe ())
1040−
1041−queryFlag :: QueryParam param => T.Text -> param
1486+queryFlag :: (QueryParam param) => Text -> param
1042queryFlag name = queryParam name (Nothing :: Maybe ())
1487queryFlag name = queryParam name (Nothing :: Maybe ())
1043
1488
1489+-- | Construct query parameters from a 'ToForm' instance. This function
1490+-- produces the same query params as 'Form.urlEncodeAsFormStable'.
1491+--
1492+-- Note that 'Form.Form' doesn't have the concept of parameters with the
1493+-- empty value (i.e. what you can get by @key =: ""@). If the value is
1494+-- empty, it will be encoded as a valueless parameter (i.e. what you can get
1495+-- by @queryFlag key@).
1496+--
1497+-- @since 3.11.0
1498+formToQuery :: (QueryParam param, Monoid param, ToForm f) => f -> param
1499+formToQuery f = mconcat . fmap toParam . Form.toListStable $ toForm f
1500+ where
1501+ toParam (key, val) =
1502+ queryParam key $
1503+ if val == ""
1504+ then Nothing
1505+ else Just val
1506+
1044−-- | A type class for query-parameter-like things. The reason to have
1507+-- | A type class for query-parameter-like things. The reason to have an
1045-- overloaded 'queryParam' is to be able to use it as an 'Option' and as a
1508-- overloaded 'queryParam' is to be able to use it as an 'Option' and as a
1046-- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.
1509-- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.
1047-- Having the same syntax for these cases seems natural and user-friendly.
1510-- Having the same syntax for these cases seems natural and user-friendly.
1048−
1049class QueryParam param where
1511class QueryParam param where
1050−
1051 -- | Create a query parameter with given name and value. If value is
1512 -- | Create a query parameter with given name and value. If value is
1052 -- 'Nothing', it won't be included at all (i.e. you create a flag this
1513 -- 'Nothing', it won't be included at all (i.e. you create a flag this
1053 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
1514 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
1054 -- method, because they are easier to read.
1515 -- method, because they are easier to read.
1516+ queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param
1055
1517
1056− queryParam :: ToHttpApiData a => T.Text -> Maybe a -> param
1518+ -- | Get the query parameter names and values set by 'queryParam'.
1519+ --
1520+ -- @since 3.11.0
1521+ queryParamToList :: param -> [(Text, Maybe Text)]
1057
1522
1058instance QueryParam (Option scheme) where
1523instance QueryParam (Option scheme) where
1059 queryParam name mvalue =
1524 queryParam name mvalue =
1060 withQueryParams ((:) (name, toQueryParam <$> mvalue))
1525 withQueryParams ((:) (name, toQueryParam <$> mvalue))
1526+ queryParamToList (Option f _) = fst $ appEndo f ([], L.defaultRequest)
1061
1527
1062----------------------------------------------------------------------------
1528----------------------------------------------------------------------------
1063−-- Request — Optional parameters — Headers
1529+-- Request—Optional parameters—Headers
1064
1530
1065-- | Create an 'Option' that adds a header. Note that if you 'mappend' two
1531-- | Create an 'Option' that adds a header. Note that if you 'mappend' two
1066-- headers with the same names the leftmost header will win. This means, in
1532-- headers with the same names the leftmost header will win. This means, in
1067-- particular, that you cannot create a request with several headers of the
1533-- particular, that you cannot create a request with several headers of the
1068-- same name.
1534-- same name.
1069−
1070−header
1535+header ::
1071− :: ByteString -- ^ Header name
1536+ -- | Header name
1537+ ByteString ->
1072− -> ByteString -- ^ Header value
1538+ -- | Header value
1539+ ByteString ->
1073− -> Option scheme
1540+ Option scheme
1074header name value = withRequest (attachHeader name value)
1541header name value = withRequest (attachHeader name value)
1075
1542
1076−-- | A non-public helper that attaches a header with given name and content
1543+-- | Attach a header with given name and content to a 'L.Request'.
1077−-- to a 'L.Request'.
1544+--
1078−
1545+-- @since 1.1.0
1079attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
1546attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
1080attachHeader name value x =
1547attachHeader name value x =
1081− x { L.requestHeaders = (CI.mk name, value) : L.requestHeaders x }
1548+ x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
1549+
1550+-- | Same as 'header', but with redacted values on print.
1551+--
1552+-- @since 3.13.0
1553+headerRedacted :: ByteString -> ByteString -> Option scheme
1554+headerRedacted name value = withRequest $ \x ->
1555+ let y = attachHeader name value x
1556+ in y {L.redactHeaders = CI.mk name `S.insert` L.redactHeaders y}
1082
1557
1083----------------------------------------------------------------------------
1558----------------------------------------------------------------------------
1084−-- Request — Optional parameters — Cookies
1559+-- Request—Optional parameters—Cookies
1085
1560
1086-- $cookies
1561-- $cookies
1087--
1562--
1088−-- Support for cookies is quite minimalistic at the moment, its' possible to
1563+-- Support for cookies is quite minimalistic at the moment. It's possible to
1089-- specify which cookies to send using 'cookieJar' and inspect 'L.Response'
1564-- specify which cookies to send using 'cookieJar' and inspect 'L.Response'
1090-- to extract 'L.CookieJar' from it (see 'responseCookieJar').
1565-- to extract 'L.CookieJar' from it (see 'responseCookieJar').
1091
1566
1092-- | Use the given 'L.CookieJar'. A 'L.CookieJar' can be obtained from a
1567-- | Use the given 'L.CookieJar'. A 'L.CookieJar' can be obtained from a
1093-- 'L.Response' record.
1568-- 'L.Response' record.
1094−
1095cookieJar :: L.CookieJar -> Option scheme
1569cookieJar :: L.CookieJar -> Option scheme
1096cookieJar jar = withRequest $ \x ->
1570cookieJar jar = withRequest $ \x ->
1097− x { L.cookieJar = Just jar }
1571+ x {L.cookieJar = Just jar}
1098
1572
1099----------------------------------------------------------------------------
1573----------------------------------------------------------------------------
1100−-- Request — Optional parameters — Authentication
1574+-- Request—Optional parameters—Authentication
1101
1575
1102-- $authentication
1576-- $authentication
1103--
1577--
@@ -1106,35 +1580,72 @@ cookieJar jar = withRequest $ \x ->
1106-- to manual construction of headers because it ensures that you only use
1580-- to manual construction of headers because it ensures that you only use
1107-- one authentication method at a time (they overwrite each other) and
1581-- one authentication method at a time (they overwrite each other) and
1108-- provides additional type safety that prevents leaking of credentials in
1582-- provides additional type safety that prevents leaking of credentials in
1109−-- cases when authentication relies on TLS for encrypting sensitive data.
1583+-- the cases when authentication relies on HTTPS for encrypting sensitive
1584+-- data.
1110
1585
1111-- | The 'Option' adds basic authentication.
1586-- | The 'Option' adds basic authentication.
1112--
1587--
1113-- See also: <https://en.wikipedia.org/wiki/Basic_access_authentication>.
1588-- See also: <https://en.wikipedia.org/wiki/Basic_access_authentication>.
1114−
1115−basicAuth
1589+basicAuth ::
1116− :: ByteString -- ^ Username
1590+ -- | Username
1591+ ByteString ->
1117− -> ByteString -- ^ Password
1592+ -- | Password
1593+ ByteString ->
1594+ -- | Auth 'Option'
1118− -> Option 'Https -- ^ Auth 'Option'
1595+ Option 'Https
1596+basicAuth = basicAuthUnsafe
1597+
1598+-- | An alternative to 'basicAuth' which works for any scheme. Note that
1599+-- using basic access authentication without SSL\/TLS is vulnerable to
1600+-- attacks. Use 'basicAuth' instead unless you know what you are doing.
1601+--
1602+-- @since 0.3.1
1603+basicAuthUnsafe ::
1604+ -- | Username
1605+ ByteString ->
1606+ -- | Password
1607+ ByteString ->
1608+ -- | Auth 'Option'
1609+ Option scheme
1119−basicAuth username password = asFinalizer
1610+basicAuthUnsafe username password =
1611+ customAuth
1120− (pure . L.applyBasicAuth username password)
1612+ (pure . L.applyBasicAuth username password)
1613+
1614+-- | The 'Option' set basic proxy authentication header.
1615+--
1616+-- @since 1.1.0
1617+basicProxyAuth ::
1618+ -- | Username
1619+ ByteString ->
1620+ -- | Password
1621+ ByteString ->
1622+ -- | Auth 'Option'
1623+ Option scheme
1624+basicProxyAuth username password =
1625+ withRequest (L.applyBasicProxyAuth username password)
1121
1626
1122-- | The 'Option' adds OAuth1 authentication.
1627-- | The 'Option' adds OAuth1 authentication.
1123--
1628--
1124-- @since 0.2.0
1629-- @since 0.2.0
1125−
1126−oAuth1
1630+oAuth1 ::
1127− :: ByteString -- ^ Consumer token
1631+ -- | Consumer token
1632+ ByteString ->
1128− -> ByteString -- ^ Consumer secret
1633+ -- | Consumer secret
1129− -> ByteString -- ^ OAuth token
1634+ ByteString ->
1635+ -- | OAuth token
1636+ ByteString ->
1130− -> ByteString -- ^ OAuth token secret
1637+ -- | OAuth token secret
1638+ ByteString ->
1131− -> Option scheme -- ^ Auth 'Option'
1639+ -- | Auth 'Option'
1640+ Option scheme
1132oAuth1 consumerToken consumerSecret token tokenSecret =
1641oAuth1 consumerToken consumerSecret token tokenSecret =
1133− asFinalizer (OAuth.signOAuth app creds)
1642+ customAuth (OAuth.signOAuth app creds)
1134 where
1643 where
1644+ app =
1135− app = OAuth.newOAuth
1645+ OAuth.newOAuth
1136− { OAuth.oauthConsumerKey = consumerToken
1646+ { OAuth.oauthConsumerKey = consumerToken,
1137− , OAuth.oauthConsumerSecret = consumerSecret }
1647+ OAuth.oauthConsumerSecret = consumerSecret
1648+ }
1138 creds = OAuth.newCredential token tokenSecret
1649 creds = OAuth.newCredential token tokenSecret
1139
1650
1140-- | The 'Option' adds an OAuth2 bearer token. This is treated by many
1651-- | The 'Option' adds an OAuth2 bearer token. This is treated by many
@@ -1145,12 +1656,14 @@ oAuth1 consumerToken consumerSecret token tokenSecret =
1145-- > oAuth2Bearer token = header "Authorization" ("Bearer " <> token)
1656-- > oAuth2Bearer token = header "Authorization" ("Bearer " <> token)
1146--
1657--
1147-- See also: <https://en.wikipedia.org/wiki/OAuth>.
1658-- See also: <https://en.wikipedia.org/wiki/OAuth>.
1148−
1149−oAuth2Bearer
1659+oAuth2Bearer ::
1150− :: ByteString -- ^ Token
1660+ -- | Token
1661+ ByteString ->
1151− -> Option 'Https -- ^ Auth 'Option'
1662+ -- | Auth 'Option'
1663+ Option 'Https
1152−oAuth2Bearer token = asFinalizer
1664+oAuth2Bearer token =
1665+ customAuth
1153− (pure . attachHeader "Authorization" ("Bearer " <> token))
1666+ (pure . attachHeader "Authorization" ("Bearer " <> token))
1154
1667
1155-- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems
1668-- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems
1156-- to be used only by GitHub). This will be treated by whatever services
1669-- to be used only by GitHub). This will be treated by whatever services
@@ -1161,26 +1674,35 @@ oAuth2Bearer token = asFinalizer
1161-- > oAuth2Token token = header "Authorization" ("token" <> token)
1674-- > oAuth2Token token = header "Authorization" ("token" <> token)
1162--
1675--
1163-- See also: <https://developer.github.com/v3/oauth#3-use-the-access-token-to-access-the-api>.
1676-- See also: <https://developer.github.com/v3/oauth#3-use-the-access-token-to-access-the-api>.
1164−
1165−oAuth2Token
1677+oAuth2Token ::
1166− :: ByteString -- ^ Token
1678+ -- | Token
1679+ ByteString ->
1167− -> Option 'Https -- ^ Auth 'Option'
1680+ -- | Auth 'Option'
1681+ Option 'Https
1168−oAuth2Token token = asFinalizer
1682+oAuth2Token token =
1683+ customAuth
1169− (pure . attachHeader "Authorization" ("token " <> token))
1684+ (pure . attachHeader "Authorization" ("token " <> token))
1685+
1686+-- | A helper to create custom authentication 'Option's. The given
1687+-- 'IO'-enabled request transformation is applied after all other
1688+-- modifications when constructing a request. Use wisely.
1689+--
1690+-- @since 1.1.0
1691+customAuth :: (L.Request -> IO L.Request) -> Option scheme
1692+customAuth = Option mempty . pure
1170
1693
1171----------------------------------------------------------------------------
1694----------------------------------------------------------------------------
1172−-- Request — Optional parameters — Other
1695+-- Request—Optional parameters—Other
1173
1696
1174-- | Specify the port to connect to explicitly. Normally, 'Url' you use
1697-- | Specify the port to connect to explicitly. Normally, 'Url' you use
1175-- determines the default port: @80@ for HTTP and @443@ for HTTPS. This
1698-- determines the default port: @80@ for HTTP and @443@ for HTTPS. This
1176−-- 'Option' allows to choose arbitrary port overwriting the defaults.
1699+-- 'Option' allows us to choose an arbitrary port overwriting the defaults.
1177−
1178port :: Int -> Option scheme
1700port :: Int -> Option scheme
1179port n = withRequest $ \x ->
1701port n = withRequest $ \x ->
1180− x { L.port = n }
1702+ x {L.port = n}
1181
1703
1182-- | This 'Option' controls whether gzipped data should be decompressed on
1704-- | This 'Option' controls whether gzipped data should be decompressed on
1183−-- the fly. By default everything except for @application\/x-tar@ is
1705+-- the fly. By default everything except for @\"application\/x-tar\"@ is
1184-- decompressed, i.e. we have:
1706-- decompressed, i.e. we have:
1185--
1707--
1186-- > decompress (/= "application/x-tar")
1708-- > decompress (/= "application/x-tar")
@@ -1188,207 +1710,272 @@ port n = withRequest $ \x ->
1188-- You can also choose to decompress everything like this:
1710-- You can also choose to decompress everything like this:
1189--
1711--
1190-- > decompress (const True)
1712-- > decompress (const True)
1191−
1192−decompress
1713+decompress ::
1193− :: (ByteString -> Bool) -- ^ Predicate that is given MIME type, it
1714+ -- | Predicate that is given MIME type, it returns 'True' when content
1194− -- returns 'True' when content should be decompressed on the fly.
1715+ -- should be decompressed on the fly.
1716+ (ByteString -> Bool) ->
1195− -> Option scheme
1717+ Option scheme
1196decompress f = withRequest $ \x ->
1718decompress f = withRequest $ \x ->
1197− x { L.decompress = f }
1719+ x {L.decompress = f}
1198−
1720+
1199−-- | Specify number of microseconds to wait for response. The default value
1721+-- | Specify the number of microseconds to wait for response. The default
1200−-- is 30 seconds.
1722+-- value is 30 seconds (defined in 'L.ManagerSettings' of connection
1201−
1723+-- 'L.Manager').
1202−responseTimeout
1724+responseTimeout ::
1203− :: Int -- ^ Number of microseconds to wait
1725+ -- | Number of microseconds to wait
1726+ Int ->
1204− -> Option scheme
1727+ Option scheme
1205responseTimeout n = withRequest $ \x ->
1728responseTimeout n = withRequest $ \x ->
1206− x { L.responseTimeout = LI.ResponseTimeoutMicro n }
1729+ x {L.responseTimeout = LI.ResponseTimeoutMicro n}
1207−
1730+
1208−-- | HTTP version to send to server, the default is HTTP 1.1.
1731+-- | HTTP version to send to the server, the default is HTTP 1.1.
1209−
1210−httpVersion
1732+httpVersion ::
1211− :: Int -- ^ Major version number
1733+ -- | Major version number
1734+ Int ->
1212− -> Int -- ^ Minor version number
1735+ -- | Minor version number
1736+ Int ->
1213− -> Option scheme
1737+ Option scheme
1214httpVersion major minor = withRequest $ \x ->
1738httpVersion major minor = withRequest $ \x ->
1215− x { L.requestVersion = Y.HttpVersion major minor }
1739+ x {L.requestVersion = Y.HttpVersion major minor}
1216
1740
1217----------------------------------------------------------------------------
1741----------------------------------------------------------------------------
1218-- Response interpretations
1742-- Response interpretations
1219
1743
1220−-- | Make a request and ignore body of response.
1744+-- | Make a request and ignore the body of the response.
1221−
1222−data IgnoreResponse = IgnoreResponse (L.Response ())
1745+newtype IgnoreResponse = IgnoreResponse (L.Response ())
1746+ deriving (Show)
1223
1747
1224instance HttpResponse IgnoreResponse where
1748instance HttpResponse IgnoreResponse where
1225 type HttpResponseBody IgnoreResponse = ()
1749 type HttpResponseBody IgnoreResponse = ()
1226− toVanillaResponse (IgnoreResponse response) = response
1750+ toVanillaResponse (IgnoreResponse r) = r
1227− getHttpResponse request manager =
1751+ getHttpResponse r = return $ IgnoreResponse (void r)
1228− IgnoreResponse <$> liftIO (L.httpNoBody request manager)
1229
1752
1230-- | Use this as the fourth argument of 'req' to specify that you want it to
1753-- | Use this as the fourth argument of 'req' to specify that you want it to
1231−-- return the 'IgnoreResponse' interpretation.
1754+-- ignore the response body.
1232−
1233ignoreResponse :: Proxy IgnoreResponse
1755ignoreResponse :: Proxy IgnoreResponse
1234ignoreResponse = Proxy
1756ignoreResponse = Proxy
1235
1757
1236−-- | Make a request and interpret body of response as JSON. The
1758+-- | Make a request and interpret the body of the response as JSON. The
1237-- 'handleHttpException' method of 'MonadHttp' instance corresponding to
1759-- 'handleHttpException' method of 'MonadHttp' instance corresponding to
1238-- monad in which you use 'req' will determine what to do in the case when
1760-- monad in which you use 'req' will determine what to do in the case when
1239−-- parsing fails ('JsonHttpException' constructor will be used).
1761+-- parsing fails (the 'JsonHttpException' constructor will be used).
1240−
1241newtype JsonResponse a = JsonResponse (L.Response a)
1762newtype JsonResponse a = JsonResponse (L.Response a)
1763+ deriving (Show)
1242
1764
1243−instance FromJSON a => HttpResponse (JsonResponse a) where
1765+instance (FromJSON a) => HttpResponse (JsonResponse a) where
1244 type HttpResponseBody (JsonResponse a) = a
1766 type HttpResponseBody (JsonResponse a) = a
1245− toVanillaResponse (JsonResponse response) = response
1767+ toVanillaResponse (JsonResponse r) = r
1246− getHttpResponse request manager = do
1768+ getHttpResponse r = do
1247− response <- L.httpLbs request manager
1769+ chunks <- L.brConsume (L.responseBody r)
1248− case A.eitherDecode (L.responseBody response) of
1770+ case A.eitherDecode (BL.fromChunks chunks) of
1249 Left e -> throwIO (JsonHttpException e)
1771 Left e -> throwIO (JsonHttpException e)
1250− Right x -> return $ JsonResponse response { L.responseBody = x }
1772+ Right x -> return $ JsonResponse (x <$ r)
1773+ acceptHeader Proxy = Just "application/json"
1251
1774
1252−-- | Use this as the forth argument of 'req' to specify that you want it to
1775+-- | Use this as the fourth argument of 'req' to specify that you want it to
1253-- return the 'JsonResponse' interpretation.
1776-- return the 'JsonResponse' interpretation.
1254−
1255jsonResponse :: Proxy (JsonResponse a)
1777jsonResponse :: Proxy (JsonResponse a)
1256jsonResponse = Proxy
1778jsonResponse = Proxy
1257
1779
1258−-- | Make a request and interpret body of response as a strict 'ByteString'.
1780+-- | Make a request and interpret the body of the response as a strict
1259−
1781+-- 'ByteString'.
1260newtype BsResponse = BsResponse (L.Response ByteString)
1782newtype BsResponse = BsResponse (L.Response ByteString)
1783+ deriving (Show)
1261
1784
1262instance HttpResponse BsResponse where
1785instance HttpResponse BsResponse where
1263 type HttpResponseBody BsResponse = ByteString
1786 type HttpResponseBody BsResponse = ByteString
1264− toVanillaResponse (BsResponse response) = response
1787+ toVanillaResponse (BsResponse r) = r
1265− getHttpResponse request manager =
1788+ getHttpResponse r = do
1266− L.withResponse request manager $ \response -> do
1267− chunks <- L.brConsume (L.responseBody response)
1789+ chunks <- L.brConsume (L.responseBody r)
1268− return $ BsResponse response { L.responseBody = B.concat chunks }
1790+ return $ BsResponse (B.concat chunks <$ r)
1269−
1270−-- | Use this as the forth argument of 'req' to specify that you want to
1271−-- interpret response body as a strict 'ByteString'.
1272
1791
1792+-- | Use this as the fourth argument of 'req' to specify that you want to
1793+-- interpret the response body as a strict 'ByteString'.
1273bsResponse :: Proxy BsResponse
1794bsResponse :: Proxy BsResponse
1274bsResponse = Proxy
1795bsResponse = Proxy
1275
1796
1276−-- | Make a request and interpret body of response as a lazy
1797+-- | Make a request and interpret the body of the response as a lazy
1277-- 'BL.ByteString'.
1798-- 'BL.ByteString'.
1278−
1279newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
1799newtype LbsResponse = LbsResponse (L.Response BL.ByteString)
1800+ deriving (Show)
1280
1801
1281instance HttpResponse LbsResponse where
1802instance HttpResponse LbsResponse where
1282 type HttpResponseBody LbsResponse = BL.ByteString
1803 type HttpResponseBody LbsResponse = BL.ByteString
1283− toVanillaResponse (LbsResponse response) = response
1804+ toVanillaResponse (LbsResponse r) = r
1284− getHttpResponse request manager =
1805+ getHttpResponse r = do
1285− LbsResponse <$> L.httpLbs request manager
1806+ chunks <- L.brConsume (L.responseBody r)
1286−
1807+ return $ LbsResponse (BL.fromChunks chunks <$ r)
1287−-- | Use this as the forth argument of 'req' to specify that you want to
1288−-- interpret response body as a lazy 'BL.ByteString'.
1289
1808
1809+-- | Use this as the fourth argument of 'req' to specify that you want to
1810+-- interpret the response body as a lazy 'BL.ByteString'.
1290lbsResponse :: Proxy LbsResponse
1811lbsResponse :: Proxy LbsResponse
1291lbsResponse = Proxy
1812lbsResponse = Proxy
1292
1813
1293−-- | This interpretation does not result in any call at all, but you can use
1814+----------------------------------------------------------------------------
1294−-- the 'responseRequest' function to extract 'L.Request' that 'req' has
1815+-- Helpers for response interpretations
1295−-- prepared. This is useful primarily for testing.
1816+
1296−--
1817+-- | Fetch beginning of the response and return it together with a new
1297−-- Note that when you use this interpretation inspecting response will
1818+-- @'L.Response' 'L.BodyReader'@ that can be passed to 'getHttpResponse' and
1298−-- diverge (i.e. it'll blow up with an error, don't do that).
1819+-- such.
1299−
1820+grabPreview ::
1300−newtype ReturnRequest = ReturnRequest L.Request
1821+ -- | How many bytes to fetch
1301−
1822+ Int ->
1302−instance HttpResponse ReturnRequest where
1823+ -- | Response with body reader inside
1303− type HttpResponseBody ReturnRequest = ()
1824+ L.Response L.BodyReader ->
1304− toVanillaResponse (ReturnRequest _) = error
1825+ -- | Preview 'ByteString' and new response with body reader inside
1305− "Network.HTTP.Req.ReturnRequest interpretation does not make requests"
1826+ IO (ByteString, L.Response L.BodyReader)
1306− getHttpResponse request _ = return (ReturnRequest request)
1827+grabPreview nbytes r = do
1307−
1828+ let br = L.responseBody r
1308−-- | Use this as the forth argument of 'req' to specify that you want it to
1829+ (target, leftover, done) <- brReadN br nbytes
1309−-- just return the request it consturcted without making any requests.
1830+ nref <- newIORef (0 :: Int)
1310−
1831+ let br' = do
1311−returnRequest :: Proxy ReturnRequest
1832+ n <- readIORef nref
1312−returnRequest = Proxy
1833+ let incn = modifyIORef' nref (+ 1)
1834+ case n of
1835+ 0 -> do
1836+ incn
1837+ if B.null target
1838+ then br'
1839+ else return target
1840+ 1 -> do
1841+ incn
1842+ if B.null leftover
1843+ then br'
1844+ else return leftover
1845+ _ ->
1846+ if done
1847+ then return B.empty
1848+ else br
1849+ return (target, r {L.responseBody = br'})
1850+
1851+-- | Consume N bytes from 'L.BodyReader', return the target chunk, the
1852+-- leftover (may be empty), and whether we're done consuming the body.
1853+brReadN ::
1854+ -- | Body reader to stream from
1855+ L.BodyReader ->
1856+ -- | How many bytes to consume
1857+ Int ->
1858+ -- | Target chunk, the leftover, whether we're done
1859+ IO (ByteString, ByteString, Bool)
1860+brReadN br n = go 0 id id
1861+ where
1862+ go !tlen t l = do
1863+ chunk <- br
1864+ if B.null chunk
1865+ then return (r t, r l, True)
1866+ else do
1867+ let (target, leftover) = B.splitAt (n - tlen) chunk
1868+ tlen' = B.length target
1869+ t' = t . (target :)
1870+ l' = l . (leftover :)
1871+ if tlen + tlen' < n
1872+ then go (tlen + tlen') t' l'
1873+ else return (r t', r l', False)
1874+ r f = B.concat (f [])
1313
1875
1314----------------------------------------------------------------------------
1876----------------------------------------------------------------------------
1315-- Inspecting a response
1877-- Inspecting a response
1316
1878
1317−-- | Get response body.
1879+-- | Get the response body.
1318−
1319−responseBody
1880+responseBody ::
1320− :: HttpResponse response
1881+ (HttpResponse response) =>
1321− => response
1882+ response ->
1322− -> HttpResponseBody response
1883+ HttpResponseBody response
1323responseBody = L.responseBody . toVanillaResponse
1884responseBody = L.responseBody . toVanillaResponse
1324
1885
1325−-- | Get response status code.
1886+-- | Get the response status code.
1326−
1327−responseStatusCode
1887+responseStatusCode ::
1328− :: HttpResponse response
1888+ (HttpResponse response) =>
1329− => response
1889+ response ->
1330− -> Int
1890+ Int
1331responseStatusCode =
1891responseStatusCode =
1332 Y.statusCode . L.responseStatus . toVanillaResponse
1892 Y.statusCode . L.responseStatus . toVanillaResponse
1333
1893
1334−-- | Get response status message.
1894+-- | Get the response status message.
1335−
1336−responseStatusMessage
1895+responseStatusMessage ::
1337− :: HttpResponse response
1896+ (HttpResponse response) =>
1338− => response
1897+ response ->
1339− -> ByteString
1898+ ByteString
1340responseStatusMessage =
1899responseStatusMessage =
1341 Y.statusMessage . L.responseStatus . toVanillaResponse
1900 Y.statusMessage . L.responseStatus . toVanillaResponse
1342
1901
1343−-- | Look a particular header from a response.
1902+-- | Lookup a particular header from a response.
1344−
1345−responseHeader
1903+responseHeader ::
1346− :: HttpResponse response
1904+ (HttpResponse response) =>
1347− => response -- ^ Response interpretation
1905+ -- | Response interpretation
1906+ response ->
1348− -> ByteString -- ^ Header to lookup
1907+ -- | Header to lookup
1908+ ByteString ->
1349− -> Maybe ByteString -- ^ Header value if found
1909+ -- | Header value if found
1910+ Maybe ByteString
1350responseHeader r h =
1911responseHeader r h =
1351 (lookup (CI.mk h) . L.responseHeaders . toVanillaResponse) r
1912 (lookup (CI.mk h) . L.responseHeaders . toVanillaResponse) r
1352
1913
1353−-- | Get response 'L.CookieJar'.
1914+-- | Get the response 'L.CookieJar'.
1354−
1355−responseCookieJar
1915+responseCookieJar ::
1356− :: HttpResponse response
1916+ (HttpResponse response) =>
1357− => response
1917+ response ->
1358− -> L.CookieJar
1918+ L.CookieJar
1359responseCookieJar = L.responseCookieJar . toVanillaResponse
1919responseCookieJar = L.responseCookieJar . toVanillaResponse
1360
1920
1361−-- | Get the original request from 'ReturnRequest' response interpretation.
1362−
1363−responseRequest :: ReturnRequest -> L.Request
1364−responseRequest (ReturnRequest request) = request
1365−
1366----------------------------------------------------------------------------
1921----------------------------------------------------------------------------
1367−-- Response — defining your own interpretation
1922+-- Response—Defining your own interpretation
1368
1923
1369-- $new-response-interpretation
1924-- $new-response-interpretation
1370--
1925--
1371-- To create a new response interpretation you just need to make your data
1926-- To create a new response interpretation you just need to make your data
1372−-- type an instance of 'HttpResponse' type class.
1927+-- type an instance of the 'HttpResponse' type class.
1373−
1374−-- | A type class for response interpretations. It allows to fully control
1375−-- how request is made and how its body is parsed.
1376
1928
1929+-- | A type class for response interpretations. It allows us to describe how
1930+-- to consume the response from a @'L.Response' 'L.BodyReader'@ and produce
1931+-- the final result that is to be returned to the user.
1377class HttpResponse response where
1932class HttpResponse response where
1378−
1379− -- | The associated type is the type of body that can be extracted from a
1933+ -- | The associated type is the type of body that can be extracted from an
1380 -- instance of 'HttpResponse'.
1934 -- instance of 'HttpResponse'.
1935+ type HttpResponseBody response :: Type
1381
1936
1382− type HttpResponseBody response :: *
1383−
1384− -- | The method describes how to get underlying 'L.Response' record.
1937+ -- | The method describes how to get the underlying 'L.Response' record.
1385−
1386 toVanillaResponse :: response -> L.Response (HttpResponseBody response)
1938 toVanillaResponse :: response -> L.Response (HttpResponseBody response)
1387
1939
1388− -- | This method describes how to make an HTTP request given 'L.Request'
1940+ -- | This method describes how to consume response body and, more
1389− -- (prepared by the rest of the library) and 'L.Manager'.
1941+ -- generally, obtain @response@ value from @'L.Response' 'L.BodyReader'@.
1390−
1942+ --
1391− getHttpResponse :: L.Request -> L.Manager -> IO response
1943+ -- __Note__: 'L.BodyReader' is nothing but @'IO' 'ByteString'@. You should
1944+ -- call this action repeatedly until it yields the empty 'ByteString'. In
1945+ -- that case streaming of response is finished (which apparently leads to
1946+ -- closing of the connection, so don't call the reader after it has
1947+ -- returned the empty 'ByteString' once) and you can concatenate the
1948+ -- chunks to obtain the final result. (Of course you could as well stream
1949+ -- the contents to a file or do whatever you want.)
1950+ --
1951+ -- __Note__: signature of this function was changed in the version
1952+ -- /1.0.0/.
1953+ getHttpResponse ::
1954+ -- | Response with body reader inside
1955+ L.Response L.BodyReader ->
1956+ -- | The final result
1957+ IO response
1958+
1959+ -- | The value of @\"Accept\"@ header. This is useful, for example, if a
1960+ -- website supports both @XML@ and @JSON@ responses, and decides what to
1961+ -- reply with based on what @Accept@ headers you have sent.
1962+ --
1963+ -- __Note__: manually specified 'Options' that set the @\"Accept\"@ header
1964+ -- will take precedence.
1965+ --
1966+ -- @since 2.1.0
1967+ acceptHeader :: Proxy response -> Maybe ByteString
1968+ acceptHeader Proxy = Nothing
1969+
1970+-- | This instance has been added to make it easier to inspect 'L.Response'
1971+-- using Req's functions like 'responseStatusCode', 'responseStatusMessage',
1972+-- etc.
1973+--
1974+-- @since 3.12.0
1975+instance HttpResponse (L.Response ()) where
1976+ type HttpResponseBody (L.Response ()) = ()
1977+ toVanillaResponse = id
1978+ getHttpResponse = return . void
1392
1979
1393----------------------------------------------------------------------------
1980----------------------------------------------------------------------------
1394-- Other
1981-- Other
@@ -1398,15 +1985,14 @@ class HttpResponse response where
1398-- 'RequestComponent' changing\/overwriting something in it. 'Endo' is a
1985-- 'RequestComponent' changing\/overwriting something in it. 'Endo' is a
1399-- monoid of endomorphisms under composition, it's used to chain different
1986-- monoid of endomorphisms under composition, it's used to chain different
1400-- request components easier using @('<>')@.
1987-- request components easier using @('<>')@.
1401−
1988+--
1989+-- __Note__: this type class is not a part of the public API.
1402class RequestComponent a where
1990class RequestComponent a where
1403−
1404 -- | Get a function that takes a 'L.Request' and changes it somehow
1991 -- | Get a function that takes a 'L.Request' and changes it somehow
1405− -- returning another 'L.Request'. For example HTTP method instance of
1992+ -- returning another 'L.Request'. For example, the 'HttpMethod' instance
1406− -- 'RequestComponent' just overwrites method. The function is wrapped in
1993+ -- of 'RequestComponent' just overwrites method. The function is wrapped
1407− -- 'Endo' so it's easier to chain such “modifying applications” together
1994+ -- in 'Endo' so it's easier to chain such “modifying applications”
1408− -- building bigger and bigger 'RequestComponent's.
1995+ -- together building bigger and bigger 'RequestComponent's.
1409−
1410 getRequestMod :: a -> Endo L.Request
1996 getRequestMod :: a -> Endo L.Request
1411
1997
1412-- | This wrapper is only used to attach a type-level tag to a given type.
1998-- | This wrapper is only used to attach a type-level tag to a given type.
@@ -1416,34 +2002,50 @@ class RequestComponent a where
1416-- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides
2002-- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides
1417-- which instance to use (i.e. the constraints are taken into account later,
2003-- which instance to use (i.e. the constraints are taken into account later,
1418-- when instance is already chosen).
2004-- when instance is already chosen).
1419−
1420−newtype Womb (tag :: Symbol) a = Womb a
2005+newtype Tagged (tag :: Symbol) a = Tagged a
1421
2006
1422-- | Exceptions that this library throws.
2007-- | Exceptions that this library throws.
1423−
1424data HttpException
2008data HttpException
1425− = VanillaHttpException L.HttpException
1426− -- ^ A wrapper with an 'L.HttpException' from "Network.HTTP.Client"
2009+ = -- | A wrapper with an 'L.HttpException' from "Network.HTTP.Client"
1427− | JsonHttpException String
2010+ VanillaHttpException L.HttpException
1428− -- ^ A wrapper with Aeson-produced 'String' describing why decoding failed
2011+ | -- | A wrapper with Aeson-produced 'String' describing why decoding
2012+ -- failed
2013+ JsonHttpException String
1429− deriving (Show, Typeable, Generic)
2014+ deriving (Show, Generic)
1430
2015
1431instance Exception HttpException
2016instance Exception HttpException
1432
2017
1433−-- | A simple 'Bool'-like type we only have for better error messages. We
2018+-- | Return 'Just' if the given 'HttpException' is wrapping a http-client's
1434−-- use it as a kind and its data constructors as type-level tags.
2019+-- 'L.StatusCodeException'. Otherwise, return 'Nothing'.
1435--
2020--
1436−-- See also: 'HttpMethod' and 'HttpBody'.
2021+-- @since 3.12.0
2022+isStatusCodeException :: HttpException -> Maybe (L.Response ())
2023+isStatusCodeException
2024+ ( VanillaHttpException
2025+ ( L.HttpExceptionRequest
2026+ _
2027+ (L.StatusCodeException r _)
2028+ )
2029+ ) = Just r
2030+isStatusCodeException _ = Nothing
1437
2031
2032+-- | A simple type isomorphic to 'Bool' that we only have for better error
2033+-- messages. We use it as a kind and its data constructors as type-level
2034+-- tags.
2035+--
2036+-- See also: 'HttpMethod' and 'HttpBody'.
1438data CanHaveBody
2037data CanHaveBody
1439− = CanHaveBody -- ^ Indeed can have a body
2038+ = -- | Indeed can have a body
2039+ CanHaveBody
1440− | NoBody -- ^ Should not have a body
2040+ | -- | Should not have a body
2041+ NoBody
1441
2042
1442−-- | A type-level tag that specifies URL scheme used (and thus if TLS is
2043+-- | A type-level tag that specifies URL scheme used (and thus if HTTPS is
1443-- enabled). This is used to force TLS requirement for some authentication
2044-- enabled). This is used to force TLS requirement for some authentication
1444-- 'Option's.
2045-- 'Option's.
1445−
1446data Scheme
2046data Scheme
1447− = Http -- ^ HTTP, no TLS
2047+ = -- | HTTP
2048+ Http
1448− | Https -- ^ HTTPS
2049+ | -- | HTTPS
2050+ Https
1449− deriving (Eq, Ord, Show, Data, Typeable, Generic)
2051+ deriving (Eq, Ord, Show, Data, Generic, TH.Lift)
README.md+65−166
@@ -4,208 +4,107 @@
4[![Hackage](https://img.shields.io/hackage/v/req.svg?style=flat)](https://hackage.haskell.org/package/req)
4[![Hackage](https://img.shields.io/hackage/v/req.svg?style=flat)](https://hackage.haskell.org/package/req)
5[![Stackage Nightly](http://stackage.org/package/req/badge/nightly)](http://stackage.org/nightly/package/req)
5[![Stackage Nightly](http://stackage.org/package/req/badge/nightly)](http://stackage.org/nightly/package/req)
6[![Stackage LTS](http://stackage.org/package/req/badge/lts)](http://stackage.org/lts/package/req)
6[![Stackage LTS](http://stackage.org/package/req/badge/lts)](http://stackage.org/lts/package/req)
7−[![Build Status](https://travis-ci.org/mrkkrp/req.svg?branch=master)](https://travis-ci.org/mrkkrp/req)
7+[![CI](https://github.com/mrkkrp/req/actions/workflows/ci.yaml/badge.svg)](https://github.com/mrkkrp/req/actions/workflows/ci.yaml)
8−[![Coverage Status](https://coveralls.io/repos/mrkkrp/req/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/req?branch=master)
9
8
10−* [Motivation and Req vs other libraries](#motivation-and-req-vs-other-libraries)
11−* [Unsolved problems](#unsolved-problems)
12* [Related packages](#related-packages)
9* [Related packages](#related-packages)
10+* [Blog posts](#blog-posts)
13* [Contribution](#contribution)
11* [Contribution](#contribution)
14* [License](#license)
12* [License](#license)
15
13
16```haskell
14```haskell
17−{-# LANGUAGE OverloadedStrings #-}
15+{-# LANGUAGE OverloadedStrings #-}
18−{-# OPTIONS_GHC -fno-warn-orphans #-}
19
16
20module Main (main) where
17module Main (main) where
21
18
22−import Control.Exception (throwIO)
19+import Control.Monad.IO.Class
23−import Network.HTTP.Req
24import Data.Aeson
20import Data.Aeson
25−
21+import Network.HTTP.Req
26−-- Just make your monad stack an instance of MonadHttp in your application
27−-- and start making requests, enjoy automatic connection sharing.
28−
29−instance MonadHttp IO where
30− handleHttpException = throwIO
31
22
32main :: IO ()
23main :: IO ()
33−main = do
24+-- You can either make your monad an instance of 'MonadHttp', or use
25+-- 'runReq' in any IO-enabled monad without defining new instances.
26+main = runReq defaultHttpConfig $ do
34− let payload = object
27+ let payload =
28+ object
35− [ "foo" .= (10 :: Int)
29+ [ "foo" .= (10 :: Int),
36− , "bar" .= (20 :: Int) ]
30+ "bar" .= (20 :: Int)
31+ ]
37− -- One function, full power and flexibility.
32+ -- One function—full power and flexibility, automatic retrying on timeouts
33+ -- and such, automatic connection sharing.
34+ r <-
35+ req
38− r <- req POST -- method
36+ POST -- method
39− (https "httpbin.org" /: "post") -- safe by construction URL
37+ (https "httpbin.org" /: "post") -- safe by construction URL
40− (ReqBodyJson payload) -- use built-in options or add your own
38+ (ReqBodyJson payload) -- use built-in options or add your own
41− jsonResponse -- specify how to interpret response
39+ jsonResponse -- specify how to interpret response
42− mempty -- query params, headers, explicit port number, etc.
40+ mempty -- query params, headers, explicit port number, etc.
43− print (responseBody r :: Value)
41+ liftIO $ print (responseBody r :: Value)
44```
42```
45
43
46−Req is an easy-to-use, type-safe, expandable, high-level HTTP library that
44+Req is an HTTP client library that attempts to be easy-to-use, type-safe,
47−just works without any fooling around.
45+and expandable.
48−
46+
49−What does the phrase “easy-to-use” mean? It means that the library is
47+“Easy-to-use” means that the library is designed to be beginner-friendly so
50−designed to be beginner-friendly so it's simple to add to your monad stack,
48+it's simple to add to your monad stack, intuitive to work with,
51−intuitive to work with, well-documented, and does not get in your way. Doing
49+well-documented, and does not get in your way. Doing HTTP requests is a
52−HTTP requests is a common task and a Haskell library for this should be very
50+common task and a Haskell library for this should be approachable and clear
53−approachable and clear to beginners, thus certain compromises were made. For
51+to beginners, thus certain compromises were made. For example, one cannot
54−example, one cannot currently modify `ManagerSettings` of the default
52+currently modify `ManagerSettings` of the default manager because the
55−manager because the library always uses the same implicit global manager for
53+library always uses the same implicit global manager for simplicity and
56−simplicity and maximal connection sharing. There is a way to use your own
54+maximal connection sharing. There is a way to use your own manager with
57−manager with different settings, but it requires a bit more typing.
55+different settings, but it requires more typing.
58−
56+
59−“Type-safe” means that the library is protective and eliminates certain
57+“Type-safe” means that the library tries to eliminate certain classes of
60−classes of errors. For example, we have correct-by-construction URLs, it's
58+errors. For example, we have correct-by-construction URLs; it is guaranteed
61−guaranteed that the user does not send the request body when using methods
59+that the user does not send the request body when using methods like GET or
62−like GET or OPTIONS, and the amount of implicit assumptions is minimized by
60+OPTIONS, and the amount of implicit assumptions is minimized by making the
63−making the user specify his/her intentions in and explicit form (for
61+user specify their intentions in an explicit form. For example, it's not
64−example, it's not possible to avoid specifying the body or method of a
62+possible to avoid specifying the body or the method of a request.
65−request). Authentication methods that assume TLS force the user to use TLS
63+Authentication methods that assume HTTPS force the user to use HTTPS at the
66−at the type level. The library also carefully hides underlying types from
64+type level.
67−the lower-level `http-client` package because those types are not safe
65+
68−enough (for example `Request` is an instance of `IsString` and, if it's
69−malformed, it will blow up at run-time).
70−
71−“Expandable” refers to the ability to create new components for dealing with
66+“Expandable” refers to the ability to create new components without having
72−HTTP without having to resort to ugly hacking. For example, it's possible to
67+to resort to hacking. For example, it's possible to define your own HTTP
73−define your own HTTP methods, create new ways to construct the body of a
68+methods, create new ways to construct the body of a request, create new
74−request, create new authorization options, perform a request in a different
69+authorization options, perform a request in a different way, and create your
75−way, and create your own methods to parse and represent a response. As a
70+own methods to parse a response.
76−user extends the library to satisfy his/her special needs, the new solutions
77−will work just like the built-ins. However, all of the common cases are also
78−covered by the library out-of-the-box.
79−
80−“High-level” means that there are less details to worry about. The library
81−is a result of my experiences as a Haskell consultant. Working for several
82−clients, who had very different projects, showed me that the library should
83−adapt easily to any particular style of writing Haskell applications. For
84−example, some people prefer throwing exceptions, while others are concerned
85−with purity. Just define `handleHttpException` accordingly when making your
86−monad instance of `MonadHttp` and it will play together seamlessly. Finally,
87−the library cuts boilerplate down considerably, and helps you write concise,
88−easy to read, and maintainable code.
89
71
90The library uses the following mature packages under the hood to guarantee
72The library uses the following mature packages under the hood to guarantee
91−you the best experience that doesn't have any bugs or other funny business:
73+you the best experience:
92
74
93−* [`http-client`](https://hackage.haskell.org/package/http-client) — low
75+* [`http-client`](https://hackage.haskell.org/package/http-client)—low level
94− level HTTP client used everywhere in Haskell.
76+ HTTP client used everywhere in Haskell.
77+* [`http-client-tls`](https://hackage.haskell.org/package/http-client-tls)—TLS
78+ (HTTPS) support for `http-client`.
95
79
96−* [`http-client-tls`](https://hackage.haskell.org/package/http-client-tls) —
97− TLS (HTTPS) support for `http-client`.
98−
99−It's important to note that since we leverage well-known libraries that the
80+It is important to note that since we leverage well-known libraries that the
100whole Haskell ecosystem uses, there is no risk in using Req. The machinery
81whole Haskell ecosystem uses, there is no risk in using Req. The machinery
101−for performing requests is the same as `http-conduit` and Wreq. The only
82+for performing requests is the same as with `http-conduit` and Wreq. The
102−difference is the API.
83+only difference is the API.
103−
104−## Motivation and Req vs other libraries
105−
106−*This section is my opinion and it contains criticisms of other well-known
107−libraries. If you're user/fan of one of these libraries, please remember not
108−to react aggressively and respect the fact that I may have different views
109−on API design from yours.*
110−
111−I have spent time to write the library because sending HTTP requests is such
112−a common thing and still there is no high-level library for that in Haskell
113−that I could use with pleasure. I'll explain why.
114−
115−First of all there is `http-client` and `http-client-tls`. They just work. I
116−have no issues with the libraries except that they are too low-level for my
117−taste. Indeed, even the docs say that they are low-level and “intended as a
118−base layer for more user-friendly packages”. This is exactly how I use them
119−in Req, as base level. Req is nothing but a different API to `http-client`,
120−so it only works because of hard work put into `http-client`.
121−
122−`http-conduit` definitely has its place. For one thing it allows you to
123−stream request and response bodies in constant memory, what other library
124−allows you to do that? On the other hand if you take a look at
125−`Network.HTTP.Simple`, then although it's said that it's a “higher level
126−API”, it's mostly the same as vanilla `http-client` in spirit/approach and
127−just adds `conduit`-powered functions to perform requests and allows to use
128−global implicit `Manager` (super-cool idea, BTW, Req does the same). If I
129−tried to frame what exactly I don't like about `http-conduit` in words, then
130−it would be “the way requests are constructed”. You set, set, set instead of
131−*being forced* to declare necessary bits and *being allowed* to declare
132−optional bits in a way that their combination is certainly valid. And you
133−parse request from a string without the protection of TH that otherwise
134−saves the day as in Yesod.
135−
136−Then there is Wreq.
137−`wreq`
138−[doesn't see much development lately](https://github.com/bos/wreq/issues/93).
139−`wreq` is by itself a weird library, IMO. You have functions per method —
140−not very good, as there may be new methods, like PATCH which is not new but
141−still missing (well you have `customMethod`, but what is the point of having
142−per-method functions if you have a more general way to use any method? you
143−should be able to just insert methods in the “argument slot” of
144−`customMethod` and end up with a more general solution). Now every method
145−function has a companion that takes `Options` (like you have `get` and
146−`getWith`). Why the duplication? Where is generality and flexibility? This
147−is not all though, because you cannot really use `get` you see in the main
148−module, because you want to have connection sharing. Wreq's author does not
149−take the gift of automatic connection re-use `Manager` from `http-client`
150−provides, he invents the whole new thing of “sessions”. Only inside a
151−session your connections will be shared and re-used. However with the
152−session stuff you have yet another set of per-method functions like `get`
153−and `getWith` — these are different ones, to be used with sessions! Now if
154−you have multi-threaded app, here is a surprise for you: you can't share
155−connections between threads as connections are shared only inside
156−`withSession` friend and “session will no longer be valid after that
157−function returns”. Disclaimer: I don't use Wreq, see below. If something in
158−this paragraph is not correct, please let me know and I'll remove it. Also
159−there are valid uses for sessions, but the point is that they are too
160−inconvenient for common tasks.
161−
162−It's funny that one client I worked for had to have his own little wrapper
163−around `http-client` just because he could not possibly use `wreq` and
164−`http-client` and friends were too low-level. The previous paragraph is
165−extracted from a talk with a Haskell developer who works for that client. I
166−thought to myself “something is wrong with HTTP client libraries in Haskell
167−if they had to make a wrapper”.
168−
169−What else? I used `servant-client` a couple of times but amount of
170−boilerplate is too high. If you have several query parameters, and you use
171−just one of them, good luck passing lots of `Nothing`s.
172−
173−## Unsolved problems
174−
175−AWS request signing is problematic because request body can be in form of
176−action to execute (and all that “popper” stuff for streaming), not just
177−`ByteString` and so getting its digest (hash) is not trivial without running
178−the action and consuming body in its entirety before the request in made. In
179−Wreq the author chose to just use `error` when body is not a (strict or
180−lazy) `ByteString`. Maybe it's OK for Wreq, but I don't consider this proper
181−solution for Req as we support full variety of body options. For example
182−what if I want to upload 1 Gb file to S3? I want to stream it in constant
183−memory but at the same time I need to calculate its hash before I start
184−streaming. One solution to the problem seems to be in taking the hash
185−explicitly (as an argument of hypothetical `awsAuth`) and making it
186−responsibility of library user to calculate the hash correctly. I don't like
187−this because it's not user-friendly. So the question stays open, for now
188−there is no AWS signing functionality provided out-of-the-box.
189
84
190## Related packages
85## Related packages
191
86
192The following packages are designed to be used with Req:
87The following packages are designed to be used with Req:
193
88
194−* [`req-conduit`](https://hackage.haskell.org/package/req-conduit) — support
89+* [`req-conduit`](https://hackage.haskell.org/package/req-conduit)—support
195 for streaming request and response bodies in constant memory.
90 for streaming request and response bodies in constant memory.
196
91
197If you happen to have written a package that adds new features to Req,
92If you happen to have written a package that adds new features to Req,
198please submit a PR to include it in this list.
93please submit a PR to include it in this list.
199
94
95+## Blog posts
96+
97+* [Req 1.0.0, HTTP client, and streaming](https://markkarpov.com/post/req-1.0.0-http-client-and-streaming.html)
98+
200## Contribution
99## Contribution
201
100
202Issues, bugs, and questions may be reported in [the GitHub issue tracker for
101Issues, bugs, and questions may be reported in [the GitHub issue tracker for
203this project](https://github.com/mrkkrp/req/issues).
102this project](https://github.com/mrkkrp/req/issues).
204
103
205−Pull requests are also welcome and will be reviewed quickly.
104+Pull requests are also welcome.
206
105
207## License
106## License
208
107
209−Copyright © 2016–2017 Mark Karpov
108+Copyright © 2016–present Mark Karpov
210
109
211Distributed under BSD 3 clause license.
110Distributed under BSD 3 clause license.
Setup.hsdeleted−6
@@ -1,6 +0,0 @@
1−module Main (main) where
2−
3−import Distribution.Simple
4−
5−main :: IO ()
6−main = defaultMain
cabal.projectnew file+4
@@ -0,0 +1,4 @@
1+packages: .
2+tests: True
3+benchmarks: True
4+constraints: req +dev
httpbin-tests/Network/HTTP/ReqSpec.hs+346−250
@@ -1,86 +1,48 @@
1−--
2−-- Tests for ‘req’ package. This test suite tests sending actual requests
3−-- using the <https://httpbin.org> service.
4−--
5−-- Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org>
6−--
7−-- Redistribution and use in source and binary forms, with or without
8−-- modification, are permitted provided that the following conditions are
9−-- met:
10−--
11−-- * Redistributions of source code must retain the above copyright notice,
12−-- this list of conditions and the following disclaimer.
13−--
14−-- * Redistributions in binary form must reproduce the above copyright
15−-- notice, this list of conditions and the following disclaimer in the
16−-- documentation and/or other materials provided with the distribution.
17−--
18−-- * Neither the name Mark Karpov nor the names of contributors may be used
19−-- to endorse or promote products derived from this software without
20−-- specific prior written permission.
21−--
22−-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY
23−-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
24−-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
25−-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY
26−-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
27−-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
28−-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
29−-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
30−-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31−-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32−-- POSSIBILITY OF SUCH DAMAGE.
33−
34−{-# LANGUAGE CPP #-}
35−{-# LANGUAGE DataKinds #-}
1+{-# LANGUAGE DataKinds #-}
36−{-# LANGUAGE FlexibleInstances #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE LambdaCase #-}
37−{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE OverloadedStrings #-}
38−{-# LANGUAGE RankNTypes #-}
5+{-# LANGUAGE RankNTypes #-}
39{-# OPTIONS_GHC -fno-warn-orphans #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
40
7
41−module Network.HTTP.ReqSpec
8+module Network.HTTP.ReqSpec (spec) where
42− ( spec )
9+
43−where
44−
45−import Control.Exception (throwIO)
10+import Control.Exception
11+import Control.Monad (forM_)
46−import Control.Monad.Reader
12+import Control.Monad.Trans.Control
47−import Data.Aeson (Value (..), ToJSON (..), object, (.=))
13+import Data.Aeson (ToJSON (..), Value (..), object, (.=))
48−import Data.Default.Class
14+import Data.Aeson qualified as A
49−import Data.Monoid ((<>))
15+import Data.Aeson.KeyMap qualified as Aeson.KeyMap
16+import Data.ByteString qualified as B
17+import Data.ByteString.Lazy qualified as BL
18+import Data.Functor.Identity (runIdentity)
19+import Data.Maybe (fromJust)
50import Data.Proxy
20import Data.Proxy
51import Data.Text (Text)
21import Data.Text (Text)
22+import Data.Text qualified as T
23+import Data.Text.Encoding qualified as T
24+import Data.Text.IO qualified as TIO
25+import Network.HTTP.Client qualified as L
26+import Network.HTTP.Client.MultipartFormData qualified as LM
27+import Network.HTTP.Req hiding (req)
52−import Network.HTTP.Req
28+import Network.HTTP.Req qualified as Req
29+import Network.HTTP.Types qualified as Y
53import Test.Hspec
30import Test.Hspec
54import Test.QuickCheck
31import Test.QuickCheck
55−import qualified Data.Aeson as A
56−import qualified Data.ByteString as B
57−import qualified Data.ByteString.Lazy as BL
58−import qualified Data.HashMap.Strict as HM
59−import qualified Data.Text as T
60−import qualified Data.Text.Encoding as T
61−import qualified Data.Text.IO as TIO
62−import qualified Network.HTTP.Client as L
63−import qualified Network.HTTP.Client.MultipartFormData as LM
64−import qualified Network.HTTP.Types as Y
65−
66−#if !MIN_VERSION_base(4,8,0)
67−import Data.Monoid (mempty)
68−import Data.Word (Word)
69−#endif
70
32
71spec :: Spec
33spec :: Spec
72spec = do
34spec = do
73−
74− describe "exception throwing on non 2xx-status codes" $
35+ describe "exception throwing on non-2xx status codes" $
75− it "throws indeed for non-2xx" $ do
36+ it "throws indeed for non-2xx" $
76− let selector :: HttpException -> Bool
77− selector (VanillaHttpException
78− (L.HttpExceptionRequest _
79− (L.StatusCodeException response chunk))) =
80− L.responseStatus response == Y.status404 && not (B.null chunk)
81− selector _ = False
82 req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
37 req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
83− `shouldThrow` selector
38+ `shouldThrow` selector404
39+
40+ describe "exception throwing on non-2xx status codes (Req monad)" $
41+ it "throws indeed for non-2xx" $
42+ asIO . runReq defaultHttpConfig $
43+ liftBaseWith $ \run ->
44+ run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)
45+ `shouldThrow` selector404
84
46
85 describe "response check via httpConfigCheckResponse" $
47 describe "response check via httpConfigCheckResponse" $
86 context "if it's set to always throw" $
48 context "if it's set to always throw" $
@@ -88,41 +50,61 @@ spec = do
88 blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)
50 blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)
89 `shouldThrow` anyException
51 `shouldThrow` anyException
90
52
53+ describe "isStatusCodeException" $
54+ it "extracts non-2xx response" $
55+ req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
56+ `shouldThrow` selector404ByStatusCodeException
57+
91 describe "receiving user-agent header back" $
58 describe "receiving user-agent header back" $
92 it "works" $ do
59 it "works" $ do
60+ r <-
61+ req
62+ GET
93− r <- req GET (httpbin /: "user-agent")
63+ (httpbin /: "user-agent")
64+ NoReqBody
65+ jsonResponse
94− NoReqBody jsonResponse (header "user-agent" "Req")
66+ (header "user-agent" "Req")
67+ responseBody r
95− responseBody r `shouldBe` object
68+ `shouldBe` object
96− ["user-agent" .= ("Req" :: Text)]
69+ ["user-agent" .= ("Req" :: Text)]
97− responseStatusCode r `shouldBe` 200
70+ responseStatusCode r `shouldBe` 200
98 responseStatusMessage r `shouldBe` "OK"
71 responseStatusMessage r `shouldBe` "OK"
99
72
100 describe "receiving request headers back" $
73 describe "receiving request headers back" $
101 it "works" $ do
74 it "works" $ do
75+ r <-
76+ req
77+ GET
102− r <- req GET (httpbin /: "headers")
78+ (httpbin /: "headers")
79+ NoReqBody
80+ jsonResponse
103− NoReqBody jsonResponse (header "Foo" "bar" <> header "Baz" "quux")
81+ (header "Foo" "bar" <> header "Baz" "quux")
104− stripFunnyHeaders (responseBody r) `shouldBe` object
82+ stripFunnyHeaders (responseBody r)
83+ `shouldBe` object
105− [ "headers" .= object
84+ [ "headers"
85+ .= object
106− [ "Accept-Encoding" .= ("gzip" :: Text)
86+ [ "Accept-Encoding" .= ("gzip" :: Text),
107− , "Connection" .= ("close" :: Text)
108− , "Foo" .= ("bar" :: Text)
87+ "Foo" .= ("bar" :: Text),
109− , "Baz" .= ("quux" :: Text)
88+ "Baz" .= ("quux" :: Text)
110− , "Host" .= ("httpbin.org" :: Text) ] ]
89+ ]
90+ ]
111− responseStatusCode r `shouldBe` 200
91+ responseStatusCode r `shouldBe` 200
112 responseStatusMessage r `shouldBe` "OK"
92 responseStatusMessage r `shouldBe` "OK"
113
93
114 describe "receiving GET data back" $
94 describe "receiving GET data back" $
115 it "works" $ do
95 it "works" $ do
116 r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty
96 r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty
117− (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
97+ (stripFunnyHeaders . stripOrigin) (responseBody r)
98+ `shouldBe` object
118− [ "args" .= emptyObject
99+ [ "args" .= emptyObject,
119− , "url" .= ("https://httpbin.org/get" :: Text)
100+ "url" .= ("http://localhost:1234/get" :: Text),
120− , "headers" .= object
101+ "headers"
102+ .= object
121− [ "Accept-Encoding" .= ("gzip" :: Text)
103+ [ "Accept-Encoding" .= ("gzip" :: Text)
122− , "Connection" .= ("close" :: Text)
104+ ]
123− , "Host" .= ("httpbin.org" :: Text) ] ]
105+ ]
124 responseHeader r "Content-Type" `shouldBe` return "application/json"
106 responseHeader r "Content-Type" `shouldBe` return "application/json"
125− responseStatusCode r `shouldBe` 200
107+ responseStatusCode r `shouldBe` 200
126 responseStatusMessage r `shouldBe` "OK"
108 responseStatusMessage r `shouldBe` "OK"
127
109
128 describe "receiving POST JSON data back" $
110 describe "receiving POST JSON data back" $
@@ -130,49 +112,55 @@ spec = do
130 let text = "foo" :: Text
112 let text = "foo" :: Text
131 reflected = reflectJSON text
113 reflected = reflectJSON text
132 r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty
114 r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty
133− (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
115+ (stripFunnyHeaders . stripOrigin) (responseBody r)
116+ `shouldBe` object
134− [ "args" .= emptyObject
117+ [ "args" .= emptyObject,
135− , "json" .= text
118+ "json" .= text,
136− , "data" .= reflected
119+ "data" .= reflected,
137− , "url" .= ("https://httpbin.org/post" :: Text)
120+ "url" .= ("http://localhost:1234/post" :: Text),
138− , "headers" .= object
121+ "headers"
122+ .= object
139− [ "Content-Type" .= ("application/json; charset=utf-8" :: Text)
123+ [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),
140− , "Accept-Encoding" .= ("gzip" :: Text)
124+ "Accept-Encoding" .= ("gzip" :: Text),
141− , "Connection" .= ("close" :: Text)
142− , "Host" .= ("httpbin.org" :: Text)
143− , "Content-Length" .= show (T.length reflected) ]
125+ "Content-Length" .= show (T.length reflected)
126+ ],
144− , "files" .= emptyObject
127+ "files" .= emptyObject,
145− , "form" .= emptyObject ]
128+ "form" .= emptyObject
129+ ]
146 responseHeader r "Content-Type" `shouldBe` return "application/json"
130 responseHeader r "Content-Type" `shouldBe` return "application/json"
147− responseStatusCode r `shouldBe` 200
131+ responseStatusCode r `shouldBe` 200
148 responseStatusMessage r `shouldBe` "OK"
132 responseStatusMessage r `shouldBe` "OK"
149
133
150 describe "receiving POST data back (multipart form data)" $
134 describe "receiving POST data back (multipart form data)" $
151 it "works" $ do
135 it "works" $ do
136+ body <-
152− body <- reqBodyMultipart
137+ reqBodyMultipart
153− [ LM.partBS "foo" "foo data!"
138+ [ LM.partBS "foo" "foo data!",
154− , LM.partBS "bar" "bar data!" ]
139+ LM.partBS "bar" "bar data!"
140+ ]
155 r <- req POST (httpbin /: "post") body jsonResponse mempty
141 r <- req POST (httpbin /: "post") body jsonResponse mempty
156− let Just contentType = getRequestContentType body
142+ let contentType = fromJust (getRequestContentType body)
157− (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
143+ (stripFunnyHeaders . stripOrigin) (responseBody r)
144+ `shouldBe` object
158− [ "args" .= emptyObject
145+ [ "args" .= emptyObject,
159− , "json" .= Null
146+ "json" .= Null,
160− , "data" .= ("" :: Text)
147+ "data" .= ("" :: Text),
161− , "url" .= ("https://httpbin.org/post" :: Text)
148+ "url" .= ("http://localhost:1234/post" :: Text),
162− , "headers" .= object
149+ "headers"
150+ .= object
163− [ "Content-Type" .= T.decodeUtf8 contentType
151+ [ "Content-Type" .= T.decodeUtf8 contentType,
164− , "Accept-Encoding" .= ("gzip" :: Text)
152+ "Accept-Encoding" .= ("gzip" :: Text),
165− , "Connection" .= ("close" :: Text)
166− , "Host" .= ("httpbin.org" :: Text)
167− , "Content-Length" .= ("242" :: Text)
153+ "Content-Length" .= ("242" :: Text)
154+ ],
155+ "files" .= emptyObject,
156+ "form"
157+ .= object
158+ [ "foo" .= ("foo data!" :: Text),
159+ "bar" .= ("bar data!" :: Text)
160+ ]
168 ]
161 ]
169− , "files" .= emptyObject
170− , "form" .= object
171− [ "foo" .= ("foo data!" :: Text)
172− , "bar" .= ("bar data!" :: Text) ]
173− ]
174 responseHeader r "Content-Type" `shouldBe` return "application/json"
162 responseHeader r "Content-Type" `shouldBe` return "application/json"
175− responseStatusCode r `shouldBe` 200
163+ responseStatusCode r `shouldBe` 200
176 responseStatusMessage r `shouldBe` "OK"
164 responseStatusMessage r `shouldBe` "OK"
177
165
178 describe "receiving PATCHed file back" $
166 describe "receiving PATCHed file back" $
@@ -181,76 +169,108 @@ spec = do
181 file = "httpbin-data/robots.txt"
169 file = "httpbin-data/robots.txt"
182 contents <- TIO.readFile file
170 contents <- TIO.readFile file
183 r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty
171 r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty
184− (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
172+ (stripFunnyHeaders . stripOrigin) (responseBody r)
173+ `shouldBe` object
185− [ "args" .= emptyObject
174+ [ "args" .= emptyObject,
186− , "json" .= Null
175+ "json" .= Null,
187− , "data" .= contents
176+ "data" .= contents,
188− , "url" .= ("https://httpbin.org/patch" :: Text)
177+ "url" .= ("http://localhost:1234/patch" :: Text),
189− , "headers" .= object
178+ "headers"
179+ .= object
190− [ "Accept-Encoding" .= ("gzip" :: Text)
180+ [ "Accept-Encoding" .= ("gzip" :: Text),
191− , "Connection" .= ("close" :: Text)
192− , "Host" .= ("httpbin.org" :: Text)
193− , "Content-Length" .= show (T.length contents) ]
181+ "Content-Length" .= show (T.length contents)
182+ ],
194− , "files" .= emptyObject
183+ "files" .= emptyObject,
195− , "form" .= emptyObject ]
184+ "form" .= emptyObject
185+ ]
196 responseHeader r "Content-Type" `shouldBe` return "application/json"
186 responseHeader r "Content-Type" `shouldBe` return "application/json"
197− responseStatusCode r `shouldBe` 200
187+ responseStatusCode r `shouldBe` 200
198 responseStatusMessage r `shouldBe` "OK"
188 responseStatusMessage r `shouldBe` "OK"
199
189
200 describe "receiving PUT form URL-encoded data back" $
190 describe "receiving PUT form URL-encoded data back" $
201 it "works" $ do
191 it "works" $ do
192+ let params =
202− let params = "foo" =: ("bar" :: Text) <>
193+ "foo" =: ("bar" :: Text)
203− "baz" =: (5 :: Int) <>
194+ <> "baz" =: (5 :: Int)
204− queryFlag "quux"
195+ <> queryFlag "quux"
205 r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty
196 r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty
206− (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
197+ (stripFunnyHeaders . stripOrigin) (responseBody r)
198+ `shouldBe` object
207− [ "args" .= emptyObject
199+ [ "args" .= emptyObject,
208− , "json" .= Null
200+ "json" .= Null,
209− , "data" .= ("" :: Text)
201+ "data" .= ("" :: Text),
210− , "url" .= ("https://httpbin.org/put" :: Text)
202+ "url" .= ("http://localhost:1234/put" :: Text),
211− , "headers" .= object
203+ "headers"
204+ .= object
212− [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text)
205+ [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),
213− , "Accept-Encoding" .= ("gzip" :: Text)
206+ "Accept-Encoding" .= ("gzip" :: Text),
214− , "Connection" .= ("close" :: Text)
215− , "Host" .= ("httpbin.org" :: Text)
216− , "Content-Length" .= ("18" :: Text) ]
207+ "Content-Length" .= ("18" :: Text)
208+ ],
217− , "files" .= emptyObject
209+ "files" .= emptyObject,
210+ "form"
218− , "form" .= object
211+ .= object
219− [ "foo" .= ("bar" :: Text)
212+ [ "foo" .= ("bar" :: Text),
220− , "baz" .= ("5" :: Text)
213+ "baz" .= ("5" :: Text),
221− , "quux" .= ("" :: Text) ] ]
214+ "quux" .= ("" :: Text)
215+ ]
216+ ]
222 responseHeader r "Content-Type" `shouldBe` return "application/json"
217 responseHeader r "Content-Type" `shouldBe` return "application/json"
223− responseStatusCode r `shouldBe` 200
218+ responseStatusCode r `shouldBe` 200
224 responseStatusMessage r `shouldBe` "OK"
219 responseStatusMessage r `shouldBe` "OK"
225
220
226 -- TODO /delete
221 -- TODO /delete
227
222
228 describe "receiving UTF-8 encoded Unicode data" $
223 describe "receiving UTF-8 encoded Unicode data" $
229 it "works" $ do
224 it "works" $ do
225+ r <-
226+ req
227+ GET
230− r <- req GET (httpbin /: "encoding" /: "utf8")
228+ (httpbin /: "encoding" /: "utf8")
229+ NoReqBody
231− NoReqBody bsResponse mempty
230+ bsResponse
231+ mempty
232 utf8data <- B.readFile "httpbin-data/utf8.html"
232 utf8data <- B.readFile "httpbin-data/utf8.html"
233− responseBody r `shouldBe` utf8data
233+ responseBody r `shouldBe` utf8data
234− responseStatusCode r `shouldBe` 200
234+ responseStatusCode r `shouldBe` 200
235 responseStatusMessage r `shouldBe` "OK"
235 responseStatusMessage r `shouldBe` "OK"
236
236
237 -- TODO /gzip
237 -- TODO /gzip
238 -- TODO /deflate
238 -- TODO /deflate
239
239
240+ describe "retrying" $
241+ it "retries as many times as specified" $ do
242+ -- FIXME We no longer can count retries because all the functions
243+ -- responsible for controlling retrying are pure now.
244+ let status = 408 :: Int
245+ r <-
246+ prepareForShit $
247+ req
248+ GET
249+ (httpbin /: "status" /~ status)
250+ NoReqBody
251+ ignoreResponse
252+ mempty
253+ responseStatusCode r `shouldBe` status
254+
240− forM_ [101..102] checkStatusCode
255+ -- forM_ [101..102] checkStatusCode
241− forM_ [200..208] checkStatusCode
256+ forM_ [200 .. 208] checkStatusCode
242 -- forM_ [300..308] checkStatusCode
257 -- forM_ [300..308] checkStatusCode
243− forM_ [400..431] checkStatusCode
258+ forM_ [400 .. 431] checkStatusCode
244− forM_ [500..511] checkStatusCode
259+ forM_ [500 .. 511] checkStatusCode
245
260
246 -- TODO /response-headers
261 -- TODO /response-headers
247 -- TODO /redirect
262 -- TODO /redirect
248
263
249 describe "redirects" $
264 describe "redirects" $
250 it "follows redirects" $ do
265 it "follows redirects" $ do
266+ r <-
267+ req
268+ GET
251− r <- req GET (httpbin /: "redirect-to") NoReqBody ignoreResponse
269+ (httpbin /: "redirect-to")
270+ NoReqBody
271+ ignoreResponse
252− ("url" =: ("https://httpbin.org" :: Text))
272+ ("url" =: ("https://httpbin.org" :: Text))
253− responseStatusCode r `shouldBe` 200
273+ responseStatusCode r `shouldBe` 200
254 responseStatusMessage r `shouldBe` "OK"
274 responseStatusMessage r `shouldBe` "OK"
255
275
256 -- TODO /relative-redicet
276 -- TODO /relative-redicet
@@ -259,21 +279,30 @@ spec = do
259
279
260 describe "basicAuth" $ do
280 describe "basicAuth" $ do
261 let user, password :: Text
281 let user, password :: Text
262− user = "Scooby"
282+ user = "Scooby"
263 password = "Doo"
283 password = "Doo"
264 context "when we do not send appropriate basic auth data" $
284 context "when we do not send appropriate basic auth data" $
265 it "fails with 401" $ do
285 it "fails with 401" $ do
286+ r <-
266− r <- prepareForShit $ req GET
287+ prepareForShit $
288+ req
289+ GET
267− (httpbin /: "basic-auth" /~ user /~ password)
290+ (httpbin /: "basic-auth" /~ user /~ password)
291+ NoReqBody
268− NoReqBody ignoreResponse mempty
292+ ignoreResponse
293+ mempty
269− responseStatusCode r `shouldBe` 401
294+ responseStatusCode r `shouldBe` 401
270 responseStatusMessage r `shouldBe` "UNAUTHORIZED"
295 responseStatusMessage r `shouldBe` "UNAUTHORIZED"
271 context "when we provide appropriate basic auth data" $
296 context "when we provide appropriate basic auth data" $
272 it "succeeds" $ do
297 it "succeeds" $ do
298+ r <-
299+ req
300+ GET
273− r <- req GET (httpbin /: "basic-auth" /~ user /~ password)
301+ (httpbin /: "basic-auth" /~ user /~ password)
302+ NoReqBody
274− NoReqBody ignoreResponse
303+ ignoreResponse
275− (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))
304+ (basicAuthUnsafe (T.encodeUtf8 user) (T.encodeUtf8 password))
276− responseStatusCode r `shouldBe` 200
305+ responseStatusCode r `shouldBe` 200
277 responseStatusMessage r `shouldBe` "OK"
306 responseStatusMessage r `shouldBe` "OK"
278
307
279 -- TODO /hidden-basic-auth
308 -- TODO /hidden-basic-auth
@@ -288,8 +317,8 @@ spec = do
288 it "works" $ do
317 it "works" $ do
289 r <- req GET (httpbin /: "robots.txt") NoReqBody bsResponse mempty
318 r <- req GET (httpbin /: "robots.txt") NoReqBody bsResponse mempty
290 robots <- B.readFile "httpbin-data/robots.txt"
319 robots <- B.readFile "httpbin-data/robots.txt"
291− responseBody r `shouldBe` robots
320+ responseBody r `shouldBe` robots
292− responseStatusCode r `shouldBe` 200
321+ responseStatusCode r `shouldBe` 200
293 responseStatusMessage r `shouldBe` "OK"
322 responseStatusMessage r `shouldBe` "OK"
294
323
295 -- TODO /deny
324 -- TODO /deny
@@ -300,10 +329,15 @@ spec = do
300 property $ \n' -> do
329 property $ \n' -> do
301 let n :: Word
330 let n :: Word
302 n = getSmall n'
331 n = getSmall n'
332+ r <-
333+ req
334+ GET
303− r <- req GET (httpbin /: "bytes" /~ n)
335+ (httpbin /: "bytes" /~ n)
336+ NoReqBody
304− NoReqBody lbsResponse mempty
337+ lbsResponse
338+ mempty
305 responseBody r `shouldSatisfy` ((== n) . fromIntegral . BL.length)
339 responseBody r `shouldSatisfy` ((== n) . fromIntegral . BL.length)
306− responseStatusCode r `shouldBe` 200
340+ responseStatusCode r `shouldBe` 200
307 responseStatusMessage r `shouldBe` "OK"
341 responseStatusMessage r `shouldBe` "OK"
308 context "when we try to interpret 1000 random bytes as JSON" $
342 context "when we try to interpret 1000 random bytes as JSON" $
309 it "throws correct exception" $ do
343 it "throws correct exception" $ do
@@ -312,29 +346,38 @@ spec = do
312 selector _ = False
346 selector _ = False
313 n :: Int
347 n :: Int
314 n = 1000
348 n = 1000
349+ req
350+ GET
315− req GET (httpbin /: "bytes" /~ n) NoReqBody
351+ (httpbin /: "bytes" /~ n)
352+ NoReqBody
316− (Proxy :: Proxy (JsonResponse Value)) mempty
353+ (Proxy :: Proxy (JsonResponse Value))
354+ mempty
317− `shouldThrow` selector
355+ `shouldThrow` selector
318
356
319 describe "streaming random bytes" $
357 describe "streaming random bytes" $
320 it "works" $
358 it "works" $
321 property $ \n' -> do
359 property $ \n' -> do
322 let n :: Word
360 let n :: Word
323 n = getSmall n'
361 n = getSmall n'
362+ r <-
363+ req
364+ GET
324− r <- req GET (httpbin /: "stream-bytes" /~ n)
365+ (httpbin /: "stream-bytes" /~ n)
366+ NoReqBody
325− NoReqBody bsResponse mempty
367+ bsResponse
368+ mempty
326 responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)
369 responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)
327− responseStatusCode r `shouldBe` 200
370+ responseStatusCode r `shouldBe` 200
328 responseStatusMessage r `shouldBe` "OK"
371 responseStatusMessage r `shouldBe` "OK"
329
372
330− -- TODO /links
373+-- TODO /links
331− -- TODO /image
374+-- TODO /image
332− -- TODO /image/png
375+-- TODO /image/png
333− -- TODO /image/jpeg
376+-- TODO /image/jpeg
334− -- TODO /image/webp
377+-- TODO /image/webp
335− -- TODO /image/svg
378+-- TODO /image/svg
336− -- TODO /forms/post
379+-- TODO /forms/post
337− -- TODO /xml
380+-- TODO /xml
338
381
339----------------------------------------------------------------------------
382----------------------------------------------------------------------------
340-- Instances
383-- Instances
@@ -342,75 +385,128 @@ spec = do
342instance MonadHttp IO where
385instance MonadHttp IO where
343 handleHttpException = throwIO
386 handleHttpException = throwIO
344
387
345−instance MonadHttp (ReaderT HttpConfig IO) where
346− handleHttpException = liftIO . throwIO
347− getHttpConfig = ask
348−
349----------------------------------------------------------------------------
388----------------------------------------------------------------------------
350-- Helpers
389-- Helpers
351
390
352−-- | Run request with such settings that it does not signal error on adverse
391+-- | Run a request with such settings that it does not signal errors.
353−-- response status codes.
354−
355−prepareForShit
392+prepareForShit :: Req a -> IO a
356− :: (forall m. MonadHttp m => m a)
357− -> IO a
358−prepareForShit m = runReaderT m def { httpConfigCheckResponse = noNoise }
393+prepareForShit = runReq defaultHttpConfig {httpConfigCheckResponse = noNoise}
394+ where
359− where noNoise _ _ = return ()
395+ noNoise _ _ _ = Nothing
360−
361−-- | Run request with such settings that it throws on any response.
362
396
363−blindlyThrowing
397+-- | Run a request with such settings that it throws on any response.
364− :: (forall m. MonadHttp m => m a)
398+blindlyThrowing :: Req a -> IO a
365− -> IO a
366−blindlyThrowing m = runReaderT m def { httpConfigCheckResponse = doit }
399+blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}
400+ where
367− where doit _ _ = error "Oops!"
401+ doit _ _ = error "Oops!"
368
402
369-- | 'Url' representing <https://httpbin.org>.
403-- | 'Url' representing <https://httpbin.org>.
370−
371−httpbin :: Url 'Https
404+httpbin :: Url 'Http
372−httpbin = https "httpbin.org"
405+httpbin = http "localhost"
406+
407+req ::
408+ ( MonadHttp m,
409+ HttpMethod method,
410+ HttpBody body,
411+ HttpResponse response,
412+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
413+ ) =>
414+ method ->
415+ Url scheme ->
416+ body ->
417+ Proxy response ->
418+ Option scheme ->
419+ m response
420+req method url body responseProxy options =
421+ Req.req method url body responseProxy (options <> defaultOptions)
422+
423+-- | Options to apply by default.
424+defaultOptions :: Option scheme
425+defaultOptions = port 1234
373
426
374-- | Remove “origin” field from JSON value. Origin may change, we don't want
427-- | Remove “origin” field from JSON value. Origin may change, we don't want
375-- to depend on that.
428-- to depend on that.
376−
377stripOrigin :: Value -> Value
429stripOrigin :: Value -> Value
378−stripOrigin (Object m) = Object (HM.delete "origin" m)
430+stripOrigin (Object m) = Object (Aeson.KeyMap.delete "origin" m)
379−stripOrigin value = value
431+stripOrigin value = value
380
432
381-- | Remove funny headers that might break the tests.
433-- | Remove funny headers that might break the tests.
382−
383stripFunnyHeaders :: Value -> Value
434stripFunnyHeaders :: Value -> Value
384−stripFunnyHeaders (Object m) =
435+stripFunnyHeaders = \case
385− let f (Object p) = Object $ HM.filterWithKey (\k _ -> k `elem` hs) p
436+ Object m ->
437+ Object
438+ ( runIdentity
439+ ( Aeson.KeyMap.alterF
440+ (pure . fmap stripFunnyHeaders')
441+ "headers"
442+ m
443+ )
444+ )
445+ value -> value
446+
447+-- | Similar to 'stripFunnyHeaders', but acts directly on the argument
448+-- without trying to access its "headers" field.
449+stripFunnyHeaders' :: Value -> Value
450+stripFunnyHeaders' = \case
451+ Object p ->
452+ Object $
453+ Aeson.KeyMap.filterWithKey
454+ (\k _ -> k `elem` whitelistedHeaders)
455+ p
386− f value = value
456+ value -> value
457+ where
458+ whitelistedHeaders =
387− hs = [ "Content-Type"
459+ [ "Content-Type",
388− , "Accept-Encoding"
460+ "Accept-Encoding",
389− , "Connection"
390− , "Host"
391− , "Content-Length"
461+ "Content-Length",
392− , "Foo"
462+ "Foo",
393− , "Baz" ]
463+ "Baz"
394− in Object (HM.adjust f "headers" m)
464+ ]
395−stripFunnyHeaders value = value
396
465
397-- | This is a complete test case that makes use of <https://httpbin.org> to
466-- | This is a complete test case that makes use of <https://httpbin.org> to
398-- get various response status codes.
467-- get various response status codes.
399−
400checkStatusCode :: Int -> SpecWith ()
468checkStatusCode :: Int -> SpecWith ()
401checkStatusCode code =
469checkStatusCode code =
402 describe ("receiving status code " ++ show code) $
470 describe ("receiving status code " ++ show code) $
403 it "works" $ do
471 it "works" $ do
472+ r <-
473+ prepareForShit $
474+ req
475+ GET
404− r <- prepareForShit $ req GET (httpbin /: "status" /~ code)
476+ (httpbin /: "status" /~ code)
477+ NoReqBody
405− NoReqBody ignoreResponse mempty
478+ ignoreResponse
479+ mempty
406 responseStatusCode r `shouldBe` code
480 responseStatusCode r `shouldBe` code
407
481
482+-- | Exception selector that selects only 404 “Not found” exceptions.
483+selector404 :: HttpException -> Bool
484+selector404
485+ ( VanillaHttpException
486+ ( L.HttpExceptionRequest
487+ _
488+ (L.StatusCodeException response chunk)
489+ )
490+ ) =
491+ L.responseStatus response == Y.status404 && not (B.null chunk)
492+selector404 _ = False
493+
494+-- | Same as 'selector404' except that it uses 'isStatusCodeException'.
495+selector404ByStatusCodeException :: HttpException -> Bool
496+selector404ByStatusCodeException e =
497+ case isStatusCodeException e of
498+ Nothing -> False
499+ Just r -> responseStatusCode r == 404
500+
408−-- | Empty JSON 'Object'.
501+-- | The empty JSON 'Object'.
409−
410emptyObject :: Value
502emptyObject :: Value
411−emptyObject = Object HM.empty
503+emptyObject = Object Aeson.KeyMap.empty
412
504
413−-- | Get rendered JSON value as 'Text'.
505+-- | Get a rendered JSON value as 'Text'.
414−
415−reflectJSON :: ToJSON a => a -> Text
506+reflectJSON :: (ToJSON a) => a -> Text
416reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode
507reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode
508+
509+-- | Clarify to the type checker that the inner computation is in the 'IO'
510+-- monad.
511+asIO :: IO a -> IO a
512+asIO = id
pure-tests/Network/HTTP/ReqSpec.hs+384−216
@@ -1,102 +1,71 @@
1−--
2−-- Tests for ‘req’ package. This test suite tests correctness of constructed
3−-- requests.
4−--
5−-- Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org>
6−--
7−-- Redistribution and use in source and binary forms, with or without
8−-- modification, are permitted provided that the following conditions are
9−-- met:
10−--
11−-- * Redistributions of source code must retain the above copyright notice,
12−-- this list of conditions and the following disclaimer.
13−--
14−-- * Redistributions in binary form must reproduce the above copyright
15−-- notice, this list of conditions and the following disclaimer in the
16−-- documentation and/or other materials provided with the distribution.
17−--
18−-- * Neither the name Mark Karpov nor the names of contributors may be used
19−-- to endorse or promote products derived from this software without
20−-- specific prior written permission.
21−--
22−-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY
23−-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
24−-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
25−-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY
26−-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
27−-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
28−-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
29−-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
30−-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31−-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32−-- POSSIBILITY OF SUCH DAMAGE.
33−
34−{-# LANGUAGE CPP #-}
35−{-# LANGUAGE DataKinds #-}
1+{-# LANGUAGE DataKinds #-}
36−{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE DeriveGeneric #-}
37−{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE LambdaCase #-}
38−{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE QuasiQuotes #-}
39−{-# LANGUAGE RankNTypes #-}
7+{-# LANGUAGE RankNTypes #-}
40−{-# LANGUAGE RecordWildCards #-}
8+{-# LANGUAGE RecordWildCards #-}
41−{-# LANGUAGE ScopedTypeVariables #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TypeApplications #-}
11+{-# LANGUAGE NoMonomorphismRestriction #-}
42{-# OPTIONS_GHC -fno-warn-orphans #-}
12{-# OPTIONS_GHC -fno-warn-orphans #-}
43
13
44−#if __GLASGOW_HASKELL__ < 710
45−{-# LANGUAGE ConstraintKinds #-}
46−#endif
47−
48−module Network.HTTP.ReqSpec
14+module Network.HTTP.ReqSpec (spec) where
49− ( spec )
50−where
51
15
16+import Blaze.ByteString.Builder qualified as BB
52import Control.Exception (throwIO)
17import Control.Exception (throwIO)
53−import Control.Monad.Reader
18+import Control.Monad
19+import Control.Retry
54import Data.Aeson (ToJSON (..))
20import Data.Aeson (ToJSON (..))
21+import Data.Aeson qualified as A
55import Data.ByteString (ByteString)
22import Data.ByteString (ByteString)
56−import Data.Maybe (isNothing, fromJust)
23+import Data.ByteString qualified as B
57−import Data.Monoid ((<>))
24+import Data.ByteString.Char8 qualified as B8
25+import Data.ByteString.Lazy qualified as BL
26+import Data.CaseInsensitive qualified as CI
27+import Data.Either (isRight)
28+import Data.List.NonEmpty qualified as NE
29+import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
58import Data.Proxy
30import Data.Proxy
59import Data.Text (Text)
31import Data.Text (Text)
32+import Data.Text qualified as T
33+import Data.Text.Encoding qualified as T
60import Data.Time
34import Data.Time
35+import Data.Typeable (Typeable, eqT)
36+import GHC.Exts (IsList (..))
61import GHC.Generics
37import GHC.Generics
38+import Language.Haskell.TH qualified as TH
39+import Language.Haskell.TH.Quote qualified as TH
40+import Network.HTTP.Client qualified as L
62import Network.HTTP.Req
41import Network.HTTP.Req
42+import Network.HTTP.Types qualified as Y
43+import Network.HTTP.Types.Header qualified as Y
63import Test.Hspec
44import Test.Hspec
64import Test.Hspec.Core.Spec (SpecM)
45import Test.Hspec.Core.Spec (SpecM)
65import Test.QuickCheck
46import Test.QuickCheck
66−import qualified Blaze.ByteString.Builder as BB
47+import Text.URI (URI)
67−import qualified Data.Aeson as A
48+import Text.URI qualified as URI
68−import qualified Data.ByteString as B
49+import Text.URI.QQ qualified as QQ
69−import qualified Data.ByteString.Char8 as B8
50+import Web.FormUrlEncoded qualified as F
70−import qualified Data.ByteString.Lazy as BL
71−import qualified Data.CaseInsensitive as CI
72−import qualified Data.Text as T
73−import qualified Data.Text.Encoding as T
74−import qualified Network.HTTP.Client as L
75−import qualified Network.HTTP.Types as Y
76−
77−#if !MIN_VERSION_base(4,8,0)
78−import Control.Applicative
79−import Data.Foldable (foldMap)
80−import Data.Monoid (mempty)
81−#endif
82
51
83spec :: Spec
52spec :: Spec
84spec = do
53spec = do
85−
86 describe "config" $
54 describe "config" $
87 it "getHttpConfig has effect on resulting request" $
55 it "getHttpConfig has effect on resulting request" $
88 property $ \config -> do
56 property $ \config -> do
89− request <- runReaderT (req_ GET url NoReqBody mempty) config
57+ request <- runReq config (req_ GET url NoReqBody mempty)
90− L.proxy request `shouldBe` httpConfigProxy config
58+ L.proxy request `shouldBe` httpConfigProxy config
91 L.redirectCount request `shouldBe` httpConfigRedirectCount config
59 L.redirectCount request `shouldBe` httpConfigRedirectCount config
92
60
93 describe "methods" $ do
61 describe "methods" $ do
94− let mnth
62+ let mnth ::
95− :: forall method.
63+ forall method.
96− ( HttpMethod method
64+ ( HttpMethod method,
97− , HttpBodyAllowed (AllowsBody method) 'NoBody )
65+ HttpBodyAllowed (AllowsBody method) 'NoBody
98− => method
66+ ) =>
67+ method ->
99− -> SpecM () ()
68+ SpecM () ()
100 mnth method = do
69 mnth method = do
101 let name = httpMethodName (Proxy :: Proxy method)
70 let name = httpMethodName (Proxy :: Proxy method)
102 describe (B8.unpack name) $
71 describe (B8.unpack name) $
@@ -119,15 +88,15 @@ spec = do
119 property $ \host -> do
88 property $ \host -> do
120 request <- req_ GET (http host) NoReqBody mempty
89 request <- req_ GET (http host) NoReqBody mempty
121 L.secure request `shouldBe` False
90 L.secure request `shouldBe` False
122− L.port request `shouldBe` 80
91+ L.port request `shouldBe` 80
123− L.host request `shouldBe` urlEncode host
92+ L.host request `shouldBe` urlEncode host
124 describe "https" $
93 describe "https" $
125 it "sets all the params correctly" $
94 it "sets all the params correctly" $
126 property $ \host -> do
95 property $ \host -> do
127 request <- req_ GET (https host) NoReqBody mempty
96 request <- req_ GET (https host) NoReqBody mempty
128 L.secure request `shouldBe` True
97 L.secure request `shouldBe` True
129− L.port request `shouldBe` 443
98+ L.port request `shouldBe` 443
130− L.host request `shouldBe` urlEncode host
99+ L.host request `shouldBe` urlEncode host
131 describe "(/~)" $
100 describe "(/~)" $
132 it "attaches a path piece that is URL-encoded" $
101 it "attaches a path piece that is URL-encoded" $
133 property $ \host pieces -> do
102 property $ \host pieces -> do
@@ -142,32 +111,95 @@ spec = do
142 request <- req_ GET url' NoReqBody mempty
111 request <- req_ GET url' NoReqBody mempty
143 L.host request `shouldBe` urlEncode host
112 L.host request `shouldBe` urlEncode host
144 L.path request `shouldBe` encodePathPieces pieces
113 L.path request `shouldBe` encodePathPieces pieces
114+
145− describe "parseUrlHttp" $ do
115+ describe "useHttpURI" $ do
146 it "does not recognize non-http schemes" $
116 it "does not recognize non-http schemes" $
117+ property $ \uri ->
118+ when (URI.uriScheme uri /= Just [QQ.scheme|http|]) $
147− parseUrlHttp "https://httpbin.org" `shouldSatisfy` isNothing
119+ useHttpURI uri `shouldSatisfy` isNothing
148− it "parses correct URLs" $
120+ it "accepts correct URLs" $
149− property $ \host pieces queryParams ->
121+ property $ \uri' -> do
150− not (T.null host) && wellFormed queryParams ==> do
122+ unless (isRight (URI.uriAuthority uri')) discard
151− let (url', path, queryString) =
123+ let uri = uri' {URI.uriScheme = Just [QQ.scheme|http|]}
152− assembleUrl Http host pieces queryParams
153− (url'', options) = fromJust (parseUrlHttp url')
124+ (url', options) = fromJust (useHttpURI uri)
154− request <- req_ GET url'' NoReqBody options
125+ request <- req_ GET url' NoReqBody options
155− L.host request `shouldBe` urlEncode host
126+ L.host request `shouldBe` uriHost uri
156− L.path request `shouldBe` path
127+ L.port request `shouldBe` uriPort 80 uri
128+ L.path request `shouldBe` uriPath uri
157− L.queryString request `shouldBe` queryString
129+ L.queryString request `shouldBe` uriQuery uri
130+ lookup "Authorization" (L.requestHeaders request)
131+ `shouldBe` uriBasicAuth uri
158− describe "parseUrlHttps" $ do
132+ describe "useHttpsURI" $ do
159 it "does not recognize non-https schemes" $
133 it "does not recognize non-https schemes" $
134+ property $ \uri ->
135+ when (URI.uriScheme uri /= Just [QQ.scheme|https|]) $
160− parseUrlHttps "http://httpbin.org" `shouldSatisfy` isNothing
136+ useHttpsURI uri `shouldSatisfy` isNothing
161 it "parses correct URLs" $
137 it "parses correct URLs" $
162− property $ \host pieces queryParams ->
138+ property $ \uri' -> do
163− not (T.null host) && wellFormed queryParams ==> do
139+ unless (isRight (URI.uriAuthority uri')) discard
164− let (url', path, queryString) =
140+ let uri = uri' {URI.uriScheme = Just [QQ.scheme|https|]}
165− assembleUrl Https host pieces queryParams
141+ (url', options) = fromJust (useHttpsURI uri)
166− (url'', options) = fromJust (parseUrlHttps url')
142+ request <- req_ GET url' NoReqBody options
143+ L.host request `shouldBe` uriHost uri
144+ L.port request `shouldBe` uriPort 443 uri
145+ L.path request `shouldBe` uriPath uri
146+ L.queryString request `shouldBe` uriQuery uri
147+ lookup "Authorization" (L.requestHeaders request)
148+ `shouldBe` uriBasicAuth uri
149+ describe "useURI" $ do
150+ it "does not recognize non-http and non-https schemes" $
151+ property $ \uri ->
152+ when
153+ ( ( URI.uriScheme uri /= Just [QQ.scheme|http|]
154+ && (URI.uriScheme uri /= Just [QQ.scheme|https|])
155+ )
156+ )
157+ $ useURI uri `shouldSatisfy` isNothing
158+ it "parses correct URLs" $
159+ property $ \uri' -> do
160+ unless (isRight (URI.uriAuthority uri')) discard
161+ let uriHttp = uri' {URI.uriScheme = Just [QQ.scheme|http|]}
162+ uriHttps = uri' {URI.uriScheme = Just [QQ.scheme|https|]}
163+ requestHttp <-
164+ case fromJust (useURI uriHttp) of
165+ Left (url', options) -> req_ GET url' NoReqBody options
166+ _ -> error "(useURI uriHttp) should have returned Left"
167+ requestHttps <-
168+ case fromJust (useURI uriHttps) of
167− request <- req_ GET url'' NoReqBody options
169+ Right (url', options) -> req_ GET url' NoReqBody options
168− L.host request `shouldBe` urlEncode host
170+ _ -> error "(useURI uriHttps) should have returned Right"
169− L.path request `shouldBe` path
171+ L.host requestHttp `shouldBe` uriHost uriHttp
172+ L.host requestHttps `shouldBe` uriHost uriHttps
173+ L.port requestHttp `shouldBe` uriPort 80 uriHttp
174+ L.port requestHttps `shouldBe` uriPort 443 uriHttps
175+ L.path requestHttp `shouldBe` uriPath uriHttp
176+ L.path requestHttps `shouldBe` uriPath uriHttps
170− L.queryString request `shouldBe` queryString
177+ L.queryString requestHttp `shouldBe` uriQuery uriHttp
178+ L.queryString requestHttps `shouldBe` uriQuery uriHttps
179+ lookup "Authorization" (L.requestHeaders requestHttp)
180+ `shouldBe` uriBasicAuth uriHttp
181+ lookup "Authorization" (L.requestHeaders requestHttps)
182+ `shouldBe` uriBasicAuth uriHttps
183+
184+ describe "renderUrl" $ do
185+ context "http" $ do
186+ context "empty path" $
187+ it "renders correctly" $ do
188+ let (uriHttp, _) = [urlQ|http://httpbin.org|]
189+ renderUrl uriHttp `shouldBe` "http://httpbin.org"
190+ context "non-empty path" $
191+ it "renders correctly" $ do
192+ let (uriHttp, _) = [urlQ|http://httpbin.org/here/we/go|]
193+ renderUrl uriHttp `shouldBe` "http://httpbin.org/here/we/go"
194+ context "http" $ do
195+ context "empty path" $
196+ it "renders correctly" $ do
197+ let (uriHttp, _) = [urlQ|https://httpbin.org|]
198+ renderUrl uriHttp `shouldBe` "https://httpbin.org"
199+ context "non-empty path" $
200+ it "renders correctly" $ do
201+ let (uriHttp, _) = [urlQ|https://httpbin.org/here/we/go|]
202+ renderUrl uriHttp `shouldBe` "https://httpbin.org/here/we/go"
171
203
172 describe "bodies" $ do
204 describe "bodies" $ do
173 describe "NoReqBody" $
205 describe "NoReqBody" $
@@ -191,7 +223,7 @@ spec = do
191 L.RequestBodyBS x -> x `shouldBe` bs
223 L.RequestBodyBS x -> x `shouldBe` bs
192 _ -> expectationFailure "Wrong request body constructor."
224 _ -> expectationFailure "Wrong request body constructor."
193 describe "ReqBodyLbs" $
225 describe "ReqBodyLbs" $
194− it "sets body to specified lazy byte string" $
226+ it "sets body to specified lazy byte string" $
195 property $ \lbs -> do
227 property $ \lbs -> do
196 request <- req_ POST url (ReqBodyLbs lbs) mempty
228 request <- req_ POST url (ReqBodyLbs lbs) mempty
197 case L.requestBody request of
229 case L.requestBody request of
@@ -205,6 +237,19 @@ spec = do
205 L.RequestBodyLBS x -> x `shouldBe` renderQuery params
237 L.RequestBodyLBS x -> x `shouldBe` renderQuery params
206 _ -> expectationFailure "Wrong request body constructor."
238 _ -> expectationFailure "Wrong request body constructor."
207
239
240+ describe "query params" $ do
241+ describe "FormUrlEncodedParam" $ do
242+ describe "formToQuery" $ do
243+ it "should produce the same parameters as F.urlEncodeFormStable" $
244+ property $ \form -> do
245+ request <- req_ POST url (ReqBodyUrlEnc $ formToQuery form) mempty
246+ case L.requestBody request of
247+ L.RequestBodyLBS x -> x `shouldBe` F.urlEncodeFormStable form
248+ _ -> expectationFailure "Wrong request body constructor"
249+ specParamToList (Proxy :: Proxy FormUrlEncodedParam)
250+ describe "Option" $ do
251+ specParamToList (Proxy :: Proxy (Option 'Http))
252+
208 describe "optional parameters" $ do
253 describe "optional parameters" $ do
209 describe "header" $ do
254 describe "header" $ do
210 it "sets specified header value" $
255 it "sets specified header value" $
@@ -213,88 +258,136 @@ spec = do
213 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value
258 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value
214 it "left header wins" $
259 it "left header wins" $
215 property $ \name value0 value1 -> do
260 property $ \name value0 value1 -> do
261+ request <-
262+ req_
263+ GET
264+ url
216− request <- req_ GET url NoReqBody
265+ NoReqBody
217− (header name value0 <> header name value1)
266+ (header name value0 <> header name value1)
218 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value0
267 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value0
219 it "overwrites headers set by other parts of the lib" $
268 it "overwrites headers set by other parts of the lib" $
220 property $ \value -> do
269 property $ \value -> do
270+ request <-
271+ req_
272+ POST
273+ url
221− request <- req_ POST url (ReqBodyUrlEnc mempty)
274+ (ReqBodyUrlEnc mempty)
222− (header "Content-Type" value)
275+ (header "Content-Type" value)
223 lookup "Content-Type" (L.requestHeaders request) `shouldBe` pure value
276 lookup "Content-Type" (L.requestHeaders request) `shouldBe` pure value
224 describe "cookieJar" $
277 describe "cookieJar" $
225 it "cookie jar is set without modifications" $
278 it "cookie jar is set without modifications" $
226 property $ \cjar -> do
279 property $ \cjar -> do
227 request <- req_ GET url NoReqBody (cookieJar cjar)
280 request <- req_ GET url NoReqBody (cookieJar cjar)
228− L.cookieJar request `shouldBe` pure cjar
281+ L.cookieJar request `shouldSatisfy` (maybe False (L.equalCookieJar cjar))
229 describe "basicAuth" $ do
282 describe "basicAuth" $ do
230 it "sets Authorization header to correct value" $
283 it "sets Authorization header to correct value" $
231 property $ \username password -> do
284 property $ \username password -> do
232 request <- req_ GET url NoReqBody (basicAuth username password)
285 request <- req_ GET url NoReqBody (basicAuth username password)
233− lookup "Authorization" (L.requestHeaders request) `shouldBe`
286+ lookup "Authorization" (L.requestHeaders request)
234− pure (basicAuthHeader username password)
287+ `shouldBe` Just (basicAuthHeader username password)
235 it "overwrites manual setting of header" $
288 it "overwrites manual setting of header" $
236 property $ \username password value -> do
289 property $ \username password value -> do
290+ request0 <-
291+ req_
292+ GET
293+ url
237− request0 <- req_ GET url NoReqBody
294+ NoReqBody
238− (basicAuth username password <> header "Authorization" value)
295+ (basicAuth username password <> header "Authorization" value)
296+ request1 <-
297+ req_
298+ GET
299+ url
239− request1 <- req_ GET url NoReqBody
300+ NoReqBody
240− (header "Authorization" value <> basicAuth username password)
301+ (header "Authorization" value <> basicAuth username password)
241− let result = basicAuthHeader username password
302+ let result = Just (basicAuthHeader username password)
242− lookup "Authorization" (L.requestHeaders request0) `shouldBe`
303+ lookup "Authorization" (L.requestHeaders request0) `shouldBe` result
243− pure result
244− lookup "Authorization" (L.requestHeaders request1) `shouldBe`
304+ lookup "Authorization" (L.requestHeaders request1) `shouldBe` result
245− pure result
246 it "left auth option wins" $
305 it "left auth option wins" $
247 property $ \username0 password0 username1 password1 -> do
306 property $ \username0 password0 username1 password1 -> do
307+ request <-
308+ req_
309+ GET
310+ url
248− request <- req_ GET url NoReqBody
311+ NoReqBody
249− (basicAuth username0 password0 <> basicAuth username1 password1)
312+ (basicAuth username0 password0 <> basicAuth username1 password1)
250− lookup "Authorization" (L.requestHeaders request) `shouldBe`
313+ lookup "Authorization" (L.requestHeaders request)
251− pure (basicAuthHeader username0 password0)
314+ `shouldBe` Just (basicAuthHeader username0 password0)
252 describe "oAuth2Bearer" $ do
315 describe "oAuth2Bearer" $ do
253 it "sets Authorization header to correct value" $
316 it "sets Authorization header to correct value" $
254 property $ \token -> do
317 property $ \token -> do
255 request <- req_ GET url NoReqBody (oAuth2Bearer token)
318 request <- req_ GET url NoReqBody (oAuth2Bearer token)
256− lookup "Authorization" (L.requestHeaders request) `shouldBe`
319+ lookup "Authorization" (L.requestHeaders request)
257− pure ("Bearer " <> token)
320+ `shouldBe` pure ("Bearer " <> token)
258 it "overwrites manual setting of header" $
321 it "overwrites manual setting of header" $
259 property $ \token value -> do
322 property $ \token value -> do
323+ request0 <-
324+ req_
325+ GET
326+ url
260− request0 <- req_ GET url NoReqBody
327+ NoReqBody
261− (oAuth2Bearer token <> header "Authorization" value)
328+ (oAuth2Bearer token <> header "Authorization" value)
329+ request1 <-
330+ req_
331+ GET
332+ url
262− request1 <- req_ GET url NoReqBody
333+ NoReqBody
263− (header "Authorization" value <> oAuth2Bearer token)
334+ (header "Authorization" value <> oAuth2Bearer token)
264 let result = "Bearer " <> token
335 let result = "Bearer " <> token
265− lookup "Authorization" (L.requestHeaders request0) `shouldBe`
336+ lookup "Authorization" (L.requestHeaders request0)
266− pure result
337+ `shouldBe` pure result
267− lookup "Authorization" (L.requestHeaders request1) `shouldBe`
338+ lookup "Authorization" (L.requestHeaders request1)
268− pure result
339+ `shouldBe` pure result
269 it "left auth option wins" $
340 it "left auth option wins" $
270 property $ \token0 token1 -> do
341 property $ \token0 token1 -> do
342+ request <-
343+ req_
344+ GET
345+ url
271− request <- req_ GET url NoReqBody
346+ NoReqBody
272− (oAuth2Bearer token0 <> oAuth2Bearer token1)
347+ (oAuth2Bearer token0 <> oAuth2Bearer token1)
273− lookup "Authorization" (L.requestHeaders request) `shouldBe`
348+ lookup "Authorization" (L.requestHeaders request)
274− pure ("Bearer " <> token0)
349+ `shouldBe` pure ("Bearer " <> token0)
350+ describe "ProxyAuthorization" $
351+ it "sets Authorization header to correct value" $
352+ property $ \username password -> do
353+ request <- req_ GET url NoReqBody (basicProxyAuth username password)
354+ lookup "Proxy-Authorization" (L.requestHeaders request)
355+ `shouldBe` pure (basicProxyAuthHeader username password)
275 describe "oAuth2Token" $ do
356 describe "oAuth2Token" $ do
276 it "sets Authorization header to correct value" $
357 it "sets Authorization header to correct value" $
277 property $ \token -> do
358 property $ \token -> do
278 request <- req_ GET url NoReqBody (oAuth2Token token)
359 request <- req_ GET url NoReqBody (oAuth2Token token)
279− lookup "Authorization" (L.requestHeaders request) `shouldBe`
360+ lookup "Authorization" (L.requestHeaders request)
280− pure ("token " <> token)
361+ `shouldBe` pure ("token " <> token)
281 it "overwrites manual setting of header" $
362 it "overwrites manual setting of header" $
282 property $ \token value -> do
363 property $ \token value -> do
364+ request0 <-
365+ req_
366+ GET
367+ url
283− request0 <- req_ GET url NoReqBody
368+ NoReqBody
284− (oAuth2Token token <> header "Authorization" value)
369+ (oAuth2Token token <> header "Authorization" value)
370+ request1 <-
371+ req_
372+ GET
373+ url
285− request1 <- req_ GET url NoReqBody
374+ NoReqBody
286− (header "Authorization" value <> oAuth2Token token)
375+ (header "Authorization" value <> oAuth2Token token)
287 let result = "token " <> token
376 let result = "token " <> token
288− lookup "Authorization" (L.requestHeaders request0) `shouldBe`
377+ lookup "Authorization" (L.requestHeaders request0)
289− pure result
378+ `shouldBe` pure result
290− lookup "Authorization" (L.requestHeaders request1) `shouldBe`
379+ lookup "Authorization" (L.requestHeaders request1)
291− pure result
380+ `shouldBe` pure result
292 it "left auth option wins" $
381 it "left auth option wins" $
293 property $ \token0 token1 -> do
382 property $ \token0 token1 -> do
383+ request <-
384+ req_
385+ GET
386+ url
294− request <- req_ GET url NoReqBody
387+ NoReqBody
295− (oAuth2Token token0 <> oAuth2Token token1)
388+ (oAuth2Token token0 <> oAuth2Token token1)
296− lookup "Authorization" (L.requestHeaders request) `shouldBe`
389+ lookup "Authorization" (L.requestHeaders request)
297− pure ("token " <> token0)
390+ `shouldBe` pure ("token " <> token0)
298 describe "port" $
391 describe "port" $
299 it "sets port overwriting the defaults" $
392 it "sets port overwriting the defaults" $
300 property $ \n -> do
393 property $ \n -> do
@@ -314,31 +407,48 @@ spec = do
314 request <- req_ GET url NoReqBody (httpVersion major minor)
407 request <- req_ GET url NoReqBody (httpVersion major minor)
315 L.requestVersion request `shouldBe` Y.HttpVersion major minor
408 L.requestVersion request `shouldBe` Y.HttpVersion major minor
316
409
410+ describe "quasiquoter" $ do
411+ it "works for valid urls" $
412+ -- Doing it this way instead of just checking if [urlQ|...|] :: (Url
413+ -- 'Https, Option _) type checks, so we can catch if the type of scheme
414+ -- is unspecified.
415+ let testTypeOfQuoterResult ::
416+ forall a s. (Typeable a) => (a, Option s) -> Bool
417+ testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https)
418+ in property $ testTypeOfQuoterResult [urlQ|https://example.org/|]
419+ it "doesn't work for invalid urls" $
420+ property $
421+ TH.runQ (TH.quoteExp urlQ "not a url") `shouldThrow` anyIOException
422+
317----------------------------------------------------------------------------
423----------------------------------------------------------------------------
318-- Instances
424-- Instances
319
425
320instance MonadHttp IO where
426instance MonadHttp IO where
321 handleHttpException = throwIO
427 handleHttpException = throwIO
322
428
323−instance MonadHttp (ReaderT HttpConfig IO) where
324− handleHttpException = liftIO . throwIO
325− getHttpConfig = ask
326−
327instance Arbitrary HttpConfig where
429instance Arbitrary HttpConfig where
328 arbitrary = do
430 arbitrary = do
329− httpConfigProxy <- arbitrary
431+ httpConfigProxy <- arbitrary
330 httpConfigRedirectCount <- arbitrary
432 httpConfigRedirectCount <- arbitrary
331 let httpConfigAltManager = Nothing
433 let httpConfigAltManager = Nothing
332− httpConfigCheckResponse _ _ = return ()
434+ httpConfigCheckResponse _ _ _ = Nothing
435+ httpConfigRetryPolicy = retryPolicyDefault
436+ httpConfigRetryJudge _ _ = False
437+ httpConfigRetryJudgeException _ _ = False
438+ httpConfigBodyPreviewLength = 1024
333 return HttpConfig {..}
439 return HttpConfig {..}
334
440
335instance Show HttpConfig where
441instance Show HttpConfig where
336 show HttpConfig {..} =
442 show HttpConfig {..} =
337− "HttpConfig\n" ++
443+ "HttpConfig\n"
444+ ++ "{ httpConfigProxy="
338− "{ httpConfigProxy=" ++ show httpConfigProxy ++ "\n" ++
445+ ++ show httpConfigProxy
446+ ++ "\n"
447+ ++ ", httpRedirectCount="
339− ", httpRedirectCount=" ++ show httpConfigRedirectCount ++ "\n" ++
448+ ++ show httpConfigRedirectCount
449+ ++ "\n"
340− ", httpConfigAltManager=<cannot be shown>\n" ++
450+ ++ ", httpConfigAltManager=<cannot be shown>\n"
341− ", httpConfigCheckResponse=<cannot be shown>}\n"
451+ ++ ", httpConfigCheckResponse=<cannot be shown>}\n"
342
452
343instance Arbitrary L.Proxy where
453instance Arbitrary L.Proxy where
344 arbitrary = L.Proxy <$> arbitrary <*> arbitrary
454 arbitrary = L.Proxy <$> arbitrary <*> arbitrary
@@ -356,9 +466,10 @@ instance Show (Option scheme) where
356 show _ = "<cannot be shown>"
466 show _ = "<cannot be shown>"
357
467
358data Thing = Thing
468data Thing = Thing
359− { _thingBool :: Bool
469+ { _thingBool :: Bool,
360− , _thingText :: Text
470+ _thingText :: Text
471+ }
361− } deriving (Eq, Show, Generic)
472+ deriving (Eq, Show, Generic)
362
473
363instance ToJSON Thing
474instance ToJSON Thing
364
475
@@ -370,17 +481,17 @@ instance Arbitrary L.CookieJar where
370
481
371instance Arbitrary L.Cookie where
482instance Arbitrary L.Cookie where
372 arbitrary = do
483 arbitrary = do
373− cookie_name <- arbitrary
484+ cookie_name <- arbitrary
374− cookie_value <- arbitrary
485+ cookie_value <- arbitrary
375− cookie_expiry_time <- arbitrary
486+ cookie_expiry_time <- arbitrary
376− cookie_domain <- arbitrary
487+ cookie_domain <- arbitrary
377− cookie_path <- arbitrary
488+ cookie_path <- arbitrary
378 cookie_creation_time <- arbitrary
489 cookie_creation_time <- arbitrary
379 cookie_last_access_time <- arbitrary
490 cookie_last_access_time <- arbitrary
380− cookie_persistent <- arbitrary
491+ cookie_persistent <- arbitrary
381− cookie_host_only <- arbitrary
492+ cookie_host_only <- arbitrary
382− cookie_secure_only <- arbitrary
493+ cookie_secure_only <- arbitrary
383− cookie_http_only <- arbitrary
494+ cookie_http_only <- arbitrary
384 return L.Cookie {..}
495 return L.Cookie {..}
385
496
386instance Arbitrary UTCTime where
497instance Arbitrary UTCTime where
@@ -392,73 +503,130 @@ instance Arbitrary Day where
392instance Arbitrary DiffTime where
503instance Arbitrary DiffTime where
393 arbitrary = secondsToDiffTime <$> arbitrary
504 arbitrary = secondsToDiffTime <$> arbitrary
394
505
506+instance Arbitrary F.Form where
507+ arbitrary = (F.Form . fromList) <$> arbitrary
508+
509+----------------------------------------------------------------------------
510+-- Helper types
511+
512+-- | A wrapper to generate correct hosts.
513+newtype Host = Host {unHost :: Text}
514+ deriving (Eq, Show)
515+
516+instance Arbitrary Host where
517+ arbitrary = Host . T.pack <$> listOf1 (arbitrary `suchThat` (/= ':'))
518+
519+-- | A wrapper to generate correct query parameters.
520+newtype QueryParams = QueryParams [(Text, Maybe Text)]
521+ deriving (Eq, Show)
522+
523+instance Arbitrary QueryParams where
524+ arbitrary = QueryParams <$> (arbitrary `suchThat` wellFormed)
525+ where
526+ wellFormed = all (not . T.null . fst)
527+
395----------------------------------------------------------------------------
528----------------------------------------------------------------------------
396-- Helpers
529-- Helpers
397
530
398-- | 'req' that just returns the prepared 'L.Request'.
531-- | 'req' that just returns the prepared 'L.Request'.
399−
400−req_
532+req_ ::
401− :: ( MonadHttp m
533+ ( MonadHttp m,
402− , HttpMethod method
534+ HttpMethod method,
403− , HttpBody body
535+ HttpBody body,
404− , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )
536+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
537+ ) =>
405− => method -- ^ HTTP method
538+ -- | HTTP method
539+ method ->
406− -> Url scheme -- ^ 'Url' — location of resource
540+ -- | 'Url' — location of resource
541+ Url scheme ->
407− -> body -- ^ Body of the request
542+ -- | Body of the request
543+ body ->
408− -> Option scheme -- ^ Collection of optional parameters
544+ -- | Collection of optional parameters
545+ Option scheme ->
546+ -- | Vanilla request
409− -> m L.Request -- ^ Vanilla request
547+ m L.Request
410−req_ method url' body options =
548+req_ method url' body options = req' method url' body options $
411− responseRequest `liftM` req method url' body returnRequest options
549+ \request _ -> return request
412
550
413-- | A dummy 'Url'.
551-- | A dummy 'Url'.
414−
415url :: Url 'Https
552url :: Url 'Https
416url = https "httpbin.org"
553url = https "httpbin.org"
417
554
418-- | Percent encode given 'Text'.
555-- | Percent encode given 'Text'.
419−
420urlEncode :: Text -> ByteString
556urlEncode :: Text -> ByteString
421urlEncode = Y.urlEncode False . T.encodeUtf8
557urlEncode = Y.urlEncode False . T.encodeUtf8
422
558
423-- | Build URL path from given path pieces.
559-- | Build URL path from given path pieces.
424−
425encodePathPieces :: [Text] -> ByteString
560encodePathPieces :: [Text] -> ByteString
426encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments
561encodePathPieces = BL.toStrict . BB.toLazyByteString . Y.encodePathSegments
427
562
428−-- | Assemble entire URL.
563+-- | Get host from a 'URI'. This function is not total.
429−
564+uriHost :: URI -> ByteString
430−assembleUrl
565+uriHost uri =
431− :: Scheme -- ^ Scheme
566+ fromJust $
432− -> Text -- ^ Host
567+ urlEncode . URI.unRText . URI.authHost
433− -> [Text] -- ^ Path pieces
568+ <$> either (const Nothing) Just (URI.uriAuthority uri)
434− -> [(Text, Maybe Text)] -- ^ Query parameters
569+
435− -> (ByteString, ByteString, ByteString) -- ^ URL, path, query string
570+-- | Get part from a 'URI' defaulting to the provided value.
436−assembleUrl scheme' host' pathPieces queryParams =
571+uriPort :: Int -> URI -> Int
437− (scheme <> host <> path <> queryString, path, queryString)
572+uriPort def uri =
438− where
573+ maybe def (fromIntegral) $
439− scheme = case scheme' of
574+ either (const Nothing) Just (URI.uriAuthority uri) >>= URI.authPort
440− Http -> "http://"
575+
441− Https -> "https://"
576+-- | Get the path from a 'URI'.
442− host = urlEncode host'
577+uriPath :: URI -> ByteString
578+uriPath uri = fromMaybe "" $ do
579+ (trailingSlash, xs) <- URI.uriPath uri
443− path = encodePathPieces pathPieces
580+ let pref = (encodePathPieces . fmap URI.unRText . NE.toList) xs
581+ return $ if trailingSlash then pref <> "/" else pref
582+
583+-- | Get the query string from a 'URI'.
584+uriQuery :: URI -> ByteString
585+uriQuery uri = do
586+ let liftQueryParam = \case
587+ URI.QueryFlag t -> (URI.unRText t, Nothing)
588+ URI.QueryParam k v -> (URI.unRText k, Just (URI.unRText v))
444− queryString = Y.renderQuery True (Y.queryTextToQuery queryParams)
589+ Y.renderQuery True (Y.queryTextToQuery (liftQueryParam <$> (URI.uriQuery uri)))
445−
590+
591+-- | Predict the headrs that should be set if the given 'URI' has username
592+-- and password in it.
593+uriBasicAuth :: URI -> Maybe ByteString
594+uriBasicAuth uri = do
595+ auth <- either (const Nothing) Just (URI.uriAuthority uri)
596+ URI.UserInfo {..} <- URI.authUserInfo auth
597+ let username = T.encodeUtf8 (URI.unRText uiUsername)
598+ password = maybe "" (T.encodeUtf8 . URI.unRText) uiPassword
599+ return (basicAuthHeader username password)
600+
601+-- | Render a query as lazy 'BL.ByteString'.
446renderQuery :: [(Text, Maybe Text)] -> BL.ByteString
602renderQuery :: [(Text, Maybe Text)] -> BL.ByteString
447renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery
603renderQuery = BL.fromStrict . Y.renderQuery False . Y.queryTextToQuery
448
604
449−-- | Check if collection of query params is well-formed.
450−
451−wellFormed :: [(Text, Maybe Text)] -> Bool
452−wellFormed = all (not . T.null . fst)
453−
454-- | Convert collection of query parameters to 'FormUrlEncodedParam' thing.
605-- | Convert collection of query parameters to 'FormUrlEncodedParam' thing.
455−
456formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam
606formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam
457formUrlEnc = foldMap (uncurry queryParam)
607formUrlEnc = foldMap (uncurry queryParam)
458
608
459-- | Get “Authorization” basic auth header given username and password.
609-- | Get “Authorization” basic auth header given username and password.
460−
461basicAuthHeader :: ByteString -> ByteString -> ByteString
610basicAuthHeader :: ByteString -> ByteString -> ByteString
462basicAuthHeader username password =
611basicAuthHeader username password =
463 fromJust . lookup Y.hAuthorization . L.requestHeaders $
612 fromJust . lookup Y.hAuthorization . L.requestHeaders $
464 L.applyBasicAuth username password L.defaultRequest
613 L.applyBasicAuth username password L.defaultRequest
614+
615+-- | Get "Proxy-Authorization" basic proxy auth header given username and
616+-- password.
617+basicProxyAuthHeader :: ByteString -> ByteString -> ByteString
618+basicProxyAuthHeader username password =
619+ fromJust . lookup Y.hProxyAuthorization . L.requestHeaders $
620+ L.applyBasicProxyAuth username password L.defaultRequest
621+
622+-- | Spec about 'paramToList' for the type @p@.
623+specParamToList :: (QueryParam p, Monoid p) => Proxy p -> Spec
624+specParamToList typeProxy = do
625+ describe "paramToList" $ do
626+ it "should reproduce the parameters given by queryParam" $
627+ property $ \(QueryParams params) -> do
628+ let queryParam0 =
629+ (mconcat $ fmap (uncurry queryParam) params)
630+ `asProxyTypeOf` typeProxy
631+ got = queryParamToList queryParam0
632+ got `shouldBe` params
req.cabal+116−121
@@ -1,132 +1,127 @@
1−--
1+cabal-version: 2.4
2−-- Cabal configuration for ‘req’ package.
2+name: req
3−--
3+version: 3.13.4
4−-- Copyright © 2016–2017 Mark Karpov <markkarpov@openmailbox.org>
4+license: BSD-3-Clause
5−--
5+license-file: LICENSE.md
6−-- Redistribution and use in source and binary forms, with or without
6+maintainer: Mark Karpov <markkarpov92@gmail.com>
7−-- modification, are permitted provided that the following conditions are
7+author: Mark Karpov <markkarpov92@gmail.com>
8−-- met:
8+tested-with: ghc ==9.6.3 ghc ==9.8.2 ghc ==9.10.1
9−--
9+homepage: https://github.com/mrkkrp/req
10−-- * Redistributions of source code must retain the above copyright notice,
10+bug-reports: https://github.com/mrkkrp/req/issues
11−-- this list of conditions and the following disclaimer.
11+synopsis: HTTP client library
12−--
12+description: HTTP client library.
13−-- * Redistributions in binary form must reproduce the above copyright
13+category: Network, Web
14−-- notice, this list of conditions and the following disclaimer in the
14+build-type: Simple
15−-- documentation and/or other materials provided with the distribution.
15+data-files:
16−--
16+ httpbin-data/utf8.html
17−-- * Neither the name Mark Karpov nor the names of contributors may be used
17+ httpbin-data/robots.txt
18−-- to endorse or promote products derived from this software without
19−-- specific prior written permission.
20−--
21−-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY
22−-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23−-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
24−-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY
25−-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26−-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
27−-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28−-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29−-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30−-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31−-- POSSIBILITY OF SUCH DAMAGE.
32
18
33−name: req
34−version: 0.2.0
35−cabal-version: >= 1.10
36−license: BSD3
37−license-file: LICENSE.md
38−author: Mark Karpov <markkarpov@openmailbox.org>
39−maintainer: Mark Karpov <markkarpov@openmailbox.org>
40−homepage: https://github.com/mrkkrp/req
41−bug-reports: https://github.com/mrkkrp/req/issues
42−category: Network, Web
43−synopsis: Easy-to-use, type-safe, expandable, high-level HTTP library
44−build-type: Simple
45−description: Easy-to-use, type-safe, expandable, high-level HTTP library.
46−extra-doc-files: CHANGELOG.md
19+extra-doc-files:
20+ CHANGELOG.md
47− , README.md
21+ README.md
48−data-files: httpbin-data/utf8.html
49− , httpbin-data/robots.txt
50
22
51source-repository head
23source-repository head
52− type: git
24+ type: git
53− location: https://github.com/mrkkrp/req.git
25+ location: https://github.com/mrkkrp/req.git
54
26
55flag dev
27flag dev
56− description: Turn on development settings.
28+ description: Turn on development settings.
57− manual: True
58− default: False
29+ default: False
30+ manual: True
59
31
60library
32library
33+ exposed-modules: Network.HTTP.Req
34+ default-language: GHC2021
61− build-depends: aeson >= 0.9 && < 1.2
35+ build-depends:
36+ aeson >=0.9 && <3,
62− , authenticate-oauth >= 1.5 && < 1.7
37+ authenticate-oauth >=1.5 && <1.8,
63− , base >= 4.7 && < 5.0
38+ base >=4.15 && <5,
64− , blaze-builder >= 0.3 && < 0.5
39+ blaze-builder >=0.3 && <0.5,
65− , bytestring >= 0.10.8 && < 0.11
40+ bytestring >=0.10.8 && <0.13,
66− , case-insensitive >= 0.2 && < 1.3
41+ case-insensitive >=0.2 && <1.3,
42+ containers >=0.5 && <0.8,
67− , connection >= 0.2.2 && < 0.3
43+ crypton-connection >=0.4.2 && <0.5,
68− , data-default-class
44+ data-default-class >=0.2.0.0,
45+ exceptions >=0.6 && <0.11,
69− , http-api-data >= 0.2 && < 0.4
46+ http-api-data >=0.2 && <0.7,
70− , http-client >= 0.5 && < 0.6
47+ http-client >=0.7.13.1 && <0.8,
71− , http-client-tls >= 0.3.2 && < 0.4
48+ http-client-tls >=0.3.2 && <0.4,
72− , http-types >= 0.8 && < 10.0
49+ http-types >=0.8 && <10,
50+ modern-uri >=0.3 && <0.4,
51+ monad-control >=1.0 && <1.1,
73− , mtl >= 2.0 && < 3.0
52+ mtl >=2.0 && <3.0,
53+ retry >=0.8 && <0.10,
54+ template-haskell >=2.19 && <2.23,
74− , text >= 0.2 && < 1.3
55+ text >=0.2 && <2.2,
75− , time >= 1.2 && < 1.8
56+ transformers >=0.5.3.0 && <0.7,
76− , transformers >= 0.4 && < 0.6
57+ transformers-base,
77− if !impl(ghc >= 8.0)
58+ unliftio-core >=0.1.1 && <0.3
78− build-depends: semigroups == 0.18.*
59+
79− exposed-modules: Network.HTTP.Req
80− if flag(dev)
60+ if flag(dev)
81− ghc-options: -Wall -Werror
61+ ghc-options:
62+ -Wall -Werror -Wpartial-fields -Wunused-packages
63+ -Wno-unused-imports
64+
82− else
65+ else
83− ghc-options: -O2 -Wall
66+ ghc-options: -O2 -Wall
84− default-language: Haskell2010
85
67
86test-suite pure-tests
68test-suite pure-tests
69+ type: exitcode-stdio-1.0
87− main-is: Spec.hs
70+ main-is: Spec.hs
88− other-modules: Network.HTTP.ReqSpec
71+ build-tool-depends: hspec-discover:hspec-discover >=2 && <3
89− hs-source-dirs: pure-tests
72+ hs-source-dirs: pure-tests
90− type: exitcode-stdio-1.0
73+ other-modules: Network.HTTP.ReqSpec
74+ default-language: GHC2021
75+ build-depends:
91− build-depends: QuickCheck >= 2.7 && < 3.0
76+ QuickCheck >=2.7 && <3,
92− , aeson >= 0.9 && < 1.2
77+ aeson >=0.9 && <3,
93− , base >= 4.7 && < 5.0
78+ base >=4.15 && <5.0,
94− , blaze-builder >= 0.3 && < 0.5
79+ blaze-builder >=0.3 && <0.5,
95− , bytestring >= 0.10.8 && < 0.11
80+ bytestring >=0.10.8 && <0.13,
96− , case-insensitive >= 0.2 && < 1.3
81+ case-insensitive >=0.2 && <1.3,
97− , hspec >= 2.0 && < 3.0
82+ hspec >=2.0 && <3,
98− , hspec-core >= 2.0 && < 3.0
83+ hspec-core >=2.0 && <3,
84+ http-api-data >=0.2 && <0.7,
99− , http-client >= 0.5 && < 0.6
85+ http-client >=0.7 && <0.8,
100− , http-types >= 0.8 && < 10.0
86+ http-types >=0.8 && <10,
101− , mtl >= 2.0 && < 3.0
87+ modern-uri >=0.3 && <0.4,
102− , req >= 0.2.0
88+ req,
89+ retry >=0.8 && <0.10,
90+ template-haskell >=2.19 && <2.23,
103− , text >= 0.2 && < 1.3
91+ text >=0.2 && <2.2,
104− , time >= 1.2 && < 1.8
92+ time >=1.2 && <1.15
93+
105− if flag(dev)
94+ if flag(dev)
106− ghc-options: -Wall -Werror
95+ ghc-options:
96+ -Wall -Werror -Wredundant-constraints -Wpartial-fields
97+ -Wunused-packages
98+
107− else
99+ else
108− ghc-options: -O2 -Wall
100+ ghc-options: -O2 -Wall
109− default-language: Haskell2010
110
101
111test-suite httpbin-tests
102test-suite httpbin-tests
103+ type: exitcode-stdio-1.0
112− main-is: Spec.hs
104+ main-is: Spec.hs
113− other-modules: Network.HTTP.ReqSpec
105+ build-tool-depends: hspec-discover:hspec-discover >=2 && <3
114− hs-source-dirs: httpbin-tests
106+ hs-source-dirs: httpbin-tests
115− type: exitcode-stdio-1.0
107+ other-modules: Network.HTTP.ReqSpec
108+ default-language: GHC2021
109+ build-depends:
116− build-depends: QuickCheck >= 2.7 && < 3.0
110+ QuickCheck >=2.7 && <3,
117− , aeson >= 0.9 && < 1.2
111+ aeson >=2 && <3,
118− , base >= 4.7 && < 5.0
112+ base >=4.15 && <5,
119− , bytestring >= 0.10.8 && < 0.11
113+ bytestring >=0.10.8 && <0.13,
120− , data-default-class
121− , hspec >= 2.0 && < 3.0
114+ hspec >=2.0 && <3.0,
122− , http-client >= 0.5 && < 0.6
115+ http-client >=0.7 && <0.8,
123− , http-types >= 0.8 && < 10.0
116+ http-types >=0.8 && <10,
124− , mtl >= 2.0 && < 3.0
117+ monad-control >=1.0 && <1.1,
125− , req >= 0.2.0
118+ req,
126− , text >= 0.2 && < 1.3
119+ text >=0.2 && <2.2
127− , unordered-containers >= 0.2.5 && < 0.2.9
120+
128− if flag(dev)
121+ if flag(dev)
129− ghc-options: -Wall -Werror
122+ ghc-options:
123+ -Wall -Werror -Wredundant-constraints -Wpartial-fields
124+ -Wunused-packages
125+
130− else
126+ else
131− ghc-options: -O2 -Wall
127+ buildable: False
132− default-language: Haskell2010
stack.yamldeleted−3
@@ -1,3 +0,0 @@
1−resolver: nightly-2016-11-07
2−packages:
3−- '.'