827404f · typeable/req

git.iko.soy/typeable/req

on master help sign in

Re-format with Ormolu 0.1.2.0

827404fMark Karpov6 years ago

httpbin-tests/Network/HTTP/ReqSpec.hs+64−82

compare with master

unifiedsplit

@@ -10,7 +10,7 @@ module Network.HTTP.ReqSpec (spec) where

10import Control.Exception

11import Control.Monad.Reader

12import Control.Monad.Trans.Control

13−import Data.Aeson ((.=), ToJSON (..), Value (..), object)

13+import Data.Aeson (ToJSON (..), Value (..), object, (.=))

14import qualified Data.Aeson as A

15import qualified Data.ByteString as B

16import qualified Data.ByteString.Lazy as BL

@@ -33,28 +33,26 @@ import Data.Semigroup ((<>))

34spec :: Spec

35spec = do

36− describe "exception throwing on non-2xx status codes"

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

37− $ it "throws indeed for non-2xx"

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

39− `shouldThrow` selector404

40−

41− describe "exception throwing on non-2xx status codes (Req monad)"

42− $ it "throws indeed for non-2xx"

37+ it "throws indeed for non-2xx" $

43− $ asIO . runReq defaultHttpConfig

44− $ liftBaseWith

45− $ \run ->

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

38+ req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty

47 `shouldThrow` selector404

39 `shouldThrow` selector404

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

42+ it "throws indeed for non-2xx" $

43+ asIO . runReq defaultHttpConfig $

44+ liftBaseWith $ \run ->

45+ run (req GET (httpbin /: "foo") NoReqBody ignoreResponse mempty)

46+ `shouldThrow` selector404

47+

49− describe "response check via httpConfigCheckResponse"

48+ describe "response check via httpConfigCheckResponse" $

50− $ context "if it's set to always throw"

49+ context "if it's set to always throw" $

51− $ it "throws indeed"

50+ it "throws indeed" $

52− $ blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)

51+ blindlyThrowing (req GET httpbin NoReqBody ignoreResponse mempty)

53− `shouldThrow` anyException

52+ `shouldThrow` anyException

54−

53+

55− describe "receiving user-agent header back"

54+ describe "receiving user-agent header back" $

56− $ it "works"

55+ it "works" $ do

57− $ do

58 r <-

56 r <-

59 req

57 req

60 GET

58 GET

@@ -68,9 +66,8 @@ spec = do

68 responseStatusCode r `shouldBe` 200

66 responseStatusCode r `shouldBe` 200

69 responseStatusMessage r `shouldBe` "OK"

67 responseStatusMessage r `shouldBe` "OK"

71− describe "receiving request headers back"

69+ describe "receiving request headers back" $

72− $ it "works"

70+ it "works" $ do

73− $ do

74 r <-

71 r <-

75 req

72 req

76 GET

73 GET

@@ -91,9 +88,8 @@ spec = do

91 responseStatusCode r `shouldBe` 200

88 responseStatusCode r `shouldBe` 200

92 responseStatusMessage r `shouldBe` "OK"

89 responseStatusMessage r `shouldBe` "OK"

94− describe "receiving GET data back"

91+ describe "receiving GET data back" $

95− $ it "works"

92+ it "works" $ do

96− $ do

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

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

98 (stripFunnyHeaders . stripOrigin) (responseBody r)

94 (stripFunnyHeaders . stripOrigin) (responseBody r)

99 `shouldBe` object

95 `shouldBe` object

@@ -109,9 +105,8 @@ spec = do

109 responseStatusCode r `shouldBe` 200

105 responseStatusCode r `shouldBe` 200

110 responseStatusMessage r `shouldBe` "OK"

106 responseStatusMessage r `shouldBe` "OK"

111

107

112− describe "receiving POST JSON data back"

108+ describe "receiving POST JSON data back" $

113− $ it "works"

109+ it "works" $ do

114− $ do

115 let text = "foo" :: Text

110 let text = "foo" :: Text

116 reflected = reflectJSON text

111 reflected = reflectJSON text

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

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

@@ -135,9 +130,8 @@ spec = do

135 responseStatusCode r `shouldBe` 200

130 responseStatusCode r `shouldBe` 200

136 responseStatusMessage r `shouldBe` "OK"

131 responseStatusMessage r `shouldBe` "OK"

137

132

138− describe "receiving POST data back (multipart form data)"

133+ describe "receiving POST data back (multipart form data)" $

