git.iko.soy/servant
on master help sign in
Merge branch 'pr'
2fb981fSönke Hahn
doc/tutorial/Client.lhs+16−22
compare with master
unifiedsplit
@@ -15,14 +15,13 @@ need to have some language extensions and imports:
15
15
16module Client where
16module Client where
17
17
18−import Control.Monad.Trans.Except
18+import Control.Monad.Trans.Except (ExceptT, runExceptT)
19import Data.Aeson
19import Data.Aeson
20import Data.Proxy
20import Data.Proxy
21import GHC.Generics
21import GHC.Generics
22import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
22import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
23import Servant.API
23import Servant.API
24import Servant.Client
24import Servant.Client
25−import System.IO.Unsafe
26```
25```
27
26
28Also, we need examples for some domain specific data types:
27Also, we need examples for some domain specific data types:
@@ -72,40 +71,34 @@ What we are going to get with **servant-client** here is 3 functions, one to que
72``` haskell
71``` haskell
73position :: Int -- ^ value for "x"
72position :: Int -- ^ value for "x"
74 -> Int -- ^ value for "y"
73 -> Int -- ^ value for "y"
74+ -> Manager -- ^ the HTTP client to use
75+ -> BaseUrl -- ^ the URL at which the API can be found
75 -> ExceptT ServantError IO Position
76 -> ExceptT ServantError IO Position
76
77
77hello :: Maybe String -- ^ an optional value for "name"
78hello :: Maybe String -- ^ an optional value for "name"
79+ -> Manager -- ^ the HTTP client to use
80+ -> BaseUrl -- ^ the URL at which the API can be found
78 -> ExceptT ServantError IO HelloMessage
81 -> ExceptT ServantError IO HelloMessage
79
82
80marketing :: ClientInfo -- ^ value for the request body
83marketing :: ClientInfo -- ^ value for the request body
84+ -> Manager -- ^ the HTTP client to use
85+ -> BaseUrl -- ^ the URL at which the API can be found
81 -> ExceptT ServantError IO Email
86 -> ExceptT ServantError IO Email
82```
87```
83
88
84Each function makes available as an argument any value that the response may
89Each function makes available as an argument any value that the response may
85depend on, as evidenced in the API type. How do we get these functions? By calling
90depend on, as evidenced in the API type. How do we get these functions? By calling
86−the function `client`. It takes three arguments:
91+the function `client`. It takes one argument:
87
92
88- a `Proxy` to your API,
93- a `Proxy` to your API,
89−- a `BaseUrl`, consisting of the protocol, the host, the port and an optional subpath --
90− this basically tells `client` where the service that you want to query is hosted,
91−- a `Manager`, (from [http-client](http://hackage.haskell.org/package/http-client))
92−which manages http connections.
93
94
94``` haskell
95``` haskell
95api :: Proxy API
96api :: Proxy API
96api = Proxy
97api = Proxy
97
98
98−{-# NOINLINE __manager #-}
99−__manager :: Manager
100−__manager = unsafePerformIO $ newManager defaultManagerSettings
101−
102−position :<|> hello :<|> marketing =
99+position :<|> hello :<|> marketing = client api
103− client api (BaseUrl Http "localhost" 8081 "") __manager
104```
100```
105
101
106−(Yes, the usage of `unsafePerformIO` is very ugly, we know. Hopefully soon it'll
107−be possible to do without.)
108−
109As you can see in the code above, we just "pattern match our way" to these functions. If we try to derive less or more functions than there are endpoints in the API, we obviously get an error. The `BaseUrl` value there is just:
102As you can see in the code above, we just "pattern match our way" to these functions. If we try to derive less or more functions than there are endpoints in the API, we obviously get an error. The `BaseUrl` value there is just:
110
103
111``` haskell ignore
104``` haskell ignore
@@ -127,16 +120,17 @@ data BaseUrl = BaseUrl
127That's it. Let's now write some code that uses our client functions.
120That's it. Let's now write some code that uses our client functions.
128
121
129``` haskell
122``` haskell
130−queries :: ExceptT ServantError IO (Position, HelloMessage, Email)
123+queries :: Manager -> BaseUrl -> ExceptT ServantError IO (Position, HelloMessage, Email)
131−queries = do
124+queries manager baseurl = do
132− pos <- position 10 10
125+ pos <- position 10 10 manager baseurl
133− message <- hello (Just "servant")
126+ message <- hello (Just "servant") manager baseurl
134− em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])
127+ em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) manager baseurl
135 return (pos, message, em)
128 return (pos, message, em)
136
129
137run :: IO ()
130run :: IO ()
138run = do
131run = do
132+ manager <- newManager defaultManagerSettings
139− res <- runExceptT queries
133+ res <- runExceptT (queries manager (BaseUrl Http "localhost" 8081 ""))
140 case res of
134 case res of
141 Left err -> putStrLn $ "Error: " ++ show err
135 Left err -> putStrLn $ "Error: " ++ show err
142 Right (pos, message, em) -> do
136 Right (pos, message, em) -> do
servant-client/CHANGELOG.md+3
@@ -1,3 +1,6 @@
1+
2+* `client` no longer takes `BaseUrl` and `Manager` arguments. Instead, each function returned by `client` requires these two arguments.
3+
10.5
40.5
2----
5----
3
6
servant-client/src/Servant/Client.hs+60−77
@@ -27,14 +27,13 @@ module Servant.Client
27#if !MIN_VERSION_base(4,8,0)
27#if !MIN_VERSION_base(4,8,0)
28import Control.Applicative ((<$>))
28import Control.Applicative ((<$>))
29#endif
29#endif
30−import Control.Monad.Trans.Except
31import Data.ByteString.Lazy (ByteString)
30import Data.ByteString.Lazy (ByteString)
32import Data.List
31import Data.List
33import Data.Proxy
32import Data.Proxy
34import Data.String.Conversions
33import Data.String.Conversions
35import Data.Text (unpack)
34import Data.Text (unpack)
36import GHC.TypeLits
35import GHC.TypeLits
37−import Network.HTTP.Client (Response, Manager)
36+import Network.HTTP.Client (Manager, Response)
38import Network.HTTP.Media
37import Network.HTTP.Media
39import qualified Network.HTTP.Types as H
38import qualified Network.HTTP.Types as H
40import qualified Network.HTTP.Types.Header as HTTP
39import qualified Network.HTTP.Types.Header as HTTP
@@ -54,19 +53,18 @@ import Servant.Common.Req
54-- > myApi :: Proxy MyApi
53-- > myApi :: Proxy MyApi
55-- > myApi = Proxy
54-- > myApi = Proxy
56-- >
55-- >
57−-- > getAllBooks :: ExceptT String IO [Book]
56+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
58−-- > postNewBook :: Book -> ExceptT String IO Book
57+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
59−-- > (getAllBooks :<|> postNewBook) = client myApi host manager
58+-- > (getAllBooks :<|> postNewBook) = client myApi
60−-- > where host = BaseUrl Http "localhost" 8080
61−client :: HasClient layout => Proxy layout -> BaseUrl -> Manager -> Client layout
59+client :: HasClient layout => Proxy layout -> Client layout
62−client p baseurl = clientWithRoute p defReq baseurl
60+client p = clientWithRoute p defReq
63
61
64-- | This class lets us define how each API combinator
62-- | This class lets us define how each API combinator
65-- influences the creation of an HTTP request. It's mostly
63-- influences the creation of an HTTP request. It's mostly
66-- an internal class, you can just use 'client'.
64-- an internal class, you can just use 'client'.
67class HasClient layout where
65class HasClient layout where
68 type Client layout :: *
66 type Client layout :: *
69− clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Manager -> Client layout
67+ clientWithRoute :: Proxy layout -> Req -> Client layout
70
68
71
69
72-- | A client querying function for @a ':<|>' b@ will actually hand you
70-- | A client querying function for @a ':<|>' b@ will actually hand you
@@ -79,15 +77,14 @@ class HasClient layout where
79-- > myApi :: Proxy MyApi
77-- > myApi :: Proxy MyApi
80-- > myApi = Proxy
78-- > myApi = Proxy
81-- >
79-- >
82−-- > getAllBooks :: ExceptT String IO [Book]
80+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
83−-- > postNewBook :: Book -> ExceptT String IO Book
81+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
84−-- > (getAllBooks :<|> postNewBook) = client myApi host manager
82+-- > (getAllBooks :<|> postNewBook) = client myApi
85−-- > where host = BaseUrl Http "localhost" 8080
86instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
83instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
87 type Client (a :<|> b) = Client a :<|> Client b
84 type Client (a :<|> b) = Client a :<|> Client b
88− clientWithRoute Proxy req baseurl manager =
85+ clientWithRoute Proxy req =
89− clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>
86+ clientWithRoute (Proxy :: Proxy a) req :<|>
90− clientWithRoute (Proxy :: Proxy b) req baseurl manager
87+ clientWithRoute (Proxy :: Proxy b) req
91
88
92-- | If you use a 'Capture' in one of your endpoints in your API,
89-- | If you use a 'Capture' in one of your endpoints in your API,
93-- the corresponding querying function will automatically take
90-- the corresponding querying function will automatically take
@@ -105,9 +102,8 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
105-- > myApi :: Proxy MyApi
102-- > myApi :: Proxy MyApi
106-- > myApi = Proxy
103-- > myApi = Proxy
107-- >
104-- >
108−-- > getBook :: Text -> ExceptT String IO Book
105+-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book
109−-- > getBook = client myApi host manager
106+-- > getBook = client myApi
110−-- > where host = BaseUrl Http "localhost" 8080
111-- > -- then you can just use "getBook" to query that endpoint
107-- > -- then you can just use "getBook" to query that endpoint
112instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
108instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
113 => HasClient (Capture capture a :> sublayout) where
109 => HasClient (Capture capture a :> sublayout) where
@@ -115,11 +111,9 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
115 type Client (Capture capture a :> sublayout) =
111 type Client (Capture capture a :> sublayout) =
116 a -> Client sublayout
112 a -> Client sublayout
117
113
118− clientWithRoute Proxy req baseurl manager val =
114+ clientWithRoute Proxy req val =
119 clientWithRoute (Proxy :: Proxy sublayout)
115 clientWithRoute (Proxy :: Proxy sublayout)
120 (appendToPath p req)
116 (appendToPath p req)
121− baseurl
122− manager
123
117
124 where p = unpack (toUrlPiece val)
118 where p = unpack (toUrlPiece val)
125
119
@@ -127,16 +121,17 @@ instance OVERLAPPABLE_
127 -- Note [Non-Empty Content Types]
121 -- Note [Non-Empty Content Types]
128 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
122 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
129 ) => HasClient (Verb method status cts' a) where
123 ) => HasClient (Verb method status cts' a) where
130− type Client (Verb method status cts' a) = ExceptT ServantError IO a
124+ type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a
131− clientWithRoute Proxy req baseurl manager =
125+ clientWithRoute Proxy req manager baseurl =
132− snd <$> performRequestCT (Proxy :: Proxy ct) method req baseurl manager
126+ snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl
133 where method = reflectMethod (Proxy :: Proxy method)
127 where method = reflectMethod (Proxy :: Proxy method)
134
128
135instance OVERLAPPING_
129instance OVERLAPPING_
136 (ReflectMethod method) => HasClient (Verb method status cts NoContent) where
130 (ReflectMethod method) => HasClient (Verb method status cts NoContent) where
137− type Client (Verb method status cts NoContent) = ExceptT ServantError IO NoContent
131+ type Client (Verb method status cts NoContent)
132+ = Manager -> BaseUrl -> ClientM NoContent
138− clientWithRoute Proxy req baseurl manager =
133+ clientWithRoute Proxy req manager baseurl =
139− performRequestNoBody method req baseurl manager >> return NoContent
134+ performRequestNoBody method req manager baseurl >> return NoContent
140 where method = reflectMethod (Proxy :: Proxy method)
135 where method = reflectMethod (Proxy :: Proxy method)
141
136
142instance OVERLAPPING_
137instance OVERLAPPING_
@@ -144,10 +139,10 @@ instance OVERLAPPING_
144 ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
139 ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
145 ) => HasClient (Verb method status cts' (Headers ls a)) where
140 ) => HasClient (Verb method status cts' (Headers ls a)) where
146 type Client (Verb method status cts' (Headers ls a))
141 type Client (Verb method status cts' (Headers ls a))
147− = ExceptT ServantError IO (Headers ls a)
142+ = Manager -> BaseUrl -> ClientM (Headers ls a)
148− clientWithRoute Proxy req baseurl manager = do
143+ clientWithRoute Proxy req manager baseurl = do
149 let method = reflectMethod (Proxy :: Proxy method)
144 let method = reflectMethod (Proxy :: Proxy method)
150− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl manager
145+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl
151 return $ Headers { getResponse = resp
146 return $ Headers { getResponse = resp
152 , getHeadersHList = buildHeadersTo hdrs
147 , getHeadersHList = buildHeadersTo hdrs
153 }
148 }
@@ -156,10 +151,10 @@ instance OVERLAPPING_
156 ( BuildHeadersTo ls, ReflectMethod method
151 ( BuildHeadersTo ls, ReflectMethod method
157 ) => HasClient (Verb method status cts (Headers ls NoContent)) where
152 ) => HasClient (Verb method status cts (Headers ls NoContent)) where
158 type Client (Verb method status cts (Headers ls NoContent))
153 type Client (Verb method status cts (Headers ls NoContent))
159− = ExceptT ServantError IO (Headers ls NoContent)
154+ = Manager -> BaseUrl -> ClientM (Headers ls NoContent)
160− clientWithRoute Proxy req baseurl manager = do
155+ clientWithRoute Proxy req manager baseurl = do
161 let method = reflectMethod (Proxy :: Proxy method)
156 let method = reflectMethod (Proxy :: Proxy method)
162− hdrs <- performRequestNoBody method req baseurl manager
157+ hdrs <- performRequestNoBody method req manager baseurl
163 return $ Headers { getResponse = NoContent
158 return $ Headers { getResponse = NoContent
164 , getHeadersHList = buildHeadersTo hdrs
159 , getHeadersHList = buildHeadersTo hdrs
165 }
160 }
@@ -186,9 +181,8 @@ instance OVERLAPPING_
186-- > myApi :: Proxy MyApi
181-- > myApi :: Proxy MyApi
187-- > myApi = Proxy
182-- > myApi = Proxy
188-- >
183-- >
189−-- > viewReferer :: Maybe Referer -> ExceptT String IO Book
184+-- > viewReferer :: Maybe Referer -> Manager -> BaseUrl -> ClientM Book
190−-- > viewReferer = client myApi host
185+-- > viewReferer = client myApi
191−-- > where host = BaseUrl Http "localhost" 8080
192-- > -- then you can just use "viewRefer" to query that endpoint
186-- > -- then you can just use "viewRefer" to query that endpoint
193-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
187-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
194instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
188instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
@@ -197,14 +191,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
197 type Client (Header sym a :> sublayout) =
191 type Client (Header sym a :> sublayout) =
198 Maybe a -> Client sublayout
192 Maybe a -> Client sublayout
199
193
200− clientWithRoute Proxy req baseurl manager mval =
194+ clientWithRoute Proxy req mval =
201 clientWithRoute (Proxy :: Proxy sublayout)
195 clientWithRoute (Proxy :: Proxy sublayout)
202 (maybe req
196 (maybe req
203 (\value -> Servant.Common.Req.addHeader hname value req)
197 (\value -> Servant.Common.Req.addHeader hname value req)
204 mval
198 mval
205 )
199 )
206− baseurl
207− manager
208
200
209 where hname = symbolVal (Proxy :: Proxy sym)
201 where hname = symbolVal (Proxy :: Proxy sym)
210
202
@@ -239,9 +231,8 @@ instance HasClient sublayout
239-- > myApi :: Proxy MyApi
231-- > myApi :: Proxy MyApi
240-- > myApi = Proxy
232-- > myApi = Proxy
241-- >
233-- >
242−-- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
234+-- > getBooksBy :: Maybe Text -> Manager -> BaseUrl -> ClientM [Book]
243−-- > getBooksBy = client myApi host
235+-- > getBooksBy = client myApi
244−-- > where host = BaseUrl Http "localhost" 8080
245-- > -- then you can just use "getBooksBy" to query that endpoint.
236-- > -- then you can just use "getBooksBy" to query that endpoint.
246-- > -- 'getBooksBy Nothing' for all books
237-- > -- 'getBooksBy Nothing' for all books
247-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
238-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
@@ -252,14 +243,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
252 Maybe a -> Client sublayout
243 Maybe a -> Client sublayout
253
244
254 -- if mparam = Nothing, we don't add it to the query string
245 -- if mparam = Nothing, we don't add it to the query string
255− clientWithRoute Proxy req baseurl manager mparam =
246+ clientWithRoute Proxy req mparam =
256 clientWithRoute (Proxy :: Proxy sublayout)
247 clientWithRoute (Proxy :: Proxy sublayout)
257 (maybe req
248 (maybe req
258 (flip (appendToQueryString pname) req . Just)
249 (flip (appendToQueryString pname) req . Just)
259 mparamText
250 mparamText
260 )
251 )
261− baseurl
262− manager
263
252
264 where pname = cs pname'
253 where pname = cs pname'
265 pname' = symbolVal (Proxy :: Proxy sym)
254 pname' = symbolVal (Proxy :: Proxy sym)
@@ -286,9 +275,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
286-- > myApi :: Proxy MyApi
275-- > myApi :: Proxy MyApi
287-- > myApi = Proxy
276-- > myApi = Proxy
288-- >
277-- >
289−-- > getBooksBy :: [Text] -> ExceptT String IO [Book]
278+-- > getBooksBy :: [Text] -> Manager -> BaseUrl -> ClientM [Book]
290−-- > getBooksBy = client myApi host
279+-- > getBooksBy = client myApi
291−-- > where host = BaseUrl Http "localhost" 8080
292-- > -- then you can just use "getBooksBy" to query that endpoint.
280-- > -- then you can just use "getBooksBy" to query that endpoint.
293-- > -- 'getBooksBy []' for all books
281-- > -- 'getBooksBy []' for all books
294-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
282-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
@@ -299,13 +287,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
299 type Client (QueryParams sym a :> sublayout) =
287 type Client (QueryParams sym a :> sublayout) =
300 [a] -> Client sublayout
288 [a] -> Client sublayout
301
289
302− clientWithRoute Proxy req baseurl manager paramlist =
290+ clientWithRoute Proxy req paramlist =
303 clientWithRoute (Proxy :: Proxy sublayout)
291 clientWithRoute (Proxy :: Proxy sublayout)
304 (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
292 (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
305 req
293 req
306 paramlist'
294 paramlist'
307 )
295 )
308− baseurl manager
309
296
310 where pname = cs pname'
297 where pname = cs pname'
311 pname' = symbolVal (Proxy :: Proxy sym)
298 pname' = symbolVal (Proxy :: Proxy sym)
@@ -327,9 +314,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
327-- > myApi :: Proxy MyApi
314-- > myApi :: Proxy MyApi
328-- > myApi = Proxy
315-- > myApi = Proxy
329-- >
316-- >
330−-- > getBooks :: Bool -> ExceptT String IO [Book]
317+-- > getBooks :: Bool -> Manager -> BaseUrl -> ClientM [Book]
331−-- > getBooks = client myApi host
318+-- > getBooks = client myApi
332−-- > where host = BaseUrl Http "localhost" 8080
333-- > -- then you can just use "getBooks" to query that endpoint.
319-- > -- then you can just use "getBooks" to query that endpoint.
334-- > -- 'getBooksBy False' for all books
320-- > -- 'getBooksBy False' for all books
335-- > -- 'getBooksBy True' to only get _already published_ books
321-- > -- 'getBooksBy True' to only get _already published_ books
@@ -339,13 +325,12 @@ instance (KnownSymbol sym, HasClient sublayout)
339 type Client (QueryFlag sym :> sublayout) =
325 type Client (QueryFlag sym :> sublayout) =
340 Bool -> Client sublayout
326 Bool -> Client sublayout
341
327
342− clientWithRoute Proxy req baseurl manager flag =
328+ clientWithRoute Proxy req flag =
343 clientWithRoute (Proxy :: Proxy sublayout)
329 clientWithRoute (Proxy :: Proxy sublayout)
344 (if flag
330 (if flag
345 then appendToQueryString paramname Nothing req
331 then appendToQueryString paramname Nothing req
346 else req
332 else req
347 )
333 )
348− baseurl manager
349
334
350 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
335 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
351
336
@@ -353,11 +338,12 @@ instance (KnownSymbol sym, HasClient sublayout)
353-- | Pick a 'Method' and specify where the server you want to query is. You get
338-- | Pick a 'Method' and specify where the server you want to query is. You get
354-- back the full `Response`.
339-- back the full `Response`.
355instance HasClient Raw where
340instance HasClient Raw where
341+ type Client Raw
356− type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
342+ = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
357
343
358− clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
344+ clientWithRoute :: Proxy Raw -> Req -> Client Raw
359− clientWithRoute Proxy req baseurl manager httpMethod = do
345+ clientWithRoute Proxy req httpMethod = do
360− performRequest httpMethod req baseurl manager
346+ performRequest httpMethod req
361
347
362-- | If you use a 'ReqBody' in one of your endpoints in your API,
348-- | If you use a 'ReqBody' in one of your endpoints in your API,
363-- the corresponding querying function will automatically take
349-- the corresponding querying function will automatically take
@@ -374,9 +360,8 @@ instance HasClient Raw where
374-- > myApi :: Proxy MyApi
360-- > myApi :: Proxy MyApi
375-- > myApi = Proxy
361-- > myApi = Proxy
376-- >
362-- >
377−-- > addBook :: Book -> ExceptT String IO Book
363+-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book
378−-- > addBook = client myApi host manager
364+-- > addBook = client myApi
379−-- > where host = BaseUrl Http "localhost" 8080
380-- > -- then you can just use "addBook" to query that endpoint
365-- > -- then you can just use "addBook" to query that endpoint
381instance (MimeRender ct a, HasClient sublayout)
366instance (MimeRender ct a, HasClient sublayout)
382 => HasClient (ReqBody (ct ': cts) a :> sublayout) where
367 => HasClient (ReqBody (ct ': cts) a :> sublayout) where
@@ -384,43 +369,41 @@ instance (MimeRender ct a, HasClient sublayout)
384 type Client (ReqBody (ct ': cts) a :> sublayout) =
369 type Client (ReqBody (ct ': cts) a :> sublayout) =
385 a -> Client sublayout
370 a -> Client sublayout
386
371
387− clientWithRoute Proxy req baseurl manager body =
372+ clientWithRoute Proxy req body =
388 clientWithRoute (Proxy :: Proxy sublayout)
373 clientWithRoute (Proxy :: Proxy sublayout)
389 (let ctProxy = Proxy :: Proxy ct
374 (let ctProxy = Proxy :: Proxy ct
390 in setRQBody (mimeRender ctProxy body)
375 in setRQBody (mimeRender ctProxy body)
391 (contentType ctProxy)
376 (contentType ctProxy)
392 req
377 req
393 )
378 )
394− baseurl manager
395
379
396-- | Make the querying function append @path@ to the request path.
380-- | Make the querying function append @path@ to the request path.
397instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
381instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
398 type Client (path :> sublayout) = Client sublayout
382 type Client (path :> sublayout) = Client sublayout
399
383
400− clientWithRoute Proxy req baseurl manager =
384+ clientWithRoute Proxy req =
401 clientWithRoute (Proxy :: Proxy sublayout)
385 clientWithRoute (Proxy :: Proxy sublayout)
402 (appendToPath p req)
386 (appendToPath p req)
403− baseurl manager
404
387
405 where p = symbolVal (Proxy :: Proxy path)
388 where p = symbolVal (Proxy :: Proxy path)
406
389
407instance HasClient api => HasClient (Vault :> api) where
390instance HasClient api => HasClient (Vault :> api) where
408 type Client (Vault :> api) = Client api
391 type Client (Vault :> api) = Client api
409
392
410− clientWithRoute Proxy req baseurl manager =
393+ clientWithRoute Proxy req =
411− clientWithRoute (Proxy :: Proxy api) req baseurl manager
394+ clientWithRoute (Proxy :: Proxy api) req
412
395
413instance HasClient api => HasClient (RemoteHost :> api) where
396instance HasClient api => HasClient (RemoteHost :> api) where
414 type Client (RemoteHost :> api) = Client api
397 type Client (RemoteHost :> api) = Client api
415
398
416− clientWithRoute Proxy req baseurl manager =
399+ clientWithRoute Proxy req =
417− clientWithRoute (Proxy :: Proxy api) req baseurl manager
400+ clientWithRoute (Proxy :: Proxy api) req
418
401
419instance HasClient api => HasClient (IsSecure :> api) where
402instance HasClient api => HasClient (IsSecure :> api) where
420 type Client (IsSecure :> api) = Client api
403 type Client (IsSecure :> api) = Client api
421
404
422− clientWithRoute Proxy req baseurl manager =
405+ clientWithRoute Proxy req =
423− clientWithRoute (Proxy :: Proxy api) req baseurl manager
406+ clientWithRoute (Proxy :: Proxy api) req
424
407
425instance HasClient subapi =>
408instance HasClient subapi =>
426 HasClient (WithNamedContext name context subapi) where
409 HasClient (WithNamedContext name context subapi) where
@@ -433,16 +416,16 @@ instance ( HasClient api
433 type Client (AuthProtect tag :> api)
416 type Client (AuthProtect tag :> api)
434 = AuthenticateReq (AuthProtect tag) -> Client api
417 = AuthenticateReq (AuthProtect tag) -> Client api
435
418
436− clientWithRoute Proxy req baseurl manager (AuthenticateReq (val,func)) =
419+ clientWithRoute Proxy req (AuthenticateReq (val,func)) =
437− clientWithRoute (Proxy :: Proxy api) (func val req) baseurl manager
420+ clientWithRoute (Proxy :: Proxy api) (func val req)
438
421
439-- * Basic Authentication
422-- * Basic Authentication
440
423
441instance HasClient api => HasClient (BasicAuth realm usr :> api) where
424instance HasClient api => HasClient (BasicAuth realm usr :> api) where
442 type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api
425 type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api
443
426
444− clientWithRoute Proxy req baseurl manager val =
427+ clientWithRoute Proxy req val =
445− clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) baseurl manager
428+ clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req)
446
429
447
430
448{- Note [Non-Empty Content Types]
431{- Note [Non-Empty Content Types]
servant-client/src/Servant/Common/Req.hs+13−12
@@ -123,11 +123,12 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
123displayHttpRequest :: Method -> String
123displayHttpRequest :: Method -> String
124displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
124displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
125
125
126+type ClientM = ExceptT ServantError IO
126
127
127−performRequest :: Method -> Req -> BaseUrl -> Manager
128+performRequest :: Method -> Req -> Manager -> BaseUrl
128− -> ExceptT ServantError IO ( Int, ByteString, MediaType
129+ -> ClientM ( Int, ByteString, MediaType
129− , [HTTP.Header], Response ByteString)
130+ , [HTTP.Header], Response ByteString)
130−performRequest reqMethod req reqHost manager = do
131+performRequest reqMethod req manager reqHost = do
131 partialRequest <- liftIO $ reqToRequest req reqHost
132 partialRequest <- liftIO $ reqToRequest req reqHost
132
133
133 let request = partialRequest { Client.method = reqMethod
134 let request = partialRequest { Client.method = reqMethod
@@ -155,21 +156,21 @@ performRequest reqMethod req reqHost manager = do
155
156
156
157
157performRequestCT :: MimeUnrender ct result =>
158performRequestCT :: MimeUnrender ct result =>
158− Proxy ct -> Method -> Req -> BaseUrl -> Manager
159+ Proxy ct -> Method -> Req -> Manager -> BaseUrl
159− -> ExceptT ServantError IO ([HTTP.Header], result)
160+ -> ClientM ([HTTP.Header], result)
160−performRequestCT ct reqMethod req reqHost manager = do
161+performRequestCT ct reqMethod req manager reqHost = do
161 let acceptCT = contentType ct
162 let acceptCT = contentType ct
162 (_status, respBody, respCT, hdrs, _response) <-
163 (_status, respBody, respCT, hdrs, _response) <-
163− performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager
164+ performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost
164 unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
165 unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
165 case mimeUnrender ct respBody of
166 case mimeUnrender ct respBody of
166 Left err -> throwE $ DecodeFailure err respCT respBody
167 Left err -> throwE $ DecodeFailure err respCT respBody
167 Right val -> return (hdrs, val)
168 Right val -> return (hdrs, val)
168
169
169−performRequestNoBody :: Method -> Req -> BaseUrl -> Manager
170+performRequestNoBody :: Method -> Req -> Manager -> BaseUrl
170− -> ExceptT ServantError IO [HTTP.Header]
171+ -> ClientM [HTTP.Header]
171−performRequestNoBody reqMethod req reqHost manager = do
172+performRequestNoBody reqMethod req manager reqHost = do
172− (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req reqHost manager
173+ (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost
173 return hdrs
174 return hdrs
174
175
175catchConnectionError :: IO a -> IO (Either ServantError a)
176catchConnectionError :: IO a -> IO (Either ServantError a)
servant-client/test/Servant/ClientSpec.hs+80−87
@@ -28,19 +28,18 @@ import Control.Applicative ((<$>))
28import Control.Arrow (left)
28import Control.Arrow (left)
29import Control.Concurrent (forkIO, killThread, ThreadId)
29import Control.Concurrent (forkIO, killThread, ThreadId)
30import Control.Exception (bracket)
30import Control.Exception (bracket)
31−import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
31+import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
32import Data.Aeson
32import Data.Aeson
33+import qualified Data.ByteString.Lazy as BS
33import Data.Char (chr, isPrint)
34import Data.Char (chr, isPrint)
34import Data.Foldable (forM_)
35import Data.Foldable (forM_)
35import Data.Monoid hiding (getLast)
36import Data.Monoid hiding (getLast)
36import Data.Proxy
37import Data.Proxy
37import qualified Data.Text as T
38import qualified Data.Text as T
38import GHC.Generics (Generic)
39import GHC.Generics (Generic)
39−import GHC.TypeLits
40import qualified Network.HTTP.Client as C
40import qualified Network.HTTP.Client as C
41import Network.HTTP.Media
41import Network.HTTP.Media
42−import Network.HTTP.Types (Status (..), badRequest400,
42+import qualified Network.HTTP.Types as HTTP
43− methodGet, ok200, status400)
44import Network.Socket
43import Network.Socket
45import Network.Wai (Application, Request,
44import Network.Wai (Application, Request,
46 requestHeaders, responseLBS)
45 requestHeaders, responseLBS)
@@ -120,6 +119,34 @@ type Api =
120api :: Proxy Api
119api :: Proxy Api
121api = Proxy
120api = Proxy
122
121
122+getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person
123+getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
124+getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person
125+getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person
126+getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person
127+getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]
128+getQueryFlag :: Bool -> C.Manager -> BaseUrl -> SCR.ClientM Bool
129+getRawSuccess :: HTTP.Method -> C.Manager -> BaseUrl
130+ -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
131+getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl
132+ -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
133+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl
134+ -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
135+getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool)
136+getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
137+getGet
138+ :<|> getDeleteEmpty
139+ :<|> getCapture
140+ :<|> getBody
141+ :<|> getQueryParam
142+ :<|> getQueryParams
143+ :<|> getQueryFlag
144+ :<|> getRawSuccess
145+ :<|> getRawFailure
146+ :<|> getMultiple
147+ :<|> getRespHeaders
148+ :<|> getDeleteContentType = client api
149+
123server :: Application
150server :: Application
124server = serve api (
151server = serve api (
125 return alice
152 return alice
@@ -132,8 +159,8 @@ server = serve api (
132 Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
159 Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
133 :<|> (\ names -> return (zipWith Person names [0..]))
160 :<|> (\ names -> return (zipWith Person names [0..]))
134 :<|> return
161 :<|> return
135− :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
162+ :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")
136− :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
163+ :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure")
137 :<|> (\ a b c d -> return (a, b, c, d))
164 :<|> (\ a b c d -> return (a, b, c, d))
138 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
165 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
139 :<|> return NoContent
166 :<|> return NoContent
@@ -149,9 +176,9 @@ failApi = Proxy
149
176
150failServer :: Application
177failServer :: Application
151failServer = serve failApi (
178failServer = serve failApi (
152− (\ _request respond -> respond $ responseLBS ok200 [] "")
179+ (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
153− :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
180+ :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")
154− :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
181+ :<|> (\_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
155 )
182 )
156
183
157-- * basic auth stuff
184-- * basic auth stuff
@@ -208,76 +235,64 @@ sucessSpec :: Spec
208sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
235sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
209
236
210 it "Servant.API.Get" $ \(_, baseUrl) -> do
237 it "Servant.API.Get" $ \(_, baseUrl) -> do
211− let getGet = getNth (Proxy :: Proxy 0) $ client api baseUrl manager
212− (left show <$> runExceptT getGet) `shouldReturn` Right alice
238+ (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice
213
239
214 describe "Servant.API.Delete" $ do
240 describe "Servant.API.Delete" $ do
215 it "allows empty content type" $ \(_, baseUrl) -> do
241 it "allows empty content type" $ \(_, baseUrl) -> do
216− let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api baseUrl manager
217− (left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right NoContent
242+ (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent
218
243
219 it "allows content type" $ \(_, baseUrl) -> do
244 it "allows content type" $ \(_, baseUrl) -> do
220− let getDeleteContentType = getLast $ client api baseUrl manager
221− (left show <$> runExceptT getDeleteContentType) `shouldReturn` Right NoContent
245+ (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent
222
246
223 it "Servant.API.Capture" $ \(_, baseUrl) -> do
247 it "Servant.API.Capture" $ \(_, baseUrl) -> do
224− let getCapture = getNth (Proxy :: Proxy 2) $ client api baseUrl manager
225− (left show <$> runExceptT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
248+ (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
226
249
227 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
250 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
228 let p = Person "Clara" 42
251 let p = Person "Clara" 42
229− getBody = getNth (Proxy :: Proxy 3) $ client api baseUrl manager
230− (left show <$> runExceptT (getBody p)) `shouldReturn` Right p
252+ (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p
231
253
232 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
254 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
233− let getQueryParam = getNth (Proxy :: Proxy 4) $ client api baseUrl manager
234− left show <$> runExceptT (getQueryParam (Just "alice")) `shouldReturn` Right alice
255+ left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice
235− Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob"))
256+ Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)
236− responseStatus `shouldBe` Status 400 "bob not found"
257+ responseStatus `shouldBe` HTTP.Status 400 "bob not found"
237
258
238 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
259 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
239− let getQueryParams = getNth (Proxy :: Proxy 5) $ client api baseUrl manager
240− (left show <$> runExceptT (getQueryParams [])) `shouldReturn` Right []
260+ (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []
241− (left show <$> runExceptT (getQueryParams ["alice", "bob"]))
261+ (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl))
242 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
262 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
243
263
244 context "Servant.API.QueryParam.QueryFlag" $
264 context "Servant.API.QueryParam.QueryFlag" $
245 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
265 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
246− let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api baseUrl manager
247− (left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag
266+ (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag
248
267
249 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
268 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
250− let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api baseUrl manager
251− res <- runExceptT (getRawSuccess methodGet)
269+ res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl)
252 case res of
270 case res of
253 Left e -> assertFailure $ show e
271 Left e -> assertFailure $ show e
254 Right (code, body, ct, _, response) -> do
272 Right (code, body, ct, _, response) -> do
255 (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
273 (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
256 C.responseBody response `shouldBe` body
274 C.responseBody response `shouldBe` body
257− C.responseStatus response `shouldBe` ok200
275+ C.responseStatus response `shouldBe` HTTP.ok200
258
276
259 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
277 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
260− let getRawFailure = getNth (Proxy :: Proxy 8) $ client api baseUrl manager
261− res <- runExceptT (getRawFailure methodGet)
278+ res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl)
262 case res of
279 case res of
263 Right _ -> assertFailure "expected Left, but got Right"
280 Right _ -> assertFailure "expected Left, but got Right"
264 Left e -> do
281 Left e -> do
265− Servant.Client.responseStatus e `shouldBe` status400
282+ Servant.Client.responseStatus e `shouldBe` HTTP.status400
266 Servant.Client.responseBody e `shouldBe` "rawFailure"
283 Servant.Client.responseBody e `shouldBe` "rawFailure"
267
284
268 it "Returns headers appropriately" $ \(_, baseUrl) -> do
285 it "Returns headers appropriately" $ \(_, baseUrl) -> do
269− let getRespHeaders = getNth (Proxy :: Proxy 10) $ client api baseUrl manager
270− res <- runExceptT getRespHeaders
286+ res <- runExceptT (getRespHeaders manager baseUrl)
271 case res of
287 case res of
272 Left e -> assertFailure $ show e
288 Left e -> assertFailure $ show e
273 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
289 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
274
290
275 modifyMaxSuccess (const 20) $ do
291 modifyMaxSuccess (const 20) $ do
276 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
292 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
277− let getMultiple = getNth (Proxy :: Proxy 9) $ client api baseUrl manager
278− in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
293+ property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
279 ioProperty $ do
294 ioProperty $ do
280− result <- left show <$> runExceptT (getMultiple cap num flag body)
295+ result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl)
281 return $
296 return $
282 result === Right (cap, num, flag, body)
297 result === Right (cap, num, flag, body)
283
298
@@ -289,10 +304,10 @@ wrappedApiSpec = describe "error status codes" $ do
289 let test :: (WrappedApi, String) -> Spec
304 let test :: (WrappedApi, String) -> Spec
290 test (WrappedApi api, desc) =
305 test (WrappedApi api, desc) =
291 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
306 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
292− let getResponse :: ExceptT ServantError IO ()
307+ let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM ()
293− getResponse = client api baseUrl manager
308+ getResponse = client api
294− Left FailureResponse{..} <- runExceptT getResponse
309+ Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl)
295− responseStatus `shouldBe` (Status 500 "error message")
310+ responseStatus `shouldBe` (HTTP.Status 500 "error message")
296 in mapM_ test $
311 in mapM_ test $
297 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
312 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
298 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
313 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
@@ -305,43 +320,43 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
305
320
306 context "client returns errors appropriately" $ do
321 context "client returns errors appropriately" $ do
307 it "reports FailureResponse" $ \(_, baseUrl) -> do
322 it "reports FailureResponse" $ \(_, baseUrl) -> do
308− let (_ :<|> getDeleteEmpty :<|> _) = client api baseUrl manager
323+ let (_ :<|> getDeleteEmpty :<|> _) = client api
309− Left res <- runExceptT getDeleteEmpty
324+ Left res <- runExceptT (getDeleteEmpty manager baseUrl)
310 case res of
325 case res of
311− FailureResponse (Status 404 "Not Found") _ _ -> return ()
326+ FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
312 _ -> fail $ "expected 404 response, but got " <> show res
327 _ -> fail $ "expected 404 response, but got " <> show res
313
328
314 it "reports DecodeFailure" $ \(_, baseUrl) -> do
329 it "reports DecodeFailure" $ \(_, baseUrl) -> do
315− let (_ :<|> _ :<|> getCapture :<|> _) = client api baseUrl manager
330+ let (_ :<|> _ :<|> getCapture :<|> _) = client api
316− Left res <- runExceptT (getCapture "foo")
331+ Left res <- runExceptT (getCapture "foo" manager baseUrl)
317 case res of
332 case res of
318 DecodeFailure _ ("application/json") _ -> return ()
333 DecodeFailure _ ("application/json") _ -> return ()
319 _ -> fail $ "expected DecodeFailure, but got " <> show res
334 _ -> fail $ "expected DecodeFailure, but got " <> show res
320
335
321 it "reports ConnectionError" $ \_ -> do
336 it "reports ConnectionError" $ \_ -> do
322− let (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager
337+ let (getGetWrongHost :<|> _) = client api
323− Left res <- runExceptT getGetWrongHost
338+ Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 ""))
324 case res of
339 case res of
325 ConnectionError _ -> return ()
340 ConnectionError _ -> return ()
326 _ -> fail $ "expected ConnectionError, but got " <> show res
341 _ -> fail $ "expected ConnectionError, but got " <> show res
327
342
328 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
343 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
329− let (getGet :<|> _ ) = client api baseUrl manager
344+ let (getGet :<|> _ ) = client api
330− Left res <- runExceptT getGet
345+ Left res <- runExceptT (getGet manager baseUrl)
331 case res of
346 case res of
332 UnsupportedContentType ("application/octet-stream") _ -> return ()
347 UnsupportedContentType ("application/octet-stream") _ -> return ()
333 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
348 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
334
349
335 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
350 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
336− let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api baseUrl manager
351+ let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
337− Left res <- runExceptT (getBody alice)
352+ Left res <- runExceptT (getBody alice manager baseUrl)
338 case res of
353 case res of
339 InvalidContentTypeHeader "fooooo" _ -> return ()
354 InvalidContentTypeHeader "fooooo" _ -> return ()
340 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
355 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
341
356
342data WrappedApi where
357data WrappedApi where
343 WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
358 WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
344− HasClient api, Client api ~ ExceptT ServantError IO ()) =>
359+ HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) =>
345 Proxy api -> WrappedApi
360 Proxy api -> WrappedApi
346
361
347basicAuthSpec :: Spec
362basicAuthSpec :: Spec
@@ -349,34 +364,34 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
349 context "Authentication works when requests are properly authenticated" $ do
364 context "Authentication works when requests are properly authenticated" $ do
350
365
351 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
366 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
352− let getBasic = client basicAuthAPI baseUrl manager
367+ let getBasic = client basicAuthAPI
353 let basicAuthData = BasicAuthData "servant" "server"
368 let basicAuthData = BasicAuthData "servant" "server"
354− (left show <$> runExceptT (getBasic basicAuthData)) `shouldReturn` Right alice
369+ (left show <$> runExceptT (getBasic basicAuthData manager baseUrl)) `shouldReturn` Right alice
355
370
356 context "Authentication is rejected when requests are not authenticated properly" $ do
371 context "Authentication is rejected when requests are not authenticated properly" $ do
357
372
358 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
373 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
359− let getBasic = client basicAuthAPI baseUrl manager
374+ let getBasic = client basicAuthAPI
360 let basicAuthData = BasicAuthData "not" "password"
375 let basicAuthData = BasicAuthData "not" "password"
361− Left FailureResponse{..} <- runExceptT (getBasic basicAuthData)
376+ Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)
362− responseStatus `shouldBe` Status 403 "Forbidden"
377+ responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
363
378
364genAuthSpec :: Spec
379genAuthSpec :: Spec
365genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
380genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
366 context "Authentication works when requests are properly authenticated" $ do
381 context "Authentication works when requests are properly authenticated" $ do
367
382
368 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
383 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
369− let getProtected = client genAuthAPI baseUrl manager
384+ let getProtected = client genAuthAPI
370 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
385 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
371− (left show <$> runExceptT (getProtected authRequest)) `shouldReturn` Right alice
386+ (left show <$> runExceptT (getProtected authRequest manager baseUrl)) `shouldReturn` Right alice
372
387
373 context "Authentication is rejected when requests are not authenticated properly" $ do
388 context "Authentication is rejected when requests are not authenticated properly" $ do
374
389
375 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
390 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
376− let getProtected = client genAuthAPI baseUrl manager
391+ let getProtected = client genAuthAPI
377 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
392 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
378− Left FailureResponse{..} <- runExceptT (getProtected authRequest)
393+ Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)
379− responseStatus `shouldBe` (Status 401 "Unauthorized")
394+ responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
380
395
381-- * utils
396-- * utils
382
397
@@ -407,25 +422,3 @@ pathGen = fmap NonEmpty path
407 filter (not . (`elem` ("?%[]/#;" :: String))) $
422 filter (not . (`elem` ("?%[]/#;" :: String))) $
408 filter isPrint $
423 filter isPrint $
409 map chr [0..127]
424 map chr [0..127]
410−
411−class GetNth (n :: Nat) a b | n a -> b where
412− getNth :: Proxy n -> a -> b
413−
414−instance OVERLAPPING_
415− GetNth 0 (x :<|> y) x where
416− getNth _ (x :<|> _) = x
417−
418−instance OVERLAPPING_
419− (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where
420− getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x
421−
422−class GetLast a b | a -> b where
423− getLast :: a -> b
424−
425−instance OVERLAPPING_
426− (GetLast b c) => GetLast (a :<|> b) c where
427− getLast (_ :<|> b) = getLast b
428−
429−instance OVERLAPPING_
430− GetLast a a where
431− getLast a = a