@@ -9,6 +9,7 @@
99{-# LANGUAGE TypeOperators #-}
1010{-# OPTIONS_GHC -fcontext-stack=100 #-}
1111{-# OPTIONS_GHC -fno-warn-orphans #-}
12+
1213module Servant.ClientSpec where
1314
1415#if !MIN_VERSION_base(4,8,0)
@@ -129,44 +130,9 @@ server = serve api (
129130withServer :: (BaseUrl -> IO a) -> IO a
130131withServer action = withWaiDaemon (return server) action
131132
132−getGet :: BaseUrl -> EitherT ServantError IO Person
133−getDelete :: BaseUrl -> EitherT ServantError IO ()
134−getDeleteString :: BaseUrl -> EitherT ServantError IO String
135−getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
136−getBody :: Person -> BaseUrl -> EitherT ServantError IO Person
137−getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
138−getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
139−getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
140−getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
141−getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
142−getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
143−getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString,
144− MediaType, [HTTP.Header], C.Response ByteString)
145−getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString,
146− MediaType, [HTTP.Header], C.Response ByteString)
147−getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
148− -> BaseUrl
149− -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
150−getRespHeaders :: BaseUrl -> EitherT ServantError IO (Headers TestHeaders Bool)
151−( getGet
152− :<|> getDelete
153− :<|> getDeleteString
154− :<|> getCapture
155− :<|> getBody
156− :<|> getQueryParam
157− :<|> getQueryParams
158− :<|> getQueryFlag
159− :<|> getMatrixParam
160− :<|> getMatrixParams
161− :<|> getMatrixFlag
162− :<|> getRawSuccess
163− :<|> getRawFailure
164− :<|> getMultiple
165− :<|> getRespHeaders)
166− = client api
167−
168133type FailApi =
169134 "get" :> Raw
135+ :<|> "delete" :> Raw
170136 :<|> "capture" :> Capture "name" String :> Raw
171137 :<|> "body" :> Raw
172138failApi :: Proxy FailApi
@@ -175,6 +141,7 @@ failApi = Proxy
175141failServer :: Application
176142failServer = serve failApi (
177143 (\ _request respond -> respond $ responseLBS ok200 [] "")
144+ :<|> (\ _request respond -> respond $ responseLBS ok200 [] "")
178145 :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
179146 :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
180147 )
@@ -182,141 +149,180 @@ failServer = serve failApi (
182149withFailServer :: (BaseUrl -> IO a) -> IO a
183150withFailServer action = withWaiDaemon (return failServer) action
184151
185−spec :: Spec
186−spec = do
187− it "Servant.API.Get" $ withServer $ \ host -> do
188− (Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice
189−
190− context "Servant.API.Delete" $ do
191− it "return no body" $ withServer $ \ host -> do
192− (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()
193−
194− it "return body" $ withServer $ \ host -> do
195− (Arrow.left show <$> runEitherT (getDeleteString host)) `shouldReturn` Right "ok"
196−
197− it "Servant.API.Capture" $ withServer $ \ host -> do
198− (Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0)
199−
200− it "Servant.API.ReqBody" $ withServer $ \ host -> do
201− let p = Person "Clara" 42
202− (Arrow.left show <$> runEitherT (getBody p host)) `shouldReturn` Right p
203−
204− it "Servant.API.QueryParam" $ withServer $ \ host -> do
205− Arrow.left show <$> runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
206− Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob") host)
207− responseStatus `shouldBe` Status 400 "bob not found"
208−
209− it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do
210− (Arrow.left show <$> runEitherT (getQueryParams [] host)) `shouldReturn` Right []
211− (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"] host))
212− `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
213−
214− context "Servant.API.QueryParam.QueryFlag" $
215− forM_ [False, True] $ \ flag ->
216− it (show flag) $ withServer $ \ host -> do
217− (Arrow.left show <$> runEitherT (getQueryFlag flag host)) `shouldReturn` Right flag
218−
219− it "Servant.API.MatrixParam" $ withServer $ \ host -> do
220− Arrow.left show <$> runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice
221− Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob") host)
222− responseStatus `shouldBe` Status 400 "bob not found"
223−
224− it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do
225− Arrow.left show <$> runEitherT (getMatrixParams [] host) `shouldReturn` Right []
226− Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"] host)
227− `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
228−
229− context "Servant.API.MatrixParam.MatrixFlag" $
230− forM_ [False, True] $ \ flag ->
231− it (show flag) $ withServer $ \ host -> do
232− Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag
233−
234− it "Servant.API.Raw on success" $ withServer $ \ host -> do
235− res <- runEitherT (getRawSuccess methodGet host)
236− case res of
237− Left e -> assertFailure $ show e
238− Right (code, body, ct, _, response) -> do
239− (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
240− C.responseBody response `shouldBe` body
241− C.responseStatus response `shouldBe` ok200
242−
243− it "Servant.API.Raw on failure" $ withServer $ \ host -> do
244− res <- runEitherT (getRawFailure methodGet host)
245− case res of
246− Left e -> assertFailure $ show e
247− Right (code, body, ct, _, response) -> do
248− (code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream")
249− C.responseBody response `shouldBe` body
250− C.responseStatus response `shouldBe` badRequest400
251−
252− it "Returns headers appropriately" $ withServer $ \ host -> do
253− res <- runEitherT (getRespHeaders host)
254− case res of
255− Left e -> assertFailure $ show e
256− Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
257−
258− modifyMaxSuccess (const 20) $ do
259− it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
260− property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
261− ioProperty $ do
262− withServer $ \ host -> do
263− result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body host)
264− return $
265− result === Right (cap, num, flag, body)
266−
267−
268− context "client correctly handles error status codes" $ do
269− let test :: (WrappedApi, String) -> Spec
270− test (WrappedApi api, desc) =
271− it desc $
272− withWaiDaemon (return (serve api (left $ ServantErr 500 "error message" "" []))) $
273− \ host -> do
274− let getResponse :: BaseUrl -> EitherT ServantError IO ()
275− getResponse = client api
276− Left FailureResponse{..} <- runEitherT (getResponse host)
277− responseStatus `shouldBe` (Status 500 "error message")
278− mapM_ test $
279− (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
280− (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
281− (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
282− (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
283− []
284−
285− context "client returns errors appropriately" $ do
286− it "reports FailureResponse" $ withFailServer $ \ host -> do
287− Left res <- runEitherT (getDelete host)
152+spec :: IO ()
153+spec = withServer $ \ baseUrl -> do
154+ let getGet :: EitherT ServantError IO Person
155+ getDelete :: EitherT ServantError IO ()
156+ getCapture :: String -> EitherT ServantError IO Person
157+ getBody :: Person -> EitherT ServantError IO Person
158+ getQueryParam :: Maybe String -> EitherT ServantError IO Person
159+ getQueryParams :: [String] -> EitherT ServantError IO [Person]
160+ getQueryFlag :: Bool -> EitherT ServantError IO Bool
161+ getMatrixParam :: Maybe String -> EitherT ServantError IO Person
162+ getMatrixParams :: [String] -> EitherT ServantError IO [Person]
163+ getMatrixFlag :: Bool -> EitherT ServantError IO Bool
164+ getRawSuccess :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
165+ getRawFailure :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
166+ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
167+ getRespHeaders :: EitherT ServantError IO (Headers TestHeaders Bool)
168+ ( getGet
169+ :<|> getDelete
170+ :<|> getCapture
171+ :<|> getBody
172+ :<|> getQueryParam
173+ :<|> getQueryParams
174+ :<|> getQueryFlag
175+ :<|> getMatrixParam
176+ :<|> getMatrixParams
177+ :<|> getMatrixFlag
178+ :<|> getRawSuccess
179+ :<|> getRawFailure
180+ :<|> getMultiple
181+ :<|> getRespHeaders)
182+ = client api baseUrl
183+
184+ hspec $ do
185+ it "Servant.API.Get" $ do
186+ (Arrow.left show <$> runEitherT getGet) `shouldReturn` Right alice
187+
188+ it "Servant.API.Delete" $ do
189+ (Arrow.left show <$> runEitherT getDelete) `shouldReturn` Right ()
190+
191+ it "Servant.API.Capture" $ do
192+ (Arrow.left show <$> runEitherT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
193+
194+ it "Servant.API.ReqBody" $ do
195+ let p = Person "Clara" 42
196+ (Arrow.left show <$> runEitherT (getBody p)) `shouldReturn` Right p
197+
198+ it "Servant.API.QueryParam" $ do
199+ Arrow.left show <$> runEitherT (getQueryParam (Just "alice")) `shouldReturn` Right alice
200+ Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob"))
201+ responseStatus `shouldBe` Status 400 "bob not found"
202+
203+ it "Servant.API.QueryParam.QueryParams" $ do
204+ (Arrow.left show <$> runEitherT (getQueryParams [])) `shouldReturn` Right []
205+ (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"]))
206+ `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
207+
208+ context "Servant.API.QueryParam.QueryFlag" $
209+ forM_ [False, True] $ \ flag ->
210+ it (show flag) $ do
211+ (Arrow.left show <$> runEitherT (getQueryFlag flag)) `shouldReturn` Right flag
212+
213+ it "Servant.API.MatrixParam" $ do
214+ Arrow.left show <$> runEitherT (getMatrixParam (Just "alice")) `shouldReturn` Right alice
215+ Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob"))
216+ responseStatus `shouldBe` Status 400 "bob not found"
217+
218+ it "Servant.API.MatrixParam.MatrixParams" $ do
219+ Arrow.left show <$> runEitherT (getMatrixParams []) `shouldReturn` Right []
220+ Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"])
221+ `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
222+
223+ context "Servant.API.MatrixParam.MatrixFlag" $
224+ forM_ [False, True] $ \ flag ->
225+ it (show flag) $ do
226+ Arrow.left show <$> runEitherT (getMatrixFlag flag) `shouldReturn` Right flag
227+
228+ it "Servant.API.Raw on success" $ do
229+ res <- runEitherT (getRawSuccess methodGet)
288230 case res of
289− FailureResponse (Status 404 "Not Found") _ _ -> return ()
290− _ -> fail $ "expected 404 response, but got " <> show res
291−
292− it "reports DecodeFailure" $ withFailServer $ \ host -> do
293− Left res <- runEitherT (getCapture "foo" host)
231+ Left e -> assertFailure $ show e
232+ Right (code, body, ct, _, response) -> do
233+ (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
234+ C.responseBody response `shouldBe` body
235+ C.responseStatus response `shouldBe` ok200
236+
237+ it "Servant.API.Raw on failure" $ do
238+ res <- runEitherT (getRawFailure methodGet)
294239 case res of
295− DecodeFailure _ ("application/json") _ -> return ()
296− _ -> fail $ "expected DecodeFailure, but got " <> show res
297−
298− it "reports ConnectionError" $ do
299− Right host <- return $ parseBaseUrl "127.0.0.1:987654"
300− Left res <- runEitherT (getGet host)
240+ Left e -> assertFailure $ show e
241+ Right (code, body, ct, _, response) -> do
242+ (code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream")
243+ C.responseBody response `shouldBe` body
244+ C.responseStatus response `shouldBe` badRequest400
245+
246+ it "Returns headers appropriately" $ withServer $ \ _ -> do
247+ res <- runEitherT getRespHeaders
301248 case res of
302− ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
303− _ -> fail $ "expected ConnectionError, but got " <> show res
249+ Left e -> assertFailure $ show e
250+ Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
251+
252+ modifyMaxSuccess (const 20) $ do
253+ it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
254+ property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
255+ ioProperty $ do
256+ result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body)
257+ return $
258+ result === Right (cap, num, flag, body)
304259
305− it "reports UnsupportedContentType" $ withFailServer $ \ host -> do
306− Left res <- runEitherT (getGet host)
307− case res of
308− UnsupportedContentType ("application/octet-stream") _ -> return ()
309− _ -> fail $ "expected UnsupportedContentType, but got " <> show res
310260
311− it "reports InvalidContentTypeHeader" $ withFailServer $ \ host -> do
312− Left res <- runEitherT (getBody alice host)
313− case res of
314− InvalidContentTypeHeader "fooooo" _ -> return ()
315− _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
261+ context "client correctly handles error status codes" $ do
262+ let test :: (WrappedApi, String) -> Spec
263+ test (WrappedApi api, desc) =
264+ it desc $
265+ withWaiDaemon (return (serve api (left $ ServantErr 500 "error message" "" []))) $
266+ \ host -> do
267+ let getResponse :: EitherT ServantError IO ()
268+ getResponse = client api host
269+ Left FailureResponse{..} <- runEitherT getResponse
270+ responseStatus `shouldBe` (Status 500 "error message")
271+ mapM_ test $
272+ (WrappedApi (Proxy :: Proxy Delete), "Delete") :
273+ (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
274+ (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
275+ (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
276+ []
277+
278+failSpec :: IO ()
279+failSpec = withFailServer $ \ baseUrl -> do
280+ let getGet :: EitherT ServantError IO Person
281+ getDelete :: EitherT ServantError IO ()
282+ getCapture :: String -> EitherT ServantError IO Person
283+ getBody :: Person -> EitherT ServantError IO Person
284+ ( getGet
285+ :<|> getDelete
286+ :<|> getCapture
287+ :<|> getBody)
288+ = client failApi baseUrl
289+
290+ hspec $ do
291+ context "client returns errors appropriately" $ do
292+ it "reports FailureResponse" $ do
293+ Left res <- runEitherT getDelete
294+ case res of
295+ FailureResponse (Status 404 "Not Found") _ _ -> return ()
296+ _ -> fail $ "expected 404 response, but got " <> show res
297+
298+ it "reports DecodeFailure" $ do
299+ Left res <- runEitherT (getCapture "foo")
300+ case res of
301+ DecodeFailure _ ("application/json") _ -> return ()
302+ _ -> fail $ "expected DecodeFailure, but got " <> show res
303+
304+ it "reports ConnectionError" $ do
305+ Right _ <- return $ parseBaseUrl "127.0.0.1:987654"
306+ Left res <- runEitherT getGet
307+ case res of
308+ ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
309+ _ -> fail $ "expected ConnectionError, but got " <> show res
310+
311+ it "reports UnsupportedContentType" $ do
312+ Left res <- runEitherT getGet
313+ case res of
314+ UnsupportedContentType ("application/octet-stream") _ -> return ()
315+ _ -> fail $ "expected UnsupportedContentType, but got " <> show res
316+
317+ it "reports InvalidContentTypeHeader" $ do
318+ Left res <- runEitherT (getBody alice)
319+ case res of
320+ InvalidContentTypeHeader "fooooo" _ -> return ()
321+ _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
316322
317323data WrappedApi where
318324 WrappedApi :: (HasServer api, Server api ~ EitherT ServantErr IO a,
319− HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
325+ HasClient api, Client' api ~ EitherT ServantError IO ()) =>
320326 Proxy api -> WrappedApi
321327
322328