7379b74 · typeable/servant

git.iko.soy/typeable/servant

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

commit7379b7486abebb6be2347710cc14754601dbfd66 authormbg <michael.gale@cl.cam.ac.uk> dateMon 28 Mar 2016, 14:11 (11 years ago) parent5890d52

2 files changed+70−69

compare with master

unifiedsplit

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

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

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

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

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

2929#endif

30−import Control.Monad.Trans.Except

3130import Data.ByteString.Lazy (ByteString)

3231import Data.List

3332import Data.Proxy

3433import Data.String.Conversions

3534import Data.Text (unpack)

3635import GHC.TypeLits

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

36+import Network.HTTP.Client (Response)

3837import Network.HTTP.Media

3938import qualified Network.HTTP.Types as H

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

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

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

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

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

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

62−client p baseurl = clientWithRoute p defReq baseurl

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

61+client p = clientWithRoute p defReq

6362

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

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

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

6766class HasClient layout where

6867 type Client layout :: *

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

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

7069

7170

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

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

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

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

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

88− clientWithRoute Proxy req baseurl manager =

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

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

87+ clientWithRoute Proxy req =

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

89+ clientWithRoute (Proxy :: Proxy b) req

9190

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

9392-- the corresponding querying function will automatically take

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

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

116115 a -> Client sublayout

117116

118− clientWithRoute Proxy req baseurl manager val =

117+ clientWithRoute Proxy req val =

119118 clientWithRoute (Proxy :: Proxy sublayout)

120119 (appendToPath p req)

121− baseurl

122− manager

123120

124121 where p = unpack (toUrlPiece val)

125122

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

127124 -- Note [Non-Empty Content Types]

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

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

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

131− clientWithRoute Proxy req baseurl manager =

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

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

128+ clientWithRoute Proxy req =

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

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

134131

135132instance OVERLAPPING_

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

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

138− clientWithRoute Proxy req baseurl manager =

139− performRequestNoBody method req baseurl manager >> return NoContent

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

135+ clientWithRoute Proxy req =

136+ performRequestNoBody method req >> return NoContent

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

141138

142139instance OVERLAPPING_

143140 -- Note [Non-Empty Content Types]

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

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

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

147− = ExceptT ServantError IO (Headers ls a)

148− clientWithRoute Proxy req baseurl manager = do

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

144+ clientWithRoute Proxy req = do

149145 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

151147 return $ Headers { getResponse = resp

152148 , getHeadersHList = buildHeadersTo hdrs

153149 }

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

156152 ( BuildHeadersTo ls, ReflectMethod method

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

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

159− = ExceptT ServantError IO (Headers ls NoContent)

160− clientWithRoute Proxy req baseurl manager = do

155+ = ClientM (Headers ls NoContent)

156+ clientWithRoute Proxy req = do

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

162− hdrs <- performRequestNoBody method req baseurl manager

158+ hdrs <- performRequestNoBody method req

163159 return $ Headers { getResponse = NoContent

164160 , getHeadersHList = buildHeadersTo hdrs

165161 }

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

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

198194 Maybe a -> Client sublayout

199195

200− clientWithRoute Proxy req baseurl manager mval =

196+ clientWithRoute Proxy req mval =

201197 clientWithRoute (Proxy :: Proxy sublayout)

202198 (maybe req

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

204200 mval

205201 )

206− baseurl

207− manager

208202

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

210204

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

252246 Maybe a -> Client sublayout

253247

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

255− clientWithRoute Proxy req baseurl manager mparam =

249+ clientWithRoute Proxy req mparam =

256250 clientWithRoute (Proxy :: Proxy sublayout)

257251 (maybe req

258252 (flip (appendToQueryString pname) req . Just)

259253 mparamText

260254 )

261− baseurl

262− manager

263255

264256 where pname = cs pname'

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

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

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

300292 [a] -> Client sublayout

301293

302− clientWithRoute Proxy req baseurl manager paramlist =

294+ clientWithRoute Proxy req paramlist =

303295 clientWithRoute (Proxy :: Proxy sublayout)

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

305297 req

306298 paramlist'

307299 )

308− baseurl manager

309300

310301 where pname = cs pname'

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

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

339330 type Client (QueryFlag sym :> sublayout) =

340331 Bool -> Client sublayout

341332

342− clientWithRoute Proxy req baseurl manager flag =

