Add Servant.BrokenSpec module to test api inconsistencies; and some clean-up

servant-client/servant-client.cabal

@@ -89,6 +89,7 @@ test-suite spec
   main-is: Spec.hs
   other-modules:
       Servant.BasicAuthSpec
+      Servant.BrokenSpec
       Servant.ClientTestUtils
       Servant.ConnectionErrorSpec
       Servant.FailSpec

servant-client/test/Servant/BrokenSpec.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE DataKinds                   #-}
+{-# LANGUAGE TypeOperators               #-}
+{-# OPTIONS_GHC -freduction-depth=100    #-}
+{-# OPTIONS_GHC -fno-warn-orphans        #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+module Servant.BrokenSpec (spec) where
+
+import           Prelude ()
+import           Prelude.Compat
+
+import           Data.Monoid ()
+import           Data.Proxy
+import qualified Network.HTTP.Types as HTTP
+import           Test.Hspec
+
+import           Servant.API
+                 ((:<|>) ((:<|>)), (:>), JSON, Verb, Get, StdMethod (GET))
+import           Servant.Client
+import           Servant.ClientTestUtils
+import           Servant.Server
+
+-- * api for testing inconsistencies between client and server
+
+type Get201 = Verb 'GET 201
+type Get301 = Verb 'GET 301
+
+type BrokenAPI =
+  -- the server should respond with 200, but returns 201
+       "get200" :> Get201 '[JSON] ()
+  -- the server should respond with 307, but returns 301
+  :<|> "get307" :> Get301 '[JSON] ()
+
+brokenApi :: Proxy BrokenAPI
+brokenApi = Proxy
+
+brokenServer :: Application
+brokenServer = serve brokenApi (pure () :<|> pure ())
+
+type PublicAPI =
+  -- the client expcets 200
+       "get200" :> Get '[JSON] ()
+  -- the client expcets 307
+  :<|> "get307" :> Get307 '[JSON] ()
+
+publicApi :: Proxy PublicAPI
+publicApi = Proxy
+
+get200Client :: ClientM ()
+get307Client :: ClientM ()
+get200Client :<|> get307Client = client publicApi
+
+
+spec :: Spec
+spec = describe "Servant.BrokenSpec" $ do
+    brokenSpec
+
+brokenSpec :: Spec
+brokenSpec = beforeAll (startWaiApp brokenServer) $ afterAll endWaiApp $ do
+    context "client returns errors for inconsistencies between client and server api" $ do
+      it "reports FailureResponse with wrong 2xx status code" $ \(_, baseUrl) -> do
+        res <- runClient get200Client baseUrl
+        case res of
+          Left (FailureResponse _ r) | responseStatusCode r == HTTP.status201 -> return ()
+          _ -> fail $ "expected 201 broken response, but got " <> show res
+
+      it "reports FailureResponse with wrong 3xx status code" $ \(_, baseUrl) -> do
+        res <- runClient get307Client baseUrl
+        case res of
+          Left (FailureResponse _ r) | responseStatusCode r == HTTP.status301 -> return ()
+          _ -> fail $ "expected 301 broken response, but got " <> show res

servant-client/test/Servant/ClientTestUtils.hs

@@ -118,14 +118,20 @@ data OtherRoutes mode = OtherRoutes
   { something :: mode :- "something" :> Get '[JSON] [String]
   } deriving Generic
 
+-- Get for HTTP 307 Temporary Redirect
+type Get307 = Verb 'GET 307
+
 type Api =
   Get '[JSON] Person
   :<|> "get" :> Get '[JSON] Person
+  -- This endpoint returns a response with status code 307 Temporary Redirect,
+  -- different from the ones in the 2xx successful class, to test derivation
+  -- of clients' api.
+  :<|> "get307" :> Get307 '[PlainText] Text
   :<|> "deleteEmpty" :> DeleteNoContent
   :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
   :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
   :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
-  :<|> "redirection" :> Verb 'GET 301 '[PlainText] Text
   :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
   -- This endpoint makes use of a 'Raw' server because it is not currently
   -- possible to handle arbitrary binary query param values with
@@ -155,17 +161,16 @@ type Api =
   :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
   :<|> NamedRoutes RecordRoutes
 
-
 api :: Proxy Api
 api = Proxy
 
 getRoot         :: ClientM Person
 getGet          :: ClientM Person
+getGet307       :: ClientM Text
 getDeleteEmpty  :: ClientM NoContent
 getCapture      :: String -> ClientM Person
 getCaptureAll   :: [String] -> ClientM [Person]
 getBody         :: Person -> ClientM Person
-getRedirection  :: ClientM Text
 getQueryParam   :: Maybe String -> ClientM Person
 getQueryParamBinary :: Maybe UrlEncodedByteString -> HTTP.Method -> ClientM Response
 getQueryParams  :: [String] -> ClientM [Person]
@@ -188,11 +193,11 @@ recordRoutes :: RecordRoutes (AsClientT ClientM)
 
 getRoot
   :<|> getGet
+  :<|> getGet307
   :<|> getDeleteEmpty
   :<|> getCapture
   :<|> getCaptureAll
   :<|> getBody
-  :<|> getRedirection
   :<|> getQueryParam
   :<|> getQueryParamBinary
   :<|> getQueryParams
@@ -215,11 +220,11 @@ server :: Application
 server = serve api (
        return carol
   :<|> return alice
+  :<|> return "redirecting"
   :<|> return NoContent
   :<|> (\ name -> return $ Person name 0)
   :<|> (\ names -> return (zipWith Person names [0..]))
   :<|> return
-  :<|> return "redirecting"
   :<|> (\ name -> case name of
                    Just "alice" -> return alice
                    Just n -> throwError $ ServerError 400 (n ++ " not found") "" []
@@ -256,6 +261,8 @@ server = serve api (
          }
   )
 
+-- * api for testing failures
+
 type FailApi =
        "get" :> Raw
   :<|> "capture" :> Capture "name" String :> Raw
@@ -270,7 +277,7 @@ failServer = serve failApi (
   :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
   :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
   :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
- )
+  )
 
 -- * basic auth stuff
 

servant-client/test/Servant/FailSpec.hs

@@ -38,14 +38,14 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
 
     context "client returns errors appropriately" $ do
       it "reports FailureResponse" $ \(_, baseUrl) -> do
-        let (_ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
+        let (_ :<|> _ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
         Left res <- runClient getDeleteEmpty baseUrl
         case res of
           FailureResponse _ r | responseStatusCode r == HTTP.status404 -> return ()
           _ -> fail $ "expected 404 response, but got " <> show res
 
       it "reports DecodeFailure" $ \(_, baseUrl) -> do
-        let (_ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
+        let (_ :<|> _ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
         Left res <- runClient (getCapture "foo") baseUrl
         case res of
           DecodeFailure _ _ -> return ()
@@ -72,7 +72,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
           _ -> fail $ "expected UnsupportedContentType, but got " <> show res
 
       it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
-        let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
+        let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
         Left res <- runClient (getBody alice) baseUrl
         case res of
           InvalidContentTypeHeader _ -> return ()

servant-client/test/Servant/SuccessSpec.hs

@@ -59,11 +59,15 @@ spec = describe "Servant.SuccessSpec" $ do
 
 successSpec :: Spec
 successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
-    it "Servant.API.Get root" $ \(_, baseUrl) -> do
-      left show <$> runClient getRoot baseUrl  `shouldReturn` Right carol
+    describe "Servant.API.Get" $ do
+      it "get root endpoint" $ \(_, baseUrl) -> do
+        left show <$> runClient getRoot baseUrl  `shouldReturn` Right carol
 
-    it "Servant.API.Get" $ \(_, baseUrl) -> do
-      left show <$> runClient getGet baseUrl  `shouldReturn` Right alice
+      it "get simple endpoint" $ \(_, baseUrl) -> do
+        left show <$> runClient getGet baseUrl  `shouldReturn` Right alice
+
+      it "get redirection endpoint" $ \(_, baseUrl) -> do
+        left show <$> runClient getGet307 baseUrl `shouldReturn` Right "redirecting"
 
     describe "Servant.API.Delete" $ do
       it "allows empty content type" $ \(_, baseUrl) -> do
@@ -83,9 +87,6 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
       let p = Person "Clara" 42
       left show <$> runClient (getBody p) baseUrl `shouldReturn` Right p
 
-    it "Servant.API.Get redirection" $ \(_, baseUrl) -> do
-      left show <$> runClient getRedirection baseUrl `shouldReturn` Right "redirecting"
-
     it "Servant.API FailureResponse" $ \(_, baseUrl) -> do
       left show <$> runClient (getQueryParam (Just "alice")) baseUrl `shouldReturn` Right alice
       Left (FailureResponse req _) <- runClient (getQueryParam (Just "bob")) baseUrl