@@ -54,13 +54,12 @@ import Data.Semigroup ((<>))
5454
5555spec :: Spec
5656spec = 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
57+ describe "config" $
58+ it "getHttpConfig has effect on resulting request" $
59+ property $ \config -> do
60+ request <- runReq config (req_ GET url NoReqBody mempty)
61+ L.proxy request `shouldBe` httpConfigProxy config
62+ L.redirectCount request `shouldBe` httpConfigRedirectCount config
6463
6564 describe "methods" $ do
6665 let mnth ::
@@ -72,9 +71,8 @@ spec = do
7271 SpecM () ()
7372 mnth method = do
7473 let name = httpMethodName (Proxy :: Proxy method)
75− describe (B8.unpack name)
76− $ it "affects name of HTTP method"
77− $ do
74+ describe (B8.unpack name) $
75+ it "affects name of HTTP method" $ do
7876 request <- req_ method url NoReqBody mempty
7977 L.method request `shouldBe` name
8078 mnth GET
@@ -88,48 +86,42 @@ spec = do
8886 mnth PATCH
8987
9088 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
89+ describe "http" $
90+ it "sets all the params correctly" $
91+ property $ \host -> do
92+ request <- req_ GET (http host) NoReqBody mempty
93+ L.secure request `shouldBe` False
94+ L.port request `shouldBe` 80
95+ L.host request `shouldBe` urlEncode host
96+ describe "https" $
97+ it "sets all the params correctly" $
98+ property $ \host -> do
99+ request <- req_ GET (https host) NoReqBody mempty
100+ L.secure request `shouldBe` True
101+ L.port request `shouldBe` 443
102+ L.host request `shouldBe` urlEncode host
103+ describe "(/~)" $
104+ it "attaches a path piece that is URL-encoded" $
105+ property $ \host pieces -> do
106+ let url' = foldl (/~) (https host) pieces
107+ request <- req_ GET url' NoReqBody mempty
108+ L.host request `shouldBe` urlEncode host
109+ L.path request `shouldBe` encodePathPieces pieces
110+ describe "(/:)" $
111+ it "attaches a path piece that is URL-encoded" $
112+ property $ \host pieces -> do
113+ let url' = foldl (/:) (https host) pieces
114+ request <- req_ GET url' NoReqBody mempty
115+ L.host request `shouldBe` urlEncode host
116+ L.path request `shouldBe` encodePathPieces pieces
123117
124118 describe "useHttpURI" $ do
125− it "does not recognize non-http schemes"
126− $ property
127− $ \uri ->
119+ it "does not recognize non-http schemes" $
120+ property $ \uri ->
128121 when (URI.uriScheme uri /= Just [QQ.scheme|http|]) $
129122 useHttpURI uri `shouldSatisfy` isNothing
130− it "accepts correct URLs"
131− $ property
132− $ \uri' -> do
123+ it "accepts correct URLs" $
124+ property $ \uri' -> do
133125 unless (isRight (URI.uriAuthority uri')) discard
134126 let uri = uri' {URI.uriScheme = Just [QQ.scheme|http|]}
135127 (url', options) = fromJust (useHttpURI uri)
@@ -141,14 +133,12 @@ spec = do
141133 lookup "Authorization" (L.requestHeaders request)
142134 `shouldBe` uriBasicAuth uri
143135 describe "useHttpsURI" $ do
144− it "does not recognize non-https schemes"
145− $ property
146− $ \uri ->
136+ it "does not recognize non-https schemes" $
137+ property $ \uri ->
147138 when (URI.uriScheme uri /= Just [QQ.scheme|https|]) $
148139 useHttpsURI uri `shouldSatisfy` isNothing
149− it "parses correct URLs"
150− $ property
151− $ \uri' -> do
140+ it "parses correct URLs" $
141+ property $ \uri' -> do
152142 unless (isRight (URI.uriAuthority uri')) discard
153143 let uri = uri' {URI.uriScheme = Just [QQ.scheme|https|]}
154144 (url', options) = fromJust (useHttpsURI uri)
@@ -160,18 +150,16 @@ spec = do
160150 lookup "Authorization" (L.requestHeaders request)
161151 `shouldBe` uriBasicAuth uri
162152 describe "useURI" $ do
163− it "does not recognize non-http and non-https schemes"
164− $ property
165− $ \uri ->
153+ it "does not recognize non-http and non-https schemes" $
154+ property $ \uri ->
166155 when
167156 ( ( URI.uriScheme uri /= Just [QQ.scheme|http|]
168157 && (URI.uriScheme uri /= Just [QQ.scheme|https|])
169158 )
170159 )
171160 $ useURI uri `shouldSatisfy` isNothing
172− it "parses correct URLs"
173− $ property
174− $ \uri' -> do
161+ it "parses correct URLs" $
162+ property $ \uri' -> do
175163 unless (isRight (URI.uriAuthority uri')) discard
176164 let uriHttp = uri' {URI.uriScheme = Just [QQ.scheme|http|]}
177165 uriHttps = uri' {URI.uriScheme = Just [QQ.scheme|https|]}
@@ -195,56 +183,49 @@ spec = do
195183 `shouldBe` uriBasicAuth uriHttps
196184
197185 describe "bodies" $ do
198− describe "NoReqBody"
199− $ it "sets body to empty byte string"
200− $ do
186+ describe "NoReqBody" $
187+ it "sets body to empty byte string" $ do
201188 request <- req_ POST url NoReqBody mempty
202189 case L.requestBody request of
203190 L.RequestBodyBS x -> x `shouldBe` B.empty
204191 _ -> 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."
192+ describe "ReqBodyJson" $
193+ it "sets body to correct lazy byte string" $
194+ property $ \thing -> do
195+ request <- req_ POST url (ReqBodyJson thing) mempty
196+ case L.requestBody request of
197+ L.RequestBodyLBS x -> x `shouldBe` A.encode (thing :: Thing)
198+ _ -> expectationFailure "Wrong request body constructor."
199+ describe "ReqBodyBs" $
200+ it "sets body to specified strict byte string" $
201+ property $ \bs -> do
202+ request <- req_ POST url (ReqBodyBs bs) mempty
203+ case L.requestBody request of
204+ L.RequestBodyBS x -> x `shouldBe` bs
205+ _ -> expectationFailure "Wrong request body constructor."
206+ describe "ReqBodyLbs" $
207+ it "sets body to specified lazy byte string" $
208+ property $ \lbs -> do
209+ request <- req_ POST url (ReqBodyLbs lbs) mempty
210+ case L.requestBody request of
211+ L.RequestBodyLBS x -> x `shouldBe` lbs
212+ _ -> expectationFailure "Wrong request body constructor."
213+ describe "ReqBodyUrlEnc" $
214+ it "sets body to correct lazy byte string" $
215+ property $ \params -> do
216+ request <- req_ POST url (ReqBodyUrlEnc (formUrlEnc params)) mempty
217+ case L.requestBody request of
218+ L.RequestBodyLBS x -> x `shouldBe` renderQuery params
219+ _ -> expectationFailure "Wrong request body constructor."
237220
238221 describe "optional parameters" $ do
239222 describe "header" $ do
240− it "sets specified header value"
241− $ property
242− $ \name value -> do
223+ it "sets specified header value" $
224+ property $ \name value -> do
243225 request <- req_ GET url NoReqBody (header name value)
244226 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value
245− it "left header wins"
246− $ property
247− $ \name value0 value1 -> do
227+ it "left header wins" $
228+ property $ \name value0 value1 -> do
248229 request <-
249230 req_
250231 GET
@@ -252,9 +233,8 @@ spec = do
252233 NoReqBody
253234 (header name value0 <> header name value1)
254235 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
236+ it "overwrites headers set by other parts of the lib" $
237+ property $ \value -> do
258238 request <-
259239 req_
260240 POST
@@ -262,26 +242,23 @@ spec = do
262242 (ReqBodyUrlEnc mempty)
263243 (header "Content-Type" value)
264244 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)
245+ describe "cookieJar" $
246+ it "cookie jar is set without modifications" $
247+ property $ \cjar -> do
248+ request <- req_ GET url NoReqBody (cookieJar cjar)
270249#if MIN_VERSION_http_client(0,7,0)
271− L.cookieJar request `shouldSatisfy` (maybe False (L.equalCookieJar cjar))
250+ L.cookieJar request `shouldSatisfy` (maybe False (L.equalCookieJar cjar))
272251#else
273− L.cookieJar request `shouldBe` Just cjar
252+ L.cookieJar request `shouldBe` Just cjar
274253#endif
275254 describe "basicAuth" $ do
276− it "sets Authorization header to correct value"
277− $ property
278− $ \username password -> do
255+ it "sets Authorization header to correct value" $
256+ property $ \username password -> do
279257 request <- req_ GET url NoReqBody (basicAuth username password)
280258 lookup "Authorization" (L.requestHeaders request)
281259 `shouldBe` Just (basicAuthHeader username password)
282− it "overwrites manual setting of header"
283− $ property
284− $ \username password value -> do
260+ it "overwrites manual setting of header" $
261+ property $ \username password value -> do
285262 request0 <-
286263 req_
287264 GET
@@ -297,9 +274,8 @@ spec = do
297274 let result = Just (basicAuthHeader username password)
298275 lookup "Authorization" (L.requestHeaders request0) `shouldBe` result
299276 lookup "Authorization" (L.requestHeaders request1) `shouldBe` result
300− it "left auth option wins"
301− $ property
302− $ \username0 password0 username1 password1 -> do
277+ it "left auth option wins" $
278+ property $ \username0 password0 username1 password1 -> do
303279 request <-
304280 req_
305281 GET
@@ -309,15 +285,13 @@ spec = do
309285 lookup "Authorization" (L.requestHeaders request)
310286 `shouldBe` Just (basicAuthHeader username0 password0)
311287 describe "oAuth2Bearer" $ do
312− it "sets Authorization header to correct value"
313− $ property
314− $ \token -> do
288+ it "sets Authorization header to correct value" $
289+ property $ \token -> do
315290 request <- req_ GET url NoReqBody (oAuth2Bearer token)
316291 lookup "Authorization" (L.requestHeaders request)
317292 `shouldBe` pure ("Bearer " <> token)
318− it "overwrites manual setting of header"
319− $ property
320− $ \token value -> do
293+ it "overwrites manual setting of header" $
294+ property $ \token value -> do
321295 request0 <-
322296 req_
323297 GET
@@ -335,9 +309,8 @@ spec = do
335309 `shouldBe` pure result
336310 lookup "Authorization" (L.requestHeaders request1)
337311 `shouldBe` pure result
338− it "left auth option wins"
339− $ property
340− $ \token0 token1 -> do
312+ it "left auth option wins" $
313+ property $ \token0 token1 -> do
341314 request <-
342315 req_
343316 GET
@@ -346,23 +319,20 @@ spec = do
346319 (oAuth2Bearer token0 <> oAuth2Bearer token1)
347320 lookup "Authorization" (L.requestHeaders request)
348321 `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)
322+ describe "ProxyAuthorization" $
323+ it "sets Authorization header to correct value" $
324+ property $ \username password -> do
325+ request <- req_ GET url NoReqBody (basicProxyAuth username password)
326+ lookup "Proxy-Authorization" (L.requestHeaders request)
327+ `shouldBe` pure (basicProxyAuthHeader username password)
356328 describe "oAuth2Token" $ do
357− it "sets Authorization header to correct value"
358− $ property
359− $ \token -> do
329+ it "sets Authorization header to correct value" $
330+ property $ \token -> do
360331 request <- req_ GET url NoReqBody (oAuth2Token token)
361332 lookup "Authorization" (L.requestHeaders request)
362333 `shouldBe` pure ("token " <> token)
363− it "overwrites manual setting of header"
364− $ property
365− $ \token value -> do
334+ it "overwrites manual setting of header" $
335+ property $ \token value -> do
366336 request0 <-
367337 req_
368338 GET
@@ -380,9 +350,8 @@ spec = do
380350 `shouldBe` pure result
381351 lookup "Authorization" (L.requestHeaders request1)
382352 `shouldBe` pure result
383− it "left auth option wins"
384− $ property
385− $ \token0 token1 -> do
353+ it "left auth option wins" $
354+ property $ \token0 token1 -> do
386355 request <-
387356 req_
388357 GET
@@ -391,27 +360,24 @@ spec = do
391360 (oAuth2Token token0 <> oAuth2Token token1)
392361 lookup "Authorization" (L.requestHeaders request)
393362 `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
363+ describe "port" $
364+ it "sets port overwriting the defaults" $
365+ property $ \n -> do
366+ request <- req_ GET url NoReqBody (port n)
367+ L.port request `shouldBe` n
368+ describe "decompress" $
369+ it "sets decompress function overwriting the defaults" $
370+ property $ \token -> do
371+ request <- req_ GET url NoReqBody (decompress (/= token))
372+ L.decompress request token `shouldBe` False
406373 -- FIXME Can't really test responseTimeout right new because the
407374 -- ResponseTimeout data type does not implement Eq and its constructors
408375 -- 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
376+ describe "httpVersion" $
377+ it "sets HTTP version overwriting the defaults" $
378+ property $ \major minor -> do
379+ request <- req_ GET url NoReqBody (httpVersion major minor)
380+ L.requestVersion request `shouldBe` Y.HttpVersion major minor
415381
416382 describe "quasiquoter" $ do
417383 it "works for valid urls" $
@@ -422,9 +388,9 @@ spec = do
422388 forall a s. Typeable a => (a, Option s) -> Bool
423389 testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https)
424390 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
391+ it "doesn't work for invalid urls" $
392+ property $
393+ TH.runQ (TH.quoteExp urlQ "not a url") `shouldThrow` anyIOException
428394
429395----------------------------------------------------------------------------
430396-- Instances