9e1ba92 · typeable/servant

git.iko.soy/typeable/servant

Manager and BaseUrl are now explicit parameters of all client functions, instead of ReaderTs

commit9e1ba9221d980353d86fc836f7efc673ecc2329a authormbg <michael.gale@cl.cam.ac.uk> dateWed 30 Mar 2016, 22:41 (11 years ago) parent41129e9

3 files changed+93−121

compare with master

unifiedsplit

servant-client/src/Servant/Client.hs+26−24 servant-client/src/Servant/Common/Req.hs+14−25 servant-client/test/Servant/ClientSpec.hs+53−72

servant-client/src/Servant/Client.hs+26−24

@@ -33,7 +33,7 @@ import Data.Proxy

3333import Data.String.Conversions

3434import Data.Text (unpack)

3535import GHC.TypeLits

36−import Network.HTTP.Client (Response)

36+import Network.HTTP.Client (Manager, Response)

3737import Network.HTTP.Media

3838import qualified Network.HTTP.Types as H

3939import qualified Network.HTTP.Types.Header as HTTP

@@ -53,8 +53,8 @@ import Servant.Common.Req

5353-- > myApi :: Proxy MyApi

5454-- > myApi = Proxy

5555-- >

56−-- > getAllBooks :: ClientM [Book]

57−-- > postNewBook :: Book -> ClientM Book

56+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]

57+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book

5858-- > (getAllBooks :<|> postNewBook) = client myApi

5959client :: HasClient layout => Proxy layout -> Client layout

6060client p = clientWithRoute p defReq

@@ -77,8 +77,8 @@ class HasClient layout where

7777-- > myApi :: Proxy MyApi

7878-- > myApi = Proxy

7979-- >

80−-- > getAllBooks :: ClientM [Book]

81−-- > postNewBook :: Book -> ClientM Book

80+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]

81+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book

8282-- > (getAllBooks :<|> postNewBook) = client myApi

8383instance (HasClient a, HasClient b) => HasClient (a :<|> b) where

8484 type Client (a :<|> b) = Client a :<|> Client b

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

102102-- > myApi :: Proxy MyApi

103103-- > myApi = Proxy

104104-- >

105−-- > getBook :: Text -> ClientM Book

105+-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book

106106-- > getBook = client myApi

107107-- > -- then you can just use "getBook" to query that endpoint

108108instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)

@@ -121,26 +121,28 @@ instance OVERLAPPABLE_

121121 -- Note [Non-Empty Content Types]

122122 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

