f5dd4bf · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

changes to fix tests for baseurl changes

f5dd4bfBrandon Martin11 years ago

servant-client/servant-client.cabal+1

compare with master

unifiedsplit

@@ -85,3 +85,4 @@ test-suite spec

85 , text

86 , wai

87 , warp

88+ , transformers

servant-client/src/Servant/Client.hs+16−16

@@ -61,7 +61,7 @@ client p = clientWithRoute p defReq

61-- influences the creation of an HTTP request. It's mostly

62-- an internal class, you can just use 'client'.

63class HasClient layout where

64− type Client layout :: *

64+ type Client' layout :: *

65 clientWithRoute :: Proxy layout -> Req -> Client layout

67type Client layout = Client' layout

@@ -107,7 +107,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where

107instance (KnownSymbol capture, ToText a, HasClient sublayout)

108 => HasClient (Capture capture a :> sublayout) where

109

110− type Client (Capture capture a :> sublayout) =

110+ type Client' (Capture capture a :> sublayout) =

111 a -> Client sublayout

112

113 clientWithRoute Proxy req baseurl val =

@@ -188,7 +188,7 @@ instance

188#endif

189 ( MimeUnrender ct a, BuildHeadersTo ls

190 ) => HasClient (Get (ct ': cts) (Headers ls a)) where

191− type Client (Get (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

191+ type Client' (Get (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

192 clientWithRoute Proxy req baseurl = do

193 (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl

194 return $ Headers { getResponse = resp

@@ -223,7 +223,7 @@ instance

223instance (KnownSymbol sym, ToText a, HasClient sublayout)

224 => HasClient (Header sym a :> sublayout) where

225

226− type Client (Header sym a :> sublayout) =

226+ type Client' (Header sym a :> sublayout) =

227 Maybe a -> Client sublayout

228

229 clientWithRoute Proxy req baseurl mval =

@@ -268,7 +268,7 @@ instance

268#endif

269 ( MimeUnrender ct a, BuildHeadersTo ls

270 ) => HasClient (Post (ct ': cts) (Headers ls a)) where

271− type Client (Post (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

271+ type Client' (Post (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

272 clientWithRoute Proxy req baseurl = do

273 (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl

274 return $ Headers { getResponse = resp

@@ -307,7 +307,7 @@ instance

307#endif

308 ( MimeUnrender ct a, BuildHeadersTo ls

309 ) => HasClient (Put (ct ': cts) (Headers ls a)) where

310− type Client (Put (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

310+ type Client' (Put (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

311 clientWithRoute Proxy req baseurl = do

312 (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl

313 return $ Headers { getResponse = resp

@@ -346,7 +346,7 @@ instance

346#endif

347 ( MimeUnrender ct a, BuildHeadersTo ls

348 ) => HasClient (Patch (ct ': cts) (Headers ls a)) where

349− type Client (Patch (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

349+ type Client' (Patch (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)

350 clientWithRoute Proxy req baseurl = do

351 (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl

352 return $ Headers { getResponse = resp

@@ -381,7 +381,7 @@ instance

381instance (KnownSymbol sym, ToText a, HasClient sublayout)

382 => HasClient (QueryParam sym a :> sublayout) where

383

384− type Client (QueryParam sym a :> sublayout) =

384+ type Client' (QueryParam sym a :> sublayout) =

385 Maybe a -> Client sublayout

386

387 -- if mparam = Nothing, we don't add it to the query string

@@ -427,7 +427,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

427instance (KnownSymbol sym, ToText a, HasClient sublayout)

428 => HasClient (QueryParams sym a :> sublayout) where

429

430− type Client (QueryParams sym a :> sublayout) =

430+ type Client' (QueryParams sym a :> sublayout) =

431 [a] -> Client sublayout

432

433 clientWithRoute Proxy req baseurl paramlist =

@@ -466,7 +466,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

466instance (KnownSymbol sym, HasClient sublayout)

467 => HasClient (QueryFlag sym :> sublayout) where

468

469− type Client (QueryFlag sym :> sublayout) =

469+ type Client' (QueryFlag sym :> sublayout) =

470 Bool -> Client sublayout

471

472 clientWithRoute Proxy req baseurl flag =

@@ -507,7 +507,7 @@ instance (KnownSymbol sym, HasClient sublayout)

507instance (KnownSymbol sym, ToText a, HasClient sublayout)

508 => HasClient (MatrixParam sym a :> sublayout) where

509

510− type Client (MatrixParam sym a :> sublayout) =

510+ type Client' (MatrixParam sym a :> sublayout) =

511 Maybe a -> Client sublayout

512

513 -- if mparam = Nothing, we don't add it to the query string

@@ -552,7 +552,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

552instance (KnownSymbol sym, ToText a, HasClient sublayout)

553 => HasClient (MatrixParams sym a :> sublayout) where

554

555− type Client (MatrixParams sym a :> sublayout) =

555+ type Client' (MatrixParams sym a :> sublayout) =

556 [a] -> Client sublayout

557

558 clientWithRoute Proxy req baseurl paramlist =

@@ -591,7 +591,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

591instance (KnownSymbol sym, HasClient sublayout)

592 => HasClient (MatrixFlag sym :> sublayout) where

593

594− type Client (MatrixFlag sym :> sublayout) =

594+ type Client' (MatrixFlag sym :> sublayout) =

595 Bool -> Client sublayout

596

597 clientWithRoute Proxy req baseurl flag =

@@ -607,7 +607,7 @@ instance (KnownSymbol sym, HasClient sublayout)

607-- | Pick a 'Method' and specify where the server you want to query is. You get

608-- back the full `Response`.

609instance HasClient Raw where

610− type Client Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

610+ type Client' Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

611

612 clientWithRoute :: Proxy Raw -> Req -> Client Raw

613 clientWithRoute Proxy req httpMethod baseurl = do

@@ -634,7 +634,7 @@ instance HasClient Raw where

634instance (MimeRender ct a, HasClient sublayout)

635 => HasClient (ReqBody (ct ': cts) a :> sublayout) where

636

637− type Client (ReqBody (ct ': cts) a :> sublayout) =

637+ type Client' (ReqBody (ct ': cts) a :> sublayout) =

638 a -> Client sublayout

639

640 clientWithRoute Proxy req baseurl body =

@@ -648,7 +648,7 @@ instance (MimeRender ct a, HasClient sublayout)

648

649-- | Make the querying function append @path@ to the request path.

650instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where

651− type Client (path :> sublayout) = Client sublayout

651+ type Client' (path :> sublayout) = Client sublayout

652

653 clientWithRoute Proxy req baseurl =

654 clientWithRoute (Proxy :: Proxy sublayout)

servant-client/test/Servant/ClientSpec.hs+169−163

@@ -9,6 +9,7 @@

9{-# LANGUAGE TypeOperators #-}

10{-# OPTIONS_GHC -fcontext-stack=100 #-}

11{-# OPTIONS_GHC -fno-warn-orphans #-}

12+

12module Servant.ClientSpec where

13module Servant.ClientSpec where

14#if !MIN_VERSION_base(4,8,0)

15#if !MIN_VERSION_base(4,8,0)

@@ -129,44 +130,9 @@ server = serve api (

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

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

130withServer action = withWaiDaemon (return server) action

131withServer action = withWaiDaemon (return server) action

131

132

132−getGet :: BaseUrl -> EitherT ServantError IO Person

133−getDelete :: BaseUrl -> EitherT ServantError IO ()

134−getDeleteString :: BaseUrl -> EitherT ServantError IO String

135−getCapture :: String -> BaseUrl -> EitherT ServantError IO Person

136−getBody :: Person -> BaseUrl -> EitherT ServantError IO Person

137−getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person

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

139−getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool

140−getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person

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

142−getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool

143−getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString,

144− MediaType, [HTTP.Header], C.Response ByteString)

145−getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString,

146− MediaType, [HTTP.Header], C.Response ByteString)

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

148− -> BaseUrl

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

150−getRespHeaders :: BaseUrl -> EitherT ServantError IO (Headers TestHeaders Bool)

151−( getGet

152− :<|> getDelete

153− :<|> getDeleteString

154− :<|> getCapture

155− :<|> getBody

156− :<|> getQueryParam

157− :<|> getQueryParams

158− :<|> getQueryFlag

159− :<|> getMatrixParam

160− :<|> getMatrixParams

161− :<|> getMatrixFlag

162− :<|> getRawSuccess

163− :<|> getRawFailure

164− :<|> getMultiple

165− :<|> getRespHeaders)

166− = client api

167−

168type FailApi =

133type FailApi =

169 "get" :> Raw

134 "get" :> Raw

135+ :<|> "delete" :> Raw

170 :<|> "capture" :> Capture "name" String :> Raw

136 :<|> "capture" :> Capture "name" String :> Raw

171 :<|> "body" :> Raw

137 :<|> "body" :> Raw

172failApi :: Proxy FailApi

138failApi :: Proxy FailApi

@@ -175,6 +141,7 @@ failApi = Proxy

175failServer :: Application

141failServer :: Application

176failServer = serve failApi (

142failServer = serve failApi (

177 (\ _request respond -> respond $ responseLBS ok200 [] "")

143 (\ _request respond -> respond $ responseLBS ok200 [] "")

144+ :<|> (\ _request respond -> respond $ responseLBS ok200 [] "")

178 :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")

145 :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")

179 :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")

146 :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")

180 )

147 )

@@ -182,141 +149,180 @@ failServer = serve failApi (

182withFailServer :: (BaseUrl -> IO a) -> IO a

149withFailServer :: (BaseUrl -> IO a) -> IO a

183withFailServer action = withWaiDaemon (return failServer) action

150withFailServer action = withWaiDaemon (return failServer) action

184

151

185−spec :: Spec

152+spec :: IO ()

186−spec = do

153+spec = withServer $ \ baseUrl -> do

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

154+ let getGet :: EitherT ServantError IO Person

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

155+ getDelete :: EitherT ServantError IO ()

189−

156+ getCapture :: String -> EitherT ServantError IO Person

190− context "Servant.API.Delete" $ do

157+ getBody :: Person -> EitherT ServantError IO Person

191− it "return no body" $ withServer $ \ host -> do

158+ getQueryParam :: Maybe String -> EitherT ServantError IO Person

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

160+ getQueryFlag :: Bool -> EitherT ServantError IO Bool

161+ getMatrixParam :: Maybe String -> EitherT ServantError IO Person

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

163+ getMatrixFlag :: Bool -> EitherT ServantError IO Bool

164+ getRawSuccess :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)

165+ getRawFailure :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)

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

167+ getRespHeaders :: EitherT ServantError IO (Headers TestHeaders Bool)

168+ ( getGet

169+ :<|> getDelete

170+ :<|> getCapture

171+ :<|> getBody

172+ :<|> getQueryParam

173+ :<|> getQueryParams

174+ :<|> getQueryFlag

175+ :<|> getMatrixParam

176+ :<|> getMatrixParams

177+ :<|> getMatrixFlag

178+ :<|> getRawSuccess

179+ :<|> getRawFailure

180+ :<|> getMultiple

181+ :<|> getRespHeaders)

182+ = client api baseUrl

183+

184+ hspec $ do

185+ it "Servant.API.Get" $ do

192− (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()

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

193−

187+

194− it "return body" $ withServer $ \ host -> do

188+ it "Servant.API.Delete" $ do

195− (Arrow.left show <$> runEitherT (getDeleteString host)) `shouldReturn` Right "ok"

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

196−

190+

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

191+ it "Servant.API.Capture" $ do

198− (Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0)

192+ (Arrow.left show <$> runEitherT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)

199−

193+

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

194+ it "Servant.API.ReqBody" $ do

201− let p = Person "Clara" 42

195+ let p = Person "Clara" 42

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

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

203−

197+

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

198+ it "Servant.API.QueryParam" $ do

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

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

206− Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob") host)

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

207− responseStatus `shouldBe` Status 400 "bob not found"

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

208−

202+

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

203+ it "Servant.API.QueryParam.QueryParams" $ do

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

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

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

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

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

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

213−

207+

214− context "Servant.API.QueryParam.QueryFlag" $

208+ context "Servant.API.QueryParam.QueryFlag" $

215− forM_ [False, True] $ \ flag ->

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

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

210+ it (show flag) $ do

217− (Arrow.left show <$> runEitherT (getQueryFlag flag host)) `shouldReturn` Right flag

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

218−

212+

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

213+ it "Servant.API.MatrixParam" $ do

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

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

221− Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob") host)

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

222− responseStatus `shouldBe` Status 400 "bob not found"

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

223−

217+

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

218+ it "Servant.API.MatrixParam.MatrixParams" $ do

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

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

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

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

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

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

228−

222+

229− context "Servant.API.MatrixParam.MatrixFlag" $

223+ context "Servant.API.MatrixParam.MatrixFlag" $

230− forM_ [False, True] $ \ flag ->

224+ forM_ [False, True] $ \ flag ->

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

225+ it (show flag) $ do

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

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

233−

227+

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

228+ it "Servant.API.Raw on success" $ do

235− res <- runEitherT (getRawSuccess methodGet host)

229+ res <- runEitherT (getRawSuccess methodGet)

236− case res of

237− Left e -> assertFailure $ show e

238− Right (code, body, ct, _, response) -> do

239− (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")

240− C.responseBody response `shouldBe` body

241− C.responseStatus response `shouldBe` ok200

242−

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

244− res <- runEitherT (getRawFailure methodGet host)

245− case res of

246− Left e -> assertFailure $ show e

247− Right (code, body, ct, _, response) -> do

248− (code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream")

249− C.responseBody response `shouldBe` body

250− C.responseStatus response `shouldBe` badRequest400

251−

252− it "Returns headers appropriately" $ withServer $ \ host -> do

253− res <- runEitherT (getRespHeaders host)

254− case res of

255− Left e -> assertFailure $ show e

256− Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

257−

258− modifyMaxSuccess (const 20) $ do

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

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

261− ioProperty $ do

262− withServer $ \ host -> do

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

264− return $

265− result === Right (cap, num, flag, body)

266−

267−

268− context "client correctly handles error status codes" $ do

269− let test :: (WrappedApi, String) -> Spec

270− test (WrappedApi api, desc) =

271− it desc $

272− withWaiDaemon (return (serve api (left $ ServantErr 500 "error message" "" []))) $

273− \ host -> do

274− let getResponse :: BaseUrl -> EitherT ServantError IO ()

275− getResponse = client api

276− Left FailureResponse{..} <- runEitherT (getResponse host)

277− responseStatus `shouldBe` (Status 500 "error message")

278− mapM_ test $

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

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

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

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

283− []

284−

285− context "client returns errors appropriately" $ do

286− it "reports FailureResponse" $ withFailServer $ \ host -> do

287− Left res <- runEitherT (getDelete host)

288 case res of

230 case res of

289− FailureResponse (Status 404 "Not Found") _ _ -> return ()

231+ Left e -> assertFailure $ show e

290− _ -> fail $ "expected 404 response, but got " <> show res

232+ Right (code, body, ct, _, response) -> do

291−

233+ (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")

292− it "reports DecodeFailure" $ withFailServer $ \ host -> do

234+ C.responseBody response `shouldBe` body

293− Left res <- runEitherT (getCapture "foo" host)

235+ C.responseStatus response `shouldBe` ok200

236+

237+ it "Servant.API.Raw on failure" $ do

238+ res <- runEitherT (getRawFailure methodGet)

294 case res of

239 case res of

295− DecodeFailure _ ("application/json") _ -> return ()

240+ Left e -> assertFailure $ show e

296− _ -> fail $ "expected DecodeFailure, but got " <> show res

241+ Right (code, body, ct, _, response) -> do

297−

242+ (code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream")

298− it "reports ConnectionError" $ do

243+ C.responseBody response `shouldBe` body

299− Right host <- return $ parseBaseUrl "127.0.0.1:987654"

244+ C.responseStatus response `shouldBe` badRequest400

245+

246+ it "Returns headers appropriately" $ withServer $ \ _ -> do

300− Left res <- runEitherT (getGet host)

247+ res <- runEitherT getRespHeaders

301 case res of

248 case res of

302− ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()

249+ Left e -> assertFailure $ show e

303− _ -> fail $ "expected ConnectionError, but got " <> show res

250+ Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

251+

252+ modifyMaxSuccess (const 20) $ do

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

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

255+ ioProperty $ do

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

257+ return $

258+ result === Right (cap, num, flag, body)

304

259

305− it "reports UnsupportedContentType" $ withFailServer $ \ host -> do

306− Left res <- runEitherT (getGet host)

307− case res of

308− UnsupportedContentType ("application/octet-stream") _ -> return ()

309− _ -> fail $ "expected UnsupportedContentType, but got " <> show res

310

260

311− it "reports InvalidContentTypeHeader" $ withFailServer $ \ host -> do

261+ context "client correctly handles error status codes" $ do

262+ let test :: (WrappedApi, String) -> Spec

263+ test (WrappedApi api, desc) =

264+ it desc $

265+ withWaiDaemon (return (serve api (left $ ServantErr 500 "error message" "" []))) $

266+ \ host -> do

267+ let getResponse :: EitherT ServantError IO ()

268+ getResponse = client api host

269+ Left FailureResponse{..} <- runEitherT getResponse

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

271+ mapM_ test $

272+ (WrappedApi (Proxy :: Proxy Delete), "Delete") :

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

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

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

276+ []

277+

278+failSpec :: IO ()

279+failSpec = withFailServer $ \ baseUrl -> do

280+ let getGet :: EitherT ServantError IO Person

281+ getDelete :: EitherT ServantError IO ()

282+ getCapture :: String -> EitherT ServantError IO Person

283+ getBody :: Person -> EitherT ServantError IO Person

284+ ( getGet

285+ :<|> getDelete

286+ :<|> getCapture

287+ :<|> getBody)

288+ = client failApi baseUrl

289+

290+ hspec $ do

291+ context "client returns errors appropriately" $ do

292+ it "reports FailureResponse" $ do

293+ Left res <- runEitherT getDelete

294+ case res of

295+ FailureResponse (Status 404 "Not Found") _ _ -> return ()

296+ _ -> fail $ "expected 404 response, but got " <> show res

297+

298+ it "reports DecodeFailure" $ do

299+ Left res <- runEitherT (getCapture "foo")

300+ case res of

301+ DecodeFailure _ ("application/json") _ -> return ()

302+ _ -> fail $ "expected DecodeFailure, but got " <> show res

303+

304+ it "reports ConnectionError" $ do

305+ Right _ <- return $ parseBaseUrl "127.0.0.1:987654"

306+ Left res <- runEitherT getGet

307+ case res of

308+ ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()

309+ _ -> fail $ "expected ConnectionError, but got " <> show res

310+

311+ it "reports UnsupportedContentType" $ do

312+ Left res <- runEitherT getGet

313+ case res of

314+ UnsupportedContentType ("application/octet-stream") _ -> return ()

315+ _ -> fail $ "expected UnsupportedContentType, but got " <> show res

316+

317+ it "reports InvalidContentTypeHeader" $ do

312− Left res <- runEitherT (getBody alice host)

318+ Left res <- runEitherT (getBody alice)

313− case res of

319+ case res of

314− InvalidContentTypeHeader "fooooo" _ -> return ()

320+ InvalidContentTypeHeader "fooooo" _ -> return ()

315− _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res

321+ _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res

316

322

317data WrappedApi where

323data WrappedApi where

318 WrappedApi :: (HasServer api, Server api ~ EitherT ServantErr IO a,

324 WrappedApi :: (HasServer api, Server api ~ EitherT ServantErr IO a,

319− HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>

325+ HasClient api, Client' api ~ EitherT ServantError IO ()) =>

320 Proxy api -> WrappedApi

326 Proxy api -> WrappedApi

321

327

322

328

servant-client/test/Spec.hs+7−1

@@ -1 +1,7 @@

1−{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

1+import Servant.ClientSpec (spec, failSpec)

3+main :: IO ()

4+main = do

5+ spec

6+ failSpec