git.iko.soy/typeable/servant
on master help sign in
Merge branch 'pr'
commit2fb981f02ab9b628be7055c084801d9aa83d9750 authorSönke Hahn <soenkehahn@gmail.com> dateFri 1 Apr 2016, 18:46 (11 years ago) parent19206946fd1e21
5 files changed+172−198
compare with master
unifiedsplit
doc/tutorial/Client.lhs+16−22 servant-client/CHANGELOG.md+3 servant-client/src/Servant/Client.hs+60−77 servant-client/src/Servant/Common/Req.hs+13−12 servant-client/test/Servant/ClientSpec.hs+80−87
doc/tutorial/Client.lhs+16−22
@@ -15,14 +15,13 @@ need to have some language extensions and imports:
1515
1616module Client where
1717
18−import Control.Monad.Trans.Except
18+import Control.Monad.Trans.Except (ExceptT, runExceptT)
1919import Data.Aeson
2020import Data.Proxy
2121import GHC.Generics
2222import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
2323import Servant.API
2424import Servant.Client
25−import System.IO.Unsafe
2625```
2726
2827Also, 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
7271``` haskell
7372position :: Int -- ^ value for "x"
7473 -> Int -- ^ value for "y"
74+ -> Manager -- ^ the HTTP client to use
75+ -> BaseUrl -- ^ the URL at which the API can be found
7576 -> ExceptT ServantError IO Position
7677
7778hello :: 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
7881 -> ExceptT ServantError IO HelloMessage
7982
8083marketing :: ClientInfo -- ^ value for the request body
84+ -> Manager -- ^ the HTTP client to use
85+ -> BaseUrl -- ^ the URL at which the API can be found
8186 -> ExceptT ServantError IO Email
8287```
8388
8489Each function makes available as an argument any value that the response may
8590depend 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:
8792
8893- 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.
9394
9495``` haskell
9596api :: Proxy API
9697api = Proxy
9798
98−{-# NOINLINE __manager #-}
99−__manager :: Manager
100−__manager = unsafePerformIO $ newManager defaultManagerSettings
101−
102−position :<|> hello :<|> marketing =
103− client api (BaseUrl Http "localhost" 8081 "") __manager
99+position :<|> hello :<|> marketing = client api
104100```
105101
106−(Yes, the usage of `unsafePerformIO` is very ugly, we know. Hopefully soon it'll
107−be possible to do without.)
108−
109102As 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:
110103
111104``` haskell ignore
@@ -127,16 +120,17 @@ data BaseUrl = BaseUrl
127120That's it. Let's now write some code that uses our client functions.
128121
129122``` haskell
130−queries :: ExceptT ServantError IO (Position, HelloMessage, Email)
131−queries = do
132− pos <- position 10 10
133− message <- hello (Just "servant")
134− em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])
123+queries :: Manager -> BaseUrl -> ExceptT ServantError IO (Position, HelloMessage, Email)
124+queries manager baseurl = do
125+ pos <- position 10 10 manager baseurl
126+ message <- hello (Just "servant") manager baseurl
127+ em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) manager baseurl
135128 return (pos, message, em)
136129
137130run :: IO ()
138131run = do
139− res <- runExceptT queries
132+ manager <- newManager defaultManagerSettings
133+ res <- runExceptT (queries manager (BaseUrl Http "localhost" 8081 ""))
140134 case res of
141135 Left err -> putStrLn $ "Error: " ++ show err
142136 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+
140.5
25----
36
servant-client/src/Servant/Client.hs+60−77
@@ -27,14 +27,13 @@ module Servant.Client
2727#if !MIN_VERSION_base(4,8,0)
2828import Control.Applicative ((<$>))
2929#endif
30−import Control.Monad.Trans.Except
3130import Data.ByteString.Lazy (ByteString)
3231import Data.List
3332import Data.Proxy
3433import Data.String.Conversions
3534import Data.Text (unpack)
3635import GHC.TypeLits
37−import Network.HTTP.Client (Response, Manager)
36+import Network.HTTP.Client (Manager, Response)
3837import Network.HTTP.Media
3938import qualified Network.HTTP.Types as H
4039import qualified Network.HTTP.Types.Header as HTTP
@@ -54,19 +53,18 @@ import Servant.Common.Req
5453-- > myApi :: Proxy MyApi
5554-- > myApi = Proxy
5655-- >
57−-- > getAllBooks :: ExceptT String IO [Book]
58−-- > postNewBook :: Book -> ExceptT String IO Book
59−-- > (getAllBooks :<|> postNewBook) = client myApi host manager
60−-- > where host = BaseUrl Http "localhost" 8080
61−client :: HasClient layout => Proxy layout -> BaseUrl -> Manager -> Client layout
62−client p baseurl = clientWithRoute p defReq baseurl
56+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
57+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
58+-- > (getAllBooks :<|> postNewBook) = client myApi
59+client :: HasClient layout => Proxy layout -> Client layout
60+client p = clientWithRoute p defReq
6361
6462-- | This class lets us define how each API combinator
6563-- influences the creation of an HTTP request. It's mostly
6664-- an internal class, you can just use 'client'.
6765class HasClient layout where
6866 type Client layout :: *
69− clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Manager -> Client layout
67+ clientWithRoute :: Proxy layout -> Req -> Client layout
7068
7169
7270-- | A client querying function for @a ':<|>' b@ will actually hand you
@@ -79,15 +77,14 @@ class HasClient layout where
7977-- > myApi :: Proxy MyApi
8078-- > myApi = Proxy
8179-- >
82−-- > getAllBooks :: ExceptT String IO [Book]
83−-- > postNewBook :: Book -> ExceptT String IO Book
84−-- > (getAllBooks :<|> postNewBook) = client myApi host manager
85−-- > where host = BaseUrl Http "localhost" 8080
80+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
81+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
82+-- > (getAllBooks :<|> postNewBook) = client myApi
8683instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
8784 type Client (a :<|> b) = Client a :<|> Client b
88− clientWithRoute Proxy req baseurl manager =
89− clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>
90− clientWithRoute (Proxy :: Proxy b) req baseurl manager
85+ clientWithRoute Proxy req =
86+ clientWithRoute (Proxy :: Proxy a) req :<|>
87+ clientWithRoute (Proxy :: Proxy b) req
9188
9289-- | If you use a 'Capture' in one of your endpoints in your API,
9390-- the corresponding querying function will automatically take
@@ -105,9 +102,8 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
105102-- > myApi :: Proxy MyApi
106103-- > myApi = Proxy
107104-- >
108−-- > getBook :: Text -> ExceptT String IO Book
109−-- > getBook = client myApi host manager
110−-- > where host = BaseUrl Http "localhost" 8080
105+-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book
106+-- > getBook = client myApi
111107-- > -- then you can just use "getBook" to query that endpoint
112108instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
113109 => HasClient (Capture capture a :> sublayout) where
@@ -115,11 +111,9 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
115111 type Client (Capture capture a :> sublayout) =
116112 a -> Client sublayout
117113
118− clientWithRoute Proxy req baseurl manager val =
114+ clientWithRoute Proxy req val =
119115 clientWithRoute (Proxy :: Proxy sublayout)
120116 (appendToPath p req)
121− baseurl
122− manager
123117
124118 where p = unpack (toUrlPiece val)
125119
@@ -127,16 +121,17 @@ instance OVERLAPPABLE_
127121 -- Note [Non-Empty Content Types]
128122 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
129123 ) => HasClient (Verb method status cts' a) where
130− type Client (Verb method status cts' a) = ExceptT ServantError IO a
131− clientWithRoute Proxy req baseurl manager =
132− snd <$> performRequestCT (Proxy :: Proxy ct) method req baseurl manager
124+ type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a
125+ clientWithRoute Proxy req manager baseurl =
126+ snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl
133127 where method = reflectMethod (Proxy :: Proxy method)
134128
135129instance OVERLAPPING_
136130 (ReflectMethod method) => HasClient (Verb method status cts NoContent) where
137− type Client (Verb method status cts NoContent) = ExceptT ServantError IO NoContent
138− clientWithRoute Proxy req baseurl manager =
139− performRequestNoBody method req baseurl manager >> return NoContent
131+ type Client (Verb method status cts NoContent)
132+ = Manager -> BaseUrl -> ClientM NoContent
133+ clientWithRoute Proxy req manager baseurl =
134+ performRequestNoBody method req manager baseurl >> return NoContent
140135 where method = reflectMethod (Proxy :: Proxy method)
141136
142137instance OVERLAPPING_
@@ -144,10 +139,10 @@ instance OVERLAPPING_
144139 ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
145140 ) => HasClient (Verb method status cts' (Headers ls a)) where
146141 type Client (Verb method status cts' (Headers ls a))
147− = ExceptT ServantError IO (Headers ls a)
148− clientWithRoute Proxy req baseurl manager = do
142+ = Manager -> BaseUrl -> ClientM (Headers ls a)
143+ clientWithRoute Proxy req manager baseurl = do
149144 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
151146 return $ Headers { getResponse = resp
152147 , getHeadersHList = buildHeadersTo hdrs
153148 }
@@ -156,10 +151,10 @@ instance OVERLAPPING_
156151 ( BuildHeadersTo ls, ReflectMethod method
157152 ) => HasClient (Verb method status cts (Headers ls NoContent)) where
158153 type Client (Verb method status cts (Headers ls NoContent))
159− = ExceptT ServantError IO (Headers ls NoContent)
160− clientWithRoute Proxy req baseurl manager = do
154+ = Manager -> BaseUrl -> ClientM (Headers ls NoContent)
155+ clientWithRoute Proxy req manager baseurl = do
161156 let method = reflectMethod (Proxy :: Proxy method)
162− hdrs <- performRequestNoBody method req baseurl manager
157+ hdrs <- performRequestNoBody method req manager baseurl
163158 return $ Headers { getResponse = NoContent
164159 , getHeadersHList = buildHeadersTo hdrs
165160 }
@@ -186,9 +181,8 @@ instance OVERLAPPING_
186181-- > myApi :: Proxy MyApi
187182-- > myApi = Proxy
188183-- >
189−-- > viewReferer :: Maybe Referer -> ExceptT String IO Book
190−-- > viewReferer = client myApi host
191−-- > where host = BaseUrl Http "localhost" 8080
184+-- > viewReferer :: Maybe Referer -> Manager -> BaseUrl -> ClientM Book
185+-- > viewReferer = client myApi
192186-- > -- then you can just use "viewRefer" to query that endpoint
193187-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
194188instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
@@ -197,14 +191,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
197191 type Client (Header sym a :> sublayout) =
198192 Maybe a -> Client sublayout
199193
200− clientWithRoute Proxy req baseurl manager mval =
194+ clientWithRoute Proxy req mval =
201195 clientWithRoute (Proxy :: Proxy sublayout)
202196 (maybe req
203197 (\value -> Servant.Common.Req.addHeader hname value req)
204198 mval
205199 )
206− baseurl
207− manager
208200
209201 where hname = symbolVal (Proxy :: Proxy sym)
210202
@@ -239,9 +231,8 @@ instance HasClient sublayout
239231-- > myApi :: Proxy MyApi
240232-- > myApi = Proxy
241233-- >
242−-- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
243−-- > getBooksBy = client myApi host
244−-- > where host = BaseUrl Http "localhost" 8080
234+-- > getBooksBy :: Maybe Text -> Manager -> BaseUrl -> ClientM [Book]
235+-- > getBooksBy = client myApi
245236-- > -- then you can just use "getBooksBy" to query that endpoint.
246237-- > -- 'getBooksBy Nothing' for all books
247238-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
@@ -252,14 +243,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
252243 Maybe a -> Client sublayout
253244
254245 -- if mparam = Nothing, we don't add it to the query string
255− clientWithRoute Proxy req baseurl manager mparam =
246+ clientWithRoute Proxy req mparam =
256247 clientWithRoute (Proxy :: Proxy sublayout)
257248 (maybe req
258249 (flip (appendToQueryString pname) req . Just)
259250 mparamText
260251 )
261− baseurl
262− manager
263252
264253 where pname = cs pname'
265254 pname' = symbolVal (Proxy :: Proxy sym)
@@ -286,9 +275,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
286275-- > myApi :: Proxy MyApi
287276-- > myApi = Proxy
288277-- >
289−-- > getBooksBy :: [Text] -> ExceptT String IO [Book]
290−-- > getBooksBy = client myApi host
291−-- > where host = BaseUrl Http "localhost" 8080
278+-- > getBooksBy :: [Text] -> Manager -> BaseUrl -> ClientM [Book]
279+-- > getBooksBy = client myApi
292280-- > -- then you can just use "getBooksBy" to query that endpoint.
293281-- > -- 'getBooksBy []' for all books
294282-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
@@ -299,13 +287,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
299287 type Client (QueryParams sym a :> sublayout) =
300288 [a] -> Client sublayout
301289
302− clientWithRoute Proxy req baseurl manager paramlist =
290+ clientWithRoute Proxy req paramlist =
303291 clientWithRoute (Proxy :: Proxy sublayout)
304292 (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
305293 req
306294 paramlist'
307295 )
308− baseurl manager
309296
310297 where pname = cs pname'
311298 pname' = symbolVal (Proxy :: Proxy sym)
@@ -327,9 +314,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
327314-- > myApi :: Proxy MyApi
328315-- > myApi = Proxy
329316-- >
330−-- > getBooks :: Bool -> ExceptT String IO [Book]
331−-- > getBooks = client myApi host
332−-- > where host = BaseUrl Http "localhost" 8080
317+-- > getBooks :: Bool -> Manager -> BaseUrl -> ClientM [Book]
318+-- > getBooks = client myApi
333319-- > -- then you can just use "getBooks" to query that endpoint.
334320-- > -- 'getBooksBy False' for all books
335321-- > -- 'getBooksBy True' to only get _already published_ books
@@ -339,13 +325,12 @@ instance (KnownSymbol sym, HasClient sublayout)
339325 type Client (QueryFlag sym :> sublayout) =
340326 Bool -> Client sublayout
341327
342− clientWithRoute Proxy req baseurl manager flag =
328+ clientWithRoute Proxy req flag =
343329 clientWithRoute (Proxy :: Proxy sublayout)
344330 (if flag
345331 then appendToQueryString paramname Nothing req
346332 else req
347333 )
348− baseurl manager
349334
350335 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
351336
@@ -353,11 +338,12 @@ instance (KnownSymbol sym, HasClient sublayout)
353338-- | Pick a 'Method' and specify where the server you want to query is. You get
354339-- back the full `Response`.
355340instance HasClient Raw where
356− type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
341+ type Client Raw
342+ = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
357343
358− clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
359− clientWithRoute Proxy req baseurl manager httpMethod = do
360− performRequest httpMethod req baseurl manager
344+ clientWithRoute :: Proxy Raw -> Req -> Client Raw
345+ clientWithRoute Proxy req httpMethod = do
346+ performRequest httpMethod req
361347
362348-- | If you use a 'ReqBody' in one of your endpoints in your API,
363349-- the corresponding querying function will automatically take
@@ -374,9 +360,8 @@ instance HasClient Raw where
374360-- > myApi :: Proxy MyApi
375361-- > myApi = Proxy
376362-- >
377−-- > addBook :: Book -> ExceptT String IO Book
378−-- > addBook = client myApi host manager
379−-- > where host = BaseUrl Http "localhost" 8080
363+-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book
364+-- > addBook = client myApi
380365-- > -- then you can just use "addBook" to query that endpoint
381366instance (MimeRender ct a, HasClient sublayout)
382367 => HasClient (ReqBody (ct ': cts) a :> sublayout) where
@@ -384,43 +369,41 @@ instance (MimeRender ct a, HasClient sublayout)
384369 type Client (ReqBody (ct ': cts) a :> sublayout) =
385370 a -> Client sublayout
386371
387− clientWithRoute Proxy req baseurl manager body =
372+ clientWithRoute Proxy req body =
388373 clientWithRoute (Proxy :: Proxy sublayout)
389374 (let ctProxy = Proxy :: Proxy ct
390375 in setRQBody (mimeRender ctProxy body)
391376 (contentType ctProxy)
392377 req
393378 )
394− baseurl manager
395379
396380-- | Make the querying function append @path@ to the request path.
397381instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
398382 type Client (path :> sublayout) = Client sublayout
399383
400− clientWithRoute Proxy req baseurl manager =
384+ clientWithRoute Proxy req =
401385 clientWithRoute (Proxy :: Proxy sublayout)
402386 (appendToPath p req)
403− baseurl manager
404387
405388 where p = symbolVal (Proxy :: Proxy path)
406389
407390instance HasClient api => HasClient (Vault :> api) where
408391 type Client (Vault :> api) = Client api
409392
410− clientWithRoute Proxy req baseurl manager =
411− clientWithRoute (Proxy :: Proxy api) req baseurl manager
393+ clientWithRoute Proxy req =
394+ clientWithRoute (Proxy :: Proxy api) req
412395
413396instance HasClient api => HasClient (RemoteHost :> api) where
414397 type Client (RemoteHost :> api) = Client api
415398
416− clientWithRoute Proxy req baseurl manager =
417− clientWithRoute (Proxy :: Proxy api) req baseurl manager
399+ clientWithRoute Proxy req =
400+ clientWithRoute (Proxy :: Proxy api) req
418401
419402instance HasClient api => HasClient (IsSecure :> api) where
420403 type Client (IsSecure :> api) = Client api
421404
422− clientWithRoute Proxy req baseurl manager =
423− clientWithRoute (Proxy :: Proxy api) req baseurl manager
405+ clientWithRoute Proxy req =
406+ clientWithRoute (Proxy :: Proxy api) req
424407
425408instance HasClient subapi =>
426409 HasClient (WithNamedContext name context subapi) where
@@ -433,16 +416,16 @@ instance ( HasClient api
433416 type Client (AuthProtect tag :> api)
434417 = AuthenticateReq (AuthProtect tag) -> Client api
435418
436− clientWithRoute Proxy req baseurl manager (AuthenticateReq (val,func)) =
437− clientWithRoute (Proxy :: Proxy api) (func val req) baseurl manager
419+ clientWithRoute Proxy req (AuthenticateReq (val,func)) =
420+ clientWithRoute (Proxy :: Proxy api) (func val req)
438421
439422-- * Basic Authentication
440423
441424instance HasClient api => HasClient (BasicAuth realm usr :> api) where
442425 type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api
443426
444− clientWithRoute Proxy req baseurl manager val =
445− clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) baseurl manager
427+ clientWithRoute Proxy req val =
428+ clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req)
446429
447430
448431{- 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) =
123123displayHttpRequest :: Method -> String
124124displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
125125
126+type ClientM = ExceptT ServantError IO
126127
127−performRequest :: Method -> Req -> BaseUrl -> Manager
128− -> ExceptT ServantError IO ( Int, ByteString, MediaType
129− , [HTTP.Header], Response ByteString)
130−performRequest reqMethod req reqHost manager = do
128+performRequest :: Method -> Req -> Manager -> BaseUrl
129+ -> ClientM ( Int, ByteString, MediaType
130+ , [HTTP.Header], Response ByteString)
131+performRequest reqMethod req manager reqHost = do
131132 partialRequest <- liftIO $ reqToRequest req reqHost
132133
133134 let request = partialRequest { Client.method = reqMethod
@@ -155,21 +156,21 @@ performRequest reqMethod req reqHost manager = do
155156
156157
157158performRequestCT :: MimeUnrender ct result =>
158− Proxy ct -> Method -> Req -> BaseUrl -> Manager
159− -> ExceptT ServantError IO ([HTTP.Header], result)
160−performRequestCT ct reqMethod req reqHost manager = do
159+ Proxy ct -> Method -> Req -> Manager -> BaseUrl
160+ -> ClientM ([HTTP.Header], result)
161+performRequestCT ct reqMethod req manager reqHost = do
161162 let acceptCT = contentType ct
162163 (_status, respBody, respCT, hdrs, _response) <-
163− performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager
164+ performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost
164165 unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
165166 case mimeUnrender ct respBody of
166167 Left err -> throwE $ DecodeFailure err respCT respBody
167168 Right val -> return (hdrs, val)
168169
169−performRequestNoBody :: Method -> Req -> BaseUrl -> Manager
170− -> ExceptT ServantError IO [HTTP.Header]
171−performRequestNoBody reqMethod req reqHost manager = do
172− (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req reqHost manager
170+performRequestNoBody :: Method -> Req -> Manager -> BaseUrl
171+ -> ClientM [HTTP.Header]
172+performRequestNoBody reqMethod req manager reqHost = do
173+ (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost
173174 return hdrs
174175
175176catchConnectionError :: IO a -> IO (Either ServantError a)
servant-client/test/Servant/ClientSpec.hs+80−87
@@ -28,19 +28,18 @@ import Control.Applicative ((<$>))
2828import Control.Arrow (left)
2929import Control.Concurrent (forkIO, killThread, ThreadId)
3030import Control.Exception (bracket)
31−import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
31+import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
3232import Data.Aeson
33+import qualified Data.ByteString.Lazy as BS
3334import Data.Char (chr, isPrint)
3435import Data.Foldable (forM_)
3536import Data.Monoid hiding (getLast)
3637import Data.Proxy
3738import qualified Data.Text as T
3839import GHC.Generics (Generic)
39−import GHC.TypeLits
4040import qualified Network.HTTP.Client as C
4141import Network.HTTP.Media
42−import Network.HTTP.Types (Status (..), badRequest400,
43− methodGet, ok200, status400)
42+import qualified Network.HTTP.Types as HTTP
4443import Network.Socket
4544import Network.Wai (Application, Request,
4645 requestHeaders, responseLBS)
@@ -120,6 +119,34 @@ type Api =
120119api :: Proxy Api
121120api = Proxy
122121
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+
123150server :: Application
124151server = serve api (
125152 return alice
@@ -132,8 +159,8 @@ server = serve api (
132159 Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
133160 :<|> (\ names -> return (zipWith Person names [0..]))
134161 :<|> return
135− :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
136− :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
162+ :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")
163+ :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure")
137164 :<|> (\ a b c d -> return (a, b, c, d))
138165 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
139166 :<|> return NoContent
@@ -149,9 +176,9 @@ failApi = Proxy
149176
150177failServer :: Application
151178failServer = serve failApi (
152− (\ _request respond -> respond $ responseLBS ok200 [] "")
153− :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
154− :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
179+ (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
180+ :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")
181+ :<|> (\_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
155182 )
156183
157184-- * basic auth stuff
@@ -208,76 +235,64 @@ sucessSpec :: Spec
208235sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
209236
210237 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
213239
214240 describe "Servant.API.Delete" $ do
215241 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
218243
219244 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
222246
223247 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)
226249
227250 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
228251 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
231253
232254 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
235− Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob"))
236− responseStatus `shouldBe` Status 400 "bob not found"
255+ left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice
256+ Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)
257+ responseStatus `shouldBe` HTTP.Status 400 "bob not found"
237258
238259 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 []
241− (left show <$> runExceptT (getQueryParams ["alice", "bob"]))
260+ (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []
261+ (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl))
242262 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
243263
244264 context "Servant.API.QueryParam.QueryFlag" $
245265 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
248267
249268 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)
252270 case res of
253271 Left e -> assertFailure $ show e
254272 Right (code, body, ct, _, response) -> do
255273 (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
256274 C.responseBody response `shouldBe` body
257− C.responseStatus response `shouldBe` ok200
275+ C.responseStatus response `shouldBe` HTTP.ok200
258276
259277 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)
262279 case res of
263280 Right _ -> assertFailure "expected Left, but got Right"
264281 Left e -> do
265− Servant.Client.responseStatus e `shouldBe` status400
282+ Servant.Client.responseStatus e `shouldBe` HTTP.status400
266283 Servant.Client.responseBody e `shouldBe` "rawFailure"
267284
268285 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)
271287 case res of
272288 Left e -> assertFailure $ show e
273289 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
274290
275291 modifyMaxSuccess (const 20) $ do
276292 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 ->
279294 ioProperty $ do
280− result <- left show <$> runExceptT (getMultiple cap num flag body)
295+ result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl)
281296 return $
282297 result === Right (cap, num, flag, body)
283298
@@ -289,10 +304,10 @@ wrappedApiSpec = describe "error status codes" $ do
289304 let test :: (WrappedApi, String) -> Spec
290305 test (WrappedApi api, desc) =
291306 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
292− let getResponse :: ExceptT ServantError IO ()
293− getResponse = client api baseUrl manager
294− Left FailureResponse{..} <- runExceptT getResponse
295− responseStatus `shouldBe` (Status 500 "error message")
307+ let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM ()
308+ getResponse = client api
309+ Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl)
310+ responseStatus `shouldBe` (HTTP.Status 500 "error message")
296311 in mapM_ test $
297312 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
298313 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
@@ -305,43 +320,43 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
305320
306321 context "client returns errors appropriately" $ do
307322 it "reports FailureResponse" $ \(_, baseUrl) -> do
308− let (_ :<|> getDeleteEmpty :<|> _) = client api baseUrl manager
309− Left res <- runExceptT getDeleteEmpty
323+ let (_ :<|> getDeleteEmpty :<|> _) = client api
324+ Left res <- runExceptT (getDeleteEmpty manager baseUrl)
310325 case res of
311− FailureResponse (Status 404 "Not Found") _ _ -> return ()
326+ FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
312327 _ -> fail $ "expected 404 response, but got " <> show res
313328
314329 it "reports DecodeFailure" $ \(_, baseUrl) -> do
315− let (_ :<|> _ :<|> getCapture :<|> _) = client api baseUrl manager
316− Left res <- runExceptT (getCapture "foo")
330+ let (_ :<|> _ :<|> getCapture :<|> _) = client api
331+ Left res <- runExceptT (getCapture "foo" manager baseUrl)
317332 case res of
318333 DecodeFailure _ ("application/json") _ -> return ()
319334 _ -> fail $ "expected DecodeFailure, but got " <> show res
320335
321336 it "reports ConnectionError" $ \_ -> do
322− let (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager
323− Left res <- runExceptT getGetWrongHost
337+ let (getGetWrongHost :<|> _) = client api
338+ Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 ""))
324339 case res of
325340 ConnectionError _ -> return ()
326341 _ -> fail $ "expected ConnectionError, but got " <> show res
327342
328343 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
329− let (getGet :<|> _ ) = client api baseUrl manager
330− Left res <- runExceptT getGet
344+ let (getGet :<|> _ ) = client api
345+ Left res <- runExceptT (getGet manager baseUrl)
331346 case res of
332347 UnsupportedContentType ("application/octet-stream") _ -> return ()
333348 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
334349
335350 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
336− let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api baseUrl manager
337− Left res <- runExceptT (getBody alice)
351+ let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
352+ Left res <- runExceptT (getBody alice manager baseUrl)
338353 case res of
339354 InvalidContentTypeHeader "fooooo" _ -> return ()
340355 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
341356
342357data WrappedApi where
343358 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 ())) =>
345360 Proxy api -> WrappedApi
346361
347362basicAuthSpec :: Spec
@@ -349,34 +364,34 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
349364 context "Authentication works when requests are properly authenticated" $ do
350365
351366 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
352− let getBasic = client basicAuthAPI baseUrl manager
367+ let getBasic = client basicAuthAPI
353368 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
355370
356371 context "Authentication is rejected when requests are not authenticated properly" $ do
357372
358373 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
359− let getBasic = client basicAuthAPI baseUrl manager
374+ let getBasic = client basicAuthAPI
360375 let basicAuthData = BasicAuthData "not" "password"
361− Left FailureResponse{..} <- runExceptT (getBasic basicAuthData)
362− responseStatus `shouldBe` Status 403 "Forbidden"
376+ Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)
377+ responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
363378
364379genAuthSpec :: Spec
365380genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
366381 context "Authentication works when requests are properly authenticated" $ do
367382
368383 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
369− let getProtected = client genAuthAPI baseUrl manager
384+ let getProtected = client genAuthAPI
370385 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
372387
373388 context "Authentication is rejected when requests are not authenticated properly" $ do
374389
375390 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
376− let getProtected = client genAuthAPI baseUrl manager
391+ let getProtected = client genAuthAPI
377392 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
378− Left FailureResponse{..} <- runExceptT (getProtected authRequest)
379− responseStatus `shouldBe` (Status 401 "Unauthorized")
393+ Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)
394+ responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
380395
381396-- * utils
382397
@@ -407,25 +422,3 @@ pathGen = fmap NonEmpty path
407422 filter (not . (`elem` ("?%[]/#;" :: String))) $
408423 filter isPrint $
409424 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