@@ -1,1011 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE InstanceSigs #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−{-# LANGUAGE OverloadedStrings #-}
8−{-# LANGUAGE PolyKinds #-}
9−{-# LANGUAGE QuantifiedConstraints #-}
10−{-# LANGUAGE RankNTypes #-}
11−{-# LANGUAGE ScopedTypeVariables #-}
12−{-# LANGUAGE TypeApplications #-}
13−{-# LANGUAGE TypeFamilies #-}
14−{-# LANGUAGE TypeOperators #-}
15−{-# LANGUAGE UndecidableInstances #-}
17−module Servant.Client.Core.HasClient (
35−import qualified Data.ByteString as BS
36−import qualified Data.ByteString.Lazy as BL
39−import Data.Constraint (Dict(..))
46−import qualified Data.Text as T
47−import Network.HTTP.Media
48− (MediaType, matches, parseAccept)
49−import qualified Network.HTTP.Media as Media
50−import qualified Data.Sequence as Seq
51−import Data.SOP.BasicFunctors
52− (I (I), (:.:) (Comp))
53−import Data.SOP.Constraint
66− (KnownNat, KnownSymbol, TypeError, symbolVal)
67−import Network.HTTP.Types
69−import qualified Network.HTTP.Types as H
71− ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,
72− BuildHeadersTo (..), Capture', CaptureAll, Description,
73− EmptyAPI, Fragment, FramingRender (..), FramingUnrender (..),
74− FromSourceIO (..), Header', Headers (..), HttpVersion,
75− IsSecure, MimeRender (mimeRender),
76− MimeUnrender (mimeUnrender), NoContent (NoContent),
77− NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM,
78− ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
79− StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
80− Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList,
81− getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)
82−import Servant.API.Generic
83− (GenericMode(..), ToServant, ToServantApi
84− , GenericServant, toServant, fromServant)
85−import Servant.API.ContentTypes
86− (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
87−import Servant.API.Status
89−import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
90−import Servant.API.Modifiers
91− (FoldRequired, RequiredArgument, foldRequiredArgument)
92−import Servant.API.TypeErrors
93−import Servant.API.UVerb
94− (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
96−import Servant.Client.Core.Auth
97−import Servant.Client.Core.BasicAuth
98−import Servant.Client.Core.ClientError
99−import Servant.Client.Core.Request
100−import Servant.Client.Core.Response
101−import Servant.Client.Core.RunClient
103−-- * Accessing APIs as a Client
105−-- | 'clientIn' allows you to produce operations to query an API from a client
106−-- within a 'RunClient' monad.
108−-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
109−-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books
111−-- > myApi :: Proxy MyApi
114−-- > clientM :: Proxy ClientM
117−-- > getAllBooks :: ClientM [Book]
118−-- > postNewBook :: Book -> ClientM Book
119−-- > (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM
120−clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api
121−clientIn p pm = clientWithRoute pm p defaultRequest
124−-- | This class lets us define how each API combinator influences the creation
125−-- of an HTTP request.
127−-- Unless you are writing a new backend for @servant-client-core@ or new
128−-- combinators that you want to support client-generation, you can ignore this
130−class RunClient m => HasClient m api where
131− type Client (m :: * -> *) (api :: *) :: *
132− clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api
136− -> (forall x. mon x -> mon' x)
141−-- | A client querying function for @a ':<|>' b@ will actually hand you
142−-- one function for querying @a@ and another one for querying @b@,
143−-- stitching them together with ':<|>', which really is just like a pair.
145−-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
146−-- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
148−-- > myApi :: Proxy MyApi
151−-- > getAllBooks :: ClientM [Book]
152−-- > postNewBook :: Book -> ClientM Book
153−-- > (getAllBooks :<|> postNewBook) = client myApi
154−instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where
155− type Client m (a :<|> b) = Client m a :<|> Client m b
156− clientWithRoute pm Proxy req =
157− clientWithRoute pm (Proxy :: Proxy a) req :<|>
158− clientWithRoute pm (Proxy :: Proxy b) req
160− hoistClientMonad pm _ f (ca :<|> cb) =
161− hoistClientMonad pm (Proxy :: Proxy a) f ca :<|>
162− hoistClientMonad pm (Proxy :: Proxy b) f cb
164−-- | Singleton type representing a client for an empty API.
165−data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
167−-- | The client for 'EmptyAPI' is simply 'EmptyClient'.
169−-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books
170−-- > :<|> "nothing" :> EmptyAPI
172−-- > myApi :: Proxy MyApi
175−-- > getAllBooks :: ClientM [Book]
176−-- > (getAllBooks :<|> EmptyClient) = client myApi
177−instance RunClient m => HasClient m EmptyAPI where
178− type Client m EmptyAPI = EmptyClient
179− clientWithRoute _pm Proxy _ = EmptyClient
180− hoistClientMonad _ _ _ EmptyClient = EmptyClient
182−-- | If you use a 'Capture' in one of your endpoints in your API,
183−-- the corresponding querying function will automatically take
184−-- an additional argument of the type specified by your 'Capture'.
185−-- That function will take care of inserting a textual representation
186−-- of this value at the right place in the request path.
188−-- You can control how values for this type are turned into
189−-- text by specifying a 'ToHttpApiData' instance for your type.
193−-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
195−-- > myApi :: Proxy MyApi
198−-- > getBook :: Text -> ClientM Book
199−-- > getBook = client myApi
200−-- > -- then you can just use "getBook" to query that endpoint
201−instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
202− => HasClient m (Capture' mods capture a :> api) where
204− type Client m (Capture' mods capture a :> api) =
207− clientWithRoute pm Proxy req val =
208− clientWithRoute pm (Proxy :: Proxy api)
209− (appendToPath p req)
211− where p = toEncodedUrlPiece val
213− hoistClientMonad pm _ f cl = \a ->
214− hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
216−-- | If you use a 'CaptureAll' in one of your endpoints in your API,
217−-- the corresponding querying function will automatically take an
218−-- additional argument of a list of the type specified by your
219−-- 'CaptureAll'. That function will take care of inserting a textual
220−-- representation of this value at the right place in the request
223−-- You can control how these values are turned into text by specifying
224−-- a 'ToHttpApiData' instance of your type.
228−-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile
233−-- > getSourceFile :: [Text] -> ClientM SourceFile
234−-- > getSourceFile = client myApi
235−-- > -- then you can use "getSourceFile" to query that endpoint
236−instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
237− => HasClient m (CaptureAll capture a :> sublayout) where
239− type Client m (CaptureAll capture a :> sublayout) =
240− [a] -> Client m sublayout
242− clientWithRoute pm Proxy req vals =
243− clientWithRoute pm (Proxy :: Proxy sublayout)
244− (foldl' (flip appendToPath) req ps)
246− where ps = map toEncodedUrlPiece vals
248− hoistClientMonad pm _ f cl = \as ->
249− hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
251−instance {-# OVERLAPPABLE #-}
252− -- Note [Non-Empty Content Types]
253− ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
255− ) => HasClient m (Verb method status cts' a) where
256− type Client m (Verb method status cts' a) = m a
257− clientWithRoute _pm Proxy req = do
258− response <- runRequestAcceptStatus (Just [status]) req
259− { requestAccept = fromList $ toList accept
260− , requestMethod = method
262− response `decodedAs` (Proxy :: Proxy ct)
264− accept = contentTypes (Proxy :: Proxy ct)
265− method = reflectMethod (Proxy :: Proxy method)
266− status = statusFromNat (Proxy :: Proxy status)
268− hoistClientMonad _ _ f ma = f ma
270−instance {-# OVERLAPPING #-}
271− ( RunClient m, ReflectMethod method, KnownNat status
272− ) => HasClient m (Verb method status cts NoContent) where
273− type Client m (Verb method status cts NoContent)
275− clientWithRoute _pm Proxy req = do
276− _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
278− where method = reflectMethod (Proxy :: Proxy method)
279− status = statusFromNat (Proxy :: Proxy status)
281− hoistClientMonad _ _ f ma = f ma
283−instance (RunClient m, ReflectMethod method) =>
284− HasClient m (NoContentVerb method) where
285− type Client m (NoContentVerb method)
287− clientWithRoute _pm Proxy req = do
288− _response <- runRequest req { requestMethod = method }
290− where method = reflectMethod (Proxy :: Proxy method)
292− hoistClientMonad _ _ f ma = f ma
294−instance {-# OVERLAPPING #-}
295− -- Note [Non-Empty Content Types]
296− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status
297− , ReflectMethod method, cts' ~ (ct ': cts)
298− ) => HasClient m (Verb method status cts' (Headers ls a)) where
299− type Client m (Verb method status cts' (Headers ls a))
301− clientWithRoute _pm Proxy req = do
302− response <- runRequestAcceptStatus (Just [status]) req
303− { requestMethod = method
304− , requestAccept = fromList $ toList accept
306− val <- response `decodedAs` (Proxy :: Proxy ct)
307− return $ Headers { getResponse = val
308− , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
311− method = reflectMethod (Proxy :: Proxy method)
312− accept = contentTypes (Proxy :: Proxy ct)
313− status = statusFromNat (Proxy :: Proxy status)
315− hoistClientMonad _ _ f ma = f ma
317−instance {-# OVERLAPPING #-}
318− ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status
319− ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
320− type Client m (Verb method status cts (Headers ls NoContent))
321− = m (Headers ls NoContent)
322− clientWithRoute _pm Proxy req = do
323− response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
324− return $ Headers { getResponse = NoContent
325− , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
328− method = reflectMethod (Proxy :: Proxy method)
329− status = statusFromNat (Proxy :: Proxy status)
331− hoistClientMonad _ _ f ma = f ma
333−data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch | ClientNoMatchingStatus
336−class UnrenderResponse (cts :: [*]) (a :: *) where
337− unrenderResponse :: Seq.Seq H.Header -> BL.ByteString -> Proxy cts
338− -> [Either (MediaType, String) a]
340−instance {-# OVERLAPPABLE #-} AllMimeUnrender cts a => UnrenderResponse cts a where
341− unrenderResponse _ body = map parse . allMimeUnrender
342− where parse (mediaType, parser) = left ((,) mediaType) (parser body)
344−instance {-# OVERLAPPING #-} forall cts a h . (UnrenderResponse cts a, BuildHeadersTo h)
345− => UnrenderResponse cts (Headers h a) where
346− unrenderResponse hs body = (map . fmap) setHeaders . unrenderResponse hs body
348− setHeaders :: a -> Headers h a
349− setHeaders x = Headers x (buildHeadersTo (toList hs))
351−instance {-# OVERLAPPING #-} UnrenderResponse cts a
352− => UnrenderResponse cts (WithStatus n a) where
353− unrenderResponse hs body = (map . fmap) WithStatus . unrenderResponse hs body
355−instance {-# OVERLAPPING #-}
357− contentTypes ~ (contentType ': otherContentTypes),
358− -- ('otherContentTypes' should be '_', but even -XPartialTypeSignatures does not seem
359− -- allow this in instance types as of 8.8.3.)
361− AllMime contentTypes,
362− ReflectMethod method,
363− All (UnrenderResponse contentTypes) as,
364− All HasStatus as, HasStatuses as',
365− Unique (Statuses as)
367− HasClient m (UVerb method contentTypes as)
369− type Client m (UVerb method contentTypes as) = m (Union as)
371− clientWithRoute _ _ request = do
372− let accept = Seq.fromList . allMime $ Proxy @contentTypes
373− -- offering to accept all mime types listed in the api gives best compatibility. eg.,
374− -- we might not own the server implementation, and the server may choose to support
375− -- only part of the api.
377− method = reflectMethod $ Proxy @method
378− acceptStatus = statuses (Proxy @as)
379− response <- runRequestAcceptStatus (Just acceptStatus) request {requestMethod = method, requestAccept = accept}
380− responseContentType <- checkContentTypeHeader response
381− unless (any (matches responseContentType) accept) $ do
382− throwClientError $ UnsupportedContentType responseContentType response
384− let status = responseStatusCode response
385− body = responseBody response
386− headers = responseHeaders response
387− res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) headers body
389− Left errors -> throwClientError $ DecodeFailure (T.pack (show errors)) response
392− -- | Given a list of parsers of 'mkres', returns the first one that succeeds and all the
393− -- failures it encountered along the way
394− -- TODO; better name, rewrite haddocs.
395− tryParsers :: forall xs. All HasStatus xs => Status -> NP ([] :.: Either (MediaType, String)) xs -> Either [ClientParseError] (Union xs)
396− tryParsers _ Nil = Left [ClientNoMatchingStatus]
397− tryParsers status (Comp x :* xs)
398− | status == statusOf (Comp x) =
399− case partitionEithers x of
400− (err', []) -> (map (uncurry ClientParseError) err' ++) +++ S $ tryParsers status xs
401− (_, (res : _)) -> Right . inject . I $ res
402− | otherwise = -- no reason to parse in the first place. This ain't the one we're looking for
403− (ClientStatusMismatch :) +++ S $ tryParsers status xs
405− -- | Given a list of types, parses the given response body as each type
408− All (UnrenderResponse cts) xs =>
412− NP ([] :.: Either (MediaType, String)) xs
413− mimeUnrenders ctp headers body = cpure_NP
414− (Proxy @(UnrenderResponse cts))
415− (Comp . unrenderResponse headers body $ ctp)
417− hoistClientMonad _ _ nt s = nt s
419−instance {-# OVERLAPPABLE #-}
420− ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,
421− FramingUnrender framing, FromSourceIO chunk a
422− ) => HasClient m (Stream method status framing ct a) where
424− type Client m (Stream method status framing ct a) = m a
426− hoistClientMonad _ _ f ma = f ma
428− clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do
429− let mimeUnrender' = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
430− framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
431− return $ fromSourceIO $ framingUnrender' $ responseBody gres
434− { requestAccept = fromList [contentType (Proxy :: Proxy ct)]
435− , requestMethod = reflectMethod (Proxy :: Proxy method)
438−instance {-# OVERLAPPING #-}
439− ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,
440− FramingUnrender framing, FromSourceIO chunk a,
442− ) => HasClient m (Stream method status framing ct (Headers hs a)) where
444− type Client m (Stream method status framing ct (Headers hs a)) = m (Headers hs a)
446− hoistClientMonad _ _ f ma = f ma
448− clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do
449− let mimeUnrender' = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
450− framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
451− val = fromSourceIO $ framingUnrender' $ responseBody gres
454− , getHeadersHList = buildHeadersTo . toList $ responseHeaders gres
459− { requestAccept = fromList [contentType (Proxy :: Proxy ct)]
460− , requestMethod = reflectMethod (Proxy :: Proxy method)
463−-- | If you use a 'Header' in one of your endpoints in your API,
464−-- the corresponding querying function will automatically take
465−-- an additional argument of the type specified by your 'Header',
468−-- That function will take care of encoding this argument as Text
469−-- in the request headers.
471−-- All you need is for your type to have a 'ToHttpApiData' instance.
475−-- > newtype Referer = Referer { referrer :: Text }
476−-- > deriving (Eq, Show, Generic, ToHttpApiData)
478−-- > -- GET /view-my-referer
479−-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
481−-- > myApi :: Proxy MyApi
484−-- > viewReferer :: Maybe Referer -> ClientM Book
485−-- > viewReferer = client myApi
486−-- > -- then you can just use "viewRefer" to query that endpoint
487−-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
488−instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods))
489− => HasClient m (Header' mods sym a :> api) where
491− type Client m (Header' mods sym a :> api) =
492− RequiredArgument mods a -> Client m api
494− clientWithRoute pm Proxy req mval =
495− clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument
496− (Proxy :: Proxy mods) add (maybe req add) mval
498− hname = fromString $ symbolVal (Proxy :: Proxy sym)
501− add value = addHeader hname value req
503− hoistClientMonad pm _ f cl = \arg ->
504− hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
506−-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
508−instance HasClient m api
509− => HasClient m (HttpVersion :> api) where
511− type Client m (HttpVersion :> api) =
514− clientWithRoute pm Proxy =
515− clientWithRoute pm (Proxy :: Proxy api)
517− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
519−-- | Ignore @'Summary'@ in client functions.
520−instance HasClient m api => HasClient m (Summary desc :> api) where
521− type Client m (Summary desc :> api) = Client m api
523− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
525− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
527−-- | Ignore @'Description'@ in client functions.
528−instance HasClient m api => HasClient m (Description desc :> api) where
529− type Client m (Description desc :> api) = Client m api
531− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
533− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
535−-- | If you use a 'QueryParam' in one of your endpoints in your API,
536−-- the corresponding querying function will automatically take
537−-- an additional argument of the type specified by your 'QueryParam',
538−-- enclosed in Maybe.
540−-- If you give Nothing, nothing will be added to the query string.
542−-- If you give a non-'Nothing' value, this function will take care
543−-- of inserting a textual representation of this value in the query string.
545−-- You can control how values for your type are turned into
546−-- text by specifying a 'ToHttpApiData' instance for your type.
550−-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
552−-- > myApi :: Proxy MyApi
555−-- > getBooksBy :: Maybe Text -> ClientM [Book]
556−-- > getBooksBy = client myApi
557−-- > -- then you can just use "getBooksBy" to query that endpoint.
558−-- > -- 'getBooksBy Nothing' for all books
559−-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
560−instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods))
561− => HasClient m (QueryParam' mods sym a :> api) where
563− type Client m (QueryParam' mods sym a :> api) =
564− RequiredArgument mods a -> Client m api
566− -- if mparam = Nothing, we don't add it to the query string
567− clientWithRoute pm Proxy req mparam =
568− clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument
569− (Proxy :: Proxy mods) add (maybe req add) mparam
572− add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req
575− pname = pack $ symbolVal (Proxy :: Proxy sym)
577− hoistClientMonad pm _ f cl = \arg ->
578− hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
580−-- | If you use a 'QueryParams' in one of your endpoints in your API,
581−-- the corresponding querying function will automatically take
582−-- an additional argument, a list of values of the type specified
583−-- by your 'QueryParams'.
585−-- If you give an empty list, nothing will be added to the query string.
587−-- Otherwise, this function will take care
588−-- of inserting a textual representation of your values in the query string,
589−-- under the same query string parameter name.
591−-- You can control how values for your type are turned into
592−-- text by specifying a 'ToHttpApiData' instance for your type.
596−-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
598−-- > myApi :: Proxy MyApi
601−-- > getBooksBy :: [Text] -> ClientM [Book]
602−-- > getBooksBy = client myApi
603−-- > -- then you can just use "getBooksBy" to query that endpoint.
604−-- > -- 'getBooksBy []' for all books
605−-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
606−-- > -- to get all books by Asimov and Heinlein
607−instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
608− => HasClient m (QueryParams sym a :> api) where
610− type Client m (QueryParams sym a :> api) =
613− clientWithRoute pm Proxy req paramlist =
614− clientWithRoute pm (Proxy :: Proxy api)
615− (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
620− where pname = pack $ symbolVal (Proxy :: Proxy sym)
621− paramlist' = map (Just . encodeQueryParamValue) paramlist
623− hoistClientMonad pm _ f cl = \as ->
624− hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
626−-- | If you use a 'QueryFlag' in one of your endpoints in your API,
627−-- the corresponding querying function will automatically take
628−-- an additional 'Bool' argument.
630−-- If you give 'False', nothing will be added to the query string.
632−-- Otherwise, this function will insert a value-less query string
633−-- parameter under the name associated to your 'QueryFlag'.
637−-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
639−-- > myApi :: Proxy MyApi
642−-- > getBooks :: Bool -> ClientM [Book]
643−-- > getBooks = client myApi
644−-- > -- then you can just use "getBooks" to query that endpoint.
645−-- > -- 'getBooksBy False' for all books
646−-- > -- 'getBooksBy True' to only get _already published_ books
647−instance (KnownSymbol sym, HasClient m api)
648− => HasClient m (QueryFlag sym :> api) where
650− type Client m (QueryFlag sym :> api) =
651− Bool -> Client m api
653− clientWithRoute pm Proxy req flag =
654− clientWithRoute pm (Proxy :: Proxy api)
656− then appendToQueryString paramname Nothing req
660− where paramname = pack $ symbolVal (Proxy :: Proxy sym)
662− hoistClientMonad pm _ f cl = \b ->
663− hoistClientMonad pm (Proxy :: Proxy api) f (cl b)
665−-- | Pick a 'Method' and specify where the server you want to query is. You get
666−-- back the full `Response`.
667−instance RunClient m => HasClient m Raw where
669− = H.Method -> m Response
671− clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw
672− clientWithRoute _pm Proxy req httpMethod = do
673− runRequest req { requestMethod = httpMethod }
675− hoistClientMonad _ _ f cl = \meth -> f (cl meth)
677−instance RunClient m => HasClient m RawM where
679− = H.Method -> m Response
681− clientWithRoute :: Proxy m -> Proxy RawM -> Request -> Client m RawM
682− clientWithRoute _pm Proxy req httpMethod = do
683− runRequest req { requestMethod = httpMethod }
685− hoistClientMonad _ _ f cl = \meth -> f (cl meth)
687−-- | If you use a 'ReqBody' in one of your endpoints in your API,
688−-- the corresponding querying function will automatically take
689−-- an additional argument of the type specified by your 'ReqBody'.
690−-- That function will take care of encoding this argument as JSON and
691−-- of using it as the request body.
693−-- All you need is for your type to have a 'ToJSON' instance.
697−-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
699−-- > myApi :: Proxy MyApi
702−-- > addBook :: Book -> ClientM Book
703−-- > addBook = client myApi
704−-- > -- then you can just use "addBook" to query that endpoint
705−instance (MimeRender ct a, HasClient m api)
706− => HasClient m (ReqBody' mods (ct ': cts) a :> api) where
708− type Client m (ReqBody' mods (ct ': cts) a :> api) =
711− clientWithRoute pm Proxy req body =
712− clientWithRoute pm (Proxy :: Proxy api)
713− (let ctProxy = Proxy :: Proxy ct
714− in setRequestBodyLBS (mimeRender ctProxy body)
715− -- We use first contentType from the Accept list
716− (contentType ctProxy)
720− hoistClientMonad pm _ f cl = \a ->
721− hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
724− ( HasClient m api, MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a
725− ) => HasClient m (StreamBody' mods framing ctype a :> api)
728− type Client m (StreamBody' mods framing ctype a :> api) = a -> Client m api
730− hoistClientMonad pm _ f cl = \a ->
731− hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
733− clientWithRoute pm Proxy req body
734− = clientWithRoute pm (Proxy :: Proxy api)
735− $ setRequestBody (RequestBodySource sourceIO) (contentType ctypeP) req
737− ctypeP = Proxy :: Proxy ctype
738− framingP = Proxy :: Proxy framing
740− sourceIO = framingRender
742− (mimeRender ctypeP :: chunk -> BL.ByteString)
745−-- | Make the querying function append @path@ to the request path.
746−instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
747− type Client m (path :> api) = Client m api
749− clientWithRoute pm Proxy req =
750− clientWithRoute pm (Proxy :: Proxy api)
751− (appendToPath p req)
753− where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
755− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
757−instance HasClient m api => HasClient m (Vault :> api) where
758− type Client m (Vault :> api) = Client m api
760− clientWithRoute pm Proxy req =
761− clientWithRoute pm (Proxy :: Proxy api) req
763− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
765−instance HasClient m api => HasClient m (RemoteHost :> api) where
766− type Client m (RemoteHost :> api) = Client m api
768− clientWithRoute pm Proxy req =
769− clientWithRoute pm (Proxy :: Proxy api) req
771− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
773−instance HasClient m api => HasClient m (IsSecure :> api) where
774− type Client m (IsSecure :> api) = Client m api
776− clientWithRoute pm Proxy req =
777− clientWithRoute pm (Proxy :: Proxy api) req
779− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
781−instance HasClient m subapi =>
782− HasClient m (WithNamedContext name context subapi) where
784− type Client m (WithNamedContext name context subapi) = Client m subapi
785− clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
787− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
789−instance HasClient m subapi =>
790− HasClient m (WithResource res :> subapi) where
792− type Client m (WithResource res :> subapi) = Client m subapi
793− clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
795− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
797−instance ( HasClient m api
798− ) => HasClient m (AuthProtect tag :> api) where
799− type Client m (AuthProtect tag :> api)
800− = AuthenticatedRequest (AuthProtect tag) -> Client m api
802− clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) =
803− clientWithRoute pm (Proxy :: Proxy api) (func val req)
805− hoistClientMonad pm _ f cl = \authreq ->
806− hoistClientMonad pm (Proxy :: Proxy api) f (cl authreq)
808−-- | Ignore @'Fragment'@ in client functions.
809−-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
813−-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
815−-- > myApi :: Proxy MyApi
818−-- > getBooks :: ClientM [Book]
819−-- > getBooks = client myApi
820−-- > -- then you can just use "getBooksBy" to query that endpoint.
821−-- > -- 'getBooks' for all books.
822−instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
823− ) => HasClient m (Fragment a :> api) where
825− type Client m (Fragment a :> api) = Client m api
827− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
829− hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
831−-- * Basic Authentication
833−instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
834− type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api
836− clientWithRoute pm Proxy req val =
837− clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)
839− hoistClientMonad pm _ f cl = \bauth ->
840− hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
842−-- | A type that specifies that an API record contains a client implementation.
843−data AsClientT (m :: * -> *)
844−instance GenericMode (AsClientT m) where
845− type AsClientT m :- api = Client m api
848−type GClientConstraints api m =
849− ( GenericServant api (AsClientT m)
850− , Client m (ToServantApi api) ~ ToServant api (AsClientT m)
853−class GClient (api :: * -> *) m where
854− gClientProof :: Dict (GClientConstraints api m)
856−instance GClientConstraints api m => GClient api m where
860− ( forall n. GClient api n
861− , HasClient m (ToServantApi api)
864− => HasClient m (NamedRoutes api) where
865− type Client m (NamedRoutes api) = api (AsClientT m)
867− clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
868− clientWithRoute pm _ request =
869− case gClientProof @api @m of
870− Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request
875− -> Proxy (NamedRoutes api)
876− -> (forall x. ma x -> mb x)
877− -> Client ma (NamedRoutes api)
878− -> Client mb (NamedRoutes api)
879− hoistClientMonad _ _ nat clientA =
880− case (gClientProof @api @ma, gClientProof @api @mb) of
882− fromServant @api @(AsClientT mb) $
883− hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
884− toServant @api @(AsClientT ma) clientA
889−-- | Helper to make code using records of clients more readable.
891−-- Can be mixed with (/:) for supplying arguments.
896−-- type Api = NamedRoutes RootApi
898−-- data RootApi mode = RootApi
899−-- { subApi :: mode :- NamedRoutes SubApi
901−-- } deriving Generic
903−-- data SubApi mode = SubApi
904−-- { endpoint :: mode :- Get '[JSON] Person
906−-- } deriving Generic
911−-- rootClient :: RootApi (AsClientT ClientM)
912−-- rootClient = client api
914−-- endpointClient :: ClientM Person
915−-- endpointClient = client \/\/ subApi \/\/ endpoint
917−(//) :: a -> (a -> b) -> b
920−-- | Convenience function for supplying arguments to client functions when
921−-- working with records of clients.
923−-- Intended to be used in conjunction with '(//)'.
928−-- type Api = NamedRoutes RootApi
930−-- data RootApi mode = RootApi
931−-- { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi
932−-- , hello :: mode :- Capture "name" String :> Get '[JSON] String
934−-- } deriving Generic
936−-- data SubApi mode = SubApi
937−-- { endpoint :: mode :- Get '[JSON] Person
939−-- } deriving Generic
944−-- rootClient :: RootApi (AsClientT ClientM)
945−-- rootClient = client api
947−-- hello :: String -> ClientM String
948−-- hello name = rootClient \/\/ hello \/: name
950−-- endpointClient :: ClientM Person
951−-- endpointClient = client \/\/ subApi \/: "foobar123" \/\/ endpoint
953−(/:) :: (a -> b -> c) -> b -> a -> c
957−{- Note [Non-Empty Content Types]
958−~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
961− instance (..., cts' ~ (ct ': cts)) => ... cts' ...
963−It may seem to make more sense to have:
965− instance (...) => ... (ct ': cts) ...
967−But this means that if another instance exists that does *not* require
968−non-empty lists, but is otherwise more specific, no instance will be overall
969−more specific. This in turn generally means adding yet another instance (one
970−for empty and one for non-empty lists).
973−-------------------------------------------------------------------------------
975−-------------------------------------------------------------------------------
977−checkContentTypeHeader :: RunClient m => Response -> m MediaType
978−checkContentTypeHeader response =
979− case lookup "Content-Type" $ toList $ responseHeaders response of
980− Nothing -> return $ "application" Media.// "octet-stream"
981− Just t -> case parseAccept t of
982− Nothing -> throwClientError $ InvalidContentTypeHeader response
983− Just t' -> return t'
985−decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
986− => Response -> Proxy ct -> m a
987−decodedAs response ct = do
988− responseContentType <- checkContentTypeHeader response
989− unless (any (matches responseContentType) accept) $
990− throwClientError $ UnsupportedContentType responseContentType response
991− case mimeUnrender ct $ responseBody response of
992− Left err -> throwClientError $ DecodeFailure (T.pack err) response
993− Right val -> return val
995− accept = toList $ contentTypes ct
997−-------------------------------------------------------------------------------
998−-- Custom type errors
999−-------------------------------------------------------------------------------
1001−-- Erroring instance for HasClient' when a combinator is not fully applied
1002−instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
1004− type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
1005− clientWithRoute _ _ _ = error "unreachable"
1006− hoistClientMonad _ _ _ _ = error "unreachable"
1008−-- Erroring instances for 'HasClient' for unknown API combinators
1009−instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
1011−instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api