@@ -1,573 +1,11 @@
1−{-# LANGUAGE AllowAmbiguousTypes #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE InstanceSigs #-}
8−{-# LANGUAGE MultiParamTypeClasses #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE ScopedTypeVariables #-}
12−{-# LANGUAGE TupleSections #-}
13−{-# LANGUAGE TypeFamilies #-}
14−{-# LANGUAGE TypeOperators #-}
15−{-# LANGUAGE UndecidableInstances #-}
1+module Servant.Reflex (
2+ a
3+ , ClientEnv (..)
4+ , HasClient (..)
5+) where
166
17−#if MIN_VERSION_base(4,9,0)
18−{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
19−#endif
20−
21−-- #include "overlapping-compat.h"
22−-- | This module provides 'client' which can automatically generate
23−-- querying functions for each endpoint just from the type representing your
24−-- API.
25−module Servant.Reflex
26− ( client
27− , clientWithOpts
28− , clientWithRoute
29− , BuildHeaderKeysTo(..)
30− , toHeaders
31− , HasClient
32− , Client
33− , module Servant.Common.Req
34− , module Servant.Common.BaseUrl
35− ) where
36−
37−------------------------------------------------------------------------------
38−import Control.Applicative
39−import Data.Monoid ((<>))
40−import qualified Data.Set as Set
41−import qualified Data.Text.Encoding as E
42−import Data.CaseInsensitive (mk)
43−import Data.Functor.Identity
44−import Data.Proxy (Proxy (..))
45−import qualified Data.Map as Map
46−import Data.Text (Text)
47−import qualified Data.Text as T
48−import GHC.Exts (Constraint)
49−import GHC.TypeLits (KnownSymbol, symbolVal)
50−import Servant.API ((:<|>)(..),(:>), BasicAuth,
51− BasicAuthData, BuildHeadersTo(..),
52− Capture, contentType, Header,
53− Headers(..), HttpVersion, IsSecure,
54− MimeRender(..), MimeUnrender,
55− NoContent, QueryFlag, QueryParam,
56− QueryParams, Raw, ReflectMethod(..),
57− RemoteHost, ReqBody,
58− ToHttpApiData(..), Vault, Verb)
59−import qualified Servant.Auth as Auth
60−
61−import Reflex.Dom.Core (Dynamic, Event, Reflex,
62− XhrRequest(..),
63− XhrResponseHeaders(..),
64− XhrResponse(..), attachPromptlyDynWith, constDyn, ffor, fmapMaybe,
65− leftmost, performRequestsAsync,
66− )
67−------------------------------------------------------------------------------
68−import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
69− showBaseUrl,
70− SupportsServantReflex)
71−import Servant.Common.Req (ClientOptions(..),
72− defaultClientOptions,
73− Req, ReqResult(..), QParam(..),
74− QueryPart(..), addHeader, authData,
75− defReq, evalResponse, prependToPathParts,
76− -- performRequestCT,
77− performRequestsCT,
78− -- performRequestNoBody,
79− performRequestsNoBody,
80− performSomeRequestsAsync,
81− qParamToQueryPart, reqBody,
82− reqSuccess, reqFailure,
83− reqMethod, respHeaders,
84− response,
85− reqTag,
86− qParams, withCredentials)
87−
88−
89−-- * Accessing APIs as a Client
90−
91−-- | 'client' allows you to produce operations to query an API from a client.
92−--
93−-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
94−-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books
95−-- >
96−-- > myApi :: Proxy MyApi
97−-- > myApi = Proxy
98−-- >
99−-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
100−-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
101−-- -> m (Event t (l, ReqResult Book)))
102−-- > (getAllBooks :<|> postNewBook) = client myApi host
103−-- > where host = constDyn $ BaseUrl Http "localhost" 8080
104−client
105− :: (HasClient t m layout tag)
106− => Proxy layout
107− -> Proxy m
108− -> Proxy tag
109− -> Dynamic t BaseUrl
110− -> Client t m layout tag
111−client p q t baseurl = clientWithRoute p q t defReq baseurl defaultClientOptions
112−
113−clientWithOpts
114− :: (HasClient t m layout tag)
115− => Proxy layout
116− -> Proxy m
117− -> Proxy tag
118− -> Dynamic t BaseUrl
119− -> ClientOptions
120− -> Client t m layout tag
121−clientWithOpts p q t baseurl = clientWithRoute p q t defReq baseurl
122−
123−
124−-- | This class lets us define how each API combinator
125−-- influences the creation of an HTTP request. It's mostly
126−-- an internal class, you can just use 'client'.
127−class HasClient t m layout (tag :: *) where
128− type Client t m layout tag :: *
129− clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> ClientOptions -> Client t m layout tag
130−
131−
132−instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where
133− type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag
134−
135− clientWithRoute Proxy q pTag req baseurl opts =
136− clientWithRoute (Proxy :: Proxy a) q pTag req baseurl opts :<|>
137− clientWithRoute (Proxy :: Proxy b) q pTag req baseurl opts
138−
139−
140−-- Capture. Example:
141−-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
142−-- >
143−-- > myApi :: Proxy MyApi = Proxy
144−-- >
145−-- > getBook :: SupportsServantReflex t m
146−-- => Dynamic t BaseUrl
147−-- -> Dynamic t (Maybe Text)
148−-- -> Event t l
149−-- -> m (Event t (l, ReqResult Book))
150−-- > getBook = client myApi (constDyn host)
151−
152−instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout tag)
153− => HasClient t m (Capture capture a :> sublayout) tag where
154−
155− type Client t m (Capture capture a :> sublayout) tag =
156− Dynamic t (Either Text a) -> Client t m sublayout tag
157−
158− clientWithRoute Proxy q t req baseurl opts val =
159− clientWithRoute (Proxy :: Proxy sublayout)
160− q t
161− (prependToPathParts p req)
162− baseurl opts
163− where p = (fmap . fmap) (toUrlPiece) val
164−
165−
166−-- VERB (Returning content) --
167−instance {-# OVERLAPPABLE #-}
168− -- Note [Non-Empty Content Types]
169− (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
170− ) => HasClient t m (Verb method status cts' a) tag where
171− type Client t m (Verb method status cts' a) tag =
172− Event t tag -> m (Event t (ReqResult tag a))
173− -- TODO how to access input types here?
174− -- ExceptT ServantError IO a
175− clientWithRoute Proxy _ _ req baseurl opts trigs =
176− fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs
177− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
178− req' = req { reqMethod = method }
179−
180−
181−-- -- VERB (No content) --
182−instance {-# OVERLAPPING #-}
183− (ReflectMethod method, SupportsServantReflex t m) =>
184− HasClient t m (Verb method status cts NoContent) tag where
185− type Client t m (Verb method status cts NoContent) tag =
186− Event t tag -> m (Event t (ReqResult tag NoContent))
187− -- TODO: how to access input types here?
188− -- ExceptT ServantError IO NoContent
189− clientWithRoute Proxy _ _ req baseurl opts =
190− (fmap . fmap) runIdentity . performRequestsNoBody method (constDyn $ Identity req) baseurl opts
191− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
192−
193−
194−toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
195−toHeaders r =
196− let toBS = E.encodeUtf8
197− hdrs = maybe []
198− (\xhr -> fmap (\(h,v) -> (mk (toBS h), toBS v))
199− (Map.toList $ _xhrResponse_headers xhr))
200− (response r)
201− in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}
202−
203−class BuildHeaderKeysTo hs where
204− buildHeaderKeysTo :: Proxy hs -> [T.Text]
205−
206−instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
207− where buildHeaderKeysTo _ = []
208−
209−instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
210− => BuildHeaderKeysTo ((Header h v) ': xs) where
211− buildHeaderKeysTo _ = T.pack (symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)
212−
213−-- HEADERS Verb (Content) --
214−-- Headers combinator not treated in fully general case,
215−-- in order to deny instances for (Headers ls (Capture "id" Int)),
216−-- a combinator that wouldn't make sense
217−-- TODO Overlapping??
218−instance {-# OVERLAPPABLE #-}
219− -- Note [Non-Empty Content Types]
220− ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
221− ReflectMethod method, cts' ~ (ct ': cts),
222− SupportsServantReflex t m
223− ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where
224− type Client t m (Verb method status cts' (Headers ls a)) tag =
225− Event t tag -> m (Event t (ReqResult tag (Headers ls a)))
226− clientWithRoute Proxy _ _ req baseurl opts trigs = do
227− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
228− resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl opts trigs
229− return $ toHeaders <$> resp
230− where req' = req { respHeaders =
231− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
232− }
233−
234−
235−-- HEADERS Verb (No content) --
236−instance {-# OVERLAPPABLE #-}
237− ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,
238− SupportsServantReflex t m
239− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where
240− type Client t m (Verb method status cts (Headers ls NoContent)) tag
241− = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))
242− clientWithRoute Proxy _ _ req baseurl opts trigs = do
243− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
244− resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl opts trigs
245− return $ toHeaders <$> resp
246− where req' = req {respHeaders =
247− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
248− }
249−
250−
251−
252−-- HEADER
253−-- > newtype Referer = Referer { referrer :: Text }
254−-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
255−-- >
256−-- > -- GET /view-my-referer
257−-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
258−-- >
259−-- >
260−-- > viewReferer :: Maybe Referer -> ExceptT String IO Book
261−-- > viewReferer = client myApi host
262−-- > where host = BaseUrl Http "localhost" 8080
263−-- > -- then you can just use "viewRefer" to query that endpoint
264−-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
265−instance (KnownSymbol sym, ToHttpApiData a,
266− HasClient t m sublayout tag, SupportsServantReflex t m)
267− => HasClient t m (Header sym a :> sublayout) tag where
268−
269− type Client t m (Header sym a :> sublayout) tag =
270− Dynamic t (Either Text a) -> Client t m sublayout tag
271−
272− clientWithRoute Proxy q t req baseurl opts eVal =
273− clientWithRoute (Proxy :: Proxy sublayout)
274− q t
275− (Servant.Common.Req.addHeader hname eVal req)
276− baseurl opts
277− where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
278−
279−
280−
281−
282−-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
283−-- functions.
284−instance HasClient t m sublayout tag
285− => HasClient t m (HttpVersion :> sublayout) tag where
286−
287− type Client t m (HttpVersion :> sublayout) tag =
288− Client t m sublayout tag
289−
290− clientWithRoute Proxy q t =
291− clientWithRoute (Proxy :: Proxy sublayout) q t
292−
293−
294−-- | If you use a 'QueryParam' in one of your endpoints in your API,
295−-- the corresponding querying function will automatically take
296−-- an additional argument of the type specified by your 'QueryParam',
297−-- enclosed in Maybe.
298−--
299−-- If you give Nothing, nothing will be added to the query string.
300−--
301−-- If you give a non-'Nothing' value, this function will take care
302−-- of inserting a textual representation of this value in the query string.
303−--
304−-- You can control how values for your type are turned into
305−-- text by specifying a 'ToHttpApiData' instance for your type.
306−--
307−-- Example:
308−--
309−-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
310−-- >
311−-- > myApi :: Proxy MyApi
312−-- > myApi = Proxy
313−-- >
314−-- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
315−-- > getBooksBy = client myApi host
316−-- > where host = BaseUrl Http "localhost" 8080
317−-- > -- then you can just use "getBooksBy" to query that endpoint.
318−-- > -- 'getBooksBy Nothing' for all books
319−-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
320−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
321− => HasClient t m (QueryParam sym a :> sublayout) tag where
322−
323− type Client t m (QueryParam sym a :> sublayout) tag =
324− Dynamic t (QParam a) -> Client t m sublayout tag
325−
326− -- if mparam = Nothing, we don't add it to the query string
327− clientWithRoute Proxy q t req baseurl opts mparam =
328− clientWithRoute (Proxy :: Proxy sublayout) q t
329− (req {qParams = paramPair : qParams req}) baseurl opts
330−
331− where pname = symbolVal (Proxy :: Proxy sym)
332− --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm
333− --paramPair = (T.pack pname, p mparam)
334− p prm = QueryPartParam $ fmap qParamToQueryPart prm -- (fmap . fmap) (unpack . toQueryParam) prm
335− paramPair = (T.pack pname, p mparam)
336−
337−
338−
339−-- | If you use a 'QueryParams' in one of your endpoints in your API,
340−-- the corresponding querying function will automatically take
341−-- an additional argument, a list of values of the type specified
342−-- by your 'QueryParams'.
343−--
344−-- If you give an empty list, nothing will be added to the query string.
345−--
346−-- Otherwise, this function will take care
347−-- of inserting a textual representation of your values in the query string,
348−-- under the same query string parameter name.
349−--
350−-- You can control how values for your type are turned into
351−-- text by specifying a 'ToHttpApiData' instance for your type.
352−--
353−-- Example:
354−--
355−-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
356−-- >
357−-- > myApi :: Proxy MyApi
358−-- > myApi = Proxy
359−-- >
360−-- > getBooksBy :: [Text] -> ExceptT String IO [Book]
361−-- > getBooksBy = client myApi host
362−-- > where host = BaseUrl Http "localhost" 8080
363−-- > -- then you can just use "getBooksBy" to query that endpoint.
364−-- > -- 'getBooksBy []' for all books
365−-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
366−-- > -- to get all books by Asimov and Heinlein
367−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
368− => HasClient t m (QueryParams sym a :> sublayout) tag where
369−
370− type Client t m (QueryParams sym a :> sublayout) tag =
371− Dynamic t [a] -> Client t m sublayout tag
372−
373− clientWithRoute Proxy q t req baseurl opts paramlist =
374− clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts
375−
376− where req' = req { qParams = (T.pack pname, params') : qParams req }
377− pname = symbolVal (Proxy :: Proxy sym)
378− params' = QueryPartParams $ (fmap . fmap) toQueryParam
379− paramlist
380−
381−
382−
383−-- | If you use a 'QueryFlag' in one of your endpoints in your API,
384−-- the corresponding querying function will automatically take
385−-- an additional 'Bool' argument.
386−--
387−-- If you give 'False', nothing will be added to the query string.
388−--
389−-- Otherwise, this function will insert a value-less query string
390−-- parameter under the name associated to your 'QueryFlag'.
391−--
392−-- Example:
393−--
394−-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
395−-- >
396−-- > myApi :: Proxy MyApi
397−-- > myApi = Proxy
398−-- >
399−-- > getBooks :: Bool -> ExceptT String IO [Book]
400−-- > getBooks = client myApi host
401−-- > where host = BaseUrl Http "localhost" 8080
402−-- > -- then you can just use "getBooks" to query that endpoint.
403−-- > -- 'getBooksBy False' for all books
404−-- > -- 'getBooksBy True' to only get _already published_ books
405−
406−-- TODO Bring back
407−instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)
408− => HasClient t m (QueryFlag sym :> sublayout) tag where
409−
410− type Client t m (QueryFlag sym :> sublayout) tag =
411− Dynamic t Bool -> Client t m sublayout tag
412−
413− clientWithRoute Proxy q t req baseurl opts flag =
414− clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts
415−
416− where req' = req { qParams = thisPair : qParams req }
417− thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
418− pName = symbolVal (Proxy :: Proxy sym)
419−
420−
421−
422−-- | Send a raw 'XhrRequest ()' directly to 'baseurl'
423−instance SupportsServantReflex t m => HasClient t m Raw tag where
424− type Client t m Raw tag = Dynamic t (Either Text (XhrRequest ()))
425− -> Event t tag
426− -> m (Event t (ReqResult tag ()))
427−
428− clientWithRoute _ _ _ _ baseurl _ xhrs triggers = do
429−
430− let xhrs' = liftA2 (\x path -> case x of
431− Left e -> Left e
432− Right jx -> Right $ jx { _xhrRequest_url = path <> _xhrRequest_url jx }
433− ) xhrs (showBaseUrl <$> baseurl)
434− xhrs'' = attachPromptlyDynWith (flip (,)) xhrs' triggers :: Event t (tag, Either Text (XhrRequest ()))
435− badReq = fmapMaybe (\(t,x) -> either (Just . (t,)) (const Nothing) x) xhrs'' :: Event t (tag, Text)
436− okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())
437−
438− resps <- performRequestsAsync okReq
439− return $ leftmost [ uncurry RequestFailure <$> badReq
440− , evalResponse (const $ Right ()) <$> resps
441− ]
442−
443−
444−-- | If you use a 'ReqBody' in one of your endpoints in your API,
445−-- the corresponding querying function will automatically take
446−-- an additional argument of the type specified by your 'ReqBody'.
447−-- That function will take care of encoding this argument as JSON and
448−-- of using it as the request body.
449−--
450−-- All you need is for your type to have a 'ToJSON' instance.
451−--
452−-- Example:
453−--
454−-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
455−-- >
456−-- > myApi :: Proxy MyApi
457−-- > myApi = Proxy
458−-- >
459−-- > addBook :: Book -> ExceptT String IO Book
460−-- > addBook = client myApi host
461−-- > where host = BaseUrl Http "localhost" 8080
462−-- > -- then you can just use "addBook" to query that endpoint
463−
464−instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
465− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where
466−
467− type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =
468− Dynamic t (Either Text a) -> Client t m sublayout tag
469−
470− clientWithRoute Proxy q t req baseurl opts body =
471− clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts
472− where req' = req { reqBody = bodyBytesCT }
473− ctProxy = Proxy :: Proxy ct
474− ctString = T.pack $ show $ contentType ctProxy
475− bodyBytesCT = Just $ (fmap . fmap)
476− (\b -> (mimeRender ctProxy b, ctString))
477− body
478−
479−
480−
481−-- | Make the querying function append @path@ to the request path.
482−instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
483− type Client t m (path :> sublayout) tag = Client t m sublayout tag
484−
485− clientWithRoute Proxy q t req baseurl opts =
486− clientWithRoute (Proxy :: Proxy sublayout) q t
487− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts
488−
489− where p = symbolVal (Proxy :: Proxy path)
490−
491−
492−instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
493− type Client t m (Vault :> api) tag = Client t m api tag
494−
495− clientWithRoute Proxy q t req baseurl =
496− clientWithRoute (Proxy :: Proxy api) q t req baseurl
497−
498−
499−instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
500− type Client t m (RemoteHost :> api) tag = Client t m api tag
501−
502− clientWithRoute Proxy q t req baseurl =
503− clientWithRoute (Proxy :: Proxy api) q t req baseurl
504−
505−
506−
507−instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
508− type Client t m (IsSecure :> api) tag = Client t m api tag
509−
510− clientWithRoute Proxy q t req baseurl =
511− clientWithRoute (Proxy :: Proxy api) q t req baseurl
512−
513−
514−instance (HasClient t m api tag, Reflex t)
515− => HasClient t m (BasicAuth realm usr :> api) tag where
516−
517− type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)
518− -> Client t m api tag
519−
520− clientWithRoute Proxy q t req baseurl opts authdata =
521− clientWithRoute (Proxy :: Proxy api) q t req' baseurl opts
522− where
523− req' = req { authData = Just authdata }
524−
525−-- instance HasClient t m subapi =>
526−-- HasClient t m (WithNamedConfig name config subapi) where
527−
528−-- type Client t m (WithNamedConfig name config subapi) = Client t m subapi
529−-- clientWithRoute Proxy q = clientWithRoute (Proxy :: Proxy subapi) q
530−
531−
532−{- Note [Non-Empty Content Types]
533−~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
534−Rather than have
535−
536− instance (..., cts' ~ (ct ': cts)) => ... cts' ...
537−
538−It may seem to make more sense to have:
539−
540− instance (...) => ... (ct ': cts) ...
541−
542−But this means that if another instance exists that does *not* require
543−non-empty lists, but is otherwise more specific, no instance will be overall
544−more specific. This in turn generally means adding yet another instance (one
545−for empty and one for non-empty lists).
546−-}
547−
548−
549−-- SUPPORT FOR servant-auth --
550−
551−-- For JavaScript clients we should be sending/storing JSON web tokens in a
552−-- way that is inaccessible to JavaScript.
553−--
554−-- For @servant-auth@ this is done with HTTP-only cookies. In a Reflex-DOM
555−-- app this means the @servant-auth@ client should only verify that the API
556−-- supports Cookie-based authentication but do nothing with the token
557−-- directly.
558−
559−-- @HasCookieAuth auths@ is nominally a redundant constraint, but ensures
560−-- we're not trying to rely on cookies when the API does not use them.
561−instance (HasCookieAuth auths, HasClient t m api tag) => HasClient t m (Auth.Auth auths a :> api) tag where
562−
563− type Client t m (Auth.Auth auths a :> api) tag = Client t m api tag
564− clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api)
565−
566−
567−type family HasCookieAuth xs :: Constraint where
568− HasCookieAuth (Auth.Cookie ': xs) = ()
569− HasCookieAuth (x ': xs) = HasCookieAuth xs
570− HasCookieAuth '[] = CookieAuthNotEnabled
571−
572−class CookieAuthNotEnabled
7+import Servant.Client.Core.Reexport
8+import Servant.Client.Internal.ReflexClient
5739
10+a :: Int
11+a = 3