git.iko.soy/servant
on master help sign in
Use `ServantError` to report Errors instead of `String`
ba46eccTimo von Holtz
CHANGELOG.md+1
compare with master
unifiedsplit
@@ -3,6 +3,7 @@
3* Support content-type aware combinators and `Accept`/`Content-type` headers
3* Support content-type aware combinators and `Accept`/`Content-type` headers
4* Added a lot of tests
4* Added a lot of tests
5* Support multiple concurrent threads
5* Support multiple concurrent threads
6+* Use `ServantError` to report Errors instead of `String`
6
7
70.2.2
80.2.2
8-----
9-----
src/Servant/Client.hs+6−7
@@ -11,12 +11,12 @@
11module Servant.Client
11module Servant.Client
12 ( client
12 ( client
13 , HasClient(..)
13 , HasClient(..)
14+ , ServantError(..)
14 , module Servant.Common.BaseUrl
15 , module Servant.Common.BaseUrl
15 ) where
16 ) where
16
17
17import Control.Monad
18import Control.Monad
18import Control.Monad.Trans.Either
19import Control.Monad.Trans.Either
19−import Data.Aeson
20import Data.ByteString.Lazy (ByteString)
20import Data.ByteString.Lazy (ByteString)
21import Data.List
21import Data.List
22import Data.Proxy
22import Data.Proxy
@@ -29,7 +29,6 @@ import Servant.API
29import Servant.API.ContentTypes
29import Servant.API.ContentTypes
30import Servant.Common.BaseUrl
30import Servant.Common.BaseUrl
31import Servant.Common.Req
31import Servant.Common.Req
32−import Servant.Common.Text
33
32
34-- * Accessing APIs as a Client
33-- * Accessing APIs as a Client
35
34
@@ -109,7 +108,7 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)
109-- will just require an argument that specifies the scheme, host
108-- will just require an argument that specifies the scheme, host
110-- and port to send the request to.
109-- and port to send the request to.
111instance HasClient Delete where
110instance HasClient Delete where
112− type Client Delete = BaseUrl -> EitherT String IO ()
111+ type Client Delete = BaseUrl -> EitherT ServantError IO ()
113
112
114 clientWithRoute Proxy req host =
113 clientWithRoute Proxy req host =
115 void $ performRequest H.methodDelete req (== 204) host
114 void $ performRequest H.methodDelete req (== 204) host
@@ -119,7 +118,7 @@ instance HasClient Delete where
119-- will just require an argument that specifies the scheme, host
118-- will just require an argument that specifies the scheme, host
120-- and port to send the request to.
119-- and port to send the request to.
121instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
120instance (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
123 clientWithRoute Proxy req host =
122 clientWithRoute Proxy req host =
124 performRequestCT (Proxy :: Proxy ct) H.methodGet req 200 host
123 performRequestCT (Proxy :: Proxy ct) H.methodGet req 200 host
125
124
@@ -165,7 +164,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
165-- will just require an argument that specifies the scheme, host
164-- will just require an argument that specifies the scheme, host
166-- and port to send the request to.
165-- and port to send the request to.
167instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
166instance (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
169
168
170 clientWithRoute Proxy req uri =
169 clientWithRoute Proxy req uri =
171 performRequestCT (Proxy :: Proxy ct) H.methodPost req 201 uri
170 performRequestCT (Proxy :: Proxy ct) H.methodPost req 201 uri
@@ -175,7 +174,7 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
175-- will just require an argument that specifies the scheme, host
174-- will just require an argument that specifies the scheme, host
176-- and port to send the request to.
175-- and port to send the request to.
177instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
176instance (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
179
178
180 clientWithRoute Proxy req host =
179 clientWithRoute Proxy req host =
181 performRequestCT (Proxy :: Proxy ct) H.methodPut req 200 host
180 performRequestCT (Proxy :: Proxy ct) H.methodPut req 200 host
@@ -414,7 +413,7 @@ instance (KnownSymbol sym, HasClient sublayout)
414-- | Pick a 'Method' and specify where the server you want to query is. You get
413-- | Pick a 'Method' and specify where the server you want to query is. You get
415-- back the status code and the response body as a 'ByteString'.
414-- back the status code and the response body as a 'ByteString'.
416instance HasClient Raw where
415instance 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)
418
417
419 clientWithRoute :: Proxy Raw -> Req -> Client Raw
418 clientWithRoute :: Proxy Raw -> Req -> Client Raw
420 clientWithRoute Proxy req httpMethod host =
419 clientWithRoute Proxy req httpMethod host =
src/Servant/Common/Req.hs+24−20
@@ -27,6 +27,14 @@ import System.IO.Unsafe
27
27
28import qualified Network.HTTP.Client as Client
28import qualified Network.HTTP.Client as Client
29
29
30+data ServantError
31+ = FailureResponse Status MediaType ByteString
32+ | DecodeFailure String MediaType ByteString
33+ | UnsupportedContentType MediaType ByteString
34+ | ConnectionError HttpException
35+ | InvalidContentTypeHeader String
36+ deriving (Show)
37+
30data Req = Req
38data Req = Req
31 { reqPath :: String
39 { reqPath :: String
32 , qs :: QueryText
40 , qs :: QueryText
@@ -109,7 +117,7 @@ displayHttpRequest :: Method -> String
109displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
117displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
110
118
111
119
112−performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
120+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
113performRequest reqMethod req isWantedStatus reqHost = do
121performRequest reqMethod req isWantedStatus reqHost = do
114 partialRequest <- liftIO $ reqToRequest req reqHost
122 partialRequest <- liftIO $ reqToRequest req reqHost
115
123
@@ -118,43 +126,39 @@ performRequest reqMethod req isWantedStatus reqHost = do
118 }
126 }
119
127
120 eResponse <- liftIO $ __withGlobalManager $ \ manager ->
128 eResponse <- liftIO $ __withGlobalManager $ \ manager ->
121− catchStatusCodeException $
129+ catchHttpException $
122 Client.httpLbs request manager
130 Client.httpLbs request manager
123 case eResponse of
131 case eResponse of
124− Left status ->
132+ Left err ->
125− left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)
133+ left $ ConnectionError err
126
134
127 Right response -> do
135 Right response -> do
128 let status = Client.responseStatus response
136 let status = Client.responseStatus response
129− unless (isWantedStatus (statusCode status)) $
137+ body = Client.responseBody response
130− left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)
138+ status_code = statusCode status
131 ct <- case lookup "Content-Type" $ Client.responseHeaders response of
139 ct <- case lookup "Content-Type" $ Client.responseHeaders response of
132 Nothing -> pure $ "application"//"octet-stream"
140 Nothing -> pure $ "application"//"octet-stream"
133 Just t -> case parseAccept t of
141 Just t -> case parseAccept t of
134− Nothing -> left $ "invalid Content-Type header: " <> cs t
142+ Nothing -> left . InvalidContentTypeHeader . cs $ t
135 Just t' -> pure t'
143 Just t' -> pure t'
136− return (statusCode status, Client.responseBody response, ct)
144+ unless (isWantedStatus status_code) $
137− where
145+ left $ FailureResponse status ct body
138− showStatus (Status code message) =
146+ return (status_code, body, ct)
139− show code ++ " - " ++ cs message
140
147
141performRequestCT :: MimeUnrender ct result =>
148performRequestCT :: MimeUnrender ct result =>
142− Proxy ct -> Method -> Req -> Int -> BaseUrl -> EitherT String IO result
149+ Proxy ct -> Method -> Req -> Int -> BaseUrl -> EitherT ServantError IO result
143performRequestCT ct reqMethod req wantedStatus reqHost = do
150performRequestCT ct reqMethod req wantedStatus reqHost = do
144 let acceptCT = contentType ct
151 let acceptCT = contentType ct
145 (_status, respBody, respCT) <-
152 (_status, respBody, respCT) <-
146 performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost
153 performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost
147 unless (matches respCT (acceptCT)) $
154 unless (matches respCT (acceptCT)) $
148− left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT
155+ left $ UnsupportedContentType respCT respBody
149 either
156 either
150− (left . ((displayHttpRequest reqMethod ++ " returned invalid response of type" ++ show respCT) ++))
157+ (left . (\s -> DecodeFailure s respCT respBody))
151 return
158 return
152 (fromByteString ct respBody)
159 (fromByteString ct respBody)
153
160
154
161
155−catchStatusCodeException :: IO a -> IO (Either Status a)
162+catchHttpException :: IO a -> IO (Either HttpException a)
156−catchStatusCodeException action =
163+catchHttpException action =
157− catch (Right <$> action) $ \e ->
164+ catch (Right <$> action) (pure . Left)
158− case e of
159− Client.StatusCodeException status _ _ -> return $ Left status
160− exc -> throwIO exc
test/Servant/ClientSpec.hs+34−31
@@ -8,6 +8,8 @@
8{-# OPTIONS_GHC -fcontext-stack=25 #-}
8{-# OPTIONS_GHC -fcontext-stack=25 #-}
9module Servant.ClientSpec where
9module Servant.ClientSpec where
10
10
11+import Control.Applicative
12+import qualified Control.Arrow as Arrow
11import Control.Concurrent
13import Control.Concurrent
12import Control.Exception
14import Control.Exception
13import Control.Monad.Trans.Either
15import Control.Monad.Trans.Either
@@ -29,7 +31,6 @@ import Test.Hspec.QuickCheck
29import Test.QuickCheck
31import Test.QuickCheck
30
32
31import Servant.API
33import Servant.API
32−import Servant.API.ContentTypes
33import Servant.Client
34import Servant.Client
34import Servant.Server
35import Servant.Server
35
36
@@ -110,21 +111,21 @@ server = serve api (
110withServer :: (BaseUrl -> IO a) -> IO a
111withServer :: (BaseUrl -> IO a) -> IO a
111withServer action = withWaiDaemon (return server) action
112withServer action = withWaiDaemon (return server) action
112
113
113−getGet :: BaseUrl -> EitherT String IO Person
114+getGet :: BaseUrl -> EitherT ServantError IO Person
114−getDelete :: BaseUrl -> EitherT String IO ()
115+getDelete :: BaseUrl -> EitherT ServantError IO ()
115−getCapture :: String -> BaseUrl -> EitherT String IO Person
116+getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
116−getBody :: Person -> BaseUrl -> EitherT String IO Person
117+getBody :: Person -> BaseUrl -> EitherT ServantError IO Person
117−getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
118+getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
118−getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
119+getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
119−getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
120+getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
120−getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
121+getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
121−getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
122+getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
122−getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
123+getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
123−getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
124+getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
124−getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
125+getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
125getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
126getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
126 -> BaseUrl
127 -> BaseUrl
127− -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
128+ -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
128( getGet
129( getGet
129 :<|> getDelete
130 :<|> getDelete
130 :<|> getCapture
131 :<|> getCapture
@@ -143,32 +144,32 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
143spec :: Spec
144spec :: Spec
144spec = do
145spec = do
145 it "Servant.API.Get" $ withServer $ \ host -> do
146 it "Servant.API.Get" $ withServer $ \ host -> do
146− runEitherT (getGet host) `shouldReturn` Right alice
147+ (Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice
147
148
148 it "Servant.API.Delete" $ withServer $ \ host -> do
149 it "Servant.API.Delete" $ withServer $ \ host -> do
149− runEitherT (getDelete host) `shouldReturn` Right ()
150+ (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()
150
151
151 it "Servant.API.Capture" $ withServer $ \ host -> do
152 it "Servant.API.Capture" $ withServer $ \ host -> do
152− runEitherT (getCapture "Paula" host) `shouldReturn` Right (Person "Paula" 0)
153+ (Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0)
153
154
154 it "Servant.API.ReqBody" $ withServer $ \ host -> do
155 it "Servant.API.ReqBody" $ withServer $ \ host -> do
155 let p = Person "Clara" 42
156 let p = Person "Clara" 42
156− runEitherT (getBody p host) `shouldReturn` Right p
157+ (Arrow.left show <$> runEitherT (getBody p host)) `shouldReturn` Right p
157
158
158 it "Servant.API.QueryParam" $ withServer $ \ host -> do
159 it "Servant.API.QueryParam" $ withServer $ \ host -> do
159− runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
160+ (Arrow.left show <$> runEitherT (getQueryParam (Just "alice") host)) `shouldReturn` Right alice
160− Left result <- runEitherT (getQueryParam (Just "bob") host)
161+ Left (FailureResponse s _ _) <- runEitherT (getQueryParam (Just "bob") host)
161− result `shouldContain` "bob not found"
162+ statusCode s `shouldBe` 400
162
163
163 it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do
164 it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do
164− runEitherT (getQueryParams [] host) `shouldReturn` Right []
165+ (Arrow.left show <$> runEitherT (getQueryParams [] host)) `shouldReturn` Right []
165− runEitherT (getQueryParams ["alice", "bob"] host)
166+ (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"] host))
166 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
167 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
167
168
168 context "Servant.API.QueryParam.QueryFlag" $
169 context "Servant.API.QueryParam.QueryFlag" $
169 forM_ [False, True] $ \ flag ->
170 forM_ [False, True] $ \ flag ->
170 it (show flag) $ withServer $ \ host -> do
171 it (show flag) $ withServer $ \ host -> do
171− runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
172+ (Arrow.left show <$> runEitherT (getQueryFlag flag host)) `shouldReturn` Right flag
172
173
173{-
174{-
174 it "Servant.API.MatrixParam" $ withServer $ \ host -> do
175 it "Servant.API.MatrixParam" $ withServer $ \ host -> do
@@ -188,17 +189,19 @@ spec = do
188-}
189-}
189
190
190 it "Servant.API.Raw on success" $ withServer $ \ host -> do
191 it "Servant.API.Raw on success" $ withServer $ \ host -> do
192+ (Arrow.left show <$> runEitherT (getRawSuccess methodGet host))
191− runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")
193+ `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")
192
194
193 it "Servant.API.Raw on failure" $ withServer $ \ host -> do
195 it "Servant.API.Raw on failure" $ withServer $ \ host -> do
196+ (Arrow.left show <$> runEitherT (getRawFailure methodGet host))
194− runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")
197+ `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")
195
198
196 modifyMaxSuccess (const 20) $ do
199 modifyMaxSuccess (const 20) $ do
197 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
200 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
198 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
201 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
199 ioProperty $ do
202 ioProperty $ do
200 withServer $ \ host -> do
203 withServer $ \ host -> do
201− result <- runEitherT (getMultiple cap num flag body host)
204+ result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body host)
202 return $
205 return $
203 result === Right (cap, num, flag, body)
206 result === Right (cap, num, flag, body)
204
207
@@ -209,10 +212,10 @@ spec = do
209 it desc $
212 it desc $
210 withWaiDaemon (return (serve api (left (500, "error message")))) $
213 withWaiDaemon (return (serve api (left (500, "error message")))) $
211 \ host -> do
214 \ host -> do
212− let getResponse :: BaseUrl -> EitherT String IO ()
215+ let getResponse :: BaseUrl -> EitherT ServantError IO ()
213 getResponse = client api
216 getResponse = client api
214− Left result <- runEitherT (getResponse host)
217+ Left (FailureResponse status _ _) <- runEitherT (getResponse host)
215− result `shouldContain` "error message"
218+ status `shouldBe` (Status 500 "error message")
216 mapM_ test $
219 mapM_ test $
217 (WrappedApi (Proxy :: Proxy Delete), "Delete") :
220 (WrappedApi (Proxy :: Proxy Delete), "Delete") :
218 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") :
221 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") :
@@ -222,7 +225,7 @@ spec = do
222
225
223data WrappedApi where
226data WrappedApi where
224 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
227 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
225− HasClient api, Client api ~ (BaseUrl -> EitherT String IO ())) =>
228+ HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
226 Proxy api -> WrappedApi
229 Proxy api -> WrappedApi
227
230
228
231