git.iko.soy/typeable/servant
on master help sign in
Merge pull request #242 from haskell-servant/jkarni/http-client-manager

Pass in Manager as argument to 'client'

commit52b58d0fe93a68d88c5c5929bb1cdf38286323d0 authorJulian Arni <jkarni@gmail.com> dateWed 30 Sep 2015, 13:36 (11 years ago) parent1d248a5cd7906d
9 files changed+118−102
compare with master
unifiedsplit
servant-client/CHANGELOG.md+1 servant-client/src/Servant/Client.hs+70−69 servant-client/src/Servant/Common/Req.hs+9−23 servant-client/test/Servant/ClientSpec.hs+6−4 servant-examples/hackage/hackage.hs+11−2 servant-examples/servant-examples.cabal+2 servant-examples/tutorial/T8.hs+8−1 servant/CHANGELOG.md+1 servant/src/Servant/API/Alternative.hs+10−3
servant-client/CHANGELOG.md+1
@@ -3,6 +3,7 @@ HEAD
33
44* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
55* Added support for `path` on `BaseUrl`.
6+* `client` now takes an explicit `Manager` argument.
67
780.4.1
89-----
servant-client/src/Servant/Client.hs+70−69
@@ -32,7 +32,7 @@ import Data.Proxy
3232import Data.String.Conversions
3333import Data.Text (unpack)
3434import GHC.TypeLits
35−import Network.HTTP.Client (Response)
35+import Network.HTTP.Client (Response, Manager)
3636import Network.HTTP.Media
3737import qualified Network.HTTP.Types as H
3838import qualified Network.HTTP.Types.Header as HTTP
@@ -52,9 +52,9 @@ import Servant.Common.Req
5252-- >
5353-- > getAllBooks :: ExceptT String IO [Book]
5454-- > postNewBook :: Book -> ExceptT String IO Book
55−-- > (getAllBooks :<|> postNewBook) = client myApi host
55+-- > (getAllBooks :<|> postNewBook) = client myApi host manager
5656-- > where host = BaseUrl Http "localhost" 8080
57−client :: HasClient layout => Proxy layout -> BaseUrl -> Client layout
57+client :: HasClient layout => Proxy layout -> BaseUrl -> Manager -> Client layout
5858client p baseurl = clientWithRoute p defReq baseurl
5959
6060-- | This class lets us define how each API combinator
@@ -62,9 +62,8 @@ client p baseurl = clientWithRoute p defReq baseurl
6262-- an internal class, you can just use 'client'.
6363class HasClient layout where
6464 type Client layout :: *
65− clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Client layout
65+ clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Manager -> Client layout
6666
67−{-type Client layout = Client layout-}
6867
6968-- | A client querying function for @a ':<|>' b@ will actually hand you
7069-- one function for querying @a@ and another one for querying @b@,
@@ -78,13 +77,13 @@ class HasClient layout where
7877-- >
7978-- > getAllBooks :: ExceptT String IO [Book]
8079-- > postNewBook :: Book -> ExceptT String IO Book
81−-- > (getAllBooks :<|> postNewBook) = client myApi host
80+-- > (getAllBooks :<|> postNewBook) = client myApi host manager
8281-- > where host = BaseUrl Http "localhost" 8080
8382instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
8483 type Client (a :<|> b) = Client a :<|> Client b
85− clientWithRoute Proxy req baseurl =
86− clientWithRoute (Proxy :: Proxy a) req baseurl :<|>
87− clientWithRoute (Proxy :: Proxy b) req baseurl
84+ clientWithRoute Proxy req baseurl manager =
85+ clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>
86+ clientWithRoute (Proxy :: Proxy b) req baseurl manager
8887
8988-- | If you use a 'Capture' in one of your endpoints in your API,
9089-- the corresponding querying function will automatically take
@@ -103,7 +102,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
103102-- > myApi = Proxy
104103-- >
105104-- > getBook :: Text -> ExceptT String IO Book
106−-- > getBook = client myApi host
105+-- > getBook = client myApi host manager
107106-- > where host = BaseUrl Http "localhost" 8080
108107-- > -- then you can just use "getBook" to query that endpoint
109108instance (KnownSymbol capture, ToText a, HasClient sublayout)
@@ -112,10 +111,11 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)
112111 type Client (Capture capture a :> sublayout) =
113112 a -> Client sublayout
114113
115− clientWithRoute Proxy req baseurl val =
114+ clientWithRoute Proxy req baseurl manager val =
116115 clientWithRoute (Proxy :: Proxy sublayout)
117116 (appendToPath p req)
118117 baseurl
118+ manager
119119
120120 where p = unpack (toText val)
121121
@@ -127,11 +127,10 @@ instance
127127#if MIN_VERSION_base(4,8,0)
128128 {-# OVERLAPPABLE #-}
129129#endif
130− -- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances
131130 (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where
132131 type Client (Delete cts' a) = ExceptT ServantError IO a
133− clientWithRoute Proxy req baseurl =
134− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
132+ clientWithRoute Proxy req baseurl manager =
133+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl manager
135134
136135-- | If you have a 'Delete xs ()' endpoint, the client expects a 204 No Content
137136-- HTTP header.
@@ -141,8 +140,8 @@ instance
141140#endif
142141 HasClient (Delete cts ()) where
143142 type Client (Delete cts ()) = ExceptT ServantError IO ()
144− clientWithRoute Proxy req baseurl =
145− void $ performRequestNoBody H.methodDelete req [204] baseurl
143+ clientWithRoute Proxy req baseurl manager =
144+ void $ performRequestNoBody H.methodDelete req [204] baseurl manager
146145
147146-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
148147-- corresponding headers.
@@ -150,12 +149,11 @@ instance
150149#if MIN_VERSION_base(4,8,0)
151150 {-# OVERLAPPING #-}
152151#endif
153− -- See https://downloads.haskell.org/~ghc/7.8.2/docs/html/users_guide/type-class-extensions.html#undecidable-instances
154152 ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
155153 ) => HasClient (Delete cts' (Headers ls a)) where
156154 type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
157− clientWithRoute Proxy req baseurl = do
158− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
155+ clientWithRoute Proxy req baseurl manager = do
156+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl manager
159157 return $ Headers { getResponse = resp
160158 , getHeadersHList = buildHeadersTo hdrs
161159 }
@@ -170,8 +168,8 @@ instance
170168#endif
171169 (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
172170 type Client (Get (ct ': cts) result) = ExceptT ServantError IO result
173− clientWithRoute Proxy req baseurl =
174− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl
171+ clientWithRoute Proxy req baseurl manager =
172+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl manager
175173
176174-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content
177175-- HTTP status.
@@ -181,8 +179,8 @@ instance
181179#endif
182180 HasClient (Get (ct ': cts) ()) where
183181 type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()
184− clientWithRoute Proxy req baseurl =
185− performRequestNoBody H.methodGet req [204] baseurl
182+ clientWithRoute Proxy req baseurl manager =
183+ performRequestNoBody H.methodGet req [204] baseurl manager
186184
187185-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
188186-- corresponding headers.
@@ -193,8 +191,8 @@ instance
193191 ( MimeUnrender ct a, BuildHeadersTo ls
194192 ) => HasClient (Get (ct ': cts) (Headers ls a)) where
195193 type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
196− clientWithRoute Proxy req baseurl = do
197− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl
194+ clientWithRoute Proxy req baseurl manager = do
195+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl manager
198196 return $ Headers { getResponse = resp
199197 , getHeadersHList = buildHeadersTo hdrs
200198 }
@@ -231,13 +229,14 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
231229 type Client (Header sym a :> sublayout) =
232230 Maybe a -> Client sublayout
233231
234− clientWithRoute Proxy req baseurl mval =
232+ clientWithRoute Proxy req baseurl manager mval =
235233 clientWithRoute (Proxy :: Proxy sublayout)
236234 (maybe req
237235 (\value -> Servant.Common.Req.addHeader hname value req)
238236 mval
239237 )
240238 baseurl
239+ manager
241240
242241 where hname = symbolVal (Proxy :: Proxy sym)
243242
@@ -251,8 +250,8 @@ instance
251250#endif
252251 (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
253252 type Client (Post (ct ': cts) a) = ExceptT ServantError IO a
254− clientWithRoute Proxy req baseurl =
255− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl
253+ clientWithRoute Proxy req baseurl manager =
254+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl manager
256255
257256-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content
258257-- HTTP header.
@@ -262,8 +261,8 @@ instance
262261#endif
263262 HasClient (Post (ct ': cts) ()) where
264263 type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()
265− clientWithRoute Proxy req baseurl =
266− void $ performRequestNoBody H.methodPost req [204] baseurl
264+ clientWithRoute Proxy req baseurl manager =
265+ void $ performRequestNoBody H.methodPost req [204] baseurl manager
267266
268267-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
269268-- corresponding headers.
@@ -274,8 +273,8 @@ instance
274273 ( MimeUnrender ct a, BuildHeadersTo ls
275274 ) => HasClient (Post (ct ': cts) (Headers ls a)) where
276275 type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
277− clientWithRoute Proxy req baseurl = do
278− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl
276+ clientWithRoute Proxy req baseurl manager = do
277+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl manager
279278 return $ Headers { getResponse = resp
280279 , getHeadersHList = buildHeadersTo hdrs
281280 }
@@ -290,8 +289,8 @@ instance
290289#endif
291290 (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
292291 type Client (Put (ct ': cts) a) = ExceptT ServantError IO a
293− clientWithRoute Proxy req baseurl =
294− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl
292+ clientWithRoute Proxy req baseurl manager =
293+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl manager
295294
296295-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content
297296-- HTTP header.
@@ -301,8 +300,8 @@ instance
301300#endif
302301 HasClient (Put (ct ': cts) ()) where
303302 type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()
304− clientWithRoute Proxy req baseurl =
305− void $ performRequestNoBody H.methodPut req [204] baseurl
303+ clientWithRoute Proxy req baseurl manager =
304+ void $ performRequestNoBody H.methodPut req [204] baseurl manager
306305
307306-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
308307-- corresponding headers.
@@ -313,8 +312,8 @@ instance
313312 ( MimeUnrender ct a, BuildHeadersTo ls
314313 ) => HasClient (Put (ct ': cts) (Headers ls a)) where
315314 type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
316− clientWithRoute Proxy req baseurl = do
317− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl
315+ clientWithRoute Proxy req baseurl manager= do
316+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl manager
318317 return $ Headers { getResponse = resp
319318 , getHeadersHList = buildHeadersTo hdrs
320319 }
@@ -329,8 +328,8 @@ instance
329328#endif
330329 (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
331330 type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a
332− clientWithRoute Proxy req baseurl =
333− snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl
331+ clientWithRoute Proxy req baseurl manager =
332+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl manager
334333
335334-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content
336335-- HTTP header.
@@ -340,8 +339,8 @@ instance
340339#endif
341340 HasClient (Patch (ct ': cts) ()) where
342341 type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()
343− clientWithRoute Proxy req baseurl =
344− void $ performRequestNoBody H.methodPatch req [204] baseurl
342+ clientWithRoute Proxy req baseurl manager =
343+ void $ performRequestNoBody H.methodPatch req [204] baseurl manager
345344
346345-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
347346-- corresponding headers.
@@ -352,8 +351,8 @@ instance
352351 ( MimeUnrender ct a, BuildHeadersTo ls
353352 ) => HasClient (Patch (ct ': cts) (Headers ls a)) where
354353 type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
355− clientWithRoute Proxy req baseurl = do
356− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl
354+ clientWithRoute Proxy req baseurl manager = do
355+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl manager
357356 return $ Headers { getResponse = resp
358357 , getHeadersHList = buildHeadersTo hdrs
359358 }
@@ -391,13 +390,14 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
391390 Maybe a -> Client sublayout
392391
393392 -- if mparam = Nothing, we don't add it to the query string
394− clientWithRoute Proxy req baseurl mparam =
393+ clientWithRoute Proxy req baseurl manager mparam =
395394 clientWithRoute (Proxy :: Proxy sublayout)
396395 (maybe req
397396 (flip (appendToQueryString pname) req . Just)
398397 mparamText
399398 )
400399 baseurl
400+ manager
401401
402402 where pname = cs pname'
403403 pname' = symbolVal (Proxy :: Proxy sym)
@@ -437,13 +437,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
437437 type Client (QueryParams sym a :> sublayout) =
438438 [a] -> Client sublayout
439439
440− clientWithRoute Proxy req baseurl paramlist =
440+ clientWithRoute Proxy req baseurl manager paramlist =
441441 clientWithRoute (Proxy :: Proxy sublayout)
442442 (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
443443 req
444444 paramlist'
445445 )
446− baseurl
446+ baseurl manager
447447
448448 where pname = cs pname'
449449 pname' = symbolVal (Proxy :: Proxy sym)
@@ -477,13 +477,13 @@ instance (KnownSymbol sym, HasClient sublayout)
477477 type Client (QueryFlag sym :> sublayout) =
478478 Bool -> Client sublayout
479479
480− clientWithRoute Proxy req baseurl flag =
480+ clientWithRoute Proxy req baseurl manager flag =
481481 clientWithRoute (Proxy :: Proxy sublayout)
482482 (if flag
483483 then appendToQueryString paramname Nothing req
484484 else req
485485 )
486− baseurl
486+ baseurl manager
487487
488488 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
489489
@@ -520,13 +520,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
520520 Maybe a -> Client sublayout
521521
522522 -- if mparam = Nothing, we don't add it to the query string
523− clientWithRoute Proxy req baseurl mparam =
523+ clientWithRoute Proxy req baseurl manager mparam =
524524 clientWithRoute (Proxy :: Proxy sublayout)
525525 (maybe req
526526 (flip (appendToMatrixParams pname . Just) req)
527527 mparamText
528528 )
529− baseurl
529+ baseurl manager
530530
531531 where pname = symbolVal (Proxy :: Proxy sym)
532532 mparamText = fmap (cs . toText) mparam
@@ -565,13 +565,13 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
565565 type Client (MatrixParams sym a :> sublayout) =
566566 [a] -> Client sublayout
567567
568− clientWithRoute Proxy req baseurl paramlist =
568+ clientWithRoute Proxy req baseurl manager paramlist =
569569 clientWithRoute (Proxy :: Proxy sublayout)
570570 (foldl' (\ req' value -> maybe req' (flip (appendToMatrixParams pname) req' . Just . cs) value)
571571 req
572572 paramlist'
573573 )
574− baseurl
574+ baseurl manager
575575
576576 where pname = cs pname'
577577 pname' = symbolVal (Proxy :: Proxy sym)
@@ -590,6 +590,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
590590--
591591-- > type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book]
592592-- >
593+-- >
593594-- > myApi :: Proxy MyApi
594595-- > myApi = Proxy
595596-- >
@@ -605,13 +606,13 @@ instance (KnownSymbol sym, HasClient sublayout)
605606 type Client (MatrixFlag sym :> sublayout) =
606607 Bool -> Client sublayout
607608
608− clientWithRoute Proxy req baseurl flag =
609+ clientWithRoute Proxy req baseurl manager flag =
609610 clientWithRoute (Proxy :: Proxy sublayout)
610611 (if flag
611612 then appendToMatrixParams paramname Nothing req
612613 else req
613614 )
614− baseurl
615+ baseurl manager
615616
616617 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
617618
@@ -620,9 +621,9 @@ instance (KnownSymbol sym, HasClient sublayout)
620621instance HasClient Raw where
621622 type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
622623
623− clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Client Raw
624− clientWithRoute Proxy req baseurl httpMethod = do
625− performRequest httpMethod req (const True) baseurl
624+ clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
625+ clientWithRoute Proxy req baseurl manager httpMethod = do
626+ performRequest httpMethod req (const True) baseurl manager
626627
627628-- | If you use a 'ReqBody' in one of your endpoints in your API,
628629-- the corresponding querying function will automatically take
@@ -640,7 +641,7 @@ instance HasClient Raw where
640641-- > myApi = Proxy
641642-- >
642643-- > addBook :: Book -> ExceptT String IO Book
643−-- > addBook = client myApi host
644+-- > addBook = client myApi host manager
644645-- > where host = BaseUrl Http "localhost" 8080
645646-- > -- then you can just use "addBook" to query that endpoint
646647instance (MimeRender ct a, HasClient sublayout)
@@ -649,40 +650,40 @@ instance (MimeRender ct a, HasClient sublayout)
649650 type Client (ReqBody (ct ': cts) a :> sublayout) =
650651 a -> Client sublayout
651652
652− clientWithRoute Proxy req baseurl body =
653+ clientWithRoute Proxy req baseurl manager body =
653654 clientWithRoute (Proxy :: Proxy sublayout)
654655 (let ctProxy = Proxy :: Proxy ct
655656 in setRQBody (mimeRender ctProxy body)
656657 (contentType ctProxy)
657658 req
658659 )
659− baseurl
660+ baseurl manager
660661
661662-- | Make the querying function append @path@ to the request path.
662663instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
663664 type Client (path :> sublayout) = Client sublayout
664665
665− clientWithRoute Proxy req baseurl =
666+ clientWithRoute Proxy req baseurl manager =
666667 clientWithRoute (Proxy :: Proxy sublayout)
667668 (appendToPath p req)
668− baseurl
669+ baseurl manager
669670
670671 where p = symbolVal (Proxy :: Proxy path)
671672
672673instance HasClient api => HasClient (Vault :> api) where
673674 type Client (Vault :> api) = Client api
674675
675− clientWithRoute Proxy req baseurl =
676− clientWithRoute (Proxy :: Proxy api) req baseurl
676+ clientWithRoute Proxy req baseurl manager =
677+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
677678
678679instance HasClient api => HasClient (RemoteHost :> api) where
679680 type Client (RemoteHost :> api) = Client api
680681
681− clientWithRoute Proxy req baseurl =
682− clientWithRoute (Proxy :: Proxy api) req baseurl
682+ clientWithRoute Proxy req baseurl manager =
683+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
683684
684685instance HasClient api => HasClient (IsSecure :> api) where
685686 type Client (IsSecure :> api) = Client api
686687
687− clientWithRoute Proxy req baseurl =
688− clientWithRoute (Proxy :: Proxy api) req baseurl
688+ clientWithRoute Proxy req baseurl manager =
689+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
servant-client/src/Servant/Common/Req.hs+9−23
@@ -13,7 +13,6 @@ import Control.Monad.Catch (MonadThrow)
1313import Control.Monad.IO.Class
1414import Control.Monad.Trans.Except
1515import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
16−import Data.IORef
1716import Data.String
1817import Data.String.Conversions
1918import Data.Proxy
@@ -21,7 +20,6 @@ import Data.Text (Text)
2120import Data.Text.Encoding
2221import Data.Typeable
2322import Network.HTTP.Client hiding (Proxy, path)
24−import Network.HTTP.Client.TLS
2523import Network.HTTP.Media
2624import Network.HTTP.Types
2725import qualified Network.HTTP.Types.Header as HTTP
@@ -29,7 +27,6 @@ import Network.URI hiding (path)
2927import Servant.API.ContentTypes
3028import Servant.Common.BaseUrl
3129import Servant.Common.Text
32−import System.IO.Unsafe
3330
3431import qualified Network.HTTP.Client as Client
3532
@@ -129,31 +126,21 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
129126
130127-- * performing requests
131128
132−{-# NOINLINE __manager #-}
133−__manager :: IORef Manager
134−__manager = unsafePerformIO (newManager tlsManagerSettings >>= newIORef)
135−
136−__withGlobalManager :: (Manager -> IO a) -> IO a
137−__withGlobalManager action = readIORef __manager >>= action
138−
139−
140129displayHttpRequest :: Method -> String
141130displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
142131
143132
144−performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl
133+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> Manager
145134 -> ExceptT ServantError IO ( Int, ByteString, MediaType
146135 , [HTTP.Header], Response ByteString)
147−performRequest reqMethod req isWantedStatus reqHost = do
136+performRequest reqMethod req isWantedStatus reqHost manager = do
148137 partialRequest <- liftIO $ reqToRequest req reqHost
149138
150139 let request = partialRequest { Client.method = reqMethod
151140 , checkStatus = \ _status _headers _cookies -> Nothing
152141 }
153142
154− eResponse <- liftIO $ __withGlobalManager $ \ manager ->
155− catchConnectionError $
156− Client.httpLbs request manager
143+ eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager
157144 case eResponse of
158145 Left err ->
159146 throwE . ConnectionError $ SomeException err
@@ -174,20 +161,19 @@ performRequest reqMethod req isWantedStatus reqHost = do
174161
175162
176163performRequestCT :: MimeUnrender ct result =>
177− Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> ExceptT ServantError IO ([HTTP.Header], result)
178−performRequestCT ct reqMethod req wantedStatus reqHost = do
164+ Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> Manager -> ExceptT ServantError IO ([HTTP.Header], result)
165+performRequestCT ct reqMethod req wantedStatus reqHost manager = do
179166 let acceptCT = contentType ct
180167 (_status, respBody, respCT, hrds, _response) <-
181− performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
168+ performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost manager
182169 unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
183170 case mimeUnrender ct respBody of
184171 Left err -> throwE $ DecodeFailure err respCT respBody
185172 Right val -> return (hrds, val)
186173
187−performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> ExceptT ServantError IO ()
188−performRequestNoBody reqMethod req wantedStatus reqHost = do
189− _ <- performRequest reqMethod req (`elem` wantedStatus) reqHost
190− return ()
174+performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> Manager -> ExceptT ServantError IO ()
175+performRequestNoBody reqMethod req wantedStatus reqHost manager =
176+ void $ performRequest reqMethod req (`elem` wantedStatus) reqHost manager
191177
192178catchConnectionError :: IO a -> IO (Either ServantError a)
193179catchConnectionError action =
servant-client/test/Servant/ClientSpec.hs+6−4
@@ -144,6 +144,7 @@ withFailServer action = withWaiDaemon (return failServer) action
144144
145145spec :: IO ()
146146spec = withServer $ \ baseUrl -> do
147+ manager <- C.newManager C.defaultManagerSettings
147148 let getGet :: ExceptT ServantError IO Person
148149 getDeleteEmpty :: ExceptT ServantError IO ()
149150 getCapture :: String -> ExceptT ServantError IO Person
@@ -174,7 +175,7 @@ spec = withServer $ \ baseUrl -> do
174175 :<|> getMultiple
175176 :<|> getRespHeaders
176177 :<|> getDeleteContentType)
177− = client api baseUrl
178+ = client api baseUrl manager
178179
179180 hspec $ do
180181 it "Servant.API.Get" $ do
@@ -264,7 +265,7 @@ spec = withServer $ \ baseUrl -> do
264265 withWaiDaemon (return (serve api (throwE $ ServantErr 500 "error message" "" []))) $
265266 \ host -> do
266267 let getResponse :: ExceptT ServantError IO ()
267− getResponse = client api host
268+ getResponse = client api host manager
268269 Left FailureResponse{..} <- runExceptT getResponse
269270 responseStatus `shouldBe` (Status 500 "error message")
270271 mapM_ test $
@@ -276,6 +277,7 @@ spec = withServer $ \ baseUrl -> do
276277
277278failSpec :: IO ()
278279failSpec = withFailServer $ \ baseUrl -> do
280+ manager <- C.newManager C.defaultManagerSettings
279281 let getGet :: ExceptT ServantError IO Person
280282 getDeleteEmpty :: ExceptT ServantError IO ()
281283 getCapture :: String -> ExceptT ServantError IO Person
@@ -285,9 +287,9 @@ failSpec = withFailServer $ \ baseUrl -> do
285287 :<|> getCapture
286288 :<|> getBody
287289 :<|> _ )
288− = client api baseUrl
290+ = client api baseUrl manager
289291 getGetWrongHost :: ExceptT ServantError IO Person
290− (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "")
292+ (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager
291293
292294 hspec $ do
293295 context "client returns errors appropriately" $ do
servant-examples/hackage/hackage.hs+11−2
@@ -12,6 +12,9 @@ import Data.Monoid
1212import Data.Proxy
1313import Data.Text (Text)
1414import GHC.Generics
15+import Network.HTTP.Client (Manager, defaultManagerSettings,
16+ newManager)
17+import System.IO.Unsafe (unsafePerformIO)
1518import Servant.API
1619import Servant.Client
1720
@@ -55,10 +58,16 @@ instance FromJSON Package
5558hackageAPI :: Proxy HackageAPI
5659hackageAPI = Proxy
5760
61+
62+{-# NOINLINE manager #-}
63+manager :: Manager
64+manager = unsafePerformIO $ newManager defaultManagerSettings
65+
5866getUsers :: ExceptT ServantError IO [UserSummary]
5967getUser :: Username -> ExceptT ServantError IO UserDetailed
6068getPackages :: ExceptT ServantError IO [Package]
61−getUsers :<|> getUser :<|> getPackages = client hackageAPI $ BaseUrl Http "hackage.haskell.org" 80 ""
69+getUsers :<|> getUser :<|> getPackages =
70+ client hackageAPI (BaseUrl Http "hackage.haskell.org" 80 "") manager
6271
6372main :: IO ()
6473main = print =<< uselessNumbers
@@ -71,7 +80,7 @@ uselessNumbers = runExceptT $ do
7180 user <- liftIO $ do
7281 putStrLn "Enter a valid hackage username"
7382 T.getLine
74− userDetailed <- (getUser user)
83+ userDetailed <- getUser user
7584 liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
7685
7786 packages <- getPackages
servant-examples/servant-examples.cabal+2
@@ -53,6 +53,7 @@ executable t8-main
5353 build-depends:
5454 aeson
5555 , base >= 4.7 && < 5
56+ , http-client > 0.4 && < 0.5
5657 , servant == 0.5.*
5758 , servant-client == 0.5.*
5859 , servant-server == 0.5.*
@@ -65,6 +66,7 @@ executable hackage
6566 build-depends:
6667 aeson >= 0.8
6768 , base >=4.7 && < 5
69+ , http-client > 0.4 && < 0.5
6870 , servant == 0.5.*
6971 , servant-client == 0.5.*
7072 , text
servant-examples/tutorial/T8.hs+8−1
@@ -4,8 +4,11 @@
44module T8 where
55
66import Control.Monad.Trans.Except
7+import Network.HTTP.Client (Manager, defaultManagerSettings,
8+ newManager)
79import Servant
810import Servant.Client
11+import System.IO.Unsafe (unsafePerformIO)
912
1013import T3
1114
@@ -19,11 +22,15 @@ hello :: Maybe String -- ^ an optional value for "name"
1922marketing :: ClientInfo -- ^ value for the request body
2023 -> ExceptT ServantError IO Email
2124
22−position :<|> hello :<|> marketing = client api baseUrl
25+position :<|> hello :<|> marketing = client api baseUrl manager
2326
2427baseUrl :: BaseUrl
2528baseUrl = BaseUrl Http "localhost" 8081 ""
2629
30+{-# NOINLINE manager #-}
31+manager :: Manager
32+manager = unsafePerformIO $ newManager defaultManagerSettings
33+
2734queries :: ExceptT ServantError IO (Position, HelloMessage, Email)
2835queries = do
2936 pos <- position 10 10
servant/CHANGELOG.md+1
@@ -3,6 +3,7 @@ HEAD
33
44* Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
55* Fix safeLink, so Header is not in fact required.
6+* Added more instances for (:<|>)
67
780.4.2
89-----
servant/src/Servant/API/Alternative.hs+10−3
@@ -1,13 +1,20 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveFunctor #-}
4+#if !MIN_VERSION_base(4,8,0)
5+{-# LANGUAGE DeriveFoldable #-}
6+#endif
7+{-# LANGUAGE DeriveTraversable #-}
38{-# LANGUAGE TypeOperators #-}
49{-# OPTIONS_HADDOCK not-home #-}
510module Servant.API.Alternative ((:<|>)(..)) where
611
712#if !MIN_VERSION_base(4,8,0)
8−import Data.Monoid (Monoid (..))
13+import Data.Monoid (Monoid (..))
14+import Data.Traversable (Traversable)
15+import Data.Foldable (Foldable)
916#endif
10−import Data.Typeable (Typeable)
17+import Data.Typeable (Typeable)
1118-- | Union of two APIs, first takes precedence in case of overlap.
1219--
1320-- Example:
@@ -17,7 +24,7 @@ import Data.Typeable (Typeable)
1724-- :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] () -- POST /books
1825-- :}
1926data a :<|> b = a :<|> b
20− deriving (Typeable, Eq, Show)
27+ deriving (Typeable, Eq, Show, Functor, Traversable, Foldable, Bounded)
2128infixr 8 :<|>
2229
2330instance (Monoid a, Monoid b) => Monoid (a :<|> b) where