on master help sign in
12 files changed+1044−766
since splitsnapshots
unifiedsplit
.github/dependabot.yml+6 .github/workflows/ci.yaml+47 .gitignore+1 .travis.yml−39 CHANGELOG.md+94 Network/HTTP/Req.hs+425−191 README.md+28−124 Setup.hs−6 cabal.project+4 httpbin-tests/Network/HTTP/ReqSpec.hs+160−137 pure-tests/Network/HTTP/ReqSpec.hs+211−199 req.cabal+68−70
.github/dependabot.ymlnew file+6
@@ -0,0 +1,6 @@
1+version: 2
2+updates:
3+ - package-ecosystem: "github-actions"
4+ directory: "/"
5+ schedule:
6+ interval: "weekly"
.github/workflows/ci.yamlnew file+47
@@ -0,0 +1,47 @@
1+name: CI
2+on:
3+ push:
4+ branches:
5+ - master
6+ pull_request:
7+ types:
8+ - opened
9+ - synchronize
10+jobs:
11+ ormolu:
12+ runs-on: ubuntu-latest
13+ steps:
14+ - uses: actions/checkout@v4
15+ - uses: haskell-actions/run-ormolu@v17
16+ build:
17+ runs-on: ubuntu-latest
18+ needs: ormolu
19+ strategy:
20+ matrix:
21+ cabal: ["3.12"]
22+ ghc: ["9.6.3", "9.8.2", "9.10.1"]
23+ steps:
24+ - uses: actions/checkout@v4
25+ - uses: haskell-actions/setup@v2
26+ id: setup-haskell-cabal
27+ with:
28+ ghc-version: ${{ matrix.ghc }}
29+ cabal-version: ${{ matrix.cabal }}
30+ - run: cabal update
31+ - run: cabal freeze
32+ - uses: actions/cache@v4.2.3
33+ with:
34+ path: |
35+ ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
36+ dist-newstyle
37+ key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
38+ restore-keys: |
39+ ${{ runner.os }}-${{ matrix.ghc }}-
40+ - run: cabal format && git diff --exit-code --color=always
41+ - run: cabal build
42+ - run: |
43+ docker pull kennethreitz/httpbin
44+ docker run -p 1234:80 kennethreitz/httpbin &
45+ cabal test
46+ - run: cabal haddock
47+ - run: cabal sdist
.gitignore+1
@@ -25,5 +25,6 @@ cabal.project.local
2525cabal.sandbox.config
2626dist-*/
2727dist/
28+hie.yaml
2829stack.yaml
2930stack.yaml.lock
.travis.ymldeleted−39
@@ -1,39 +0,0 @@
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.6.5
13− addons: {apt: {packages: [cabal-install-3.0,ghc-8.6.5], sources: [hvr-ghc]}}
14− - env: CABALVER=3.0 GHCVER=8.8.3
15− addons: {apt: {packages: [cabal-install-3.0,ghc-8.8.3], sources: [hvr-ghc]}}
16− - env: CABALVER=3.0 GHCVER=8.10.1
17− addons: {apt: {packages: [cabal-install-3.0,ghc-8.10.1], 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− # To avoid re-compilation it is important to use exactly the same
29− # configuration for all steps.
30− - export CONFIG="--enable-tests --enable-benchmarks --flags=dev"
31− - cabal format
32− - git diff --exit-code --color=always
33− - cabal new-build $CONFIG
34− - cabal new-test $CONFIG
35− - cabal new-haddock $CONFIG
36− - cabal new-sdist
37−
38−notifications:
39− email: false
CHANGELOG.md+94
@@ -1,3 +1,97 @@
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+
195## Req 3.3.0
296
397* Derived `Show` instances for response types `IgnoreResponse`,
Network/HTTP/Req.hs+425−191
@@ -1,19 +1,9 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
31{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−{-# LANGUAGE DeriveGeneric #-}
6−{-# LANGUAGE DeriveLift #-}
7−{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
92{-# LANGUAGE LambdaCase #-}
10−{-# LANGUAGE MultiParamTypeClasses #-}
113{-# LANGUAGE OverloadedStrings #-}
124{-# LANGUAGE QuasiQuotes #-}
13−{-# LANGUAGE RankNTypes #-}
145{-# LANGUAGE RecordWildCards #-}
156{-# LANGUAGE RoleAnnotations #-}
16−{-# LANGUAGE ScopedTypeVariables #-}
177{-# LANGUAGE TemplateHaskellQuotes #-}
188{-# LANGUAGE TypeFamilies #-}
199{-# LANGUAGE UndecidableInstances #-}
@@ -29,61 +19,40 @@
2919--
3020-- The documentation below is structured in such a way that the most
3121-- important information is presented first: you learn how to do HTTP
32−-- requests, how to embed them in any monad you have, and then it gives you
22+-- requests, how to embed them in the monad you have, and then it gives you
3323-- details about less-common things you may want to know about. The
3424-- documentation is written with sufficient coverage of details and
3525-- examples, and it's designed to be a complete tutorial on its own.
3626--
37−-- /(A modest intro goes here, click on 'req' to start making requests.)/
38−--
3927-- === About the library
4028--
41−-- Req is an easy-to-use, type-safe, expandable, high-level HTTP client
42−-- library that just works without any fooling around.
43−--
44−-- What does the phrase “easy-to-use” mean? It means that the library is
45−-- designed to be beginner-friendly so it's simple to add to your monad
46−-- stack, intuitive to work with, well-documented, and does not get in your
47−-- way. Doing HTTP requests is a common task and Haskell library for this
48−-- should be very approachable and clear to beginners, thus certain
49−-- compromises were made. For example, one cannot currently modify
50−-- 'L.ManagerSettings' of the default manager because the library always
51−-- uses the same implicit global manager for simplicity and maximal
52−-- connection sharing. There is a way to use your own manager with different
53−-- settings, but it requires a bit more typing.
54−--
55−-- “Type-safe” means that the library is protective and eliminates certain
56−-- classes of errors. For example, we have correct-by-construction 'Url's,
57−-- it's guaranteed that the user does not send the request body when using
58−-- methods like 'GET' or 'OPTIONS', and the amount of implicit assumptions
59−-- is minimized by making the user specify his\/her intentions in an
60−-- explicit form (for example, it's not possible to avoid specifying the
61−-- body or method of request). Authentication methods that assume HTTPS
62−-- force the user to use HTTPS at the type level. The library also carefully
63−-- hides underlying types from the lower-level @http-client@ package because
64−-- those types are not safe enough (for example 'L.Request' is an instance
65−-- of 'Data.String.IsString' and, if it's malformed, it will blow up at
66−-- run-time).
67−--
68−-- “Expandable” refers to the ability of the library to be expanded without
69−-- having to resort to ugly hacking. For example, it's possible to define
70−-- your own HTTP methods, create new ways to construct the body of a
71−-- request, create new authorization options, perform a request in a
72−-- different way, and create your own methods to parse and represent a
73−-- response. As the user extends the library to satisfy his\/her special
74−-- needs, the new solutions will work just like the built-ins. However, all
75−-- of the common cases are also covered by the library out-of-the-box.
76−--
77−-- “High-level” means that there are less details to worry about. The
78−-- library is a result of my experiences as a Haskell consultant. Working
79−-- for several clients, who had very different projects, showed me that the
80−-- library should adapt easily to any particular style of writing Haskell
81−-- applications. For example, some people prefer throwing exceptions, while
82−-- others are concerned with purity. Just define 'handleHttpException'
83−-- accordingly when making your monad instance of 'MonadHttp' and it will
84−-- play together seamlessly. Finally, the library cuts down boilerplate
85−-- considerably, and helps you write concise, easy to read, and maintainable
86−-- code.
29+-- Req is an HTTP client library that attempts to be easy-to-use, type-safe,
30+-- and expandable.
31+--
32+-- “Easy-to-use” means that the library is designed to be beginner-friendly
33+-- so it's simple to add to your monad stack, intuitive to work with,
34+-- well-documented, and does not get in your way. Doing HTTP requests is a
35+-- common task and a Haskell library for this should be approachable and
36+-- clear to beginners, thus certain compromises were made. For example, one
37+-- cannot currently modify 'L.ManagerSettings' of the default manager
38+-- because the library always uses the same implicit global manager for
39+-- simplicity and maximal connection sharing. There is a way to use your own
40+-- manager with different settings, but it requires more typing.
41+--
42+-- “Type-safe” means that the library tries to eliminate certain classes of
43+-- errors. For example, we have correct-by-construction URLs; it is
44+-- 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
46+-- minimized by making the user specify their intentions in an explicit
47+-- form. For example, it's not possible to avoid specifying the body or the
48+-- method of a request. Authentication methods that assume HTTPS force the
49+-- user to use HTTPS at the type level.
50+--
51+-- “Expandable” refers to the ability to create new components without
52+-- having to resort to hacking. For example, it's possible to define your
53+-- own HTTP methods, create new ways to construct the body of a request,
54+-- create new authorization options, perform a request in a different way,
55+-- and create your own methods to parse a response.
8756--
8857-- === Using with other libraries
8958--
@@ -112,6 +81,7 @@ module Network.HTTP.Req
11281 -- $making-a-request
11382 req,
11483 reqBr,
84+ reqCb,
11585 req',
11686 withReqManager,
11787
@@ -149,6 +119,7 @@ module Network.HTTP.Req
149119 useHttpsURI,
150120 useURI,
151121 urlQ,
122+ renderUrl,
152123
153124 -- ** Body
154125 -- $body
@@ -173,11 +144,13 @@ module Network.HTTP.Req
173144 -- $query-parameters
174145 (=:),
175146 queryFlag,
147+ formToQuery,
176148 QueryParam (..),
177149
178150 -- *** Headers
179151 header,
180152 attachHeader,
153+ headerRedacted,
181154
182155 -- *** Cookies
183156 -- $cookies
@@ -224,56 +197,78 @@ module Network.HTTP.Req
224197
225198 -- * Other
226199 HttpException (..),
200+ isStatusCodeException,
227201 CanHaveBody (..),
228202 Scheme (..),
229203 )
230204where
231205
232−import qualified Blaze.ByteString.Builder as BB
206+import Blaze.ByteString.Builder qualified as BB
233207import Control.Applicative
234208import Control.Arrow (first, second)
235−import Control.Exception hiding (TypeError)
209+import Control.Exception hiding (Handler (..), TypeError)
210+import Control.Monad (guard, void, (>=>))
236211import Control.Monad.Base
212+import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
237213import Control.Monad.IO.Class
238−import Control.Monad.Reader
214+import Control.Monad.IO.Unlift
215+import Control.Monad.Reader (ReaderT (ReaderT), ask, lift, runReaderT)
216+import Control.Monad.Trans.Accum (AccumT)
217+import Control.Monad.Trans.Cont (ContT)
239218import 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
240231import Control.Retry
241232import Data.Aeson (FromJSON (..), ToJSON (..))
242−import qualified Data.Aeson as A
233+import Data.Aeson qualified as A
243234import Data.ByteString (ByteString)
244−import qualified Data.ByteString as B
245−import qualified Data.ByteString.Lazy as BL
246−import qualified Data.CaseInsensitive as CI
235+import Data.ByteString qualified as B
236+import Data.ByteString.Lazy qualified as BL
237+import Data.CaseInsensitive qualified as CI
247238import Data.Data (Data)
239+import Data.Default.Class (def)
248240import Data.Function (on)
249241import Data.IORef
250242import Data.Kind (Constraint, Type)
251243import Data.List (foldl', nubBy)
252244import Data.List.NonEmpty (NonEmpty (..))
253−import qualified Data.List.NonEmpty as NE
245+import Data.List.NonEmpty qualified as NE
254246import Data.Maybe (fromMaybe)
255247import Data.Proxy
256−import Data.Semigroup hiding (Option, option)
248+import Data.Semigroup (Endo (..))
249+import Data.Set qualified as S
257250import Data.Text (Text)
258−import qualified Data.Text as T
259−import qualified Data.Text.Encoding as T
251+import Data.Text qualified as T
252+import Data.Text.Encoding qualified as T
260253import Data.Typeable (Typeable, cast)
261254import GHC.Generics
262255import GHC.TypeLits
263−import qualified Language.Haskell.TH as TH
264−import qualified Language.Haskell.TH.Quote as TH
265−import qualified Language.Haskell.TH.Syntax as TH
266−import qualified Network.Connection as NC
267−import qualified Network.HTTP.Client as L
268−import qualified Network.HTTP.Client.Internal as LI
269−import qualified Network.HTTP.Client.MultipartFormData as LM
270−import qualified Network.HTTP.Client.TLS as L
271−import qualified Network.HTTP.Types as Y
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
272265import System.IO.Unsafe (unsafePerformIO)
273266import Text.URI (URI)
274−import qualified Text.URI as URI
275−import qualified Text.URI.QQ as QQ
276−import qualified Web.Authenticate.OAuth as OAuth
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
277272import Web.HttpApiData (ToHttpApiData (..))
278273
279274----------------------------------------------------------------------------
@@ -298,7 +293,7 @@ import Web.HttpApiData (ToHttpApiData (..))
298293--
299294-- @body@ is a body option such as 'NoReqBody' or 'ReqBodyJson'. The
300295-- tutorial has a section about HTTP bodies, but usage is very
301−-- straightforward and should be clear from the examples below.
296+-- straightforward and should be clear from the examples.
302297--
303298-- @response@ is a type hint how to make and interpret response of an HTTP
304299-- request. Out-of-the-box it can be the following:
@@ -426,12 +421,7 @@ req ::
426421 -- | Response
427422 m response
428423req method url body responseProxy options =
429− reqBr method url body (options <> extraOptions) getHttpResponse
430− where
431− extraOptions =
432− case acceptHeader responseProxy of
433− Nothing -> mempty
434− Just accept -> header "Accept" accept
424+ reqCb method url body responseProxy options pure
435425
436426-- | A version of 'req' that does not use one of the predefined instances of
437427-- 'HttpResponse' but instead allows the user to consume @'L.Response'
@@ -456,7 +446,58 @@ reqBr ::
456446 (L.Response L.BodyReader -> IO a) ->
457447 -- | Result
458448 m a
459−reqBr method url body options consume = req' method url body options $ \request manager -> do
449+reqBr method url body options consume =
450+ req' method url body options (reqHandler consume)
451+
452+-- | A version of 'req' that takes a callback to modify the 'L.Request', but
453+-- otherwise performs the request identically.
454+--
455+-- @since 3.7.0
456+reqCb ::
457+ ( MonadHttp m,
458+ HttpMethod method,
459+ HttpBody body,
460+ HttpResponse response,
461+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
462+ ) =>
463+ -- | HTTP method
464+ method ->
465+ -- | 'Url'—location of resource
466+ Url scheme ->
467+ -- | Body of the request
468+ body ->
469+ -- | A hint how to interpret response
470+ Proxy response ->
471+ -- | Collection of optional parameters
472+ Option scheme ->
473+ -- | Callback to modify the request
474+ (L.Request -> m L.Request) ->
475+ -- | Response
476+ m response
477+reqCb method url body responseProxy options adjustRequest =
478+ req' method url body (options <> extraOptions) $ \request manager -> do
479+ request' <- adjustRequest request
480+ reqHandler getHttpResponse request' manager
481+ where
482+ extraOptions =
483+ case acceptHeader responseProxy of
484+ Nothing -> mempty
485+ Just accept -> header "Accept" accept
486+
487+-- | The default handler function that the higher-level request functions
488+-- pass to 'req''. Internal function.
489+--
490+-- @since 3.7.0
491+reqHandler ::
492+ (MonadHttp m) =>
493+ -- | How to get final result from a 'L.Response'
494+ (L.Response L.BodyReader -> IO b) ->
495+ -- | 'L.Request' to perform
496+ L.Request ->
497+ -- | 'L.Manager' to use
498+ L.Manager ->
499+ m b
500+reqHandler consume request manager = do
460501 HttpConfig {..} <- getHttpConfig
461502 let wrapVanilla = handle (throwIO . VanillaHttpException)
462503 wrapExc = handle (throwIO . LI.toHttpException request)
@@ -472,12 +513,23 @@ reqBr method url body options consume = req' method url body options $ \request
472513 r' <- L.responseOpen request manager
473514 writeIORef rref (Just r')
474515 return r'
516+ exceptionRetryPolicies =
517+ skipAsyncExceptions
518+ ++ [ \retryStatus -> Handler $ \e ->
519+ return $ httpConfigRetryJudgeException retryStatus e
520+ ]
475521 r <-
476522 retrying
477523 httpConfigRetryPolicy
478− (\st r -> return $ httpConfigRetryJudge st r)
479− (const openResponse)
480− (preview, r') <- grabPreview bodyPreviewLength r
524+ (\retryStatus r -> return $ httpConfigRetryJudge retryStatus r)
525+ ( const
526+ ( recovering
527+ httpConfigRetryPolicy
528+ exceptionRetryPolicies
529+ (const openResponse)
530+ )
531+ )
532+ (preview, r') <- grabPreview httpConfigBodyPreviewLength r
481533 mapM_ LI.throwHttp (httpConfigCheckResponse request r' preview)
482534 consume r'
483535 )
@@ -526,22 +578,22 @@ req' method url body options m = do
526578 nubHeaders
527579 <> getRequestMod options
528580 <> getRequestMod config
529− <> getRequestMod (Womb body :: Womb "body" body)
581+ <> getRequestMod (Tagged body :: Tagged "body" body)
530582 <> getRequestMod url
531− <> getRequestMod (Womb method :: Womb "method" method)
583+ <> getRequestMod (Tagged method :: Tagged "method" method)
532584 request <- finalizeRequest options request'
533585 withReqManager (m request)
534586
535587-- | Perform an action using the global implicit 'L.Manager' that the rest
536−-- of the library uses. This allows to reuse connections that the
588+-- of the library uses. This allows us to reuse connections that the
537589-- 'L.Manager' controls.
538−withReqManager :: MonadIO m => (L.Manager -> m a) -> m a
539−withReqManager m = liftIO (readIORef globalManager) >>= m
590+withReqManager :: (MonadIO m) => (L.Manager -> m a) -> m a
591+withReqManager m = m globalManager
540592
541−-- | Global 'L.Manager' that 'req' uses. Here we just go with the default
542−-- settings, so users don't need to deal with this manager stuff at all, but
543−-- when we create a request, instance 'HttpConfig' can affect the default
544−-- settings via 'getHttpConfig'.
593+-- | The global 'L.Manager' that 'req' uses. Here we just go with the
594+-- default settings, so users don't need to deal with this manager stuff at
595+-- all, but when we create a request, instance 'HttpConfig' can affect the
596+-- default settings via 'getHttpConfig'.
545597--
546598-- A note about safety, in case 'unsafePerformIO' looks suspicious to you.
547599-- The value of 'globalManager' is named and lives on top level. This means
@@ -549,16 +601,16 @@ withReqManager m = liftIO (readIORef globalManager) >>= m
549601-- manager. From that moment on the 'IORef' will be just reused—exactly the
550602-- behavior we want here in order to maximize connection sharing. GHC could
551603-- spoil the plan by inlining the definition, hence the @NOINLINE@ pragma.
552−globalManager :: IORef L.Manager
604+globalManager :: L.Manager
553605globalManager = unsafePerformIO $ do
554606 context <- NC.initConnectionContext
555607 let settings =
556608 L.mkManagerSettingsContext
557609 (Just context)
558− (NC.TLSSettingsSimple False False False)
610+ def
559611 Nothing
560612 manager <- L.newManager settings
561− newIORef manager
613+ return manager
562614{-# NOINLINE globalManager #-}
563615
564616----------------------------------------------------------------------------
@@ -572,13 +624,13 @@ globalManager = unsafePerformIO $ do
572624-- When writing a library, keep your API polymorphic in terms of
573625-- 'MonadHttp', only define instance of 'MonadHttp' in final application.
574626-- Another option is to use a @newtype@-wrapped monad stack and define
575−-- 'MonadHttp' for it. As of version /0.4.0/, the 'Req' monad that follows
576−-- this strategy is provided out-of-the-box (see below).
627+-- 'MonadHttp' for it. As of the version /0.4.0/, the 'Req' monad that
628+-- follows this strategy is provided out-of-the-box (see below).
577629
578630-- | A type class for monads that support performing HTTP requests.
579631-- Typically, you only need to define the 'handleHttpException' method
580632-- unless you want to tweak 'HttpConfig'.
581−class MonadIO m => MonadHttp m where
633+class (MonadIO m) => MonadHttp m where
582634 -- | This method describes how to deal with 'HttpException' that was
583635 -- caught by the library. One option is to re-throw it if you are OK with
584636 -- exceptions, but if you prefer working with something like
@@ -586,17 +638,16 @@ class MonadIO m => MonadHttp m where
586638 -- 'Control.Monad.Except.throwError'.
587639 handleHttpException :: HttpException -> m a
588640
589− -- | Return 'HttpConfig' to be used when performing HTTP requests. Default
590− -- implementation returns its 'def' value, which is described in the
591− -- documentation for the type. Common usage pattern with manually defined
592− -- 'getHttpConfig' is to return some hard-coded value, or a value
641+ -- | Return the 'HttpConfig' to be used when performing HTTP requests.
642+ -- Default implementation returns its 'def' value, which is described in
643+ -- the documentation for the type. Common usage pattern with manually
644+ -- defined 'getHttpConfig' is to return some hard-coded value, or a value
593645 -- extracted from 'Control.Monad.Reader.MonadReader' if a more flexible
594646 -- approach to configuration is desirable.
595647 getHttpConfig :: m HttpConfig
596648 getHttpConfig = return defaultHttpConfig
597649
598−-- | 'HttpConfig' contains general and default settings to be used when
599−-- making HTTP requests.
650+-- | 'HttpConfig' contains settings to be used when making HTTP requests.
600651data HttpConfig = HttpConfig
601652 { -- | Proxy to use. By default values of @HTTP_PROXY@ and @HTTPS_PROXY@
602653 -- environment variables are respected, this setting overwrites them.
@@ -640,8 +691,8 @@ data HttpConfig = HttpConfig
640691 -- | The retry policy to use for request retrying. By default 'def' is
641692 -- used (see 'RetryPolicyM').
642693 --
643− -- __Note__: signature of this function was changed in the version
644− -- /1.0.0/.
694+ -- __Note__: signature of this function was changed to disallow 'IO' in
695+ -- version /1.0.0/ and then changed back to its current form in /3.1.0/.
645696 --
646697 -- @since 0.3.0
647698 httpConfigRetryPolicy :: RetryPolicyM IO,
@@ -652,11 +703,21 @@ data HttpConfig = HttpConfig
652703 -- /1.0.0/.
653704 --
654705 -- @since 0.3.0
655− httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool
706+ httpConfigRetryJudge :: forall b. RetryStatus -> L.Response b -> Bool,
707+ -- | Similar to 'httpConfigRetryJudge', but is used to decide when to
708+ -- retry requests that resulted in an exception. By default it retries
709+ -- on response timeout and connection timeout (changed in version
710+ -- /3.8.0/).
711+ --
712+ -- @since 3.4.0
713+ httpConfigRetryJudgeException :: RetryStatus -> SomeException -> Bool,
714+ -- | Max length of preview fragment of response body.
715+ --
716+ -- @since 3.6.0
717+ httpConfigBodyPreviewLength :: forall a. (Num a) => a
656718 }
657− deriving (Typeable)
658719
659−-- | Default value of 'HttpConfig'.
720+-- | The default value of 'HttpConfig'.
660721--
661722-- @since 2.0.0
662723defaultHttpConfig :: HttpConfig
@@ -678,7 +739,16 @@ defaultHttpConfig =
678739 524, -- A timeout occurred
679740 598, -- (Informal convention) Network read timeout error
680741 599 -- (Informal convention) Network connect timeout error
681− ]
742+ ],
743+ httpConfigRetryJudgeException = \_ e ->
744+ case fromException e of
745+ Just (L.HttpExceptionRequest _ c) ->
746+ case c of
747+ L.ResponseTimeout -> True
748+ L.ConnectionTimeout -> True
749+ _ -> False
750+ _ -> False,
751+ httpConfigBodyPreviewLength = 1024
682752 }
683753 where
684754 statusCode = Y.statusCode . L.responseStatus
@@ -691,7 +761,7 @@ instance RequestComponent HttpConfig where
691761 LI.requestManagerOverride = httpConfigAltManager
692762 }
693763
694−-- | A monad that allows to run 'req' in any 'IO'-enabled monad without
764+-- | A monad that allows us to run 'req' in any 'IO'-enabled monad without
695765-- having to define new instances.
696766--
697767-- @since 0.4.0
@@ -700,9 +770,19 @@ newtype Req a = Req (ReaderT HttpConfig IO a)
700770 ( Functor,
701771 Applicative,
702772 Monad,
703− MonadIO
773+ MonadIO,
774+ MonadUnliftIO
704775 )
705776
777+-- | @since 3.7.0
778+deriving instance MonadThrow Req
779+
780+-- | @since 3.7.0
781+deriving instance MonadCatch Req
782+
783+-- | @since 3.7.0
784+deriving instance MonadMask Req
785+
706786instance MonadBase IO Req where
707787 liftBase = liftIO
708788
@@ -717,12 +797,87 @@ instance MonadHttp Req where
717797 handleHttpException = Req . lift . throwIO
718798 getHttpConfig = Req ask
719799
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+
720875-- | Run a computation in the 'Req' monad with the given 'HttpConfig'. In
721−-- case of exceptional situation an 'HttpException' will be thrown.
876+-- the case of an exceptional situation an 'HttpException' will be thrown.
722877--
723878-- @since 0.4.0
724879runReq ::
725− MonadIO m =>
880+ (MonadIO m) =>
726881 -- | 'HttpConfig' to use
727882 HttpConfig ->
728883 -- | Computation to run
@@ -770,14 +925,15 @@ instance HttpMethod PUT where
770925 type AllowsBody PUT = 'CanHaveBody
771926 httpMethodName Proxy = Y.methodPut
772927
773−-- | 'DELETE' method. This data type does not allow having request body with
774−-- 'DELETE' requests, as it should be. However some APIs may expect 'DELETE'
775−-- requests to have bodies, in that case define your own variation of
776−-- 'DELETE' method and allow it to have a body.
928+-- | 'DELETE' method. RFC 7231 allows a payload in DELETE but without
929+-- semantics.
930+--
931+-- __Note__: before version /3.4.0/ this method did not allow request
932+-- bodies.
777933data DELETE = DELETE
778934
779935instance HttpMethod DELETE where
780− type AllowsBody DELETE = 'NoBody
936+ type AllowsBody DELETE = 'CanHaveBody
781937 httpMethodName Proxy = Y.methodDelete
782938
783939-- | 'TRACE' method.
@@ -826,7 +982,7 @@ class HttpMethod a where
826982 -- | Return name of the method as a 'ByteString'.
827983 httpMethodName :: Proxy a -> ByteString
828984
829−instance HttpMethod method => RequestComponent (Womb "method" method) where
985+instance (HttpMethod method) => RequestComponent (Tagged "method" method) where
830986 getRequestMod _ = Endo $ \x ->
831987 x {L.method = httpMethodName (Proxy :: Proxy method)}
832988
@@ -868,23 +1024,20 @@ instance HttpMethod method => RequestComponent (Womb "method" method) where
8681024-- > -- https://%D1%8E%D0%BD%D0%B8%D0%BA%D0%BE%D0%B4.%D1%80%D1%84
8691025data Url (scheme :: Scheme) = Url Scheme (NonEmpty Text)
8701026 -- NOTE The second value is the path segments in reversed order.
871− deriving (Eq, Ord, Show, Data, Typeable, Generic)
1027+ deriving (Eq, Ord, Show, Data, Generic)
8721028
8731029type role Url nominal
8741030
8751031-- With template-haskell >=2.15 and text >=1.2.4 Lift can be derived, however
876−-- the derived lift forgets the type of scheme.
877−instance Typeable scheme => TH.Lift (Url scheme) where
1032+-- the derived lift forgets the type of the scheme.
1033+instance (Typeable scheme) => TH.Lift (Url scheme) where
8781034 lift url =
8791035 TH.dataToExpQ (fmap liftText . cast) url `TH.sigE` case url of
8801036 Url Http _ -> [t|Url 'Http|]
8811037 Url Https _ -> [t|Url 'Https|]
8821038 where
8831039 liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
884−
885−#if MIN_VERSION_template_haskell(2,16,0)
886− liftTyped url = TH.TExp <$> TH.lift url
887−#endif
1040+ liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
8881041
8891042-- | Given host name, produce a 'Url' which has “http” as its scheme and
8901043-- empty path. This also sets port to @80@.
@@ -896,20 +1049,33 @@ http = Url Http . pure
8961049https :: Text -> Url 'Https
8971050https = Url Https . pure
8981051
899−-- | Grow given 'Url' appending a single path segment to it. Note that the
1052+-- | Grow a given 'Url' appending a single path segment to it. Note that the
9001053-- path segment can be of any type that is an instance of 'ToHttpApiData'.
9011054infixl 5 /~
9021055
903−(/~) :: ToHttpApiData a => Url scheme -> a -> Url scheme
1056+(/~) :: (ToHttpApiData a) => Url scheme -> a -> Url scheme
9041057Url secure path /~ segment = Url secure (NE.cons (toUrlPiece segment) path)
9051058
906−-- | Type-constrained version of @('/~')@ to remove ambiguity in the cases
1059+-- | A type-constrained version of @('/~')@ to remove ambiguity in the cases
9071060-- when next URL piece is a 'Data.Text.Text' literal.
9081061infixl 5 /:
9091062
9101063(/:) :: Url scheme -> Text -> Url scheme
9111064(/:) = (/~)
9121065
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+
9131079-- | The 'useHttpURI' function provides an alternative method to get 'Url'
9141080-- (possibly with some 'Option's) from a 'URI'. This is useful when you are
9151081-- given a URL to query dynamically and don't know it beforehand.
@@ -923,8 +1089,7 @@ useHttpURI uri = do
9231089 urlHead <- http <$> uriHost uri
9241090 let url = case URI.uriPath uri of
9251091 Nothing -> urlHead
926− Just (_, xs) ->
927− foldl' (/:) urlHead (URI.unRText <$> NE.toList xs)
1092+ Just uriPath -> uriPathToUrl uriPath urlHead
9281093 return (url, uriOptions uri)
9291094
9301095-- | Just like 'useHttpURI', but expects the “https” scheme.
@@ -936,10 +1101,21 @@ useHttpsURI uri = do
9361101 urlHead <- https <$> uriHost uri
9371102 let url = case URI.uriPath uri of
9381103 Nothing -> urlHead
939− Just (_, xs) ->
940− foldl' (/:) urlHead (URI.unRText <$> NE.toList xs)
1104+ Just uriPath -> uriPathToUrl uriPath urlHead
9411105 return (url, uriOptions uri)
9421106
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+
9431119-- | A combination of 'useHttpURI' and 'useHttpsURI' for cases when scheme
9441120-- is not known in advance.
9451121--
@@ -1056,21 +1232,21 @@ data NoReqBody = NoReqBody
10561232instance HttpBody NoReqBody where
10571233 getRequestBody NoReqBody = L.RequestBodyBS B.empty
10581234
1059−-- | This body option allows to use a JSON object as request body—probably
1060−-- the most popular format right now. Just wrap a data type that is an
1061−-- instance of 'ToJSON' type class and you are done: it will be converted to
1062−-- JSON and inserted as request body.
1235+-- | This body option allows us to use a JSON object as the request
1236+-- body—probably the most popular format right now. Just wrap a data type
1237+-- that is an instance of 'ToJSON' type class and you are done: it will be
1238+-- converted to JSON and inserted as request body.
10631239--
10641240-- This body option sets the @Content-Type@ header to @\"application/json;
10651241-- charset=utf-8\"@ value.
10661242newtype ReqBodyJson a = ReqBodyJson a
10671243
1068−instance ToJSON a => HttpBody (ReqBodyJson a) where
1244+instance (ToJSON a) => HttpBody (ReqBodyJson a) where
10691245 getRequestBody (ReqBodyJson a) = L.RequestBodyLBS (A.encode a)
10701246 getRequestContentType _ = pure "application/json; charset=utf-8"
10711247
10721248-- | This body option streams request body from a file. It is expected that
1073−-- the file size does not change during the streaming.
1249+-- the file size does not change during streaming.
10741250--
10751251-- Using of this body option does not set the @Content-Type@ header.
10761252newtype ReqBodyFile = ReqBodyFile FilePath
@@ -1095,12 +1271,11 @@ newtype ReqBodyLbs = ReqBodyLbs BL.ByteString
10951271instance HttpBody ReqBodyLbs where
10961272 getRequestBody (ReqBodyLbs bs) = L.RequestBodyLBS bs
10971273
1098−-- | Form URL-encoded body. This can hold a collection of parameters which
1099−-- are encoded similarly to query parameters at the end of query string,
1100−-- with the only difference that they are stored in request body. The
1101−-- similarity is reflected in the API as well, as you can use the same
1102−-- combinators you would use to add query parameters: @('=:')@ and
1103−-- 'queryFlag'.
1274+-- | URL-encoded body. This can hold a collection of parameters which are
1275+-- encoded similarly to query parameters at the end of query string, with
1276+-- the only difference that they are stored in request body. The similarity
1277+-- is reflected in the API as well, as you can use the same combinators you
1278+-- would use to add query parameters: @('=:')@ and 'queryFlag'.
11041279--
11051280-- This body option sets the @Content-Type@ header to
11061281-- @\"application/x-www-form-urlencoded\"@ value.
@@ -1119,6 +1294,13 @@ newtype FormUrlEncodedParam = FormUrlEncodedParam [(Text, Maybe Text)]
11191294instance QueryParam FormUrlEncodedParam where
11201295 queryParam name mvalue =
11211296 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
11221304
11231305-- | Multipart form data. Please consult the
11241306-- "Network.HTTP.Client.MultipartFormData" module for how to construct
@@ -1158,7 +1340,7 @@ instance HttpBody ReqBodyMultipart where
11581340-- | Create 'ReqBodyMultipart' request body from a collection of 'LM.Part's.
11591341--
11601342-- @since 0.2.0
1161−reqBodyMultipart :: MonadIO m => [LM.Part] -> m ReqBodyMultipart
1343+reqBodyMultipart :: (MonadIO m) => [LM.Part] -> m ReqBodyMultipart
11621344reqBodyMultipart parts = liftIO $ do
11631345 boundary <- LM.webkitBoundary
11641346 body <- LM.renderParts boundary parts
@@ -1186,9 +1368,6 @@ type family ProvidesBody body :: CanHaveBody where
11861368-- | This type function allows any HTTP body if method says it
11871369-- 'CanHaveBody'. When the method says it should have 'NoBody', the only
11881370-- body option to use is 'NoReqBody'.
1189−--
1190−-- __Note__: users of GHC 8.0.1 and later will see a slightly more friendly
1191−-- error message when method does not allow a body and body is provided.
11921371type family
11931372 HttpBodyAllowed
11941373 (allowsBody :: CanHaveBody)
@@ -1201,8 +1380,8 @@ type family
12011380 TypeError
12021381 ('Text "This HTTP method does not allow attaching a request body.")
12031382
1204−instance HttpBody body => RequestComponent (Womb "body" body) where
1205− getRequestMod (Womb body) = Endo $ \x ->
1383+instance (HttpBody body) => RequestComponent (Tagged "body" body) where
1384+ getRequestMod (Tagged body) = Endo $ \x ->
12061385 x
12071386 { L.requestBody = getRequestBody body,
12081387 L.requestHeaders =
@@ -1231,8 +1410,8 @@ data Option (scheme :: Scheme)
12311410 = Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))
12321411
12331412-- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
1234−-- Request to avoid appending to existing query string in request every
1235−-- time new parameter is added. Additional Maybe (L.Request -> IO
1413+-- Request to avoid appending to an existing query string in request every
1414+-- time new parameter is added. The additional Maybe (L.Request -> IO
12361415-- L.Request) is a finalizer that will be applied after all other
12371416-- transformations. This is for authentication methods that sign requests
12381417-- based on data in Request.
@@ -1247,6 +1426,12 @@ instance Monoid (Option scheme) where
12471426 mempty = Option mempty Nothing
12481427 mappend = (<>)
12491428
1429+-- | Use 'formToQuery'.
1430+--
1431+-- @since 3.11.0
1432+instance FromForm (Option scheme) where
1433+ fromForm = Right . formToQuery
1434+
12501435-- | A helper to create an 'Option' that modifies only collection of query
12511436-- parameters. This helper is not a part of the public API.
12521437withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
@@ -1265,7 +1450,7 @@ instance RequestComponent (Option scheme) where
12651450
12661451-- | Finalize given 'L.Request' by applying a finalizer from the given
12671452-- 'Option' (if it has any).
1268−finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
1453+finalizeRequest :: (MonadIO m) => Option scheme -> L.Request -> m L.Request
12691454finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
12701455
12711456----------------------------------------------------------------------------
@@ -1289,7 +1474,7 @@ infix 7 =:
12891474(=:) :: (QueryParam param, ToHttpApiData a) => Text -> a -> param
12901475name =: value = queryParam name (pure value)
12911476
1292−-- | Construct a flag, that is, valueless query parameter. For example, in
1477+-- | Construct a flag, that is, a valueless query parameter. For example, in
12931478-- the following URL @\"a\"@ is a flag, while @\"b\"@ is a query parameter
12941479-- with a value:
12951480--
@@ -1298,9 +1483,27 @@ name =: value = queryParam name (pure value)
12981483-- This operator is defined in terms of 'queryParam':
12991484--
13001485-- > queryFlag name = queryParam name (Nothing :: Maybe ())
1301−queryFlag :: QueryParam param => Text -> param
1486+queryFlag :: (QueryParam param) => Text -> param
13021487queryFlag name = queryParam name (Nothing :: Maybe ())
13031488
1489+-- | Construct query parameters from a 'ToForm' instance. This function
1490+-- produces the same query params as 'Form.urlEncodeAsFormStable'.
1491+--
1492+-- Note that 'Form.Form' doesn't have the concept of parameters with the
1493+-- empty value (i.e. what you can get by @key =: ""@). If the value is
1494+-- empty, it will be encoded as a valueless parameter (i.e. what you can get
1495+-- by @queryFlag key@).
1496+--
1497+-- @since 3.11.0
1498+formToQuery :: (QueryParam param, Monoid param, ToForm f) => f -> param
1499+formToQuery f = mconcat . fmap toParam . Form.toListStable $ toForm f
1500+ where
1501+ toParam (key, val) =
1502+ queryParam key $
1503+ if val == ""
1504+ then Nothing
1505+ else Just val
1506+
13041507-- | A type class for query-parameter-like things. The reason to have an
13051508-- overloaded 'queryParam' is to be able to use it as an 'Option' and as a
13061509-- 'FormUrlEncodedParam' when constructing form URL encoded request bodies.
@@ -1310,11 +1513,17 @@ class QueryParam param where
13101513 -- 'Nothing', it won't be included at all (i.e. you create a flag this
13111514 -- way). It's recommended to use @('=:')@ and 'queryFlag' instead of this
13121515 -- method, because they are easier to read.
1313− queryParam :: ToHttpApiData a => Text -> Maybe a -> param
1516+ queryParam :: (ToHttpApiData a) => Text -> Maybe a -> param
1517+
1518+ -- | Get the query parameter names and values set by 'queryParam'.
1519+ --
1520+ -- @since 3.11.0
1521+ queryParamToList :: param -> [(Text, Maybe Text)]
13141522
13151523instance QueryParam (Option scheme) where
13161524 queryParam name mvalue =
13171525 withQueryParams ((:) (name, toQueryParam <$> mvalue))
1526+ queryParamToList (Option f _) = fst $ appEndo f ([], L.defaultRequest)
13181527
13191528----------------------------------------------------------------------------
13201529-- Request—Optional parameters—Headers
@@ -1338,6 +1547,14 @@ attachHeader :: ByteString -> ByteString -> L.Request -> L.Request
13381547attachHeader name value x =
13391548 x {L.requestHeaders = (CI.mk name, value) : L.requestHeaders x}
13401549
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+
13411558----------------------------------------------------------------------------
13421559-- Request—Optional parameters—Cookies
13431560
@@ -1479,7 +1696,7 @@ customAuth = Option mempty . pure
14791696
14801697-- | Specify the port to connect to explicitly. Normally, 'Url' you use
14811698-- determines the default port: @80@ for HTTP and @443@ for HTTPS. This
1482−-- 'Option' allows to choose an arbitrary port overwriting the defaults.
1699+-- 'Option' allows us to choose an arbitrary port overwriting the defaults.
14831700port :: Int -> Option scheme
14841701port n = withRequest $ \x ->
14851702 x {L.port = n}
@@ -1494,8 +1711,8 @@ port n = withRequest $ \x ->
14941711--
14951712-- > decompress (const True)
14961713decompress ::
1497− -- | Predicate that is given MIME type, it
1498− -- returns 'True' when content should be decompressed on the fly.
1714+ -- | Predicate that is given MIME type, it returns 'True' when content
1715+ -- should be decompressed on the fly.
14991716 (ByteString -> Bool) ->
15001717 Option scheme
15011718decompress f = withRequest $ \x ->
@@ -1545,7 +1762,7 @@ ignoreResponse = Proxy
15451762newtype JsonResponse a = JsonResponse (L.Response a)
15461763 deriving (Show)
15471764
1548−instance FromJSON a => HttpResponse (JsonResponse a) where
1765+instance (FromJSON a) => HttpResponse (JsonResponse a) where
15491766 type HttpResponseBody (JsonResponse a) = a
15501767 toVanillaResponse (JsonResponse r) = r
15511768 getHttpResponse r = do
@@ -1597,7 +1814,7 @@ lbsResponse = Proxy
15971814----------------------------------------------------------------------------
15981815-- Helpers for response interpretations
15991816
1600−-- | Fetch beginning of response and return it together with new
1817+-- | Fetch beginning of the response and return it together with a new
16011818-- @'L.Response' 'L.BodyReader'@ that can be passed to 'getHttpResponse' and
16021819-- such.
16031820grabPreview ::
@@ -1661,14 +1878,14 @@ brReadN br n = go 0 id id
16611878
16621879-- | Get the response body.
16631880responseBody ::
1664− HttpResponse response =>
1881+ (HttpResponse response) =>
16651882 response ->
16661883 HttpResponseBody response
16671884responseBody = L.responseBody . toVanillaResponse
16681885
16691886-- | Get the response status code.
16701887responseStatusCode ::
1671− HttpResponse response =>
1888+ (HttpResponse response) =>
16721889 response ->
16731890 Int
16741891responseStatusCode =
@@ -1676,7 +1893,7 @@ responseStatusCode =
16761893
16771894-- | Get the response status message.
16781895responseStatusMessage ::
1679− HttpResponse response =>
1896+ (HttpResponse response) =>
16801897 response ->
16811898 ByteString
16821899responseStatusMessage =
@@ -1684,7 +1901,7 @@ responseStatusMessage =
16841901
16851902-- | Lookup a particular header from a response.
16861903responseHeader ::
1687− HttpResponse response =>
1904+ (HttpResponse response) =>
16881905 -- | Response interpretation
16891906 response ->
16901907 -- | Header to lookup
@@ -1696,7 +1913,7 @@ responseHeader r h =
16961913
16971914-- | Get the response 'L.CookieJar'.
16981915responseCookieJar ::
1699− HttpResponse response =>
1916+ (HttpResponse response) =>
17001917 response ->
17011918 L.CookieJar
17021919responseCookieJar = L.responseCookieJar . toVanillaResponse
@@ -1709,9 +1926,9 @@ responseCookieJar = L.responseCookieJar . toVanillaResponse
17091926-- To create a new response interpretation you just need to make your data
17101927-- type an instance of the 'HttpResponse' type class.
17111928
1712−-- | A type class for response interpretations. It allows to describe how to
1713−-- consume response from a @'L.Response' 'L.BodyReader'@ and produce the
1714−-- final result that is to be returned to the user.
1929+-- | A type class for response interpretations. It allows us to describe how
1930+-- to consume the response from a @'L.Response' 'L.BodyReader'@ and produce
1931+-- the final result that is to be returned to the user.
17151932class HttpResponse response where
17161933 -- | The associated type is the type of body that can be extracted from an
17171934 -- instance of 'HttpResponse'.
@@ -1750,6 +1967,16 @@ class HttpResponse response where
17501967 acceptHeader :: Proxy response -> Maybe ByteString
17511968 acceptHeader Proxy = Nothing
17521969
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+
17531980----------------------------------------------------------------------------
17541981-- Other
17551982
@@ -1775,7 +2002,7 @@ class RequestComponent a where
17752002-- method@ and @'HttpBody' body => 'RequestComponent' body@ when it decides
17762003-- which instance to use (i.e. the constraints are taken into account later,
17772004-- when instance is already chosen).
1778−newtype Womb (tag :: Symbol) a = Womb a
2005+newtype Tagged (tag :: Symbol) a = Tagged a
17792006
17802007-- | Exceptions that this library throws.
17812008data HttpException
@@ -1784,10 +2011,24 @@ data HttpException
17842011 | -- | A wrapper with Aeson-produced 'String' describing why decoding
17852012 -- failed
17862013 JsonHttpException String
1787− deriving (Show, Typeable, Generic)
2014+ deriving (Show, Generic)
17882015
17892016instance Exception HttpException
17902017
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+
17912032-- | A simple type isomorphic to 'Bool' that we only have for better error
17922033-- messages. We use it as a kind and its data constructors as type-level
17932034-- tags.
@@ -1807,11 +2048,4 @@ data Scheme
18072048 Http
18082049 | -- | HTTPS
18092050 Https
1810− deriving (Eq, Ord, Show, Data, Typeable, Generic, TH.Lift)
1811−
1812−----------------------------------------------------------------------------
1813−-- Constants
1814−
1815−-- | Max length of preview fragment of response body.
1816−bodyPreviewLength :: Num a => a
1817−bodyPreviewLength = 1024
2051+ deriving (Eq, Ord, Show, Data, Generic, TH.Lift)
README.md+28−124
@@ -4,10 +4,8 @@
44[![Hackage](https://img.shields.io/hackage/v/req.svg?style=flat)](https://hackage.haskell.org/package/req)
55[![Stackage Nightly](http://stackage.org/package/req/badge/nightly)](http://stackage.org/nightly/package/req)
66[![Stackage LTS](http://stackage.org/package/req/badge/lts)](http://stackage.org/lts/package/req)
7−[![Build Status](https://travis-ci.org/mrkkrp/req.svg?branch=master)](https://travis-ci.org/mrkkrp/req)
7+[![CI](https://github.com/mrkkrp/req/actions/workflows/ci.yaml/badge.svg)](https://github.com/mrkkrp/req/actions/workflows/ci.yaml)
88
9−* [Motivation and Req vs other libraries](#motivation-and-req-vs-other-libraries)
10−* [Unsolved problems](#unsolved-problems)
119* [Related packages](#related-packages)
1210* [Blog posts](#blog-posts)
1311* [Contribution](#contribution)
@@ -43,49 +41,33 @@ main = runReq defaultHttpConfig $ do
4341 liftIO $ print (responseBody r :: Value)
4442```
4543
46−Req is an easy-to-use, type-safe, expandable, high-level HTTP client library
47−that just works without any fooling around.
48−
49−What does the phrase “easy-to-use” mean? It means that the library is
50−designed to be beginner-friendly so it's simple to add to your monad stack,
51−intuitive to work with, well-documented, and does not get in your way. Doing
52−HTTP requests is a common task and Haskell library for this should be very
53−approachable and clear to beginners, thus certain compromises were made. For
54−example, one cannot currently modify `ManagerSettings` of the default
55−manager because the library always uses the same implicit global manager for
56−simplicity and maximal connection sharing. There is a way to use your own
57−manager with different settings, but it requires a bit more typing.
58−
59−“Type-safe” means that the library is protective and eliminates certain
60−classes of errors. For example, we have correct-by-construction URLs, it's
61−guaranteed that the user does not send the request body when using methods
62−like GET or OPTIONS, and the amount of implicit assumptions is minimized by
63−making the user specify his/her intentions in an explicit form (for example,
64−it's not possible to avoid specifying the body or method of request).
44+Req is an HTTP client library that attempts to be easy-to-use, type-safe,
45+and expandable.
46+
47+“Easy-to-use” means that the library is designed to be beginner-friendly so
48+it's simple to add to your monad stack, intuitive to work with,
49+well-documented, and does not get in your way. Doing HTTP requests is a
50+common task and a Haskell library for this should be approachable and clear
51+to beginners, thus certain compromises were made. For example, one cannot
52+currently modify `ManagerSettings` of the default manager because the
53+library always uses the same implicit global manager for simplicity and
54+maximal connection sharing. There is a way to use your own manager with
55+different settings, but it requires more typing.
56+
57+“Type-safe” means that the library tries to eliminate certain classes of
58+errors. For example, we have correct-by-construction URLs; it is guaranteed
59+that the user does not send the request body when using methods like GET or
60+OPTIONS, and the amount of implicit assumptions is minimized by making the
61+user specify their intentions in an explicit form. For example, it's not
62+possible to avoid specifying the body or the method of a request.
6563Authentication methods that assume HTTPS force the user to use HTTPS at the
66−type level. The library also carefully hides underlying types from the
67−lower-level `http-client` package because those types are not safe enough
68−(for example `Request` is an instance of `IsString` and, if it's malformed,
69−it will blow up at run-time).
70−
71−“Expandable” refers to the ability to create new components for dealing with
72−HTTP without having to resort to ugly hacking. For example, it's possible to
73−define your own HTTP methods, create new ways to construct the body of a
74−request, create new authorization options, perform a request in a different
75−way, and create your own methods to parse and represent a response. As the
76−user extends the library to satisfy his/her special needs, the new solutions
77−will work just like the built-ins. However, all of the common cases are also
78−covered by the library out-of-the-box.
79−
80−“High-level” means that there are less details to worry about. The library
81−is a result of my experiences as a Haskell consultant. Working for several
82−clients, who had very different projects, showed me that the library should
83−adapt easily to any particular style of writing Haskell applications. For
84−example, some people prefer throwing exceptions, while others are concerned
85−with purity. Just define `handleHttpException` accordingly when making your
86−monad instance of `MonadHttp` and it will play together seamlessly. Finally,
87−the library cuts down boilerplate considerably, and helps you write concise,
88−easy to read, and maintainable code.
64+type level.
65+
66+“Expandable” refers to the ability to create new components without having
67+to resort to hacking. For example, it's possible to define your own HTTP
68+methods, create new ways to construct the body of a request, create new
69+authorization options, perform a request in a different way, and create your
70+own methods to parse a response.
8971
9072The library uses the following mature packages under the hood to guarantee
9173you the best experience:
@@ -95,89 +77,11 @@ you the best experience:
9577* [`http-client-tls`](https://hackage.haskell.org/package/http-client-tls)—TLS
9678 (HTTPS) support for `http-client`.
9779
98−It's important to note that since we leverage well-known libraries that the
80+It is important to note that since we leverage well-known libraries that the
9981whole Haskell ecosystem uses, there is no risk in using Req. The machinery
10082for performing requests is the same as with `http-conduit` and Wreq. The
10183only difference is the API.
10284
103−## Motivation and Req vs other libraries
104−
105−*This section is my opinion and it contains criticisms of other well-known
106−libraries. If you're a user/fan of one of these libraries, please remember
107−not to react aggressively and respect the fact that I may have different
108−views on API design from yours.*
109−
110−I have spent time to write the library because sending HTTP requests is a
111−common need, but there is no high-level library for that in Haskell that I
112−could use with pleasure. I'll explain why.
113−
114−First of all, there is `http-client` and `http-client-tls`. They just work.
115−I have no issues with the libraries except that they are too low-level for
116−my taste. Indeed, even the docs say that they are low-level and “intended as
117−a base layer for more user-friendly packages”. This is exactly how I use
118−them in Req, as base level. Req is nothing but a different API to
119−`http-client`, so it only works because of the hard work put into
120−`http-client`.
121−
122−`http-conduit` definitely has its place. For one thing it allows you to
123−stream request and response bodies in constant memory, what other library
124−allows you to do that? On the other hand if you take a look at
125−`Network.HTTP.Simple`, then although it's said that it's a “higher level
126−API”, it's mostly the same as vanilla `http-client` in spirit/approach and
127−just adds `conduit`-powered functions to perform requests and allows to use
128−global implicit `Manager` (Req does the same). If I tried to frame what
129−exactly I don't like about `http-conduit` in words, then it would be “the
130−way requests are constructed”. You *set* parameters instead of *being
131−forced* to declare necessary bits and *being allowed* to declare optional
132−bits in a way that their combination is valid. Also, with `http-conduit` you
133−parse request from a string without the protection of TH that otherwise
134−saves the day as in Yesod.
135−
136−Then there is Wreq. `wreq` [doesn't see much development
137−lately](https://github.com/bos/wreq/issues/93). `wreq` is by itself a weird
138−library, IMO. You have functions per method—not very good, as there may be
139−new methods, like PATCH which is not new but still missing (well, you have
140−`customMethod`, but what is the point of having per-method functions if you
141−have a more general way to use any method? you should be able to just insert
142−methods in the “argument slot” of `customMethod` and end up with a more
143−general solution). Now, every method function has a companion that takes
144−`Options` (like you have `get` and `getWith`). Why the duplication? Where is
145−generality and flexibility? This is not all though, because you cannot
146−really use `get` you see in the main module, because you want to have
147−connection sharing. Wreq's author does not take the gift of automatic
148−connection re-use `Manager` from `http-client` provides, he invents the
149−whole new thing of “sessions”. Only inside a session your connections will
150−be shared and re-used. However with the session stuff you have yet another
151−set of per-method functions like `get` and `getWith`—these are different
152−ones, to be used with sessions! Now if you have a multi-threaded app, here
153−is a surprise for you: you can't share connections between threads as
154−connections are shared only inside of the `withSession` friend and “session
155−will no longer be valid after that function returns”. There are valid uses
156−for sessions, but the point is that they are just too inconvenient for
157−common tasks.
158−
159−I used `servant-client` a couple of times but the amount of boilerplate it
160−requires is frightening. If you have several query parameters, and you use
161−just one of them, you'll have to pass lots of `Nothing`s.
162−
163−## Unsolved problems
164−
165−AWS request signing is problematic because request body can be in the form
166−of an action to execute (and all that “popper” stuff for streaming), not
167−just a `ByteString` and so getting its digest (hash) is not trivial without
168−running the action and consuming body in its entirety before the request in
169−made. In Wreq the author chose to just use `error` when body is not a
170−(strict or lazy) `ByteString`. Maybe it's OK for Wreq, but I don't consider
171−this a proper solution for Req as we support full variety of body options.
172−For example, what if I want to upload 1 Gb file to S3? I want to stream it
173−in constant memory but at the same time I need to calculate its hash before
174−I start streaming. One solution to the problem seems to be in taking the
175−hash explicitly (as an argument of the hypothetical `awsAuth`) and making it
176−a responsibility of the user to calculate the hash correctly. I don't like
177−this because it's not user-friendly. So the question stays open, for now
178−there is no AWS signing functionality provided out-of-the-box. The best
179−solution for talking to AWS is the `amazonka` package so far.
180−
18185## Related packages
18286
18387The following packages are designed to be used with Req:
Setup.hsdeleted−6
@@ -1,6 +0,0 @@
1−module Main (main) where
2−
3−import Distribution.Simple
4−
5−main :: IO ()
6−main = defaultMain
cabal.projectnew file+4
@@ -0,0 +1,4 @@
1+packages: .
2+tests: True
3+benchmarks: True
4+constraints: req +dev
httpbin-tests/Network/HTTP/ReqSpec.hs+160−137
@@ -1,6 +1,6 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE DataKinds #-}
32{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE LambdaCase #-}
44{-# LANGUAGE OverloadedStrings #-}
55{-# LANGUAGE RankNTypes #-}
66{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -8,53 +8,55 @@
88module Network.HTTP.ReqSpec (spec) where
99
1010import Control.Exception
11−import Control.Monad.Reader
11+import Control.Monad (forM_)
1212import Control.Monad.Trans.Control
13−import Data.Aeson ((.=), ToJSON (..), Value (..), object)
14−import qualified Data.Aeson as A
15−import qualified Data.ByteString as B
16−import qualified Data.ByteString.Lazy as BL
17−import qualified Data.HashMap.Strict as HM
13+import Data.Aeson (ToJSON (..), Value (..), 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)
1820import Data.Proxy
1921import Data.Text (Text)
20−import qualified Data.Text as T
21−import qualified Data.Text.Encoding as T
22−import qualified Data.Text.IO as TIO
23−import qualified Network.HTTP.Client as L
24−import qualified Network.HTTP.Client.MultipartFormData as LM
25−import Network.HTTP.Req
26−import qualified Network.HTTP.Types as Y
22+import Data.Text qualified as T
23+import Data.Text.Encoding qualified as T
24+import Data.Text.IO qualified as TIO
25+import Network.HTTP.Client qualified as L
26+import Network.HTTP.Client.MultipartFormData qualified as LM
27+import Network.HTTP.Req hiding (req)
28+import Network.HTTP.Req qualified as Req
29+import Network.HTTP.Types qualified as Y
2730import Test.Hspec
2831import Test.QuickCheck
2932
30−#if !MIN_VERSION_base(4,13,0)
31−import Data.Semigroup ((<>))
32−#endif
33−
3433spec :: Spec
3534spec = do
36− describe "exception throwing on non-2xx status codes"
37− $ it "throws indeed for non-2xx"
38− $ req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
39− `shouldThrow` selector404
40−
41− describe "exception throwing on non-2xx status codes (Req monad)"
42− $ it "throws indeed for non-2xx"
43− $ asIO . runReq defaultHttpConfig
44− $ liftBaseWith
45− $ \run ->
46− run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)
35+ describe "exception throwing on non-2xx status codes" $
36+ it "throws indeed for non-2xx" $
37+ req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
4738 `shouldThrow` selector404
4839
49− describe "response check via httpConfigCheckResponse"
50− $ context "if it's set to always throw"
51− $ it "throws indeed"
52− $ blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)
53− `shouldThrow` anyException
54−
55− describe "receiving user-agent header back"
56− $ it "works"
57− $ do
40+ describe "exception throwing on non-2xx status codes (Req monad)" $
41+ it "throws indeed for non-2xx" $
42+ asIO . runReq defaultHttpConfig $
43+ liftBaseWith $ \run ->
44+ run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)
45+ `shouldThrow` selector404
46+
47+ describe "response check via httpConfigCheckResponse" $
48+ context "if it's set to always throw" $
49+ it "throws indeed" $
50+ blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)
51+ `shouldThrow` anyException
52+
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" $
59+ it "works" $ do
5860 r <-
5961 req
6062 GET
@@ -68,9 +70,8 @@ spec = do
6870 responseStatusCode r `shouldBe` 200
6971 responseStatusMessage r `shouldBe` "OK"
7072
71− describe "receiving request headers back"
72− $ it "works"
73− $ do
73+ describe "receiving request headers back" $
74+ it "works" $ do
7475 r <-
7576 req
7677 GET
@@ -84,34 +85,30 @@ spec = do
8485 .= object
8586 [ "Accept-Encoding" .= ("gzip" :: Text),
8687 "Foo" .= ("bar" :: Text),
87− "Baz" .= ("quux" :: Text),
88− "Host" .= ("httpbin.org" :: Text)
88+ "Baz" .= ("quux" :: Text)
8989 ]
9090 ]
9191 responseStatusCode r `shouldBe` 200
9292 responseStatusMessage r `shouldBe` "OK"
9393
94− describe "receiving GET data back"
95− $ it "works"
96− $ do
94+ describe "receiving GET data back" $
95+ it "works" $ do
9796 r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty
9897 (stripFunnyHeaders . stripOrigin) (responseBody r)
9998 `shouldBe` object
10099 [ "args" .= emptyObject,
101− "url" .= ("https://httpbin.org/get" :: Text),
100+ "url" .= ("http://localhost:1234/get" :: Text),
102101 "headers"
103102 .= object
104− [ "Accept-Encoding" .= ("gzip" :: Text),
105− "Host" .= ("httpbin.org" :: Text)
103+ [ "Accept-Encoding" .= ("gzip" :: Text)
106104 ]
107105 ]
108106 responseHeader r "Content-Type" `shouldBe` return "application/json"
109107 responseStatusCode r `shouldBe` 200
110108 responseStatusMessage r `shouldBe` "OK"
111109
112− describe "receiving POST JSON data back"
113− $ it "works"
114− $ do
110+ describe "receiving POST JSON data back" $
111+ it "works" $ do
115112 let text = "foo" :: Text
116113 reflected = reflectJSON text
117114 r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty
@@ -120,12 +117,11 @@ spec = do
120117 [ "args" .= emptyObject,
121118 "json" .= text,
122119 "data" .= reflected,
123− "url" .= ("https://httpbin.org/post" :: Text),
120+ "url" .= ("http://localhost:1234/post" :: Text),
124121 "headers"
125122 .= object
126123 [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),
127124 "Accept-Encoding" .= ("gzip" :: Text),
128− "Host" .= ("httpbin.org" :: Text),
129125 "Content-Length" .= show (T.length reflected)
130126 ],
131127 "files" .= emptyObject,
@@ -135,27 +131,25 @@ spec = do
135131 responseStatusCode r `shouldBe` 200
136132 responseStatusMessage r `shouldBe` "OK"
137133
138− describe "receiving POST data back (multipart form data)"
139− $ it "works"
140− $ do
134+ describe "receiving POST data back (multipart form data)" $
135+ it "works" $ do
141136 body <-
142137 reqBodyMultipart
143138 [ LM.partBS "foo" "foo data!",
144139 LM.partBS "bar" "bar data!"
145140 ]
146141 r <- req POST (httpbin /: "post") body jsonResponse mempty
147− let Just contentType = getRequestContentType body
142+ let contentType = fromJust (getRequestContentType body)
148143 (stripFunnyHeaders . stripOrigin) (responseBody r)
149144 `shouldBe` object
150145 [ "args" .= emptyObject,
151146 "json" .= Null,
152147 "data" .= ("" :: Text),
153− "url" .= ("https://httpbin.org/post" :: Text),
148+ "url" .= ("http://localhost:1234/post" :: Text),
154149 "headers"
155150 .= object
156151 [ "Content-Type" .= T.decodeUtf8 contentType,
157152 "Accept-Encoding" .= ("gzip" :: Text),
158− "Host" .= ("httpbin.org" :: Text),
159153 "Content-Length" .= ("242" :: Text)
160154 ],
161155 "files" .= emptyObject,
@@ -169,9 +163,8 @@ spec = do
169163 responseStatusCode r `shouldBe` 200
170164 responseStatusMessage r `shouldBe` "OK"
171165
172− describe "receiving PATCHed file back"
173− $ it "works"
174− $ do
166+ describe "receiving PATCHed file back" $
167+ it "works" $ do
175168 let file :: FilePath
176169 file = "httpbin-data/robots.txt"
177170 contents <- TIO.readFile file
@@ -181,11 +174,10 @@ spec = do
181174 [ "args" .= emptyObject,
182175 "json" .= Null,
183176 "data" .= contents,
184− "url" .= ("https://httpbin.org/patch" :: Text),
177+ "url" .= ("http://localhost:1234/patch" :: Text),
185178 "headers"
186179 .= object
187180 [ "Accept-Encoding" .= ("gzip" :: Text),
188− "Host" .= ("httpbin.org" :: Text),
189181 "Content-Length" .= show (T.length contents)
190182 ],
191183 "files" .= emptyObject,
@@ -195,9 +187,8 @@ spec = do
195187 responseStatusCode r `shouldBe` 200
196188 responseStatusMessage r `shouldBe` "OK"
197189
198− describe "receiving PUT form URL-encoded data back"
199− $ it "works"
200− $ do
190+ describe "receiving PUT form URL-encoded data back" $
191+ it "works" $ do
201192 let params =
202193 "foo" =: ("bar" :: Text)
203194 <> "baz" =: (5 :: Int)
@@ -208,12 +199,11 @@ spec = do
208199 [ "args" .= emptyObject,
209200 "json" .= Null,
210201 "data" .= ("" :: Text),
211− "url" .= ("https://httpbin.org/put" :: Text),
202+ "url" .= ("http://localhost:1234/put" :: Text),
212203 "headers"
213204 .= object
214205 [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),
215206 "Accept-Encoding" .= ("gzip" :: Text),
216− "Host" .= ("httpbin.org" :: Text),
217207 "Content-Length" .= ("18" :: Text)
218208 ],
219209 "files" .= emptyObject,
@@ -230,9 +220,8 @@ spec = do
230220
231221 -- TODO /delete
232222
233− describe "receiving UTF-8 encoded Unicode data"
234− $ it "works"
235− $ do
223+ describe "receiving UTF-8 encoded Unicode data" $
224+ it "works" $ do
236225 r <-
237226 req
238227 GET
@@ -248,9 +237,8 @@ spec = do
248237 -- TODO /gzip
249238 -- TODO /deflate
250239
251− describe "retrying"
252− $ it "retries as many times as specified"
253− $ do
240+ describe "retrying" $
241+ it "retries as many times as specified" $ do
254242 -- FIXME We no longer can count retries because all the functions
255243 -- responsible for controlling retrying are pure now.
256244 let status = 408 :: Int
@@ -273,9 +261,8 @@ spec = do
273261 -- TODO /response-headers
274262 -- TODO /redirect
275263
276− describe "redirects"
277− $ it "follows redirects"
278− $ do
264+ describe "redirects" $
265+ it "follows redirects" $ do
279266 r <-
280267 req
281268 GET
@@ -294,9 +281,8 @@ spec = do
294281 let user, password :: Text
295282 user = "Scooby"
296283 password = "Doo"
297− context "when we do not send appropriate basic auth data"
298− $ it "fails with 401"
299− $ do
284+ context "when we do not send appropriate basic auth data" $
285+ it "fails with 401" $ do
300286 r <-
301287 prepareForShit $
302288 req
@@ -307,16 +293,15 @@ spec = do
307293 mempty
308294 responseStatusCode r `shouldBe` 401
309295 responseStatusMessage r `shouldBe` "UNAUTHORIZED"
310− context "when we provide appropriate basic auth data"
311− $ it "succeeds"
312− $ do
296+ context "when we provide appropriate basic auth data" $
297+ it "succeeds" $ do
313298 r <-
314299 req
315300 GET
316301 (httpbin /: "basic-auth" /~ user /~ password)
317302 NoReqBody
318303 ignoreResponse
319− (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))
304+ (basicAuthUnsafe (T.encodeUtf8 user) (T.encodeUtf8 password))
320305 responseStatusCode r `shouldBe` 200
321306 responseStatusMessage r `shouldBe` "OK"
322307
@@ -328,9 +313,8 @@ spec = do
328313 -- TODO /range
329314 -- TODO /html
330315
331− describe "robots.txt"
332− $ it "works"
333− $ do
316+ describe "robots.txt" $
317+ it "works" $ do
334318 r <- req GET (httpbin /: "robots.txt") NoReqBody bsResponse mempty
335319 robots <- B.readFile "httpbin-data/robots.txt"
336320 responseBody r `shouldBe` robots
@@ -341,9 +325,8 @@ spec = do
341325 -- TODO /cache
342326
343327 describe "getting random bytes" $ do
344− it "works"
345− $ property
346− $ \n' -> do
328+ it "works" $
329+ property $ \n' -> do
347330 let n :: Word
348331 n = getSmall n'
349332 r <-
@@ -356,9 +339,8 @@ spec = do
356339 responseBody r `shouldSatisfy` ((== n) . fromIntegral . BL.length)
357340 responseStatusCode r `shouldBe` 200
358341 responseStatusMessage r `shouldBe` "OK"
359− context "when we try to interpret 1000 random bytes as JSON"
360− $ it "throws correct exception"
361− $ do
342+ context "when we try to interpret 1000 random bytes as JSON" $
343+ it "throws correct exception" $ do
362344 let selector :: HttpException -> Bool
363345 selector (JsonHttpException _) = True
364346 selector _ = False
@@ -372,22 +354,21 @@ spec = do
372354 mempty
373355 `shouldThrow` selector
374356
375− describe "streaming random bytes"
376− $ it "works"
377− $ property
378− $ \n' -> do
379− let n :: Word
380− n = getSmall n'
381− r <-
382− req
383− GET
384− (httpbin /: "stream-bytes" /~ n)
385− NoReqBody
386− bsResponse
387− mempty
388− responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)
389− responseStatusCode r `shouldBe` 200
390− responseStatusMessage r `shouldBe` "OK"
357+ describe "streaming random bytes" $
358+ it "works" $
359+ property $ \n' -> do
360+ let n :: Word
361+ n = getSmall n'
362+ r <-
363+ req
364+ GET
365+ (httpbin /: "stream-bytes" /~ n)
366+ NoReqBody
367+ bsResponse
368+ mempty
369+ responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)
370+ responseStatusCode r `shouldBe` 200
371+ responseStatusMessage r `shouldBe` "OK"
391372
392373-- TODO /links
393374-- TODO /image
@@ -407,52 +388,87 @@ instance MonadHttp IO where
407388----------------------------------------------------------------------------
408389-- Helpers
409390
410−-- | Run request with such settings that it does not signal error on adverse
411−-- response status codes.
391+-- | Run a request with such settings that it does not signal errors.
412392prepareForShit :: Req a -> IO a
413393prepareForShit = runReq defaultHttpConfig {httpConfigCheckResponse = noNoise}
414394 where
415395 noNoise _ _ _ = Nothing
416396
417−-- | Run request with such settings that it throws on any response.
397+-- | Run a request with such settings that it throws on any response.
418398blindlyThrowing :: Req a -> IO a
419399blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}
420400 where
421401 doit _ _ = error "Oops!"
422402
423403-- | 'Url' representing <https://httpbin.org>.
424−httpbin :: Url 'Https
425−httpbin = https "httpbin.org"
404+httpbin :: Url 'Http
405+httpbin = http "localhost"
406+
407+req ::
408+ ( MonadHttp m,
409+ HttpMethod method,
410+ HttpBody body,
411+ HttpResponse response,
412+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
413+ ) =>
414+ method ->
415+ Url scheme ->
416+ body ->
417+ Proxy response ->
418+ Option scheme ->
419+ m response
420+req method url body responseProxy options =
421+ Req.req method url body responseProxy (options <> defaultOptions)
422+
423+-- | Options to apply by default.
424+defaultOptions :: Option scheme
425+defaultOptions = port 1234
426426
427427-- | Remove “origin” field from JSON value. Origin may change, we don't want
428428-- to depend on that.
429429stripOrigin :: Value -> Value
430−stripOrigin (Object m) = Object (HM.delete "origin" m)
430+stripOrigin (Object m) = Object (Aeson.KeyMap.delete "origin" m)
431431stripOrigin value = value
432432
433433-- | Remove funny headers that might break the tests.
434434stripFunnyHeaders :: Value -> Value
435−stripFunnyHeaders (Object m) =
436− let f (Object p) = Object $ HM.filterWithKey (\k _ -> k `elem` hs) p
437− f value = value
438− hs =
439− [ "Content-Type",
440− "Accept-Encoding",
441− "Host",
442− "Content-Length",
443− "Foo",
444− "Baz"
445− ]
446− in Object (HM.adjust f "headers" m)
447−stripFunnyHeaders value = value
435+stripFunnyHeaders = \case
436+ Object m ->
437+ Object
438+ ( runIdentity
439+ ( Aeson.KeyMap.alterF
440+ (pure . fmap stripFunnyHeaders')
441+ "headers"
442+ m
443+ )
444+ )
445+ value -> value
446+
447+-- | Similar to 'stripFunnyHeaders', but acts directly on the argument
448+-- without trying to access its "headers" field.
449+stripFunnyHeaders' :: Value -> Value
450+stripFunnyHeaders' = \case
451+ Object p ->
452+ Object $
453+ Aeson.KeyMap.filterWithKey
454+ (\k _ -> k `elem` whitelistedHeaders)
455+ p
456+ value -> value
457+ where
458+ whitelistedHeaders =
459+ [ "Content-Type",
460+ "Accept-Encoding",
461+ "Content-Length",
462+ "Foo",
463+ "Baz"
464+ ]
448465
449466-- | This is a complete test case that makes use of <https://httpbin.org> to
450467-- get various response status codes.
451468checkStatusCode :: Int -> SpecWith ()
452469checkStatusCode code =
453− describe ("receiving status code " ++ show code)
454− $ it "works"
455− $ do
470+ describe ("receiving status code " ++ show code) $
471+ it "works" $ do
456472 r <-
457473 prepareForShit $
458474 req
@@ -475,12 +491,19 @@ selector404
475491 L.responseStatus response == Y.status404 && not (B.null chunk)
476492selector404 _ = False
477493
478−-- | Empty JSON 'Object'.
494+-- | Same as 'selector404' except that it uses 'isStatusCodeException'.
495+selector404ByStatusCodeException :: HttpException -> Bool
496+selector404ByStatusCodeException e =
497+ case isStatusCodeException e of
498+ Nothing -> False
499+ Just r -> responseStatusCode r == 404
500+
501+-- | The empty JSON 'Object'.
479502emptyObject :: Value
480−emptyObject = Object HM.empty
503+emptyObject = Object Aeson.KeyMap.empty
481504
482−-- | Get rendered JSON value as 'Text'.
483−reflectJSON :: ToJSON a => a -> Text
505+-- | Get a rendered JSON value as 'Text'.
506+reflectJSON :: (ToJSON a) => a -> Text
484507reflectJSON = T.decodeUtf8 . BL.toStrict . A.encode
485508
486509-- | Clarify to the type checker that the inner computation is in the 'IO'
pure-tests/Network/HTTP/ReqSpec.hs+211−199
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE DataKinds #-}
32{-# LANGUAGE DeriveGeneric #-}
43{-# LANGUAGE FlexibleInstances #-}
@@ -14,53 +13,50 @@
1413
1514module Network.HTTP.ReqSpec (spec) where
1615
17−import qualified Blaze.ByteString.Builder as BB
16+import Blaze.ByteString.Builder qualified as BB
1817import Control.Exception (throwIO)
1918import Control.Monad
2019import Control.Retry
2120import Data.Aeson (ToJSON (..))
22−import qualified Data.Aeson as A
21+import Data.Aeson qualified as A
2322import Data.ByteString (ByteString)
24−import qualified Data.ByteString as B
25−import qualified Data.ByteString.Char8 as B8
26−import qualified Data.ByteString.Lazy as BL
27−import qualified Data.CaseInsensitive as CI
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
2827import Data.Either (isRight)
29−import qualified Data.List.NonEmpty as NE
28+import Data.List.NonEmpty qualified as NE
3029import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
3130import Data.Proxy
3231import Data.Text (Text)
33−import qualified Data.Text as T
34−import qualified Data.Text.Encoding as T
32+import Data.Text qualified as T
33+import Data.Text.Encoding qualified as T
3534import Data.Time
3635import Data.Typeable (Typeable, eqT)
36+import GHC.Exts (IsList (..))
3737import GHC.Generics
38−import qualified Language.Haskell.TH as TH
39−import qualified Language.Haskell.TH.Quote as TH
40−import qualified Network.HTTP.Client as L
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
4141import Network.HTTP.Req
42−import qualified Network.HTTP.Types as Y
43−import qualified Network.HTTP.Types.Header as Y
42+import Network.HTTP.Types qualified as Y
43+import Network.HTTP.Types.Header qualified as Y
4444import Test.Hspec
4545import Test.Hspec.Core.Spec (SpecM)
4646import Test.QuickCheck
4747import Text.URI (URI)
48−import qualified Text.URI as URI
49−import qualified Text.URI.QQ as QQ
50−
51−#if !MIN_VERSION_base(4,13,0)
52−import Data.Semigroup ((<>))
53−#endif
48+import Text.URI qualified as URI
49+import Text.URI.QQ qualified as QQ
50+import Web.FormUrlEncoded qualified as F
5451
5552spec :: Spec
5653spec = do
57− describe "config"
58− $ it "getHttpConfig has effect on resulting request"
59− $ property
60− $ \config -> do
61− request <- runReq config (req_ GET url NoReqBody mempty)
62− L.proxy request `shouldBe` httpConfigProxy config
63− L.redirectCount request `shouldBe` httpConfigRedirectCount config
54+ describe "config" $
55+ it "getHttpConfig has effect on resulting request" $
56+ property $ \config -> do
57+ request <- runReq config (req_ GET url NoReqBody mempty)
58+ L.proxy request `shouldBe` httpConfigProxy config
59+ L.redirectCount request `shouldBe` httpConfigRedirectCount config
6460
6561 describe "methods" $ do
6662 let mnth ::
@@ -72,9 +68,8 @@ spec = do
7268 SpecM () ()
7369 mnth method = do
7470 let name = httpMethodName (Proxy :: Proxy method)
75− describe (B8.unpack name)
76− $ it "affects name of HTTP method"
77− $ do
71+ describe (B8.unpack name) $
72+ it "affects name of HTTP method" $ do
7873 request <- req_ method url NoReqBody mempty
7974 L.method request `shouldBe` name
8075 mnth GET
@@ -88,48 +83,42 @@ spec = do
8883 mnth PATCH
8984
9085 describe "urls" $ do
91− describe "http"
92− $ it "sets all the params correctly"
93− $ property
94− $ \host -> do
95− request <- req_ GET (http host) NoReqBody mempty
96− L.secure request `shouldBe` False
97− L.port request `shouldBe` 80
98− L.host request `shouldBe` urlEncode host
99− describe "https"
100− $ it "sets all the params correctly"
101− $ property
102− $ \host -> do
103− request <- req_ GET (https host) NoReqBody mempty
104− L.secure request `shouldBe` True
105− L.port request `shouldBe` 443
106− L.host request `shouldBe` urlEncode host
107− describe "(/~)"
108− $ it "attaches a path piece that is URL-encoded"
109− $ property
110− $ \host pieces -> do
111− let url' = foldl (/~) (https host) pieces
112− request <- req_ GET url' NoReqBody mempty
113− L.host request `shouldBe` urlEncode host
114− L.path request `shouldBe` encodePathPieces pieces
115− describe "(/:)"
116− $ it "attaches a path piece that is URL-encoded"
117− $ property
118− $ \host pieces -> do
119− let url' = foldl (/:) (https host) pieces
120− request <- req_ GET url' NoReqBody mempty
121− L.host request `shouldBe` urlEncode host
122− L.path request `shouldBe` encodePathPieces pieces
86+ describe "http" $
87+ it "sets all the params correctly" $
88+ property $ \host -> do
89+ request <- req_ GET (http host) NoReqBody mempty
90+ L.secure request `shouldBe` False
91+ L.port request `shouldBe` 80
92+ L.host request `shouldBe` urlEncode host
93+ describe "https" $
94+ it "sets all the params correctly" $
95+ property $ \host -> do
96+ request <- req_ GET (https host) NoReqBody mempty
97+ L.secure request `shouldBe` True
98+ L.port request `shouldBe` 443
99+ L.host request `shouldBe` urlEncode host
100+ describe "(/~)" $
101+ it "attaches a path piece that is URL-encoded" $
102+ property $ \host pieces -> do
103+ let url' = foldl (/~) (https host) pieces
104+ request <- req_ GET url' NoReqBody mempty
105+ L.host request `shouldBe` urlEncode host
106+ L.path request `shouldBe` encodePathPieces pieces
107+ describe "(/:)" $
108+ it "attaches a path piece that is URL-encoded" $
109+ property $ \host pieces -> do
110+ let url' = foldl (/:) (https host) pieces
111+ request <- req_ GET url' NoReqBody mempty
112+ L.host request `shouldBe` urlEncode host
113+ L.path request `shouldBe` encodePathPieces pieces
123114
124115 describe "useHttpURI" $ do
125− it "does not recognize non-http schemes"
126− $ property
127− $ \uri ->
116+ it "does not recognize non-http schemes" $
117+ property $ \uri ->
128118 when (URI.uriScheme uri /= Just [QQ.scheme|http|]) $
129119 useHttpURI uri `shouldSatisfy` isNothing
130− it "accepts correct URLs"
131− $ property
132− $ \uri' -> do
120+ it "accepts correct URLs" $
121+ property $ \uri' -> do
133122 unless (isRight (URI.uriAuthority uri')) discard
134123 let uri = uri' {URI.uriScheme = Just [QQ.scheme|http|]}
135124 (url', options) = fromJust (useHttpURI uri)
@@ -141,14 +130,12 @@ spec = do
141130 lookup "Authorization" (L.requestHeaders request)
142131 `shouldBe` uriBasicAuth uri
143132 describe "useHttpsURI" $ do
144− it "does not recognize non-https schemes"
145− $ property
146− $ \uri ->
133+ it "does not recognize non-https schemes" $
134+ property $ \uri ->
147135 when (URI.uriScheme uri /= Just [QQ.scheme|https|]) $
148136 useHttpsURI uri `shouldSatisfy` isNothing
149− it "parses correct URLs"
150− $ property
151− $ \uri' -> do
137+ it "parses correct URLs" $
138+ property $ \uri' -> do
152139 unless (isRight (URI.uriAuthority uri')) discard
153140 let uri = uri' {URI.uriScheme = Just [QQ.scheme|https|]}
154141 (url', options) = fromJust (useHttpsURI uri)
@@ -160,27 +147,27 @@ spec = do
160147 lookup "Authorization" (L.requestHeaders request)
161148 `shouldBe` uriBasicAuth uri
162149 describe "useURI" $ do
163− it "does not recognize non-http and non-https schemes"
164− $ property
165− $ \uri ->
150+ it "does not recognize non-http and non-https schemes" $
151+ property $ \uri ->
166152 when
167153 ( ( URI.uriScheme uri /= Just [QQ.scheme|http|]
168154 && (URI.uriScheme uri /= Just [QQ.scheme|https|])
169155 )
170156 )
171157 $ useURI uri `shouldSatisfy` isNothing
172− it "parses correct URLs"
173− $ property
174− $ \uri' -> do
158+ it "parses correct URLs" $
159+ property $ \uri' -> do
175160 unless (isRight (URI.uriAuthority uri')) discard
176161 let uriHttp = uri' {URI.uriScheme = Just [QQ.scheme|http|]}
177162 uriHttps = uri' {URI.uriScheme = Just [QQ.scheme|https|]}
178163 requestHttp <-
179− let Left (url', options) = fromJust (useURI uriHttp)
180− in req_ GET url' NoReqBody options
164+ case fromJust (useURI uriHttp) of
165+ Left (url', options) -> req_ GET url' NoReqBody options
166+ _ -> error "(useURI uriHttp) should have returned Left"
181167 requestHttps <-
182− let Right (url', options) = fromJust (useURI uriHttps)
183− in req_ GET url' NoReqBody options
168+ case fromJust (useURI uriHttps) of
169+ Right (url', options) -> req_ GET url' NoReqBody options
170+ _ -> error "(useURI uriHttps) should have returned Right"
184171 L.host requestHttp `shouldBe` uriHost uriHttp
185172 L.host requestHttps `shouldBe` uriHost uriHttps
186173 L.port requestHttp `shouldBe` uriPort 80 uriHttp
@@ -194,57 +181,83 @@ spec = do
194181 lookup "Authorization" (L.requestHeaders requestHttps)
195182 `shouldBe` uriBasicAuth uriHttps
196183
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+
197204 describe "bodies" $ do
198− describe "NoReqBody"
199− $ it "sets body to empty byte string"
200− $ do
205+ describe "NoReqBody" $
206+ it "sets body to empty byte string" $ do
201207 request <- req_ POST url NoReqBody mempty
202208 case L.requestBody request of
203209 L.RequestBodyBS x -> x `shouldBe` B.empty
204210 _ -> expectationFailure "Wrong request body constructor."
205− describe "ReqBodyJson"
206− $ it "sets body to correct lazy byte string"
207− $ property
208− $ \thing -> do
209− request <- req_ POST url (ReqBodyJson thing) mempty
210− case L.requestBody request of
211− L.RequestBodyLBS x -> x `shouldBe` A.encode (thing :: Thing)
212− _ -> expectationFailure "Wrong request body constructor."
213− describe "ReqBodyBs"
214− $ it "sets body to specified strict byte string"
215− $ property
216− $ \bs -> do
217− request <- req_ POST url (ReqBodyBs bs) mempty
218− case L.requestBody request of
219− L.RequestBodyBS x -> x `shouldBe` bs
220− _ -> expectationFailure "Wrong request body constructor."
221− describe "ReqBodyLbs"
222− $ it "sets body to specified lazy byte string"
223− $ property
224− $ \lbs -> do
225− request <- req_ POST url (ReqBodyLbs lbs) mempty
226− case L.requestBody request of
227− L.RequestBodyLBS x -> x `shouldBe` lbs
228− _ -> expectationFailure "Wrong request body constructor."
229− describe "ReqBodyUrlEnc"
230− $ it "sets body to correct lazy byte string"
231− $ property
232− $ \params -> do
233− request <- req_ POST url (ReqBodyUrlEnc (formUrlEnc params)) mempty
234− case L.requestBody request of
235− L.RequestBodyLBS x -> x `shouldBe` renderQuery params
236− _ -> expectationFailure "Wrong request body constructor."
211+ describe "ReqBodyJson" $
212+ it "sets body to correct lazy byte string" $
213+ property $ \thing -> do
214+ request <- req_ POST url (ReqBodyJson thing) mempty
215+ case L.requestBody request of
216+ L.RequestBodyLBS x -> x `shouldBe` A.encode (thing :: Thing)
217+ _ -> expectationFailure "Wrong request body constructor."
218+ describe "ReqBodyBs" $
219+ it "sets body to specified strict byte string" $
220+ property $ \bs -> do
221+ request <- req_ POST url (ReqBodyBs bs) mempty
222+ case L.requestBody request of
223+ L.RequestBodyBS x -> x `shouldBe` bs
224+ _ -> expectationFailure "Wrong request body constructor."
225+ describe "ReqBodyLbs" $
226+ it "sets body to specified lazy byte string" $
227+ property $ \lbs -> do
228+ request <- req_ POST url (ReqBodyLbs lbs) mempty
229+ case L.requestBody request of
230+ L.RequestBodyLBS x -> x `shouldBe` lbs
231+ _ -> expectationFailure "Wrong request body constructor."
232+ describe "ReqBodyUrlEnc" $
233+ it "sets body to correct lazy byte string" $
234+ property $ \params -> do
235+ request <- req_ POST url (ReqBodyUrlEnc (formUrlEnc params)) mempty
236+ case L.requestBody request of
237+ L.RequestBodyLBS x -> x `shouldBe` renderQuery params
238+ _ -> expectationFailure "Wrong request body constructor."
239+
240+ describe "query params" $ do
241+ describe "FormUrlEncodedParam" $ do
242+ describe "formToQuery" $ do
243+ it "should produce the same parameters as F.urlEncodeFormStable" $
244+ property $ \form -> do
245+ request <- req_ POST url (ReqBodyUrlEnc $ formToQuery form) mempty
246+ case L.requestBody request of
247+ L.RequestBodyLBS x -> x `shouldBe` F.urlEncodeFormStable form
248+ _ -> expectationFailure "Wrong request body constructor"
249+ specParamToList (Proxy :: Proxy FormUrlEncodedParam)
250+ describe "Option" $ do
251+ specParamToList (Proxy :: Proxy (Option 'Http))
237252
238253 describe "optional parameters" $ do
239254 describe "header" $ do
240− it "sets specified header value"
241− $ property
242− $ \name value -> do
255+ it "sets specified header value" $
256+ property $ \name value -> do
243257 request <- req_ GET url NoReqBody (header name value)
244258 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value
245− it "left header wins"
246− $ property
247− $ \name value0 value1 -> do
259+ it "left header wins" $
260+ property $ \name value0 value1 -> do
248261 request <-
249262 req_
250263 GET
@@ -252,9 +265,8 @@ spec = do
252265 NoReqBody
253266 (header name value0 <> header name value1)
254267 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value0
255− it "overwrites headers set by other parts of the lib"
256− $ property
257− $ \value -> do
268+ it "overwrites headers set by other parts of the lib" $
269+ property $ \value -> do
258270 request <-
259271 req_
260272 POST
@@ -262,26 +274,19 @@ spec = do
262274 (ReqBodyUrlEnc mempty)
263275 (header "Content-Type" value)
264276 lookup "Content-Type" (L.requestHeaders request) `shouldBe` pure value
265− describe "cookieJar"
266− $ it "cookie jar is set without modifications"
267− $ property
268− $ \cjar -> do
269− request <- req_ GET url NoReqBody (cookieJar cjar)
270−#if MIN_VERSION_http_client(0,7,0)
271− L.cookieJar request `shouldSatisfy` (maybe False (L.equalCookieJar cjar))
272−#else
273− L.cookieJar request `shouldBe` Just cjar
274−#endif
277+ describe "cookieJar" $
278+ it "cookie jar is set without modifications" $
279+ property $ \cjar -> do
280+ request <- req_ GET url NoReqBody (cookieJar cjar)
281+ L.cookieJar request `shouldSatisfy` (maybe False (L.equalCookieJar cjar))
275282 describe "basicAuth" $ do
276− it "sets Authorization header to correct value"
277− $ property
278− $ \username password -> do
283+ it "sets Authorization header to correct value" $
284+ property $ \username password -> do
279285 request <- req_ GET url NoReqBody (basicAuth username password)
280286 lookup "Authorization" (L.requestHeaders request)
281287 `shouldBe` Just (basicAuthHeader username password)
282− it "overwrites manual setting of header"
283− $ property
284− $ \username password value -> do
288+ it "overwrites manual setting of header" $
289+ property $ \username password value -> do
285290 request0 <-
286291 req_
287292 GET
@@ -297,9 +302,8 @@ spec = do
297302 let result = Just (basicAuthHeader username password)
298303 lookup "Authorization" (L.requestHeaders request0) `shouldBe` result
299304 lookup "Authorization" (L.requestHeaders request1) `shouldBe` result
300− it "left auth option wins"
301− $ property
302− $ \username0 password0 username1 password1 -> do
305+ it "left auth option wins" $
306+ property $ \username0 password0 username1 password1 -> do
303307 request <-
304308 req_
305309 GET
@@ -309,15 +313,13 @@ spec = do
309313 lookup "Authorization" (L.requestHeaders request)
310314 `shouldBe` Just (basicAuthHeader username0 password0)
311315 describe "oAuth2Bearer" $ do
312− it "sets Authorization header to correct value"
313− $ property
314− $ \token -> do
316+ it "sets Authorization header to correct value" $
317+ property $ \token -> do
315318 request <- req_ GET url NoReqBody (oAuth2Bearer token)
316319 lookup "Authorization" (L.requestHeaders request)
317320 `shouldBe` pure ("Bearer " <> token)
318− it "overwrites manual setting of header"
319− $ property
320− $ \token value -> do
321+ it "overwrites manual setting of header" $
322+ property $ \token value -> do
321323 request0 <-
322324 req_
323325 GET
@@ -335,9 +337,8 @@ spec = do
335337 `shouldBe` pure result
336338 lookup "Authorization" (L.requestHeaders request1)
337339 `shouldBe` pure result
338− it "left auth option wins"
339− $ property
340− $ \token0 token1 -> do
340+ it "left auth option wins" $
341+ property $ \token0 token1 -> do
341342 request <-
342343 req_
343344 GET
@@ -346,23 +347,20 @@ spec = do
346347 (oAuth2Bearer token0 <> oAuth2Bearer token1)
347348 lookup "Authorization" (L.requestHeaders request)
348349 `shouldBe` pure ("Bearer " <> token0)
349− describe "ProxyAuthorization"
350− $ it "sets Authorization header to correct value"
351− $ property
352− $ \username password -> do
353− request <- req_ GET url NoReqBody (basicProxyAuth username password)
354− lookup "Proxy-Authorization" (L.requestHeaders request)
355− `shouldBe` pure (basicProxyAuthHeader username password)
350+ describe "ProxyAuthorization" $
351+ it "sets Authorization header to correct value" $
352+ property $ \username password -> do
353+ request <- req_ GET url NoReqBody (basicProxyAuth username password)
354+ lookup "Proxy-Authorization" (L.requestHeaders request)
355+ `shouldBe` pure (basicProxyAuthHeader username password)
356356 describe "oAuth2Token" $ do
357− it "sets Authorization header to correct value"
358− $ property
359− $ \token -> do
357+ it "sets Authorization header to correct value" $
358+ property $ \token -> do
360359 request <- req_ GET url NoReqBody (oAuth2Token token)
361360 lookup "Authorization" (L.requestHeaders request)
362361 `shouldBe` pure ("token " <> token)
363− it "overwrites manual setting of header"
364− $ property
365− $ \token value -> do
362+ it "overwrites manual setting of header" $
363+ property $ \token value -> do
366364 request0 <-
367365 req_
368366 GET
@@ -380,9 +378,8 @@ spec = do
380378 `shouldBe` pure result
381379 lookup "Authorization" (L.requestHeaders request1)
382380 `shouldBe` pure result
383− it "left auth option wins"
384− $ property
385− $ \token0 token1 -> do
381+ it "left auth option wins" $
382+ property $ \token0 token1 -> do
386383 request <-
387384 req_
388385 GET
@@ -391,27 +388,24 @@ spec = do
391388 (oAuth2Token token0 <> oAuth2Token token1)
392389 lookup "Authorization" (L.requestHeaders request)
393390 `shouldBe` pure ("token " <> token0)
394− describe "port"
395− $ it "sets port overwriting the defaults"
396− $ property
397− $ \n -> do
398− request <- req_ GET url NoReqBody (port n)
399− L.port request `shouldBe` n
400− describe "decompress"
401− $ it "sets decompress function overwriting the defaults"
402− $ property
403− $ \token -> do
404− request <- req_ GET url NoReqBody (decompress (/= token))
405− L.decompress request token `shouldBe` False
391+ describe "port" $
392+ it "sets port overwriting the defaults" $
393+ property $ \n -> do
394+ request <- req_ GET url NoReqBody (port n)
395+ L.port request `shouldBe` n
396+ describe "decompress" $
397+ it "sets decompress function overwriting the defaults" $
398+ property $ \token -> do
399+ request <- req_ GET url NoReqBody (decompress (/= token))
400+ L.decompress request token `shouldBe` False
406401 -- FIXME Can't really test responseTimeout right new because the
407402 -- ResponseTimeout data type does not implement Eq and its constructors
408403 -- are also not exported. Sent a PR.
409− describe "httpVersion"
410− $ it "sets HTTP version overwriting the defaults"
411− $ property
412− $ \major minor -> do
413− request <- req_ GET url NoReqBody (httpVersion major minor)
414− L.requestVersion request `shouldBe` Y.HttpVersion major minor
404+ describe "httpVersion" $
405+ it "sets HTTP version overwriting the defaults" $
406+ property $ \major minor -> do
407+ request <- req_ GET url NoReqBody (httpVersion major minor)
408+ L.requestVersion request `shouldBe` Y.HttpVersion major minor
415409
416410 describe "quasiquoter" $ do
417411 it "works for valid urls" $
@@ -419,12 +413,12 @@ spec = do
419413 -- 'Https, Option _) type checks, so we can catch if the type of scheme
420414 -- is unspecified.
421415 let testTypeOfQuoterResult ::
422− forall a s. Typeable a => (a, Option s) -> Bool
416+ forall a s. (Typeable a) => (a, Option s) -> Bool
423417 testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https)
424418 in property $ testTypeOfQuoterResult [urlQ|https://example.org/|]
425− it "doesn't work for invalid urls"
426− $ property
427− $ TH.runQ (TH.quoteExp urlQ "not a url") `shouldThrow` anyIOException
419+ it "doesn't work for invalid urls" $
420+ property $
421+ TH.runQ (TH.quoteExp urlQ "not a url") `shouldThrow` anyIOException
428422
429423----------------------------------------------------------------------------
430424-- Instances
@@ -440,6 +434,8 @@ instance Arbitrary HttpConfig where
440434 httpConfigCheckResponse _ _ _ = Nothing
441435 httpConfigRetryPolicy = retryPolicyDefault
442436 httpConfigRetryJudge _ _ = False
437+ httpConfigRetryJudgeException _ _ = False
438+ httpConfigBodyPreviewLength = 1024
443439 return HttpConfig {..}
444440
445441instance Show HttpConfig where
@@ -507,6 +503,9 @@ instance Arbitrary Day where
507503instance Arbitrary DiffTime where
508504 arbitrary = secondsToDiffTime <$> arbitrary
509505
506+instance Arbitrary F.Form where
507+ arbitrary = (F.Form . fromList) <$> arbitrary
508+
510509----------------------------------------------------------------------------
511510-- Helper types
512511
@@ -574,13 +573,14 @@ uriPort def uri =
574573 maybe def (fromIntegral) $
575574 either (const Nothing) Just (URI.uriAuthority uri) >>= URI.authPort
576575
577−-- | Get path from 'URI'.
576+-- | Get the path from a 'URI'.
578577uriPath :: URI -> ByteString
579578uriPath uri = fromMaybe "" $ do
580− (_, xs) <- URI.uriPath uri
581− (return . encodePathPieces . fmap URI.unRText . NE.toList) xs
579+ (trailingSlash, xs) <- URI.uriPath uri
580+ let pref = (encodePathPieces . fmap URI.unRText . NE.toList) xs
581+ return $ if trailingSlash then pref <> "/" else pref
582582
583−-- | Get query string from 'URI'.
583+-- | Get the query string from a 'URI'.
584584uriQuery :: URI -> ByteString
585585uriQuery uri = do
586586 let liftQueryParam = \case
@@ -618,3 +618,15 @@ basicProxyAuthHeader :: ByteString -> ByteString -> ByteString
618618basicProxyAuthHeader username password =
619619 fromJust . lookup Y.hProxyAuthorization . L.requestHeaders $
620620 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+68−70
@@ -1,19 +1,15 @@
1−cabal-version: 1.18
1+cabal-version: 2.4
22name: req
3−version: 3.2.0
4−license: BSD3
3+version: 3.13.4
4+license: BSD-3-Clause
55license-file: LICENSE.md
66maintainer: Mark Karpov <markkarpov92@gmail.com>
77author: Mark Karpov <markkarpov92@gmail.com>
8−tested-with: ghc ==8.6.5 ghc ==8.8.3 ghc ==8.10.1
8+tested-with: ghc ==9.6.3 ghc ==9.8.2 ghc ==9.10.1
99homepage: https://github.com/mrkkrp/req
1010bug-reports: https://github.com/mrkkrp/req/issues
11−synopsis:
12− Easy-to-use, type-safe, expandable, high-level HTTP client library
13−
14−description:
15− Easy-to-use, type-safe, expandable, high-level HTTP client library.
16−
11+synopsis: HTTP client library
12+description: HTTP client library.
1713category: Network, Web
1814build-type: Simple
1915data-files:
@@ -35,95 +31,97 @@ flag dev
3531
3632library
3733 exposed-modules: Network.HTTP.Req
38− default-language: Haskell2010
34+ default-language: GHC2021
3935 build-depends:
40− aeson >=0.9 && <1.6,
41− authenticate-oauth >=1.5 && <1.7,
42− base >=4.12 && <5.0,
36+ aeson >=0.9 && <3,
37+ authenticate-oauth >=1.5 && <1.8,
38+ base >=4.15 && <5,
4339 blaze-builder >=0.3 && <0.5,
44− bytestring >=0.10.8 && <0.11,
40+ bytestring >=0.10.8 && <0.13,
4541 case-insensitive >=0.2 && <1.3,
46− connection >=0.2.2 && <0.4,
47− http-api-data >=0.2 && <0.5,
48− http-client >=0.5 && <0.8,
42+ containers >=0.5 && <0.8,
43+ crypton-connection >=0.4.2 && <0.5,
44+ data-default-class >=0.2.0.0,
45+ exceptions >=0.6 && <0.11,
46+ http-api-data >=0.2 && <0.7,
47+ http-client >=0.7.13.1 && <0.8,
4948 http-client-tls >=0.3.2 && <0.4,
50− http-types >=0.8 && <10.0,
49+ http-types >=0.8 && <10,
5150 modern-uri >=0.3 && <0.4,
5251 monad-control >=1.0 && <1.1,
5352 mtl >=2.0 && <3.0,
54− retry >=0.8 && <0.9,
55− template-haskell >=2.14 && <2.17,
56− text >=0.2 && <1.3,
57− time >=1.2 && <1.10,
58− transformers >=0.4 && <0.6,
59− transformers-base -any
53+ retry >=0.8 && <0.10,
54+ template-haskell >=2.19 && <2.23,
55+ text >=0.2 && <2.2,
56+ transformers >=0.5.3.0 && <0.7,
57+ transformers-base,
58+ unliftio-core >=0.1.1 && <0.3
6059
6160 if flag(dev)
62− ghc-options: -O0 -Wall -Werror
61+ ghc-options:
62+ -Wall -Werror -Wpartial-fields -Wunused-packages
63+ -Wno-unused-imports
6364
6465 else
6566 ghc-options: -O2 -Wall
6667
67− if flag(dev)
68− ghc-options:
69− -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns
70− -Wnoncanonical-monad-instances
71−
7268test-suite pure-tests
73− type: exitcode-stdio-1.0
74− main-is: Spec.hs
75− build-tools: hspec-discover >=2.0 && <3.0
76− hs-source-dirs: pure-tests
77− other-modules: Network.HTTP.ReqSpec
78− default-language: Haskell2010
69+ type: exitcode-stdio-1.0
70+ main-is: Spec.hs
71+ build-tool-depends: hspec-discover:hspec-discover >=2 && <3
72+ hs-source-dirs: pure-tests
73+ other-modules: Network.HTTP.ReqSpec
74+ default-language: GHC2021
7975 build-depends:
80− QuickCheck >=2.7 && <3.0,
81− aeson >=0.9 && <1.6,
82− base >=4.12 && <5.0,
76+ QuickCheck >=2.7 && <3,
77+ aeson >=0.9 && <3,
78+ base >=4.15 && <5.0,
8379 blaze-builder >=0.3 && <0.5,
84− bytestring >=0.10.8 && <0.11,
80+ bytestring >=0.10.8 && <0.13,
8581 case-insensitive >=0.2 && <1.3,
86− hspec >=2.0 && <3.0,
87− hspec-core >=2.0 && <3.0,
88− http-client >=0.5 && <0.8,
89− http-types >=0.8 && <10.0,
82+ hspec >=2.0 && <3,
83+ hspec-core >=2.0 && <3,
84+ http-api-data >=0.2 && <0.7,
85+ http-client >=0.7 && <0.8,
86+ http-types >=0.8 && <10,
9087 modern-uri >=0.3 && <0.4,
91− mtl >=2.0 && <3.0,
92− req -any,
93− retry >=0.8 && <0.9,
94− template-haskell >=2.14 && <2.17,
95− text >=0.2 && <1.3,
96− time >=1.2 && <1.10
88+ req,
89+ retry >=0.8 && <0.10,
90+ template-haskell >=2.19 && <2.23,
91+ text >=0.2 && <2.2,
92+ time >=1.2 && <1.15
9793
9894 if flag(dev)
99− ghc-options: -O0 -Wall -Werror
95+ ghc-options:
96+ -Wall -Werror -Wredundant-constraints -Wpartial-fields
97+ -Wunused-packages
10098
10199 else
102100 ghc-options: -O2 -Wall
103101
104102test-suite httpbin-tests
105− type: exitcode-stdio-1.0
106− main-is: Spec.hs
107− build-tools: hspec-discover >=2.0 && <3.0
108− hs-source-dirs: httpbin-tests
109− other-modules: Network.HTTP.ReqSpec
110− default-language: Haskell2010
103+ type: exitcode-stdio-1.0
104+ main-is: Spec.hs
105+ build-tool-depends: hspec-discover:hspec-discover >=2 && <3
106+ hs-source-dirs: httpbin-tests
107+ other-modules: Network.HTTP.ReqSpec
108+ default-language: GHC2021
111109 build-depends:
112− QuickCheck >=2.7 && <3.0,
113− aeson >=0.9 && <1.6,
114− base >=4.12 && <5.0,
115− bytestring >=0.10.8 && <0.11,
110+ QuickCheck >=2.7 && <3,
111+ aeson >=2 && <3,
112+ base >=4.15 && <5,
113+ bytestring >=0.10.8 && <0.13,
116114 hspec >=2.0 && <3.0,
117− http-client >=0.5 && <0.8,
118− http-types >=0.8 && <10.0,
115+ http-client >=0.7 && <0.8,
116+ http-types >=0.8 && <10,
119117 monad-control >=1.0 && <1.1,
120− mtl >=2.0 && <3.0,
121− req -any,
122− text >=0.2 && <1.3,
123− unordered-containers >=0.2.5 && <0.2.11
118+ req,
119+ text >=0.2 && <2.2
124120
125121 if flag(dev)
126− ghc-options: -O0 -Wall -Werror
122+ ghc-options:
123+ -Wall -Werror -Wredundant-constraints -Wpartial-fields
124+ -Wunused-packages
127125
128126 else
129− ghc-options: -O2 -Wall
127+ buildable: False