@@ -1,23 +1,16 @@
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 #-}
9+{-# LANGUAGE TupleSections #-}
14−{-# LANGUAGE TypeFamilies #-}
10+{-# LANGUAGE TypeFamilies #-}
15−{-# LANGUAGE TypeOperators #-}
11+{-# LANGUAGE TypeOperators #-}
16−{-# LANGUAGE UndecidableInstances #-}
12+{-# LANGUAGE UndecidableInstances #-}
17−
13+{-# LANGUAGE MultiParamTypeClasses #-}
18−#if MIN_VERSION_base(4,9,0)
19−{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
22-- #include "overlapping-compat.h"
15-- #include "overlapping-compat.h"
23-- | This module provides 'client' which can automatically generate
16-- | This module provides 'client' which can automatically generate
@@ -25,71 +18,49 @@
26module Servant.Reflex
19module Servant.Reflex
28− , clientWithOpts
21+ , HasClient(..)
29− , clientWithOptsAndResultHandler
31− , clientWithRouteAndResultHandler
32− , BuildHeaderKeysTo(..)
36 , module Servant.Common.Req
22 , module Servant.Common.Req
37 , module Servant.Common.BaseUrl
23 , module Servant.Common.BaseUrl
40−------------------------------------------------------------------------------
26+-------------------------------------------------------------------------------
41import Control.Applicative
27import Control.Applicative
42−import qualified Data.CaseInsensitive as CI
43−import Data.Functor.Identity
44−import qualified Data.Map as Map
45import Data.Monoid ((<>))
28import Data.Monoid ((<>))
46−import Data.Proxy (Proxy (..))
47import qualified Data.Set as Set
29import qualified Data.Set as Set
30+import qualified Data.Text.Encoding as E
31+import Data.CaseInsensitive (mk)
32+import Data.Proxy (Proxy (..))
33+import qualified Data.Map as Map
48import Data.Text (Text)
34import Data.Text (Text)
49import qualified Data.Text as T
35import qualified Data.Text as T
50−import qualified Data.Text.Encoding as E
51−import GHC.Exts (Constraint)
52import GHC.TypeLits (KnownSymbol, symbolVal)
36import GHC.TypeLits (KnownSymbol, symbolVal)
53−import Servant.API ((:<|>) (..), (:>), BasicAuth,
37+import Servant.API ((:<|>)(..),(:>), BasicAuth,
54− BasicAuthData, BuildHeadersTo (..),
38+ BasicAuthData, BuildHeadersTo(..),
55− Capture, Header, Headers (..),
39+ Capture, contentType, Header,
56− HttpVersion, IsSecure,
40+ Headers(..), HttpVersion, IsSecure,
57− MimeRender (..), MimeUnrender,
41+ MimeRender(..), MimeUnrender,
58 NoContent, QueryFlag, QueryParam,
42 NoContent, QueryFlag, QueryParam,
59− QueryParams, Raw, ReflectMethod (..),
43+ QueryParams, Raw, ReflectMethod(..),
60 RemoteHost, ReqBody,
44 RemoteHost, ReqBody,
61− ToHttpApiData (..), Vault, Verb,
45+ 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−------------------------------------------------------------------------------
73import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
46import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
74 showBaseUrl,
47 showBaseUrl,
75 SupportsServantReflex)
48 SupportsServantReflex)
76−import Servant.Common.Req (ClientOptions(..),
77− defaultClientOptions,
78− Req, ReqResult(..), QParam(..),
49+import Servant.Common.Req (Req, ReqResult(..), QParam(..),
79 QueryPart(..), addHeader, authData,
50 QueryPart(..), addHeader, authData,
80− defReq, evalResponse, prependToPathParts,
51+ defReq, prependToPathParts,
81− -- performRequestCT,
52+ performRequestCT,
83− -- performRequestNoBody,
53+ performRequestNoBody,
84− performRequestsNoBody,
85− performSomeRequestsAsync,
86 qParamToQueryPart, reqBody,
54 qParamToQueryPart, reqBody,
87 reqSuccess, reqFailure,
55 reqSuccess, reqFailure,
88− reqMethod, respHeaders,
56+ reqMethod, respHeaders, response,
91− qParams, withCredentials)
57+ qParams)
92−
58+import Reflex.Dom (Dynamic, Event, Reflex,
60+ XhrResponseHeaders(..),
61+ XhrResponse(..), ffor, fmapMaybe,
62+ leftmost, performRequestAsync,
94-- * Accessing APIs as a Client
65-- * Accessing APIs as a Client
@@ -101,78 +72,28 @@ import Servant.Common.Req (ClientOptions(..),
101-- > myApi :: Proxy MyApi
72-- > myApi :: Proxy MyApi
102-- > myApi = Proxy
73-- > myApi = Proxy
104−-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
75+-- > getAllBooks :: Event t () -> m (Event t (Either XhrError ((),[Book])))
105−-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
76+-- > postNewBook :: Dynamic t (Maybe Book) -> Event t ()
106−-- > -> m (Event t (l, ReqResult Book)))
77+-- -> m (Event t (Either XhrError (Book,Book)))
107-- > (getAllBooks :<|> postNewBook) = client myApi host
78-- > (getAllBooks :<|> postNewBook) = client myApi host
108-- > where host = constDyn $ BaseUrl Http "localhost" 8080
79-- > where host = constDyn $ BaseUrl Http "localhost" 8080
110− :: (HasClient t m layout tag)
80+client :: (HasClient t m layout)
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
81+ => Proxy layout -> Proxy m -> Dynamic t BaseUrl -> Client t m layout
125− -> Client t m layout tag
126−clientWithOpts p q t baseurl = clientWithRoute p q t defReq baseurl
82+client p q baseurl = clientWithRoute p q 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
84-- | This class lets us define how each API combinator
144-- influences the creation of an HTTP request. It's mostly
85-- influences the creation of an HTTP request. It's mostly
145-- an internal class, you can just use 'client'.
86-- an internal class, you can just use 'client'.
146−class Monad m => HasClient t m layout (tag :: *) where
87+class HasClient t m layout where
147− type Client t m layout tag :: *
88+ type Client t m layout :: *
148− clientWithRoute
89+ clientWithRoute :: Proxy layout -> Proxy m -> Req t -> Dynamic t BaseUrl -> Client t m 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
92+instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where
93+ type Client t m (a :<|> b) = Client t m a :<|> Client t m b
94+ clientWithRoute Proxy q req baseurl =
95+ clientWithRoute (Proxy :: Proxy a) q req baseurl :<|>
96+ clientWithRoute (Proxy :: Proxy b) q req baseurl
177-- Capture. Example:
98-- Capture. Example:
178-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
99-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
@@ -182,72 +103,67 @@ instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b)
182-- > getBook :: SupportsServantReflex t m
103-- > getBook :: SupportsServantReflex t m
183-- => Dynamic t BaseUrl
104-- => Dynamic t BaseUrl
184-- -> Dynamic t (Maybe Text)
105-- -> Dynamic t (Maybe Text)
185−-- -> Event t l
106+-- -> Event t ()
186−-- -> m (Event t (l, ReqResult Book))
107+-- -> m (Event t (Either XhrError (Text, Book)))
187-- > getBook = client myApi (constDyn host)
108-- > getBook = client myApi (constDyn host)
109+instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout)
110+ => HasClient t m (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
112+ type Client t m (Capture capture a :> sublayout) =
113+ Dynamic t (Either Text a) -> Client t m sublayout
192− type Client t m (Capture capture a :> sublayout) tag =
115+ clientWithRoute Proxy q req baseurl val =
193− Dynamic t (Either Text a) -> Client t m sublayout tag
116+ clientWithRoute (Proxy :: Proxy sublayout)
118+ (prependToPathParts p req)
195− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap val =
196− clientWithRouteAndResultHandler
197− (Proxy :: Proxy sublayout) q t (prependToPathParts p req) baseurl opts wrap
198 where p = (fmap . fmap) (toUrlPiece) val
121 where p = (fmap . fmap) (toUrlPiece) val
201-- VERB (Returning content) --
123-- VERB (Returning content) --
202instance {-# OVERLAPPABLE #-}
124instance {-# OVERLAPPABLE #-}
203 -- Note [Non-Empty Content Types]
125 -- Note [Non-Empty Content Types]
204 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
126 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
205− ) => HasClient t m (Verb method status cts' a) tag where
127+ ) => HasClient t m (Verb method status cts' a) where
206− type Client t m (Verb method status cts' a) tag =
128+ type Client t m (Verb method status cts' a) =
207− Event t tag -> m (Event t (ReqResult tag a))
129+ Event t () -> m (Event t (ReqResult a))
208 -- TODO how to access input types here?
130 -- TODO how to access input types here?
209 -- ExceptT ServantError IO a
131 -- ExceptT ServantError IO a
210− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =
132+ clientWithRoute Proxy _ req baseurl =
211− wrap =<< fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs
133+ performRequestCT (Proxy :: Proxy ct) method req' baseurl
212 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
134 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
213 req' = req { reqMethod = method }
135 req' = req { reqMethod = method }
216-- -- VERB (No content) --
137-- -- VERB (No content) --
217instance {-# OVERLAPPING #-}
138instance {-# OVERLAPPING #-}
218 (ReflectMethod method, SupportsServantReflex t m) =>
139 (ReflectMethod method, SupportsServantReflex t m) =>
219− HasClient t m (Verb method status cts NoContent) tag where
140+ HasClient t m (Verb method status cts NoContent) where
220− type Client t m (Verb method status cts NoContent) tag =
141+ type Client t m (Verb method status cts NoContent) =
221− Event t tag -> m (Event t (ReqResult tag NoContent))
142+ Event t () -> m (Event t (ReqResult NoContent))
222 -- TODO: how to access input types here?
143 -- TODO: how to access input types here?
223 -- ExceptT ServantError IO NoContent
144 -- ExceptT ServantError IO NoContent
224− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =
145+ clientWithRoute Proxy _ req baseurl =
225− wrap =<< fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req) baseurl opts trigs
146+ performRequestNoBody method req baseurl
226 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
147 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
229−toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
149+toHeaders :: BuildHeadersTo ls => ReqResult a -> ReqResult (Headers ls a)
230toHeaders r =
150toHeaders r =
151+ let toBS = E.encodeUtf8
231− let hdrs = maybe []
152+ hdrs = maybe []
232− (\xhr -> fmap (\(h,v) -> (CI.map E.encodeUtf8 h, E.encodeUtf8 v))
153+ (\xhr -> fmap (\(h,v) -> (mk (toBS h), toBS v))
233 (Map.toList $ _xhrResponse_headers xhr))
154 (Map.toList $ _xhrResponse_headers xhr))
234 (response r)
155 (response r)
235 in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}
156 in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}
238class BuildHeaderKeysTo hs where
158class BuildHeaderKeysTo hs where
239− buildHeaderKeysTo :: Proxy hs -> [CI.CI T.Text]
159+ buildHeaderKeysTo :: Proxy hs -> [T.Text]
241instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
161instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
242 where buildHeaderKeysTo _ = []
162 where buildHeaderKeysTo _ = []
244instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
164instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
245− => BuildHeaderKeysTo ((Header h v) ': xs) where
165+ => 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)
166+ buildHeaderKeysTo _ = (T.pack $ symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)
252-- HEADERS Verb (Content) --
168-- HEADERS Verb (Content) --
253-- Headers combinator not treated in fully general case,
169-- Headers combinator not treated in fully general case,
@@ -259,35 +175,33 @@ instance {-# OVERLAPPABLE #-}
259 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
175 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
260 ReflectMethod method, cts' ~ (ct ': cts),
176 ReflectMethod method, cts' ~ (ct ': cts),
261 SupportsServantReflex t m
177 SupportsServantReflex t m
262− ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where
178+ ) => HasClient t m (Verb method status cts' (Headers ls a)) where
263− type Client t m (Verb method status cts' (Headers ls a)) tag =
179+ type Client t m (Verb method status cts' (Headers ls a)) =
264− Event t tag -> m (Event t (ReqResult tag (Headers ls a)))
180+ Event t () -> m (Event t (ReqResult (Headers ls a)))
265− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do
181+ clientWithRoute Proxy _ req baseurl = do
266 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
182 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
267− resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl opts trigs
183+ resp <- performRequestCT (Proxy :: Proxy ct) method req' baseurl
268− wrap $ toHeaders <$> resp
184+ return $ (fmap . fmap) toHeaders resp
269 where req' = req { respHeaders =
185 where req' = req { respHeaders =
270 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
186 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
274-- HEADERS Verb (No content) --
189-- HEADERS Verb (No content) --
275instance {-# OVERLAPPABLE #-}
190instance {-# OVERLAPPABLE #-}
276 ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,
191 ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,
277 SupportsServantReflex t m
192 SupportsServantReflex t m
278− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where
193+ ) => HasClient t m (Verb method status cts (Headers ls NoContent)) where
279− type Client t m (Verb method status cts (Headers ls NoContent)) tag
194+ type Client t m (Verb method status cts (Headers ls NoContent))
280− = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))
195+ = Event t () -> m (Event t (ReqResult (Headers ls NoContent)))
281− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do
196+ clientWithRoute Proxy _ req baseurl = do
282 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
197 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
283− resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl opts trigs
198+ resp <- performRequestNoBody method req' baseurl
284− wrap $ toHeaders <$> resp
199+ return $ (fmap . fmap) toHeaders resp
285 where req' = req {respHeaders =
200 where req' = req {respHeaders =
286 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
201 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
292-- > newtype Referer = Referer { referrer :: Text }
206-- > newtype Referer = Referer { referrer :: Text }
293-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
207-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
@@ -302,45 +216,29 @@ instance {-# OVERLAPPABLE #-}
302-- > -- then you can just use "viewRefer" to query that endpoint
216-- > -- then you can just use "viewRefer" to query that endpoint
303-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
217-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
304instance (KnownSymbol sym, ToHttpApiData a,
218instance (KnownSymbol sym, ToHttpApiData a,
305− HasClient t m sublayout tag, SupportsServantReflex t m)
219+ HasClient t m sublayout, SupportsServantReflex t m)
306− => HasClient t m (Header sym a :> sublayout) tag where
220+ => HasClient t m (Header sym a :> sublayout) where
308− type Client t m (Header sym a :> sublayout) tag =
222+ type Client t m (Header sym a :> sublayout) =
309− Dynamic t (Either Text a) -> Client t m sublayout tag
223+ Dynamic t (Either Text a) -> Client t m sublayout
311− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap eVal =
225+ clientWithRoute Proxy q req baseurl eVal =
312− clientWithRouteAndResultHandler
313− (Proxy :: Proxy sublayout) q t
226+ clientWithRoute (Proxy :: Proxy sublayout)
314− (Servant.Common.Req.addHeader hname eVal req)
228+ (Servant.Common.Req.addHeader hname eVal req)
315− baseurl opts wrap
229+ baseurl
316 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
230 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
321-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
232-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
322-- functions.
233-- functions.
323−instance HasClient t m sublayout tag
234+instance HasClient t m sublayout
324− => HasClient t m (HttpVersion :> sublayout) tag where
235+ => HasClient t m (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)
237+ type Client t m (HttpVersion :> sublayout) =
238+ Client t m sublayout
240+ clientWithRoute Proxy q =
241+ clientWithRoute (Proxy :: Proxy sublayout) q
346-- | If you use a 'QueryParam' in one of your endpoints in your API,
244-- | If you use a 'QueryParam' in one of your endpoints in your API,
@@ -369,16 +267,16 @@ instance (HasClient t m sublayout tag, KnownSymbol sym)
369-- > -- then you can just use "getBooksBy" to query that endpoint.
267-- > -- then you can just use "getBooksBy" to query that endpoint.
370-- > -- 'getBooksBy Nothing' for all books
268-- > -- 'getBooksBy Nothing' for all books
371-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
269-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
372−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
270+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
373− => HasClient t m (QueryParam sym a :> sublayout) tag where
271+ => HasClient t m (QueryParam sym a :> sublayout) where
375− type Client t m (QueryParam sym a :> sublayout) tag =
273+ type Client t m (QueryParam sym a :> sublayout) =
376− Dynamic t (QParam a) -> Client t m sublayout tag
274+ Dynamic t (QParam a) -> Client t m sublayout
378 -- if mparam = Nothing, we don't add it to the query string
276 -- if mparam = Nothing, we don't add it to the query string
379− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap mparam =
277+ clientWithRoute Proxy q req baseurl mparam =
380− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t
278+ clientWithRoute (Proxy :: Proxy sublayout) q
381− (req {qParams = paramPair : qParams req}) baseurl opts wrap
279+ (req {qParams = paramPair : qParams req}) baseurl
383 where pname = symbolVal (Proxy :: Proxy sym)
281 where pname = symbolVal (Proxy :: Proxy sym)
384 --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm
282 --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm
@@ -386,8 +284,6 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
386 p prm = QueryPartParam $ fmap qParamToQueryPart prm -- (fmap . fmap) (unpack . toQueryParam) prm
284 p prm = QueryPartParam $ fmap qParamToQueryPart prm -- (fmap . fmap) (unpack . toQueryParam) prm
387 paramPair = (T.pack pname, p mparam)
285 paramPair = (T.pack pname, p mparam)
391-- | If you use a 'QueryParams' in one of your endpoints in your API,
287-- | If you use a 'QueryParams' in one of your endpoints in your API,
392-- the corresponding querying function will automatically take
288-- the corresponding querying function will automatically take
393-- an additional argument, a list of values of the type specified
289-- an additional argument, a list of values of the type specified
@@ -416,22 +312,21 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
416-- > -- 'getBooksBy []' for all books
312-- > -- 'getBooksBy []' for all books
417-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
313-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
418-- > -- to get all books by Asimov and Heinlein
314-- > -- to get all books by Asimov and Heinlein
419−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
315+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
420− => HasClient t m (QueryParams sym a :> sublayout) tag where
316+ => HasClient t m (QueryParams sym a :> sublayout) where
422− type Client t m (QueryParams sym a :> sublayout) tag =
318+ type Client t m (QueryParams sym a :> sublayout) =
423− Dynamic t [a] -> Client t m sublayout tag
319+ Dynamic t [a] -> Client t m sublayout
425− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap paramlist =
321+ clientWithRoute Proxy q req baseurl paramlist =
426− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
322+ clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
428 where req' = req { qParams = (T.pack pname, params') : qParams req }
324 where req' = req { qParams = (T.pack pname, params') : qParams req }
429 pname = symbolVal (Proxy :: Proxy sym)
325 pname = symbolVal (Proxy :: Proxy sym)
430− params' = QueryPartParams $ (fmap . fmap) toQueryParam
326+ params' = QueryPartParams $ (fmap . fmap) (toQueryParam)
431 paramlist
327 paramlist
435-- | If you use a 'QueryFlag' in one of your endpoints in your API,
330-- | If you use a 'QueryFlag' in one of your endpoints in your API,
436-- the corresponding querying function will automatically take
331-- the corresponding querying function will automatically take
437-- an additional 'Bool' argument.
332-- an additional 'Bool' argument.
@@ -456,42 +351,49 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
456-- > -- 'getBooksBy True' to only get _already published_ books
351-- > -- 'getBooksBy True' to only get _already published_ books
458-- TODO Bring back
353-- TODO Bring back
459−instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)
354+instance (KnownSymbol sym, HasClient t m sublayout, Reflex t)
460− => HasClient t m (QueryFlag sym :> sublayout) tag where
355+ => HasClient t m (QueryFlag sym :> sublayout) where
462− type Client t m (QueryFlag sym :> sublayout) tag =
357+ type Client t m (QueryFlag sym :> sublayout) =
463− Dynamic t Bool -> Client t m sublayout tag
358+ Dynamic t Bool -> Client t m sublayout
465− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap flag =
360+ clientWithRoute Proxy q req baseurl flag =
466− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
361+ clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
468 where req' = req { qParams = thisPair : qParams req }
363 where req' = req { qParams = thisPair : qParams req }
469 thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
364 thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
470 pName = symbolVal (Proxy :: Proxy sym)
365 pName = symbolVal (Proxy :: Proxy sym)
473−
368+-- | Pick a 'Method' and specify where the server you want to query is. You get
474−-- | Send a raw 'XhrRequest ()' directly to 'baseurl'
369+-- back the full `Response`.
475−instance SupportsServantReflex t m => HasClient t m Raw tag where
371+instance SupportsServantReflex t m => HasClient t m Raw where
476− type Client t m Raw tag = Dynamic t (Either Text (XhrRequest ()))
372+ type Client t m Raw = Dynamic t (Either Text (XhrRequest ()))
477− -> Event t tag
373+ -> Event t ()
478− -> m (Event t (ReqResult tag ()))
374+ -> m (Event t (ReqResult ()))
480− clientWithRouteAndResultHandler _ _ _ _ baseurl _ wrap xhrs triggers = do
376+ -- clientWithRoute :: Proxy Raw -> Proxy m -> Req -> BaseUrl -> Client t m Raw
481−
377+ clientWithRoute _ _ _ baseurl xhrs triggers = do
482− let xhrs' = liftA2 (\x path -> case x of
378+ let xhrs' = liftA2 (\x path -> case x of
483− Left e -> Left e
379+ Left e -> Left e
484− Right jx -> Right $ jx { _xhrRequest_url = path <> _xhrRequest_url jx }
380+ Right jx -> Right $ jx {_xhrRequest_url = path
381+ <> _xhrRequest_url jx})
485− ) xhrs (showBaseUrl <$> baseurl)
383+ (showBaseUrl <$> baseurl)
486− xhrs'' = attachPromptlyDynWith (flip (,)) xhrs' triggers :: Event t (tag, Either Text (XhrRequest ()))
384+ reqs = tagPromptlyDyn xhrs' triggers
487− badReq = fmapMaybe (\(t,x) -> either (Just . (t,)) (const Nothing) x) xhrs'' :: Event t (tag, Text)
385+ okReq = fmapMaybe hush reqs
488− okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())
386+ badReq = fmapMaybe tattle reqs
489−
387+ resps <- performRequestAsync okReq
490− resps <- performRequestsAsync okReq
388+ return $ leftmost [fmap (ResponseSuccess () ) resps
491− wrap $ leftmost [ uncurry RequestFailure <$> badReq
389+ ,fmap RequestFailure badReq]
492− , evalResponse (const $ Right ()) <$> resps
390+
494−
392+hush :: Either e a -> Maybe a
393+hush = either (const Nothing) Just
395+tattle :: Either e a -> Maybe e
396+tattle = either Just (const Nothing)
496-- | If you use a 'ReqBody' in one of your endpoints in your API,
398-- | If you use a 'ReqBody' in one of your endpoints in your API,
497-- the corresponding querying function will automatically take
399-- the corresponding querying function will automatically take
@@ -513,14 +415,14 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where
513-- > where host = BaseUrl Http "localhost" 8080
415-- > where host = BaseUrl Http "localhost" 8080
514-- > -- then you can just use "addBook" to query that endpoint
416-- > -- then you can just use "addBook" to query that endpoint
516−instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
418+instance (MimeRender ct a, HasClient t m sublayout, Reflex t)
517− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where
419+ => HasClient t m (ReqBody (ct ': cts) a :> sublayout) where
519− type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =
421+ type Client t m (ReqBody (ct ': cts) a :> sublayout) =
520− Dynamic t (Either Text a) -> Client t m sublayout tag
422+ Dynamic t (Either Text a) -> Client t m sublayout
522− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap body =
424+ clientWithRoute Proxy q req baseurl body =
523− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
425+ clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
524 where req' = req { reqBody = bodyBytesCT }
426 where req' = req { reqBody = bodyBytesCT }
525 ctProxy = Proxy :: Proxy ct
427 ctProxy = Proxy :: Proxy ct
526 ctString = T.pack $ show $ contentType ctProxy
428 ctString = T.pack $ show $ contentType ctProxy
@@ -528,49 +430,43 @@ instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
528 (\b -> (mimeRender ctProxy b, ctString))
430 (\b -> (mimeRender ctProxy b, ctString))
533-- | Make the querying function append @path@ to the request path.
433-- | 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
434+instance (KnownSymbol path, HasClient t m sublayout, Reflex t) => HasClient t m (path :> sublayout) where
535− type Client t m (path :> sublayout) tag = Client t m sublayout tag
435+ type Client t m (path :> sublayout) = Client t m sublayout
537− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap =
437+ clientWithRoute Proxy q req baseurl =
538− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t
438+ clientWithRoute (Proxy :: Proxy sublayout) q
539− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts wrap
439+ (prependToPathParts (pure (Right $ T.pack p)) req)
541 where p = symbolVal (Proxy :: Proxy path)
442 where p = symbolVal (Proxy :: Proxy path)
444+instance HasClient t m api => HasClient t m (Vault :> api) where
445+ type Client t m (Vault :> api) = Client t m api
544−instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
447+ clientWithRoute Proxy q req baseurl =
545− type Client t m (Vault :> api) tag = Client t m api tag
448+ clientWithRoute (Proxy :: Proxy api) q req baseurl
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 =
450+instance HasClient t m api => HasClient t m (RemoteHost :> api) where
555− clientWithRouteAndResultHandler (Proxy :: Proxy api)
451+ type Client t m (RemoteHost :> api) = Client t m api
453+ clientWithRoute Proxy q req baseurl =
454+ clientWithRoute (Proxy :: Proxy api) q req baseurl
456+instance HasClient t m api => HasClient t m (IsSecure :> api) where
457+ type Client t m (IsSecure :> api) = Client t m api
559−instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
459+ clientWithRoute Proxy q req baseurl =
560− type Client t m (IsSecure :> api) tag = Client t m api tag
460+ clientWithRoute (Proxy :: Proxy api) q req baseurl
562− clientWithRouteAndResultHandler Proxy =
462+instance (HasClient t m api, Reflex t)
563− clientWithRouteAndResultHandler (Proxy :: Proxy api)
463+ => HasClient t m (BasicAuth realm usr :> api) where
465+ type Client t m (BasicAuth realm usr :> api) = Dynamic t (Maybe BasicAuthData)
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 =
468+ clientWithRoute Proxy q req baseurl authdata =
573− clientWithRouteAndResultHandler (Proxy :: Proxy api) q t req' baseurl opts wrap
469+ clientWithRoute (Proxy :: Proxy api) q req' baseurl
575 req' = req { authData = Just authdata }
471 req' = req { authData = Just authdata }
@@ -596,30 +492,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
492more specific. This in turn generally means adding yet another instance (one
597for empty and one for non-empty lists).
493for 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