b25011d · typeable/req

33spec = do

34 describe "exception throwing on non-2xx status codes" $

35 it "throws indeed for non-2xx" $

36− req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty

36+ req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty

37 `shouldThrow` selector404

38

39 describe "exception throwing on non-2xx status codes (Req monad)" $

40 it "throws indeed for non-2xx" $

41 asIO . runReq defaultHttpConfig $

42 liftBaseWith $ \run ->

43− run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)

43+ run (req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty)

44 `shouldThrow` selector404

45

46 describe "response check via httpConfigCheckResponse" $

47 context "if it's set to always throw" $

48 it "throws indeed" $

49− blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)

49+ blindlyThrowing (req GET httpbun NoReqBody ignoreResponse mempty)

50 `shouldThrow` anyException

51

52 describe "isStatusCodeException" $

53 it "extracts non-2xx response" $

54− req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty

54+ req GET (httpbun /: "foo") NoReqBody ignoreResponse mempty

55 `shouldThrow` selector404ByStatusCodeException

56

57 describe "receiving user-agent header back" $

59 r <-

60 req

61 GET

62− (httpbin /: "user-agent")

62+ (httpbun /: "user-agent")

63 NoReqBody

64 jsonResponse

65 (header "user-agent" "Req")

74 r <-

75 req

76 GET

77− (httpbin /: "headers")

77+ (httpbun /: "headers")

78 NoReqBody

79 jsonResponse

80 (header "Foo" "bar" <> header "Baz" "quux")

84 .= object

85 [ "Accept-Encoding" .= ("gzip" :: Text),

86 "Foo" .= ("bar" :: Text),

87− "Baz" .= ("quux" :: Text),

87+ "Baz" .= ("quux" :: Text)

88− "Host" .= ("httpbin.org" :: Text)

89 ]

88 ]

90 ]

89 ]

91 responseStatusCode r `shouldBe` 200

90 responseStatusCode r `shouldBe` 200

93

92

94 describe "receiving GET data back" $

93 describe "receiving GET data back" $

95 it "works" $ do

94 it "works" $ do

96− r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty

95+ r <- req GET (httpbun /: "get") NoReqBody jsonResponse mempty

97 (stripFunnyHeaders . stripOrigin) (responseBody r)

96 (stripFunnyHeaders . stripOrigin) (responseBody r)

98 `shouldBe` object

97 `shouldBe` object

99 [ "args" .= emptyObject,

98 [ "args" .= emptyObject,

100− "url" .= ("https://httpbin.org/get" :: Text),

99+ "url" .= ("https://httpbun.org/get" :: Text),

100+ "method" .= ("GET" :: Text),

101 "headers"

102 .= object

103− [ "Accept-Encoding" .= ("gzip" :: Text),

103+ [ "Accept-Encoding" .= ("gzip" :: Text)

104− "Host" .= ("httpbin.org" :: Text)

105 ]

104 ]

106 ]

105 ]

107 responseHeader r "Content-Type" `shouldBe` return "application/json"

106 responseHeader r "Content-Type" `shouldBe` return "application/json"

112 it "works" $ do

111 it "works" $ do

113 let text = "foo" :: Text

112 let text = "foo" :: Text

114 reflected = reflectJSON text

113 reflected = reflectJSON text

115− r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty

114+ r <- req POST (httpbun /: "post") (ReqBodyJson text) jsonResponse mempty

116 (stripFunnyHeaders . stripOrigin) (responseBody r)

115 (stripFunnyHeaders . stripOrigin) (responseBody r)

117 `shouldBe` object

116 `shouldBe` object

