de447df · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Pass in Manager as argument to 'client'

de447dfJulian K. Arni11 years ago

servant-client/src/Servant/Client.hs+70−69

compare with master

unifiedsplit

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

32import Data.String.Conversions

33import Data.Text (unpack)

34import GHC.TypeLits

35−import Network.HTTP.Client (Response)

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

36import Network.HTTP.Media

37import qualified Network.HTTP.Types as H

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

@@ -52,9 +52,9 @@ import Servant.Common.Req

52-- >

53-- > getAllBooks :: ExceptT String IO [Book]

54-- > postNewBook :: Book -> ExceptT String IO Book

55−-- > (getAllBooks :<|> postNewBook) = client myApi host

55+-- > (getAllBooks :<|> postNewBook) = client myApi host manager

56-- > where host = BaseUrl Http "localhost" 8080

57−client :: HasClient layout => Proxy layout -> BaseUrl -> Client layout

57+client :: HasClient layout => Proxy layout -> BaseUrl -> Manager -> Client layout

58client p baseurl = clientWithRoute p defReq baseurl

60-- | This class lets us define how each API combinator

@@ -62,9 +62,8 @@ client p baseurl = clientWithRoute p defReq baseurl

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

63class HasClient layout where

64 type Client layout :: *

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

65+ clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Manager -> Client layout

67−{-type Client layout = Client layout-}

69-- | A client querying function for @a ':<|>' b@ will actually hand you

68-- | A client querying function for @a ':<|>' b@ will actually hand you

70-- one function for querying @a@ and another one for querying @b@,

69-- one function for querying @a@ and another one for querying @b@,

@@ -78,13 +77,13 @@ class HasClient layout where

78-- >

77-- >

79-- > getAllBooks :: ExceptT String IO [Book]

78-- > getAllBooks :: ExceptT String IO [Book]

80-- > postNewBook :: Book -> ExceptT String IO Book

79-- > postNewBook :: Book -> ExceptT String IO Book

81−-- > (getAllBooks :<|> postNewBook) = client myApi host

80+-- > (getAllBooks :<|> postNewBook) = client myApi host manager

82-- > where host = BaseUrl Http "localhost" 8080

81-- > where host = BaseUrl Http "localhost" 8080

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

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

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

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

85− clientWithRoute Proxy req baseurl =

84+ clientWithRoute Proxy req baseurl manager =

86− clientWithRoute (Proxy :: Proxy a) req baseurl :<|>

85+ clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>

87− clientWithRoute (Proxy :: Proxy b) req baseurl

86+ clientWithRoute (Proxy :: Proxy b) req baseurl manager

89-- | If you use a 'Capture' in one of your endpoints in your API,

88-- | If you use a 'Capture' in one of your endpoints in your API,

90-- the corresponding querying function will automatically take

89-- the corresponding querying function will automatically take

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

103-- > myApi = Proxy

102-- > myApi = Proxy

104-- >

103-- >

105-- > getBook :: Text -> ExceptT String IO Book

104-- > getBook :: Text -> ExceptT String IO Book

106−-- > getBook = client myApi host

105+-- > getBook = client myApi host manager

107-- > where host = BaseUrl Http "localhost" 8080

106-- > where host = BaseUrl Http "localhost" 8080

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

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

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

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

@@ -112,10 +111,11 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)

112 type Client (Capture capture a :> sublayout) =

111 type Client (Capture capture a :> sublayout) =

113 a -> Client sublayout

112 a -> Client sublayout

114

113

115− clientWithRoute Proxy req baseurl val =

114+ clientWithRoute Proxy req baseurl manager val =

116 clientWithRoute (Proxy :: Proxy sublayout)

115 clientWithRoute (Proxy :: Proxy sublayout)

117 (appendToPath p req)

116 (appendToPath p req)

118 baseurl

117 baseurl

118+ manager

119

120 where p = unpack (toText val)

121

@@ -127,11 +127,10 @@ instance

127#if MIN_VERSION_base(4,8,0)