139− $ it "works"

134+ it "works" $ do

140− $ do

141 body <-

135 body <-

142 reqBodyMultipart

136 reqBodyMultipart

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

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

@@ -169,9 +163,8 @@ spec = do

169 responseStatusCode r `shouldBe` 200

163 responseStatusCode r `shouldBe` 200

170 responseStatusMessage r `shouldBe` "OK"

164 responseStatusMessage r `shouldBe` "OK"

171

165

172− describe "receiving PATCHed file back"

166+ describe "receiving PATCHed file back" $

173− $ it "works"

167+ it "works" $ do

174− $ do

175 let file :: FilePath

168 let file :: FilePath

176 file = "httpbin-data/robots.txt"

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

177 contents <- TIO.readFile file

170 contents <- TIO.readFile file

@@ -195,9 +188,8 @@ spec = do

195 responseStatusCode r `shouldBe` 200

188 responseStatusCode r `shouldBe` 200

196 responseStatusMessage r `shouldBe` "OK"

189 responseStatusMessage r `shouldBe` "OK"

197

190

198− describe "receiving PUT form URL-encoded data back"

191+ describe "receiving PUT form URL-encoded data back" $

199− $ it "works"

192+ it "works" $ do

200− $ do

201 let params =

193 let params =

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

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

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

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

@@ -230,9 +222,8 @@ spec = do

230

222

231 -- TODO /delete

223 -- TODO /delete

232

224

233− describe "receiving UTF-8 encoded Unicode data"

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

234− $ it "works"

226+ it "works" $ do

235− $ do

236 r <-

227 r <-

237 req

228 req

238 GET

229 GET

@@ -248,9 +239,8 @@ spec = do

248 -- TODO /gzip

239 -- TODO /gzip

249 -- TODO /deflate

240 -- TODO /deflate

250

241

251− describe "retrying"

242+ describe "retrying" $

252− $ it "retries as many times as specified"

243+ it "retries as many times as specified" $ do

253− $ do

254 -- FIXME We no longer can count retries because all the functions

244 -- FIXME We no longer can count retries because all the functions

255 -- responsible for controlling retrying are pure now.

245 -- responsible for controlling retrying are pure now.

256 let status = 408 :: Int

246 let status = 408 :: Int

@@ -277,9 +267,8 @@ spec = do

277 --

267 --

278 -- https://github.com/postmanlabs/httpbin/issues/617

268 -- https://github.com/postmanlabs/httpbin/issues/617

279

269

280− -- describe "redirects"

270+ -- describe "redirects" $

281− -- $ it "follows redirects"

271+ -- it "follows redirects" $ do

282− -- $ do

283 -- r <-

272 -- r <-

284 -- req

273 -- req

285 -- GET

274 -- GET

@@ -298,9 +287,8 @@ spec = do

298 let user, password :: Text

287 let user, password :: Text

299 user = "Scooby"

288 user = "Scooby"

300 password = "Doo"

289 password = "Doo"

301− context "when we do not send appropriate basic auth data"

290+ context "when we do not send appropriate basic auth data" $

302− $ it "fails with 401"

291+ it "fails with 401" $ do

303− $ do

304 r <-

292 r <-

305 prepareForShit $

293 prepareForShit $

306 req

294 req

@@ -311,9 +299,8 @@ spec = do

311 mempty

299 mempty

312 responseStatusCode r `shouldBe` 401

300 responseStatusCode r `shouldBe` 401

313 responseStatusMessage r `shouldBe` "UNAUTHORIZED"

301 responseStatusMessage r `shouldBe` "UNAUTHORIZED"

314− context "when we provide appropriate basic auth data"

302+ context "when we provide appropriate basic auth data" $

315− $ it "succeeds"

303+ it "succeeds" $ do

316− $ do

317 r <-

304 r <-

318 req

305 req

319 GET

306 GET

@@ -332,9 +319,8 @@ spec = do

332 -- TODO /range

319 -- TODO /range

333 -- TODO /html

320 -- TODO /html

334

321

335− describe "robots.txt"

322+ describe "robots.txt" $

336− $ it "works"

323+ it "works" $ do

337− $ do

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

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

339 robots <- B.readFile "httpbin-data/robots.txt"

325 robots <- B.readFile "httpbin-data/robots.txt"

340 responseBody r `shouldBe` robots

326 responseBody r `shouldBe` robots

@@ -345,9 +331,8 @@ spec = do

345 -- TODO /cache