123123 ) => HasClient (Verb method status cts' a) where

124− type Client (Verb method status cts' a) = ClientM a

125− clientWithRoute Proxy req =

126− snd <$> performRequestCT (Proxy :: Proxy ct) method req

124+ type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a

125+ clientWithRoute Proxy req manager baseurl =

126+ snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl

127127 where method = reflectMethod (Proxy :: Proxy method)

128128

129129instance OVERLAPPING_

130130 (ReflectMethod method) => HasClient (Verb method status cts NoContent) where

131− type Client (Verb method status cts NoContent) = ClientM NoContent

132− clientWithRoute Proxy req =

133− performRequestNoBody method req >> return NoContent

131+ type Client (Verb method status cts NoContent)

132+ = Manager -> BaseUrl -> ClientM NoContent

133+ clientWithRoute Proxy req manager baseurl =

134+ performRequestNoBody method req manager baseurl >> return NoContent

134135 where method = reflectMethod (Proxy :: Proxy method)

135136

136137instance OVERLAPPING_

137138 -- Note [Non-Empty Content Types]

138139 ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)

139140 ) => HasClient (Verb method status cts' (Headers ls a)) where

140− type Client (Verb method status cts' (Headers ls a)) = ClientM (Headers ls a)

141− clientWithRoute Proxy req = do

141+ type Client (Verb method status cts' (Headers ls a))

142+ = Manager -> BaseUrl -> ClientM (Headers ls a)

143+ clientWithRoute Proxy req manager baseurl = do

142144 let method = reflectMethod (Proxy :: Proxy method)

143− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req

145+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl

144146 return $ Headers { getResponse = resp

145147 , getHeadersHList = buildHeadersTo hdrs

146148 }

@@ -149,10 +151,10 @@ instance OVERLAPPING_

149151 ( BuildHeadersTo ls, ReflectMethod method

150152 ) => HasClient (Verb method status cts (Headers ls NoContent)) where

151153 type Client (Verb method status cts (Headers ls NoContent))

152− = ClientM (Headers ls NoContent)

153− clientWithRoute Proxy req = do

154+ = Manager -> BaseUrl -> ClientM (Headers ls NoContent)

155+ clientWithRoute Proxy req manager baseurl = do

154156 let method = reflectMethod (Proxy :: Proxy method)

155− hdrs <- performRequestNoBody method req

157+ hdrs <- performRequestNoBody method req manager baseurl

156158 return $ Headers { getResponse = NoContent

157159 , getHeadersHList = buildHeadersTo hdrs

158160 }

@@ -179,7 +181,7 @@ instance OVERLAPPING_

179181-- > myApi :: Proxy MyApi

180182-- > myApi = Proxy

181183-- >

182−-- > viewReferer :: Maybe Referer -> ClientM Book

184+-- > viewReferer :: Maybe Referer -> Manager -> BaseUrl -> ClientM Book

183185-- > viewReferer = client myApi

184186-- > -- then you can just use "viewRefer" to query that endpoint

185187-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments

@@ -229,7 +231,7 @@ instance HasClient sublayout

229231-- > myApi :: Proxy MyApi

230232-- > myApi = Proxy

231233-- >

232−-- > getBooksBy :: Maybe Text -> ClientM [Book]

234+-- > getBooksBy :: Maybe Text -> Manager -> BaseUrl -> ClientM [Book]

233235-- > getBooksBy = client myApi

234236-- > -- then you can just use "getBooksBy" to query that endpoint.

235237-- > -- 'getBooksBy Nothing' for all books

@@ -273,7 +275,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)

273275-- > myApi :: Proxy MyApi

274276-- > myApi = Proxy

275277-- >

276−-- > getBooksBy :: [Text] -> ClientM [Book]

278+-- > getBooksBy :: [Text] -> Manager -> BaseUrl -> ClientM [Book]

277279-- > getBooksBy = client myApi

278280-- > -- then you can just use "getBooksBy" to query that endpoint.

279281-- > -- 'getBooksBy []' for all books

@@ -312,7 +314,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)

312314-- > myApi :: Proxy MyApi

313315-- > myApi = Proxy

314316-- >

315−-- > getBooks :: Bool -> ClientM [Book]

317+-- > getBooks :: Bool -> Manager -> BaseUrl -> ClientM [Book]

316318-- > getBooks = client myApi

317319-- > -- then you can just use "getBooks" to query that endpoint.

318320-- > -- 'getBooksBy False' for all books

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

337339-- back the full `Response`.

338340instance HasClient Raw where

339341 type Client Raw

340− = H.Method -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

342+ = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

341343

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

343345 clientWithRoute Proxy req httpMethod = do

@@ -358,7 +360,7 @@ instance HasClient Raw where

358360-- > myApi :: Proxy MyApi

359361-- > myApi = Proxy

360362-- >

361−-- > addBook :: Book -> ClientM Book

363+-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book

362364-- > addBook = client myApi

363365-- > -- then you can just use "addBook" to query that endpoint

364366instance (MimeRender ct a, HasClient sublayout)

servant-client/src/Servant/Common/Req.hs+14−25

@@ -11,9 +11,7 @@ import Control.Exception

1111import Control.Monad

1212import Control.Monad.Catch (MonadThrow)

1313import Control.Monad.IO.Class

14−import Control.Monad.Trans.Class

1514import Control.Monad.Trans.Except

16−import Control.Monad.Trans.Reader

1715import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)

1816import Data.String

1917import Data.String.Conversions

@@ -125,21 +123,12 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =

125123displayHttpRequest :: Method -> String

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

127125

128−type ClientM = ReaderT BaseUrl (ReaderT Manager (ExceptT ServantError IO))

126+type ClientM = ExceptT ServantError IO

129127

130−runClientM :: ClientM a -> BaseUrl -> Manager -> IO (Either ServantError a)

131−runClientM m baseUrl manager = runExceptT (runReaderT (runReaderT m baseUrl) manager)

132−

133−-- to avoid adding a dependency on mtl

134−throwError :: ServantError -> ClientM a

135−throwError = lift . lift . throwE

136−

137−performRequest :: Method -> Req

