7379b74 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Moved BaseUrl and Manager parameters from the client function to the Client type as discussed in #428

7379b74mbg11 years ago

servant-client/src/Servant/Client.hs+41−52

compare with master

unifiedsplit

@@ -27,14 +27,13 @@ module Servant.Client

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

28import Control.Applicative ((<$>))

29#endif

30−import Control.Monad.Trans.Except

31import Data.ByteString.Lazy (ByteString)

30import Data.ByteString.Lazy (ByteString)

32import Data.List

31import Data.List

33import Data.Proxy

32import Data.Proxy

34import Data.String.Conversions

33import Data.String.Conversions

35import Data.Text (unpack)

34import Data.Text (unpack)

36import GHC.TypeLits

35import GHC.TypeLits

37−import Network.HTTP.Client (Response, Manager)

36+import Network.HTTP.Client (Response)

38import Network.HTTP.Media

37import Network.HTTP.Media

39import qualified Network.HTTP.Types as H

38import qualified Network.HTTP.Types as H

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

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

@@ -58,15 +57,15 @@ import Servant.Common.Req

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

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

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

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

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

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

61−client :: HasClient layout => Proxy layout -> BaseUrl -> Manager -> Client layout

60+client :: HasClient layout => Proxy layout -> Client layout

62−client p baseurl = clientWithRoute p defReq baseurl

61+client p = clientWithRoute p defReq

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

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

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

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

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

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

67class HasClient layout where

66class HasClient layout where

68 type Client layout :: *

67 type Client layout :: *

69− clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Manager -> Client layout

68+ clientWithRoute :: Proxy layout -> Req -> Client layout

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

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

@@ -85,9 +84,9 @@ class HasClient layout where

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

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

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

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

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

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

88− clientWithRoute Proxy req baseurl manager =

87+ clientWithRoute Proxy req =

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

88+ clientWithRoute (Proxy :: Proxy a) req :<|>

90− clientWithRoute (Proxy :: Proxy b) req baseurl manager

89+ clientWithRoute (Proxy :: Proxy b) req

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

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

93-- the corresponding querying function will automatically take

92-- the corresponding querying function will automatically take

@@ -115,11 +114,9 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)

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

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

116 a -> Client sublayout

115 a -> Client sublayout

117

116

118− clientWithRoute Proxy req baseurl manager val =

117+ clientWithRoute Proxy req val =

119 clientWithRoute (Proxy :: Proxy sublayout)

118 clientWithRoute (Proxy :: Proxy sublayout)

120 (appendToPath p req)

119 (appendToPath p req)

121− baseurl

122− manager

123

120

124 where p = unpack (toUrlPiece val)

121 where p = unpack (toUrlPiece val)

125

122

@@ -127,27 +124,26 @@ instance OVERLAPPABLE_

127 -- Note [Non-Empty Content Types]

124 -- Note [Non-Empty Content Types]

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

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

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

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

