git.iko.soy/servant
on master help sign in
Merge pull request #14 from haskell-servant/proper-errors

Use `ServantError` to report Errors instead of `String`

commitc08baabfdfbc3c100b7846aee9d425818a7c0149 authorAlp Mestanogullari <alpmestan@gmail.com> dateMon 9 Mar 2015, 09:02 (12 years ago) parent83aff1474b5bc4
5 files changed+152−74
compare with master
unifiedsplit
CHANGELOG.md+1 servant-client.cabal+1 src/Servant/Client.hs+9−10 src/Servant/Common/Req.hs+42−22 test/Servant/ClientSpec.hs+99−42
CHANGELOG.md+1
@@ -3,6 +3,7 @@
33* Support content-type aware combinators and `Accept`/`Content-type` headers
44* Added a lot of tests
55* Support multiple concurrent threads
6+* Use `ServantError` to report Errors instead of `String`
67
780.2.2
89-----
servant-client.cabal+1
@@ -71,6 +71,7 @@ test-suite spec
7171 , deepseq
7272 , either
7373 , hspec == 2.*
74+ , http-client
7475 , http-media
7576 , http-types
7677 , network >= 2.6
src/Servant/Client.hs+9−10
@@ -11,12 +11,12 @@
1111module Servant.Client
1212 ( client
1313 , HasClient(..)
14+ , ServantError(..)
1415 , module Servant.Common.BaseUrl
1516 ) where
1617
1718import Control.Monad
1819import Control.Monad.Trans.Either
19−import Data.Aeson
2020import Data.ByteString.Lazy (ByteString)
2121import Data.List
2222import Data.Proxy
@@ -29,7 +29,6 @@ import Servant.API
2929import Servant.API.ContentTypes
3030import Servant.Common.BaseUrl
3131import Servant.Common.Req
32−import Servant.Common.Text
3332
3433-- * Accessing APIs as a Client
3534
@@ -109,7 +108,7 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)
109108-- will just require an argument that specifies the scheme, host
110109-- and port to send the request to.
111110instance HasClient Delete where
112− type Client Delete = BaseUrl -> EitherT String IO ()
111+ type Client Delete = BaseUrl -> EitherT ServantError IO ()
113112
114113 clientWithRoute Proxy req host =
115114 void $ performRequest H.methodDelete req (== 204) host
@@ -119,9 +118,9 @@ instance HasClient Delete where
119118-- will just require an argument that specifies the scheme, host
120119-- and port to send the request to.
121120instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
122− type Client (Get (ct ': cts) result) = BaseUrl -> EitherT String IO result
121+ type Client (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result
123122 clientWithRoute Proxy req host =
124− performRequestCT (Proxy :: Proxy ct) H.methodGet req 200 host
123+ performRequestCT (Proxy :: Proxy ct) H.methodGet req [200] host
125124
126125-- | If you use a 'Header' in one of your endpoints in your API,
127126-- the corresponding querying function will automatically take
@@ -165,20 +164,20 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
165164-- will just require an argument that specifies the scheme, host
166165-- and port to send the request to.
167166instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
168− type Client (Post (ct ': cts) a) = BaseUrl -> EitherT String IO a
167+ type Client (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
169168
170169 clientWithRoute Proxy req uri =
171− performRequestCT (Proxy :: Proxy ct) H.methodPost req 201 uri
170+ performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] uri
172171
173172-- | If you have a 'Put' endpoint in your API, the client
174173-- side querying function that is created when calling 'client'
175174-- will just require an argument that specifies the scheme, host
176175-- and port to send the request to.
177176instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
178− type Client (Put (ct ': cts) a) = BaseUrl -> EitherT String IO a
177+ type Client (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
179178
180179 clientWithRoute Proxy req host =
181− performRequestCT (Proxy :: Proxy ct) H.methodPut req 200 host
180+ performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] host
182181
183182-- | If you use a 'QueryParam' in one of your endpoints in your API,
184183-- the corresponding querying function will automatically take
@@ -414,7 +413,7 @@ instance (KnownSymbol sym, HasClient sublayout)
414413-- | Pick a 'Method' and specify where the server you want to query is. You get
415414-- back the status code and the response body as a 'ByteString'.
416415instance HasClient Raw where
417− type Client Raw = H.Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
416+ type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
418417
419418 clientWithRoute :: Proxy Raw -> Req -> Client Raw
420419 clientWithRoute Proxy req httpMethod host =
src/Servant/Common/Req.hs+42−22
@@ -8,7 +8,7 @@ import Control.Monad
88import Control.Monad.Catch (MonadThrow)
99import Control.Monad.IO.Class
1010import Control.Monad.Trans.Either
11−import Data.ByteString.Lazy hiding (pack, filter, map, null)
11+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
1212import Data.IORef
1313import Data.String
1414import Data.String.Conversions
@@ -27,6 +27,30 @@ import System.IO.Unsafe
2727
2828import qualified Network.HTTP.Client as Client
2929
30+data ServantError
31+ = FailureResponse
32+ { responseStatus :: Status
33+ , responseContentType :: MediaType
34+ , responseBody :: ByteString
35+ }
36+ | DecodeFailure
37+ { decodeError :: String
38+ , responseContentType :: MediaType
39+ , responseBody :: ByteString
40+ }
41+ | UnsupportedContentType
42+ { responseContentType :: MediaType
43+ , responseBody :: ByteString
44+ }
45+ | ConnectionError
46+ { connectionError :: HttpException
47+ }
48+ | InvalidContentTypeHeader
49+ { responseContentTypeHeader :: ByteString
50+ , responseBody :: ByteString
51+ }
52+ deriving (Show)
53+
3054data Req = Req
3155 { reqPath :: String
3256 , qs :: QueryText
@@ -109,7 +133,7 @@ displayHttpRequest :: Method -> String
109133displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
110134
111135
112−performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
136+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
113137performRequest reqMethod req isWantedStatus reqHost = do
114138 partialRequest <- liftIO $ reqToRequest req reqHost
115139
@@ -118,43 +142,39 @@ performRequest reqMethod req isWantedStatus reqHost = do
118142 }
119143
120144 eResponse <- liftIO $ __withGlobalManager $ \ manager ->
121− catchStatusCodeException $
145+ catchHttpException $
122146 Client.httpLbs request manager
123147 case eResponse of
124− Left status ->
125− left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)
148+ Left err ->
149+ left $ ConnectionError err
126150
127151 Right response -> do
128152 let status = Client.responseStatus response
129− unless (isWantedStatus (statusCode status)) $
130− left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)
153+ body = Client.responseBody response
154+ status_code = statusCode status
131155 ct <- case lookup "Content-Type" $ Client.responseHeaders response of
132156 Nothing -> pure $ "application"//"octet-stream"
133157 Just t -> case parseAccept t of
134− Nothing -> left $ "invalid Content-Type header: " <> cs t
158+ Nothing -> left $ InvalidContentTypeHeader (cs t) body
135159 Just t' -> pure t'
136− return (statusCode status, Client.responseBody response, ct)
137− where
138− showStatus (Status code message) =
139− show code ++ " - " ++ cs message
160+ unless (isWantedStatus status_code) $
161+ left $ FailureResponse status ct body
162+ return (status_code, body, ct)
140163
141164performRequestCT :: MimeUnrender ct result =>
142− Proxy ct -> Method -> Req -> Int -> BaseUrl -> EitherT String IO result
165+ Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO result
143166performRequestCT ct reqMethod req wantedStatus reqHost = do
144167 let acceptCT = contentType ct
145168 (_status, respBody, respCT) <-
146− performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost
169+ performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
147170 unless (matches respCT (acceptCT)) $
148− left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT
171+ left $ UnsupportedContentType respCT respBody
149172 either
150− (left . ((displayHttpRequest reqMethod ++ " returned invalid response of type" ++ show respCT) ++))
173+ (left . (\s -> DecodeFailure s respCT respBody))
151174 return
152175 (fromByteString ct respBody)
153176
154177
155−catchStatusCodeException :: IO a -> IO (Either Status a)
156−catchStatusCodeException action =
157− catch (Right <$> action) $ \e ->
158− case e of
159− Client.StatusCodeException status _ _ -> return $ Left status
160− exc -> throwIO exc
178+catchHttpException :: IO a -> IO (Either HttpException a)
179+catchHttpException action =
180+ catch (Right <$> action) (pure . Left)
test/Servant/ClientSpec.hs+99−42
@@ -5,9 +5,13 @@
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
13+import Control.Applicative
14+import qualified Control.Arrow as Arrow
1115import Control.Concurrent
1216import Control.Exception
1317import Control.Monad.Trans.Either
@@ -19,6 +23,7 @@ import Data.Monoid
1923import Data.Proxy
2024import qualified Data.Text as T
2125import GHC.Generics
26+import Network.HTTP.Client (HttpException(..))
2227import Network.HTTP.Media
2328import Network.HTTP.Types
2429import Network.Socket
@@ -29,7 +34,6 @@ import Test.Hspec.QuickCheck
2934import Test.QuickCheck
3035
3136import Servant.API
32−import Servant.API.ContentTypes
3337import Servant.Client
3438import Servant.Server
3539
@@ -58,6 +62,10 @@ instance FromFormUrlEncoded Person where
5862 a <- lookupEither "age" xs
5963 return $ Person (T.unpack n) (read $ T.unpack a)
6064
65+deriving instance Eq ServantError
66+
67+instance Eq HttpException where
68+ a == b = show a == show b
6169
6270alice :: Person
6371alice = Person "Alice" 42
@@ -110,21 +118,21 @@ server = serve api (
110118withServer :: (BaseUrl -> IO a) -> IO a
111119withServer action = withWaiDaemon (return server) action
112120
113−getGet :: BaseUrl -> EitherT String IO Person
114−getDelete :: BaseUrl -> EitherT String IO ()
115−getCapture :: String -> BaseUrl -> EitherT String IO Person
116−getBody :: Person -> BaseUrl -> EitherT String IO Person
117−getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
118−getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
119−getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
120−getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
121−getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
122−getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
123−getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
124−getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
121+getGet :: BaseUrl -> EitherT ServantError IO Person
122+getDelete :: BaseUrl -> EitherT ServantError IO ()
123+getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
124+getBody :: Person -> BaseUrl -> EitherT ServantError IO Person
125+getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
126+getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
127+getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
128+getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
129+getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
130+getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
131+getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
132+getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
125133getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
126134 -> BaseUrl
127− -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
135+ -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
128136( getGet
129137 :<|> getDelete
130138 :<|> getCapture
@@ -140,65 +148,82 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
140148 :<|> getMultiple)
141149 = client api
142150
151+type FailApi =
152+ "get" :> Raw
153+ :<|> "capture" :> Capture "name" String :> Raw
154+ :<|> "body" :> Raw
155+failApi :: Proxy FailApi
156+failApi = Proxy
157+
158+failServer :: Application
159+failServer = serve failApi (
160+ (\ _request respond -> respond $ responseLBS ok200 [] "")
161+ :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
162+ :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
163+ )
164+
165+withFailServer :: (BaseUrl -> IO a) -> IO a
166+withFailServer action = withWaiDaemon (return failServer) action
167+
143168spec :: Spec
144169spec = do
145170 it "Servant.API.Get" $ withServer $ \ host -> do
146− runEitherT (getGet host) `shouldReturn` Right alice
171+ (Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice
147172
148173 it "Servant.API.Delete" $ withServer $ \ host -> do
149− runEitherT (getDelete host) `shouldReturn` Right ()
174+ (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()
150175
151176 it "Servant.API.Capture" $ withServer $ \ host -> do
152− runEitherT (getCapture "Paula" host) `shouldReturn` Right (Person "Paula" 0)
177+ (Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0)
153178
154179 it "Servant.API.ReqBody" $ withServer $ \ host -> do
155180 let p = Person "Clara" 42
156− runEitherT (getBody p host) `shouldReturn` Right p
181+ (Arrow.left show <$> runEitherT (getBody p host)) `shouldReturn` Right p
157182
158183 it "Servant.API.QueryParam" $ withServer $ \ host -> do
159− runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
160− Left result <- runEitherT (getQueryParam (Just "bob") host)
161− result `shouldContain` "bob not found"
184+ Arrow.left show <$> runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
185+ Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob") host)
186+ responseStatus `shouldBe` Status 400 "bob not found"
162187
163188 it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do
164− runEitherT (getQueryParams [] host) `shouldReturn` Right []
165− runEitherT (getQueryParams ["alice", "bob"] host)
189+ (Arrow.left show <$> runEitherT (getQueryParams [] host)) `shouldReturn` Right []
190+ (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"] host))
166191 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
167192
168193 context "Servant.API.QueryParam.QueryFlag" $
169194 forM_ [False, True] $ \ flag ->
170195 it (show flag) $ withServer $ \ host -> do
171− runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
196+ (Arrow.left show <$> runEitherT (getQueryFlag flag host)) `shouldReturn` Right flag
172197
173−{-
174198 it "Servant.API.MatrixParam" $ withServer $ \ host -> do
175− runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice
176− Left result <- runEitherT (getMatrixParam (Just "bob") host)
177− result `shouldContain` "bob not found"
199+ Arrow.left show <$> runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice
200+ Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob") host)
201+ responseStatus `shouldBe` Status 400 "bob not found"
178202
179203 it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do
180− runEitherT (getMatrixParams [] host) `shouldReturn` Right []
181− runEitherT (getMatrixParams ["alice", "bob"] host)
204+ Arrow.left show <$> runEitherT (getMatrixParams [] host) `shouldReturn` Right []
205+ Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"] host)
182206 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
183207
184208 context "Servant.API.MatrixParam.MatrixFlag" $
185209 forM_ [False, True] $ \ flag ->
186210 it (show flag) $ withServer $ \ host -> do
187− runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag
188−-}
211+ Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag
189212
190213 it "Servant.API.Raw on success" $ withServer $ \ host -> do
191− runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")
214+ (Arrow.left show <$> runEitherT (getRawSuccess methodGet host))
215+ `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")
192216
193217 it "Servant.API.Raw on failure" $ withServer $ \ host -> do
194− runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")
218+ (Arrow.left show <$> runEitherT (getRawFailure methodGet host))
219+ `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")
195220
196221 modifyMaxSuccess (const 20) $ do
197222 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
198223 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
199224 ioProperty $ do
200225 withServer $ \ host -> do
201− result <- runEitherT (getMultiple cap num flag body host)
226+ result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body host)
202227 return $
203228 result === Right (cap, num, flag, body)
204229
@@ -209,20 +234,52 @@ spec = do
209234 it desc $
210235 withWaiDaemon (return (serve api (left (500, "error message")))) $
211236 \ host -> do
212− let getResponse :: BaseUrl -> EitherT String IO ()
237+ let getResponse :: BaseUrl -> EitherT ServantError IO ()
213238 getResponse = client api
214− Left result <- runEitherT (getResponse host)
215− result `shouldContain` "error message"
239+ Left FailureResponse{..} <- runEitherT (getResponse host)
240+ responseStatus `shouldBe` (Status 500 "error message")
216241 mapM_ test $
217242 (WrappedApi (Proxy :: Proxy Delete), "Delete") :
218− (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") :
219− (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Delete") :
220− (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Delete") :
243+ (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
244+ (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
245+ (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
221246 []
222247
248+ context "client returns errors appropriately" $ do
249+ it "reports FailureResponse" $ 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+
255+ it "reports DecodeFailure" $ withFailServer $ \ host -> do
256+ Left res <- runEitherT (getCapture "foo" host)
257+ case res of
258+ DecodeFailure _ ("application/json") _ -> return ()
259+ _ -> fail $ "expected DecodeFailure, but got " <> show res
260+
261+ it "reports ConnectionError" $ do
262+ Right host <- return $ parseBaseUrl "127.0.0.1:987654"
263+ Left res <- runEitherT (getGet host)
264+ case res of
265+ ConnectionError (FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
266+ _ -> fail $ "expected ConnectionError, but got " <> show res
267+
268+ it "reports UnsupportedContentType" $ withFailServer $ \ host -> do
269+ Left res <- runEitherT (getGet host)
270+ case res of
271+ UnsupportedContentType ("application/octet-stream") _ -> return ()
272+ _ -> fail $ "expected UnsupportedContentType, but got " <> show res
273+
274+ it "reports InvalidContentTypeHeader" $ withFailServer $ \ host -> do
275+ Left res <- runEitherT (getBody alice host)
276+ case res of
277+ InvalidContentTypeHeader "fooooo" _ -> return ()
278+ _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
279+
223280data WrappedApi where
224281 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
225− HasClient api, Client api ~ (BaseUrl -> EitherT String IO ())) =>
282+ HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
226283 Proxy api -> WrappedApi
227284
228285