@@ -226,6 +226,97 @@ spec = do
226226 property $ \cjar -> do
227227 request <- req_ GET url NoReqBody (cookieJar cjar)
228228 L.cookieJar request `shouldBe` pure cjar
229+ describe "basicAuth" $ do
230+ it "sets Authorization header to correct value" $
231+ property $ \username password -> do
232+ request <- req_ GET url NoReqBody (basicAuth username password)
233+ lookup "Authorization" (L.requestHeaders request) `shouldBe`
234+ pure (basicAuthHeader username password)
235+ it "overwrites manual setting of header" $
236+ property $ \username password value -> do
237+ request0 <- req_ GET url NoReqBody
238+ (basicAuth username password <> header "Authorization" value)
239+ request1 <- req_ GET url NoReqBody
240+ (header "Authorization" value <> basicAuth username password)
241+ let result = basicAuthHeader username password
242+ lookup "Authorization" (L.requestHeaders request0) `shouldBe`
243+ pure result
244+ lookup "Authorization" (L.requestHeaders request1) `shouldBe`
245+ pure result
246+ it "left auth option wins" $
247+ property $ \username0 password0 username1 password1 -> do
248+ request <- req_ GET url NoReqBody
249+ (basicAuth username0 password0 <> basicAuth username1 password1)
250+ lookup "Authorization" (L.requestHeaders request) `shouldBe`
251+ pure (basicAuthHeader username0 password0)
252+ describe "oAuth1" $
253+ it "does something right" pending -- TODO
254+ describe "oAuth2Bearer" $ do
255+ it "sets Authorization header to correct value" $
256+ property $ \token -> do
257+ request <- req_ GET url NoReqBody (oAuth2Bearer token)
258+ lookup "Authorization" (L.requestHeaders request) `shouldBe`
259+ pure ("Bearer " <> token)
260+ it "overwrites manual setting of header" $
261+ property $ \token value -> do
262+ request0 <- req_ GET url NoReqBody
263+ (oAuth2Bearer token <> header "Authorization" value)
264+ request1 <- req_ GET url NoReqBody
265+ (header "Authorization" value <> oAuth2Bearer token)
266+ let result = "Bearer " <> token
267+ lookup "Authorization" (L.requestHeaders request0) `shouldBe`
268+ pure result
269+ lookup "Authorization" (L.requestHeaders request1) `shouldBe`
270+ pure result
271+ it "left auth option wins" $
272+ property $ \token0 token1 -> do
273+ request <- req_ GET url NoReqBody
274+ (oAuth2Bearer token0 <> oAuth2Bearer token1)
275+ lookup "Authorization" (L.requestHeaders request) `shouldBe`
276+ pure ("Bearer " <> token0)
277+ describe "oAuth2Token" $ do
278+ it "sets Authorization header to correct value" $
279+ property $ \token -> do
280+ request <- req_ GET url NoReqBody (oAuth2Token token)
281+ lookup "Authorization" (L.requestHeaders request) `shouldBe`
282+ pure ("token " <> token)
283+ it "overwrites manual setting of header" $
284+ property $ \token value -> do
285+ request0 <- req_ GET url NoReqBody
286+ (oAuth2Token token <> header "Authorization" value)
287+ request1 <- req_ GET url NoReqBody
288+ (header "Authorization" value <> oAuth2Token token)
289+ let result = "token " <> token
290+ lookup "Authorization" (L.requestHeaders request0) `shouldBe`
291+ pure result
292+ lookup "Authorization" (L.requestHeaders request1) `shouldBe`
293+ pure result
294+ it "left auth option wins" $
295+ property $ \token0 token1 -> do
296+ request <- req_ GET url NoReqBody
297+ (oAuth2Token token0 <> oAuth2Token token1)
298+ lookup "Authorization" (L.requestHeaders request) `shouldBe`
299+ pure ("token " <> token0)
300+ describe "awsAuth" $
301+ it "does something right" pending -- TODO
302+ describe "port" $
303+ it "sets port overwriting the defaults" $
304+ property $ \n -> do
305+ request <- req_ GET url NoReqBody (port n)
306+ L.port request `shouldBe` n
307+ describe "decompress" $
308+ it "sets decompress function overwriting the defaults" $
309+ property $ \token -> do
310+ request <- req_ GET url NoReqBody (decompress (/= token))
311+ L.decompress request token `shouldBe` False
312+ -- FIXME Can't really test responseTimeout right new because the
313+ -- ResponseTimeout data type does not implement Eq and its constructors
314+ -- are also not exported. Sent a PR.
315+ describe "httpVersion" $
316+ it "sets HTTP version overwriting the defaults" $
317+ property $ \major minor -> do
318+ request <- req_ GET url NoReqBody (httpVersion major minor)
319+ L.requestVersion request `shouldBe` Y.HttpVersion major minor
229320
230321----------------------------------------------------------------------------
231322-- Instances
@@ -368,3 +459,10 @@ wellFormed = all (not . T.null . fst)
368459
369460formUrlEnc :: [(Text, Maybe Text)] -> FormUrlEncodedParam
370461formUrlEnc = foldMap (uncurry queryParam)
462+
463+-- | Get “Authorization” basic auth header given username and password.
464+
465+basicAuthHeader :: ByteString -> ByteString -> ByteString
466+basicAuthHeader username password =
467+ fromJust . lookup Y.hAuthorization . L.requestHeaders $
468+ L.applyBasicAuth username password L.defaultRequest