c08baab · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Merge pull request #14 from haskell-servant/proper-errors

c08baabAlp Mestanogullari12 years ago

CHANGELOG.md+1

compare with master

unifiedsplit

@@ -3,6 +3,7 @@

3* Support content-type aware combinators and `Accept`/`Content-type` headers

4* Added a lot of tests

5* Support multiple concurrent threads

6+* Use `ServantError` to report Errors instead of `String`

70.2.2

80.2.2

8-----

9-----

servant-client.cabal+1

@@ -71,6 +71,7 @@ test-suite spec

71 , deepseq

72 , either

73 , hspec == 2.*

74+ , http-client

74 , http-media

75 , http-media

75 , http-types

76 , http-types

76 , network >= 2.6

77 , network >= 2.6

src/Servant/Client.hs+9−10

@@ -11,12 +11,12 @@

11module Servant.Client

12 ( client

13 , HasClient(..)

14+ , ServantError(..)

14 , module Servant.Common.BaseUrl

15 , module Servant.Common.BaseUrl

15 ) where

16 ) where

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)

21import Data.List

22import Data.Proxy

@@ -29,7 +29,6 @@ import Servant.API

29import Servant.API.ContentTypes

30import Servant.Common.BaseUrl

31import Servant.Common.Req

32−import Servant.Common.Text

34-- * Accessing APIs as a Client

33-- * Accessing APIs as a Client

@@ -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,9 +118,9 @@ 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

126-- | If you use a 'Header' in one of your endpoints in your API,

125-- | If you use a 'Header' in one of your endpoints in your API,

127-- the corresponding querying function will automatically take

126-- the corresponding querying function will automatically take

@@ -165,20 +164,20 @@ 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 [200,201] uri

172

171

173-- | If you have a 'Put' endpoint in your API, the client

172-- | If you have a 'Put' endpoint in your API, the client

174-- side querying function that is created when calling 'client'

173-- side querying function that is created when calling 'client'

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,201] host

182

181

183-- | If you use a 'QueryParam' in one of your endpoints in your API,

182-- | If you use a 'QueryParam' in one of your endpoints in your API,

184-- the corresponding querying function will automatically take

183-- the corresponding querying function will automatically take

@@ -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+42−22

@@ -8,7 +8,7 @@ import Control.Monad

8import Control.Monad.Catch (MonadThrow)

9import Control.Monad.IO.Class

10import 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)

12import Data.IORef

13import Data.String

14import Data.String.Conversions

@@ -27,6 +27,30 @@ import System.IO.Unsafe

28import qualified Network.HTTP.Client as Client

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+

30data Req = Req

54data Req = Req

31 { reqPath :: String

55 { reqPath :: String

32 , qs :: QueryText

56 , qs :: QueryText

@@ -109,7 +133,7 @@ displayHttpRequest :: Method -> String

109displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

133displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

110

134

111

135

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)

113performRequest reqMethod req isWantedStatus reqHost = do

137performRequest reqMethod req isWantedStatus reqHost = do

114 partialRequest <- liftIO $ reqToRequest req reqHost

138 partialRequest <- liftIO $ reqToRequest req reqHost

115

139

@@ -118,43 +142,39 @@ performRequest reqMethod req isWantedStatus reqHost = do

118 }

142 }

119

143

120 eResponse <- liftIO $ __withGlobalManager $ \ manager ->

144 eResponse <- liftIO $ __withGlobalManager $ \ manager ->

121− catchStatusCodeException $

145+ catchHttpException $

122 Client.httpLbs request manager

146 Client.httpLbs request manager

123 case eResponse of

147 case eResponse of

124− Left status ->

148+ Left err ->

125− left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)

149+ left $ ConnectionError err

126

150

127 Right response -> do

151 Right response -> do

128 let status = Client.responseStatus response

152 let status = Client.responseStatus response

129− unless (isWantedStatus (statusCode status)) $

153+ body = Client.responseBody response

130− left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)

154+ status_code = statusCode status

131 ct <- case lookup "Content-Type" $ Client.responseHeaders response of

155 ct <- case lookup "Content-Type" $ Client.responseHeaders response of

132 Nothing -> pure $ "application"//"octet-stream"

156 Nothing -> pure $ "application"//"octet-stream"

133 Just t -> case parseAccept t of

157 Just t -> case parseAccept t of

134− Nothing -> left $ "invalid Content-Type header: " <> cs t

158+ Nothing -> left $ InvalidContentTypeHeader (cs t) body

135 Just t' -> pure t'

159 Just t' -> pure t'

136− return (statusCode status, Client.responseBody response, ct)

160+ unless (isWantedStatus status_code) $

137− where

161+ left $ FailureResponse status ct body

138− showStatus (Status code message) =

162+ return (status_code, body, ct)

139− show code ++ " - " ++ cs message

140

163

141performRequestCT :: MimeUnrender ct result =>

164performRequestCT :: 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

143performRequestCT ct reqMethod req wantedStatus reqHost = do

