@@ -24,8 +24,7 @@ import Data.Text.Encoding qualified as T
2424import Data.Text.IO qualified as TIO
2525import Network.HTTP.Client qualified as L
2626import Network.HTTP.Client.MultipartFormData qualified as LM
27−import Network.HTTP.Req hiding (req)
28−import Network.HTTP.Req qualified as Req
27+import Network.HTTP.Req
2928import Network.HTTP.Types qualified as Y
3029import Test.Hspec
3130import Test.QuickCheck
@@ -34,74 +33,61 @@ spec :: Spec
3433spec = do
3534 describe "exception throwing on non-2xx status codes" $
3635 it "throws indeed for non-2xx" $
37− req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
36+ req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty
3837 `shouldThrow` selector404
3938
4039 describe "exception throwing on non-2xx status codes (Req monad)" $
4140 it "throws indeed for non-2xx" $
4241 asIO . runReq defaultHttpConfig $
4342 liftBaseWith $ \run ->
44− run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)
43+ run (req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty)
4544 `shouldThrow` selector404
4645
4746 describe "response check via httpConfigCheckResponse" $
4847 context "if it's set to always throw" $
4948 it "throws indeed" $
50− blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)
49+ blindlyThrowing (req GET httpbun NoReqBody ignoreResponse mempty)
5150 `shouldThrow` anyException
5251
5352 describe "isStatusCodeException" $
5453 it "extracts non-2xx response" $
55− req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
54+ req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty
5655 `shouldThrow` selector404ByStatusCodeException
5756
58− describe "receiving user-agent header back" $
59− it "works" $ do
60− r <-
61− req
62− GET
63− (httpbin /: "user-agent")
64− NoReqBody
65− jsonResponse
66− (header "user-agent" "Req")
67− responseBody r
68− `shouldBe` object
69− ["user-agent" .= ("Req" :: Text)]
70− responseStatusCode r `shouldBe` 200
71− responseStatusMessage r `shouldBe` "OK"
72−
7357 describe "receiving request headers back" $
7458 it "works" $ do
7559 r <-
7660 req
7761 GET
78− (httpbin /: "headers")
62+ (httpbun /: "headers")
7963 NoReqBody
8064 jsonResponse
8165 (header "Foo" "bar" <> header "Baz" "quux")
82− stripFunnyHeaders (responseBody r)
66+ stripFunnyHeaders' (responseBody r)
8367 `shouldBe` object
84− [ "headers"
85− .= object
86− [ "Accept-Encoding" .= ("gzip" :: Text),
87− "Foo" .= ("bar" :: Text),
88− "Baz" .= ("quux" :: Text)
89− ]
68+ [ "Accept-Encoding" .= ("gzip" :: Text),
69+ "Foo" .= ("bar" :: Text),
70+ "Baz" .= ("quux" :: Text)
9071 ]
9172 responseStatusCode r `shouldBe` 200
9273 responseStatusMessage r `shouldBe` "OK"
9374
9475 describe "receiving GET data back" $
9576 it "works" $ do
96− r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty
77+ r <- req GET (httpbun /: "get") NoReqBody jsonResponse mempty
9778 (stripFunnyHeaders . stripOrigin) (responseBody r)
9879 `shouldBe` object
9980 [ "args" .= emptyObject,
100− "url" .= ("http://localhost:1234/get" :: Text),
81+ "url" .= ("https://httpbun.org/get" :: Text),
82+ "method" .= ("GET" :: Text),
10183 "headers"
10284 .= object
10385 [ "Accept-Encoding" .= ("gzip" :: Text)
104− ]
86+ ],
87+ "form" .= emptyObject,
88+ "files" .= emptyObject,
89+ "data" .= ("" :: Text),
90+ "json" .= Null
10591 ]
10692 responseHeader r "Content-Type" `shouldBe` return "application/json"
10793 responseStatusCode r `shouldBe` 200
@@ -111,13 +97,14 @@ spec = do
11197 it "works" $ do
11298 let text = "foo" :: Text
11399 reflected = reflectJSON text
114− r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty
100+ r <- req POST (httpbun /: "post") (ReqBodyJson text) jsonResponse mempty
115101 (stripFunnyHeaders . stripOrigin) (responseBody r)
116102 `shouldBe` object
117103 [ "args" .= emptyObject,
118104 "json" .= text,
119105 "data" .= reflected,
120− "url" .= ("http://localhost:1234/post" :: Text),
106+ "url" .= ("https://httpbun.org/post" :: Text),
107+ "method" .= ("POST" :: Text),
121108 "headers"
122109 .= object
123110 [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),
@@ -138,14 +125,15 @@ spec = do
138125 [ LM.partBS "foo" "foo data!",
139126 LM.partBS "bar" "bar data!"
140127 ]
141− r <- req POST (httpbin /: "post") body jsonResponse mempty
128+ r <- req POST (httpbun /: "post") body jsonResponse mempty
142129 let contentType = fromJust (getRequestContentType body)
143130 (stripFunnyHeaders . stripOrigin) (responseBody r)
144131 `shouldBe` object
145132 [ "args" .= emptyObject,
146133 "json" .= Null,
147134 "data" .= ("" :: Text),
148− "url" .= ("http://localhost:1234/post" :: Text),
135+ "url" .= ("https://httpbun.org/post" :: Text),
136+ "method" .= ("POST" :: Text),
149137 "headers"
150138 .= object
151139 [ "Content-Type" .= T.decodeUtf8 contentType,
@@ -166,15 +154,16 @@ spec = do
166154 describe "receiving PATCHed file back" $
167155 it "works" $ do
168156 let file :: FilePath
169− file = "httpbin-data/robots.txt"
157+ file = "httpbun-data/robots.txt"
170158 contents <- TIO.readFile file
171− r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty
159+ r <- req PATCH (httpbun /: "patch") (ReqBodyFile file) jsonResponse mempty
172160 (stripFunnyHeaders . stripOrigin) (responseBody r)
173161 `shouldBe` object
174162 [ "args" .= emptyObject,
175163 "json" .= Null,
176164 "data" .= contents,
177− "url" .= ("http://localhost:1234/patch" :: Text),
165+ "url" .= ("https://httpbun.org/patch" :: Text),
166+ "method" .= ("PATCH" :: Text),
178167 "headers"
179168 .= object
180169 [ "Accept-Encoding" .= ("gzip" :: Text),
@@ -193,13 +182,14 @@ spec = do
193182 "foo" =: ("bar" :: Text)
194183 <> "baz" =: (5 :: Int)
195184 <> queryFlag "quux"
196− r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty
185+ r <- req PUT (httpbun /: "put") (ReqBodyUrlEnc params) jsonResponse mempty
197186 (stripFunnyHeaders . stripOrigin) (responseBody r)
198187 `shouldBe` object
199188 [ "args" .= emptyObject,
200189 "json" .= Null,
201190 "data" .= ("" :: Text),
202− "url" .= ("http://localhost:1234/put" :: Text),
191+ "url" .= ("https://httpbun.org/put" :: Text),
192+ "method" .= ("PUT" :: Text),
203193 "headers"
204194 .= object
205195 [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),
@@ -218,24 +208,19 @@ spec = do
218208 responseStatusCode r `shouldBe` 200
219209 responseStatusMessage r `shouldBe` "OK"
220210
221− -- TODO /delete
222−
223− describe "receiving UTF-8 encoded Unicode data" $
224− it "works" $ do
225− r <-
226− req
227− GET
228− (httpbin /: "encoding" /: "utf8")
229− NoReqBody
230− bsResponse
231− mempty
232− utf8data <- B.readFile "httpbin-data/utf8.html"
233− responseBody r `shouldBe` utf8data
234− responseStatusCode r `shouldBe` 200
235− responseStatusMessage r `shouldBe` "OK"
236−
237− -- TODO /gzip
238− -- TODO /deflate
211+ -- describe "receiving UTF-8 encoded Unicode data" $
212+ -- it "works" $ do
213+ -- r <-
214+ -- req
215+ -- GET
216+ -- (httpbun /: "encoding" /: "utf8")
217+ -- NoReqBody
218+ -- bsResponse
219+ -- mempty
220+ -- utf8data <- B.readFile "httpbun-data/utf8.html"
221+ -- responseBody r `shouldBe` utf8data
222+ -- responseStatusCode r `shouldBe` 200
223+ -- responseStatusMessage r `shouldBe` "OK"
239224
240225 describe "retrying" $
241226 it "retries as many times as specified" $ do
@@ -246,7 +231,7 @@ spec = do
246231 prepareForShit $
247232 req
248233 GET
249− (httpbin /: "status" /~ status)
234+ (httpbun /: "status" /~ status)
250235 NoReqBody
251236 ignoreResponse
252237 mempty
@@ -258,25 +243,18 @@ spec = do
258243 forM_ [400 .. 431] checkStatusCode
259244 forM_ [500 .. 511] checkStatusCode
260245
261− -- TODO /response-headers
262− -- TODO /redirect
263−
264246 describe "redirects" $
265247 it "follows redirects" $ do
266248 r <-
267249 req
268250 GET
269− (httpbin /: "redirect-to")
251+ (httpbun /: "redirect-to")
270252 NoReqBody
271253 ignoreResponse
272− ("url" =: ("https://httpbin.org" :: Text))
254+ ("url" =: ("https://httpbun.org" :: Text))
273255 responseStatusCode r `shouldBe` 200
274256 responseStatusMessage r `shouldBe` "OK"
275257
276− -- TODO /relative-redicet
277− -- TODO /absolute-redirect
278− -- TODO /cookies
279−
280258 describe "basicAuth" $ do
281259 let user, password :: Text
282260 user = "Scooby"
@@ -287,43 +265,32 @@ spec = do
287265 prepareForShit $
288266 req
289267 GET
290− (httpbin /: "basic-auth" /~ user /~ password)
268+ (httpbun /: "basic-auth" /~ user /~ password)
291269 NoReqBody
292270 ignoreResponse
293271 mempty
294272 responseStatusCode r `shouldBe` 401
295− responseStatusMessage r `shouldBe` "UNAUTHORIZED"
273+ responseStatusMessage r `shouldBe` "Unauthorized"
296274 context "when we provide appropriate basic auth data" $
297275 it "succeeds" $ do
298276 r <-
299277 req
300278 GET
301− (httpbin /: "basic-auth" /~ user /~ password)
279+ (httpbun /: "basic-auth" /~ user /~ password)
302280 NoReqBody
303281 ignoreResponse
304− (basicAuthUnsafe (T.encodeUtf8 user) (T.encodeUtf8 password))
282+ (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))
305283 responseStatusCode r `shouldBe` 200
306284 responseStatusMessage r `shouldBe` "OK"
307285
308− -- TODO /hidden-basic-auth
309− -- TODO /digest-auth
310− -- TODO /stream
311− -- TODO /delay
312− -- TODO /drip
313− -- TODO /range
314− -- TODO /html
315−
316286 describe "robots.txt" $
317287 it "works" $ do
318− r <- req GET (httpbin /: "robots.txt") NoReqBody bsResponse mempty
319− robots <- B.readFile "httpbin-data/robots.txt"
288+ r <- req GET (httpbun /: "robots.txt") NoReqBody bsResponse mempty
289+ robots <- B.readFile "httpbun-data/robots.txt"
320290 responseBody r `shouldBe` robots
321291 responseStatusCode r `shouldBe` 200
322292 responseStatusMessage r `shouldBe` "OK"
323293
324− -- TODO /deny
325− -- TODO /cache
326−
327294 describe "getting random bytes" $ do
328295 it "works" $
329296 property $ \n' -> do
@@ -332,7 +299,7 @@ spec = do
332299 r <-
333300 req
334301 GET
335− (httpbin /: "bytes" /~ n)
302+ (httpbun /: "bytes" /~ n)
336303 NoReqBody
337304 lbsResponse
338305 mempty
@@ -348,36 +315,27 @@ spec = do
348315 n = 1000
349316 req
350317 GET
351− (httpbin /: "bytes" /~ n)
318+ (httpbun /: "bytes" /~ n)
352319 NoReqBody
353320 (Proxy :: Proxy (JsonResponse Value))
354321 mempty
355322 `shouldThrow` selector
356323
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"
372−
373−-- TODO /links
374−-- TODO /image
375−-- TODO /image/png
376−-- TODO /image/jpeg
377−-- TODO /image/webp
378−-- TODO /image/svg
379−-- TODO /forms/post
380−-- TODO /xml
324+-- describe "streaming random bytes" $
325+-- it "works" $
326+-- property $ \n' -> do
327+-- let n :: Word
328+-- n = getSmall n'
329+-- r <-
330+-- req
331+-- GET
332+-- (httpbun /: "stream-bytes" /~ n)
333+-- NoReqBody
334+-- bsResponse
335+-- mempty
336+-- responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)
337+-- responseStatusCode r `shouldBe` 200
338+-- responseStatusMessage r `shouldBe` "OK"
381339
382340----------------------------------------------------------------------------
383341-- Instances
@@ -400,29 +358,9 @@ blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}
400358 where
401359 doit _ _ = error "Oops!"
402360
403−-- | 'Url' representing <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
361+-- | 'Url' representing <https://httpbun.org>.
362+httpbun :: Url 'Https
363+httpbun = https "httpbun.org"
426364
427365-- | Remove “origin” field from JSON value. Origin may change, we don't want
428366-- to depend on that.
@@ -463,7 +401,7 @@ stripFunnyHeaders' = \case
463401 "Baz"
464402 ]
465403
466−-- | This is a complete test case that makes use of <https://httpbin.org> to
404+-- | This is a complete test case that makes use of <https://httpbun.org> to
467405-- get various response status codes.
468406checkStatusCode :: Int -> SpecWith ()
469407checkStatusCode code =
@@ -473,7 +411,7 @@ checkStatusCode code =
473411 prepareForShit $
474412 req
475413 GET
476− (httpbin /: "status" /~ code)
414+ (httpbun /: "status" /~ code)
477415 NoReqBody
478416 ignoreResponse
479417 mempty