git.iko.soy/servant
on master help sign in
Documentation and Reexport module
e8b9814Julian K. Arni
servant-client-core/servant-client-core.cabal+3−1
compare with master
unifiedsplit
@@ -24,12 +24,14 @@ source-repository head
24library
24library
25 exposed-modules:
25 exposed-modules:
26 Servant.Client.Core
26 Servant.Client.Core
27+ Servant.Client.Core.Reexport
27 Servant.Client.Core.Internal.Auth
28 Servant.Client.Core.Internal.Auth
28 Servant.Client.Core.Internal.BaseUrl
29 Servant.Client.Core.Internal.BaseUrl
29 Servant.Client.Core.Internal.BasicAuth
30 Servant.Client.Core.Internal.BasicAuth
30− Servant.Client.Core.Internal.Class
31 Servant.Client.Core.Internal.Generic
31 Servant.Client.Core.Internal.Generic
32+ Servant.Client.Core.Internal.HasClient
32 Servant.Client.Core.Internal.Request
33 Servant.Client.Core.Internal.Request
34+ Servant.Client.Core.Internal.RunClient
33 build-depends:
35 build-depends:
34 base >= 4.7 && < 4.11
36 base >= 4.7 && < 4.11
35 , base-compat >= 0.9.1 && < 0.10
37 , base-compat >= 0.9.1 && < 0.10
servant-client-core/src/Servant/Client/Core.hs+37−23
@@ -1,29 +1,33 @@
1−{-# LANGUAGE CPP #-}
1+-- | This module provides backend-agnostic functionality for generating clients
2−{-# LANGUAGE DataKinds #-}
2+-- from @servant@ APIs. By "backend," we mean something that concretely
3−{-# LANGUAGE FlexibleContexts #-}
3+-- executes the request, such as:
4−{-# LANGUAGE FlexibleInstances #-}
4+--
5−{-# LANGUAGE InstanceSigs #-}
5+-- * The 'http-client' library
6−{-# LANGUAGE MultiParamTypeClasses #-}
6+-- * The 'haxl' library
7−{-# LANGUAGE OverloadedStrings #-}
7+-- * GHCJS via FFI
8−{-# LANGUAGE PolyKinds #-}
8+--
9−{-# LANGUAGE ScopedTypeVariables #-}
9+-- etc.
10−{-# LANGUAGE TypeFamilies #-}
10+--
11−{-# LANGUAGE TypeOperators #-}
11+-- Each backend is encapsulated in a monad that is an instance of the
12−{-# LANGUAGE UndecidableInstances #-}
12+-- 'RunClient' class.
13−
13+--
14−#include "overlapping-compat.h"
14+-- This library is primarily of interest to backend-writers, who are encouraged
15−-- | This module provides 'client' which can automatically generate
15+-- to re-export the parts of the
16−-- querying functions for each endpoint just from the type representing your
17−-- API.
18module Servant.Client.Core
16module Servant.Client.Core
19 (
17 (
20 -- * Client generation
18 -- * Client generation
21 clientIn
19 clientIn
22 , HasClient(..)
20 , HasClient(..)
23
21
22+ -- * Request
23+ , Request(..)
24+ , defaultRequest
25+ , RequestBody(..)
26+
24 -- * Authentication
27 -- * Authentication
25− , mkAuthenticateReq
28+ , mkAuthenticatedRequest
26− , AuthenticateReq(..)
29+ , basicAuthReq
30+ , AuthenticatedRequest(..)
27 , AuthClientData
31 , AuthClientData
28
32
29 -- * Generic Client
33 -- * Generic Client
@@ -33,10 +37,6 @@ module Servant.Client.Core
33 , ServantError(..)
37 , ServantError(..)
34 , EmptyClient(..)
38 , EmptyClient(..)
35
39
36− -- * Request
37− , Request(..)
38− , defaultRequest
39− , RequestBody(..)
40
40
41 -- * Response
41 -- * Response
42 , Response(..)
42 , Response(..)
@@ -44,13 +44,26 @@ module Servant.Client.Core
44 , module Servant.Client.Core.Internal.BaseUrl
44 , module Servant.Client.Core.Internal.BaseUrl
45
45
46 -- * Writing HasClient instances
46 -- * Writing HasClient instances
47+ -- | These functions need not be re-exported by backend libraries.
47 , addHeader
48 , addHeader
48 , appendToQueryString
49 , appendToQueryString
49 , appendToPath
50 , appendToPath
50 , setRequestBodyLBS
51 , setRequestBodyLBS
51 , setRequestBody
52 , setRequestBody
52 ) where
53 ) where
54+import Servant.Client.Core.Internal.Auth
55+import Servant.Client.Core.Internal.BaseUrl (BaseUrl (..),
56+ InvalidBaseUrlException,
57+ Scheme (..),
58+ parseBaseUrl,
59+ showBaseUrl)
60+import Servant.Client.Core.Internal.BasicAuth
61+import Servant.Client.Core.Internal.HasClient
62+import Servant.Client.Core.Internal.Generic
63+import Servant.Client.Core.Internal.Request
64+import Servant.Client.Core.Internal.RunClient
53
65
66+{-
54import Control.Monad.Error.Class (throwError)
67import Control.Monad.Error.Class (throwError)
55import Data.List (foldl')
68import Data.List (foldl')
56import Data.Proxy (Proxy (Proxy))
69import Data.Proxy (Proxy (Proxy))
@@ -581,3 +594,4 @@ non-empty lists, but is otherwise more specific, no instance will be overall
581more specific. This in turn generally means adding yet another instance (one
594more specific. This in turn generally means adding yet another instance (one
582for empty and one for non-empty lists).
595for empty and one for non-empty lists).
583-}
596-}
597+-}
servant-client-core/src/Servant/Client/Core/Internal/Auth.hs+5−5
@@ -20,13 +20,13 @@ type family AuthClientData a :: *
20-- data to a request
20-- data to a request
21--
21--
22-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
22-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
23−newtype AuthenticateReq a =
23+newtype AuthenticatedRequest a =
24− AuthenticateReq { unAuthReq :: (AuthClientData a, AuthClientData a -> Request -> Request) }
24+ AuthenticatedRequest { unAuthReq :: (AuthClientData a, AuthClientData a -> Request -> Request) }
25
25
26-- | Handy helper to avoid wrapping datatypes in tuples everywhere.
26-- | Handy helper to avoid wrapping datatypes in tuples everywhere.
27--
27--
28-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
28-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
29−mkAuthenticateReq :: AuthClientData a
29+mkAuthenticatedRequest :: AuthClientData a
30 -> (AuthClientData a -> Request -> Request)
30 -> (AuthClientData a -> Request -> Request)
31− -> AuthenticateReq a
31+ -> AuthenticatedRequest a
32−mkAuthenticateReq val func = AuthenticateReq (val, func)
32+mkAuthenticatedRequest val func = AuthenticatedRequest (val, func)
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hsnew file+541
@@ -0,0 +1,541 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE InstanceSigs #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TypeFamilies #-}
11+{-# LANGUAGE TypeOperators #-}
12+{-# LANGUAGE UndecidableInstances #-}
13+
14+#include "overlapping-compat.h"
15+module Servant.Client.Core.Internal.HasClient where
16+
17+
18+import Control.Monad.Error.Class (throwError)
19+import Data.List (foldl')
20+import Data.Proxy (Proxy (Proxy))
21+import Data.String (fromString)
22+import Data.Text (pack)
23+import GHC.Exts (fromList, toList)
24+import GHC.TypeLits (KnownSymbol, symbolVal)
25+import qualified Network.HTTP.Types as H
26+import Prelude ()
27+import Prelude.Compat
28+import Servant.API ((:<|>) ((:<|>)), (:>),
29+ AuthProtect, BasicAuth,
30+ BasicAuthData,
31+ BuildHeadersTo (..),
32+ Capture, CaptureAll,
33+ Description, EmptyAPI,
34+ Header, Headers (..),
35+ HttpVersion, IsSecure,
36+ MimeRender (mimeRender),
37+ MimeUnrender (mimeUnrender),
38+ NoContent (NoContent),
39+ QueryFlag, QueryParam,
40+ QueryParams, Raw,
41+ ReflectMethod (..),
42+ RemoteHost, ReqBody,
43+ Summary, ToHttpApiData,
44+ Vault, Verb,
45+ WithNamedContext,
46+ contentType,
47+ getHeadersHList,
48+ getResponse,
49+ toQueryParam,
50+ toUrlPiece)
51+import Servant.API.ContentTypes (contentTypes)
52+
53+import Servant.Client.Core.Internal.Auth
54+import Servant.Client.Core.Internal.BasicAuth
55+import Servant.Client.Core.Internal.Request
56+import Servant.Client.Core.Internal.RunClient
57+
58+-- * Accessing APIs as a Client
59+
60+-- | 'clientIn' allows you to produce operations to query an API from a client
61+-- within a 'RunClient' monad.
62+--
63+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
64+-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books
65+-- >
66+-- > myApi :: Proxy MyApi
67+-- > myApi = Proxy
68+-- >
69+-- > clientM :: Proxy ClientM
70+-- > clientM = Proxy
71+-- >
72+-- > getAllBooks :: ClientM [Book]
73+-- > postNewBook :: Book -> ClientM Book
74+-- > (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM
75+clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api
76+clientIn p pm = clientWithRoute pm p defaultRequest
77+
78+
79+-- | This class lets us define how each API combinator influences the creation
80+-- of an HTTP request.
81+--
82+-- Unless you are writing a new backend for @servant-client-core@ or new
83+-- combinators that you want to support client-generation, you can ignore this
84+-- class.
85+class RunClient m => HasClient m api where
86+ type Client (m :: * -> *) (api :: *) :: *
87+ clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api
88+
89+
90+-- | A client querying function for @a ':<|>' b@ will actually hand you
91+-- one function for querying @a@ and another one for querying @b@,
92+-- stitching them together with ':<|>', which really is just like a pair.
93+--
94+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
95+-- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
96+-- >
97+-- > myApi :: Proxy MyApi
98+-- > myApi = Proxy
99+-- >
100+-- > getAllBooks :: ClientM [Book]
101+-- > postNewBook :: Book -> ClientM Book
102+-- > (getAllBooks :<|> postNewBook) = client myApi
103+instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where
104+ type Client m (a :<|> b) = Client m a :<|> Client m b
105+ clientWithRoute pm Proxy req =
106+ clientWithRoute pm (Proxy :: Proxy a) req :<|>
107+ clientWithRoute pm (Proxy :: Proxy b) req
108+
109+-- | Singleton type representing a client for an empty API.
110+data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
111+
112+-- | The client for 'EmptyAPI' is simply 'EmptyClient'.
113+--
114+-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books
115+-- > :<|> "nothing" :> EmptyAPI
116+-- >
117+-- > myApi :: Proxy MyApi
118+-- > myApi = Proxy
119+-- >
120+-- > getAllBooks :: ClientM [Book]
121+-- > (getAllBooks :<|> EmptyClient) = client myApi
122+instance RunClient m => HasClient m EmptyAPI where
123+ type Client m EmptyAPI = EmptyClient
124+ clientWithRoute _pm Proxy _ = EmptyClient
125+
126+-- | If you use a 'Capture' in one of your endpoints in your API,
127+-- the corresponding querying function will automatically take
128+-- an additional argument of the type specified by your 'Capture'.
129+-- That function will take care of inserting a textual representation
130+-- of this value at the right place in the request path.
131+--
132+-- You can control how values for this type are turned into
133+-- text by specifying a 'ToHttpApiData' instance for your type.
134+--
135+-- Example:
136+--
137+-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
138+-- >
139+-- > myApi :: Proxy MyApi
140+-- > myApi = Proxy
141+-- >
142+-- > getBook :: Text -> ClientM Book
143+-- > getBook = client myApi
144+-- > -- then you can just use "getBook" to query that endpoint
145+instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
146+ => HasClient m (Capture capture a :> api) where
147+
148+ type Client m (Capture capture a :> api) =
149+ a -> Client m api
150+
151+ clientWithRoute pm Proxy req val =
152+ clientWithRoute pm (Proxy :: Proxy api)
153+ (appendToPath p req)
154+
155+ where p = (toUrlPiece val)
156+
157+-- | If you use a 'CaptureAll' in one of your endpoints in your API,
158+-- the corresponding querying function will automatically take an
159+-- additional argument of a list of the type specified by your
160+-- 'CaptureAll'. That function will take care of inserting a textual
161+-- representation of this value at the right place in the request
162+-- path.
163+--
164+-- You can control how these values are turned into text by specifying
165+-- a 'ToHttpApiData' instance of your type.
166+--
167+-- Example:
168+--
169+-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile
170+-- >
171+-- > myApi :: Proxy
172+-- > myApi = Proxy
173+--
174+-- > getSourceFile :: [Text] -> ClientM SourceFile
175+-- > getSourceFile = client myApi
176+-- > -- then you can use "getSourceFile" to query that endpoint
177+instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
178+ => HasClient m (CaptureAll capture a :> sublayout) where
179+
180+ type Client m (CaptureAll capture a :> sublayout) =
181+ [a] -> Client m sublayout
182+
183+ clientWithRoute pm Proxy req vals =
184+ clientWithRoute pm (Proxy :: Proxy sublayout)
185+ (foldl' (flip appendToPath) req ps)
186+
187+ where ps = map (toUrlPiece) vals
188+
189+instance OVERLAPPABLE_
190+ -- Note [Non-Empty Content Types]
191+ ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
192+ ) => HasClient m (Verb method status cts' a) where
193+ type Client m (Verb method status cts' a) = m a
194+ clientWithRoute _pm Proxy req = do
195+ response <- runRequest req
196+ { requestAccept = fromList $ toList accept
197+ , requestMethod = method
198+ }
199+ response `decodedAs` (Proxy :: Proxy ct)
200+ where
201+ accept = contentTypes (Proxy :: Proxy ct)
202+ method = reflectMethod (Proxy :: Proxy method)
203+
204+instance OVERLAPPING_
205+ ( RunClient m, ReflectMethod method
206+ ) => HasClient m (Verb method status cts NoContent) where
207+ type Client m (Verb method status cts NoContent)
208+ = m NoContent
209+ clientWithRoute _pm Proxy req = do
210+ _response <- runRequest req { requestMethod = method }
211+ return NoContent
212+ where method = reflectMethod (Proxy :: Proxy method)
213+
214+instance OVERLAPPING_
215+ -- Note [Non-Empty Content Types]
216+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
217+ , ReflectMethod method, cts' ~ (ct ': cts)
218+ ) => HasClient m (Verb method status cts' (Headers ls a)) where
219+ type Client m (Verb method status cts' (Headers ls a))
220+ = m (Headers ls a)
221+ clientWithRoute _pm Proxy req = do
222+ response <- runRequest req
223+ { requestMethod = method
224+ , requestAccept = fromList $ toList accept
225+ }
226+ case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
227+ Left err -> throwError $ DecodeFailure (pack err) response
228+ Right val -> return $ Headers
229+ { getResponse = val
230+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
231+ }
232+ where method = reflectMethod (Proxy :: Proxy method)
233+ accept = contentTypes (Proxy :: Proxy ct)
234+
235+instance OVERLAPPING_
236+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method
237+ ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
238+ type Client m (Verb method status cts (Headers ls NoContent))
239+ = m (Headers ls NoContent)
240+ clientWithRoute _pm Proxy req = do
241+ let method = reflectMethod (Proxy :: Proxy method)
242+ response <- runRequest req { requestMethod = method }
243+ return $ Headers { getResponse = NoContent
244+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
245+ }
246+
247+
248+-- | If you use a 'Header' in one of your endpoints in your API,
249+-- the corresponding querying function will automatically take
250+-- an additional argument of the type specified by your 'Header',
251+-- wrapped in Maybe.
252+--
253+-- That function will take care of encoding this argument as Text
254+-- in the request headers.
255+--
256+-- All you need is for your type to have a 'ToHttpApiData' instance.
257+--
258+-- Example:
259+--
260+-- > newtype Referer = Referer { referrer :: Text }
261+-- > deriving (Eq, Show, Generic, ToHttpApiData)
262+-- >
263+-- > -- GET /view-my-referer
264+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
265+-- >
266+-- > myApi :: Proxy MyApi
267+-- > myApi = Proxy
268+-- >
269+-- > viewReferer :: Maybe Referer -> ClientM Book
270+-- > viewReferer = client myApi
271+-- > -- then you can just use "viewRefer" to query that endpoint
272+-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
273+instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
274+ => HasClient m (Header sym a :> api) where
275+
276+ type Client m (Header sym a :> api) =
277+ Maybe a -> Client m api
278+
279+ clientWithRoute pm Proxy req mval =
280+ clientWithRoute pm (Proxy :: Proxy api)
281+ (maybe req
282+ (\value -> addHeader hname value req)
283+ mval
284+ )
285+
286+ where hname = fromString $ symbolVal (Proxy :: Proxy sym)
287+
288+-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
289+-- functions.
290+instance HasClient m api
291+ => HasClient m (HttpVersion :> api) where
292+
293+ type Client m (HttpVersion :> api) =
294+ Client m api
295+
296+ clientWithRoute pm Proxy =
297+ clientWithRoute pm (Proxy :: Proxy api)
298+
299+-- | Ignore @'Summary'@ in client functions.
300+instance HasClient m api => HasClient m (Summary desc :> api) where
301+ type Client m (Summary desc :> api) = Client m api
302+
303+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
304+
305+-- | Ignore @'Description'@ in client functions.
306+instance HasClient m api => HasClient m (Description desc :> api) where
307+ type Client m (Description desc :> api) = Client m api
308+
309+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
310+
311+-- | If you use a 'QueryParam' in one of your endpoints in your API,
312+-- the corresponding querying function will automatically take
313+-- an additional argument of the type specified by your 'QueryParam',
314+-- enclosed in Maybe.
315+--
316+-- If you give Nothing, nothing will be added to the query string.
317+--
318+-- If you give a non-'Nothing' value, this function will take care
319+-- of inserting a textual representation of this value in the query string.
320+--
321+-- You can control how values for your type are turned into
322+-- text by specifying a 'ToHttpApiData' instance for your type.
323+--
324+-- Example:
325+--
326+-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
327+-- >
328+-- > myApi :: Proxy MyApi
329+-- > myApi = Proxy
330+-- >
331+-- > getBooksBy :: Maybe Text -> ClientM [Book]
332+-- > getBooksBy = client myApi
333+-- > -- then you can just use "getBooksBy" to query that endpoint.
334+-- > -- 'getBooksBy Nothing' for all books
335+-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
336+instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
337+ => HasClient m (QueryParam sym a :> api) where
338+
339+ type Client m (QueryParam sym a :> api) =
340+ Maybe a -> Client m api
341+
342+ -- if mparam = Nothing, we don't add it to the query string
343+ clientWithRoute pm Proxy req mparam =
344+ clientWithRoute pm (Proxy :: Proxy api)
345+ (maybe req
346+ (flip (appendToQueryString pname) req . Just)
347+ mparamText
348+ )
349+
350+ where pname = pack $ symbolVal (Proxy :: Proxy sym)
351+ mparamText = fmap toQueryParam mparam
352+
353+-- | If you use a 'QueryParams' in one of your endpoints in your API,
354+-- the corresponding querying function will automatically take
355+-- an additional argument, a list of values of the type specified
356+-- by your 'QueryParams'.
357+--
358+-- If you give an empty list, nothing will be added to the query string.
359+--
360+-- Otherwise, this function will take care
361+-- of inserting a textual representation of your values in the query string,
362+-- under the same query string parameter name.
363+--
364+-- You can control how values for your type are turned into
365+-- text by specifying a 'ToHttpApiData' instance for your type.
366+--
367+-- Example:
368+--
369+-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
370+-- >
371+-- > myApi :: Proxy MyApi
372+-- > myApi = Proxy
373+-- >
374+-- > getBooksBy :: [Text] -> ClientM [Book]
375+-- > getBooksBy = client myApi
376+-- > -- then you can just use "getBooksBy" to query that endpoint.
377+-- > -- 'getBooksBy []' for all books
378+-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
379+-- > -- to get all books by Asimov and Heinlein
380+instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
381+ => HasClient m (QueryParams sym a :> api) where
382+
383+ type Client m (QueryParams sym a :> api) =
384+ [a] -> Client m api
385+
386+ clientWithRoute pm Proxy req paramlist =
387+ clientWithRoute pm (Proxy :: Proxy api)
388+ (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
389+ req
390+ paramlist'
391+ )
392+
393+ where pname = pack $ symbolVal (Proxy :: Proxy sym)
394+ paramlist' = map (Just . toQueryParam) paramlist
395+
396+-- | If you use a 'QueryFlag' in one of your endpoints in your API,
397+-- the corresponding querying function will automatically take
398+-- an additional 'Bool' argument.
399+--
400+-- If you give 'False', nothing will be added to the query string.
401+--
402+-- Otherwise, this function will insert a value-less query string
403+-- parameter under the name associated to your 'QueryFlag'.
404+--
405+-- Example:
406+--
407+-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
408+-- >
409+-- > myApi :: Proxy MyApi
410+-- > myApi = Proxy
411+-- >
412+-- > getBooks :: Bool -> ClientM [Book]
413+-- > getBooks = client myApi
414+-- > -- then you can just use "getBooks" to query that endpoint.
415+-- > -- 'getBooksBy False' for all books
416+-- > -- 'getBooksBy True' to only get _already published_ books
417+instance (KnownSymbol sym, HasClient m api)
418+ => HasClient m (QueryFlag sym :> api) where
419+
420+ type Client m (QueryFlag sym :> api) =
421+ Bool -> Client m api
422+
423+ clientWithRoute pm Proxy req flag =
424+ clientWithRoute pm (Proxy :: Proxy api)
425+ (if flag
426+ then appendToQueryString paramname Nothing req
427+ else req
428+ )
429+
430+ where paramname = pack $ symbolVal (Proxy :: Proxy sym)
431+
432+
433+-- | Pick a 'Method' and specify where the server you want to query is. You get
434+-- back the full `Response`.
435+instance RunClient m => HasClient m Raw where
436+ type Client m Raw
437+ = H.Method -> m Response
438+
439+ clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw
440+ clientWithRoute _pm Proxy req httpMethod = do
441+ runRequest req { requestMethod = httpMethod }
442+
443+-- | If you use a 'ReqBody' in one of your endpoints in your API,
444+-- the corresponding querying function will automatically take
445+-- an additional argument of the type specified by your 'ReqBody'.
446+-- That function will take care of encoding this argument as JSON and
447+-- of using it as the request body.
448+--
449+-- All you need is for your type to have a 'ToJSON' instance.
450+--
451+-- Example:
452+--
453+-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
454+-- >
455+-- > myApi :: Proxy MyApi
456+-- > myApi = Proxy
457+-- >
458+-- > addBook :: Book -> ClientM Book
459+-- > addBook = client myApi
460+-- > -- then you can just use "addBook" to query that endpoint
461+instance (MimeRender ct a, HasClient m api)
462+ => HasClient m (ReqBody (ct ': cts) a :> api) where
463+
464+ type Client m (ReqBody (ct ': cts) a :> api) =
465+ a -> Client m api
466+
467+ clientWithRoute pm Proxy req body =
468+ clientWithRoute pm (Proxy :: Proxy api)
469+ (let ctProxy = Proxy :: Proxy ct
470+ in setRequestBodyLBS (mimeRender ctProxy body)
471+ -- We use first contentType from the Accept list
472+ (contentType ctProxy)
473+ req
474+ )
475+
476+-- | Make the querying function append @path@ to the request path.
477+instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
478+ type Client m (path :> api) = Client m api
479+
480+ clientWithRoute pm Proxy req =
481+ clientWithRoute pm (Proxy :: Proxy api)
482+ (appendToPath p req)
483+
484+ where p = pack $ symbolVal (Proxy :: Proxy path)
485+
486+instance HasClient m api => HasClient m (Vault :> api) where
487+ type Client m (Vault :> api) = Client m api
488+
489+ clientWithRoute pm Proxy req =
490+ clientWithRoute pm (Proxy :: Proxy api) req
491+
492+instance HasClient m api => HasClient m (RemoteHost :> api) where
493+ type Client m (RemoteHost :> api) = Client m api
494+
495+ clientWithRoute pm Proxy req =
496+ clientWithRoute pm (Proxy :: Proxy api) req
497+
498+instance HasClient m api => HasClient m (IsSecure :> api) where
499+ type Client m (IsSecure :> api) = Client m api
500+
501+ clientWithRoute pm Proxy req =
502+ clientWithRoute pm (Proxy :: Proxy api) req
503+
504+instance HasClient m subapi =>
505+ HasClient m (WithNamedContext name context subapi) where
506+
507+ type Client m (WithNamedContext name context subapi) = Client m subapi
508+ clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
509+
510+instance ( HasClient m api
511+ ) => HasClient m (AuthProtect tag :> api) where
512+ type Client m (AuthProtect tag :> api)
513+ = AuthenticatedRequest (AuthProtect tag) -> Client m api
514+
515+ clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) =
516+ clientWithRoute pm (Proxy :: Proxy api) (func val req)
517+
518+-- * Basic Authentication
519+
520+instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
521+ type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api
522+
523+ clientWithRoute pm Proxy req val =
524+ clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)
525+
526+
527+{- Note [Non-Empty Content Types]
528+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
529+Rather than have
530+
531+ instance (..., cts' ~ (ct ': cts)) => ... cts' ...
532+
533+It may seem to make more sense to have:
534+
535+ instance (...) => ... (ct ': cts) ...
536+
537+But this means that if another instance exists that does *not* require
538+non-empty lists, but is otherwise more specific, no instance will be overall
539+more specific. This in turn generally means adding yet another instance (one
540+for empty and one for non-empty lists).
541+-}
servant-client-core/src/Servant/Client/Core/Internal/Class.hs → servant-client-core/src/Servant/Client/Core/Internal/RunClient.hsrenamed+1−1
@@ -4,7 +4,7 @@
4{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE OverloadedStrings #-}
6-- | Types for possible backends to run client-side `Request` queries
6-- | Types for possible backends to run client-side `Request` queries
7−module Servant.Client.Core.Internal.Class where
7+module Servant.Client.Core.Internal.RunClient where
8
8
9import Control.Monad (unless)
9import Control.Monad (unless)
10import Control.Monad.Error.Class (MonadError, throwError)
10import Control.Monad.Error.Class (MonadError, throwError)
servant-client-core/src/Servant/Client/Core/Reexport.hsnew file+30
@@ -0,0 +1,30 @@
1+-- | This module is a utility for @servant-client-core@ backend writers. It
2+-- contains all the functionality fron @servant-client-core@ that should be
3+-- re-exported.
4+module Servant.Client.Core.Reexport
5+ (
6+ -- * HasClient
7+ HasClient(..)
8+ -- * Response (for @Raw@)
9+ , Response(..)
10+
11+ -- * Generic Client
12+ , ClientLike(..)
13+ , genericMkClientL
14+ , genericMkClientP
15+ , ServantError(..)
16+ , EmptyClient(..)
17+
18+ -- * BaseUrl
19+ , BaseUrl(..)
20+ , Scheme(..)
21+ , showBaseUrl
22+ , parseBaseUrl
23+ , InvalidBaseUrlException
24+ ) where
25+
26+
27+import Servant.Client.Core.Internal.BaseUrl
28+import Servant.Client.Core.Internal.HasClient
29+import Servant.Client.Core.Internal.Generic
30+import Servant.Client.Core.Internal.Request
servant-client/servant-client.cabal+1
@@ -86,6 +86,7 @@ test-suite spec
86 , QuickCheck >= 2.7
86 , QuickCheck >= 2.7
87 , servant
87 , servant
88 , servant-client
88 , servant-client
89+ , servant-client-core
89 , servant-server == 0.11.*
90 , servant-server == 0.11.*
90 , text
91 , text
91 , transformers
92 , transformers
servant-client/src/Servant/Client.hs+2−2
@@ -6,8 +6,8 @@ module Servant.Client
6 , ClientM
6 , ClientM
7 , runClientM
7 , runClientM
8 , ClientEnv(..)
8 , ClientEnv(..)
9− , module Servant.Client.Core
9+ , module X
10 ) where
10 ) where
11
11
12import Servant.Client.Internal.HttpClient
12import Servant.Client.Internal.HttpClient
13−import Servant.Client.Core
13+import Servant.Client.Core.Reexport as X
servant-client/src/Servant/Client/Internal/HttpClient.hs+1−2
@@ -9,7 +9,7 @@
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE TypeFamilies #-}
11
11
12−{-| http-client based client requests executor -}
12+-- | @http-client@-based client requests executor
13module Servant.Client.Internal.HttpClient where
13module Servant.Client.Internal.HttpClient where
14
14
15
15
@@ -96,7 +96,6 @@ runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
96runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
96runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
97
97
98
98
99−
100performRequest :: Request -> ClientM Response
99performRequest :: Request -> ClientM Response
101performRequest req = do
100performRequest req = do
102 m <- asks manager
101 m <- asks manager
servant-client/test/Servant/ClientSpec.hs+6−4
@@ -73,6 +73,8 @@ import Servant.API ((:<|>) ((:<|>)),
73 getHeaders)
73 getHeaders)
74import Servant.API.Internal.Test.ComprehensiveAPI
74import Servant.API.Internal.Test.ComprehensiveAPI
75import Servant.Client
75import Servant.Client
76+import qualified Servant.Client.Core.Internal.Request as Req
77+import qualified Servant.Client.Core.Internal.Auth as Auth
76import Servant.Server
78import Servant.Server
77import Servant.Server.Experimental.Auth
79import Servant.Server.Experimental.Auth
78
80
@@ -176,7 +178,7 @@ server = serve api (
176 :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
178 :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
177 :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")
179 :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")
178 :<|> (\ a b c d -> return (a, b, c, d))
180 :<|> (\ a b c d -> return (a, b, c, d))
179− :<|> (return $ Servant.API.addHeader 1729 $ Servant.API.addHeader "eg2" True)
181+ :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
180 :<|> return NoContent
182 :<|> return NoContent
181 :<|> emptyServer)
183 :<|> emptyServer)
182
184
@@ -226,7 +228,7 @@ genAuthAPI :: Proxy GenAuthAPI
226genAuthAPI = Proxy
228genAuthAPI = Proxy
227
229
228type instance AuthServerData (AuthProtect "auth-tag") = ()
230type instance AuthServerData (AuthProtect "auth-tag") = ()
229−type instance AuthClientData (AuthProtect "auth-tag") = ()
231+type instance Auth.AuthClientData (AuthProtect "auth-tag") = ()
230
232
231genAuthHandler :: AuthHandler Wai.Request ()
233genAuthHandler :: AuthHandler Wai.Request ()
232genAuthHandler =
234genAuthHandler =
@@ -450,14 +452,14 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
450
452
451 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
453 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
452 let getProtected = client genAuthAPI
454 let getProtected = client genAuthAPI
453− let authRequest = mkAuthenticateReq () (\_ req -> Servant.Client.addHeader "AuthHeader" ("cool" :: String) req)
455+ let authRequest = Auth.mkAuthenticatedRequest () (\_ req -> Req.addHeader "AuthHeader" ("cool" :: String) req)
454 left show <$> runClient (getProtected authRequest) baseUrl `shouldReturn` Right alice
456 left show <$> runClient (getProtected authRequest) baseUrl `shouldReturn` Right alice
455
457
456 context "Authentication is rejected when requests are not authenticated properly" $ do
458 context "Authentication is rejected when requests are not authenticated properly" $ do
457
459
458 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
460 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
459 let getProtected = client genAuthAPI
461 let getProtected = client genAuthAPI
460− let authRequest = mkAuthenticateReq () (\_ req -> Servant.Client.addHeader "Wrong" ("header" :: String) req)
462+ let authRequest = Auth.mkAuthenticatedRequest () (\_ req -> Req.addHeader "Wrong" ("header" :: String) req)
461 Left (FailureResponse r) <- runClient (getProtected authRequest) baseUrl
463 Left (FailureResponse r) <- runClient (getProtected authRequest) baseUrl
462 responseStatusCode r `shouldBe` (HTTP.Status 401 "Unauthorized")
464 responseStatusCode r `shouldBe` (HTTP.Status 401 "Unauthorized")
463
465