git.iko.soy/typeable/servant
on master help sign in
Changed servant-client tests to reflect the changes to the client function
89b0758mbg
servant-client/test/Servant/ClientSpec.hs+50−49
compare with master
unifiedsplit
@@ -28,7 +28,7 @@ import Control.Applicative ((<$>))
28import Control.Arrow (left)
28import Control.Arrow (left)
29import Control.Concurrent (forkIO, killThread, ThreadId)
29import Control.Concurrent (forkIO, killThread, ThreadId)
30import Control.Exception (bracket)
30import Control.Exception (bracket)
31−import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
31+import Control.Monad.Trans.Except (ExceptT, throwE)
32import Data.Aeson
32import Data.Aeson
33import Data.Char (chr, isPrint)
33import Data.Char (chr, isPrint)
34import Data.Foldable (forM_)
34import Data.Foldable (forM_)
@@ -208,47 +208,48 @@ sucessSpec :: Spec
208sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
208sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
209
209
210 it "Servant.API.Get" $ \(_, baseUrl) -> do
210 it "Servant.API.Get" $ \(_, baseUrl) -> do
211− let getGet = getNth (Proxy :: Proxy 0) $ client api baseUrl manager
211+ let getGet = getNth (Proxy :: Proxy 0) $ client api
212− (left show <$> runExceptT getGet) `shouldReturn` Right alice
212+ (left show <$> SCR.runClientM getGet baseUrl manager) `shouldReturn` Right alice
213
213
214 describe "Servant.API.Delete" $ do
214 describe "Servant.API.Delete" $ do
215 it "allows empty content type" $ \(_, baseUrl) -> do
215 it "allows empty content type" $ \(_, baseUrl) -> do
216− let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api baseUrl manager
216+ let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api
217− (left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right NoContent
217+ (left show <$> SCR.runClientM getDeleteEmpty baseUrl manager) `shouldReturn` Right NoContent
218
218
219 it "allows content type" $ \(_, baseUrl) -> do
219 it "allows content type" $ \(_, baseUrl) -> do
220− let getDeleteContentType = getLast $ client api baseUrl manager
220+ let getDeleteContentType :: SCR.ClientM NoContent
221+ getDeleteContentType = getLast $ client api
221− (left show <$> runExceptT getDeleteContentType) `shouldReturn` Right NoContent
222+ (left show <$> SCR.runClientM getDeleteContentType baseUrl manager) `shouldReturn` Right NoContent
222
223
223 it "Servant.API.Capture" $ \(_, baseUrl) -> do
224 it "Servant.API.Capture" $ \(_, baseUrl) -> do
224− let getCapture = getNth (Proxy :: Proxy 2) $ client api baseUrl manager
225+ let getCapture = getNth (Proxy :: Proxy 2) $ client api
225− (left show <$> runExceptT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
226+ (left show <$> SCR.runClientM (getCapture "Paula") baseUrl manager) `shouldReturn` Right (Person "Paula" 0)
226
227
227 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
228 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
228 let p = Person "Clara" 42
229 let p = Person "Clara" 42
229− getBody = getNth (Proxy :: Proxy 3) $ client api baseUrl manager
230+ getBody = getNth (Proxy :: Proxy 3) $ client api
230− (left show <$> runExceptT (getBody p)) `shouldReturn` Right p
231+ (left show <$> SCR.runClientM (getBody p) baseUrl manager) `shouldReturn` Right p
231
232
232 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
233 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
233− let getQueryParam = getNth (Proxy :: Proxy 4) $ client api baseUrl manager
234+ let getQueryParam = getNth (Proxy :: Proxy 4) $ client api
234− left show <$> runExceptT (getQueryParam (Just "alice")) `shouldReturn` Right alice
235+ left show <$> SCR.runClientM (getQueryParam (Just "alice")) baseUrl manager `shouldReturn` Right alice
235− Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob"))
236+ Left FailureResponse{..} <- SCR.runClientM (getQueryParam (Just "bob")) baseUrl manager
236 responseStatus `shouldBe` Status 400 "bob not found"
237 responseStatus `shouldBe` Status 400 "bob not found"
237
238
238 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
239 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
239− let getQueryParams = getNth (Proxy :: Proxy 5) $ client api baseUrl manager
240+ let getQueryParams = getNth (Proxy :: Proxy 5) $ client api
240− (left show <$> runExceptT (getQueryParams [])) `shouldReturn` Right []
241+ (left show <$> SCR.runClientM (getQueryParams []) baseUrl manager) `shouldReturn` Right []
241− (left show <$> runExceptT (getQueryParams ["alice", "bob"]))
242+ (left show <$> SCR.runClientM (getQueryParams ["alice", "bob"]) baseUrl manager)
242 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
243 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
243
244
244 context "Servant.API.QueryParam.QueryFlag" $
245 context "Servant.API.QueryParam.QueryFlag" $
245 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
246 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
246− let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api baseUrl manager
247+ let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api
247− (left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag
248+ (left show <$> SCR.runClientM (getQueryFlag flag) baseUrl manager) `shouldReturn` Right flag
248
249
249 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
250 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
250− let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api baseUrl manager
251+ let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api
251− res <- runExceptT (getRawSuccess methodGet)
252+ res <- SCR.runClientM (getRawSuccess methodGet) baseUrl manager
252 case res of
253 case res of
253 Left e -> assertFailure $ show e
254 Left e -> assertFailure $ show e
254 Right (code, body, ct, _, response) -> do
255 Right (code, body, ct, _, response) -> do
@@ -257,8 +258,8 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
257 C.responseStatus response `shouldBe` ok200
258 C.responseStatus response `shouldBe` ok200
258
259
259 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
260 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
260− let getRawFailure = getNth (Proxy :: Proxy 8) $ client api baseUrl manager
261+ let getRawFailure = getNth (Proxy :: Proxy 8) $ client api
261− res <- runExceptT (getRawFailure methodGet)
262+ res <- SCR.runClientM (getRawFailure methodGet) baseUrl manager
262 case res of
263 case res of
263 Right _ -> assertFailure "expected Left, but got Right"
264 Right _ -> assertFailure "expected Left, but got Right"
264 Left e -> do
265 Left e -> do
@@ -266,18 +267,18 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
266 Servant.Client.responseBody e `shouldBe` "rawFailure"
267 Servant.Client.responseBody e `shouldBe` "rawFailure"
267
268
268 it "Returns headers appropriately" $ \(_, baseUrl) -> do
269 it "Returns headers appropriately" $ \(_, baseUrl) -> do
269− let getRespHeaders = getNth (Proxy :: Proxy 10) $ client api baseUrl manager
270+ let getRespHeaders = getNth (Proxy :: Proxy 10) $ client api
270− res <- runExceptT getRespHeaders
271+ res <- SCR.runClientM getRespHeaders baseUrl manager
271 case res of
272 case res of
272 Left e -> assertFailure $ show e
273 Left e -> assertFailure $ show e
273 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
274 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
274
275
275 modifyMaxSuccess (const 20) $ do
276 modifyMaxSuccess (const 20) $ do
276 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
277 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
277− let getMultiple = getNth (Proxy :: Proxy 9) $ client api baseUrl manager
278+ let getMultiple = getNth (Proxy :: Proxy 9) $ client api
278 in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
279 in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
279 ioProperty $ do
280 ioProperty $ do
280− result <- left show <$> runExceptT (getMultiple cap num flag body)
281+ result <- left show <$> SCR.runClientM (getMultiple cap num flag body) baseUrl manager
281 return $
282 return $
282 result === Right (cap, num, flag, body)
283 result === Right (cap, num, flag, body)
283
284
@@ -289,9 +290,9 @@ wrappedApiSpec = describe "error status codes" $ do
289 let test :: (WrappedApi, String) -> Spec
290 let test :: (WrappedApi, String) -> Spec
290 test (WrappedApi api, desc) =
291 test (WrappedApi api, desc) =
291 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
292 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
292− let getResponse :: ExceptT ServantError IO ()
293+ let getResponse :: SCR.ClientM ()
293− getResponse = client api baseUrl manager
294+ getResponse = client api
294− Left FailureResponse{..} <- runExceptT getResponse
295+ Left FailureResponse{..} <- SCR.runClientM getResponse baseUrl manager
295 responseStatus `shouldBe` (Status 500 "error message")
296 responseStatus `shouldBe` (Status 500 "error message")
296 in mapM_ test $
297 in mapM_ test $
297 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
298 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
@@ -305,43 +306,43 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
305
306
306 context "client returns errors appropriately" $ do
307 context "client returns errors appropriately" $ do
307 it "reports FailureResponse" $ \(_, baseUrl) -> do
308 it "reports FailureResponse" $ \(_, baseUrl) -> do
308− let (_ :<|> getDeleteEmpty :<|> _) = client api baseUrl manager
309+ let (_ :<|> getDeleteEmpty :<|> _) = client api
309− Left res <- runExceptT getDeleteEmpty
310+ Left res <- SCR.runClientM getDeleteEmpty baseUrl manager
310 case res of
311 case res of
311 FailureResponse (Status 404 "Not Found") _ _ -> return ()
312 FailureResponse (Status 404 "Not Found") _ _ -> return ()
312 _ -> fail $ "expected 404 response, but got " <> show res
313 _ -> fail $ "expected 404 response, but got " <> show res
313
314
314 it "reports DecodeFailure" $ \(_, baseUrl) -> do
315 it "reports DecodeFailure" $ \(_, baseUrl) -> do
315− let (_ :<|> _ :<|> getCapture :<|> _) = client api baseUrl manager
316+ let (_ :<|> _ :<|> getCapture :<|> _) = client api
316− Left res <- runExceptT (getCapture "foo")
317+ Left res <- SCR.runClientM (getCapture "foo") baseUrl manager
317 case res of
318 case res of
318 DecodeFailure _ ("application/json") _ -> return ()
319 DecodeFailure _ ("application/json") _ -> return ()
319 _ -> fail $ "expected DecodeFailure, but got " <> show res
320 _ -> fail $ "expected DecodeFailure, but got " <> show res
320
321
321 it "reports ConnectionError" $ \_ -> do
322 it "reports ConnectionError" $ \_ -> do
322− let (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager
323+ let (getGetWrongHost :<|> _) = client api
323− Left res <- runExceptT getGetWrongHost
324+ Left res <- SCR.runClientM getGetWrongHost (BaseUrl Http "127.0.0.1" 19872 "") manager
324 case res of
325 case res of
325 ConnectionError _ -> return ()
326 ConnectionError _ -> return ()
326 _ -> fail $ "expected ConnectionError, but got " <> show res
327 _ -> fail $ "expected ConnectionError, but got " <> show res
327
328
328 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
329 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
329− let (getGet :<|> _ ) = client api baseUrl manager
330+ let (getGet :<|> _ ) = client api
330− Left res <- runExceptT getGet
331+ Left res <- SCR.runClientM getGet baseUrl manager
331 case res of
332 case res of
332 UnsupportedContentType ("application/octet-stream") _ -> return ()
333 UnsupportedContentType ("application/octet-stream") _ -> return ()
333 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
334 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
334
335
335 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
336 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
336− let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api baseUrl manager
337+ let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
337− Left res <- runExceptT (getBody alice)
338+ Left res <- SCR.runClientM (getBody alice) baseUrl manager
338 case res of
339 case res of
339 InvalidContentTypeHeader "fooooo" _ -> return ()
340 InvalidContentTypeHeader "fooooo" _ -> return ()
340 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
341 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
341
342
342data WrappedApi where
343data WrappedApi where
343 WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
344 WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
344− HasClient api, Client api ~ ExceptT ServantError IO ()) =>
345+ HasClient api, Client api ~ SCR.ClientM ()) =>
345 Proxy api -> WrappedApi
346 Proxy api -> WrappedApi
346
347
347basicAuthSpec :: Spec
348basicAuthSpec :: Spec
@@ -349,16 +350,16 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
349 context "Authentication works when requests are properly authenticated" $ do
350 context "Authentication works when requests are properly authenticated" $ do
350
351
351 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
352 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
352− let getBasic = client basicAuthAPI baseUrl manager
353+ let getBasic = client basicAuthAPI
353 let basicAuthData = BasicAuthData "servant" "server"
354 let basicAuthData = BasicAuthData "servant" "server"
354− (left show <$> runExceptT (getBasic basicAuthData)) `shouldReturn` Right alice
355+ (left show <$> SCR.runClientM (getBasic basicAuthData) baseUrl manager) `shouldReturn` Right alice
355
356
356 context "Authentication is rejected when requests are not authenticated properly" $ do
357 context "Authentication is rejected when requests are not authenticated properly" $ do
357
358
358 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
359 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
359− let getBasic = client basicAuthAPI baseUrl manager
360+ let getBasic = client basicAuthAPI
360 let basicAuthData = BasicAuthData "not" "password"
361 let basicAuthData = BasicAuthData "not" "password"
361− Left FailureResponse{..} <- runExceptT (getBasic basicAuthData)
362+ Left FailureResponse{..} <- SCR.runClientM (getBasic basicAuthData) baseUrl manager
362 responseStatus `shouldBe` Status 403 "Forbidden"
363 responseStatus `shouldBe` Status 403 "Forbidden"
363
364
364genAuthSpec :: Spec
365genAuthSpec :: Spec
@@ -366,16 +367,16 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
366 context "Authentication works when requests are properly authenticated" $ do
367 context "Authentication works when requests are properly authenticated" $ do
367
368
368 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
369 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
369− let getProtected = client genAuthAPI baseUrl manager
370+ let getProtected = client genAuthAPI
370 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
371 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
371− (left show <$> runExceptT (getProtected authRequest)) `shouldReturn` Right alice
372+ (left show <$> SCR.runClientM (getProtected authRequest) baseUrl manager) `shouldReturn` Right alice
372
373
373 context "Authentication is rejected when requests are not authenticated properly" $ do
374 context "Authentication is rejected when requests are not authenticated properly" $ do
374
375
375 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
376 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
376− let getProtected = client genAuthAPI baseUrl manager
377+ let getProtected = client genAuthAPI
377 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
378 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
378− Left FailureResponse{..} <- runExceptT (getProtected authRequest)
379+ Left FailureResponse{..} <- SCR.runClientM (getProtected authRequest) baseUrl manager
379 responseStatus `shouldBe` (Status 401 "Unauthorized")
380 responseStatus `shouldBe` (Status 401 "Unauthorized")
380
381
381-- * utils
382-- * utils