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