166performRequestCT ct reqMethod req wantedStatus reqHost = do

144 let acceptCT = contentType ct

167 let acceptCT = contentType ct

145 (_status, respBody, respCT) <-

168 (_status, respBody, respCT) <-

146− performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost

169+ performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost

147 unless (matches respCT (acceptCT)) $

170 unless (matches respCT (acceptCT)) $

148− left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT

171+ left $ UnsupportedContentType respCT respBody

149 either

172 either

150− (left . ((displayHttpRequest reqMethod ++ " returned invalid response of type" ++ show respCT) ++))

173+ (left . (\s -> DecodeFailure s respCT respBody))

151 return

174 return

152 (fromByteString ct respBody)

175 (fromByteString ct respBody)

153

176

154

177

155−catchStatusCodeException :: IO a -> IO (Either Status a)

178+catchHttpException :: IO a -> IO (Either HttpException a)

156−catchStatusCodeException action =

179+catchHttpException action =

157− catch (Right <$> action) $ \e ->

180+ catch (Right <$> action) (pure . Left)

158− case e of

159− Client.StatusCodeException status _ _ -> return $ Left status

160− exc -> throwIO exc

test/Servant/ClientSpec.hs+99−42

@@ -5,9 +5,13 @@

5{-# LANGUAGE TypeOperators #-}

6{-# LANGUAGE RecordWildCards #-}

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

13+import Control.Applicative

14+import qualified Control.Arrow as Arrow

11import Control.Concurrent

15import Control.Concurrent

12import Control.Exception

16import Control.Exception

13import Control.Monad.Trans.Either

17import Control.Monad.Trans.Either

@@ -19,6 +23,7 @@ import Data.Monoid

19import Data.Proxy

23import Data.Proxy

20import qualified Data.Text as T

24import qualified Data.Text as T

21import GHC.Generics

25import GHC.Generics

26+import Network.HTTP.Client (HttpException(..))

22import Network.HTTP.Media

27import Network.HTTP.Media

23import Network.HTTP.Types

28import Network.HTTP.Types

24import Network.Socket

29import Network.Socket

@@ -29,7 +34,6 @@ import Test.Hspec.QuickCheck

29import Test.QuickCheck

34import Test.QuickCheck

31import Servant.API

36import Servant.API

32−import Servant.API.ContentTypes

33import Servant.Client

37import Servant.Client

34import Servant.Server

38import Servant.Server

@@ -58,6 +62,10 @@ instance FromFormUrlEncoded Person where

58 a <- lookupEither "age" xs

62 a <- lookupEither "age" xs

59 return $ Person (T.unpack n) (read $ T.unpack a)

63 return $ Person (T.unpack n) (read $ T.unpack a)

65+deriving instance Eq ServantError

66+

67+instance Eq HttpException where

68+ a == b = show a == show b

62alice :: Person

70alice :: Person

63alice = Person "Alice" 42

71alice = Person "Alice" 42

@@ -110,21 +118,21 @@ server = serve api (

110withServer :: (BaseUrl -> IO a) -> IO a

118withServer :: (BaseUrl -> IO a) -> IO a

111withServer action = withWaiDaemon (return server) action

119withServer action = withWaiDaemon (return server) action

112

120

113−getGet :: BaseUrl -> EitherT String IO Person

121+getGet :: BaseUrl -> EitherT ServantError IO Person

114−getDelete :: BaseUrl -> EitherT String IO ()

122+getDelete :: BaseUrl -> EitherT ServantError IO ()

115−getCapture :: String -> BaseUrl -> EitherT String IO Person

123+getCapture :: String -> BaseUrl -> EitherT ServantError IO Person

116−getBody :: Person -> BaseUrl -> EitherT String IO Person

124+getBody :: Person -> BaseUrl -> EitherT ServantError IO Person

117−getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person

125+getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person

118−getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]

126+getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]

119−getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool

127+getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool

120−getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person

128+getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person

121−getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]

129+getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]

122−getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool

130+getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool

123−getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)

131+getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)

124−getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)

132+getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)

125getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

133getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

126 -> BaseUrl

134 -> BaseUrl

127− -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])

135+ -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])

128( getGet

136( getGet

129 :<|> getDelete

137 :<|> getDelete

130 :<|> getCapture

138 :<|> getCapture

@@ -140,65 +148,82 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

140 :<|> getMultiple)

148 :<|> getMultiple)

141 = client api

149 = client api

142

150

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+

143spec :: Spec

168spec :: Spec

144spec = do

169spec = do

145 it "Servant.API.Get" $ withServer $ \ host -> do

170 it "Servant.API.Get" $ withServer $ \ host -> do

146− runEitherT (getGet host) `shouldReturn` Right alice