331 -- TODO /cache

346

332

347 describe "getting random bytes" $ do

333 describe "getting random bytes" $ do

348− it "works"

334+ it "works" $

349− $ property

335+ property $ \n' -> do

350− $ \n' -> do

351 let n :: Word

336 let n :: Word

352 n = getSmall n'

337 n = getSmall n'

353 r <-

338 r <-

@@ -360,9 +345,8 @@ spec = do

360 responseBody r `shouldSatisfy` ((== n) . fromIntegral . BL.length)

345 responseBody r `shouldSatisfy` ((== n) . fromIntegral . BL.length)

361 responseStatusCode r `shouldBe` 200

346 responseStatusCode r `shouldBe` 200

362 responseStatusMessage r `shouldBe` "OK"

347 responseStatusMessage r `shouldBe` "OK"

363− context "when we try to interpret 1000 random bytes as JSON"

348+ context "when we try to interpret 1000 random bytes as JSON" $

364− $ it "throws correct exception"

349+ it "throws correct exception" $ do

365− $ do

366 let selector :: HttpException -> Bool

350 let selector :: HttpException -> Bool

367 selector (JsonHttpException _) = True

351 selector (JsonHttpException _) = True

368 selector _ = False

352 selector _ = False

@@ -376,22 +360,21 @@ spec = do

376 mempty

360 mempty

377 `shouldThrow` selector

361 `shouldThrow` selector

378

362

379− describe "streaming random bytes"

363+ describe "streaming random bytes" $

380− $ it "works"

364+ it "works" $

381− $ property

365+ property $ \n' -> do

382− $ \n' -> do

383− let n :: Word

366+ let n :: Word

384− n = getSmall n'

367+ n = getSmall n'

385− r <-

368+ r <-

386− req

369+ req

387− GET

370+ GET

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

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

389− NoReqBody

372+ NoReqBody

390− bsResponse

373+ bsResponse

391− mempty

374+ mempty

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

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

393− responseStatusCode r `shouldBe` 200

376+ responseStatusCode r `shouldBe` 200

394− responseStatusMessage r `shouldBe` "OK"

377+ responseStatusMessage r `shouldBe` "OK"

395

378

396-- TODO /links

379-- TODO /links

397-- TODO /image

380-- TODO /image

@@ -454,9 +437,8 @@ stripFunnyHeaders value = value

454-- get various response status codes.

437-- get various response status codes.

455checkStatusCode :: Int -> SpecWith ()

438checkStatusCode :: Int -> SpecWith ()

456checkStatusCode code =

439checkStatusCode code =

457− describe ("receiving status code " ++ show code)

440+ describe ("receiving status code " ++ show code) $

458− $ it "works"

441+ it "works" $ do

459− $ do

460 r <-

442 r <-

461 prepareForShit $

443 prepareForShit $

462 req

444 req

pure-tests/Network/HTTP/ReqSpec.hs+132−166

@@ -54,13 +54,12 @@ import Data.Semigroup ((<>))

55spec :: Spec

56spec = do

57− describe "config"

57+ describe "config" $

58− $ it "getHttpConfig has effect on resulting request"

58+ it "getHttpConfig has effect on resulting request" $

59− $ property

59+ property $ \config -> do

60− $ \config -> do

61− request <- runReq config (req_ GET url NoReqBody mempty)

60+ request <- runReq config (req_ GET url NoReqBody mempty)

62− L.proxy request `shouldBe` httpConfigProxy config

61+ L.proxy request `shouldBe` httpConfigProxy config

63− L.redirectCount request `shouldBe` httpConfigRedirectCount config

62+ L.redirectCount request `shouldBe` httpConfigRedirectCount config

65 describe "methods" $ do

64 describe "methods" $ do

66 let mnth ::

65 let mnth ::

@@ -72,9 +71,8 @@ spec = do

72 SpecM () ()

71 SpecM () ()

73 mnth method = do

72 mnth method = do

74 let name = httpMethodName (Proxy :: Proxy method)

73 let name = httpMethodName (Proxy :: Proxy method)

75− describe (B8.unpack name)

74+ describe (B8.unpack name) $

76− $ it "affects name of HTTP method"

75+ it "affects name of HTTP method" $ do

77− $ do

78 request <- req_ method url NoReqBody mempty

76 request <- req_ method url NoReqBody mempty

79 L.method request `shouldBe` name

77 L.method request `shouldBe` name

80 mnth GET

78 mnth GET