128+performRequest :: Method -> Req -> Manager -> BaseUrl

138129 -> ClientM ( Int, ByteString, MediaType

139130 , [HTTP.Header], Response ByteString)

140−performRequest reqMethod req = do

141− reqHost <- ask

142− manager <- lift ask

131+performRequest reqMethod req manager reqHost = do

143132 partialRequest <- liftIO $ reqToRequest req reqHost

144133

145134 let request = partialRequest { Client.method = reqMethod

@@ -149,7 +138,7 @@ performRequest reqMethod req = do

149138 eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager

150139 case eResponse of

151140 Left err ->

152− throwError . ConnectionError $ SomeException err

141+ throwE . ConnectionError $ SomeException err

153142

154143 Right response -> do

155144 let status = Client.responseStatus response

@@ -159,29 +148,29 @@ performRequest reqMethod req = do

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

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

161150 Just t -> case parseAccept t of

162− Nothing -> throwError $ InvalidContentTypeHeader (cs t) body

151+ Nothing -> throwE $ InvalidContentTypeHeader (cs t) body

163152 Just t' -> pure t'

164153 unless (status_code >= 200 && status_code < 300) $

165− throwError $ FailureResponse status ct body

154+ throwE $ FailureResponse status ct body

166155 return (status_code, body, ct, hdrs, response)

167156

168157

169158performRequestCT :: MimeUnrender ct result =>

170− Proxy ct -> Method -> Req

159+ Proxy ct -> Method -> Req -> Manager -> BaseUrl

171160 -> ClientM ([HTTP.Header], result)

172−performRequestCT ct reqMethod req = do

161+performRequestCT ct reqMethod req manager reqHost = do

173162 let acceptCT = contentType ct

174163 (_status, respBody, respCT, hdrs, _response) <-

175− performRequest reqMethod (req { reqAccept = [acceptCT] })

176− unless (matches respCT (acceptCT)) $ throwError $ UnsupportedContentType respCT respBody

164+ performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost

165+ unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody

177166 case mimeUnrender ct respBody of

178− Left err -> throwError $ DecodeFailure err respCT respBody

167+ Left err -> throwE $ DecodeFailure err respCT respBody

179168 Right val -> return (hdrs, val)

180169

181−performRequestNoBody :: Method -> Req

170+performRequestNoBody :: Method -> Req -> Manager -> BaseUrl

182171 -> ClientM [HTTP.Header]

183−performRequestNoBody reqMethod req = do

184− (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req

172+performRequestNoBody reqMethod req manager reqHost = do

173+ (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost

185174 return hdrs

186175

187176catchConnectionError :: IO a -> IO (Either ServantError a)

servant-client/test/Servant/ClientSpec.hs+53−72

@@ -28,7 +28,7 @@ import Control.Applicative ((<$>))

2828import Control.Arrow (left)

2929import Control.Concurrent (forkIO, killThread, ThreadId)

3030import Control.Exception (bracket)

31−import Control.Monad.Trans.Except (ExceptT, throwE)

31+import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)

3232import Data.Aeson

3333import qualified Data.ByteString.Lazy as BS

3434import Data.Char (chr, isPrint)

@@ -119,52 +119,33 @@ type Api =

119119api :: Proxy Api

120120api = Proxy

121121

122−getGet :: SCR.ClientM Person

123−getDeleteEmpty :: SCR.ClientM NoContent

124−getCapture :: String

125− -> SCR.ClientM Person

126−getBody :: Person

127− -> SCR.ClientM Person

128−getQueryParam :: Maybe String

129− -> SCR.ClientM Person

130−getQueryParams :: [String]

131− -> SCR.ClientM [Person]

132−getQueryFlag :: Bool

133− -> SCR.ClientM Bool

134−getRawSuccess :: HTTP.Method

135− -> SCR.ClientM ( Int

136− , BS.ByteString

137− , MediaType

138− , [HTTP.Header]

139− , C.Response BS.ByteString )

140−getRawFailure :: HTTP.Method

141− -> SCR.ClientM ( Int

142− , BS.ByteString

143− , MediaType

144− , [HTTP.Header]

145− , C.Response BS.ByteString )

146−getMultiple :: String

147− -> Maybe Int

148− -> Bool

149− -> [(String, [Rational])]

150− -> SCR.ClientM ( String

151− , Maybe Int

152− , Bool

153− , [(String, [Rational])] )

154−getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)

155−getDeleteContentType :: SCR.ClientM NoContent

122+getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person

123+getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent

124+getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person

125+getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person

126+getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person

127+getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]

