b6f0834 · typeable/req

git.iko.soy/typeable/req

on master help sign in

Switch back to httpbin, but run the server locally

b6f0834Mark Karpov3 years ago

.github/workflows/ci.yaml+4−1

compare with master

unifiedsplit

@@ -41,6 +41,9 @@ jobs:

41 ${{ runner.os }}-${{ matrix.ghc }}-

42 - run: cabal format && git diff --exit-code --color=always

43 - run: cabal build $CONFIG

44+ - run: |

45+ docker pull kennethreitz/httpbin

46+ docker run -p 1234:80 kennethreitz/httpbin &

44− - run: cabal test $CONFIG

47+ cabal test $CONFIG

45 - run: cabal haddock $CONFIG

48 - run: cabal haddock $CONFIG

46 - run: cabal sdist

49 - run: cabal sdist

CHANGELOG.md+6

@@ -1,3 +1,9 @@

1+## Req 3.13.2

3+* Disable the problematic `httpbin-tests` test suite by default. Only enable

4+ it when the `dev` flag is enabled. In that case it is expected that an

5+ httpbin server is run locally at `localhost:1234`.

1## Req 3.13.1

7## Req 3.13.1

3* Switched the non-pure test suite to use https://httpbun.org instead of

9* Switched the non-pure test suite to use https://httpbun.org instead of

httpbun-data/robots.txt → httpbin-data/robots.txtrenamed

The content is the same.

httpbun-data/utf8.html → httpbin-data/utf8.htmlrenamed

The content is the same.

httpbun-tests/Network/HTTP/ReqSpec.hs → httpbin-tests/Network/HTTP/ReqSpec.hsrenamed+137−75

@@ -24,7 +24,8 @@ import Data.Text.Encoding qualified as T

24import Data.Text.IO qualified as TIO

25import Network.HTTP.Client qualified as L

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,61 +34,74 @@ spec :: Spec

33spec = do

34spec = do

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

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+

57 describe "receiving request headers back" $

73 describe "receiving request headers back" $

58 it "works" $ do

74 it "works" $ do

59 r <-

75 r <-

60 req

76 req

61 GET

77 GET

62− (httpbun /: "headers")

78+ (httpbin /: "headers")

63 NoReqBody

79 NoReqBody

64 jsonResponse

80 jsonResponse

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

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

66− stripFunnyHeaders' (responseBody r)

82+ stripFunnyHeaders (responseBody r)

67 `shouldBe` object

83 `shouldBe` object

84+ [ "headers"

85+ .= object

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

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

69− "Foo" .= ("bar" :: Text),

87+ "Foo" .= ("bar" :: Text),

70− "Baz" .= ("quux" :: Text)

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

89+ ]

71 ]

90 ]

72 responseStatusCode r `shouldBe` 200

91 responseStatusCode r `shouldBe` 200

73 responseStatusMessage r `shouldBe` "OK"

92 responseStatusMessage r `shouldBe` "OK"

75 describe "receiving GET data back" $

94 describe "receiving GET data back" $

76 it "works" $ do

95 it "works" $ do

77− r <- req GET (httpbun /: "get") NoReqBody jsonResponse mempty

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

78 (stripFunnyHeaders . stripOrigin) (responseBody r)

97 (stripFunnyHeaders . stripOrigin) (responseBody r)

79 `shouldBe` object

98 `shouldBe` object

80 [ "args" .= emptyObject,

99 [ "args" .= emptyObject,

81− "url" .= ("https://httpbun.org/get" :: Text),

100+ "url" .= ("http://localhost:1234/get" :: Text),

82− "method" .= ("GET" :: Text),

83 "headers"

101 "headers"

84 .= object

102 .= object

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

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

86− ],

104+ ]

87− "form" .= emptyObject,

88− "files" .= emptyObject,

89− "data" .= ("" :: Text),

90− "json" .= Null

91 ]

105 ]

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

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

93 responseStatusCode r `shouldBe` 200

107 responseStatusCode r `shouldBe` 200

@@ -97,14 +111,13 @@ spec = do

97 it "works" $ do

111 it "works" $ do

98 let text = "foo" :: Text

112 let text = "foo" :: Text

99 reflected = reflectJSON text

113 reflected = reflectJSON text

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

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

101 (stripFunnyHeaders . stripOrigin) (responseBody r)

115 (stripFunnyHeaders . stripOrigin) (responseBody r)