333+ clientWithRoute Proxy req flag =

343334 clientWithRoute (Proxy :: Proxy sublayout)

344335 (if flag

345336 then appendToQueryString paramname Nothing req

346337 else req

347338 )

348− baseurl manager

349339

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

351341

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

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

354344-- back the full `Response`.

355345instance HasClient Raw where

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

346+ type Client Raw

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

357348

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

359− clientWithRoute Proxy req baseurl manager httpMethod = do

360− performRequest httpMethod req baseurl manager

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

350+ clientWithRoute Proxy req httpMethod = do

351+ performRequest httpMethod req

361352

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

363354-- the corresponding querying function will automatically take

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

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

385376 a -> Client sublayout

386377

387− clientWithRoute Proxy req baseurl manager body =

378+ clientWithRoute Proxy req body =

388379 clientWithRoute (Proxy :: Proxy sublayout)

389380 (let ctProxy = Proxy :: Proxy ct

390381 in setRQBody (mimeRender ctProxy body)

391382 (contentType ctProxy)

392383 req

393384 )

394− baseurl manager

395385

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

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

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

399389

400− clientWithRoute Proxy req baseurl manager =

390+ clientWithRoute Proxy req =

401391 clientWithRoute (Proxy :: Proxy sublayout)

402392 (appendToPath p req)

403− baseurl manager

404393

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

406395

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

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

409398

410− clientWithRoute Proxy req baseurl manager =

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

399+ clientWithRoute Proxy req =

400+ clientWithRoute (Proxy :: Proxy api) req

412401

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

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

415404

416− clientWithRoute Proxy req baseurl manager =

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

405+ clientWithRoute Proxy req =

406+ clientWithRoute (Proxy :: Proxy api) req

418407

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

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

421410

422− clientWithRoute Proxy req baseurl manager =

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

411+ clientWithRoute Proxy req =

412+ clientWithRoute (Proxy :: Proxy api) req

424413

425414instance HasClient subapi =>

426415 HasClient (WithNamedContext name context subapi) where

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

433422 type Client (AuthProtect tag :> api)

434423 = AuthenticateReq (AuthProtect tag) -> Client api

435424

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

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

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

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

438427

439428-- * Basic Authentication

440429

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

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

443432

444− clientWithRoute Proxy req baseurl manager val =

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

433+ clientWithRoute Proxy req val =

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

446435

447436

448437{- Note [Non-Empty Content Types]

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

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

1111import Control.Monad

1212import Control.Monad.Catch (MonadThrow)

1313import Control.Monad.IO.Class

14+import Control.Monad.Trans.Class

1415import Control.Monad.Trans.Except

16+import Control.Monad.Trans.Reader

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

1618import Data.String

1719import Data.String.Conversions

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

123125displayHttpRequest :: Method -> String

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

125127

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

126129

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

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

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

130−performRequest reqMethod req reqHost manager = do

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

138+ -> ClientM ( Int, ByteString, MediaType

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

140+performRequest reqMethod req = do

141+ reqHost <- ask

142+ manager <- lift ask

131143 partialRequest <- liftIO $ reqToRequest req reqHost

132144

133145 let request = partialRequest { Client.method = reqMethod

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

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

138150 case eResponse of

139151 Left err ->

140− throwE . ConnectionError $ SomeException err

152+ throwError . ConnectionError $ SomeException err

141153

142154 Right response -> do

143155 let status = Client.responseStatus response

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

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

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

149161 Just t -> case parseAccept t of

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

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

151163 Just t' -> pure t'

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

153− throwE $ FailureResponse status ct body

165+ throwError $ FailureResponse status ct body

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

155167

156168

157169performRequestCT :: MimeUnrender ct result =>

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

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

160−performRequestCT ct reqMethod req reqHost manager = do

170+ Proxy ct -> Method -> Req

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

172+performRequestCT ct reqMethod req = do

161173 let acceptCT = contentType ct

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

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

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

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

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

165177 case mimeUnrender ct respBody of

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

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

167179 Right val -> return (hdrs, val)

168180

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

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

171−performRequestNoBody reqMethod req reqHost manager = do

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

181+performRequestNoBody :: Method -> Req

182+ -> ClientM [HTTP.Header]

183+performRequestNoBody reqMethod req = do

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

173185 return hdrs

174186

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