128 {-# OVERLAPPABLE #-}

129#endif

130− -- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances

131 (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where

130 (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where

132 type Client (Delete cts' a) = ExceptT ServantError IO a

131 type Client (Delete cts' a) = ExceptT ServantError IO a

133− clientWithRoute Proxy req baseurl =

132+ clientWithRoute Proxy req baseurl manager =

134− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl

133+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl manager

135

134

136-- | If you have a 'Delete xs ()' endpoint, the client expects a 204 No Content

135-- | If you have a 'Delete xs ()' endpoint, the client expects a 204 No Content

137-- HTTP header.

136-- HTTP header.

@@ -141,8 +140,8 @@ instance

141#endif

140#endif

142 HasClient (Delete cts ()) where

141 HasClient (Delete cts ()) where

143 type Client (Delete cts ()) = ExceptT ServantError IO ()

142 type Client (Delete cts ()) = ExceptT ServantError IO ()

144− clientWithRoute Proxy req baseurl =

143+ clientWithRoute Proxy req baseurl manager =

145− void $ performRequestNoBody H.methodDelete req [204] baseurl

144+ void $ performRequestNoBody H.methodDelete req [204] baseurl manager

146

145

147-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the

146-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the

148-- corresponding headers.

147-- corresponding headers.

@@ -150,12 +149,11 @@ instance

150#if MIN_VERSION_base(4,8,0)

149#if MIN_VERSION_base(4,8,0)

151 {-# OVERLAPPING #-}

150 {-# OVERLAPPING #-}

152#endif

151#endif

153− -- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances

154 ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)

152 ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)

155 ) => HasClient (Delete cts' (Headers ls a)) where

153 ) => HasClient (Delete cts' (Headers ls a)) where

156 type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

154 type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

157− clientWithRoute Proxy req baseurl = do

155+ clientWithRoute Proxy req baseurl manager = do

158− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl

156+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl manager

159 return $ Headers { getResponse = resp

157 return $ Headers { getResponse = resp

160 , getHeadersHList = buildHeadersTo hdrs

158 , getHeadersHList = buildHeadersTo hdrs

161 }

159 }

@@ -170,8 +168,8 @@ instance

170#endif

168#endif

171 (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where

169 (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where

172 type Client (Get (ct ': cts) result) = ExceptT ServantError IO result

170 type Client (Get (ct ': cts) result) = ExceptT ServantError IO result

173− clientWithRoute Proxy req baseurl =

171+ clientWithRoute Proxy req baseurl manager =

174− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl

172+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl manager

175

173

176-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content

174-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content

177-- HTTP status.

175-- HTTP status.

@@ -181,8 +179,8 @@ instance

181#endif

179#endif

182 HasClient (Get (ct ': cts) ()) where

180 HasClient (Get (ct ': cts) ()) where

183 type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()

181 type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()

184− clientWithRoute Proxy req baseurl =

182+ clientWithRoute Proxy req baseurl manager =

185− performRequestNoBody H.methodGet req [204] baseurl

183+ performRequestNoBody H.methodGet req [204] baseurl manager

186

184

187-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the

185-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the

188-- corresponding headers.

186-- corresponding headers.

@@ -193,8 +191,8 @@ instance

193 ( MimeUnrender ct a, BuildHeadersTo ls

191 ( MimeUnrender ct a, BuildHeadersTo ls

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

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

195 type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

193 type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

196− clientWithRoute Proxy req baseurl = do

194+ clientWithRoute Proxy req baseurl manager = do

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

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

198 return $ Headers { getResponse = resp

196 return $ Headers { getResponse = resp

199 , getHeadersHList = buildHeadersTo hdrs

197 , getHeadersHList = buildHeadersTo hdrs

200 }

198 }

@@ -231,13 +229,14 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

231 type Client (Header sym a :> sublayout) =

229 type Client (Header sym a :> sublayout) =

232 Maybe a -> Client sublayout

230 Maybe a -> Client sublayout

233

231

234− clientWithRoute Proxy req baseurl mval =

232+ clientWithRoute Proxy req baseurl manager mval =

235 clientWithRoute (Proxy :: Proxy sublayout)

233 clientWithRoute (Proxy :: Proxy sublayout)

236 (maybe req

234 (maybe req

237 (\value -> Servant.Common.Req.addHeader hname value req)

235 (\value -> Servant.Common.Req.addHeader hname value req)

238 mval

236 mval

239 )

237 )

240 baseurl

238 baseurl

239+ manager

241

240

242 where hname = symbolVal (Proxy :: Proxy sym)

241 where hname = symbolVal (Proxy :: Proxy sym)

243

242

@@ -251,8 +250,8 @@ instance

251#endif

250#endif

252 (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where

251 (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where

253 type Client (Post (ct ': cts) a) = ExceptT ServantError IO a

252 type Client (Post (ct ': cts) a) = ExceptT ServantError IO a

254− clientWithRoute Proxy req baseurl =

253+ clientWithRoute Proxy req baseurl manager =

255− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl

254+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl manager

256

255

257-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content

256-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content

258-- HTTP header.

257-- HTTP header.

@@ -262,8 +261,8 @@ instance

262#endif

261#endif

263 HasClient (Post (ct ': cts) ()) where

262 HasClient (Post (ct ': cts) ()) where

264 type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()

263 type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()

265− clientWithRoute Proxy req baseurl =

264+ clientWithRoute Proxy req baseurl manager =

266− void $ performRequestNoBody H.methodPost req [204] baseurl

265+ void $ performRequestNoBody H.methodPost req [204] baseurl manager

267

266

268-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the

267-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the

269-- corresponding headers.

268-- corresponding headers.

@@ -274,8 +273,8 @@ instance

274 ( MimeUnrender ct a, BuildHeadersTo ls

273 ( MimeUnrender ct a, BuildHeadersTo ls

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

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

276 type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

275 type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

277− clientWithRoute Proxy req baseurl = do

276+ clientWithRoute Proxy req baseurl manager = do

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

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

279 return $ Headers { getResponse = resp

278 return $ Headers { getResponse = resp

280 , getHeadersHList = buildHeadersTo hdrs

279 , getHeadersHList = buildHeadersTo hdrs

281 }

280 }

@@ -290,8 +289,8 @@ instance

290#endif

289#endif

291 (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where

290 (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where

292 type Client (Put (ct ': cts) a) = ExceptT ServantError IO a

291 type Client (Put (ct ': cts) a) = ExceptT ServantError IO a

293− clientWithRoute Proxy req baseurl =

292+ clientWithRoute Proxy req baseurl manager =

294− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl

293+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl manager

295

294

296-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content

295-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content

297-- HTTP header.

296-- HTTP header.

@@ -301,8 +300,8 @@ instance

301#endif

300#endif

302 HasClient (Put (ct ': cts) ()) where

301 HasClient (Put (ct ': cts) ()) where

303 type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()

302 type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()

304− clientWithRoute Proxy req baseurl =

303+ clientWithRoute Proxy req baseurl manager =

305− void $ performRequestNoBody H.methodPut req [204] baseurl

304+ void $ performRequestNoBody H.methodPut req [204] baseurl manager

306

305

307-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the

306-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the

308-- corresponding headers.

307-- corresponding headers.

@@ -313,8 +312,8 @@ instance

313 ( MimeUnrender ct a, BuildHeadersTo ls

312 ( MimeUnrender ct a, BuildHeadersTo ls

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

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

315 type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

314 type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

316− clientWithRoute Proxy req baseurl = do

315+ clientWithRoute Proxy req baseurl manager= do

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

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

318 return $ Headers { getResponse = resp

317 return $ Headers { getResponse = resp

319 , getHeadersHList = buildHeadersTo hdrs

318 , getHeadersHList = buildHeadersTo hdrs

320 }

319 }

@@ -329,8 +328,8 @@ instance

329#endif

328#endif

330 (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

329 (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

331 type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a

330 type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a

332− clientWithRoute Proxy req baseurl =

331+ clientWithRoute Proxy req baseurl manager =

333− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl

332+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl manager

334

333

335-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content

334-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content

336-- HTTP header.

335-- HTTP header.

@@ -340,8 +339,8 @@ instance

340#endif

339#endif

341 HasClient (Patch (ct ': cts) ()) where

340 HasClient (Patch (ct ': cts) ()) where

342 type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()

341 type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()

343− clientWithRoute Proxy req baseurl =

342+ clientWithRoute Proxy req baseurl manager =

344− void $ performRequestNoBody H.methodPatch req [204] baseurl

343+ void $ performRequestNoBody H.methodPatch req [204] baseurl manager

345

344

346-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the

345-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the

347-- corresponding headers.

346-- corresponding headers.

@@ -352,8 +351,8 @@ instance

352 ( MimeUnrender ct a, BuildHeadersTo ls

351 ( MimeUnrender ct a, BuildHeadersTo ls

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

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

354 type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

353 type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)

355− clientWithRoute Proxy req baseurl = do

354+ clientWithRoute Proxy req baseurl manager = do

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

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

357 return $ Headers { getResponse = resp

356 return $ Headers { getResponse = resp

358 , getHeadersHList = buildHeadersTo hdrs

357 , getHeadersHList = buildHeadersTo hdrs

359 }

358 }

@@ -391,13 +390,14 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

391 Maybe a -> Client sublayout

390 Maybe a -> Client sublayout

392

391

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

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

394− clientWithRoute Proxy req baseurl mparam =

393+ clientWithRoute Proxy req baseurl manager mparam =

395 clientWithRoute (Proxy :: Proxy sublayout)

394 clientWithRoute (Proxy :: Proxy sublayout)

396 (maybe req

395 (maybe req

397 (flip (appendToQueryString pname) req . Just)

396 (flip (appendToQueryString pname) req . Just)

398 mparamText

397 mparamText

399 )

398 )

400 baseurl

399 baseurl

400+ manager

401

402 where pname = cs pname'

403 pname' = symbolVal (Proxy :: Proxy sym)

@@ -437,13 +437,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

437 type Client (QueryParams sym a :> sublayout) =

438 [a] -> Client sublayout

439

440− clientWithRoute Proxy req baseurl paramlist =

440+ clientWithRoute Proxy req baseurl manager paramlist =

441 clientWithRoute (Proxy :: Proxy sublayout)

442 (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))

443 req

444 paramlist'

445 )

446− baseurl

446+ baseurl manager

447

448 where pname = cs pname'

449 pname' = symbolVal (Proxy :: Proxy sym)

@@ -477,13 +477,13 @@ instance (KnownSymbol sym, HasClient sublayout)

477 type Client (QueryFlag sym :> sublayout) =

478 Bool -> Client sublayout

479

480− clientWithRoute Proxy req baseurl flag =

480+ clientWithRoute Proxy req baseurl manager flag =

481 clientWithRoute (Proxy :: Proxy sublayout)

482 (if flag

483 then appendToQueryString paramname Nothing req

484 else req

485 )

486− baseurl

486+ baseurl manager

487

488 where paramname = cs $ symbolVal (Proxy :: Proxy sym)

489

@@ -520,13 +520,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

520 Maybe a -> Client sublayout

521

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

523− clientWithRoute Proxy req baseurl mparam =

523+ clientWithRoute Proxy req baseurl manager mparam =

524 clientWithRoute (Proxy :: Proxy sublayout)

525 (maybe req

526 (flip (appendToMatrixParams pname . Just) req)

527 mparamText

528 )

529− baseurl

529+ baseurl manager

530

531 where pname = symbolVal (Proxy :: Proxy sym)

532 mparamText = fmap (cs . toText) mparam

@@ -565,13 +565,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

565 type Client (MatrixParams sym a :> sublayout) =

566 [a] -> Client sublayout

567

568− clientWithRoute Proxy req baseurl paramlist =

568+ clientWithRoute Proxy req baseurl manager paramlist =

569 clientWithRoute (Proxy :: Proxy sublayout)

570 (foldl' (\ req' value -> maybe req' (flip (appendToMatrixParams pname) req' . Just . cs) value)

571 req

572 paramlist'

573 )

574− baseurl

574+ baseurl manager

575

576 where pname = cs pname'

577 pname' = symbolVal (Proxy :: Proxy sym)

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

590--

591-- > type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book]

592-- >

593+-- >

593-- > myApi :: Proxy MyApi

594-- > myApi :: Proxy MyApi

594-- > myApi = Proxy

595-- > myApi = Proxy

595-- >

596-- >

@@ -605,13 +606,13 @@ instance (KnownSymbol sym, HasClient sublayout)

605 type Client (MatrixFlag sym :> sublayout) =

606 type Client (MatrixFlag sym :> sublayout) =

606 Bool -> Client sublayout

607 Bool -> Client sublayout

607

608

608− clientWithRoute Proxy req baseurl flag =

609+ clientWithRoute Proxy req baseurl manager flag =

609 clientWithRoute (Proxy :: Proxy sublayout)

610 clientWithRoute (Proxy :: Proxy sublayout)

610 (if flag

611 (if flag

611 then appendToMatrixParams paramname Nothing req

612 then appendToMatrixParams paramname Nothing req

612 else req

613 else req

613 )

614 )

614− baseurl

615+ baseurl manager

615

616

616 where paramname = cs $ symbolVal (Proxy :: Proxy sym)

617 where paramname = cs $ symbolVal (Proxy :: Proxy sym)

617

618

@@ -620,9 +621,9 @@ instance (KnownSymbol sym, HasClient sublayout)

620instance HasClient Raw where

621instance HasClient Raw where

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

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

622

623

623− clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Client Raw

624+ clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw

624− clientWithRoute Proxy req baseurl httpMethod = do

625+ clientWithRoute Proxy req baseurl manager httpMethod = do

625− performRequest httpMethod req (const True) baseurl

626+ performRequest httpMethod req (const True) baseurl manager

626

627

627-- | If you use a 'ReqBody' in one of your endpoints in your API,

628-- | If you use a 'ReqBody' in one of your endpoints in your API,

628-- the corresponding querying function will automatically take

629-- the corresponding querying function will automatically take

@@ -640,7 +641,7 @@ instance HasClient Raw where

640-- > myApi = Proxy

641-- > myApi = Proxy

641-- >

642-- >

642-- > addBook :: Book -> ExceptT String IO Book

643-- > addBook :: Book -> ExceptT String IO Book

643−-- > addBook = client myApi host

644+-- > addBook = client myApi host manager

644-- > where host = BaseUrl Http "localhost" 8080

645-- > where host = BaseUrl Http "localhost" 8080

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

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

646instance (MimeRender ct a, HasClient sublayout)

647instance (MimeRender ct a, HasClient sublayout)

@@ -649,40 +650,40 @@ instance (MimeRender ct a, HasClient sublayout)

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

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

650 a -> Client sublayout

651 a -> Client sublayout

651

652

652− clientWithRoute Proxy req baseurl body =

653+ clientWithRoute Proxy req baseurl manager body =

653 clientWithRoute (Proxy :: Proxy sublayout)

654 clientWithRoute (Proxy :: Proxy sublayout)

654 (let ctProxy = Proxy :: Proxy ct

655 (let ctProxy = Proxy :: Proxy ct

655 in setRQBody (mimeRender ctProxy body)

656 in setRQBody (mimeRender ctProxy body)

656 (contentType ctProxy)

657 (contentType ctProxy)

657 req

658 req

658 )

659 )

659− baseurl

660+ baseurl manager

660

661

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

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

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

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

663 type Client (path :> sublayout) = Client sublayout

664 type Client (path :> sublayout) = Client sublayout

664

665

665− clientWithRoute Proxy req baseurl =

666+ clientWithRoute Proxy req baseurl manager =

666 clientWithRoute (Proxy :: Proxy sublayout)

667 clientWithRoute (Proxy :: Proxy sublayout)

667 (appendToPath p req)

668 (appendToPath p req)

668− baseurl

669+ baseurl manager

669

670

670 where p = symbolVal (Proxy :: Proxy path)

671 where p = symbolVal (Proxy :: Proxy path)

671

672

672instance HasClient api => HasClient (Vault :> api) where

673instance HasClient api => HasClient (Vault :> api) where

673 type Client (Vault :> api) = Client api

674 type Client (Vault :> api) = Client api

674

675

675− clientWithRoute Proxy req baseurl =

676+ clientWithRoute Proxy req baseurl manager =

676− clientWithRoute (Proxy :: Proxy api) req baseurl

677+ clientWithRoute (Proxy :: Proxy api) req baseurl manager

677

678

678instance HasClient api => HasClient (RemoteHost :> api) where

679instance HasClient api => HasClient (RemoteHost :> api) where

679 type Client (RemoteHost :> api) = Client api

680 type Client (RemoteHost :> api) = Client api

680

681

681− clientWithRoute Proxy req baseurl =

682+ clientWithRoute Proxy req baseurl manager =

682− clientWithRoute (Proxy :: Proxy api) req baseurl

683+ clientWithRoute (Proxy :: Proxy api) req baseurl manager

683

684

684instance HasClient api => HasClient (IsSecure :> api) where

685instance HasClient api => HasClient (IsSecure :> api) where

685 type Client (IsSecure :> api) = Client api

686 type Client (IsSecure :> api) = Client api

686

687

687− clientWithRoute Proxy req baseurl =

688+ clientWithRoute Proxy req baseurl manager =

688− clientWithRoute (Proxy :: Proxy api) req baseurl

689+ clientWithRoute (Proxy :: Proxy api) req baseurl manager

servant-client/src/Servant/Common/Req.hs+9−23

@@ -13,7 +13,6 @@ import Control.Monad.Catch (MonadThrow)

13import Control.Monad.IO.Class

14import Control.Monad.Trans.Except

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

16−import Data.IORef

17import Data.String

16import Data.String

18import Data.String.Conversions

17import Data.String.Conversions

19import Data.Proxy

18import Data.Proxy

@@ -21,7 +20,6 @@ import Data.Text (Text)

21import Data.Text.Encoding

20import Data.Text.Encoding

22import Data.Typeable

21import Data.Typeable

23import Network.HTTP.Client hiding (Proxy, path)

22import Network.HTTP.Client hiding (Proxy, path)

24−import Network.HTTP.Client.TLS

25import Network.HTTP.Media

23import Network.HTTP.Media

26import Network.HTTP.Types

24import Network.HTTP.Types

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

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

@@ -29,7 +27,6 @@ import Network.URI hiding (path)

29import Servant.API.ContentTypes

27import Servant.API.ContentTypes

30import Servant.Common.BaseUrl

28import Servant.Common.BaseUrl

31import Servant.Common.Text

29import Servant.Common.Text

32−import System.IO.Unsafe

34import qualified Network.HTTP.Client as Client

31import qualified Network.HTTP.Client as Client

@@ -129,31 +126,21 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =

129

126

130-- * performing requests

127-- * performing requests

131

128

132−{-# NOINLINE __manager #-}

133−__manager :: IORef Manager

134−__manager = unsafePerformIO (newManager tlsManagerSettings >>= newIORef)

135−

136−__withGlobalManager :: (Manager -> IO a) -> IO a

137−__withGlobalManager action = readIORef __manager >>= action

138−

139−

140displayHttpRequest :: Method -> String

129displayHttpRequest :: Method -> String

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

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

142

131

143

132

144−performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl

133+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> Manager

145 -> ExceptT ServantError IO ( Int, ByteString, MediaType

134 -> ExceptT ServantError IO ( Int, ByteString, MediaType

146 , [HTTP.Header], Response ByteString)

135 , [HTTP.Header], Response ByteString)

147−performRequest reqMethod req isWantedStatus reqHost = do

136+performRequest reqMethod req isWantedStatus reqHost manager = do

148 partialRequest <- liftIO $ reqToRequest req reqHost

137 partialRequest <- liftIO $ reqToRequest req reqHost

149

138

150 let request = partialRequest { Client.method = reqMethod

139 let request = partialRequest { Client.method = reqMethod

151 , checkStatus = \ _status _headers _cookies -> Nothing

140 , checkStatus = \ _status _headers _cookies -> Nothing

152 }

141 }

153

142

154− eResponse <- liftIO $ __withGlobalManager $ \ manager ->

155− catchConnectionError $

156− Client.httpLbs request manager

143+ eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager

157 case eResponse of

144 case eResponse of

158 Left err ->

145 Left err ->

159 throwE . ConnectionError $ SomeException err

146 throwE . ConnectionError $ SomeException err

@@ -174,20 +161,19 @@ performRequest reqMethod req isWantedStatus reqHost = do

174

161

175

162

176performRequestCT :: MimeUnrender ct result =>

163performRequestCT :: MimeUnrender ct result =>

177− Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> ExceptT ServantError IO ([HTTP.Header], result)

164+ Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> Manager -> ExceptT ServantError IO ([HTTP.Header], result)

178−performRequestCT ct reqMethod req wantedStatus reqHost = do

165+performRequestCT ct reqMethod req wantedStatus reqHost manager = do

179 let acceptCT = contentType ct

166 let acceptCT = contentType ct

180 (_status, respBody, respCT, hrds, _response) <-

167 (_status, respBody, respCT, hrds, _response) <-

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

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

182 unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody

169 unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody

183 case mimeUnrender ct respBody of

170 case mimeUnrender ct respBody of

184 Left err -> throwE $ DecodeFailure err respCT respBody

171 Left err -> throwE $ DecodeFailure err respCT respBody

185 Right val -> return (hrds, val)

172 Right val -> return (hrds, val)

186

173

187−performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> ExceptT ServantError IO ()

174+performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> Manager -> ExceptT ServantError IO ()

188−performRequestNoBody reqMethod req wantedStatus reqHost = do

175+performRequestNoBody reqMethod req wantedStatus reqHost manager =

189− _ <- performRequest reqMethod req (`elem` wantedStatus) reqHost

176+ void $ performRequest reqMethod req (`elem` wantedStatus) reqHost manager

190− return ()

191

177

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

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

193catchConnectionError action =

179catchConnectionError action =

servant-client/test/Servant/ClientSpec.hs+6−4

@@ -144,6 +144,7 @@ withFailServer action = withWaiDaemon (return failServer) action

144

145spec :: IO ()

146spec = withServer $ \ baseUrl -> do

147+ manager <- C.newManager C.defaultManagerSettings

147 let getGet :: ExceptT ServantError IO Person

148 let getGet :: ExceptT ServantError IO Person

148 getDeleteEmpty :: ExceptT ServantError IO ()

149 getDeleteEmpty :: ExceptT ServantError IO ()

149 getCapture :: String -> ExceptT ServantError IO Person

150 getCapture :: String -> ExceptT ServantError IO Person

@@ -174,7 +175,7 @@ spec = withServer $ \ baseUrl -> do

174 :<|> getMultiple

175 :<|> getMultiple

175 :<|> getRespHeaders

176 :<|> getRespHeaders

176 :<|> getDeleteContentType)

177 :<|> getDeleteContentType)

177− = client api baseUrl

178+ = client api baseUrl manager

178

179

179 hspec $ do

180 hspec $ do

180 it "Servant.API.Get" $ do

181 it "Servant.API.Get" $ do

@@ -264,7 +265,7 @@ spec = withServer $ \ baseUrl -> do

264 withWaiDaemon (return (serve api (throwE $ ServantErr 500 "error message" "" []))) $

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

265 \ host -> do

266 \ host -> do

266 let getResponse :: ExceptT ServantError IO ()

267 let getResponse :: ExceptT ServantError IO ()

267− getResponse = client api host

268+ getResponse = client api host manager

268 Left FailureResponse{..} <- runExceptT getResponse

269 Left FailureResponse{..} <- runExceptT getResponse

269 responseStatus `shouldBe` (Status 500 "error message")

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

270 mapM_ test $

271 mapM_ test $

@@ -276,6 +277,7 @@ spec = withServer $ \ baseUrl -> do

276

277

277failSpec :: IO ()

278failSpec :: IO ()

278failSpec = withFailServer $ \ baseUrl -> do

279failSpec = withFailServer $ \ baseUrl -> do

280+ manager <- C.newManager C.defaultManagerSettings

279 let getGet :: ExceptT ServantError IO Person

281 let getGet :: ExceptT ServantError IO Person

280 getDeleteEmpty :: ExceptT ServantError IO ()

282 getDeleteEmpty :: ExceptT ServantError IO ()

281 getCapture :: String -> ExceptT ServantError IO Person

283 getCapture :: String -> ExceptT ServantError IO Person

@@ -285,9 +287,9 @@ failSpec = withFailServer $ \ baseUrl -> do

285 :<|> getCapture

287 :<|> getCapture

286 :<|> getBody

288 :<|> getBody

287 :<|> _ )

289 :<|> _ )

288− = client api baseUrl

290+ = client api baseUrl manager

289 getGetWrongHost :: ExceptT ServantError IO Person

291 getGetWrongHost :: ExceptT ServantError IO Person

290− (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "")

292+ (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager

291

293

292 hspec $ do

294 hspec $ do

293 context "client returns errors appropriately" $ do

295 context "client returns errors appropriately" $ do