130− type Client (Verb method status cts' a) = ExceptT ServantError IO a

127+ type Client (Verb method status cts' a) = ClientM a

131− clientWithRoute Proxy req baseurl manager =

128+ clientWithRoute Proxy req =

132− snd <$> performRequestCT (Proxy :: Proxy ct) method req baseurl manager

129+ snd <$> performRequestCT (Proxy :: Proxy ct) method req

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

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

134

131

135instance OVERLAPPING_

132instance OVERLAPPING_

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

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

137− type Client (Verb method status cts NoContent) = ExceptT ServantError IO NoContent

134+ type Client (Verb method status cts NoContent) = ClientM NoContent

138− clientWithRoute Proxy req baseurl manager =

135+ clientWithRoute Proxy req =

139− performRequestNoBody method req baseurl manager >> return NoContent

136+ performRequestNoBody method req >> return NoContent

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

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

141

138

142instance OVERLAPPING_

139instance OVERLAPPING_

143 -- Note [Non-Empty Content Types]

140 -- Note [Non-Empty Content Types]

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

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

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

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

146− type Client (Verb method status cts' (Headers ls a))

143+ type Client (Verb method status cts' (Headers ls a)) = ClientM (Headers ls a)

147− = ExceptT ServantError IO (Headers ls a)

148− clientWithRoute Proxy req baseurl manager = do

144+ clientWithRoute Proxy req = do

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

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

150− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl manager

146+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req

151 return $ Headers { getResponse = resp

147 return $ Headers { getResponse = resp

152 , getHeadersHList = buildHeadersTo hdrs

148 , getHeadersHList = buildHeadersTo hdrs

153 }

149 }

@@ -156,10 +152,10 @@ instance OVERLAPPING_

156 ( BuildHeadersTo ls, ReflectMethod method

152 ( BuildHeadersTo ls, ReflectMethod method

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

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

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

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

159− = ExceptT ServantError IO (Headers ls NoContent)

155+ = ClientM (Headers ls NoContent)

160− clientWithRoute Proxy req baseurl manager = do

156+ clientWithRoute Proxy req = do

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

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

162− hdrs <- performRequestNoBody method req baseurl manager

158+ hdrs <- performRequestNoBody method req

163 return $ Headers { getResponse = NoContent

159 return $ Headers { getResponse = NoContent

164 , getHeadersHList = buildHeadersTo hdrs

160 , getHeadersHList = buildHeadersTo hdrs

165 }

161 }

@@ -197,14 +193,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)

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

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

198 Maybe a -> Client sublayout

194 Maybe a -> Client sublayout

199

195

200− clientWithRoute Proxy req baseurl manager mval =

196+ clientWithRoute Proxy req mval =

201 clientWithRoute (Proxy :: Proxy sublayout)

197 clientWithRoute (Proxy :: Proxy sublayout)

202 (maybe req

198 (maybe req

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

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

204 mval

200 mval

205 )

201 )

206− baseurl

207− manager

208

202

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

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

210

204

@@ -252,14 +246,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)

252 Maybe a -> Client sublayout

246 Maybe a -> Client sublayout

253

247

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

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

255− clientWithRoute Proxy req baseurl manager mparam =

249+ clientWithRoute Proxy req mparam =

256 clientWithRoute (Proxy :: Proxy sublayout)

250 clientWithRoute (Proxy :: Proxy sublayout)

257 (maybe req

251 (maybe req

258 (flip (appendToQueryString pname) req . Just)

252 (flip (appendToQueryString pname) req . Just)

259 mparamText

253 mparamText

260 )

254 )

261− baseurl

262− manager

263

255

264 where pname = cs pname'

256 where pname = cs pname'

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

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

@@ -299,13 +291,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)

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

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

300 [a] -> Client sublayout

292 [a] -> Client sublayout

301

293

302− clientWithRoute Proxy req baseurl manager paramlist =

294+ clientWithRoute Proxy req paramlist =

303 clientWithRoute (Proxy :: Proxy sublayout)

295 clientWithRoute (Proxy :: Proxy sublayout)

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

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

305 req

297 req

306 paramlist'

298 paramlist'

307 )

299 )

308− baseurl manager

309

300

310 where pname = cs pname'

301 where pname = cs pname'

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

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

@@ -339,13 +330,12 @@ instance (KnownSymbol sym, HasClient sublayout)

339 type Client (QueryFlag sym :> sublayout) =

330 type Client (QueryFlag sym :> sublayout) =

340 Bool -> Client sublayout

331 Bool -> Client sublayout

341

332

342− clientWithRoute Proxy req baseurl manager flag =

333+ clientWithRoute Proxy req flag =

343 clientWithRoute (Proxy :: Proxy sublayout)

334 clientWithRoute (Proxy :: Proxy sublayout)

344 (if flag

335 (if flag

345 then appendToQueryString paramname Nothing req

336 then appendToQueryString paramname Nothing req

346 else req

337 else req

347 )

338 )

348− baseurl manager

349

339

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

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

351

341

@@ -353,11 +343,12 @@ instance (KnownSymbol sym, HasClient sublayout)

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

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

354-- back the full `Response`.

344-- back the full `Response`.

355instance HasClient Raw where

345instance HasClient Raw where

346+ type Client Raw

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

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

357

348

358− clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw

349+ clientWithRoute :: Proxy Raw -> Req -> Client Raw

359− clientWithRoute Proxy req baseurl manager httpMethod = do

350+ clientWithRoute Proxy req httpMethod = do

360− performRequest httpMethod req baseurl manager

351+ performRequest httpMethod req

361

352

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

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

363-- the corresponding querying function will automatically take

354-- the corresponding querying function will automatically take

@@ -384,43 +375,41 @@ instance (MimeRender ct a, HasClient sublayout)

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

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

385 a -> Client sublayout

376 a -> Client sublayout

386

377

387− clientWithRoute Proxy req baseurl manager body =

378+ clientWithRoute Proxy req body =

388 clientWithRoute (Proxy :: Proxy sublayout)

379 clientWithRoute (Proxy :: Proxy sublayout)

389 (let ctProxy = Proxy :: Proxy ct

380 (let ctProxy = Proxy :: Proxy ct

390 in setRQBody (mimeRender ctProxy body)

381 in setRQBody (mimeRender ctProxy body)

391 (contentType ctProxy)

382 (contentType ctProxy)

392 req

383 req

393 )

384 )

394− baseurl manager

395

385

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

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

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

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

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

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

399

389

400− clientWithRoute Proxy req baseurl manager =

390+ clientWithRoute Proxy req =

401 clientWithRoute (Proxy :: Proxy sublayout)

391 clientWithRoute (Proxy :: Proxy sublayout)

402 (appendToPath p req)

392 (appendToPath p req)

403− baseurl manager

404

393

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

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

406

395

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

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

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

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

409

398

410− clientWithRoute Proxy req baseurl manager =

399+ clientWithRoute Proxy req =

411− clientWithRoute (Proxy :: Proxy api) req baseurl manager

400+ clientWithRoute (Proxy :: Proxy api) req

412

401

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

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

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

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

415

404

416− clientWithRoute Proxy req baseurl manager =

405+ clientWithRoute Proxy req =

417− clientWithRoute (Proxy :: Proxy api) req baseurl manager

406+ clientWithRoute (Proxy :: Proxy api) req

418

407

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

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

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

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

421

410

422− clientWithRoute Proxy req baseurl manager =

411+ clientWithRoute Proxy req =

423− clientWithRoute (Proxy :: Proxy api) req baseurl manager

412+ clientWithRoute (Proxy :: Proxy api) req

424

413

425instance HasClient subapi =>

414instance HasClient subapi =>

426 HasClient (WithNamedContext name context subapi) where

415 HasClient (WithNamedContext name context subapi) where

@@ -433,16 +422,16 @@ instance ( HasClient api

433 type Client (AuthProtect tag :> api)

422 type Client (AuthProtect tag :> api)

434 = AuthenticateReq (AuthProtect tag) -> Client api

423 = AuthenticateReq (AuthProtect tag) -> Client api

435

424

436− clientWithRoute Proxy req baseurl manager (AuthenticateReq (val,func)) =

425+ clientWithRoute Proxy req (AuthenticateReq (val,func)) =

437− clientWithRoute (Proxy :: Proxy api) (func val req) baseurl manager

426+ clientWithRoute (Proxy :: Proxy api) (func val req)

438

427

439-- * Basic Authentication

428-- * Basic Authentication

440

429

441instance HasClient api => HasClient (BasicAuth realm usr :> api) where

430instance HasClient api => HasClient (BasicAuth realm usr :> api) where

442 type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api

431 type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api

443

432

444− clientWithRoute Proxy req baseurl manager val =

433+ clientWithRoute Proxy req val =

445− clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) baseurl manager

434+ clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req)

