@@ -26,6 +26,9 @@
2626#include "overlapping-compat.h"
2727module Servant.ClientSpec where
2828
29+import Prelude ()
30+import Prelude.Compat
31+
2932import Control.Arrow (left)
3033import Control.Concurrent (ThreadId, forkIO,
3134 killThread)
@@ -34,9 +37,12 @@ import Control.Monad.Error.Class (throwError)
3437import Data.Aeson
3538import qualified Data.ByteString.Lazy as BS
3639import Data.Char (chr, isPrint)
40+import Data.Foldable (toList)
3741import Data.Foldable (forM_)
42+import Data.Maybe (isJust)
3843import Data.Monoid hiding (getLast)
3944import Data.Proxy
45+import Data.Sequence (findIndexL)
4046import qualified Generics.SOP as SOP
4147import GHC.Generics (Generic)
4248import qualified Network.HTTP.Client as C
@@ -45,8 +51,6 @@ import qualified Network.HTTP.Types as HTTP
4551import Network.Socket
4652import qualified Network.Wai as Wai
4753import Network.Wai.Handler.Warp
48−import Prelude ()
49−import Prelude.Compat
5054import System.IO.Unsafe (unsafePerformIO)
5155import Test.Hspec
5256import Test.Hspec.QuickCheck
@@ -61,19 +65,19 @@ import Servant.API ((:<|>) ((:<|>)),
6165 Capture,
6266 CaptureAll, Delete,
6367 DeleteNoContent,
64− EmptyAPI,
68+ EmptyAPI, addHeader,
6569 FormUrlEncoded,
6670 Get, Header,
6771 Headers, JSON,
68− NoContent, Post,
69− Put, QueryFlag,
72+ NoContent (NoContent),
73+ Post, Put, Raw,
74+ QueryFlag,
7075 QueryParam,
7176 QueryParams,
72− ReqBody)
77+ ReqBody,
78+ getHeaders)
7379import Servant.API.Internal.Test.ComprehensiveAPI
7480import Servant.Client
75−{-import qualified Servant.Common.Req as SCR-}
76−{-import qualified Servant.Client.HttpClient as SCR-}
7781import Servant.Server
7882import Servant.Server.Experimental.Auth
7983
@@ -139,10 +143,8 @@ getBody :: Person -> ClientM Person
139143getQueryParam :: Maybe String -> ClientM Person
140144getQueryParams :: [String] -> ClientM [Person]
141145getQueryFlag :: Bool -> ClientM Bool
142−getRawSuccess :: HTTP.Method
143− -> ClientM Response
144−getRawFailure :: HTTP.Method
145− -> ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
146+getRawSuccess :: HTTP.Method -> ClientM Response
147+getRawFailure :: HTTP.Method -> ClientM Response
146148getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
147149 -> ClientM (String, Maybe Int, Bool, [(String, [Rational])])
148150getRespHeaders :: ClientM (Headers TestHeaders Bool)
@@ -179,7 +181,7 @@ server = serve api (
179181 :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
180182 :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")
181183 :<|> (\ a b c d -> return (a, b, c, d))
182− :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
184+ :<|> (return $ Servant.API.addHeader 1729 $ Servant.API.addHeader "eg2" True)
183185 :<|> return NoContent
184186 :<|> emptyServer)
185187
@@ -233,7 +235,7 @@ type instance AuthClientData (AuthProtect "auth-tag") = ()
233235
234236genAuthHandler :: AuthHandler Request ()
235237genAuthHandler =
236− let handler req = case lookup "AuthHeader" (requestHeaders req) of
238+ let handler req = case lookup "AuthHeader" (toList $ requestHeaders req) of
237239 Nothing -> throwError (err401 { errBody = "Missing auth header" })
238240 Just _ -> return ()
239241 in mkAuthHandler handler
@@ -295,57 +297,58 @@ genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
295297manager' :: C.Manager
296298manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
297299
298−runClient x = runClientM x (ClientEnv manager' baseUrl)
300+runClient x baseUrl' = runClientM x (ClientEnv manager' baseUrl')
299301
300302sucessSpec :: Spec
301303sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
302304
303305 it "Servant.API.Get" $ \(_, baseUrl) -> do
304− (left show <$> runClient getGet) `shouldReturn` Right alice
306+ left show <$> runClient getGet baseUrl `shouldReturn` Right alice
305307
306308 describe "Servant.API.Delete" $ do
307309 it "allows empty content type" $ \(_, baseUrl) -> do
308− (left show <$> (runClient getDeleteEmpty)) `shouldReturn` Right NoContent
310+ left show <$> runClient getDeleteEmpty baseUrl `shouldReturn` Right NoContent
309311
310312 it "allows content type" $ \(_, baseUrl) -> do
311− (left show <$> (runClient getDeleteContentType)) `shouldReturn` Right NoContent
313+ left show <$> runClient getDeleteContentType baseUrl `shouldReturn` Right NoContent
312314
313315 it "Servant.API.Capture" $ \(_, baseUrl) -> do
314− (left show <$> (runClient (getCapture "Paula"))) `shouldReturn` Right (Person "Paula" 0)
316+ left show <$> runClient (getCapture "Paula") baseUrl `shouldReturn` Right (Person "Paula" 0)
315317
316318 it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do
317319 let expected = [(Person "Paula" 0), (Person "Peta" 1)]
318− (left show <$> (runClient (getCaptureAll ["Paula", "Peta"]))) `shouldReturn` Right expected
320+ left show <$> runClient (getCaptureAll ["Paula", "Peta"]) baseUrl `shouldReturn` Right expected
319321
320322 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
321323 let p = Person "Clara" 42
322− (left show <$> runClient (getBody p)) `shouldReturn` Right p
324+ left show <$> runClient (getBody p) baseUrl `shouldReturn` Right p
323325
324326 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
325− left show <$> runClient (getQueryParam (Just "alice")) `shouldReturn` Right alice
326− Left (FailureResponse r) <- runClient (getQueryParam (Just "bob"))
327+ left show <$> runClient (getQueryParam (Just "alice")) baseUrl `shouldReturn` Right alice
328+ Left (FailureResponse r) <- runClient (getQueryParam (Just "bob")) baseUrl
327329 responseStatusCode r `shouldBe` HTTP.Status 400 "bob not found"
328330
329331 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
330− (left show <$> runClient (getQueryParams [])) `shouldReturn` Right []
331− (left show <$> runClient (getQueryParams ["alice", "bob"]))
332+ left show <$> runClient (getQueryParams []) baseUrl `shouldReturn` Right []
333+ left show <$> runClient (getQueryParams ["alice", "bob"]) baseUrl
332334 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
333335
334336 context "Servant.API.QueryParam.QueryFlag" $
335337 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
336− (left show <$> runClient (getQueryFlag flag)) `shouldReturn` Right flag
338+ left show <$> runClient (getQueryFlag flag) baseUrl `shouldReturn` Right flag
337339
338340 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
339− res <- runClient (getRawSuccess HTTP.methodGet)
341+ res <- runClient (getRawSuccess HTTP.methodGet) baseUrl
340342 case res of
341343 Left e -> assertFailure $ show e
342− Right (code, body, ct, _, response) -> do
343− (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
344− C.responseBody response `shouldBe` body
345− C.responseStatus response `shouldBe` HTTP.ok200
344+ Right r -> do
345+ responseStatusCode r `shouldBe` HTTP.status200
346+ responseBody r `shouldBe` "rawSuccess"
347+ findIndexL (\x -> fst x == HTTP.hContentType) (responseHeaders r)
348+ `shouldSatisfy` isJust
346349
347350 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
348− res <- runClient (getRawFailure HTTP.methodGet)
351+ res <- runClient (getRawFailure HTTP.methodGet) baseUrl
349352 case res of
350353 Right _ -> assertFailure "expected Left, but got Right"
351354 Left (FailureResponse r) -> do
@@ -354,7 +357,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
354357 Left e -> assertFailure $ "expected FailureResponse, but got " ++ show e
355358
356359 it "Returns headers appropriately" $ \(_, baseUrl) -> do
357− res <- runClient getRespHeaders
360+ res <- runClient getRespHeaders baseUrl
358361 case res of
359362 Left e -> assertFailure $ show e
360363 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
@@ -363,7 +366,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
363366 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
364367 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
365368 ioProperty $ do
366− result <- left show <$> runClient (getMultiple cap num flag body)
369+ result <- left show <$> runClient (getMultiple cap num flag body) baseUrl
367370 return $
368371 result === Right (cap, num, flag, body)
369372
@@ -377,7 +380,7 @@ wrappedApiSpec = describe "error status codes" $ do
377380 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
378381 let getResponse :: ClientM ()
379382 getResponse = client api
380− Left (FailureResponse r) <- runClient getResponse
383+ Left (FailureResponse r) <- runClient getResponse baseUrl
381384 responseStatusCode r `shouldBe` (HTTP.Status 500 "error message")
382385 in mapM_ test $
383386 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
@@ -392,35 +395,35 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
392395 context "client returns errors appropriately" $ do
393396 it "reports FailureResponse" $ \(_, baseUrl) -> do
394397 let (_ :<|> getDeleteEmpty :<|> _) = client api
395− Left res <- runClient getDeleteEmpty
398+ Left res <- runClient getDeleteEmpty baseUrl
396399 case res of
397− FailureResponse r | responseStatusCode r == 404 -> return ()
400+ FailureResponse r | responseStatusCode r == HTTP.status404 -> return ()
398401 _ -> fail $ "expected 404 response, but got " <> show res
399402
400403 it "reports DecodeFailure" $ \(_, baseUrl) -> do
401404 let (_ :<|> _ :<|> getCapture :<|> _) = client api
402− Left res <- runClient (getCapture "foo") (ClientEnv manager baseUrl)
405+ Left res <- runClient (getCapture "foo") baseUrl
403406 case res of
404407 DecodeFailure _ _ -> return ()
405408 _ -> fail $ "expected DecodeFailure, but got " <> show res
406409
407410 it "reports ConnectionError" $ \_ -> do
408411 let (getGetWrongHost :<|> _) = client api
409− Left res <- runClientM getGetWrongHost (ClientEnv manager (BaseUrl Http "127.0.0.1" 19872 ""))
412+ Left res <- runClient getGetWrongHost (BaseUrl Http "127.0.0.1" 19872 "")
410413 case res of
411414 ConnectionError _ -> return ()
412415 _ -> fail $ "expected ConnectionError, but got " <> show res
413416
414417 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
415418 let (getGet :<|> _ ) = client api
416− Left res <- runClient getGet
419+ Left res <- runClient getGet baseUrl
417420 case res of
418421 UnsupportedContentType ("application/octet-stream") _ -> return ()
419422 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
420423
421424 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
422425 let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
423− Left res <- runClient (getBody alice)
426+ Left res <- runClient (getBody alice) baseUrl
424427 case res of
425428 InvalidContentTypeHeader _ -> return ()
426429 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
@@ -437,14 +440,14 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
437440 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
438441 let getBasic = client basicAuthAPI
439442 let basicAuthData = BasicAuthData "servant" "server"
440− (left show <$> runClient (getBasic basicAuthData)) `shouldReturn` Right alice
443+ left show <$> runClient (getBasic basicAuthData) baseUrl `shouldReturn` Right alice
441444
442445 context "Authentication is rejected when requests are not authenticated properly" $ do
443446
444447 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
445448 let getBasic = client basicAuthAPI
446449 let basicAuthData = BasicAuthData "not" "password"
447− Left (FailureResponse r) <- runClient (getBasic basicAuthData)
450+ Left (FailureResponse r) <- runClient (getBasic basicAuthData) baseUrl
448451 responseStatusCode r `shouldBe` HTTP.Status 403 "Forbidden"
449452
450453genAuthSpec :: Spec
@@ -453,15 +456,15 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
453456
454457 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
455458 let getProtected = client genAuthAPI
456− let authRequest = mkAuthenticateReq () (\_ req -> addHeader "AuthHeader" ("cool" :: String) req)
457− (left show <$> runClient (getProtected authRequest) ) `shouldReturn` Right alice
459+ let authRequest = mkAuthenticateReq () (\_ req -> Servant.Client.addHeader "AuthHeader" ("cool" :: String) req)
460+ left show <$> runClient (getProtected authRequest) baseUrl `shouldReturn` Right alice
458461
459462 context "Authentication is rejected when requests are not authenticated properly" $ do
460463
461464 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
462465 let getProtected = client genAuthAPI
463− let authRequest = mkAuthenticateReq () (\_ req -> addHeader "Wrong" ("header" :: String) req)
464− Left (FailureResponse r) <- runClient (getProtected authRequest)
466+ let authRequest = mkAuthenticateReq () (\_ req -> Servant.Client.addHeader "Wrong" ("header" :: String) req)
467+ Left (FailureResponse r) <- runClient (getProtected authRequest) baseUrl
465468 responseStatusCode r `shouldBe` (HTTP.Status 401 "Unauthorized")
466469
467470genericClientSpec :: Spec
@@ -473,12 +476,12 @@ genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWa
473476 NestedClient2{..} = mkNestedClient2 (Just 42)
474477
475478 it "works for top-level client inClientM function" $ \(_, baseUrl) -> do
476− (left show <$> (runClient (getSqr (Just 5)))) `shouldReturn` Right 25
479+ left show <$> runClient (getSqr (Just 5)) baseUrl `shouldReturn` Right 25
477480
478481 it "works for nested clients" $ \(_, baseUrl) -> do
479− (left show <$> (runClient (idChar (Just 'c')))) `shouldReturn` Right 'c'
480− (left show <$> (runClient (getSum 3 4))) `shouldReturn` Right 7
481− (left show <$> (runClient doNothing )) `shouldReturn` Right ()
482+ left show <$> runClient (idChar (Just 'c')) baseUrl `shouldReturn` Right 'c'
483+ left show <$> runClient (getSum 3 4) baseUrl `shouldReturn` Right 7
484+ left show <$> runClient doNothing baseUrl `shouldReturn` Right ()
482485
483486-- * utils
484487