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