@@ -1,8 +1,16 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
12{-# LANGUAGE CPP #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE FlexibleContexts #-}
45{-# LANGUAGE FlexibleInstances #-}
56{-# LANGUAGE InstanceSigs #-}
7+{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TupleSections #-}
11+{-# LANGUAGE TypeFamilies #-}
12+{-# LANGUAGE TypeOperators #-}
13+{-# LANGUAGE UndecidableInstances #-}
614{-# LANGUAGE MultiParamTypeClasses #-}
715{-# LANGUAGE OverloadedStrings #-}
816{-# LANGUAGE PolyKinds #-}
@@ -18,47 +26,58 @@
1826-- API.
1927module Servant.Reflex
2028 ( client
29+ , BuildHeaderKeysTo(..)
30+ , toHeaders
2131 , HasClient(..)
2232 , module Servant.Common.Req
2333 , module Servant.Common.BaseUrl
2434 ) where
2535
26−-------------------------------------------------------------------------------
36+------------------------------------------------------------------------------
2737import Control.Applicative
28−import Data.CaseInsensitive (mk)
29−import qualified Data.Map as Map
30−import Data.Monoid ((<>))
31−import Data.Proxy (Proxy (..))
32−import qualified Data.Set as Set
33−import Data.Text (Text)
34−import qualified Data.Text as T
35−import qualified Data.Text.Encoding as E
36−import GHC.TypeLits (KnownSymbol, symbolVal)
37−import Reflex.Dom (Dynamic, Event, Reflex,
38− XhrRequest (..), XhrResponse (..),
39− XhrResponseHeaders (..), ffor,
40− fmapMaybe, leftmost,
41− performRequestAsync, tagPromptlyDyn)
42−import Servant.API ((:<|>) (..), (:>), BasicAuth,
43− BasicAuthData, BuildHeadersTo (..),
44− Capture, Header, Headers (..),
45− HttpVersion, IsSecure, MimeRender (..),
46− MimeUnrender, NoContent, QueryFlag,
47− QueryParam, QueryParams, Raw,
48− ReflectMethod (..), RemoteHost,
49− ReqBody, ToHttpApiData (..), Vault,
50− Verb, contentType)
51−import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),
52− SupportsServantReflex, baseUrlWidget,
53− showBaseUrl)
54−import Servant.Common.Req (QParam (..), QueryPart (..), Req,
55− ReqResult (..), addHeader, authData,
56− defReq, performRequestCT,
57− performRequestNoBody,
58− prependToPathParts, qParamToQueryPart,
59− qParams, reqBody, reqFailure,
60− reqMethod, reqSuccess, respHeaders,
61− response)
38+import Data.Monoid ((<>))
39+import qualified Data.Set as Set
40+import qualified Data.Text.Encoding as E
41+import Data.CaseInsensitive (mk)
42+import Data.Functor.Identity
43+import Data.Proxy (Proxy (..))
44+import qualified Data.Map as Map
45+import Data.Text (Text)
46+import qualified Data.Text as T
47+import GHC.TypeLits (KnownSymbol, symbolVal)
48+import Servant.API ((:<|>)(..),(:>), BasicAuth,
49+ BasicAuthData, BuildHeadersTo(..),
50+ Capture, contentType, Header,
51+ Headers(..), HttpVersion, IsSecure,
52+ MimeRender(..), MimeUnrender,
53+ NoContent, QueryFlag, QueryParam,
54+ QueryParams, Raw, ReflectMethod(..),
55+ RemoteHost, ReqBody,
56+ ToHttpApiData(..), Vault, Verb)
57+
58+import Reflex.Dom (Dynamic, Event, Reflex,
59+ XhrRequest(..),
60+ XhrResponseHeaders(..),
61+ XhrResponse(..), attachPromptlyDynWith, constDyn, ffor, fmapMaybe,
62+ leftmost, performRequestsAsync,
63+ )
64+------------------------------------------------------------------------------
65+import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
66+ showBaseUrl,
67+ SupportsServantReflex)
68+import Servant.Common.Req (Req, ReqResult(..), QParam(..),
69+ QueryPart(..), addHeader, authData,
70+ defReq, evalResponse, prependToPathParts,
71+ -- performRequestCT,
72+ performRequestsCT,
73+ -- performRequestNoBody,
74+ performRequestsNoBody,
75+ performSomeRequestsAsync,
76+ qParamToQueryPart, reqBody,
77+ reqSuccess, reqFailure,
78+ reqMethod, respHeaders, response,
79+ qParams)
80+
6281
6382-- * Accessing APIs as a Client
6483
@@ -70,28 +89,31 @@ import Servant.Common.Req (QParam (..), QueryPart (..), Req,
7089-- > myApi :: Proxy MyApi
7190-- > myApi = Proxy
7291-- >
73−-- > getAllBooks :: Event t () -> m (Event t (Either XhrError ((),[Book])))
74−-- > postNewBook :: Dynamic t (Maybe Book) -> Event t ()
75−-- -> m (Event t (Either XhrError (Book,Book)))
92+-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
93+-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
94+-- -> m (Event t (l, ReqResult Book)))
7695-- > (getAllBooks :<|> postNewBook) = client myApi host
7796-- > where host = constDyn $ BaseUrl Http "localhost" 8080
78−client :: (HasClient t m layout)
79− => Proxy layout -> Proxy m -> Dynamic t BaseUrl -> Client t m layout
80−client p q = clientWithRoute p q defReq
97+client :: (HasClient t m layout tag)
98+ => Proxy layout -> Proxy m -> Proxy tag -> Dynamic t BaseUrl -> Client t m layout tag
99+client p q t baseurl = clientWithRoute p q t defReq baseurl
100+
81101
82102-- | This class lets us define how each API combinator
83103-- influences the creation of an HTTP request. It's mostly
84104-- an internal class, you can just use 'client'.
85−class HasClient t m layout where
86− type Client t m layout :: *
87− clientWithRoute :: Proxy layout -> Proxy m -> Req t -> Dynamic t BaseUrl -> Client t m layout
105+class HasClient t m layout (tag :: *) where
106+ type Client t m layout tag :: *
107+ clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> Client t m layout tag
88108
89109
90−instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where
91− type Client t m (a :<|> b) = Client t m a :<|> Client t m b
92− clientWithRoute Proxy q req baseurl =
93− clientWithRoute (Proxy :: Proxy a) q req baseurl :<|>
94− clientWithRoute (Proxy :: Proxy b) q req baseurl
110+instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where
111+ type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag
112+
113+ clientWithRoute Proxy q pTag req baseurl =
114+ clientWithRoute (Proxy :: Proxy a) q pTag req baseurl :<|>
115+ clientWithRoute (Proxy :: Proxy b) q pTag req baseurl
116+
95117
96118-- Capture. Example:
97119-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
@@ -101,50 +123,54 @@ instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where
101123-- > getBook :: SupportsServantReflex t m
102124-- => Dynamic t BaseUrl
103125-- -> Dynamic t (Maybe Text)
104−-- -> Event t ()
105−-- -> m (Event t (Either XhrError (Text, Book)))
126+-- -> Event t l
127+-- -> m (Event t (l, ReqResult Book))
106128-- > getBook = client myApi (constDyn host)
107−instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout)
108− => HasClient t m (Capture capture a :> sublayout) where
109129
110− type Client t m (Capture capture a :> sublayout) =
111− Dynamic t (Either Text a) -> Client t m sublayout
130+instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout tag)
131+ => HasClient t m (Capture capture a :> sublayout) tag where
112132
113− clientWithRoute Proxy q req baseurl val =
133+ type Client t m (Capture capture a :> sublayout) tag =
134+ Dynamic t (Either Text a) -> Client t m sublayout tag
135+
136+ clientWithRoute Proxy q t req baseurl val =
114137 clientWithRoute (Proxy :: Proxy sublayout)
115− q
138+ q t
116139 (prependToPathParts p req)
117140 baseurl
141+ where p = (fmap . fmap) (toUrlPiece) val
118142
119− where p = (fmap . fmap) toUrlPiece val
120143
121144-- VERB (Returning content) --
122145instance {-# OVERLAPPABLE #-}
123146 -- Note [Non-Empty Content Types]
124147 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
125− ) => HasClient t m (Verb method status cts' a) where
126− type Client t m (Verb method status cts' a) =
127− Event t () -> m (Event t (ReqResult a))
148+ ) => HasClient t m (Verb method status cts' a) tag where
149+ type Client t m (Verb method status cts' a) tag =
150+ Event t tag -> m (Event t (ReqResult tag a))
128151 -- TODO how to access input types here?
129152 -- ExceptT ServantError IO a
130− clientWithRoute Proxy _ req =
131− performRequestCT (Proxy :: Proxy ct) method req'
153+ clientWithRoute Proxy _ _ req baseurl trigs =
154+ -- performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs
155+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl trigs
132156 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
133157 req' = req { reqMethod = method }
134158
159+
135160-- -- VERB (No content) --
136161instance {-# OVERLAPPING #-}
137162 (ReflectMethod method, SupportsServantReflex t m) =>
138− HasClient t m (Verb method status cts NoContent) where
139− type Client t m (Verb method status cts NoContent) =
140− Event t () -> m (Event t (ReqResult NoContent))
163+ HasClient t m (Verb method status cts NoContent) tag where
164+ type Client t m (Verb method status cts NoContent) tag =
165+ Event t tag -> m (Event t (ReqResult tag NoContent))
141166 -- TODO: how to access input types here?
142167 -- ExceptT ServantError IO NoContent
143− clientWithRoute Proxy _ =
144− performRequestNoBody method
168+ clientWithRoute Proxy _ _ req baseurl =
169+ (fmap . fmap) runIdentity . performRequestsNoBody method (constDyn $ Identity req) baseurl
145170 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
146171
147−toHeaders :: BuildHeadersTo ls => ReqResult a -> ReqResult (Headers ls a)
172+
173+toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
148174toHeaders r =
149175 let toBS = E.encodeUtf8
150176 hdrs = maybe []
@@ -173,33 +199,35 @@ instance {-# OVERLAPPABLE #-}
173199 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
174200 ReflectMethod method, cts' ~ (ct ': cts),
175201 SupportsServantReflex t m
176− ) => HasClient t m (Verb method status cts' (Headers ls a)) where
177− type Client t m (Verb method status cts' (Headers ls a)) =
178− Event t () -> m (Event t (ReqResult (Headers ls a)))
179− clientWithRoute Proxy _ req baseurl = do
202+ ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where
203+ type Client t m (Verb method status cts' (Headers ls a)) tag =
204+ Event t tag -> m (Event t (ReqResult tag (Headers ls a)))
205+ clientWithRoute Proxy _ _ req baseurl trigs = do
180206 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
181− resp <- performRequestCT (Proxy :: Proxy ct) method req' baseurl
182− return $ (fmap . fmap) toHeaders resp
207+ resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl trigs
208+ return $ toHeaders <$> resp
183209 where req' = req { respHeaders =
184210 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
185211 }
186212
213+
187214-- HEADERS Verb (No content) --
188215instance {-# OVERLAPPABLE #-}
189216 ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,
190217 SupportsServantReflex t m
191− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) where
192− type Client t m (Verb method status cts (Headers ls NoContent))
193− = Event t () -> m (Event t (ReqResult (Headers ls NoContent)))
194− clientWithRoute Proxy _ req baseurl = do
218+ ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where
219+ type Client t m (Verb method status cts (Headers ls NoContent)) tag
220+ = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))
221+ clientWithRoute Proxy _ _ req baseurl trigs = do
195222 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
196− resp <- performRequestNoBody method req' baseurl
197− return $ (fmap . fmap) toHeaders resp
223+ resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl trigs
224+ return $ toHeaders <$> resp
198225 where req' = req {respHeaders =
199226 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
200227 }
201228
202229
230+
203231-- HEADER
204232-- > newtype Referer = Referer { referrer :: Text }
205233-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
@@ -214,28 +242,32 @@ instance {-# OVERLAPPABLE #-}
214242-- > -- then you can just use "viewRefer" to query that endpoint
215243-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
216244instance (KnownSymbol sym, ToHttpApiData a,
217− HasClient t m sublayout, SupportsServantReflex t m)
218− => HasClient t m (Header sym a :> sublayout) where
245+ HasClient t m sublayout tag, SupportsServantReflex t m)
246+ => HasClient t m (Header sym a :> sublayout) tag where
219247
220− type Client t m (Header sym a :> sublayout) =
221− Dynamic t (Either Text a) -> Client t m sublayout
248+ type Client t m (Header sym a :> sublayout) tag =
249+ Dynamic t (Either Text a) -> Client t m sublayout tag
222250
223− clientWithRoute Proxy q req baseurl eVal =
251+ clientWithRoute Proxy q t req baseurl eVal =
224252 clientWithRoute (Proxy :: Proxy sublayout)
225− q
253+ q t
226254 (Servant.Common.Req.addHeader hname eVal req)
227255 baseurl
228256 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
229257
258+
259+
260+
230261-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
231262-- functions.
232−instance HasClient t m sublayout
233− => HasClient t m (HttpVersion :> sublayout) where
263+instance HasClient t m sublayout tag
264+ => HasClient t m (HttpVersion :> sublayout) tag where
234265
235− type Client t m (HttpVersion :> sublayout) =
236− Client t m sublayout
266+ type Client t m (HttpVersion :> sublayout) tag =
267+ Client t m sublayout tag
237268
238− clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy sublayout)
269+ clientWithRoute Proxy q t =
270+ clientWithRoute (Proxy :: Proxy sublayout) q t
239271
240272
241273-- | If you use a 'QueryParam' in one of your endpoints in your API,
@@ -264,15 +296,15 @@ instance HasClient t m sublayout
264296-- > -- then you can just use "getBooksBy" to query that endpoint.
265297-- > -- 'getBooksBy Nothing' for all books
266298-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
267−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
268− => HasClient t m (QueryParam sym a :> sublayout) where
299+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
300+ => HasClient t m (QueryParam sym a :> sublayout) tag where
269301
270− type Client t m (QueryParam sym a :> sublayout) =
271− Dynamic t (QParam a) -> Client t m sublayout
302+ type Client t m (QueryParam sym a :> sublayout) tag =
303+ Dynamic t (QParam a) -> Client t m sublayout tag
272304
273305 -- if mparam = Nothing, we don't add it to the query string
274− clientWithRoute Proxy q req baseurl mparam =
275− clientWithRoute (Proxy :: Proxy sublayout) q
306+ clientWithRoute Proxy q t req baseurl mparam =
307+ clientWithRoute (Proxy :: Proxy sublayout) q t
276308 (req {qParams = paramPair : qParams req}) baseurl
277309
278310 where pname = symbolVal (Proxy :: Proxy sym)
@@ -281,6 +313,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
281313 p prm = QueryPartParam $ fmap qParamToQueryPart prm -- (fmap . fmap) (unpack . toQueryParam) prm
282314 paramPair = (T.pack pname, p mparam)
283315
316+
317+
284318-- | If you use a 'QueryParams' in one of your endpoints in your API,
285319-- the corresponding querying function will automatically take
286320-- an additional argument, a list of values of the type specified
@@ -309,14 +343,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
309343-- > -- 'getBooksBy []' for all books
310344-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
311345-- > -- to get all books by Asimov and Heinlein
312−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
313− => HasClient t m (QueryParams sym a :> sublayout) where
346+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
347+ => HasClient t m (QueryParams sym a :> sublayout) tag where
314348
315− type Client t m (QueryParams sym a :> sublayout) =
316− Dynamic t [a] -> Client t m sublayout
349+ type Client t m (QueryParams sym a :> sublayout) tag =
350+ Dynamic t [a] -> Client t m sublayout tag
317351
318− clientWithRoute Proxy q req baseurl paramlist =
319− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
352+ clientWithRoute Proxy q t req baseurl paramlist =
353+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
320354
321355 where req' = req { qParams = (T.pack pname, params') : qParams req }
322356 pname = symbolVal (Proxy :: Proxy sym)
@@ -324,6 +358,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
324358 paramlist
325359
326360
361+
327362-- | If you use a 'QueryFlag' in one of your endpoints in your API,
328363-- the corresponding querying function will automatically take
329364-- an additional 'Bool' argument.
@@ -348,49 +383,42 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
348383-- > -- 'getBooksBy True' to only get _already published_ books
349384
350385-- TODO Bring back
351−instance (KnownSymbol sym, HasClient t m sublayout, Reflex t)
352− => HasClient t m (QueryFlag sym :> sublayout) where
386+instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)
387+ => HasClient t m (QueryFlag sym :> sublayout) tag where
353388
354− type Client t m (QueryFlag sym :> sublayout) =
355− Dynamic t Bool -> Client t m sublayout
389+ type Client t m (QueryFlag sym :> sublayout) tag =
390+ Dynamic t Bool -> Client t m sublayout tag
356391
357− clientWithRoute Proxy q req baseurl flag =
358− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
392+ clientWithRoute Proxy q t req baseurl flag =
393+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
359394
360395 where req' = req { qParams = thisPair : qParams req }
361396 thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
362397 pName = symbolVal (Proxy :: Proxy sym)
363398
364399
365−-- | Pick a 'Method' and specify where the server you want to query is. You get
366−-- back the full `Response`.
367−-- TODO redo
368−instance SupportsServantReflex t m => HasClient t m Raw where
369− type Client t m Raw = Dynamic t (Either Text (XhrRequest ()))
370− -> Event t ()
371− -> m (Event t (ReqResult ()))
372−
373− -- clientWithRoute :: Proxy Raw -> Proxy m -> Req -> BaseUrl -> Client t m Raw
374− clientWithRoute _ _ _ baseurl xhrs triggers = do
375− let xhrs' = liftA2 (\x path -> case x of
376− Left e -> Left e
377− Right jx -> Right $ jx {_xhrRequest_url = path
378− <> _xhrRequest_url jx})
379− xhrs
380− (showBaseUrl <$> baseurl)
381− reqs = tagPromptlyDyn xhrs' triggers
382− okReq = fmapMaybe hush reqs
383− badReq = fmapMaybe tattle reqs
384− resps <- performRequestAsync okReq
385− return $ leftmost [fmap (ResponseSuccess () ) resps
386− ,fmap RequestFailure badReq]
387−
388−
389−hush :: Either e a -> Maybe a
390−hush = either (const Nothing) Just
391−
392−tattle :: Either e a -> Maybe e
393−tattle = either Just (const Nothing)
400+
401+-- | Send a raw 'XhrRequest ()' directly to 'baseurl'
402+instance SupportsServantReflex t m => HasClient t m Raw tag where
403+ type Client t m Raw tag = Dynamic t (Either Text (XhrRequest ()))
404+ -> Event t tag
405+ -> m (Event t (ReqResult tag ()))
406+
407+ clientWithRoute _ _ _ _ baseurl xhrs triggers = do
408+
409+ let xhrs' = liftA2 (\x path -> case x of
410+ Left e -> Left e
411+ Right jx -> Right $ jx { _xhrRequest_url = path <> _xhrRequest_url jx }
412+ ) xhrs (showBaseUrl <$> baseurl)
413+ xhrs'' = attachPromptlyDynWith (flip (,)) xhrs' triggers :: Event t (tag, Either Text (XhrRequest ()))
414+ badReq = fmapMaybe (\(t,x) -> either (Just . (t,)) (const Nothing) x) xhrs'' :: Event t (tag, Text)
415+ okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())
416+
417+ resps <- performRequestsAsync okReq
418+ return $ leftmost [ uncurry RequestFailure <$> badReq
419+ , evalResponse (const $ Right ()) <$> resps
420+ ]
421+
394422
395423-- | If you use a 'ReqBody' in one of your endpoints in your API,
396424-- the corresponding querying function will automatically take
@@ -412,14 +440,14 @@ tattle = either Just (const Nothing)
412440-- > where host = BaseUrl Http "localhost" 8080
413441-- > -- then you can just use "addBook" to query that endpoint
414442
415−instance (MimeRender ct a, HasClient t m sublayout, Reflex t)
416− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) where
443+instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
444+ => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where
417445
418− type Client t m (ReqBody (ct ': cts) a :> sublayout) =
419− Dynamic t (Either Text a) -> Client t m sublayout
446+ type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =
447+ Dynamic t (Either Text a) -> Client t m sublayout tag
420448
421− clientWithRoute Proxy q req baseurl body =
422− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
449+ clientWithRoute Proxy q t req baseurl body =
450+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
423451 where req' = req { reqBody = bodyBytesCT }
424452 ctProxy = Proxy :: Proxy ct
425453 ctString = T.pack $ show $ contentType ctProxy
@@ -427,39 +455,49 @@ instance (MimeRender ct a, HasClient t m sublayout, Reflex t)
427455 (\b -> (mimeRender ctProxy b, ctString))
428456 body
429457
458+
459+
430460-- | Make the querying function append @path@ to the request path.
431−instance (KnownSymbol path, HasClient t m sublayout, Reflex t) => HasClient t m (path :> sublayout) where
432− type Client t m (path :> sublayout) = Client t m sublayout
461+instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
462+ type Client t m (path :> sublayout) tag = Client t m sublayout tag
433463
434− clientWithRoute Proxy q req =
435− clientWithRoute (Proxy :: Proxy sublayout) q
436− (prependToPathParts (pure (Right $ T.pack p)) req)
464+ clientWithRoute Proxy q t req baseurl =
465+ clientWithRoute (Proxy :: Proxy sublayout) q t
466+ (prependToPathParts (pure (Right $ T.pack p)) req) baseurl
437467
438468 where p = symbolVal (Proxy :: Proxy path)
439469
440−instance HasClient t m api => HasClient t m (Vault :> api) where
441− type Client t m (Vault :> api) = Client t m api
442470
443− clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api)
471+instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
472+ type Client t m (Vault :> api) tag = Client t m api tag
473+
474+ clientWithRoute Proxy q t req baseurl =
475+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
476+
477+
478+instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
479+ type Client t m (RemoteHost :> api) tag = Client t m api tag
480+
481+ clientWithRoute Proxy q t req baseurl =
482+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
483+
444484
445−instance HasClient t m api => HasClient t m (RemoteHost :> api) where
446− type Client t m (RemoteHost :> api) = Client t m api
447485
448− clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api)
486+instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
487+ type Client t m (IsSecure :> api) tag = Client t m api tag
449488
450−instance HasClient t m api => HasClient t m (IsSecure :> api) where
451− type Client t m (IsSecure :> api) = Client t m api
489+ clientWithRoute Proxy q t req baseurl =
490+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
452491
453− clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api)
454492
455−instance (HasClient t m api, Reflex t)
456− => HasClient t m (BasicAuth realm usr :> api) where
493+instance (HasClient t m api tag, Reflex t)
494+ => HasClient t m (BasicAuth realm usr :> api) tag where
457495
458− type Client t m (BasicAuth realm usr :> api) = Dynamic t (Maybe BasicAuthData)
459− -> Client t m api
496+ type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)
497+ -> Client t m api tag
460498
461− clientWithRoute Proxy q req baseurl authdata =
462− clientWithRoute (Proxy :: Proxy api) q req' baseurl
499+ clientWithRoute Proxy q t req baseurl authdata =
500+ clientWithRoute (Proxy :: Proxy api) q t req' baseurl
463501 where
464502 req' = req { authData = Just authdata }
465503