171+ (Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice

147

172

148 it "Servant.API.Delete" $ withServer $ \ host -> do

173 it "Servant.API.Delete" $ withServer $ \ host -> do

149− runEitherT (getDelete host) `shouldReturn` Right ()

174+ (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()

150

175

151 it "Servant.API.Capture" $ withServer $ \ host -> do

176 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)

153

178

154 it "Servant.API.ReqBody" $ withServer $ \ host -> do

179 it "Servant.API.ReqBody" $ withServer $ \ host -> do

155 let p = Person "Clara" 42

180 let p = Person "Clara" 42

156− runEitherT (getBody p host) `shouldReturn` Right p

181+ (Arrow.left show <$> runEitherT (getBody p host)) `shouldReturn` Right p

157

182

158 it "Servant.API.QueryParam" $ withServer $ \ host -> do

183 it "Servant.API.QueryParam" $ withServer $ \ host -> do

159− runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice

184+ Arrow.left show <$> runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice

160− Left result <- runEitherT (getQueryParam (Just "bob") host)

185+ Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob") host)

161− result `shouldContain` "bob not found"

186+ responseStatus `shouldBe` Status 400 "bob not found"

162

187

163 it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do

188 it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do

164− runEitherT (getQueryParams [] host) `shouldReturn` Right []

189+ (Arrow.left show <$> runEitherT (getQueryParams [] host)) `shouldReturn` Right []

165− runEitherT (getQueryParams ["alice", "bob"] host)

190+ (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"] host))

166 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]

191 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]

167

192

168 context "Servant.API.QueryParam.QueryFlag" $

193 context "Servant.API.QueryParam.QueryFlag" $

169 forM_ [False, True] $ \ flag ->

194 forM_ [False, True] $ \ flag ->

170 it (show flag) $ withServer $ \ host -> do

195 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

172

197

173−{-

174 it "Servant.API.MatrixParam" $ withServer $ \ host -> do

198 it "Servant.API.MatrixParam" $ withServer $ \ host -> do

175− runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice

199+ Arrow.left show <$> runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice

176− Left result <- runEitherT (getMatrixParam (Just "bob") host)

200+ Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob") host)

177− result `shouldContain` "bob not found"

201+ responseStatus `shouldBe` Status 400 "bob not found"

178

202

179 it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do

203 it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do

180− runEitherT (getMatrixParams [] host) `shouldReturn` Right []

204+ Arrow.left show <$> runEitherT (getMatrixParams [] host) `shouldReturn` Right []

181− runEitherT (getMatrixParams ["alice", "bob"] host)

205+ Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"] host)

182 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]

206 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]

183

207

184 context "Servant.API.MatrixParam.MatrixFlag" $

208 context "Servant.API.MatrixParam.MatrixFlag" $

185 forM_ [False, True] $ \ flag ->

209 forM_ [False, True] $ \ flag ->

186 it (show flag) $ withServer $ \ host -> do

210 it (show flag) $ withServer $ \ host -> do

187− runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag

211+ Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag

188−-}

189

212

190 it "Servant.API.Raw on success" $ withServer $ \ host -> do

213 it "Servant.API.Raw on success" $ withServer $ \ host -> do

214+ (Arrow.left show <$> runEitherT (getRawSuccess methodGet host))

191− runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")

215+ `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")

192

216

193 it "Servant.API.Raw on failure" $ withServer $ \ host -> do

217 it "Servant.API.Raw on failure" $ withServer $ \ host -> do

218+ (Arrow.left show <$> runEitherT (getRawFailure methodGet host))

194− runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")

219+ `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")

195

220

196 modifyMaxSuccess (const 20) $ do

221 modifyMaxSuccess (const 20) $ do

197 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $

222 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $

198 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->

223 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->

199 ioProperty $ do

224 ioProperty $ do

200 withServer $ \ host -> do

225 withServer $ \ host -> do

201− result <- runEitherT (getMultiple cap num flag body host)

226+ result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body host)

202 return $

227 return $

203 result === Right (cap, num, flag, body)

228 result === Right (cap, num, flag, body)

204

229

@@ -209,20 +234,52 @@ spec = do

209 it desc $

234 it desc $

210 withWaiDaemon (return (serve api (left (500, "error message")))) $

235 withWaiDaemon (return (serve api (left (500, "error message")))) $

211 \ host -> do

236 \ host -> do

212− let getResponse :: BaseUrl -> EitherT String IO ()

237+ let getResponse :: BaseUrl -> EitherT ServantError IO ()

213 getResponse = client api

238 getResponse = client api

214− Left result <- runEitherT (getResponse host)

239+ Left FailureResponse{..} <- runEitherT (getResponse host)

215− result `shouldContain` "error message"

240+ responseStatus `shouldBe` (Status 500 "error message")

216 mapM_ test $

241 mapM_ test $

217 (WrappedApi (Proxy :: Proxy Delete), "Delete") :

242 (WrappedApi (Proxy :: Proxy Delete), "Delete") :

218− (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") :

243+ (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :

219− (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Delete") :

244+ (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :

220− (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Delete") :

245+ (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :

221 []

246 []

222

247

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+

223data WrappedApi where

280data WrappedApi where

224 WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,

281 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 ())) =>

226 Proxy api -> WrappedApi

283 Proxy api -> WrappedApi

227

284

228

285