@@ -21,34 +21,52 @@ module Servant.Client.Core
2121 , AuthenticateReq(..)
2222 , client
2323 , HasClient(..)
24− , ClientM
25− , runClientM, inClientM, clientM
26− , ClientEnv (ClientEnv)
2724 , mkAuthenticateReq
2825 , ServantError(..)
2926 , EmptyClient(..)
30− , module Servant.Common.BaseUrl
27+ , module Servant.Client.Core.Internal.BaseUrl
3128 ) where
3229
33−import Data.ByteString.Lazy (ByteString)
34−import Data.List
35−import Data.Proxy
36−import Data.String.Conversions
37−import Data.Text (unpack)
38−import GHC.TypeLits
39−import Network.HTTP.Client (Response)
40−import Network.HTTP.Media
41−import qualified Network.HTTP.Types as H
42−import qualified Network.HTTP.Types.Header as HTTP
43−import Prelude ()
30+import Control.Monad.Error.Class (throwError)
31+import Data.List (foldl')
32+import Data.Proxy (Proxy (Proxy))
33+import Data.String (fromString)
34+import Data.Text (pack)
35+import GHC.Exts (fromList, toList)
36+import GHC.TypeLits (KnownSymbol, symbolVal)
37+import qualified Network.HTTP.Types as H
38+import Prelude ()
4439import Prelude.Compat
45−import Servant.API
46−import Servant.Client.Experimental.Auth
47−import Servant.Client.HttpClient
48−import Servant.Client.Class
49−import Servant.Common.BaseUrl
50−import Servant.Common.BasicAuth
51−import Servant.Common.Req
40+import Servant.API ((:<|>) ((:<|>)), (:>),
41+ AuthProtect, BasicAuth,
42+ BasicAuthData,
43+ BuildHeadersTo (..),
44+ Capture, CaptureAll,
45+ Description, EmptyAPI,
46+ Header, Headers (..),
47+ HttpVersion, IsSecure,
48+ MimeRender (mimeRender),
49+ MimeUnrender (mimeUnrender),
50+ NoContent (NoContent),
51+ QueryFlag, QueryParam,
52+ QueryParams, Raw,
53+ ReflectMethod (..),
54+ RemoteHost, ReqBody,
55+ Summary, ToHttpApiData,
56+ Vault, Verb,
57+ WithNamedContext,
58+ contentType,
59+ getHeadersHList,
60+ getResponse,
61+ toQueryParam,
62+ toUrlPiece)
63+import Servant.API.ContentTypes (contentTypes)
64+
65+import Servant.Client.Core.Internal.Auth
66+import Servant.Client.Core.Internal.BaseUrl
67+import Servant.Client.Core.Internal.BasicAuth
68+import Servant.Client.Core.Internal.Class
69+import Servant.Client.Core.Internal.Request
5270
5371-- * Accessing APIs as a Client
5472
@@ -68,25 +86,15 @@ import Servant.Common.Req
6886-- > postNewBook :: Book -> ClientM Book
6987-- > (getAllBooks :<|> postNewBook) = client clientM myApi
7088client :: HasClient m api => Proxy m -> Proxy api -> Client m api
71−client pm p = clientWithRoute pm p defReq
72−
73−-- | Helper proxy to simplify common case of working in `ClientM` monad
74−inClientM :: Proxy ClientM
75−inClientM = Proxy
76−
77−-- | Convenience method to declare clients running in the `ClientM` monad.
78−--
79−-- Simply pass `inClientM` to `client`....
80−clientM :: (HasClient ClientM api) => Proxy api -> Client ClientM api
81−clientM = client inClientM
89+client pm p = clientWithRoute pm p defaultRequest
8290
8391
8492-- | This class lets us define how each API combinator
8593-- influences the creation of an HTTP request. It's mostly
8694-- an internal class, you can just use 'client'.
87−class HasClient m api where
95+class RunClient m => HasClient m api where
8896 type Client (m :: * -> *) (api :: *) :: *
89− clientWithRoute :: Proxy m -> Proxy api -> Req -> Client m api
97+ clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api
9098
9199
92100-- | A client querying function for @a ':<|>' b@ will actually hand you
@@ -121,7 +129,7 @@ data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
121129-- >
122130-- > getAllBooks :: ClientM [Book]
123131-- > (getAllBooks :<|> EmptyClient) = client myApi
124−instance HasClient m EmptyAPI where
132+instance RunClient m => HasClient m EmptyAPI where
125133 type Client m EmptyAPI = EmptyClient
126134 clientWithRoute _pm Proxy _ = EmptyClient
127135
@@ -154,7 +162,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
154162 clientWithRoute pm (Proxy :: Proxy api)
155163 (appendToPath p req)
156164
157− where p = unpack (toUrlPiece val)
165+ where p = (toUrlPiece val)
158166
159167-- | If you use a 'CaptureAll' in one of your endpoints in your API,
160168-- the corresponding querying function will automatically take an
@@ -186,53 +194,65 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
186194 clientWithRoute pm (Proxy :: Proxy sublayout)
187195 (foldl' (flip appendToPath) req ps)
188196
189− where ps = map (unpack . toUrlPiece) vals
197+ where ps = map (toUrlPiece) vals
190198
191199instance OVERLAPPABLE_
192200 -- Note [Non-Empty Content Types]
193− (RunClient m ct ([H.Header], a), MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
201+ ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
194202 ) => HasClient m (Verb method status cts' a) where
195203 type Client m (Verb method status cts' a) = m a
196204 clientWithRoute _pm Proxy req = do
197− (_hdrs, a) :: ([H.Header], a) <- runRequest (Proxy :: Proxy ct) method req
198− return a
205+ response <- runRequest req
206+ { requestAccept = fromList $ toList accept
207+ , requestMethod = method
208+ }
209+ case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
210+ Left err -> throwError $ DecodeFailure (pack err) response
211+ Right val -> return val
199212 where method = reflectMethod (Proxy :: Proxy method)
213+ accept = contentTypes (Proxy :: Proxy ct)
200214
201215instance OVERLAPPING_
202− ( RunClient m NoContent [HTTP.Header]
203− , ReflectMethod method) => HasClient m (Verb method status cts NoContent) where
216+ ( RunClient m, ReflectMethod method
217+ ) => HasClient m (Verb method status cts NoContent) where
204218 type Client m (Verb method status cts NoContent)
205219 = m NoContent
206220 clientWithRoute _pm Proxy req = do
207− _hdrs :: [H.Header] <- runRequest (Proxy :: Proxy NoContent) method req
221+ _response <- runRequest req { requestMethod = method }
208222 return NoContent
209223 where method = reflectMethod (Proxy :: Proxy method)
210224
211225instance OVERLAPPING_
212226 -- Note [Non-Empty Content Types]
213− ( RunClient m ct ([H.Header], a)
214− , MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
227+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
228+ , ReflectMethod method, cts' ~ (ct ': cts)
215229 ) => HasClient m (Verb method status cts' (Headers ls a)) where
216230 type Client m (Verb method status cts' (Headers ls a))
217231 = m (Headers ls a)
218232 clientWithRoute _pm Proxy req = do
219− let method = reflectMethod (Proxy :: Proxy method)
220− (hdrs, resp) <- runRequest (Proxy :: Proxy ct) method req
221− return $ Headers { getResponse = resp
222− , getHeadersHList = buildHeadersTo hdrs
223− }
233+ response <- runRequest req
234+ { requestMethod = method
235+ , requestAccept = fromList $ toList accept
236+ }
237+ case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
238+ Left err -> throwError $ DecodeFailure (pack err) response
239+ Right val -> return $ Headers
240+ { getResponse = val
241+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
242+ }
243+ where method = reflectMethod (Proxy :: Proxy method)
244+ accept = contentTypes (Proxy :: Proxy ct)
224245
225246instance OVERLAPPING_
226− ( RunClient m NoContent [H.Header]
227− , BuildHeadersTo ls, ReflectMethod method
247+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method
228248 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
229249 type Client m (Verb method status cts (Headers ls NoContent))
230250 = m (Headers ls NoContent)
231251 clientWithRoute _pm Proxy req = do
232252 let method = reflectMethod (Proxy :: Proxy method)
233− hdrs <- runRequest (Proxy :: Proxy NoContent) method req
253+ response <- runRequest req { requestMethod = method }
234254 return $ Headers { getResponse = NoContent
235− , getHeadersHList = buildHeadersTo hdrs
255+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
236256 }
237257
238258
@@ -270,11 +290,11 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
270290 clientWithRoute pm Proxy req mval =
271291 clientWithRoute pm (Proxy :: Proxy api)
272292 (maybe req
273− (\value -> Servant.Common.Req.addHeader hname value req)
293+ (\value -> addHeader hname value req)
274294 mval
275295 )
276296
277− where hname = symbolVal (Proxy :: Proxy sym)
297+ where hname = fromString $ symbolVal (Proxy :: Proxy sym)
278298
279299-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
280300-- functions.
@@ -338,8 +358,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
338358 mparamText
339359 )
340360
341− where pname = cs pname'
342− pname' = symbolVal (Proxy :: Proxy sym)
361+ where pname = pack $ symbolVal (Proxy :: Proxy sym)
343362 mparamText = fmap toQueryParam mparam
344363
345364-- | If you use a 'QueryParams' in one of your endpoints in your API,
@@ -382,8 +401,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
382401 paramlist'
383402 )
384403
385− where pname = cs pname'
386− pname' = symbolVal (Proxy :: Proxy sym)
404+ where pname = pack $ symbolVal (Proxy :: Proxy sym)
387405 paramlist' = map (Just . toQueryParam) paramlist
388406
389407-- | If you use a 'QueryFlag' in one of your endpoints in your API,
@@ -420,19 +438,18 @@ instance (KnownSymbol sym, HasClient m api)
420438 else req
421439 )
422440
423− where paramname = cs $ symbolVal (Proxy :: Proxy sym)
441+ where paramname = pack $ symbolVal (Proxy :: Proxy sym)
424442
425443
426444-- | Pick a 'Method' and specify where the server you want to query is. You get
427445-- back the full `Response`.
428−instance (RunClient m NoContent (Int, ByteString, MediaType, [HTTP.Header], Response ByteString))
429− => HasClient m Raw where
446+instance RunClient m => HasClient m Raw where
430447 type Client m Raw
431− = H.Method -> m (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
448+ = H.Method -> m Response
432449
433− clientWithRoute :: Proxy m -> Proxy Raw -> Req -> Client m Raw
450+ clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw
434451 clientWithRoute _pm Proxy req httpMethod = do
435− runRequest (Proxy :: Proxy NoContent) httpMethod req
452+ runRequest req { requestMethod = httpMethod }
436453
437454-- | If you use a 'ReqBody' in one of your endpoints in your API,
438455-- the corresponding querying function will automatically take
@@ -461,10 +478,10 @@ instance (MimeRender ct a, HasClient m api)
461478 clientWithRoute pm Proxy req body =
462479 clientWithRoute pm (Proxy :: Proxy api)
463480 (let ctProxy = Proxy :: Proxy ct
464− in setReqBodyLBS (mimeRender ctProxy body)
465− -- We use first contentType from the Accept list
466− (contentType ctProxy)
467− req
481+ in setRequestBodyLBS (mimeRender ctProxy body)
482+ -- We use first contentType from the Accept list
483+ (contentType ctProxy)
484+ req
468485 )
469486
470487-- | Make the querying function append @path@ to the request path.
@@ -475,7 +492,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
475492 clientWithRoute pm (Proxy :: Proxy api)
476493 (appendToPath p req)
477494
478− where p = symbolVal (Proxy :: Proxy path)
495+ where p = pack $ symbolVal (Proxy :: Proxy path)
479496
480497instance HasClient m api => HasClient m (Vault :> api) where
481498 type Client m (Vault :> api) = Client m api