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