@@ -88,48 +86,42 @@ spec = do

88 mnth PATCH

86 mnth PATCH

90 describe "urls" $ do

88 describe "urls" $ do

91− describe "http"

89+ describe "http" $

92− $ it "sets all the params correctly"

90+ it "sets all the params correctly" $

93− $ property

94− $ \host -> do

91+ property $ \host -> do

95− request <- req_ GET (http host) NoReqBody mempty

92+ request <- req_ GET (http host) NoReqBody mempty

96− L.secure request `shouldBe` False

93+ L.secure request `shouldBe` False

97− L.port request `shouldBe` 80

94+ L.port request `shouldBe` 80

98− L.host request `shouldBe` urlEncode host

95+ L.host request `shouldBe` urlEncode host

99− describe "https"

96+ describe "https" $

100− $ it "sets all the params correctly"

97+ it "sets all the params correctly" $

101− $ property

102− $ \host -> do

98+ property $ \host -> do

103− request <- req_ GET (https host) NoReqBody mempty

99+ request <- req_ GET (https host) NoReqBody mempty

104− L.secure request `shouldBe` True

100+ L.secure request `shouldBe` True

105− L.port request `shouldBe` 443

101+ L.port request `shouldBe` 443

106− L.host request `shouldBe` urlEncode host

102+ L.host request `shouldBe` urlEncode host

107− describe "(/~)"

103+ describe "(/~)" $

108− $ it "attaches a path piece that is URL-encoded"

104+ it "attaches a path piece that is URL-encoded" $

109− $ property

110− $ \host pieces -> do

105+ property $ \host pieces -> do

111− let url' = foldl (/~) (https host) pieces

106+ let url' = foldl (/~) (https host) pieces

112− request <- req_ GET url' NoReqBody mempty

107+ request <- req_ GET url' NoReqBody mempty

113− L.host request `shouldBe` urlEncode host

108+ L.host request `shouldBe` urlEncode host

114− L.path request `shouldBe` encodePathPieces pieces

109+ L.path request `shouldBe` encodePathPieces pieces

115− describe "(/:)"

110+ describe "(/:)" $

116− $ it "attaches a path piece that is URL-encoded"

111+ it "attaches a path piece that is URL-encoded" $

117− $ property

118− $ \host pieces -> do

112+ property $ \host pieces -> do

119− let url' = foldl (/:) (https host) pieces

113+ let url' = foldl (/:) (https host) pieces

120− request <- req_ GET url' NoReqBody mempty

114+ request <- req_ GET url' NoReqBody mempty

121− L.host request `shouldBe` urlEncode host

115+ L.host request `shouldBe` urlEncode host

122− L.path request `shouldBe` encodePathPieces pieces

116+ L.path request `shouldBe` encodePathPieces pieces

123

117

124 describe "useHttpURI" $ do

118 describe "useHttpURI" $ do

125− it "does not recognize non-http schemes"

119+ it "does not recognize non-http schemes" $

126− $ property

120+ property $ \uri ->

127− $ \uri ->

128 when (URI.uriScheme uri /= Just [QQ.scheme|http|]) $

121 when (URI.uriScheme uri /= Just [QQ.scheme|http|]) $

129 useHttpURI uri `shouldSatisfy` isNothing

122 useHttpURI uri `shouldSatisfy` isNothing

130− it "accepts correct URLs"

123+ it "accepts correct URLs" $

131− $ property

124+ property $ \uri' -> do

132− $ \uri' -> do

