@@ -24,7 +24,8 @@ import Data.Text.Encoding qualified as T
24import Data.Text.IO qualified as TIO
24import Data.Text.IO qualified as TIO
25import Network.HTTP.Client qualified as L
25import Network.HTTP.Client qualified as L
26import Network.HTTP.Client.MultipartFormData qualified as LM
26import Network.HTTP.Client.MultipartFormData qualified as LM
27−import Network.HTTP.Req
27+import Network.HTTP.Req hiding (req)
28+import Network.HTTP.Req qualified as Req
28import Network.HTTP.Types qualified as Y
29import Network.HTTP.Types qualified as Y
29import Test.Hspec
30import Test.Hspec
30import Test.QuickCheck
31import Test.QuickCheck
@@ -33,25 +34,25 @@ spec :: Spec
34 describe "exception throwing on non-2xx status codes" $
35 describe "exception throwing on non-2xx status codes" $
35 it "throws indeed for non-2xx" $
36 it "throws indeed for non-2xx" $
36− req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty
37+ req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
37 `shouldThrow` selector404
38 `shouldThrow` selector404
39 describe "exception throwing on non-2xx status codes (Req monad)" $
40 describe "exception throwing on non-2xx status codes (Req monad)" $
40 it "throws indeed for non-2xx" $
41 it "throws indeed for non-2xx" $
41 asIO . runReq defaultHttpConfig $
42 asIO . runReq defaultHttpConfig $
42 liftBaseWith $ \run ->
43 liftBaseWith $ \run ->
43− run (req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty)
44+ run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)
44 `shouldThrow` selector404
45 `shouldThrow` selector404
46 describe "response check via httpConfigCheckResponse" $
47 describe "response check via httpConfigCheckResponse" $
47 context "if it's set to always throw" $
48 context "if it's set to always throw" $
48 it "throws indeed" $
49 it "throws indeed" $
49− blindlyThrowing (req GET httpbun NoReqBody ignoreResponse mempty)
50+ blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)
50 `shouldThrow` anyException
51 `shouldThrow` anyException
52 describe "isStatusCodeException" $
53 describe "isStatusCodeException" $
53 it "extracts non-2xx response" $
54 it "extracts non-2xx response" $
54− req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty
55+ req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty
55 `shouldThrow` selector404ByStatusCodeException
56 `shouldThrow` selector404ByStatusCodeException
57 describe "receiving user-agent header back" $
58 describe "receiving user-agent header back" $
@@ -59,7 +60,7 @@ spec = do
62− (httpbun /: "user-agent")
63+ (httpbin /: "user-agent")
64 jsonResponse
65 jsonResponse
65 (header "user-agent" "Req")
66 (header "user-agent" "Req")
@@ -74,27 +75,29 @@ spec = do
77− (httpbun /: "headers")
78+ (httpbin /: "headers")
79 jsonResponse
80 jsonResponse
80 (header "Foo" "bar" <> header "Baz" "quux")
81 (header "Foo" "bar" <> header "Baz" "quux")
81− stripFunnyHeaders' (responseBody r)
82+ stripFunnyHeaders (responseBody r)
82 `shouldBe` object
83 `shouldBe` object
83− [ "Accept-Encoding" .= ("gzip" :: Text),
86+ [ "Accept-Encoding" .= ("gzip" :: Text),
84− "Foo" .= ("bar" :: Text),
87+ "Foo" .= ("bar" :: Text),
85− "Baz" .= ("quux" :: Text)
88+ "Baz" .= ("quux" :: Text)
87 responseStatusCode r `shouldBe` 200
91 responseStatusCode r `shouldBe` 200
88 responseStatusMessage r `shouldBe` "OK"
92 responseStatusMessage r `shouldBe` "OK"
90 describe "receiving GET data back" $
94 describe "receiving GET data back" $
91 it "works" $ do
95 it "works" $ do
92− r <- req GET (httpbun /: "get") NoReqBody jsonResponse mempty
96+ r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty
93 (stripFunnyHeaders . stripOrigin) (responseBody r)
97 (stripFunnyHeaders . stripOrigin) (responseBody r)
94 `shouldBe` object
98 `shouldBe` object
95 [ "args" .= emptyObject,
99 [ "args" .= emptyObject,
96− "url" .= ("https://httpbun.org/get" :: Text),
100+ "url" .= ("http://localhost:1234/get" :: Text),
97− "method" .= ("GET" :: Text),
98 "headers"
101 "headers"
99 .= object
102 .= object
100 [ "Accept-Encoding" .= ("gzip" :: Text)
103 [ "Accept-Encoding" .= ("gzip" :: Text)
@@ -108,14 +111,13 @@ spec = do
108 it "works" $ do
111 it "works" $ do
109 let text = "foo" :: Text
112 let text = "foo" :: Text
110 reflected = reflectJSON text
113 reflected = reflectJSON text
111− r <- req POST (httpbun /: "post") (ReqBodyJson text) jsonResponse mempty
114+ r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty
112 (stripFunnyHeaders . stripOrigin) (responseBody r)
115 (stripFunnyHeaders . stripOrigin) (responseBody r)
113 `shouldBe` object
116 `shouldBe` object
114 [ "args" .= emptyObject,
117 [ "args" .= emptyObject,
115 "json" .= text,
118 "json" .= text,
116 "data" .= reflected,
119 "data" .= reflected,
117− "url" .= ("https://httpbun.org/post" :: Text),
120+ "url" .= ("http://localhost:1234/post" :: Text),
118− "method" .= ("POST" :: Text),
119 "headers"
121 "headers"
120 .= object
122 .= object
121 [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),
123 [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),
@@ -136,15 +138,14 @@ spec = do
136 [ LM.partBS "foo" "foo data!",
138 [ LM.partBS "foo" "foo data!",
137 LM.partBS "bar" "bar data!"
139 LM.partBS "bar" "bar data!"
139− r <- req POST (httpbun /: "post") body jsonResponse mempty
141+ r <- req POST (httpbin /: "post") body jsonResponse mempty
140 let contentType = fromJust (getRequestContentType body)
142 let contentType = fromJust (getRequestContentType body)
141 (stripFunnyHeaders . stripOrigin) (responseBody r)
143 (stripFunnyHeaders . stripOrigin) (responseBody r)
142 `shouldBe` object
144 `shouldBe` object
143 [ "args" .= emptyObject,
145 [ "args" .= emptyObject,
144 "json" .= Null,
146 "json" .= Null,
145 "data" .= ("" :: Text),
147 "data" .= ("" :: Text),
146− "url" .= ("https://httpbun.org/post" :: Text),
148+ "url" .= ("http://localhost:1234/post" :: Text),
147− "method" .= ("POST" :: Text),
148 "headers"
149 "headers"
149 .= object
150 .= object
150 [ "Content-Type" .= T.decodeUtf8 contentType,
151 [ "Content-Type" .= T.decodeUtf8 contentType,
@@ -165,16 +166,15 @@ spec = do
165 describe "receiving PATCHed file back" $
166 describe "receiving PATCHed file back" $
166 it "works" $ do
167 it "works" $ do
167 let file :: FilePath
168 let file :: FilePath
168− file = "httpbun-data/robots.txt"
169+ file = "httpbin-data/robots.txt"
169 contents <- TIO.readFile file
170 contents <- TIO.readFile file
170− r <- req PATCH (httpbun /: "patch") (ReqBodyFile file) jsonResponse mempty
171+ r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty
171 (stripFunnyHeaders . stripOrigin) (responseBody r)
172 (stripFunnyHeaders . stripOrigin) (responseBody r)
172 `shouldBe` object
173 `shouldBe` object
173 [ "args" .= emptyObject,
174 [ "args" .= emptyObject,
174 "json" .= Null,
175 "json" .= Null,
175 "data" .= contents,
176 "data" .= contents,
176− "url" .= ("https://httpbun.org/patch" :: Text),
177+ "url" .= ("http://localhost:1234/patch" :: Text),
177− "method" .= ("PATCH" :: Text),
178 "headers"
178 "headers"
179 .= object
179 .= object
180 [ "Accept-Encoding" .= ("gzip" :: Text),
180 [ "Accept-Encoding" .= ("gzip" :: Text),
@@ -193,14 +193,13 @@ spec = do
193 "foo" =: ("bar" :: Text)
193 "foo" =: ("bar" :: Text)
194 <> "baz" =: (5 :: Int)
194 <> "baz" =: (5 :: Int)
195 <> queryFlag "quux"
195 <> queryFlag "quux"
196− r <- req PUT (httpbun /: "put") (ReqBodyUrlEnc params) jsonResponse mempty
196+ r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty
197 (stripFunnyHeaders . stripOrigin) (responseBody r)
197 (stripFunnyHeaders . stripOrigin) (responseBody r)
198 `shouldBe` object
198 `shouldBe` object
199 [ "args" .= emptyObject,
199 [ "args" .= emptyObject,
200 "json" .= Null,
200 "json" .= Null,
201 "data" .= ("" :: Text),
201 "data" .= ("" :: Text),
202− "url" .= ("https://httpbun.org/put" :: Text),
202+ "url" .= ("http://localhost:1234/put" :: Text),
203− "method" .= ("PUT" :: Text),
204 "headers"
203 "headers"
205 .= object
204 .= object
206 [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),
205 [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),
@@ -219,19 +218,24 @@ spec = do
219 responseStatusCode r `shouldBe` 200
218 responseStatusCode r `shouldBe` 200
220 responseStatusMessage r `shouldBe` "OK"
219 responseStatusMessage r `shouldBe` "OK"
222− -- describe "receiving UTF-8 encoded Unicode data" $
223+ describe "receiving UTF-8 encoded Unicode data" $
223− -- it "works" $ do
224+ it "works" $ do
227− -- (httpbun /: "encoding" /: "utf8")
228+ (httpbin /: "encoding" /: "utf8")
228− -- NoReqBody
229+ NoReqBody
229− -- bsResponse
230+ bsResponse
230− -- mempty
231+ mempty
231− -- utf8data <- B.readFile "httpbun-data/utf8.html"
232+ utf8data <- B.readFile "httpbin-data/utf8.html"
232− -- responseBody r `shouldBe` utf8data
233+ responseBody r `shouldBe` utf8data
233− -- responseStatusCode r `shouldBe` 200
234+ responseStatusCode r `shouldBe` 200
234− -- responseStatusMessage r `shouldBe` "OK"
235+ responseStatusMessage r `shouldBe` "OK"
236 describe "retrying" $
240 describe "retrying" $
237 it "retries as many times as specified" $ do
241 it "retries as many times as specified" $ do
@@ -242,7 +246,7 @@ spec = do
242 prepareForShit $
246 prepareForShit $
245− (httpbun /: "status" /~ status)
249+ (httpbin /: "status" /~ status)
246 NoReqBody
250 NoReqBody
247 ignoreResponse
251 ignoreResponse
@@ -254,18 +258,25 @@ spec = do
254 forM_ [400 .. 431] checkStatusCode
258 forM_ [400 .. 431] checkStatusCode
255 forM_ [500 .. 511] checkStatusCode
259 forM_ [500 .. 511] checkStatusCode
261+ -- TODO /response-headers
257 describe "redirects" $
264 describe "redirects" $
258 it "follows redirects" $ do
265 it "follows redirects" $ do
262− (httpbun /: "redirect-to")
269+ (httpbin /: "redirect-to")
263 NoReqBody
270 NoReqBody
264 ignoreResponse
271 ignoreResponse
265− ("url" =: ("https://httpbun.org" :: Text))
272+ ("url" =: ("https://httpbin.org" :: Text))
266 responseStatusCode r `shouldBe` 200
273 responseStatusCode r `shouldBe` 200
267 responseStatusMessage r `shouldBe` "OK"
274 responseStatusMessage r `shouldBe` "OK"
276+ -- TODO /relative-redicet
277+ -- TODO /absolute-redirect
269 describe "basicAuth" $ do
280 describe "basicAuth" $ do
270 let user, password :: Text
281 let user, password :: Text
271 user = "Scooby"
282 user = "Scooby"
@@ -276,32 +287,43 @@ spec = do
276 prepareForShit $
287 prepareForShit $
279− (httpbun /: "basic-auth" /~ user /~ password)
290+ (httpbin /: "basic-auth" /~ user /~ password)
280 NoReqBody
291 NoReqBody
281 ignoreResponse
292 ignoreResponse
283 responseStatusCode r `shouldBe` 401
294 responseStatusCode r `shouldBe` 401
284− responseStatusMessage r `shouldBe` "Unauthorized"
295+ responseStatusMessage r `shouldBe` "UNAUTHORIZED"
285 context "when we provide appropriate basic auth data" $
296 context "when we provide appropriate basic auth data" $
286 it "succeeds" $ do
297 it "succeeds" $ do
290− (httpbun /: "basic-auth" /~ user /~ password)
301+ (httpbin /: "basic-auth" /~ user /~ password)
291 NoReqBody
302 NoReqBody
292 ignoreResponse
303 ignoreResponse
293− (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))
304+ (basicAuthUnsafe (T.encodeUtf8 user) (T.encodeUtf8 password))
294 responseStatusCode r `shouldBe` 200
305 responseStatusCode r `shouldBe` 200
295 responseStatusMessage r `shouldBe` "OK"
306 responseStatusMessage r `shouldBe` "OK"
308+ -- TODO /hidden-basic-auth
309+ -- TODO /digest-auth
297 describe "robots.txt" $
316 describe "robots.txt" $
298 it "works" $ do
317 it "works" $ do
299− r <- req GET (httpbun /: "robots.txt") NoReqBody bsResponse mempty
318+ r <- req GET (httpbin /: "robots.txt") NoReqBody bsResponse mempty
300− robots <- B.readFile "httpbun-data/robots.txt"
319+ robots <- B.readFile "httpbin-data/robots.txt"
301 responseBody r `shouldBe` robots
320 responseBody r `shouldBe` robots
302 responseStatusCode r `shouldBe` 200
321 responseStatusCode r `shouldBe` 200
303 responseStatusMessage r `shouldBe` "OK"
322 responseStatusMessage r `shouldBe` "OK"
305 describe "getting random bytes" $ do
327 describe "getting random bytes" $ do
306 it "works" $
328 it "works" $
307 property $ \n' -> do
329 property $ \n' -> do
@@ -310,7 +332,7 @@ spec = do
313− (httpbun /: "bytes" /~ n)
335+ (httpbin /: "bytes" /~ n)
314 NoReqBody
336 NoReqBody
315 lbsResponse
337 lbsResponse
@@ -326,27 +348,36 @@ spec = do
329− (httpbun /: "bytes" /~ n)
351+ (httpbin /: "bytes" /~ n)
330 NoReqBody
352 NoReqBody
331 (Proxy :: Proxy (JsonResponse Value))
353 (Proxy :: Proxy (JsonResponse Value))
333 `shouldThrow` selector
355 `shouldThrow` selector
335−-- describe "streaming random bytes" $
357+ describe "streaming random bytes" $
336−-- it "works" $
358+ it "works" $
337−-- property $ \n' -> do
359+ property $ \n' -> do
338−-- let n :: Word
360+ let n :: Word
339−-- n = getSmall n'
361+ n = getSmall n'
343−-- (httpbun /: "stream-bytes" /~ n)
365+ (httpbin /: "stream-bytes" /~ n)
344−-- NoReqBody
366+ NoReqBody
345−-- bsResponse
367+ bsResponse
347−-- responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)
369+ responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)
348−-- responseStatusCode r `shouldBe` 200
370+ responseStatusCode r `shouldBe` 200
349−-- responseStatusMessage r `shouldBe` "OK"
371+ responseStatusMessage r `shouldBe` "OK"
351----------------------------------------------------------------------------
382----------------------------------------------------------------------------
352-- Instances
383-- Instances
@@ -369,9 +400,29 @@ blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}
370 doit _ _ = error "Oops!"
401 doit _ _ = error "Oops!"
372−-- | 'Url' representing <https://httpbun.org>.
403+-- | 'Url' representing <https://httpbin.org>.
373−httpbun :: Url 'Https
404+httpbin :: Url 'Http
374−httpbun = https "httpbun.org"
405+httpbin = http "localhost"
411+ HttpResponse response,
412+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
420+req method url body responseProxy options =
421+ Req.req method url body responseProxy (options <> defaultOptions)
423+-- | Options to apply by default.
424+defaultOptions :: Option scheme
425+defaultOptions = port 1234
376-- | Remove “origin” field from JSON value. Origin may change, we don't want
427-- | Remove “origin” field from JSON value. Origin may change, we don't want
377-- to depend on that.
428-- to depend on that.
@@ -412,7 +463,7 @@ stripFunnyHeaders' = \case
415−-- | This is a complete test case that makes use of <https://httpbun.org> to
466+-- | This is a complete test case that makes use of <https://httpbin.org> to
416-- get various response status codes.
467-- get various response status codes.
417checkStatusCode :: Int -> SpecWith ()
468checkStatusCode :: Int -> SpecWith ()
418checkStatusCode code =
469checkStatusCode code =
@@ -422,7 +473,7 @@ checkStatusCode code =
422 prepareForShit $
473 prepareForShit $
425− (httpbun /: "status" /~ code)
476+ (httpbin /: "status" /~ code)
426 NoReqBody
477 NoReqBody
427 ignoreResponse
478 ignoreResponse