@@ -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+-}