118 [ "args" .= emptyObject,

117 [ "args" .= emptyObject,

119 "json" .= text,

118 "json" .= text,

120 "data" .= reflected,

119 "data" .= reflected,

121− "url" .= ("https://httpbin.org/post" :: Text),

120+ "url" .= ("https://httpbun.org/post" :: Text),

121+ "method" .= ("POST" :: Text),

122 "headers"

123 .= object

124 [ "Content-Type" .= ("application/json; charset=utf-8" :: Text),

125 "Accept-Encoding" .= ("gzip" :: Text),

126− "Host" .= ("httpbin.org" :: Text),

127 "Content-Length" .= show (T.length reflected)

126 "Content-Length" .= show (T.length reflected)

128 ],

127 ],

129 "files" .= emptyObject,

128 "files" .= emptyObject,

140 [ LM.partBS "foo" "foo data!",

139 [ LM.partBS "foo" "foo data!",

141 LM.partBS "bar" "bar data!"

140 LM.partBS "bar" "bar data!"

142 ]

141 ]

143− r <- req POST (httpbin /: "post") body jsonResponse mempty

142+ r <- req POST (httpbun /: "post") body jsonResponse mempty

144 let contentType = fromJust (getRequestContentType body)

143 let contentType = fromJust (getRequestContentType body)

145 (stripFunnyHeaders . stripOrigin) (responseBody r)

144 (stripFunnyHeaders . stripOrigin) (responseBody r)

146 `shouldBe` object

145 `shouldBe` object

147 [ "args" .= emptyObject,

146 [ "args" .= emptyObject,

148 "json" .= Null,

147 "json" .= Null,

149 "data" .= ("" :: Text),

148 "data" .= ("" :: Text),

150− "url" .= ("https://httpbin.org/post" :: Text),

149+ "url" .= ("https://httpbun.org/post" :: Text),

150+ "method" .= ("POST" :: Text),

151 "headers"

152 .= object

153 [ "Content-Type" .= T.decodeUtf8 contentType,

154 "Accept-Encoding" .= ("gzip" :: Text),

155− "Host" .= ("httpbin.org" :: Text),

156 "Content-Length" .= ("242" :: Text)

155 "Content-Length" .= ("242" :: Text)

157 ],

156 ],

158 "files" .= emptyObject,

157 "files" .= emptyObject,

169 describe "receiving PATCHed file back" $

168 describe "receiving PATCHed file back" $

170 it "works" $ do

169 it "works" $ do

171 let file :: FilePath

170 let file :: FilePath

172− file = "httpbin-data/robots.txt"

171+ file = "httpbun-data/robots.txt"

173 contents <- TIO.readFile file

172 contents <- TIO.readFile file

174− r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty

173+ r <- req PATCH (httpbun /: "patch") (ReqBodyFile file) jsonResponse mempty

175 (stripFunnyHeaders . stripOrigin) (responseBody r)

174 (stripFunnyHeaders . stripOrigin) (responseBody r)

176 `shouldBe` object

175 `shouldBe` object

177 [ "args" .= emptyObject,

176 [ "args" .= emptyObject,

178 "json" .= Null,

177 "json" .= Null,

179 "data" .= contents,

178 "data" .= contents,

180− "url" .= ("https://httpbin.org/patch" :: Text),

179+ "url" .= ("https://httpbun.org/patch" :: Text),

180+ "method" .= ("PATCH" :: Text),

181 "headers"

182 .= object

183 [ "Accept-Encoding" .= ("gzip" :: Text),

184− "Host" .= ("httpbin.org" :: Text),

185 "Content-Length" .= show (T.length contents)

184 "Content-Length" .= show (T.length contents)

186 ],

185 ],

187 "files" .= emptyObject,

186 "files" .= emptyObject,

197 "foo" =: ("bar" :: Text)

196 "foo" =: ("bar" :: Text)

198 <> "baz" =: (5 :: Int)

197 <> "baz" =: (5 :: Int)

199 <> queryFlag "quux"

198 <> queryFlag "quux"

200− r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty

199+ r <- req PUT (httpbun /: "put") (ReqBodyUrlEnc params) jsonResponse mempty

201 (stripFunnyHeaders . stripOrigin) (responseBody r)

200 (stripFunnyHeaders . stripOrigin) (responseBody r)

202 `shouldBe` object

201 `shouldBe` object

203 [ "args" .= emptyObject,

202 [ "args" .= emptyObject,

204 "json" .= Null,

203 "json" .= Null,

205 "data" .= ("" :: Text),

204 "data" .= ("" :: Text),

206− "url" .= ("https://httpbin.org/put" :: Text),

205+ "url" .= ("https://httpbun.org/put" :: Text),

206+ "method" .= ("PUT" :: Text),

207 "headers"

208 .= object

209 [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text),

210 "Accept-Encoding" .= ("gzip" :: Text),

211− "Host" .= ("httpbin.org" :: Text),

212 "Content-Length" .= ("18" :: Text)

211 "Content-Length" .= ("18" :: Text)

213 ],

212 ],

214 "files" .= emptyObject,

213 "files" .= emptyObject,

223 responseStatusCode r `shouldBe` 200

222 responseStatusCode r `shouldBe` 200

224 responseStatusMessage r `shouldBe` "OK"

223 responseStatusMessage r `shouldBe` "OK"

225

224

226− -- TODO /delete

227−

228− describe "receiving UTF-8 encoded Unicode data" $

225+ -- describe "receiving UTF-8 encoded Unicode data" $

229− it "works" $ do

226+ -- it "works" $ do

230− r <-

227+ -- r <-

231− req

228+ -- req

232− GET

229+ -- GET

233− (httpbin /: "encoding" /: "utf8")

230+ -- (httpbun /: "encoding" /: "utf8")

234− NoReqBody

231+ -- NoReqBody

235− bsResponse

232+ -- bsResponse

236− mempty

233+ -- mempty

237− utf8data <- B.readFile "httpbin-data/utf8.html"

234+ -- utf8data <- B.readFile "httpbun-data/utf8.html"

238− responseBody r `shouldBe` utf8data

235+ -- responseBody r `shouldBe` utf8data

239− responseStatusCode r `shouldBe` 200

236+ -- responseStatusCode r `shouldBe` 200

240− responseStatusMessage r `shouldBe` "OK"

237+ -- responseStatusMessage r `shouldBe` "OK"

241−

242− -- TODO /gzip

243− -- TODO /deflate

244

238

245 describe "retrying" $

239 describe "retrying" $

246 it "retries as many times as specified" $ do

240 it "retries as many times as specified" $ do

251 prepareForShit $

245 prepareForShit $

252 req

246 req

253 GET

247 GET

254− (httpbin /: "status" /~ status)

248+ (httpbun /: "status" /~ status)

255 NoReqBody

249 NoReqBody

256 ignoreResponse

250 ignoreResponse

257 mempty

251 mempty

263 forM_ [400 .. 431] checkStatusCode

257 forM_ [400 .. 431] checkStatusCode

264 forM_ [500 .. 511] checkStatusCode

258 forM_ [500 .. 511] checkStatusCode

265

259

266− -- TODO /response-headers

267− -- TODO /redirect

268−

269 describe "redirects" $

260 describe "redirects" $

270 it "follows redirects" $ do

261 it "follows redirects" $ do

271 r <-

262 r <-

272 req

263 req

273 GET

264 GET

274− (httpbin /: "redirect-to")

265+ (httpbun /: "redirect-to")

275 NoReqBody

266 NoReqBody

276 ignoreResponse

267 ignoreResponse

277− ("url" =: ("https://httpbin.org" :: Text))

268+ ("url" =: ("https://httpbun.org" :: Text))

278 responseStatusCode r `shouldBe` 200

269 responseStatusCode r `shouldBe` 200

279 responseStatusMessage r `shouldBe` "OK"

270 responseStatusMessage r `shouldBe` "OK"

280

271

281− -- TODO /relative-redicet

282− -- TODO /absolute-redirect

283− -- TODO /cookies

284−

285 describe "basicAuth" $ do

272 describe "basicAuth" $ do

286 let user, password :: Text

273 let user, password :: Text

287 user = "Scooby"

274 user = "Scooby"

292 prepareForShit $

279 prepareForShit $

293 req

280 req

294 GET

281 GET

295− (httpbin /: "basic-auth" /~ user /~ password)

282+ (httpbun /: "basic-auth" /~ user /~ password)

296 NoReqBody

283 NoReqBody

297 ignoreResponse

284 ignoreResponse

298 mempty

285 mempty

299 responseStatusCode r `shouldBe` 401

286 responseStatusCode r `shouldBe` 401

300− responseStatusMessage r `shouldBe` "UNAUTHORIZED"

287+ responseStatusMessage r `shouldBe` "Unauthorized"

301 context "when we provide appropriate basic auth data" $

288 context "when we provide appropriate basic auth data" $

302 it "succeeds" $ do

289 it "succeeds" $ do

303 r <-

290 r <-

304 req

291 req

305 GET

292 GET

306− (httpbin /: "basic-auth" /~ user /~ password)

293+ (httpbun /: "basic-auth" /~ user /~ password)

307 NoReqBody

294 NoReqBody

308 ignoreResponse

295 ignoreResponse

309 (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))

296 (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))

310 responseStatusCode r `shouldBe` 200

297 responseStatusCode r `shouldBe` 200

311 responseStatusMessage r `shouldBe` "OK"

298 responseStatusMessage r `shouldBe` "OK"

312

299

313− -- TODO /hidden-basic-auth

314− -- TODO /digest-auth

315− -- TODO /stream

316− -- TODO /delay

317− -- TODO /drip

318− -- TODO /range

319− -- TODO /html

320−

321 describe "robots.txt" $

300 describe "robots.txt" $

322 it "works" $ do

301 it "works" $ do

323− r <- req GET (httpbin /: "robots.txt") NoReqBody bsResponse mempty

302+ r <- req GET (httpbun /: "robots.txt") NoReqBody bsResponse mempty

324− robots <- B.readFile "httpbin-data/robots.txt"

303+ robots <- B.readFile "httpbun-data/robots.txt"

325 responseBody r `shouldBe` robots

304 responseBody r `shouldBe` robots

326 responseStatusCode r `shouldBe` 200

305 responseStatusCode r `shouldBe` 200

327 responseStatusMessage r `shouldBe` "OK"

306 responseStatusMessage r `shouldBe` "OK"

328

307

329− -- TODO /deny

330− -- TODO /cache

331−

332 describe "getting random bytes" $ do

308 describe "getting random bytes" $ do

333 it "works" $

309 it "works" $

334 property $ \n' -> do

310 property $ \n' -> do

337 r <-

313 r <-

338 req

314 req

339 GET

315 GET

340− (httpbin /: "bytes" /~ n)

316+ (httpbun /: "bytes" /~ n)

341 NoReqBody

317 NoReqBody

342 lbsResponse

318 lbsResponse

343 mempty

319 mempty

353 n = 1000

329 n = 1000

354 req

330 req

355 GET

331 GET

356− (httpbin /: "bytes" /~ n)

332+ (httpbun /: "bytes" /~ n)

357 NoReqBody

333 NoReqBody

358 (Proxy :: Proxy (JsonResponse Value))

334 (Proxy :: Proxy (JsonResponse Value))

359 mempty

335 mempty

360 `shouldThrow` selector

336 `shouldThrow` selector

361

337

362− describe "streaming random bytes" $

338+-- describe "streaming random bytes" $

363− it "works" $

339+-- it "works" $

364− property $ \n' -> do

340+-- property $ \n' -> do

365− let n :: Word

341+-- let n :: Word

366− n = getSmall n'

342+-- n = getSmall n'

367− r <-

343+-- r <-

368− req

344+-- req

369− GET

345+-- GET

370− (httpbin /: "stream-bytes" /~ n)

346+-- (httpbun /: "stream-bytes" /~ n)

371− NoReqBody

347+-- NoReqBody

372− bsResponse

348+-- bsResponse

373− mempty

349+-- mempty

374− responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)