446

435

447

436

448{- Note [Non-Empty Content Types]

437{- Note [Non-Empty Content Types]

servant-client/src/Servant/Common/Req.hs+29−17

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

11import Control.Monad

12import Control.Monad.Catch (MonadThrow)

13import Control.Monad.IO.Class

14+import Control.Monad.Trans.Class

14import Control.Monad.Trans.Except

15import Control.Monad.Trans.Except

16+import Control.Monad.Trans.Reader

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

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

16import Data.String

18import Data.String

17import Data.String.Conversions

19import Data.String.Conversions

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

123displayHttpRequest :: Method -> String

125displayHttpRequest :: Method -> String

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

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

125

127

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

126

129

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+

127−performRequest :: Method -> Req -> BaseUrl -> Manager

137+performRequest :: Method -> Req

128− -> ExceptT ServantError IO ( Int, ByteString, MediaType

138+ -> ClientM ( Int, ByteString, MediaType

129− , [HTTP.Header], Response ByteString)

139+ , [HTTP.Header], Response ByteString)

130−performRequest reqMethod req reqHost manager = do

140+performRequest reqMethod req = do

141+ reqHost <- ask

142+ manager <- lift ask

131 partialRequest <- liftIO $ reqToRequest req reqHost

143 partialRequest <- liftIO $ reqToRequest req reqHost

132

144

133 let request = partialRequest { Client.method = reqMethod

145 let request = partialRequest { Client.method = reqMethod

@@ -137,7 +149,7 @@ performRequest reqMethod req reqHost manager = do

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

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

138 case eResponse of

150 case eResponse of

139 Left err ->

151 Left err ->

140− throwE . ConnectionError $ SomeException err

152+ throwError . ConnectionError $ SomeException err

141

153

142 Right response -> do

154 Right response -> do

143 let status = Client.responseStatus response

155 let status = Client.responseStatus response

@@ -147,29 +159,29 @@ performRequest reqMethod req reqHost manager = do

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

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

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

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

149 Just t -> case parseAccept t of

161 Just t -> case parseAccept t of

150− Nothing -> throwE $ InvalidContentTypeHeader (cs t) body

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

151 Just t' -> pure t'

163 Just t' -> pure t'

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

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

153− throwE $ FailureResponse status ct body

165+ throwError $ FailureResponse status ct body

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

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

155

167

156

168

157performRequestCT :: MimeUnrender ct result =>

169performRequestCT :: MimeUnrender ct result =>

158− Proxy ct -> Method -> Req -> BaseUrl -> Manager

170+ Proxy ct -> Method -> Req

159− -> ExceptT ServantError IO ([HTTP.Header], result)

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

160−performRequestCT ct reqMethod req reqHost manager = do

172+performRequestCT ct reqMethod req = do

161 let acceptCT = contentType ct

173 let acceptCT = contentType ct

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

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

163− performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager

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

164− unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody

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

165 case mimeUnrender ct respBody of

177 case mimeUnrender ct respBody of

166− Left err -> throwE $ DecodeFailure err respCT respBody

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

167 Right val -> return (hdrs, val)

179 Right val -> return (hdrs, val)

168

180

169−performRequestNoBody :: Method -> Req -> BaseUrl -> Manager

181+performRequestNoBody :: Method -> Req

170− -> ExceptT ServantError IO [HTTP.Header]

182+ -> ClientM [HTTP.Header]

171−performRequestNoBody reqMethod req reqHost manager = do

183+performRequestNoBody reqMethod req = do

172− (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req reqHost manager

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

173 return hdrs

185 return hdrs

174

186

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

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