128+getQueryFlag :: Bool -> C.Manager -> BaseUrl -> SCR.ClientM Bool

129+getRawSuccess :: HTTP.Method -> C.Manager -> BaseUrl

130+ -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)

131+getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl

132+ -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)

133+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl

134+ -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])

135+getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool)

136+getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent

156137getGet

157− :<|> getDeleteEmpty

158− :<|> getCapture

159− :<|> getBody

160− :<|> getQueryParam

161− :<|> getQueryParams

162− :<|> getQueryFlag

163− :<|> getRawSuccess

164− :<|> getRawFailure

165− :<|> getMultiple

166− :<|> getRespHeaders

167− :<|> getDeleteContentType = client api

138+ :<|> getDeleteEmpty

139+ :<|> getCapture

140+ :<|> getBody

141+ :<|> getQueryParam

142+ :<|> getQueryParams

143+ :<|> getQueryFlag

144+ :<|> getRawSuccess

145+ :<|> getRawFailure

146+ :<|> getMultiple

147+ :<|> getRespHeaders

148+ :<|> getDeleteContentType = client api

168149

169150server :: Application

170151server = serve api (

@@ -254,38 +235,38 @@ sucessSpec :: Spec

254235sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

255236

256237 it "Servant.API.Get" $ \(_, baseUrl) -> do

257− (left show <$> SCR.runClientM getGet baseUrl manager) `shouldReturn` Right alice

238+ (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice

258239

259240 describe "Servant.API.Delete" $ do

260241 it "allows empty content type" $ \(_, baseUrl) -> do

261− (left show <$> SCR.runClientM getDeleteEmpty baseUrl manager) `shouldReturn` Right NoContent

242+ (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent

262243

263244 it "allows content type" $ \(_, baseUrl) -> do

264− (left show <$> SCR.runClientM getDeleteContentType baseUrl manager) `shouldReturn` Right NoContent

245+ (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent

265246

266247 it "Servant.API.Capture" $ \(_, baseUrl) -> do

267− (left show <$> SCR.runClientM (getCapture "Paula") baseUrl manager) `shouldReturn` Right (Person "Paula" 0)

248+ (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)

268249

269250 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do

270251 let p = Person "Clara" 42

271− (left show <$> SCR.runClientM (getBody p) baseUrl manager) `shouldReturn` Right p

252+ (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p

272253

273254 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do

274− left show <$> SCR.runClientM (getQueryParam (Just "alice")) baseUrl manager `shouldReturn` Right alice

275− Left FailureResponse{..} <- SCR.runClientM (getQueryParam (Just "bob")) baseUrl manager

255+ left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice

256+ Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)

276257 responseStatus `shouldBe` HTTP.Status 400 "bob not found"

277258

278259 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do

279− (left show <$> SCR.runClientM (getQueryParams []) baseUrl manager) `shouldReturn` Right []

280− (left show <$> SCR.runClientM (getQueryParams ["alice", "bob"]) baseUrl manager)

260+ (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []

261+ (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl))

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

282263

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

284265 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do

285− (left show <$> SCR.runClientM (getQueryFlag flag) baseUrl manager) `shouldReturn` Right flag

266+ (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag

286267

287268 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do

288− res <- SCR.runClientM (getRawSuccess HTTP.methodGet) baseUrl manager

269+ res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl)

289270 case res of

290271 Left e -> assertFailure $ show e

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

@@ -294,7 +275,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

294275 C.responseStatus response `shouldBe` HTTP.ok200

295276

296277 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do

297− res <- SCR.runClientM (getRawFailure HTTP.methodGet) baseUrl manager

278+ res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl)

298279 case res of

299280 Right _ -> assertFailure "expected Left, but got Right"

300281 Left e -> do

@@ -302,7 +283,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

302283 Servant.Client.responseBody e `shouldBe` "rawFailure"

303284

304285 it "Returns headers appropriately" $ \(_, baseUrl) -> do

305− res <- SCR.runClientM getRespHeaders baseUrl manager

286+ res <- runExceptT (getRespHeaders manager baseUrl)

306287 case res of

307288 Left e -> assertFailure $ show e

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

@@ -311,7 +292,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

311292 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->

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

313294 ioProperty $ do

314− result <- left show <$> SCR.runClientM (getMultiple cap num flag body) baseUrl manager

295+ result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl)

315296 return $

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

317298

@@ -323,9 +304,9 @@ wrappedApiSpec = describe "error status codes" $ do

323304 let test :: (WrappedApi, String) -> Spec

324305 test (WrappedApi api, desc) =

325306 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do

326− let getResponse :: SCR.ClientM ()

307+ let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM ()

327308 getResponse = client api

328− Left FailureResponse{..} <- SCR.runClientM getResponse baseUrl manager

309+ Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl)

329310 responseStatus `shouldBe` (HTTP.Status 500 "error message")

330311 in mapM_ test $

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

@@ -340,42 +321,42 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do

340321 context "client returns errors appropriately" $ do

341322 it "reports FailureResponse" $ \(_, baseUrl) -> do

342323 let (_ :<|> getDeleteEmpty :<|> _) = client api

343− Left res <- SCR.runClientM getDeleteEmpty baseUrl manager

324+ Left res <- runExceptT (getDeleteEmpty manager baseUrl)

344325 case res of

345326 FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()

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

347328

348329 it "reports DecodeFailure" $ \(_, baseUrl) -> do

349330 let (_ :<|> _ :<|> getCapture :<|> _) = client api

350− Left res <- SCR.runClientM (getCapture "foo") baseUrl manager

331+ Left res <- runExceptT (getCapture "foo" manager baseUrl)

351332 case res of

352333 DecodeFailure _ ("application/json") _ -> return ()

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

354335

355336 it "reports ConnectionError" $ \_ -> do

356337 let (getGetWrongHost :<|> _) = client api

357− Left res <- SCR.runClientM getGetWrongHost (BaseUrl Http "127.0.0.1" 19872 "") manager

338+ Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 ""))