350+-- responseBody r `shouldSatisfy` ((== n) . fromIntegral . B.length)

375− responseStatusCode r `shouldBe` 200

351+-- responseStatusCode r `shouldBe` 200

376− responseStatusMessage r `shouldBe` "OK"

352+-- responseStatusMessage r `shouldBe` "OK"

377−

378−-- TODO /links

379−-- TODO /image

380−-- TODO /image/png

381−-- TODO /image/jpeg

382−-- TODO /image/webp

383−-- TODO /image/svg

384−-- TODO /forms/post

385−-- TODO /xml

386

353

387----------------------------------------------------------------------------

354----------------------------------------------------------------------------

388-- Instances

355-- Instances

405 where

372 where

406 doit _ _ = error "Oops!"

373 doit _ _ = error "Oops!"

407

374

408−-- | 'Url' representing <https://httpbin.org>.

375+-- | 'Url' representing <https://httpbun.org>.

409−httpbin :: Url 'Https

376+httpbun :: Url 'Https

410−httpbin = https "httpbin.org"

377+httpbun = https "httpbun.org"

411

378

412-- | Remove “origin” field from JSON value. Origin may change, we don't want

379-- | Remove “origin” field from JSON value. Origin may change, we don't want

413-- to depend on that.

380-- to depend on that.

431 in Object (runIdentity (Aeson.KeyMap.alterF (pure . fmap f) "headers" m))

398 in Object (runIdentity (Aeson.KeyMap.alterF (pure . fmap f) "headers" m))

432stripFunnyHeaders value = value

399stripFunnyHeaders value = value

433

400

434−-- | This is a complete test case that makes use of <https://httpbin.org> to

401+-- | This is a complete test case that makes use of <https://httpbun.org> to

435-- get various response status codes.

402-- get various response status codes.

436checkStatusCode :: Int -> SpecWith ()

403checkStatusCode :: Int -> SpecWith ()

437checkStatusCode code =

404checkStatusCode code =

441 prepareForShit $

408 prepareForShit $

442 req

409 req

443 GET

410 GET

444− (httpbin /: "status" /~ code)

411+ (httpbun /: "status" /~ code)

445 NoReqBody

412 NoReqBody

446 ignoreResponse

413 ignoreResponse

447 mempty

414 mempty