@@ -5,7 +5,9 @@
5{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE RecordWildCards #-}
6{-# LANGUAGE RecordWildCards #-}
7{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE StandaloneDeriving #-}
8{-# OPTIONS_GHC -fcontext-stack=25 #-}
9{-# OPTIONS_GHC -fcontext-stack=25 #-}
10+{-# OPTIONS_GHC -fno-warn-orphans #-}
9module Servant.ClientSpec where
11module Servant.ClientSpec where
11import Control.Applicative
13import Control.Applicative
@@ -21,6 +23,7 @@ import Data.Monoid
21import Data.Proxy
23import Data.Proxy
22import qualified Data.Text as T
24import qualified Data.Text as T
23import GHC.Generics
25import GHC.Generics
26+import Network.HTTP.Client (HttpException(..))
24import Network.HTTP.Media
27import Network.HTTP.Media
25import Network.HTTP.Types
28import Network.HTTP.Types
26import Network.Socket
29import Network.Socket
@@ -59,6 +62,10 @@ instance FromFormUrlEncoded Person where
59 a <- lookupEither "age" xs
62 a <- lookupEither "age" xs
60 return $ Person (T.unpack n) (read $ T.unpack a)
63 return $ Person (T.unpack n) (read $ T.unpack a)
65+deriving instance Eq ServantError
67+instance Eq HttpException where
68+ a == b = show a == show b
63alice :: Person
70alice :: Person
64alice = Person "Alice" 42
71alice = Person "Alice" 42
@@ -111,6 +118,19 @@ server = serve api (
111withServer :: (BaseUrl -> IO a) -> IO a
118withServer :: (BaseUrl -> IO a) -> IO a
112withServer action = withWaiDaemon (return server) action
119withServer action = withWaiDaemon (return server) action
122+ "get" :> Get '[FormUrlEncoded] Person
123+failApi :: Proxy FailApi
126+failServer :: Application
127+failServer = serve failApi (
131+withFailServer :: (BaseUrl -> IO a) -> IO a
132+withFailServer action = withWaiDaemon (return failServer) action
114getGet :: BaseUrl -> EitherT ServantError IO Person
134getGet :: BaseUrl -> EitherT ServantError IO Person
115getDelete :: BaseUrl -> EitherT ServantError IO ()
135getDelete :: BaseUrl -> EitherT ServantError IO ()
116getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
136getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
@@ -216,11 +236,27 @@ spec = do
216 responseStatus `shouldBe` (Status 500 "error message")
236 responseStatus `shouldBe` (Status 500 "error message")
217 mapM_ test $
237 mapM_ test $
218 (WrappedApi (Proxy :: Proxy Delete), "Delete") :
238 (WrappedApi (Proxy :: Proxy Delete), "Delete") :
219− (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") :
239+ (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
220− (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Delete") :
240+ (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
221− (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Delete") :
241+ (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
244+ context "client returns errors appropriately" $ do
245+ it "reports connection errors" $ do
246+ Right host <- return $ parseBaseUrl "127.0.0.1:987654"
247+ Left (ConnectionError (FailedConnectionException2 "127.0.0.1" 987654 False _)) <- runEitherT (getGet host)
249+ it "reports non-success responses" $ withFailServer $ \ host -> do
250+ Left res <- runEitherT (getDelete host)
252+ FailureResponse (Status 404 "Not Found") _ _ -> return ()
253+ _ -> fail $ "expected 404 response, but got " <> show res
254+ it "reports unsupported content types" $ withFailServer $ \ host -> do
255+ Left res <- runEitherT (getGet host)
257+ FailureResponse (Status 404 "Not Found") _ _ -> return ()
258+ _ -> fail $ "expected 404 response, but got " <> show res
224data WrappedApi where
260data WrappedApi where
225 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
261 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
226 HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
262 HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>