358339 case res of

359340 ConnectionError _ -> return ()

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

361342

362343 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do

363344 let (getGet :<|> _ ) = client api

364− Left res <- SCR.runClientM getGet baseUrl manager

345+ Left res <- runExceptT (getGet manager baseUrl)

365346 case res of

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

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

368349

369350 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do

370351 let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api

371− Left res <- SCR.runClientM (getBody alice) baseUrl manager

352+ Left res <- runExceptT (getBody alice manager baseUrl)

372353 case res of

373354 InvalidContentTypeHeader "fooooo" _ -> return ()

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

375356

376357data WrappedApi where

377358 WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,

378− HasClient api, Client api ~ SCR.ClientM ()) =>

359+ HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) =>

379360 Proxy api -> WrappedApi

380361

381362basicAuthSpec :: Spec

@@ -385,14 +366,14 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d

385366 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do

386367 let getBasic = client basicAuthAPI

387368 let basicAuthData = BasicAuthData "servant" "server"

388− (left show <$> SCR.runClientM (getBasic basicAuthData) baseUrl manager) `shouldReturn` Right alice

369+ (left show <$> runExceptT (getBasic basicAuthData manager baseUrl)) `shouldReturn` Right alice

389370

390371 context "Authentication is rejected when requests are not authenticated properly" $ do

391372

392373 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do

393374 let getBasic = client basicAuthAPI

394375 let basicAuthData = BasicAuthData "not" "password"

395− Left FailureResponse{..} <- SCR.runClientM (getBasic basicAuthData) baseUrl manager

376+ Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)

396377 responseStatus `shouldBe` HTTP.Status 403 "Forbidden"

397378

398379genAuthSpec :: Spec

@@ -402,14 +383,14 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do

402383 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do

403384 let getProtected = client genAuthAPI

404385 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)

405− (left show <$> SCR.runClientM (getProtected authRequest) baseUrl manager) `shouldReturn` Right alice

386+ (left show <$> runExceptT (getProtected authRequest manager baseUrl)) `shouldReturn` Right alice

406387

407388 context "Authentication is rejected when requests are not authenticated properly" $ do

408389

409390 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do

410391 let getProtected = client genAuthAPI

411392 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)

412− Left FailureResponse{..} <- SCR.runClientM (getProtected authRequest) baseUrl manager

393+ Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)

413394 responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")

414395

415396-- * utils