@@ -1,23 +1,15 @@
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 #-}
17−
12+{-# LANGUAGE MultiParamTypeClasses #-}
18−#if MIN_VERSION_base(4,9,0)
19−{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
22-- #include "overlapping-compat.h"
14-- #include "overlapping-compat.h"
23-- | This module provides 'client' which can automatically generate
15-- | This module provides 'client' which can automatically generate
@@ -25,71 +17,29 @@
26module Servant.Reflex
18module Servant.Reflex
28− , clientWithOpts
20+ , HasClient(..)
29− , clientWithOptsAndResultHandler
31− , clientWithRouteAndResultHandler
32− , BuildHeaderKeysTo(..)
36− , module Servant.Common.Req
37 , module Servant.Common.BaseUrl
21 , module Servant.Common.BaseUrl
40−------------------------------------------------------------------------------
41−import Control.Applicative
24+import Control.Applicative ((<$>))
42−import qualified Data.CaseInsensitive as CI
25+import Control.Monad.Trans.Except
43−import Data.Functor.Identity
44−import qualified Data.Map as Map
45−import Data.Monoid ((<>))
26+import Data.ByteString.Lazy (ByteString)
46−import Data.Proxy (Proxy (..))
27+import Data.List
47−import qualified Data.Set as Set
28+import Data.Proxy
48−import Data.Text (Text)
29+import Data.String.Conversions
49−import qualified Data.Text as T
30+import Data.Text (unpack)
50−import qualified Data.Text.Encoding as E
31+import qualified Data.ByteString.Char8 as BS
51−import GHC.Exts (Constraint)
52−import GHC.TypeLits (KnownSymbol, symbolVal)
32+import GHC.TypeLits
53−import Servant.API ((:<|>) (..), (:>), BasicAuth,
33+-- import Network.HTTP.Media
54− BasicAuthData, BuildHeadersTo (..),
34+-- import qualified Network.HTTP.Types as H
55− Capture, Header, Headers (..),
35+-- import qualified Network.HTTP.Types.Header as HTTP
56− HttpVersion, IsSecure,
36+import Servant.API
57− MimeRender (..), MimeUnrender,
37+import Servant.Common.BaseUrl
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.Req
77− defaultClientOptions,
39+import Servant.API.ContentTypes
78− Req, ReqResult(..), QParam(..),
40+import Reflex
79− QueryPart(..), addHeader, authData,
41+import Reflex.Dom
80− defReq, evalResponse, prependToPathParts,
42+import Reflex.Dom.Xhr
83− -- performRequestNoBody,
84− performRequestsNoBody,
85− performSomeRequestsAsync,
86− qParamToQueryPart, reqBody,
87− reqSuccess, reqFailure,
88− reqMethod, respHeaders,
91− qParams, withCredentials)
94-- * Accessing APIs as a Client
44-- * Accessing APIs as a Client
@@ -101,191 +51,116 @@ import Servant.Common.Req (ClientOptions(..),
101-- > myApi :: Proxy MyApi
51-- > myApi :: Proxy MyApi
102-- > myApi = Proxy
52-- > myApi = Proxy
104−-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
54+-- > getAllBooks :: Event t () -> m (Event t (Either XhrError ((),[Book])))
105−-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
55+-- > postNewBook :: Behavior t (Maybe Book) -> Event t ()
106−-- > -> m (Event t (l, ReqResult Book)))
56+-- -> m (Event t (Either XhrError (Book,Book)))
107-- > (getAllBooks :<|> postNewBook) = client myApi host
57-- > (getAllBooks :<|> postNewBook) = client myApi host
108-- > where host = constDyn $ BaseUrl Http "localhost" 8080
58-- > where host = constDyn $ BaseUrl Http "localhost" 8080
109−client
59+client :: (HasClient t m layout, MonadWidget t m)
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
60+ => 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
61+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
63-- | This class lets us define how each API combinator
144-- influences the creation of an HTTP request. It's mostly
64-- influences the creation of an HTTP request. It's mostly
145-- an internal class, you can just use 'client'.
65-- an internal class, you can just use 'client'.
146−class Monad m => HasClient t m layout (tag :: *) where
66+class HasClient t m layout where
147− type Client t m layout tag :: *
67+ type Client t m layout :: *
148− clientWithRoute
68+ 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
71+instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where
72+ type Client t m (a :<|> b) = Client t m a :<|> Client t m b
73+ clientWithRoute Proxy q req baseurl =
74+ clientWithRoute (Proxy :: Proxy a) q req baseurl :<|>
75+ clientWithRoute (Proxy :: Proxy b) q req baseurl
177-- Capture. Example:
77-- Capture. Example:
178-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
78-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
180-- > myApi :: Proxy MyApi = Proxy
80-- > myApi :: Proxy MyApi = Proxy
182−-- > getBook :: SupportsServantReflex t m
82+-- > getBook :: MonadWidget t m
183-- => Dynamic t BaseUrl
83-- => Dynamic t BaseUrl
184−-- -> Dynamic t (Maybe Text)
84+-- -> Behavior t (Maybe Text)
185−-- -> Event t l
85+-- -> Event t ()
186−-- -> m (Event t (l, ReqResult Book))
86+-- -> m (Event t (Either XhrError (Text, Book)))
187-- > getBook = client myApi (constDyn host)
87-- > getBook = client myApi (constDyn host)
88+instance (MonadWidget t m, KnownSymbol capture, ToHttpApiData a, HasClient t m sublayout)
89+ => 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
192− type Client t m (Capture capture a :> sublayout) tag =
91+ type Client t m (Capture capture a :> sublayout) =
193− Dynamic t (Either Text a) -> Client t m sublayout tag
92+ Behavior t (Maybe a) -> Client t m sublayout
195− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap val =
94+ clientWithRoute Proxy q req baseurl val =
196− clientWithRouteAndResultHandler
95+ clientWithRoute (Proxy :: Proxy sublayout)
197− (Proxy :: Proxy sublayout) q t (prependToPathParts p req) baseurl opts wrap
97+ (prependToPathParts p req)
198− where p = (fmap . fmap) (toUrlPiece) val
98+ baseurl
100+ where p = (fmap . fmap) (unpack . toUrlPiece) val
201-- VERB (Returning content) --
102-- VERB (Returning content) --
202instance {-# OVERLAPPABLE #-}
103instance {-# OVERLAPPABLE #-}
203 -- Note [Non-Empty Content Types]
104 -- Note [Non-Empty Content Types]
204− (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
105+ (MimeUnrender ct a, FromHttpApiData a, ReflectMethod method, cts' ~ (ct ': cts), MonadWidget t m
205− ) => HasClient t m (Verb method status cts' a) tag where
106+ ) => HasClient t m (Verb method status cts' a) where
206− type Client t m (Verb method status cts' a) tag =
107+ type Client t m (Verb method status cts' a) =
207− Event t tag -> m (Event t (ReqResult tag a))
108+ Event t () -> m (Event t (Maybe a, XhrResponse))
208 -- TODO how to access input types here?
109 -- TODO how to access input types here?
209 -- ExceptT ServantError IO a
110 -- ExceptT ServantError IO a
210− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =
111+ clientWithRoute Proxy q req baseurl =
211− wrap =<< fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs
112+ performRequestCT (Proxy :: Proxy ct) method req baseurl
212− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
113+ where method = BS.unpack $ reflectMethod (Proxy :: Proxy method)
213− req' = req { reqMethod = method }
115+-- TODO Overlapping error??
216-- -- VERB (No content) --
116-- -- VERB (No content) --
217−instance {-# OVERLAPPING #-}
117+-- instance {-# OVERLAPPABLE #-}
218− (ReflectMethod method, SupportsServantReflex t m) =>
118+-- (ReflectMethod method, MonadWidget t m) =>
219− HasClient t m (Verb method status cts NoContent) tag where
119+-- HasClient t m (Verb method status cts NoContent) where
220− type Client t m (Verb method status cts NoContent) tag =
120+-- type Client t m (Verb method status cts NoContent) =
221− Event t tag -> m (Event t (ReqResult tag NoContent))
121+-- Event t () -> m (Event t XhrResponse)
222− -- TODO: how to access input types here?
122+-- -- TODO: how to access input types here?
223− -- ExceptT ServantError IO NoContent
123+-- -- ExceptT ServantError IO NoContent
224− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =
124+-- clientWithRoute Proxy req baseurl =
225− wrap =<< fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req) baseurl opts trigs
125+-- performRequestNoBody method req baseurl
226− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
126+-- 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) --
128-- HEADERS Verb (Content) --
253-- Headers combinator not treated in fully general case,
129-- Headers combinator not treated in fully general case,
254-- in order to deny instances for (Headers ls (Capture "id" Int)),
130-- in order to deny instances for (Headers ls (Capture "id" Int)),
255-- a combinator that wouldn't make sense
131-- a combinator that wouldn't make sense
256-- TODO Overlapping??
132-- TODO Overlapping??
257−instance {-# OVERLAPPABLE #-}
133+-- instance {-# OVERLAPPABLE #-}
258− -- Note [Non-Empty Content Types]
134+-- -- Note [Non-Empty Content Types]
259− ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
135+-- ( MimeUnrender ct a, BuildHeadersTo ls,
260− ReflectMethod method, cts' ~ (ct ': cts),
136+-- ReflectMethod method, cts' ~ (ct ': cts),
261− SupportsServantReflex t m
137+-- MonadWidget t m
262− ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where
138+-- ) => HasClient t m (Verb method status cts' (Headers ls a)) where
263− type Client t m (Verb method status cts' (Headers ls a)) tag =
139+-- type Client t m (Verb method status cts' (Headers ls a))
264− Event t tag -> m (Event t (ReqResult tag (Headers ls a)))
140+-- = Event t () -> m (Event t (Maybe a, XhrResponse))
265− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do
141+-- -- ExceptT ServantError IO (Headers ls a)
142+-- clientWithRoute Proxy req baseurl = do
266− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
143+-- let method = reflectMethod (Proxy :: Proxy method)
267− resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl opts trigs
144+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl
268− wrap $ toHeaders <$> resp
145+-- return $ Headers { getResponse = resp
269− where req' = req { respHeaders =
146+-- , getHeadersHList = buildHeadersTo hdrs
270− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
274−-- HEADERS Verb (No content) --
275−instance {-# OVERLAPPABLE #-}
276− ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,
277− SupportsServantReflex t m
278− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where
279− type Client t m (Verb method status cts (Headers ls NoContent)) tag
280− = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))
281− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do
282− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
283− resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl opts trigs
284− wrap $ toHeaders <$> resp
285− where req' = req {respHeaders =
286− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
149+-- TODO Overlapping??
150+-- -- HEADERS Verb (No content) --
151+-- instance {-# OVERLAPPABLE #-}
152+-- ( BuildHeadersTo ls, ReflectMethod method,
154+-- ) => HasClient t m (Verb method status cts (Headers ls NoContent)) where
155+-- type Client t m (Verb method status cts (Headers ls NoContent))
156+-- = Event t () -> m (Event t XhrResponse)
157+-- -- ExceptT ServantError IO (Headers ls NoContent)
158+-- clientWithRoute Proxy req baseurl = do
159+-- let method = reflectMethod (Proxy :: Proxy method)
160+-- hdrs <- performRequestNoBody method req baseurl
161+-- return $ Headers { getResponse = NoContent
162+-- , getHeadersHList = buildHeadersTo hdrs
@@ -302,46 +177,34 @@ instance {-# OVERLAPPABLE #-}
302-- > -- then you can just use "viewRefer" to query that endpoint
177-- > -- then you can just use "viewRefer" to query that endpoint
303-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
178-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
304instance (KnownSymbol sym, ToHttpApiData a,
179instance (KnownSymbol sym, ToHttpApiData a,
305− HasClient t m sublayout tag, SupportsServantReflex t m)
180+ HasClient t m sublayout, MonadWidget t m)
306− => HasClient t m (Header sym a :> sublayout) tag where
181+ => HasClient t m (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)
183+ type Client t m (Header sym a :> sublayout) =
184+ Behavior t (Maybe a) -> Client t m sublayout
186+ clientWithRoute Proxy q req baseurl mval =
187+ clientWithRoute (Proxy :: Proxy sublayout)
190+ -- (maybe req -- TODO Need to pass the header in
191+ -- (\value -> Servant.Common.Req.addHeader hname value req)
196+ where hname = symbolVal (Proxy :: Proxy sym)
321-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
198-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
322-- functions.
199-- functions.
323−instance HasClient t m sublayout tag
200+instance HasClient t m sublayout
324− => HasClient t m (HttpVersion :> sublayout) tag where
201+ => 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)
203+ type Client t m (HttpVersion :> sublayout) =
204+ Client t m sublayout
206+ clientWithRoute Proxy q =
207+ clientWithRoute (Proxy :: Proxy sublayout) q
346-- | If you use a 'QueryParam' in one of your endpoints in your API,
209-- | If you use a 'QueryParam' in one of your endpoints in your API,
347-- the corresponding querying function will automatically take
210-- the corresponding querying function will automatically take
@@ -369,24 +232,24 @@ instance (HasClient t m sublayout tag, KnownSymbol sym)
369-- > -- then you can just use "getBooksBy" to query that endpoint.
232-- > -- then you can just use "getBooksBy" to query that endpoint.
370-- > -- 'getBooksBy Nothing' for all books
233-- > -- 'getBooksBy Nothing' for all books
371-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
234-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
372−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
235+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout)
373− => HasClient t m (QueryParam sym a :> sublayout) tag where
236+ => HasClient t m (QueryParam sym a :> sublayout) where
375− type Client t m (QueryParam sym a :> sublayout) tag =
238+ type Client t m (QueryParam sym a :> sublayout) =
239+ -- TODO (Maybe a), or (Maybe (Maybe a))? (should the user be able to send a Nothing)
376− Dynamic t (QParam a) -> Client t m sublayout tag
240+ Behavior t (Maybe a) -> Client t m sublayout
378 -- if mparam = Nothing, we don't add it to the query string
242 -- if mparam = Nothing, we don't add it to the query string
379− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap mparam =
243+ clientWithRoute Proxy q req baseurl mparam =
380− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t
244+ clientWithRoute (Proxy :: Proxy sublayout)
246+ req -- TODO Must pass in the query param
381− (req {qParams = paramPair : qParams req}) baseurl opts wrap
247+ -- (req {qParams = (pname', map show mparam) : qParams req})
383− where pname = symbolVal (Proxy :: Proxy sym)
384− --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm
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)
250+ -- where pname = cs pname'
251+ -- pname' = symbolVal (Proxy :: Proxy sym)
252+ -- mparamText = fmap toQueryParam mparam
391-- | If you use a 'QueryParams' in one of your endpoints in your API,
254-- | If you use a 'QueryParams' in one of your endpoints in your API,
392-- the corresponding querying function will automatically take
255-- the corresponding querying function will automatically take
@@ -416,21 +279,24 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
416-- > -- 'getBooksBy []' for all books
279-- > -- 'getBooksBy []' for all books
417-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
280-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
418-- > -- to get all books by Asimov and Heinlein
281-- > -- to get all books by Asimov and Heinlein
419−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
282+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout)
420− => HasClient t m (QueryParams sym a :> sublayout) tag where
283+ => HasClient t m (QueryParams sym a :> sublayout) where
422− type Client t m (QueryParams sym a :> sublayout) tag =
285+ type Client t m (QueryParams sym a :> sublayout) =
423− Dynamic t [a] -> Client t m sublayout tag
286+ [a] -> Client t m sublayout
425− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap paramlist =
426− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
428− where req' = req { qParams = (T.pack pname, params') : qParams req }
429− pname = symbolVal (Proxy :: Proxy sym)
430− params' = QueryPartParams $ (fmap . fmap) toQueryParam
288+ clientWithRoute Proxy _ req baseurl paramlist = undefined
289+ -- clientWithRoute (Proxy :: Proxy sublayout)
290+ -- (foldl' prependPathParts req paramlist')
291+ -- (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
297+ -- where pname = cs pname'
298+ -- pname' = symbolVal (Proxy :: Proxy sym)
299+ -- paramlist' = map (Just . toQueryParam) paramlist
435-- | If you use a 'QueryFlag' in one of your endpoints in your API,
301-- | If you use a 'QueryFlag' in one of your endpoints in your API,
436-- the corresponding querying function will automatically take
302-- the corresponding querying function will automatically take
@@ -456,42 +322,35 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
456-- > -- 'getBooksBy True' to only get _already published_ books
322-- > -- 'getBooksBy True' to only get _already published_ books
458-- TODO Bring back
324-- TODO Bring back
459−instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)
325+-- instance (KnownSymbol sym, HasClient t m sublayout)
460− => HasClient t m (QueryFlag sym :> sublayout) tag where
326+-- => HasClient t m (QueryFlag sym :> sublayout) where
462− type Client t m (QueryFlag sym :> sublayout) tag =
463− Dynamic t Bool -> Client t m sublayout tag
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 }
328+-- type Client t m (QueryFlag sym :> sublayout) =
469− thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
329+-- Bool -> Client t m sublayout
470− pName = symbolVal (Proxy :: Proxy sym)
331+-- clientWithRoute Proxy req baseurl flag =
332+-- clientWithRoute (Proxy :: Proxy sublayout)
334+-- then appendToQueryString paramname Nothing req
339+-- where paramname = cs $ symbolVal (Proxy :: Proxy sym)
474−-- | Send a raw 'XhrRequest ()' directly to 'baseurl'
475−instance SupportsServantReflex t m => HasClient t m Raw tag where
476− type Client t m Raw tag = Dynamic t (Either Text (XhrRequest ()))
478− -> m (Event t (ReqResult tag ()))
480− clientWithRouteAndResultHandler _ _ _ _ baseurl _ wrap xhrs triggers = do
342+-- | Pick a 'Method' and specify where the server you want to query is. You get
481−
343+-- back the full `Response`.
482− let xhrs' = liftA2 (\x path -> case x of
344+-- TODO redo
483− Left e -> Left e
345+instance (MonadWidget t m) => HasClient t m Raw where
484− Right jx -> Right $ jx { _xhrRequest_url = path <> _xhrRequest_url jx }
346+ type Client t m Raw = Behavior t (Maybe XhrRequest)
485− ) xhrs (showBaseUrl <$> baseurl)
347+ -> Event t ()
486− xhrs'' = attachPromptlyDynWith (flip (,)) xhrs' triggers :: Event t (tag, Either Text (XhrRequest ()))
348+ -> m (Event t XhrResponse)
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
491− wrap $ leftmost [ uncurry RequestFailure <$> badReq
492− , evalResponse (const $ Right ()) <$> resps
350+ -- clientWithRoute :: Proxy Raw -> Proxy m -> Req -> BaseUrl -> Client t m Raw
351+ clientWithRoute p q req baseurl xhrs triggers = do
352+ let okReq = fmapMaybe id $ tag xhrs triggers
353+ performRequestAsync okReq
496-- | If you use a 'ReqBody' in one of your endpoints in your API,
355-- | If you use a 'ReqBody' in one of your endpoints in your API,
497-- the corresponding querying function will automatically take
356-- the corresponding querying function will automatically take
@@ -509,76 +368,60 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where
509-- > myApi = Proxy
368-- > myApi = Proxy
511-- > addBook :: Book -> ExceptT String IO Book
370-- > addBook :: Book -> ExceptT String IO Book
512−-- > addBook = client myApi host
371+-- > addBook = client myApi host
513-- > where host = BaseUrl Http "localhost" 8080
372-- > where host = BaseUrl Http "localhost" 8080
514-- > -- then you can just use "addBook" to query that endpoint
373-- > -- then you can just use "addBook" to query that endpoint
516−instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
376+-- instance (MimeRender ct a, HasClient t m sublayout)
517− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where
377+-- => HasClient t m (ReqBody (ct ': cts) a :> sublayout) where
519− type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =
520− Dynamic t (Either Text a) -> Client t m sublayout tag
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))
379+-- type Client t m (ReqBody (ct ': cts) a :> sublayout) =
380+-- a -> Client sublayout
382+-- clientWithRoute Proxy req baseurl body =
383+-- clientWithRoute (Proxy :: Proxy sublayout)
384+-- (let ctProxy = Proxy :: Proxy ct
385+-- in setRQBody (mimeRender ctProxy body)
386+-- (contentType ctProxy)
533-- | Make the querying function append @path@ to the request path.
391-- | 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
392+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
393+ type Client t m (path :> sublayout) = Client t m sublayout
537− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap =
395+ clientWithRoute Proxy q req baseurl =
538− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t
396+ clientWithRoute (Proxy :: Proxy sublayout) q
539− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts wrap
397+ (prependToPathParts (constant (Just p)) req)
541 where p = symbolVal (Proxy :: Proxy path)
400 where p = symbolVal (Proxy :: Proxy path)
402+instance HasClient t m api => HasClient t m (Vault :> api) where
403+ type Client t m (Vault :> api) = Client t m api
544−instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
405+ clientWithRoute Proxy q req baseurl =
545− type Client t m (Vault :> api) tag = Client t m api tag
406+ 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 =
555− clientWithRouteAndResultHandler (Proxy :: Proxy api)
408+instance HasClient t m api => HasClient t m (RemoteHost :> api) where
409+ type Client t m (RemoteHost :> api) = Client t m api
559−instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
411+ clientWithRoute Proxy q req baseurl =
560− type Client t m (IsSecure :> api) tag = Client t m api tag
412+ clientWithRoute (Proxy :: Proxy api) q req baseurl
562− clientWithRouteAndResultHandler Proxy =
414+instance HasClient t m api => HasClient t m (IsSecure :> api) where
563− clientWithRouteAndResultHandler (Proxy :: Proxy api)
415+ type Client t m (IsSecure :> api) = Client t m api
417+ clientWithRoute Proxy q req baseurl =
418+ clientWithRoute (Proxy :: Proxy api) q req baseurl
566−instance (HasClient t m api tag, Reflex t)
420+instance HasClient t m subapi =>
567− => HasClient t m (BasicAuth realm usr :> api) tag where
421+ HasClient t m (WithNamedConfig name config subapi) 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
423+ type Client t m (WithNamedConfig name config subapi) = Client t m subapi
580−-- type Client t m (WithNamedConfig name config subapi) = Client t m subapi
581−-- clientWithRoute Proxy q = clientWithRoute (Proxy :: Proxy subapi) q
424+ clientWithRoute Proxy q = clientWithRoute (Proxy :: Proxy subapi) q
584{- Note [Non-Empty Content Types]
427{- Note [Non-Empty Content Types]
@@ -596,30 +439,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
439more specific. This in turn generally means adding yet another instance (one
597for empty and one for non-empty lists).
440for 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