@@ -5,7 +5,9 @@
55{-# LANGUAGE TypeOperators #-}
66{-# LANGUAGE RecordWildCards #-}
77{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE StandaloneDeriving #-}
89{-# OPTIONS_GHC -fcontext-stack=25 #-}
10+{-# OPTIONS_GHC -fno-warn-orphans #-}
911module Servant.ClientSpec where
1012
1113import Control.Applicative
@@ -21,6 +23,7 @@ import Data.Monoid
2123import Data.Proxy
2224import qualified Data.Text as T
2325import GHC.Generics
26+import Network.HTTP.Client (HttpException(..))
2427import Network.HTTP.Media
2528import Network.HTTP.Types
2629import Network.Socket
@@ -59,6 +62,10 @@ instance FromFormUrlEncoded Person where
5962 a <- lookupEither "age" xs
6063 return $ Person (T.unpack n) (read $ T.unpack a)
6164
65+deriving instance Eq ServantError
66+
67+instance Eq HttpException where
68+ a == b = show a == show b
6269
6370alice :: Person
6471alice = Person "Alice" 42
@@ -111,6 +118,19 @@ server = serve api (
111118withServer :: (BaseUrl -> IO a) -> IO a
112119withServer action = withWaiDaemon (return server) action
113120
121+type FailApi =
122+ "get" :> Get '[FormUrlEncoded] Person
123+failApi :: Proxy FailApi
124+failApi = Proxy
125+
126+failServer :: Application
127+failServer = serve failApi (
128+ return alice
129+ )
130+
131+withFailServer :: (BaseUrl -> IO a) -> IO a
132+withFailServer action = withWaiDaemon (return failServer) action
133+
114134getGet :: BaseUrl -> EitherT ServantError IO Person
115135getDelete :: BaseUrl -> EitherT ServantError IO ()
116136getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
@@ -216,11 +236,27 @@ spec = do
216236 responseStatus `shouldBe` (Status 500 "error message")
217237 mapM_ test $
218238 (WrappedApi (Proxy :: Proxy Delete), "Delete") :
219− (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") :
220− (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Delete") :
221− (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Delete") :
239+ (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
240+ (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
241+ (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
222242 []
223243
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)
248+ return ()
249+ it "reports non-success responses" $ withFailServer $ \ host -> do
250+ Left res <- runEitherT (getDelete host)
251+ case res of
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)
256+ case res of
257+ FailureResponse (Status 404 "Not Found") _ _ -> return ()
258+ _ -> fail $ "expected 404 response, but got " <> show res
259+
224260data WrappedApi where
225261 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
226262 HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>