133 unless (isRight (URI.uriAuthority uri')) discard

125 unless (isRight (URI.uriAuthority uri')) discard

134 let uri = uri' {URI.uriScheme = Just [QQ.scheme|http|]}

126 let uri = uri' {URI.uriScheme = Just [QQ.scheme|http|]}

135 (url', options) = fromJust (useHttpURI uri)

127 (url', options) = fromJust (useHttpURI uri)

@@ -141,14 +133,12 @@ spec = do

141 lookup "Authorization" (L.requestHeaders request)

133 lookup "Authorization" (L.requestHeaders request)

142 `shouldBe` uriBasicAuth uri

134 `shouldBe` uriBasicAuth uri

143 describe "useHttpsURI" $ do

135 describe "useHttpsURI" $ do

144− it "does not recognize non-https schemes"

136+ it "does not recognize non-https schemes" $

145− $ property

137+ property $ \uri ->

146− $ \uri ->

147 when (URI.uriScheme uri /= Just [QQ.scheme|https|]) $

138 when (URI.uriScheme uri /= Just [QQ.scheme|https|]) $

148 useHttpsURI uri `shouldSatisfy` isNothing

139 useHttpsURI uri `shouldSatisfy` isNothing

149− it "parses correct URLs"

140+ it "parses correct URLs" $

150− $ property

141+ property $ \uri' -> do

151− $ \uri' -> do

152 unless (isRight (URI.uriAuthority uri')) discard

142 unless (isRight (URI.uriAuthority uri')) discard

153 let uri = uri' {URI.uriScheme = Just [QQ.scheme|https|]}

143 let uri = uri' {URI.uriScheme = Just [QQ.scheme|https|]}

154 (url', options) = fromJust (useHttpsURI uri)

144 (url', options) = fromJust (useHttpsURI uri)

@@ -160,18 +150,16 @@ spec = do

160 lookup "Authorization" (L.requestHeaders request)

150 lookup "Authorization" (L.requestHeaders request)

161 `shouldBe` uriBasicAuth uri

151 `shouldBe` uriBasicAuth uri

162 describe "useURI" $ do

152 describe "useURI" $ do

163− it "does not recognize non-http and non-https schemes"

153+ it "does not recognize non-http and non-https schemes" $

164− $ property

154+ property $ \uri ->

165− $ \uri ->

166 when

155 when

167 ( ( URI.uriScheme uri /= Just [QQ.scheme|http|]

156 ( ( URI.uriScheme uri /= Just [QQ.scheme|http|]

168 && (URI.uriScheme uri /= Just [QQ.scheme|https|])

157 && (URI.uriScheme uri /= Just [QQ.scheme|https|])

169 )

158 )

170 )

159 )

171 $ useURI uri `shouldSatisfy` isNothing

160 $ useURI uri `shouldSatisfy` isNothing

172− it "parses correct URLs"

161+ it "parses correct URLs" $

173− $ property

162+ property $ \uri' -> do

174− $ \uri' -> do

175 unless (isRight (URI.uriAuthority uri')) discard

163 unless (isRight (URI.uriAuthority uri')) discard

176 let uriHttp = uri' {URI.uriScheme = Just [QQ.scheme|http|]}

164 let uriHttp = uri' {URI.uriScheme = Just [QQ.scheme|http|]}

177 uriHttps = uri' {URI.uriScheme = Just [QQ.scheme|https|]}

165 uriHttps = uri' {URI.uriScheme = Just [QQ.scheme|https|]}

@@ -195,56 +183,49 @@ spec = do

195 `shouldBe` uriBasicAuth uriHttps

183 `shouldBe` uriBasicAuth uriHttps

196

184

197 describe "bodies" $ do

185 describe "bodies" $ do

198− describe "NoReqBody"

186+ describe "NoReqBody" $

199− $ it "sets body to empty byte string"

187+ it "sets body to empty byte string" $ do

200− $ do

201 request <- req_ POST url NoReqBody mempty

188 request <- req_ POST url NoReqBody mempty

202 case L.requestBody request of

189 case L.requestBody request of

203 L.RequestBodyBS x -> x `shouldBe` B.empty

190 L.RequestBodyBS x -> x `shouldBe` B.empty

204 _ -> expectationFailure "Wrong request body constructor."

191 _ -> expectationFailure "Wrong request body constructor."

205− describe "ReqBodyJson"

192+ describe "ReqBodyJson" $

206− $ it "sets body to correct lazy byte string"

193+ it "sets body to correct lazy byte string" $

207− $ property

208− $ \thing -> do

194+ property $ \thing -> do

209− request <- req_ POST url (ReqBodyJson thing) mempty

195+ request <- req_ POST url (ReqBodyJson thing) mempty

210− case L.requestBody request of

196+ case L.requestBody request of

211− L.RequestBodyLBS x -> x `shouldBe` A.encode (thing :: Thing)

197+ L.RequestBodyLBS x -> x `shouldBe` A.encode (thing :: Thing)

212− _ -> expectationFailure "Wrong request body constructor."

198+ _ -> expectationFailure "Wrong request body constructor."

213− describe "ReqBodyBs"

199+ describe "ReqBodyBs" $

214− $ it "sets body to specified strict byte string"

200+ it "sets body to specified strict byte string" $

215− $ property

201+ property $ \bs -> do

216− $ \bs -> do

217− request <- req_ POST url (ReqBodyBs bs) mempty

202+ request <- req_ POST url (ReqBodyBs bs) mempty

218− case L.requestBody request of

203+ case L.requestBody request of

219− L.RequestBodyBS x -> x `shouldBe` bs

204+ L.RequestBodyBS x -> x `shouldBe` bs

220− _ -> expectationFailure "Wrong request body constructor."

205+ _ -> expectationFailure "Wrong request body constructor."

221− describe "ReqBodyLbs"

206+ describe "ReqBodyLbs" $

222− $ it "sets body to specified lazy byte string"

207+ it "sets body to specified lazy byte string" $

223− $ property

224− $ \lbs -> do

208+ property $ \lbs -> do

225− request <- req_ POST url (ReqBodyLbs lbs) mempty

209+ request <- req_ POST url (ReqBodyLbs lbs) mempty

226− case L.requestBody request of

210+ case L.requestBody request of

227− L.RequestBodyLBS x -> x `shouldBe` lbs

211+ L.RequestBodyLBS x -> x `shouldBe` lbs

228− _ -> expectationFailure "Wrong request body constructor."

212+ _ -> expectationFailure "Wrong request body constructor."

229− describe "ReqBodyUrlEnc"

213+ describe "ReqBodyUrlEnc" $

230− $ it "sets body to correct lazy byte string"

214+ it "sets body to correct lazy byte string" $

231− $ property

232− $ \params -> do

215+ property $ \params -> do

233− request <- req_ POST url (ReqBodyUrlEnc (formUrlEnc params)) mempty

216+ request <- req_ POST url (ReqBodyUrlEnc (formUrlEnc params)) mempty

234− case L.requestBody request of

217+ case L.requestBody request of

235− L.RequestBodyLBS x -> x `shouldBe` renderQuery params

218+ L.RequestBodyLBS x -> x `shouldBe` renderQuery params

236− _ -> expectationFailure "Wrong request body constructor."

219+ _ -> expectationFailure "Wrong request body constructor."

237

220

238 describe "optional parameters" $ do

221 describe "optional parameters" $ do

239 describe "header" $ do

222 describe "header" $ do

240− it "sets specified header value"

223+ it "sets specified header value" $

241− $ property

242− $ \name value -> do

224+ property $ \name value -> do

243 request <- req_ GET url NoReqBody (header name value)

225 request <- req_ GET url NoReqBody (header name value)

244 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value

226 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value

245− it "left header wins"

227+ it "left header wins" $

246− $ property

247− $ \name value0 value1 -> do

228+ property $ \name value0 value1 -> do

248 request <-

229 request <-

249 req_

230 req_

250 GET

231 GET

@@ -252,9 +233,8 @@ spec = do

252 NoReqBody

233 NoReqBody

253 (header name value0 <> header name value1)

234 (header name value0 <> header name value1)

254 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value0

235 lookup (CI.mk name) (L.requestHeaders request) `shouldBe` pure value0

255− it "overwrites headers set by other parts of the lib"

236+ it "overwrites headers set by other parts of the lib" $

256− $ property

237+ property $ \value -> do

257− $ \value -> do

258 request <-

238 request <-

259 req_

239 req_

260 POST

240 POST

@@ -262,26 +242,23 @@ spec = do

262 (ReqBodyUrlEnc mempty)

242 (ReqBodyUrlEnc mempty)

263 (header "Content-Type" value)

243 (header "Content-Type" value)

264 lookup "Content-Type" (L.requestHeaders request) `shouldBe` pure value

244 lookup "Content-Type" (L.requestHeaders request) `shouldBe` pure value

265− describe "cookieJar"

245+ describe "cookieJar" $

266− $ it "cookie jar is set without modifications"

246+ it "cookie jar is set without modifications" $

267− $ property

247+ property $ \cjar -> do

268− $ \cjar -> do

269− request <- req_ GET url NoReqBody (cookieJar cjar)

248+ request <- req_ GET url NoReqBody (cookieJar cjar)

270#if MIN_VERSION_http_client(0,7,0)

249#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))

272#else

251#else

273− L.cookieJar request `shouldBe` Just cjar

252+ L.cookieJar request `shouldBe` Just cjar

274#endif

253#endif

275 describe "basicAuth" $ do

254 describe "basicAuth" $ do

276− it "sets Authorization header to correct value"

255+ it "sets Authorization header to correct value" $

277− $ property

278− $ \username password -> do

256+ property $ \username password -> do

279 request <- req_ GET url NoReqBody (basicAuth username password)

257 request <- req_ GET url NoReqBody (basicAuth username password)

280 lookup "Authorization" (L.requestHeaders request)

258 lookup "Authorization" (L.requestHeaders request)

281 `shouldBe` Just (basicAuthHeader username password)

259 `shouldBe` Just (basicAuthHeader username password)

282− it "overwrites manual setting of header"

260+ it "overwrites manual setting of header" $

283− $ property

284− $ \username password value -> do

261+ property $ \username password value -> do

285 request0 <-

262 request0 <-

286 req_

263 req_

287 GET

264 GET

@@ -297,9 +274,8 @@ spec = do

297 let result = Just (basicAuthHeader username password)

274 let result = Just (basicAuthHeader username password)

298 lookup "Authorization" (L.requestHeaders request0) `shouldBe` result

275 lookup "Authorization" (L.requestHeaders request0) `shouldBe` result

299 lookup "Authorization" (L.requestHeaders request1) `shouldBe` result

276 lookup "Authorization" (L.requestHeaders request1) `shouldBe` result

300− it "left auth option wins"

277+ it "left auth option wins" $

301− $ property

302− $ \username0 password0 username1 password1 -> do

278+ property $ \username0 password0 username1 password1 -> do

303 request <-

279 request <-

304 req_

280 req_

305 GET

281 GET

@@ -309,15 +285,13 @@ spec = do

309 lookup "Authorization" (L.requestHeaders request)

285 lookup "Authorization" (L.requestHeaders request)

310 `shouldBe` Just (basicAuthHeader username0 password0)

286 `shouldBe` Just (basicAuthHeader username0 password0)

311 describe "oAuth2Bearer" $ do

287 describe "oAuth2Bearer" $ do

312− it "sets Authorization header to correct value"

288+ it "sets Authorization header to correct value" $

313− $ property

289+ property $ \token -> do

314− $ \token -> do

315 request <- req_ GET url NoReqBody (oAuth2Bearer token)

290 request <- req_ GET url NoReqBody (oAuth2Bearer token)

316 lookup "Authorization" (L.requestHeaders request)

291 lookup "Authorization" (L.requestHeaders request)

317 `shouldBe` pure ("Bearer " <> token)

292 `shouldBe` pure ("Bearer " <> token)

318− it "overwrites manual setting of header"

293+ it "overwrites manual setting of header" $

319− $ property

320− $ \token value -> do

294+ property $ \token value -> do

321 request0 <-

295 request0 <-

322 req_

296 req_

323 GET

297 GET

@@ -335,9 +309,8 @@ spec = do

335 `shouldBe` pure result

309 `shouldBe` pure result

336 lookup "Authorization" (L.requestHeaders request1)

310 lookup "Authorization" (L.requestHeaders request1)

337 `shouldBe` pure result

311 `shouldBe` pure result

338− it "left auth option wins"

312+ it "left auth option wins" $

339− $ property

340− $ \token0 token1 -> do

313+ property $ \token0 token1 -> do

341 request <-

314 request <-

342 req_

315 req_

343 GET

316 GET

@@ -346,23 +319,20 @@ spec = do

346 (oAuth2Bearer token0 <> oAuth2Bearer token1)

319 (oAuth2Bearer token0 <> oAuth2Bearer token1)

347 lookup "Authorization" (L.requestHeaders request)

320 lookup "Authorization" (L.requestHeaders request)

348 `shouldBe` pure ("Bearer " <> token0)

321 `shouldBe` pure ("Bearer " <> token0)

349− describe "ProxyAuthorization"

322+ describe "ProxyAuthorization" $

350− $ it "sets Authorization header to correct value"

323+ it "sets Authorization header to correct value" $

351− $ property

352− $ \username password -> do

324+ property $ \username password -> do

353− request <- req_ GET url NoReqBody (basicProxyAuth username password)

325+ request <- req_ GET url NoReqBody (basicProxyAuth username password)

354− lookup "Proxy-Authorization" (L.requestHeaders request)

326+ lookup "Proxy-Authorization" (L.requestHeaders request)

355− `shouldBe` pure (basicProxyAuthHeader username password)

327+ `shouldBe` pure (basicProxyAuthHeader username password)

356 describe "oAuth2Token" $ do

328 describe "oAuth2Token" $ do

357− it "sets Authorization header to correct value"

329+ it "sets Authorization header to correct value" $

358− $ property

330+ property $ \token -> do

359− $ \token -> do

360 request <- req_ GET url NoReqBody (oAuth2Token token)

331 request <- req_ GET url NoReqBody (oAuth2Token token)

361 lookup "Authorization" (L.requestHeaders request)

332 lookup "Authorization" (L.requestHeaders request)

362 `shouldBe` pure ("token " <> token)

333 `shouldBe` pure ("token " <> token)

363− it "overwrites manual setting of header"

334+ it "overwrites manual setting of header" $

364− $ property

365− $ \token value -> do

335+ property $ \token value -> do

366 request0 <-

336 request0 <-

367 req_

337 req_

368 GET

338 GET

@@ -380,9 +350,8 @@ spec = do

380 `shouldBe` pure result

350 `shouldBe` pure result

381 lookup "Authorization" (L.requestHeaders request1)

351 lookup "Authorization" (L.requestHeaders request1)

382 `shouldBe` pure result

352 `shouldBe` pure result

383− it "left auth option wins"

353+ it "left auth option wins" $

384− $ property

385− $ \token0 token1 -> do

354+ property $ \token0 token1 -> do

386 request <-

355 request <-

387 req_

356 req_

388 GET

357 GET

@@ -391,27 +360,24 @@ spec = do

391 (oAuth2Token token0 <> oAuth2Token token1)

360 (oAuth2Token token0 <> oAuth2Token token1)

392 lookup "Authorization" (L.requestHeaders request)

361 lookup "Authorization" (L.requestHeaders request)

393 `shouldBe` pure ("token " <> token0)

362 `shouldBe` pure ("token " <> token0)

394− describe "port"

363+ describe "port" $

395− $ it "sets port overwriting the defaults"

364+ it "sets port overwriting the defaults" $

396− $ property

397− $ \n -> do

365+ property $ \n -> do

398− request <- req_ GET url NoReqBody (port n)

366+ request <- req_ GET url NoReqBody (port n)

399− L.port request `shouldBe` n

367+ L.port request `shouldBe` n

400− describe "decompress"

368+ describe "decompress" $

401− $ it "sets decompress function overwriting the defaults"

369+ it "sets decompress function overwriting the defaults" $

402− $ property

403− $ \token -> do

370+ property $ \token -> do

404− request <- req_ GET url NoReqBody (decompress (/= token))

371+ request <- req_ GET url NoReqBody (decompress (/= token))

405− L.decompress request token `shouldBe` False

372+ L.decompress request token `shouldBe` False

406 -- FIXME Can't really test responseTimeout right new because the

373 -- FIXME Can't really test responseTimeout right new because the

407 -- ResponseTimeout data type does not implement Eq and its constructors

374 -- ResponseTimeout data type does not implement Eq and its constructors

408 -- are also not exported. Sent a PR.

375 -- are also not exported. Sent a PR.

409− describe "httpVersion"

376+ describe "httpVersion" $

410− $ it "sets HTTP version overwriting the defaults"

377+ it "sets HTTP version overwriting the defaults" $

411− $ property

412− $ \major minor -> do

378+ property $ \major minor -> do

413− request <- req_ GET url NoReqBody (httpVersion major minor)

379+ request <- req_ GET url NoReqBody (httpVersion major minor)

414− L.requestVersion request `shouldBe` Y.HttpVersion major minor

380+ L.requestVersion request `shouldBe` Y.HttpVersion major minor

415

381

416 describe "quasiquoter" $ do

382 describe "quasiquoter" $ do

417 it "works for valid urls" $

383 it "works for valid urls" $

@@ -422,9 +388,9 @@ spec = do

422 forall a s. Typeable a => (a, Option s) -> Bool

388 forall a s. Typeable a => (a, Option s) -> Bool

423 testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https)

389 testTypeOfQuoterResult _ = isJust $ eqT @a @(Url 'Https)

424 in property $ testTypeOfQuoterResult [urlQ|https://example.org/|]

390 in property $ testTypeOfQuoterResult [urlQ|https://example.org/|]

425− it "doesn't work for invalid urls"

391+ it "doesn't work for invalid urls" $

426− $ property

392+ property $

427− $ TH.runQ (TH.quoteExp urlQ "not a url") `shouldThrow` anyIOException

393+ TH.runQ (TH.quoteExp urlQ "not a url") `shouldThrow` anyIOException

428

394

429----------------------------------------------------------------------------

395----------------------------------------------------------------------------

430-- Instances

396-- Instances