git.iko.soy/typeable/servant
on master help sign in
Compiling servant-client-core
01f344dJulian K. Arni
servant-client-core/servant-client-core.cabal+1
compare with master
unifiedsplit
@@ -41,6 +41,7 @@ library
41 , http-api-data >= 0.3.6 && < 0.4
41 , http-api-data >= 0.3.6 && < 0.4
42 , http-media >= 0.6.2 && < 0.8
42 , http-media >= 0.6.2 && < 0.8
43 , http-types >= 0.8.6 && < 0.10
43 , http-types >= 0.8.6 && < 0.10
44+ , mtl >= 2.2 && < 2.3
44 , network-uri >= 2.6 && < 2.7
45 , network-uri >= 2.6 && < 2.7
45 , safe >= 0.3.9 && < 0.4
46 , safe >= 0.3.9 && < 0.4
46 , servant == 0.11.*
47 , servant == 0.11.*
servant-client-core/src/Servant/Client/Core.hs+89−72
@@ -21,34 +21,52 @@ module Servant.Client.Core
21 , AuthenticateReq(..)
21 , AuthenticateReq(..)
22 , client
22 , client
23 , HasClient(..)
23 , HasClient(..)
24− , ClientM
25− , runClientM, inClientM, clientM
26− , ClientEnv (ClientEnv)
27 , mkAuthenticateReq
24 , mkAuthenticateReq
28 , ServantError(..)
25 , ServantError(..)
29 , EmptyClient(..)
26 , EmptyClient(..)
30− , module Servant.Common.BaseUrl
27+ , module Servant.Client.Core.Internal.BaseUrl
31 ) where
28 ) where
32
29
33−import Data.ByteString.Lazy (ByteString)
30+import Control.Monad.Error.Class (throwError)
34−import Data.List
31+import Data.List (foldl')
35−import Data.Proxy
32+import Data.Proxy (Proxy (Proxy))
36−import Data.String.Conversions
33+import Data.String (fromString)
37−import Data.Text (unpack)
34+import Data.Text (pack)
35+import GHC.Exts (fromList, toList)
38−import GHC.TypeLits
36+import GHC.TypeLits (KnownSymbol, symbolVal)
39−import Network.HTTP.Client (Response)
40−import Network.HTTP.Media
41−import qualified Network.HTTP.Types as H
37+import qualified Network.HTTP.Types as H
42−import qualified Network.HTTP.Types.Header as HTTP
43−import Prelude ()
38+import Prelude ()
44import Prelude.Compat
39import Prelude.Compat
45−import Servant.API
40+import Servant.API ((:<|>) ((:<|>)), (:>),
41+ AuthProtect, BasicAuth,
42+ BasicAuthData,
43+ BuildHeadersTo (..),
44+ Capture, CaptureAll,
45+ Description, EmptyAPI,
46+ Header, Headers (..),
47+ HttpVersion, IsSecure,
48+ MimeRender (mimeRender),
49+ MimeUnrender (mimeUnrender),
50+ NoContent (NoContent),
51+ QueryFlag, QueryParam,
52+ QueryParams, Raw,
53+ ReflectMethod (..),
54+ RemoteHost, ReqBody,
55+ Summary, ToHttpApiData,
56+ Vault, Verb,
57+ WithNamedContext,
58+ contentType,
59+ getHeadersHList,
60+ getResponse,
61+ toQueryParam,
62+ toUrlPiece)
63+import Servant.API.ContentTypes (contentTypes)
64+
46−import Servant.Client.Experimental.Auth
65+import Servant.Client.Core.Internal.Auth
47−import Servant.Client.HttpClient
66+import Servant.Client.Core.Internal.BaseUrl
48−import Servant.Client.Class
49−import Servant.Common.BaseUrl
50−import Servant.Common.BasicAuth
67+import Servant.Client.Core.Internal.BasicAuth
51−import Servant.Common.Req
68+import Servant.Client.Core.Internal.Class
69+import Servant.Client.Core.Internal.Request
52
70
53-- * Accessing APIs as a Client
71-- * Accessing APIs as a Client
54
72
@@ -68,25 +86,15 @@ import Servant.Common.Req
68-- > postNewBook :: Book -> ClientM Book
86-- > postNewBook :: Book -> ClientM Book
69-- > (getAllBooks :<|> postNewBook) = client clientM myApi
87-- > (getAllBooks :<|> postNewBook) = client clientM myApi
70client :: HasClient m api => Proxy m -> Proxy api -> Client m api
88client :: HasClient m api => Proxy m -> Proxy api -> Client m api
71−client pm p = clientWithRoute pm p defReq
89+client pm p = clientWithRoute pm p defaultRequest
72−
73−-- | Helper proxy to simplify common case of working in `ClientM` monad
74−inClientM :: Proxy ClientM
75−inClientM = Proxy
76−
77−-- | Convenience method to declare clients running in the `ClientM` monad.
78−--
79−-- Simply pass `inClientM` to `client`....
80−clientM :: (HasClient ClientM api) => Proxy api -> Client ClientM api
81−clientM = client inClientM
82
90
83
91
84-- | This class lets us define how each API combinator
92-- | This class lets us define how each API combinator
85-- influences the creation of an HTTP request. It's mostly
93-- influences the creation of an HTTP request. It's mostly
86-- an internal class, you can just use 'client'.
94-- an internal class, you can just use 'client'.
87−class HasClient m api where
95+class RunClient m => HasClient m api where
88 type Client (m :: * -> *) (api :: *) :: *
96 type Client (m :: * -> *) (api :: *) :: *
89− clientWithRoute :: Proxy m -> Proxy api -> Req -> Client m api
97+ clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api
90
98
91
99
92-- | A client querying function for @a ':<|>' b@ will actually hand you
100-- | A client querying function for @a ':<|>' b@ will actually hand you
@@ -121,7 +129,7 @@ data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
121-- >
129-- >
122-- > getAllBooks :: ClientM [Book]
130-- > getAllBooks :: ClientM [Book]
123-- > (getAllBooks :<|> EmptyClient) = client myApi
131-- > (getAllBooks :<|> EmptyClient) = client myApi
124−instance HasClient m EmptyAPI where
132+instance RunClient m => HasClient m EmptyAPI where
125 type Client m EmptyAPI = EmptyClient
133 type Client m EmptyAPI = EmptyClient
126 clientWithRoute _pm Proxy _ = EmptyClient
134 clientWithRoute _pm Proxy _ = EmptyClient
127
135
@@ -154,7 +162,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
154 clientWithRoute pm (Proxy :: Proxy api)
162 clientWithRoute pm (Proxy :: Proxy api)
155 (appendToPath p req)
163 (appendToPath p req)
156
164
157− where p = unpack (toUrlPiece val)
165+ where p = (toUrlPiece val)
158
166
159-- | If you use a 'CaptureAll' in one of your endpoints in your API,
167-- | If you use a 'CaptureAll' in one of your endpoints in your API,
160-- the corresponding querying function will automatically take an
168-- the corresponding querying function will automatically take an
@@ -186,53 +194,65 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
186 clientWithRoute pm (Proxy :: Proxy sublayout)
194 clientWithRoute pm (Proxy :: Proxy sublayout)
187 (foldl' (flip appendToPath) req ps)
195 (foldl' (flip appendToPath) req ps)
188
196
189− where ps = map (unpack . toUrlPiece) vals
197+ where ps = map (toUrlPiece) vals
190
198
191instance OVERLAPPABLE_
199instance OVERLAPPABLE_
192 -- Note [Non-Empty Content Types]
200 -- Note [Non-Empty Content Types]
193− (RunClient m ct ([H.Header], a), MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
201+ ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
194 ) => HasClient m (Verb method status cts' a) where
202 ) => HasClient m (Verb method status cts' a) where
195 type Client m (Verb method status cts' a) = m a
203 type Client m (Verb method status cts' a) = m a
196 clientWithRoute _pm Proxy req = do
204 clientWithRoute _pm Proxy req = do
197− (_hdrs, a) :: ([H.Header], a) <- runRequest (Proxy :: Proxy ct) method req
205+ response <- runRequest req
206+ { requestAccept = fromList $ toList accept
207+ , requestMethod = method
208+ }
209+ case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
210+ Left err -> throwError $ DecodeFailure (pack err) response
198− return a
211+ Right val -> return val
199 where method = reflectMethod (Proxy :: Proxy method)
212 where method = reflectMethod (Proxy :: Proxy method)
213+ accept = contentTypes (Proxy :: Proxy ct)
200
214
201instance OVERLAPPING_
215instance OVERLAPPING_
202− ( RunClient m NoContent [HTTP.Header]
216+ ( RunClient m, ReflectMethod method
203− , ReflectMethod method) => HasClient m (Verb method status cts NoContent) where
217+ ) => HasClient m (Verb method status cts NoContent) where
204 type Client m (Verb method status cts NoContent)
218 type Client m (Verb method status cts NoContent)
205 = m NoContent
219 = m NoContent
206 clientWithRoute _pm Proxy req = do
220 clientWithRoute _pm Proxy req = do
207− _hdrs :: [H.Header] <- runRequest (Proxy :: Proxy NoContent) method req
221+ _response <- runRequest req { requestMethod = method }
208 return NoContent
222 return NoContent
209 where method = reflectMethod (Proxy :: Proxy method)
223 where method = reflectMethod (Proxy :: Proxy method)
210
224
211instance OVERLAPPING_
225instance OVERLAPPING_
212 -- Note [Non-Empty Content Types]
226 -- Note [Non-Empty Content Types]
213− ( RunClient m ct ([H.Header], a)
227+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
214− , MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
228+ , ReflectMethod method, cts' ~ (ct ': cts)
215 ) => HasClient m (Verb method status cts' (Headers ls a)) where
229 ) => HasClient m (Verb method status cts' (Headers ls a)) where
216 type Client m (Verb method status cts' (Headers ls a))
230 type Client m (Verb method status cts' (Headers ls a))
217 = m (Headers ls a)
231 = m (Headers ls a)
218 clientWithRoute _pm Proxy req = do
232 clientWithRoute _pm Proxy req = do
219− let method = reflectMethod (Proxy :: Proxy method)
220− (hdrs, resp) <- runRequest (Proxy :: Proxy ct) method req
233+ response <- runRequest req
234+ { requestMethod = method
235+ , requestAccept = fromList $ toList accept
236+ }
237+ case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
238+ Left err -> throwError $ DecodeFailure (pack err) response
221− return $ Headers { getResponse = resp
239+ Right val -> return $ Headers
240+ { getResponse = val
222− , getHeadersHList = buildHeadersTo hdrs
241+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
223− }
242+ }
243+ where method = reflectMethod (Proxy :: Proxy method)
244+ accept = contentTypes (Proxy :: Proxy ct)
224
245
225instance OVERLAPPING_
246instance OVERLAPPING_
226− ( RunClient m NoContent [H.Header]
227− , BuildHeadersTo ls, ReflectMethod method
247+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method
228 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
248 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
229 type Client m (Verb method status cts (Headers ls NoContent))
249 type Client m (Verb method status cts (Headers ls NoContent))
230 = m (Headers ls NoContent)
250 = m (Headers ls NoContent)
231 clientWithRoute _pm Proxy req = do
251 clientWithRoute _pm Proxy req = do
232 let method = reflectMethod (Proxy :: Proxy method)
252 let method = reflectMethod (Proxy :: Proxy method)
233− hdrs <- runRequest (Proxy :: Proxy NoContent) method req
253+ response <- runRequest req { requestMethod = method }
234 return $ Headers { getResponse = NoContent
254 return $ Headers { getResponse = NoContent
235− , getHeadersHList = buildHeadersTo hdrs
255+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
236 }
256 }
237
257
238
258
@@ -270,11 +290,11 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
270 clientWithRoute pm Proxy req mval =
290 clientWithRoute pm Proxy req mval =
271 clientWithRoute pm (Proxy :: Proxy api)
291 clientWithRoute pm (Proxy :: Proxy api)
272 (maybe req
292 (maybe req
273− (\value -> Servant.Common.Req.addHeader hname value req)
293+ (\value -> addHeader hname value req)
274 mval
294 mval
275 )
295 )
276
296
277− where hname = symbolVal (Proxy :: Proxy sym)
297+ where hname = fromString $ symbolVal (Proxy :: Proxy sym)
278
298
279-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
299-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
280-- functions.
300-- functions.
@@ -338,8 +358,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
338 mparamText
358 mparamText
339 )
359 )
340
360
341− where pname = cs pname'
342− pname' = symbolVal (Proxy :: Proxy sym)
361+ where pname = pack $ symbolVal (Proxy :: Proxy sym)
343 mparamText = fmap toQueryParam mparam
362 mparamText = fmap toQueryParam mparam
344
363
345-- | If you use a 'QueryParams' in one of your endpoints in your API,
364-- | If you use a 'QueryParams' in one of your endpoints in your API,
@@ -382,8 +401,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
382 paramlist'
401 paramlist'
383 )
402 )
384
403
385− where pname = cs pname'
386− pname' = symbolVal (Proxy :: Proxy sym)
404+ where pname = pack $ symbolVal (Proxy :: Proxy sym)
387 paramlist' = map (Just . toQueryParam) paramlist
405 paramlist' = map (Just . toQueryParam) paramlist
388
406
389-- | If you use a 'QueryFlag' in one of your endpoints in your API,
407-- | If you use a 'QueryFlag' in one of your endpoints in your API,
@@ -420,19 +438,18 @@ instance (KnownSymbol sym, HasClient m api)
420 else req
438 else req
421 )
439 )
422
440
423− where paramname = cs $ symbolVal (Proxy :: Proxy sym)
441+ where paramname = pack $ symbolVal (Proxy :: Proxy sym)
424
442
425
443
426-- | Pick a 'Method' and specify where the server you want to query is. You get
444-- | Pick a 'Method' and specify where the server you want to query is. You get
427-- back the full `Response`.
445-- back the full `Response`.
428−instance (RunClient m NoContent (Int, ByteString, MediaType, [HTTP.Header], Response ByteString))
429− => HasClient m Raw where
446+instance RunClient m => HasClient m Raw where
430 type Client m Raw
447 type Client m Raw
431− = H.Method -> m (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
448+ = H.Method -> m Response
432
449
433− clientWithRoute :: Proxy m -> Proxy Raw -> Req -> Client m Raw
450+ clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw
434 clientWithRoute _pm Proxy req httpMethod = do
451 clientWithRoute _pm Proxy req httpMethod = do
435− runRequest (Proxy :: Proxy NoContent) httpMethod req
452+ runRequest req { requestMethod = httpMethod }
436
453
437-- | If you use a 'ReqBody' in one of your endpoints in your API,
454-- | If you use a 'ReqBody' in one of your endpoints in your API,
438-- the corresponding querying function will automatically take
455-- the corresponding querying function will automatically take
@@ -461,10 +478,10 @@ instance (MimeRender ct a, HasClient m api)
461 clientWithRoute pm Proxy req body =
478 clientWithRoute pm Proxy req body =
462 clientWithRoute pm (Proxy :: Proxy api)
479 clientWithRoute pm (Proxy :: Proxy api)
463 (let ctProxy = Proxy :: Proxy ct
480 (let ctProxy = Proxy :: Proxy ct
464− in setReqBodyLBS (mimeRender ctProxy body)
481+ in setRequestBodyLBS (mimeRender ctProxy body)
465− -- We use first contentType from the Accept list
482+ -- We use first contentType from the Accept list
466− (contentType ctProxy)
483+ (contentType ctProxy)
467− req
484+ req
468 )
485 )
469
486
470-- | Make the querying function append @path@ to the request path.
487-- | Make the querying function append @path@ to the request path.
@@ -475,7 +492,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
475 clientWithRoute pm (Proxy :: Proxy api)
492 clientWithRoute pm (Proxy :: Proxy api)
476 (appendToPath p req)
493 (appendToPath p req)
477
494
478− where p = symbolVal (Proxy :: Proxy path)
495+ where p = pack $ symbolVal (Proxy :: Proxy path)
479
496
480instance HasClient m api => HasClient m (Vault :> api) where
497instance HasClient m api => HasClient m (Vault :> api) where
481 type Client m (Vault :> api) = Client m api
498 type Client m (Vault :> api) = Client m api
servant-client-core/src/Servant/Client/Core/Internal/BasicAuth.hs+7−7
@@ -1,16 +1,16 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE TypeSynonymInstances #-}
3−{-# LANGUAGE TypeFamilies #-}
4
4
5-- | Basic Authentication for clients
5-- | Basic Authentication for clients
6
6
7module Servant.Client.Core.Internal.BasicAuth where
7module Servant.Client.Core.Internal.BasicAuth where
8
8
9−import Data.ByteString.Base64 (encode)
9+import Data.ByteString.Base64 (encode)
10−import Data.Monoid ((<>))
10+import Data.Monoid ((<>))
11−import Data.Text.Encoding (decodeUtf8)
11+import Data.Text.Encoding (decodeUtf8)
12+import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
12−import Servant.Client.Core.Internal.Request (addHeader, Request)
13+import Servant.Client.Core.Internal.Request (Request, addHeader)
13−import Servant.API.BasicAuth (BasicAuthData(BasicAuthData))
14
14
15-- | Authenticate a request using Basic Authentication
15-- | Authenticate a request using Basic Authentication
16basicAuthReq :: BasicAuthData -> Request -> Request
16basicAuthReq :: BasicAuthData -> Request -> Request
servant-client-core/src/Servant/Client/Core/Internal/Class.hs+6−8
@@ -1,13 +1,11 @@
1+{-# LANGUAGE FlexibleContexts #-}
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
2{-| Types for possible backends to run client-side `Request` queries -}
3{-| Types for possible backends to run client-side `Request` queries -}
3module Servant.Client.Core.Internal.Class where
4module Servant.Client.Core.Internal.Class where
4
5
5−import Data.Proxy
6+import Control.Monad.Error.Class (MonadError)
6−import Network.HTTP.Types
7−import Servant.Client.Core.Internal.Request (Request, Response)
7+import Servant.Client.Core.Internal.Request (Request, Response,
8+ ServantError)
8
9
9−class (Monad m) => RunClient m ct where
10+class (MonadError ServantError m) => RunClient m where
10− runRequest :: Proxy ct
11− -> Method
12− -> Request
13− -> m Response
11+ runRequest :: Request -> m Response
servant-client-core/src/Servant/Client/Core/Internal/Request.hs+12−7
@@ -17,11 +17,13 @@ import qualified Data.ByteString.Lazy as LBS
17import Data.Semigroup ((<>))
17import Data.Semigroup ((<>))
18import qualified Data.Sequence as Seq
18import qualified Data.Sequence as Seq
19import Data.Text (Text)
19import Data.Text (Text)
20+import Data.Text.Encoding (encodeUtf8)
20import Data.Typeable (Typeable)
21import Data.Typeable (Typeable)
21import GHC.Generics (Generic)
22import GHC.Generics (Generic)
22import Network.HTTP.Media (MediaType)
23import Network.HTTP.Media (MediaType)
23import Network.HTTP.Types (Header, HeaderName, HttpVersion,
24import Network.HTTP.Types (Header, HeaderName, HttpVersion,
24− QueryItem, Status, http11)
25+ Method, QueryItem, Status, http11,
26+ methodGet)
25import Web.HttpApiData (ToHttpApiData, toEncodedUrlPiece,
27import Web.HttpApiData (ToHttpApiData, toEncodedUrlPiece,
26 toHeader)
28 toHeader)
27
29
@@ -40,6 +42,7 @@ data Request = Request
40 , requestAccept :: Seq.Seq MediaType
42 , requestAccept :: Seq.Seq MediaType
41 , requestHeaders :: Seq.Seq Header
43 , requestHeaders :: Seq.Seq Header
42 , requestHttpVersion :: HttpVersion
44 , requestHttpVersion :: HttpVersion
45+ , requestMethod :: Method
43 } deriving (Generic, Typeable)
46 } deriving (Generic, Typeable)
44
47
45newtype RequestBody = RequestBodyLBS LBS.ByteString
48newtype RequestBody = RequestBodyLBS LBS.ByteString
@@ -60,18 +63,20 @@ defaultRequest = Request
60 , requestAccept = Seq.empty
63 , requestAccept = Seq.empty
61 , requestHeaders = Seq.empty
64 , requestHeaders = Seq.empty
62 , requestHttpVersion = http11
65 , requestHttpVersion = http11
66+ , requestMethod = methodGet
63 }
67 }
64
68
65appendToPath :: Text -> Request -> Request
69appendToPath :: Text -> Request -> Request
66appendToPath p req
70appendToPath p req
67 = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
71 = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
68
72
69−{-appendToQueryString :: Text -- ^ param name-}
73+appendToQueryString :: Text -- ^ param name
70− {--> Maybe Text -- ^ param value-}
74+ -> Maybe Text -- ^ param value
71− {--> Request-}
75+ -> Request
72− {--> Request-}
76+ -> Request
73−{-appendToQueryString pname pvalue req-}
77+appendToQueryString pname pvalue req
74− {-= req { requestQueryString = requestQueryString req Seq.|> (pname, pvalue)}-}
78+ = req { requestQueryString = requestQueryString req
79+ Seq.|> (encodeUtf8 pname, encodeUtf8 <$> pvalue)}
75
80
76addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
81addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
77addHeader name val req
82addHeader name val req
servant-client/servant-client.cabal−1
@@ -49,7 +49,6 @@ library
49 , transformers >= 0.3 && < 0.6
49 , transformers >= 0.3 && < 0.6
50 , transformers-base >= 0.4.4 && < 0.5
50 , transformers-base >= 0.4.4 && < 0.5
51 , transformers-compat >= 0.4 && < 0.6
51 , transformers-compat >= 0.4 && < 0.6
52− , mtl
53 if !impl(ghc >= 8.0)
52 if !impl(ghc >= 8.0)
54 build-depends:
53 build-depends:
55 semigroups >=0.16.2.2 && <0.19
54 semigroups >=0.16.2.2 && <0.19