@@ -1,95 +1,43 @@
1−{-# LANGUAGE AllowAmbiguousTypes #-}
1+{-# LANGUAGE CPP #-}
3−{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE InstanceSigs #-}
5+{-# LANGUAGE InstanceSigs #-}
8−{-# LANGUAGE MultiParamTypeClasses #-}
9−{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
7+{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE Rank2Types #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE ScopedTypeVariables #-}
13−{-# LANGUAGE TupleSections #-}
14−{-# LANGUAGE TypeFamilies #-}
9+{-# LANGUAGE TypeFamilies #-}
15−{-# LANGUAGE TypeOperators #-}
10+{-# LANGUAGE TypeOperators #-}
16−{-# LANGUAGE UndecidableInstances #-}
11+{-# LANGUAGE UndecidableInstances #-}
18−#if MIN_VERSION_base(4,9,0)
19−{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
22−-- #include "overlapping-compat.h"
13+#include "overlapping-compat.h"
23-- | This module provides 'client' which can automatically generate
14-- | This module provides 'client' which can automatically generate
24-- querying functions for each endpoint just from the type representing your
15-- querying functions for each endpoint just from the type representing your
26module Servant.Reflex
17module Servant.Reflex
29− , clientWithOptsAndResultHandler
31− , clientWithRouteAndResultHandler
32− , BuildHeaderKeysTo(..)
34− , HasClient
19+ , HasClient(..)
35− , Client
20+ , ServantError(..)
36− , module Servant.Common.Req
37 , module Servant.Common.BaseUrl
21 , module Servant.Common.BaseUrl
40−------------------------------------------------------------------------------
24+#if !MIN_VERSION_base(4,8,0)
41−import Control.Applicative
25+import Control.Applicative ((<$>))
42−import qualified Data.CaseInsensitive as CI
26+#endif
43−import Data.Functor.Identity
27+import Control.Monad.Trans.Except
44−import qualified Data.Map as Map
45−import Data.Monoid ((<>))
28+import Data.ByteString.Lazy (ByteString)
46−import Data.Proxy (Proxy (..))
29+import Data.List
47−import qualified Data.Set as Set
30+import Data.Proxy
48−import Data.Text (Text)
31+import Data.String.Conversions
49−import qualified Data.Text as T
50−import qualified Data.Text.Encoding as E
32+import Data.Text (unpack)
51−import GHC.Exts (Constraint)
52−import GHC.TypeLits (KnownSymbol, symbolVal)
33+import GHC.TypeLits
53−import Servant.API ((:<|>) (..), (:>), BasicAuth,
34+import Network.HTTP.Media
54− BasicAuthData, BuildHeadersTo (..),
35+import qualified Network.HTTP.Types as H
55− Capture, Header, Headers (..),
36+import qualified Network.HTTP.Types.Header as HTTP
56− HttpVersion, IsSecure,
37+import Servant.API
57− MimeRender (..), MimeUnrender,
58− NoContent, QueryFlag, QueryParam,
59− QueryParams, Raw, ReflectMethod (..),
61− ToHttpApiData (..), Vault, Verb,
63−import Servant.API.Description (Summary)
64−import qualified Servant.Auth as Auth
66−import Reflex.Dom.Core (Dynamic, Event, Reflex,
67− XhrRequest (..), XhrResponse (..),
68− XhrResponseHeaders (..),
69− attachPromptlyDynWith, constDyn, ffor,
71− performRequestsAsync)
72−------------------------------------------------------------------------------
73−import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
75− SupportsServantReflex)
76−import Servant.Common.Req (ClientOptions(..),
38+import Servant.Common.BaseUrl
77− defaultClientOptions,
39+import Servant.Common.Req
78− Req, ReqResult(..), QParam(..),
40+import Reflex.Dom.Xhr
79− QueryPart(..), addHeader, authData,
80− defReq, evalResponse, prependToPathParts,
83− -- performRequestNoBody,
84− performRequestsNoBody,
85− performSomeRequestsAsync,
86− qParamToQueryPart, reqBody,
87− reqSuccess, reqFailure,
88− reqMethod, respHeaders,
91− qParams, withCredentials)
94-- * Accessing APIs as a Client
42-- * Accessing APIs as a Client
@@ -101,247 +49,152 @@ import Servant.Common.Req (ClientOptions(..),
101-- > myApi :: Proxy MyApi
49-- > myApi :: Proxy MyApi
102-- > myApi = Proxy
50-- > myApi = Proxy
104−-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
52+-- > getAllBooks :: Event t () -> m (Event t (Either XhrError ((),[Book])))
105−-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
53+-- > postNewBook :: Behavior t (Maybe Book) -> Event t ()
106−-- > -> m (Event t (l, ReqResult Book)))
54+-- -> m (Event t (Either XhrError (Book,Book)))
107-- > (getAllBooks :<|> postNewBook) = client myApi host
55-- > (getAllBooks :<|> postNewBook) = client myApi host
108-- > where host = constDyn $ BaseUrl Http "localhost" 8080
56-- > where host = constDyn $ BaseUrl Http "localhost" 8080
110− :: (HasClient t m layout tag)
114− -> Dynamic t BaseUrl
115− -> Client t m layout tag
116−client p q t baseurl = clientWithRoute p q t defReq baseurl defaultClientOptions
119− :: (HasClient t m layout tag)
123− -> Dynamic t BaseUrl
57+client :: (HasClient layout) => Proxy layout -> Dynamic t BaseUrl -> Client layout
125− -> Client t m layout tag
126−clientWithOpts p q t baseurl = clientWithRoute p q t defReq baseurl
58+client p baseurl = clientWithRoute p defReq baseurl
128−-- | Like 'clientWithOpts' but allows passing a function which will process the
129−-- result event in some way. This can be used to handle errors in a uniform way
130−-- across call sites.
131−clientWithOptsAndResultHandler
132− :: (HasClient t m layout tag)
136− -> Dynamic t BaseUrl
138− -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
139− -> Client t m layout tag
140−clientWithOptsAndResultHandler p q t = clientWithRouteAndResultHandler p q t defReq
143-- | This class lets us define how each API combinator
60-- | This class lets us define how each API combinator
144-- influences the creation of an HTTP request. It's mostly
61-- influences the creation of an HTTP request. It's mostly
145-- an internal class, you can just use 'client'.
62-- an internal class, you can just use 'client'.
146−class Monad m => HasClient t m layout (tag :: *) where
63+class HasClient layout where
147− type Client t m layout tag :: *
64+ type Client layout :: *
148− clientWithRoute
65+ clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Client layout
153− -> Dynamic t BaseUrl
155− -> Client t m layout tag
156− clientWithRoute l m t r b o = clientWithRouteAndResultHandler l m t r b o return
158− clientWithRouteAndResultHandler
163− -> Dynamic t BaseUrl
165− -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
166− -> Client t m layout tag
169−instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where
170− type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag
172− clientWithRouteAndResultHandler Proxy q pTag req baseurl opts wrap =
173− clientWithRouteAndResultHandler (Proxy :: Proxy a) q pTag req baseurl opts wrap :<|>
174− clientWithRouteAndResultHandler (Proxy :: Proxy b) q pTag req baseurl opts wrap
68+instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
69+ type Client (a :<|> b) = Client a :<|> Client b
70+ clientWithRoute Proxy req baseurl manager =
71+ clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>
72+ clientWithRoute (Proxy :: Proxy b) req baseurl manager
177-- Capture. Example:
74-- Capture. Example:
178-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
75-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
180-- > myApi :: Proxy MyApi = Proxy
77-- > myApi :: Proxy MyApi = Proxy
182−-- > getBook :: SupportsServantReflex t m
79+-- > getBook :: MonadWidget t m
183-- => Dynamic t BaseUrl
80-- => Dynamic t BaseUrl
184−-- -> Dynamic t (Maybe Text)
81+-- -> Behavior t (Maybe Text)
185−-- -> Event t l
82+-- -> Event t ()
186−-- -> m (Event t (l, ReqResult Book))
83+-- -> m (Event t (Either XhrError (Text, Book)))
187-- > getBook = client myApi (constDyn host)
84-- > getBook = client myApi (constDyn host)
85+instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
86+ => HasClient (Capture capture a :> sublayout) where
189−instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout tag)
190− => HasClient t m (Capture capture a :> sublayout) tag where
88+ type Client (Capture capture a :> sublayout) =
89+ a -> Client sublayout
192− type Client t m (Capture capture a :> sublayout) tag =
91+ clientWithRoute Proxy req baseurl manager val =
193− Dynamic t (Either Text a) -> Client t m sublayout tag
195− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap val =
196− clientWithRouteAndResultHandler
197− (Proxy :: Proxy sublayout) q t (prependToPathParts p req) baseurl opts wrap
92+ clientWithRoute (Proxy :: Proxy sublayout)
198− where p = (fmap . fmap) (toUrlPiece) val
93+ (appendToPath p req)
97+ where p = unpack (toUrlPiece val)
201-- VERB (Returning content) --
99-- VERB (Returning content) --
202−instance {-# OVERLAPPABLE #-}
100+instance OVERLAPPABLE_
203 -- Note [Non-Empty Content Types]
101 -- Note [Non-Empty Content Types]
204− (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
102+ (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
205− ) => HasClient t m (Verb method status cts' a) tag where
103+ ) => HasClient (Verb method status cts' a) where
206− type Client t m (Verb method status cts' a) tag =
104+ type Client (Verb method status cts' a) = ExceptT ServantError IO a
207− Event t tag -> m (Event t (ReqResult tag a))
105+ clientWithRoute Proxy req baseurl manager =
208− -- TODO how to access input types here?
106+ snd <$> performRequestCT (Proxy :: Proxy ct) method req baseurl manager
209− -- ExceptT ServantError IO a
210− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =
211− wrap =<< fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs
212− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
107+ where method = reflectMethod (Proxy :: Proxy method)
213− req' = req { reqMethod = method }
108+
216−-- -- VERB (No content) --
109+-- VERB (No content) --
217−instance {-# OVERLAPPING #-}
110+instance OVERLAPPING_
218− (ReflectMethod method, SupportsServantReflex t m) =>
219− HasClient t m (Verb method status cts NoContent) tag where
111+ (ReflectMethod method) => HasClient (Verb method status cts NoContent) where
220− type Client t m (Verb method status cts NoContent) tag =
112+ type Client (Verb method status cts NoContent) = ExceptT ServantError IO NoContent
221− Event t tag -> m (Event t (ReqResult tag NoContent))
113+ clientWithRoute Proxy req baseurl manager =
222− -- TODO: how to access input types here?
114+ performRequestNoBody method req baseurl manager >> return NoContent
223− -- ExceptT ServantError IO NoContent
224− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =
225− wrap =<< fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req) baseurl opts trigs
226− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
115+ where method = reflectMethod (Proxy :: Proxy method)
229−toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
232− (\xhr -> fmap (\(h,v) -> (CI.map E.encodeUtf8 h, E.encodeUtf8 v))
233− (Map.toList $ _xhrResponse_headers xhr))
235− in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}
238−class BuildHeaderKeysTo hs where
239− buildHeaderKeysTo :: Proxy hs -> [CI.CI T.Text]
241−instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
242− where buildHeaderKeysTo _ = []
244−instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
245− => BuildHeaderKeysTo ((Header h v) ': xs) where
246− buildHeaderKeysTo _ =
248− thisKey = CI.mk $ T.pack (symbolVal (Proxy :: Proxy h))
249− in thisKey : buildHeaderKeysTo (Proxy :: Proxy xs)
252-- HEADERS Verb (Content) --
117-- HEADERS Verb (Content) --
253−-- Headers combinator not treated in fully general case,
254−-- in order to deny instances for (Headers ls (Capture "id" Int)),
255−-- a combinator that wouldn't make sense
256−-- TODO Overlapping??
257−instance {-# OVERLAPPABLE #-}
118+instance OVERLAPPING_
258 -- Note [Non-Empty Content Types]
119 -- Note [Non-Empty Content Types]
259− ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
260− ReflectMethod method, cts' ~ (ct ': cts),
120+ ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
261− SupportsServantReflex t m
262− ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where
121+ ) => HasClient (Verb method status cts' (Headers ls a)) where
263− type Client t m (Verb method status cts' (Headers ls a)) tag =
122+ type Client (Verb method status cts' (Headers ls a))
264− Event t tag -> m (Event t (ReqResult tag (Headers ls a)))
123+ = ExceptT ServantError IO (Headers ls a)
265− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do
124+ clientWithRoute Proxy req baseurl manager = do
266− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
125+ let method = reflectMethod (Proxy :: Proxy method)
267− resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl opts trigs
126+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl manager
268− wrap $ toHeaders <$> resp
127+ return $ Headers { getResponse = resp
269− where req' = req { respHeaders =
128+ , getHeadersHList = buildHeadersTo hdrs
270− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
274-- HEADERS Verb (No content) --
131-- HEADERS Verb (No content) --
275−instance {-# OVERLAPPABLE #-}
132+instance OVERLAPPING_
276− ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,
133+ ( BuildHeadersTo ls, ReflectMethod method
277− SupportsServantReflex t m
278− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where
134+ ) => HasClient (Verb method status cts (Headers ls NoContent)) where
279− type Client t m (Verb method status cts (Headers ls NoContent)) tag
135+ type Client (Verb method status cts (Headers ls NoContent))
280− = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))
136+ = ExceptT ServantError IO (Headers ls NoContent)
281− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do
137+ clientWithRoute Proxy req baseurl manager = do
282− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
138+ let method = reflectMethod (Proxy :: Proxy method)
283− resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl opts trigs
139+ hdrs <- performRequestNoBody method req baseurl manager
284− wrap $ toHeaders <$> resp
140+ return $ Headers { getResponse = NoContent
285− where req' = req {respHeaders =
141+ , getHeadersHList = buildHeadersTo hdrs
286− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
290−
145+-- | If you use a 'Header' in one of your endpoints in your API,
291−-- HEADER
146+-- the corresponding querying function will automatically take
147+-- an additional argument of the type specified by your 'Header',
150+-- That function will take care of encoding this argument as Text
151+-- in the request headers.
153+-- All you need is for your type to have a 'ToHttpApiData' instance.
292-- > newtype Referer = Referer { referrer :: Text }
157-- > newtype Referer = Referer { referrer :: Text }
293-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
158-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
295-- > -- GET /view-my-referer
160-- > -- GET /view-my-referer
296-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
161-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
163+-- > myApi :: Proxy MyApi
299-- > viewReferer :: Maybe Referer -> ExceptT String IO Book
166-- > viewReferer :: Maybe Referer -> ExceptT String IO Book
300-- > viewReferer = client myApi host
167-- > viewReferer = client myApi host
301-- > where host = BaseUrl Http "localhost" 8080
168-- > where host = BaseUrl Http "localhost" 8080
302-- > -- then you can just use "viewRefer" to query that endpoint
169-- > -- then you can just use "viewRefer" to query that endpoint
303-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
170-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
304−instance (KnownSymbol sym, ToHttpApiData a,
171+instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
305− HasClient t m sublayout tag, SupportsServantReflex t m)
306− => HasClient t m (Header sym a :> sublayout) tag where
172+ => HasClient (Header sym a :> sublayout) where
308− type Client t m (Header sym a :> sublayout) tag =
309− Dynamic t (Either Text a) -> Client t m sublayout tag
311− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap eVal =
312− clientWithRouteAndResultHandler
313− (Proxy :: Proxy sublayout) q t
314− (Servant.Common.Req.addHeader hname eVal req)
316− where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
174+ type Client (Header sym a :> sublayout) =
175+ Maybe a -> Client sublayout
177+ clientWithRoute Proxy req baseurl manager mval =
178+ clientWithRoute (Proxy :: Proxy sublayout)
180+ (\value -> Servant.Common.Req.addHeader hname value req)
186+ where hname = symbolVal (Proxy :: Proxy sym)
321-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
188-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
322-- functions.
189-- functions.
323−instance HasClient t m sublayout tag
190+instance HasClient sublayout
324− => HasClient t m (HttpVersion :> sublayout) tag where
191+ => HasClient (HttpVersion :> sublayout) where
326− type Client t m (HttpVersion :> sublayout) tag =
327− Client t m sublayout tag
329− clientWithRouteAndResultHandler Proxy =
330− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)
332−-- | Using a 'Summary' combinator in your API doesn't affect the client
334−instance (HasClient t m sublayout tag, KnownSymbol sym)
335− => HasClient t m (Summary sym :> sublayout) tag where
337− type Client t m (Summary sym :> sublayout) tag =
338− Client t m sublayout tag
340− clientWithRouteAndResultHandler Proxy =
341− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)
193+ type Client (HttpVersion :> sublayout) =
196+ clientWithRoute Proxy =
197+ clientWithRoute (Proxy :: Proxy sublayout)
346-- | If you use a 'QueryParam' in one of your endpoints in your API,
199-- | If you use a 'QueryParam' in one of your endpoints in your API,
347-- the corresponding querying function will automatically take
200-- the corresponding querying function will automatically take
@@ -369,24 +222,25 @@ instance (HasClient t m sublayout tag, KnownSymbol sym)
369-- > -- then you can just use "getBooksBy" to query that endpoint.
222-- > -- then you can just use "getBooksBy" to query that endpoint.
370-- > -- 'getBooksBy Nothing' for all books
223-- > -- 'getBooksBy Nothing' for all books
371-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
224-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
372−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
225+instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
373− => HasClient t m (QueryParam sym a :> sublayout) tag where
226+ => HasClient (QueryParam sym a :> sublayout) where
375− type Client t m (QueryParam sym a :> sublayout) tag =
228+ type Client (QueryParam sym a :> sublayout) =
376− Dynamic t (QParam a) -> Client t m sublayout tag
229+ Maybe a -> Client sublayout
378 -- if mparam = Nothing, we don't add it to the query string
231 -- if mparam = Nothing, we don't add it to the query string
379− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap mparam =
232+ clientWithRoute Proxy req baseurl manager mparam =
380− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t
233+ clientWithRoute (Proxy :: Proxy sublayout)
381− (req {qParams = paramPair : qParams req}) baseurl opts wrap
234+ (maybe req
382−
235+ (flip (appendToQueryString pname) req . Just)
241+ where pname = cs pname'
383− where pname = symbolVal (Proxy :: Proxy sym)
242+ pname' = symbolVal (Proxy :: Proxy sym)
384− --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm
243+ mparamText = fmap toQueryParam mparam
385− --paramPair = (T.pack pname, p mparam)
386− p prm = QueryPartParam $ fmap qParamToQueryPart prm -- (fmap . fmap) (unpack . toQueryParam) prm
387− paramPair = (T.pack pname, p mparam)
391-- | If you use a 'QueryParams' in one of your endpoints in your API,
245-- | If you use a 'QueryParams' in one of your endpoints in your API,
392-- the corresponding querying function will automatically take
246-- the corresponding querying function will automatically take
@@ -416,21 +270,23 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
416-- > -- 'getBooksBy []' for all books
270-- > -- 'getBooksBy []' for all books
417-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
271-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
418-- > -- to get all books by Asimov and Heinlein
272-- > -- to get all books by Asimov and Heinlein
419−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
273+instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
420− => HasClient t m (QueryParams sym a :> sublayout) tag where
274+ => HasClient (QueryParams sym a :> sublayout) where
422− type Client t m (QueryParams sym a :> sublayout) tag =
423− Dynamic t [a] -> Client t m sublayout tag
425− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap paramlist =
276+ type Client (QueryParams sym a :> sublayout) =
426− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
277+ [a] -> Client sublayout
428− where req' = req { qParams = (T.pack pname, params') : qParams req }
429− pname = symbolVal (Proxy :: Proxy sym)
430− params' = QueryPartParams $ (fmap . fmap) toQueryParam
279+ clientWithRoute Proxy req baseurl manager paramlist =
280+ clientWithRoute (Proxy :: Proxy sublayout)
281+ (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
287+ where pname = cs pname'
288+ pname' = symbolVal (Proxy :: Proxy sym)
289+ paramlist' = map (Just . toQueryParam) paramlist
435-- | If you use a 'QueryFlag' in one of your endpoints in your API,
291-- | If you use a 'QueryFlag' in one of your endpoints in your API,
436-- the corresponding querying function will automatically take
292-- the corresponding querying function will automatically take
@@ -454,44 +310,31 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
454-- > -- then you can just use "getBooks" to query that endpoint.
310-- > -- then you can just use "getBooks" to query that endpoint.
455-- > -- 'getBooksBy False' for all books
311-- > -- 'getBooksBy False' for all books
456-- > -- 'getBooksBy True' to only get _already published_ books
312-- > -- 'getBooksBy True' to only get _already published_ books
313+instance (KnownSymbol sym, HasClient sublayout)
314+ => HasClient (QueryFlag sym :> sublayout) where
459−instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)
460− => HasClient t m (QueryFlag sym :> sublayout) tag where
462− type Client t m (QueryFlag sym :> sublayout) tag =
316+ type Client (QueryFlag sym :> sublayout) =
463− Dynamic t Bool -> Client t m sublayout tag
317+ Bool -> Client sublayout
465− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap flag =
466− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
468− where req' = req { qParams = thisPair : qParams req }
469− thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
470− pName = symbolVal (Proxy :: Proxy sym)
474−-- | Send a raw 'XhrRequest ()' directly to 'baseurl'
319+ clientWithRoute Proxy req baseurl manager flag =
475−instance SupportsServantReflex t m => HasClient t m Raw tag where
320+ clientWithRoute (Proxy :: Proxy sublayout)
476− type Client t m Raw tag = Dynamic t (Either Text (XhrRequest ()))
321+ (if flag
477− -> Event t tag
322+ then appendToQueryString paramname Nothing req
478− -> m (Event t (ReqResult tag ()))
323+ else req
480− clientWithRouteAndResultHandler _ _ _ _ baseurl _ wrap xhrs triggers = do
327+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
482− let xhrs' = liftA2 (\x path -> case x of
484− Right jx -> Right $ jx { _xhrRequest_url = path <> _xhrRequest_url jx }
485− ) xhrs (showBaseUrl <$> baseurl)
486− xhrs'' = attachPromptlyDynWith (flip (,)) xhrs' triggers :: Event t (tag, Either Text (XhrRequest ()))
487− badReq = fmapMaybe (\(t,x) -> either (Just . (t,)) (const Nothing) x) xhrs'' :: Event t (tag, Text)
488− okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())
490− resps <- performRequestsAsync okReq
330+-- | Pick a 'Method' and specify where the server you want to query is. You get
491− wrap $ leftmost [ uncurry RequestFailure <$> badReq
331+-- back the full `Response`.
492− , evalResponse (const $ Right ()) <$> resps
332+instance HasClient Raw where
493− ]
333+ type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
335+ clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
336+ clientWithRoute Proxy req baseurl manager httpMethod = do
337+ performRequest httpMethod req baseurl manager
496-- | If you use a 'ReqBody' in one of your endpoints in your API,
339-- | If you use a 'ReqBody' in one of your endpoints in your API,
497-- the corresponding querying function will automatically take
340-- the corresponding querying function will automatically take
@@ -509,76 +352,58 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where
509-- > myApi = Proxy
352-- > myApi = Proxy
511-- > addBook :: Book -> ExceptT String IO Book
354-- > addBook :: Book -> ExceptT String IO Book
512−-- > addBook = client myApi host
355+-- > addBook = client myApi host manager
513-- > where host = BaseUrl Http "localhost" 8080
356-- > where host = BaseUrl Http "localhost" 8080
514-- > -- then you can just use "addBook" to query that endpoint
357-- > -- then you can just use "addBook" to query that endpoint
358+instance (MimeRender ct a, HasClient sublayout)
359+ => HasClient (ReqBody (ct ': cts) a :> sublayout) where
516−instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
517− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where
519− type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =
361+ type Client (ReqBody (ct ': cts) a :> sublayout) =
520− Dynamic t (Either Text a) -> Client t m sublayout tag
362+ a -> Client sublayout
522− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap body =
523− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
524− where req' = req { reqBody = bodyBytesCT }
525− ctProxy = Proxy :: Proxy ct
526− ctString = T.pack $ show $ contentType ctProxy
527− bodyBytesCT = Just $ (fmap . fmap)
528− (\b -> (mimeRender ctProxy b, ctString))
364+ clientWithRoute Proxy req baseurl manager body =
365+ clientWithRoute (Proxy :: Proxy sublayout)
366+ (let ctProxy = Proxy :: Proxy ct
367+ in setRQBody (mimeRender ctProxy body)
368+ (contentType ctProxy)
533-- | Make the querying function append @path@ to the request path.
373-- | Make the querying function append @path@ to the request path.
534−instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
374+instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
535− type Client t m (path :> sublayout) tag = Client t m sublayout tag
375+ type Client (path :> sublayout) = Client sublayout
537− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap =
377+ clientWithRoute Proxy req baseurl manager =
538− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t
378+ clientWithRoute (Proxy :: Proxy sublayout)
539− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts wrap
379+ (appendToPath p req)
541 where p = symbolVal (Proxy :: Proxy path)
382 where p = symbolVal (Proxy :: Proxy path)
384+instance HasClient api => HasClient (Vault :> api) where
385+ type Client (Vault :> api) = Client api
544−instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
387+ clientWithRoute Proxy req baseurl manager =
545− type Client t m (Vault :> api) tag = Client t m api tag
388+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
547− clientWithRouteAndResultHandler Proxy =
548− clientWithRouteAndResultHandler (Proxy :: Proxy api)
551−instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
552− type Client t m (RemoteHost :> api) tag = Client t m api tag
554− clientWithRouteAndResultHandler Proxy =
555− clientWithRouteAndResultHandler (Proxy :: Proxy api)
390+instance HasClient api => HasClient (RemoteHost :> api) where
391+ type Client (RemoteHost :> api) = Client api
393+ clientWithRoute Proxy req baseurl manager =
394+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
559−instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
396+instance HasClient api => HasClient (IsSecure :> api) where
560− type Client t m (IsSecure :> api) tag = Client t m api tag
397+ type Client (IsSecure :> api) = Client api
562− clientWithRouteAndResultHandler Proxy =
399+ clientWithRoute Proxy req baseurl manager =
563− clientWithRouteAndResultHandler (Proxy :: Proxy api)
400+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
402+instance HasClient subapi =>
403+ HasClient (WithNamedConfig name config subapi) where
566−instance (HasClient t m api tag, Reflex t)
567− => HasClient t m (BasicAuth realm usr :> api) tag where
569− type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)
570− -> Client t m api tag
572− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap authdata =
573− clientWithRouteAndResultHandler (Proxy :: Proxy api) q t req' baseurl opts wrap
575− req' = req { authData = Just authdata }
577−-- instance HasClient t m subapi =>
578−-- HasClient t m (WithNamedConfig name config subapi) where
580−-- type Client t m (WithNamedConfig name config subapi) = Client t m subapi
405+ type Client (WithNamedConfig name config subapi) = Client subapi
581−-- clientWithRoute Proxy q = clientWithRoute (Proxy :: Proxy subapi) q
406+ clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
584{- Note [Non-Empty Content Types]
409{- Note [Non-Empty Content Types]
@@ -596,30 +421,3 @@ non-empty lists, but is otherwise more specific, no instance will be overall
596more specific. This in turn generally means adding yet another instance (one
421more specific. This in turn generally means adding yet another instance (one
597for empty and one for non-empty lists).
422for empty and one for non-empty lists).
601−-- SUPPORT FOR servant-auth --
603−-- For JavaScript clients we should be sending/storing JSON web tokens in a
604−-- way that is inaccessible to JavaScript.
606−-- For @servant-auth@ this is done with HTTP-only cookies. In a Reflex-DOM
607−-- app this means the @servant-auth@ client should only verify that the API
608−-- supports Cookie-based authentication but do nothing with the token
611−-- @HasCookieAuth auths@ is nominally a redundant constraint, but ensures
612−-- we're not trying to rely on cookies when the API does not use them.
613−instance (HasCookieAuth auths, HasClient t m api tag) => HasClient t m (Auth.Auth auths a :> api) tag where
615− type Client t m (Auth.Auth auths a :> api) tag = Client t m api tag
616− clientWithRouteAndResultHandler Proxy = clientWithRouteAndResultHandler (Proxy :: Proxy api)
619−type family HasCookieAuth xs :: Constraint where
620− HasCookieAuth (Auth.Cookie ': xs) = ()
621− HasCookieAuth (x ': xs) = HasCookieAuth xs
622− HasCookieAuth '[] = CookieAuthNotEnabled
624−class CookieAuthNotEnabled