102 `shouldBe` object

116 `shouldBe` object

103 [ "args" .= emptyObject,

117 [ "args" .= emptyObject,

104 "json" .= text,

118 "json" .= text,

105 "data" .= reflected,

119 "data" .= reflected,

106− "url" .= ("https://httpbun.org/post" :: Text),

120+ "url" .= ("http://localhost:1234/post" :: Text),

107− "method" .= ("POST" :: Text),

108 "headers"

121 "headers"

109 .= object

122 .= object

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

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

@@ -125,15 +138,14 @@ spec = do

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

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

126 LM.partBS "bar" "bar data!"

139 LM.partBS "bar" "bar data!"

127 ]

140 ]

128− r <- req POST (httpbun /: "post") body jsonResponse mempty

141+ r <- req POST (httpbin /: "post") body jsonResponse mempty

129 let contentType = fromJust (getRequestContentType body)

142 let contentType = fromJust (getRequestContentType body)

130 (stripFunnyHeaders . stripOrigin) (responseBody r)

143 (stripFunnyHeaders . stripOrigin) (responseBody r)

131 `shouldBe` object

144 `shouldBe` object

132 [ "args" .= emptyObject,

145 [ "args" .= emptyObject,

133 "json" .= Null,

146 "json" .= Null,

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

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

135− "url" .= ("https://httpbun.org/post" :: Text),

148+ "url" .= ("http://localhost:1234/post" :: Text),

136− "method" .= ("POST" :: Text),

137 "headers"

149 "headers"

138 .= object

150 .= object

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

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

@@ -154,16 +166,15 @@ spec = do

154 describe "receiving PATCHed file back" $

166 describe "receiving PATCHed file back" $

155 it "works" $ do

167 it "works" $ do

156 let file :: FilePath

168 let file :: FilePath

157− file = "httpbun-data/robots.txt"

169+ file = "httpbin-data/robots.txt"

158 contents <- TIO.readFile file

170 contents <- TIO.readFile file

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

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

160 (stripFunnyHeaders . stripOrigin) (responseBody r)

172 (stripFunnyHeaders . stripOrigin) (responseBody r)

161 `shouldBe` object

173 `shouldBe` object

162 [ "args" .= emptyObject,

174 [ "args" .= emptyObject,

163 "json" .= Null,

175 "json" .= Null,

164 "data" .= contents,

176 "data" .= contents,

165− "url" .= ("https://httpbun.org/patch" :: Text),

177+ "url" .= ("http://localhost:1234/patch" :: Text),

166− "method" .= ("PATCH" :: Text),

167 "headers"

178 "headers"

168 .= object

179 .= object

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

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

@@ -182,14 +193,13 @@ spec = do

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

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

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

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

184 <> queryFlag "quux"

195 <> queryFlag "quux"

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

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

186 (stripFunnyHeaders . stripOrigin) (responseBody r)

197 (stripFunnyHeaders . stripOrigin) (responseBody r)

187 `shouldBe` object

198 `shouldBe` object

188 [ "args" .= emptyObject,

199 [ "args" .= emptyObject,

189 "json" .= Null,

200 "json" .= Null,

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

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

191− "url" .= ("https://httpbun.org/put" :: Text),

202+ "url" .= ("http://localhost:1234/put" :: Text),

192− "method" .= ("PUT" :: Text),

193 "headers"

203 "headers"

194 .= object

204 .= object

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

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

@@ -208,19 +218,24 @@ spec = do

208 responseStatusCode r `shouldBe` 200

218 responseStatusCode r `shouldBe` 200

209 responseStatusMessage r `shouldBe` "OK"

219 responseStatusMessage r `shouldBe` "OK"

210

220

221+ -- TODO /delete

222+

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

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

212− -- it "works" $ do

224+ it "works" $ do

213− -- r <-

225+ r <-

214− -- req

226+ req

215− -- GET

227+ GET

216− -- (httpbun /: "encoding" /: "utf8")

228+ (httpbin /: "encoding" /: "utf8")

217− -- NoReqBody

229+ NoReqBody

218− -- bsResponse

230+ bsResponse

219− -- mempty

231+ mempty

220− -- utf8data <- B.readFile "httpbun-data/utf8.html"

232+ utf8data <- B.readFile "httpbin-data/utf8.html"

221− -- responseBody r `shouldBe` utf8data

233+ responseBody r `shouldBe` utf8data

222− -- responseStatusCode r `shouldBe` 200

234+ responseStatusCode r `shouldBe` 200

223− -- responseStatusMessage r `shouldBe` "OK"

235+ responseStatusMessage r `shouldBe` "OK"

236+

237+ -- TODO /gzip

238+ -- TODO /deflate

224

239

225 describe "retrying" $

240 describe "retrying" $

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

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

@@ -231,7 +246,7 @@ spec = do

231 prepareForShit $

246 prepareForShit $

232 req

247 req

233 GET

248 GET

234− (httpbun /: "status" /~ status)

249+ (httpbin /: "status" /~ status)

235 NoReqBody

250 NoReqBody

236 ignoreResponse

251 ignoreResponse

237 mempty

252 mempty

@@ -243,18 +258,25 @@ spec = do

243 forM_ [400 .. 431] checkStatusCode

258 forM_ [400 .. 431] checkStatusCode

244 forM_ [500 .. 511] checkStatusCode

259 forM_ [500 .. 511] checkStatusCode

245

260

261+ -- TODO /response-headers

262+ -- TODO /redirect

263+

246 describe "redirects" $

264 describe "redirects" $

247 it "follows redirects" $ do

265 it "follows redirects" $ do

248 r <-

266 r <-

249 req

267 req

250 GET

268 GET

251− (httpbun /: "redirect-to")

269+ (httpbin /: "redirect-to")

252 NoReqBody

270 NoReqBody

253 ignoreResponse

271 ignoreResponse

254− ("url" =: ("https://httpbun.org" :: Text))

272+ ("url" =: ("https://httpbin.org" :: Text))

255 responseStatusCode r `shouldBe` 200

273 responseStatusCode r `shouldBe` 200

256 responseStatusMessage r `shouldBe` "OK"

274 responseStatusMessage r `shouldBe` "OK"

257

275

276+ -- TODO /relative-redicet

277+ -- TODO /absolute-redirect

278+ -- TODO /cookies

279+

258 describe "basicAuth" $ do

280 describe "basicAuth" $ do

259 let user, password :: Text

281 let user, password :: Text

260 user = "Scooby"

282 user = "Scooby"

@@ -265,32 +287,43 @@ spec = do

265 prepareForShit $

287 prepareForShit $

266 req

288 req

267 GET

289 GET

268− (httpbun /: "basic-auth" /~ user /~ password)

290+ (httpbin /: "basic-auth" /~ user /~ password)

269 NoReqBody

291 NoReqBody

270 ignoreResponse

292 ignoreResponse

271 mempty

293 mempty

272 responseStatusCode r `shouldBe` 401

294 responseStatusCode r `shouldBe` 401

273− responseStatusMessage r `shouldBe` "Unauthorized"

295+ responseStatusMessage r `shouldBe` "UNAUTHORIZED"

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

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

275 it "succeeds" $ do

297 it "succeeds" $ do

276 r <-

298 r <-

277 req

299 req

278 GET

300 GET

279− (httpbun /: "basic-auth" /~ user /~ password)

301+ (httpbin /: "basic-auth" /~ user /~ password)

280 NoReqBody

302 NoReqBody

281 ignoreResponse

303 ignoreResponse

282− (basicAuth (T.encodeUtf8 user) (T.encodeUtf8 password))

304+ (basicAuthUnsafe (T.encodeUtf8 user) (T.encodeUtf8 password))

283 responseStatusCode r `shouldBe` 200

305 responseStatusCode r `shouldBe` 200

284 responseStatusMessage r `shouldBe` "OK"

306 responseStatusMessage r `shouldBe` "OK"

285

307

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+

286 describe "robots.txt" $

316 describe "robots.txt" $

287 it "works" $ do

317 it "works" $ do

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

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

289− robots <- B.readFile "httpbun-data/robots.txt"

319+ robots <- B.readFile "httpbin-data/robots.txt"

290 responseBody r `shouldBe` robots

320 responseBody r `shouldBe` robots

291 responseStatusCode r `shouldBe` 200

321 responseStatusCode r `shouldBe` 200

292 responseStatusMessage r `shouldBe` "OK"

322 responseStatusMessage r `shouldBe` "OK"

293

323

324+ -- TODO /deny

325+ -- TODO /cache

326+

294 describe "getting random bytes" $ do

327 describe "getting random bytes" $ do

295 it "works" $

328 it "works" $

296 property $ \n' -> do

329 property $ \n' -> do

@@ -299,7 +332,7 @@ spec = do

299 r <-

332 r <-

300 req

333 req

301 GET

334 GET

302− (httpbun /: "bytes" /~ n)

335+ (httpbin /: "bytes" /~ n)

303 NoReqBody

336 NoReqBody

304 lbsResponse

337 lbsResponse

305 mempty

338 mempty

@@ -315,27 +348,36 @@ spec = do

315 n = 1000

348 n = 1000

316 req

349 req

317 GET

350 GET

318− (httpbun /: "bytes" /~ n)

351+ (httpbin /: "bytes" /~ n)

319 NoReqBody

352 NoReqBody

320 (Proxy :: Proxy (JsonResponse Value))

353 (Proxy :: Proxy (JsonResponse Value))

321 mempty

354 mempty

322 `shouldThrow` selector

355 `shouldThrow` selector

323

356

324−-- describe "streaming random bytes" $

357+ describe "streaming random bytes" $

325−-- it "works" $

358+ it "works" $

326−-- property $ \n' -> do

359+ property $ \n' -> do

327−-- let n :: Word

360+ let n :: Word

328−-- n = getSmall n'

361+ n = getSmall n'

329−-- r <-

362+ r <-

330−-- req

363+ req

331−-- GET

364+ GET

332−-- (httpbun /: "stream-bytes" /~ n)

365+ (httpbin /: "stream-bytes" /~ n)

333−-- NoReqBody

366+ NoReqBody

334−-- bsResponse

367+ bsResponse

335−-- mempty

368+ mempty

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

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

337−-- responseStatusCode r `shouldBe` 200

370+ responseStatusCode r `shouldBe` 200

338−-- responseStatusMessage r `shouldBe` "OK"

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

339

381

340----------------------------------------------------------------------------

382----------------------------------------------------------------------------

341-- Instances

383-- Instances

@@ -358,9 +400,29 @@ blindlyThrowing = runReq defaultHttpConfig {httpConfigCheckResponse = doit}

358 where

400 where

359 doit _ _ = error "Oops!"

401 doit _ _ = error "Oops!"

360

402

361−-- | 'Url' representing <https://httpbun.org>.

403+-- | 'Url' representing <https://httpbin.org>.

362−httpbun :: Url 'Https

404+httpbin :: Url 'Http

363−httpbun = https "httpbun.org"

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

364

426

365-- | 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

366-- to depend on that.

428-- to depend on that.

@@ -401,7 +463,7 @@ stripFunnyHeaders' = \case

401 "Baz"

463 "Baz"

402 ]

464 ]

403

465

404−-- | 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

405-- get various response status codes.

467-- get various response status codes.

406checkStatusCode :: Int -> SpecWith ()

468checkStatusCode :: Int -> SpecWith ()

407checkStatusCode code =

469checkStatusCode code =

@@ -411,7 +473,7 @@ checkStatusCode code =

411 prepareForShit $

473 prepareForShit $

412 req

474 req

413 GET

475 GET

414− (httpbun /: "status" /~ code)

476+ (httpbin /: "status" /~ code)

415 NoReqBody

477 NoReqBody

416 ignoreResponse

478 ignoreResponse

417 mempty

479 mempty

httpbun-tests/Spec.hs → httpbin-tests/Spec.hsrenamed

The content is the same.

req.cabal+5−5

@@ -13,8 +13,8 @@ description: HTTP client library.

13category: Network, Web

14build-type: Simple

15data-files:

16− httpbun-data/utf8.html

16+ httpbin-data/utf8.html

17− httpbun-data/robots.txt

17+ httpbin-data/robots.txt

19extra-doc-files:

20 CHANGELOG.md

@@ -96,11 +96,11 @@ test-suite pure-tests

96 else

97 ghc-options: -O2 -Wall

99−test-suite httpbun-tests

99+test-suite httpbin-tests

100 type: exitcode-stdio-1.0

101 main-is: Spec.hs

102 build-tool-depends: hspec-discover:hspec-discover >=2 && <3

103− hs-source-dirs: httpbun-tests

103+ hs-source-dirs: httpbin-tests

104 other-modules: Network.HTTP.ReqSpec

105 default-language: GHC2021

106 build-depends:

@@ -121,4 +121,4 @@ test-suite httpbun-tests

121 -Wunused-packages

122

123 else

124− ghc-options: -O2 -Wall

124+ buildable: False