git.iko.soy/typeable/servant
on master help sign in
Merge pull request #803 from haskell-servant/pr800
28fe7a0Julian Arni
doc/tutorial/Client.lhs+4−4
compare with master
unifiedsplit
@@ -128,15 +128,15 @@ That's it. Let's now write some code that uses our client functions.
128``` haskell
128``` haskell
129queries :: ClientM (Position, HelloMessage, Email)
129queries :: ClientM (Position, HelloMessage, Email)
130queries = do
130queries = do
131− pos <- position 10 10
131+ pos <- position 10 10
132− message <- hello (Just "servant")
132+ message <- hello (Just "servant")
133 em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])
133 em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])
134 return (pos, message, em)
134 return (pos, message, em)
135
135
136run :: IO ()
136run :: IO ()
137run = do
137run = do
138− manager <- newManager defaultManagerSettings
138+ manager' <- newManager defaultManagerSettings
139− res <- runClientM queries (ClientEnv manager (BaseUrl Http "localhost" 8081 ""))
139+ res <- runClientM queries (ClientEnv manager' (BaseUrl Http "localhost" 8081 ""))
140 case res of
140 case res of
141 Left err -> putStrLn $ "Error: " ++ show err
141 Left err -> putStrLn $ "Error: " ++ show err
142 Right (pos, message, em) -> do
142 Right (pos, message, em) -> do
servant-client-core/CHANGELOG.mdnew file+6
@@ -0,0 +1,6 @@
1+# Revision history for servant-client-core
2+
3+## 0.12 -- YYYY-mm-dd
4+
5+* First version. Factored out of servant-client all the functionality that was
6+independent of the http-client backend.
servant-client-core/LICENSEnew file+30
@@ -0,0 +1,30 @@
1+Copyright (c) 2017, Servant Contributors
2+
3+All rights reserved.
4+
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
7+
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
10+
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Servant Contributors nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
servant-client-core/README.mdnew file+30
@@ -0,0 +1,30 @@
1+# servant-client-core
2+
3+![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
4+
5+HTTP-client-agnostic client functions for servant APIs.
6+
7+This library should mainly be of interest to backend- and combinator-writers.
8+
9+## For backend-writers
10+
11+If you are creating a new backend, you'll need to:
12+
13+1. Define a `RunClient` instance for your datatype (call it `MyMonad`)
14+2. Define a `ClientLike` instance. This will look like:
15+
16+``` haskell
17+instance ClientLike (MyMonad a) (MyMonad a) where
18+ mkClient = id
19+```
20+
21+3. Re-export the module Servant.Client.Core.Reexport so that your end-users
22+ can be blissfully unaware of 'servant-client-core', and so each
23+ backend-package comes closer to the warm hearth of the drop-in-replacement
24+ equivalence class.
25+
26+## For combinator-writers
27+
28+You'll need to define a new `HasClient` instance for your combinator. There are
29+plenty of examples to guide you in the
30+[HasClient](src/Servant/Client/Core/Internal/HasClient.hs) module.
servant-client-core/Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
servant-client-core/include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3+#define OVERLAPPING_ {-# OVERLAPPING #-}
4+#else
5+{-# LANGUAGE OverlappingInstances #-}
6+#define OVERLAPPABLE_
7+#define OVERLAPPING_
8+#endif
servant-client-core/servant-client-core.cabalnew file+74
@@ -0,0 +1,74 @@
1+name: servant-client-core
2+version: 0.11
3+synopsis: Core functionality and class for client function generation for servant APIs
4+description:
5+ This library provides backend-agnostic generation of client functions. For
6+ more information, see the README.
7+license: BSD3
8+license-file: LICENSE
9+author: Servant Contributors
10+maintainer: haskell-servant-maintainers@googlegroups.com
11+homepage: http://haskell-servant.readthedocs.org/
12+bug-reports: http://github.com/haskell-servant/servant/issues
13+cabal-version: >=1.10
14+copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2017 Servant Contributors
15+category: Web
16+build-type: Simple
17+extra-source-files:
18+ include/*.h
19+ CHANGELOG.md
20+ README.md
21+source-repository head
22+ type: git
23+ location: http://github.com/haskell-servant/servant.git
24+
25+library
26+ exposed-modules:
27+ Servant.Client.Core
28+ Servant.Client.Core.Reexport
29+ Servant.Client.Core.Internal.Auth
30+ Servant.Client.Core.Internal.BaseUrl
31+ Servant.Client.Core.Internal.BasicAuth
32+ Servant.Client.Core.Internal.Generic
33+ Servant.Client.Core.Internal.HasClient
34+ Servant.Client.Core.Internal.Request
35+ Servant.Client.Core.Internal.RunClient
36+ build-depends:
37+ base >= 4.7 && < 4.11
38+ , base-compat >= 0.9.1 && < 0.10
39+ , base64-bytestring >= 1.0.0.1 && < 1.1
40+ , bytestring >= 0.10 && < 0.11
41+ , containers >= 0.5 && < 0.6
42+ , exceptions >= 0.8 && < 0.9
43+ , generics-sop >= 0.1.0.0 && < 0.4
44+ , http-api-data >= 0.3.6 && < 0.4
45+ , http-media >= 0.6.2 && < 0.8
46+ , http-types >= 0.8.6 && < 0.10
47+ , mtl >= 2.1 && < 2.3
48+ , network-uri >= 2.6 && < 2.7
49+ , safe >= 0.3.9 && < 0.4
50+ , servant == 0.11.*
51+ , text >= 1.2 && < 1.3
52+ if !impl(ghc >= 8.0)
53+ build-depends:
54+ semigroups >=0.16.2.2 && <0.19
55+ hs-source-dirs: src
56+ default-language: Haskell2010
57+ ghc-options: -Wall
58+ include-dirs: include
59+
60+test-suite spec
61+ type: exitcode-stdio-1.0
62+ ghc-options: -Wall
63+ default-language: Haskell2010
64+ hs-source-dirs: test
65+ main-is: Spec.hs
66+ build-depends:
67+ base
68+ , base-compat
69+ , deepseq
70+ , servant-client-core
71+ , hspec == 2.*
72+ , QuickCheck >= 2.7 && < 2.11
73+ other-modules:
74+ Servant.Client.Core.Internal.BaseUrlSpec
servant-client-core/src/Servant/Client/Core.hsnew file+65
@@ -0,0 +1,65 @@
1+-- | This module provides backend-agnostic functionality for generating clients
2+-- from @servant@ APIs. By "backend," we mean something that concretely
3+-- executes the request, such as:
4+--
5+-- * The @http-client@ library
6+-- * The @haxl@ library
7+-- * GHCJS via FFI
8+--
9+-- etc.
10+--
11+-- Each backend is encapsulated in a monad that is an instance of the
12+-- 'RunClient' class.
13+--
14+-- This library is primarily of interest to backend-writers and
15+-- combinator-writers. For more information, see the README.md
16+module Servant.Client.Core
17+ (
18+ -- * Client generation
19+ clientIn
20+ , HasClient(..)
21+
22+ -- * Request
23+ , Request
24+ , RequestF(..)
25+ , defaultRequest
26+ , RequestBody(..)
27+
28+ -- * Authentication
29+ , mkAuthenticatedRequest
30+ , basicAuthReq
31+ , AuthenticatedRequest(..)
32+ , AuthClientData
33+
34+ -- * Generic Client
35+ , ClientLike(..)
36+ , genericMkClientL
37+ , genericMkClientP
38+ , ServantError(..)
39+ , EmptyClient(..)
40+
41+
42+ -- * Response
43+ , Response(..)
44+ , RunClient(..)
45+ , module Servant.Client.Core.Internal.BaseUrl
46+
47+ -- * Writing HasClient instances
48+ -- | These functions need not be re-exported by backend libraries.
49+ , addHeader
50+ , appendToQueryString
51+ , appendToPath
52+ , setRequestBodyLBS
53+ , setRequestBody
54+ ) where
55+import Servant.Client.Core.Internal.Auth
56+import Servant.Client.Core.Internal.BaseUrl (BaseUrl (..),
57+ InvalidBaseUrlException,
58+ Scheme (..),
59+ parseBaseUrl,
60+ showBaseUrl)
61+import Servant.Client.Core.Internal.BasicAuth
62+import Servant.Client.Core.Internal.HasClient
63+import Servant.Client.Core.Internal.Generic
64+import Servant.Client.Core.Internal.Request
65+import Servant.Client.Core.Internal.RunClient
servant-client/src/Servant/Client/Experimental/Auth.hs → servant-client-core/src/Servant/Client/Core/Internal/Auth.hsrenamed+10−14
@@ -1,16 +1,12 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE TypeSynonymInstances #-}
3−{-# LANGUAGE TypeFamilies #-}
4
4
5-- | Authentication for clients
5-- | Authentication for clients
6
6
7−module Servant.Client.Experimental.Auth (
7+module Servant.Client.Core.Internal.Auth where
8− AuthenticateReq(AuthenticateReq, unAuthReq)
9− , AuthClientData
10− , mkAuthenticateReq
11− ) where
12
8
13−import Servant.Common.Req (Req)
9+import Servant.Client.Core.Internal.Request (Request)
14
10
15-- | For a resource protected by authentication (e.g. AuthProtect), we need
11-- | For a resource protected by authentication (e.g. AuthProtect), we need
16-- to provide the client with some data used to add authentication data
12-- to provide the client with some data used to add authentication data
@@ -24,13 +20,13 @@ type family AuthClientData a :: *
24-- data to a request
20-- data to a request
25--
21--
26-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
22-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
27−newtype AuthenticateReq a =
23+newtype AuthenticatedRequest a =
28− AuthenticateReq { unAuthReq :: (AuthClientData a, AuthClientData a -> Req -> Req) }
24+ AuthenticatedRequest { unAuthReq :: (AuthClientData a, AuthClientData a -> Request -> Request) }
29
25
30-- | Handy helper to avoid wrapping datatypes in tuples everywhere.
26-- | Handy helper to avoid wrapping datatypes in tuples everywhere.
31--
27--
32-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
28-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
33−mkAuthenticateReq :: AuthClientData a
29+mkAuthenticatedRequest :: AuthClientData a
34− -> (AuthClientData a -> Req -> Req)
30+ -> (AuthClientData a -> Request -> Request)
35− -> AuthenticateReq a
31+ -> AuthenticatedRequest a
36−mkAuthenticateReq val func = AuthenticateReq (val, func)
32+mkAuthenticatedRequest val func = AuthenticatedRequest (val, func)
servant-client/src/Servant/Common/BaseUrl.hs → servant-client-core/src/Servant/Client/Core/Internal/BaseUrl.hsrenamed+2−10
@@ -1,21 +1,13 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE ViewPatterns #-}
3{-# LANGUAGE ViewPatterns #-}
4−module Servant.Common.BaseUrl (
4+module Servant.Client.Core.Internal.BaseUrl where
5− -- * types
6− BaseUrl (..)
7− , InvalidBaseUrlException
8− , Scheme (..)
9− -- * functions
10− , parseBaseUrl
11− , showBaseUrl
12−) where
13
5
14import Control.Monad.Catch (Exception, MonadThrow, throwM)
6import Control.Monad.Catch (Exception, MonadThrow, throwM)
15import Data.List
7import Data.List
16import Data.Typeable
8import Data.Typeable
17import GHC.Generics
9import GHC.Generics
18−import Network.URI hiding (path)
10+import Network.URI hiding (path)
19import Safe
11import Safe
20import Text.Read
12import Text.Read
21
13
servant-client-core/src/Servant/Client/Core/Internal/BasicAuth.hsnew file+19
@@ -0,0 +1,19 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE TypeSynonymInstances #-}
4+
5+-- | Basic Authentication for clients
6+
7+module Servant.Client.Core.Internal.BasicAuth where
8+
9+import Data.ByteString.Base64 (encode)
10+import Data.Monoid ((<>))
11+import Data.Text.Encoding (decodeUtf8)
12+import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
13+import Servant.Client.Core.Internal.Request (Request, addHeader)
14+
15+-- | Authenticate a request using Basic Authentication
16+basicAuthReq :: BasicAuthData -> Request -> Request
17+basicAuthReq (BasicAuthData user pass) req =
18+ let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass))
19+ in addHeader "Authorization" authText req
servant-client/src/Servant/Client/Generic.hs → servant-client-core/src/Servant/Client/Core/Internal/Generic.hsrenamed+1−9
@@ -10,15 +10,10 @@
10
10
11#include "overlapping-compat.h"
11#include "overlapping-compat.h"
12
12
13−module Servant.Client.Generic
13+module Servant.Client.Core.Internal.Generic where
14− ( ClientLike(..)
15− , genericMkClientL
16− , genericMkClientP
17− ) where
18
14
19import Generics.SOP (Code, Generic, I(..), NP(..), NS(Z), SOP(..), to)
15import Generics.SOP (Code, Generic, I(..), NP(..), NS(Z), SOP(..), to)
20import Servant.API ((:<|>)(..))
16import Servant.API ((:<|>)(..))
21−import Servant.Client (ClientM)
22
17
23-- | This class allows us to match client structure with client functions
18-- | This class allows us to match client structure with client functions
24-- produced with 'client' without explicit pattern-matching.
19-- produced with 'client' without explicit pattern-matching.
@@ -111,9 +106,6 @@ instance ClientLike client custom
111 => ClientLike (a -> client) (a -> custom) where
106 => ClientLike (a -> client) (a -> custom) where
112 mkClient c = mkClient . c
107 mkClient c = mkClient . c
113
108
114−instance ClientLike (ClientM a) (ClientM a) where
115− mkClient = id
116−
117-- | Match client structure with client functions, regarding left-nested API clients
109-- | Match client structure with client functions, regarding left-nested API clients
118-- as separate data structures.
110-- as separate data structures.
119class GClientLikeP client xs where
111class GClientLikeP client xs where
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hsnew file+541
@@ -0,0 +1,541 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE InstanceSigs #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TypeFamilies #-}
11+{-# LANGUAGE TypeOperators #-}
12+{-# LANGUAGE UndecidableInstances #-}
13+
14+#include "overlapping-compat.h"
15+module Servant.Client.Core.Internal.HasClient where
16+
17+import Prelude ()
18+import Prelude.Compat
19+
20+import Data.Foldable (toList)
21+import Data.List (foldl')
22+import Data.Proxy (Proxy (Proxy))
23+import Data.Sequence (fromList)
24+import Data.String (fromString)
25+import Data.Text (pack)
26+import GHC.TypeLits (KnownSymbol, symbolVal)
27+import qualified Network.HTTP.Types as H
28+import Servant.API ((:<|>) ((:<|>)), (:>),
29+ AuthProtect, BasicAuth,
30+ BasicAuthData,
31+ BuildHeadersTo (..),
32+ Capture, CaptureAll,
33+ Description, EmptyAPI,
34+ Header, Headers (..),
35+ HttpVersion, IsSecure,
36+ MimeRender (mimeRender),
37+ MimeUnrender (mimeUnrender),
38+ NoContent (NoContent),
39+ QueryFlag, QueryParam,
40+ QueryParams, Raw,
41+ ReflectMethod (..),
42+ RemoteHost, ReqBody,
43+ Summary, ToHttpApiData,
44+ Vault, Verb,
45+ WithNamedContext,
46+ contentType,
47+ getHeadersHList,
48+ getResponse,
49+ toQueryParam,
50+ toUrlPiece)
51+import Servant.API.ContentTypes (contentTypes)
52+
53+import Servant.Client.Core.Internal.Auth
54+import Servant.Client.Core.Internal.BasicAuth
55+import Servant.Client.Core.Internal.Request
56+import Servant.Client.Core.Internal.RunClient
57+
58+-- * Accessing APIs as a Client
59+
60+-- | 'clientIn' allows you to produce operations to query an API from a client
61+-- within a 'RunClient' monad.
62+--
63+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
64+-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books
65+-- >
66+-- > myApi :: Proxy MyApi
67+-- > myApi = Proxy
68+-- >
69+-- > clientM :: Proxy ClientM
70+-- > clientM = Proxy
71+-- >
72+-- > getAllBooks :: ClientM [Book]
73+-- > postNewBook :: Book -> ClientM Book
74+-- > (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM
75+clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api
76+clientIn p pm = clientWithRoute pm p defaultRequest
77+
78+
79+-- | This class lets us define how each API combinator influences the creation
80+-- of an HTTP request.
81+--
82+-- Unless you are writing a new backend for @servant-client-core@ or new
83+-- combinators that you want to support client-generation, you can ignore this
84+-- class.
85+class RunClient m => HasClient m api where
86+ type Client (m :: * -> *) (api :: *) :: *
87+ clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api
88+
89+
90+-- | A client querying function for @a ':<|>' b@ will actually hand you
91+-- one function for querying @a@ and another one for querying @b@,
92+-- stitching them together with ':<|>', which really is just like a pair.
93+--
94+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
95+-- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
96+-- >
97+-- > myApi :: Proxy MyApi
98+-- > myApi = Proxy
99+-- >
100+-- > getAllBooks :: ClientM [Book]
101+-- > postNewBook :: Book -> ClientM Book
102+-- > (getAllBooks :<|> postNewBook) = client myApi
103+instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where
104+ type Client m (a :<|> b) = Client m a :<|> Client m b
105+ clientWithRoute pm Proxy req =
106+ clientWithRoute pm (Proxy :: Proxy a) req :<|>
107+ clientWithRoute pm (Proxy :: Proxy b) req
108+
109+-- | Singleton type representing a client for an empty API.
110+data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
111+
112+-- | The client for 'EmptyAPI' is simply 'EmptyClient'.
113+--
114+-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books
115+-- > :<|> "nothing" :> EmptyAPI
116+-- >
117+-- > myApi :: Proxy MyApi
118+-- > myApi = Proxy
119+-- >
120+-- > getAllBooks :: ClientM [Book]
121+-- > (getAllBooks :<|> EmptyClient) = client myApi
122+instance RunClient m => HasClient m EmptyAPI where
123+ type Client m EmptyAPI = EmptyClient
124+ clientWithRoute _pm Proxy _ = EmptyClient
125+
126+-- | If you use a 'Capture' in one of your endpoints in your API,
127+-- the corresponding querying function will automatically take
128+-- an additional argument of the type specified by your 'Capture'.
129+-- That function will take care of inserting a textual representation
130+-- of this value at the right place in the request path.
131+--
132+-- You can control how values for this type are turned into
133+-- text by specifying a 'ToHttpApiData' instance for your type.
134+--
135+-- Example:
136+--
137+-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
138+-- >
139+-- > myApi :: Proxy MyApi
140+-- > myApi = Proxy
141+-- >
142+-- > getBook :: Text -> ClientM Book
143+-- > getBook = client myApi
144+-- > -- then you can just use "getBook" to query that endpoint
145+instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
146+ => HasClient m (Capture capture a :> api) where
147+
148+ type Client m (Capture capture a :> api) =
149+ a -> Client m api
150+
151+ clientWithRoute pm Proxy req val =
152+ clientWithRoute pm (Proxy :: Proxy api)
153+ (appendToPath p req)
154+
155+ where p = (toUrlPiece val)
156+
157+-- | If you use a 'CaptureAll' in one of your endpoints in your API,
158+-- the corresponding querying function will automatically take an
159+-- additional argument of a list of the type specified by your
160+-- 'CaptureAll'. That function will take care of inserting a textual
161+-- representation of this value at the right place in the request
162+-- path.
163+--
164+-- You can control how these values are turned into text by specifying
165+-- a 'ToHttpApiData' instance of your type.
166+--
167+-- Example:
168+--
169+-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile
170+-- >
171+-- > myApi :: Proxy
172+-- > myApi = Proxy
173+--
174+-- > getSourceFile :: [Text] -> ClientM SourceFile
175+-- > getSourceFile = client myApi
176+-- > -- then you can use "getSourceFile" to query that endpoint
177+instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
178+ => HasClient m (CaptureAll capture a :> sublayout) where
179+
180+ type Client m (CaptureAll capture a :> sublayout) =
181+ [a] -> Client m sublayout
182+
183+ clientWithRoute pm Proxy req vals =
184+ clientWithRoute pm (Proxy :: Proxy sublayout)
185+ (foldl' (flip appendToPath) req ps)
186+
187+ where ps = map (toUrlPiece) vals
188+
189+instance OVERLAPPABLE_
190+ -- Note [Non-Empty Content Types]
191+ ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
192+ ) => HasClient m (Verb method status cts' a) where
193+ type Client m (Verb method status cts' a) = m a
194+ clientWithRoute _pm Proxy req = do
195+ response <- runRequest req
196+ { requestAccept = fromList $ toList accept
197+ , requestMethod = method
198+ }
199+ response `decodedAs` (Proxy :: Proxy ct)
200+ where
201+ accept = contentTypes (Proxy :: Proxy ct)
202+ method = reflectMethod (Proxy :: Proxy method)
203+
204+instance OVERLAPPING_
205+ ( RunClient m, ReflectMethod method
206+ ) => HasClient m (Verb method status cts NoContent) where
207+ type Client m (Verb method status cts NoContent)
208+ = m NoContent
209+ clientWithRoute _pm Proxy req = do
210+ _response <- runRequest req { requestMethod = method }
211+ return NoContent
212+ where method = reflectMethod (Proxy :: Proxy method)
213+
214+instance OVERLAPPING_
215+ -- Note [Non-Empty Content Types]
216+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
217+ , ReflectMethod method, cts' ~ (ct ': cts)
218+ ) => HasClient m (Verb method status cts' (Headers ls a)) where
219+ type Client m (Verb method status cts' (Headers ls a))
220+ = m (Headers ls a)
221+ clientWithRoute _pm Proxy req = do
222+ response <- runRequest req
223+ { requestMethod = method
224+ , requestAccept = fromList $ toList accept
225+ }
226+ case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
227+ Left err -> throwServantError $ DecodeFailure (pack err) response
228+ Right val -> return $ Headers
229+ { getResponse = val
230+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
231+ }
232+ where method = reflectMethod (Proxy :: Proxy method)
233+ accept = contentTypes (Proxy :: Proxy ct)
234+
235+instance OVERLAPPING_
236+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method
237+ ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
238+ type Client m (Verb method status cts (Headers ls NoContent))
239+ = m (Headers ls NoContent)
240+ clientWithRoute _pm Proxy req = do
241+ let method = reflectMethod (Proxy :: Proxy method)
242+ response <- runRequest req { requestMethod = method }
243+ return $ Headers { getResponse = NoContent
244+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
245+ }
246+
247+
248+-- | If you use a 'Header' in one of your endpoints in your API,
249+-- the corresponding querying function will automatically take
250+-- an additional argument of the type specified by your 'Header',
251+-- wrapped in Maybe.
252+--
253+-- That function will take care of encoding this argument as Text
254+-- in the request headers.
255+--
256+-- All you need is for your type to have a 'ToHttpApiData' instance.
257+--
258+-- Example:
259+--
260+-- > newtype Referer = Referer { referrer :: Text }
261+-- > deriving (Eq, Show, Generic, ToHttpApiData)
262+-- >
263+-- > -- GET /view-my-referer
264+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
265+-- >
266+-- > myApi :: Proxy MyApi
267+-- > myApi = Proxy
268+-- >
269+-- > viewReferer :: Maybe Referer -> ClientM Book
270+-- > viewReferer = client myApi
271+-- > -- then you can just use "viewRefer" to query that endpoint
272+-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
273+instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
274+ => HasClient m (Header sym a :> api) where
275+
276+ type Client m (Header sym a :> api) =
277+ Maybe a -> Client m api
278+
279+ clientWithRoute pm Proxy req mval =
280+ clientWithRoute pm (Proxy :: Proxy api)
281+ (maybe req
282+ (\value -> addHeader hname value req)
283+ mval
284+ )
285+
286+ where hname = fromString $ symbolVal (Proxy :: Proxy sym)
287+
288+-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
289+-- functions.
290+instance HasClient m api
291+ => HasClient m (HttpVersion :> api) where
292+
293+ type Client m (HttpVersion :> api) =
294+ Client m api
295+
296+ clientWithRoute pm Proxy =
297+ clientWithRoute pm (Proxy :: Proxy api)
298+
299+-- | Ignore @'Summary'@ in client functions.
300+instance HasClient m api => HasClient m (Summary desc :> api) where
301+ type Client m (Summary desc :> api) = Client m api
302+
303+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
304+
305+-- | Ignore @'Description'@ in client functions.
306+instance HasClient m api => HasClient m (Description desc :> api) where
307+ type Client m (Description desc :> api) = Client m api
308+
309+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
310+
311+-- | If you use a 'QueryParam' in one of your endpoints in your API,
312+-- the corresponding querying function will automatically take
313+-- an additional argument of the type specified by your 'QueryParam',
314+-- enclosed in Maybe.
315+--
316+-- If you give Nothing, nothing will be added to the query string.
317+--
318+-- If you give a non-'Nothing' value, this function will take care
319+-- of inserting a textual representation of this value in the query string.
320+--
321+-- You can control how values for your type are turned into
322+-- text by specifying a 'ToHttpApiData' instance for your type.
323+--
324+-- Example:
325+--
326+-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
327+-- >
328+-- > myApi :: Proxy MyApi
329+-- > myApi = Proxy
330+-- >
331+-- > getBooksBy :: Maybe Text -> ClientM [Book]
332+-- > getBooksBy = client myApi
333+-- > -- then you can just use "getBooksBy" to query that endpoint.
334+-- > -- 'getBooksBy Nothing' for all books
335+-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
336+instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
337+ => HasClient m (QueryParam sym a :> api) where
338+
339+ type Client m (QueryParam sym a :> api) =
340+ Maybe a -> Client m api
341+
342+ -- if mparam = Nothing, we don't add it to the query string
343+ clientWithRoute pm Proxy req mparam =
344+ clientWithRoute pm (Proxy :: Proxy api)
345+ (maybe req
346+ (flip (appendToQueryString pname) req . Just)
347+ mparamText
348+ )
349+
350+ where pname = pack $ symbolVal (Proxy :: Proxy sym)
351+ mparamText = fmap toQueryParam mparam
352+
353+-- | If you use a 'QueryParams' in one of your endpoints in your API,
354+-- the corresponding querying function will automatically take
355+-- an additional argument, a list of values of the type specified
356+-- by your 'QueryParams'.
357+--
358+-- If you give an empty list, nothing will be added to the query string.
359+--
360+-- Otherwise, this function will take care
361+-- of inserting a textual representation of your values in the query string,
362+-- under the same query string parameter name.
363+--
364+-- You can control how values for your type are turned into
365+-- text by specifying a 'ToHttpApiData' instance for your type.
366+--
367+-- Example:
368+--
369+-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
370+-- >
371+-- > myApi :: Proxy MyApi
372+-- > myApi = Proxy
373+-- >
374+-- > getBooksBy :: [Text] -> ClientM [Book]
375+-- > getBooksBy = client myApi
376+-- > -- then you can just use "getBooksBy" to query that endpoint.
377+-- > -- 'getBooksBy []' for all books
378+-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
379+-- > -- to get all books by Asimov and Heinlein
380+instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
381+ => HasClient m (QueryParams sym a :> api) where
382+
383+ type Client m (QueryParams sym a :> api) =
384+ [a] -> Client m api
385+
386+ clientWithRoute pm Proxy req paramlist =
387+ clientWithRoute pm (Proxy :: Proxy api)
388+ (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
389+ req
390+ paramlist'
391+ )
392+
393+ where pname = pack $ symbolVal (Proxy :: Proxy sym)
394+ paramlist' = map (Just . toQueryParam) paramlist
395+
396+-- | If you use a 'QueryFlag' in one of your endpoints in your API,
397+-- the corresponding querying function will automatically take
398+-- an additional 'Bool' argument.
399+--
400+-- If you give 'False', nothing will be added to the query string.
401+--
402+-- Otherwise, this function will insert a value-less query string
403+-- parameter under the name associated to your 'QueryFlag'.
404+--
405+-- Example:
406+--
407+-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
408+-- >
409+-- > myApi :: Proxy MyApi
410+-- > myApi = Proxy
411+-- >
412+-- > getBooks :: Bool -> ClientM [Book]
413+-- > getBooks = client myApi
414+-- > -- then you can just use "getBooks" to query that endpoint.
415+-- > -- 'getBooksBy False' for all books
416+-- > -- 'getBooksBy True' to only get _already published_ books
417+instance (KnownSymbol sym, HasClient m api)
418+ => HasClient m (QueryFlag sym :> api) where
419+
420+ type Client m (QueryFlag sym :> api) =
421+ Bool -> Client m api
422+
423+ clientWithRoute pm Proxy req flag =
424+ clientWithRoute pm (Proxy :: Proxy api)
425+ (if flag
426+ then appendToQueryString paramname Nothing req
427+ else req
428+ )
429+
430+ where paramname = pack $ symbolVal (Proxy :: Proxy sym)
431+
432+
433+-- | Pick a 'Method' and specify where the server you want to query is. You get
434+-- back the full `Response`.
435+instance RunClient m => HasClient m Raw where
436+ type Client m Raw
437+ = H.Method -> m Response
438+
439+ clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw
440+ clientWithRoute _pm Proxy req httpMethod = do
441+ runRequest req { requestMethod = httpMethod }
442+
443+-- | If you use a 'ReqBody' in one of your endpoints in your API,
444+-- the corresponding querying function will automatically take
445+-- an additional argument of the type specified by your 'ReqBody'.
446+-- That function will take care of encoding this argument as JSON and
447+-- of using it as the request body.
448+--
449+-- All you need is for your type to have a 'ToJSON' instance.
450+--
451+-- Example:
452+--
453+-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
454+-- >
455+-- > myApi :: Proxy MyApi
456+-- > myApi = Proxy
457+-- >
458+-- > addBook :: Book -> ClientM Book
459+-- > addBook = client myApi
460+-- > -- then you can just use "addBook" to query that endpoint
461+instance (MimeRender ct a, HasClient m api)
462+ => HasClient m (ReqBody (ct ': cts) a :> api) where
463+
464+ type Client m (ReqBody (ct ': cts) a :> api) =
465+ a -> Client m api
466+
467+ clientWithRoute pm Proxy req body =
468+ clientWithRoute pm (Proxy :: Proxy api)
469+ (let ctProxy = Proxy :: Proxy ct
470+ in setRequestBodyLBS (mimeRender ctProxy body)
471+ -- We use first contentType from the Accept list
472+ (contentType ctProxy)
473+ req
474+ )
475+
476+-- | Make the querying function append @path@ to the request path.
477+instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
478+ type Client m (path :> api) = Client m api
479+
480+ clientWithRoute pm Proxy req =
481+ clientWithRoute pm (Proxy :: Proxy api)
482+ (appendToPath p req)
483+
484+ where p = pack $ symbolVal (Proxy :: Proxy path)
485+
486+instance HasClient m api => HasClient m (Vault :> api) where
487+ type Client m (Vault :> api) = Client m api
488+
489+ clientWithRoute pm Proxy req =
490+ clientWithRoute pm (Proxy :: Proxy api) req
491+
492+instance HasClient m api => HasClient m (RemoteHost :> api) where
493+ type Client m (RemoteHost :> api) = Client m api
494+
495+ clientWithRoute pm Proxy req =
496+ clientWithRoute pm (Proxy :: Proxy api) req
497+
498+instance HasClient m api => HasClient m (IsSecure :> api) where
499+ type Client m (IsSecure :> api) = Client m api
500+
501+ clientWithRoute pm Proxy req =
502+ clientWithRoute pm (Proxy :: Proxy api) req
503+
504+instance HasClient m subapi =>
505+ HasClient m (WithNamedContext name context subapi) where
506+
507+ type Client m (WithNamedContext name context subapi) = Client m subapi
508+ clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
509+
510+instance ( HasClient m api
511+ ) => HasClient m (AuthProtect tag :> api) where
512+ type Client m (AuthProtect tag :> api)
513+ = AuthenticatedRequest (AuthProtect tag) -> Client m api
514+
515+ clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) =
516+ clientWithRoute pm (Proxy :: Proxy api) (func val req)
517+
518+-- * Basic Authentication
519+
520+instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
521+ type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api
522+
523+ clientWithRoute pm Proxy req val =
524+ clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)
525+
526+
527+{- Note [Non-Empty Content Types]
528+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
529+Rather than have
530+
531+ instance (..., cts' ~ (ct ': cts)) => ... cts' ...
532+
533+It may seem to make more sense to have:
534+
535+ instance (...) => ... (ct ': cts) ...
536+
537+But this means that if another instance exists that does *not* require
538+non-empty lists, but is otherwise more specific, no instance will be overall
539+more specific. This in turn generally means adding yet another instance (one
540+for empty and one for non-empty lists).
541+-}
servant-client-core/src/Servant/Client/Core/Internal/Request.hsnew file+117
@@ -0,0 +1,117 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveFunctor #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE ScopedTypeVariables #-}
9+{-# LANGUAGE TypeFamilies #-}
10+
11+module Servant.Client.Core.Internal.Request where
12+
13+import Prelude ()
14+import Prelude.Compat
15+
16+import Control.Monad.Catch (Exception)
17+import qualified Data.ByteString.Builder as Builder
18+import qualified Data.ByteString.Lazy as LBS
19+import Data.Semigroup ((<>))
20+import qualified Data.Sequence as Seq
21+import Data.Text (Text)
22+import Data.Text.Encoding (encodeUtf8)
23+import Data.Typeable (Typeable)
24+import GHC.Generics (Generic)
25+import Network.HTTP.Media (MediaType)
26+import Network.HTTP.Types (Header, HeaderName, HttpVersion,
27+ Method, QueryItem, Status, http11,
28+ methodGet)
29+import Web.HttpApiData (ToHttpApiData, toEncodedUrlPiece,
30+ toHeader)
31+
32+-- | A type representing possible errors in a request
33+--
34+-- Note that this type substantially changed in 0.12.
35+data ServantError =
36+ -- | The server returned an error response
37+ FailureResponse Response
38+ -- | The body could not be decoded at the expected type
39+ | DecodeFailure Text Response
40+ -- | The content-type of the response is not supported
41+ | UnsupportedContentType MediaType Response
42+ -- | The content-type header is invalid
43+ | InvalidContentTypeHeader Response
44+ -- | There was a connection error, and no response was received
45+ | ConnectionError Text
46+ deriving (Eq, Show, Generic, Typeable)
47+
48+instance Exception ServantError
49+
50+data RequestF a = Request
51+ { requestPath :: a
52+ , requestQueryString :: Seq.Seq QueryItem
53+ , requestBody :: Maybe (RequestBody, MediaType)
54+ , requestAccept :: Seq.Seq MediaType
55+ , requestHeaders :: Seq.Seq Header
56+ , requestHttpVersion :: HttpVersion
57+ , requestMethod :: Method
58+ } deriving (Eq, Show, Functor, Generic, Typeable)
59+
60+type Request = RequestF Builder.Builder
61+
62+-- | The request body. Currently only lazy ByteStrings are supported.
63+newtype RequestBody = RequestBodyLBS LBS.ByteString
64+ deriving (Eq, Ord, Read, Show, Typeable)
65+
66+data Response = Response
67+ { responseStatusCode :: Status
68+ , responseBody :: LBS.ByteString
69+ , responseHeaders :: Seq.Seq Header
70+ , responseHttpVersion :: HttpVersion
71+ } deriving (Eq, Show, Generic, Typeable)
72+
73+-- A GET request to the top-level path
74+defaultRequest :: Request
75+defaultRequest = Request
76+ { requestPath = ""
77+ , requestQueryString = Seq.empty
78+ , requestBody = Nothing
79+ , requestAccept = Seq.empty
80+ , requestHeaders = Seq.empty
81+ , requestHttpVersion = http11
82+ , requestMethod = methodGet
83+ }
84+
85+appendToPath :: Text -> Request -> Request
86+appendToPath p req
87+ = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
88+
89+appendToQueryString :: Text -- ^ param name
90+ -> Maybe Text -- ^ param value
91+ -> Request
92+ -> Request
93+appendToQueryString pname pvalue req
94+ = req { requestQueryString = requestQueryString req
95+ Seq.|> (encodeUtf8 pname, encodeUtf8 <$> pvalue)}
96+
97+addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
98+addHeader name val req
99+ = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
100+
101+-- | Set body and media type of the request being constructed.
102+--
103+-- The body is set to the given bytestring using the 'RequestBodyLBS'
104+-- constructor.
105+--
106+-- @since 0.12
107+--
108+setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request
109+setRequestBodyLBS b t req
110+ = req { requestBody = Just (RequestBodyLBS b, t) }
111+
112+-- | Set body and media type of the request being constructed.
113+--
114+-- @since 0.12
115+--
116+setRequestBody :: RequestBody -> MediaType -> Request -> Request
117+setRequestBody b t req = req { requestBody = Just (b, t) }
servant-client-core/src/Servant/Client/Core/Internal/RunClient.hsnew file+48
@@ -0,0 +1,48 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE MultiParamTypeClasses #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE TypeFamilies #-}
6+-- | Types for possible backends to run client-side `Request` queries
7+module Servant.Client.Core.Internal.RunClient where
8+
9+import Prelude ()
10+import Prelude.Compat
11+
12+import Control.Monad (unless)
13+import Data.Foldable (toList)
14+import Data.Proxy (Proxy)
15+import qualified Data.Text as T
16+import Network.HTTP.Media (MediaType, matches,
17+ parseAccept, (//))
18+import Servant.API (MimeUnrender,
19+ contentTypes,
20+ mimeUnrender)
21+import Servant.Client.Core.Internal.Request (Request, Response (..),
22+ ServantError (..))
23+
24+class (Monad m) => RunClient m where
25+ -- | How to make a request.
26+ runRequest :: Request -> m Response
27+ throwServantError :: ServantError -> m a
28+ catchServantError :: m a -> (ServantError -> m a) -> m a
29+
30+checkContentTypeHeader :: RunClient m => Response -> m MediaType
31+checkContentTypeHeader response =
32+ case lookup "Content-Type" $ toList $ responseHeaders response of
33+ Nothing -> return $ "application"//"octet-stream"
34+ Just t -> case parseAccept t of
35+ Nothing -> throwServantError $ InvalidContentTypeHeader response
36+ Just t' -> return t'
37+
38+decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
39+ => Response -> Proxy ct -> m a
40+decodedAs response contentType = do
41+ responseContentType <- checkContentTypeHeader response
42+ unless (any (matches responseContentType) accept) $
43+ throwServantError $ UnsupportedContentType responseContentType response
44+ case mimeUnrender contentType $ responseBody response of
45+ Left err -> throwServantError $ DecodeFailure (T.pack err) response
46+ Right val -> return val
47+ where
48+ accept = toList $ contentTypes contentType
servant-client-core/src/Servant/Client/Core/Reexport.hsnew file+30
@@ -0,0 +1,30 @@
1+-- | This module is a utility for @servant-client-core@ backend writers. It
2+-- contains all the functionality from @servant-client-core@ that should be
3+-- re-exported.
4+module Servant.Client.Core.Reexport
5+ (
6+ -- * HasClient
7+ HasClient(..)
8+ -- * Response (for @Raw@)
9+ , Response(..)
10+
11+ -- * Generic Client
12+ , ClientLike(..)
13+ , genericMkClientL
14+ , genericMkClientP
15+ , ServantError(..)
16+ , EmptyClient(..)
17+
18+ -- * BaseUrl
19+ , BaseUrl(..)
20+ , Scheme(..)
21+ , showBaseUrl
22+ , parseBaseUrl
23+ , InvalidBaseUrlException
24+ ) where
25+
26+
27+import Servant.Client.Core.Internal.BaseUrl
28+import Servant.Client.Core.Internal.HasClient
29+import Servant.Client.Core.Internal.Generic
30+import Servant.Client.Core.Internal.Request
servant-client/test/Servant/Common/BaseUrlSpec.hs → servant-client-core/test/Servant/Client/Core/Internal/BaseUrlSpec.hsrenamed+3−5
@@ -1,5 +1,6 @@
1{-# OPTIONS_GHC -fno-warn-orphans #-}
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2−module Servant.Common.BaseUrlSpec where
2+module Servant.Client.Core.Internal.BaseUrlSpec (spec) where
3+
3
4
4import Control.DeepSeq
5import Control.DeepSeq
5import Prelude ()
6import Prelude ()
@@ -7,7 +8,7 @@ import Prelude.Compat
7import Test.Hspec
8import Test.Hspec
8import Test.QuickCheck
9import Test.QuickCheck
9
10
10−import Servant.Common.BaseUrl
11+import Servant.Client.Core.Internal.BaseUrl
11
12
12spec :: Spec
13spec :: Spec
13spec = do
14spec = do
@@ -78,6 +79,3 @@ instance Arbitrary BaseUrl where
78 (1, choose (1, 20000)) :
79 (1, choose (1, 20000)) :
79 []
80 []
80 pathGen = listOf1 . elements $ letters
81 pathGen = listOf1 . elements $ letters
81−
82−isLeft :: Either a b -> Bool
83−isLeft = either (const True) (const False)
servant-client-core/test/Spec.hsnew file+1
@@ -0,0 +1 @@
1+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
servant-client/servant-client.cabal+10−21
@@ -12,7 +12,7 @@ license: BSD3
12license-file: LICENSE
12license-file: LICENSE
13author: Servant Contributors
13author: Servant Contributors
14maintainer: haskell-servant-maintainers@googlegroups.com
14maintainer: haskell-servant-maintainers@googlegroups.com
15−copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
15+copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2017 Servant Contributors
16category: Servant, Web
16category: Servant, Web
17build-type: Simple
17build-type: Simple
18cabal-version: >=1.10
18cabal-version: >=1.10
@@ -30,39 +30,27 @@ source-repository head
30library
30library
31 exposed-modules:
31 exposed-modules:
32 Servant.Client
32 Servant.Client
33− Servant.Client.Generic
33+ Servant.Client.Internal.HttpClient
34− Servant.Client.Experimental.Auth
35− Servant.Common.BaseUrl
36− Servant.Common.BasicAuth
37− Servant.Common.Req
38 build-depends:
34 build-depends:
39 base >= 4.7 && < 4.11
35 base >= 4.7 && < 4.11
40 , base-compat >= 0.9.1 && < 0.10
36 , base-compat >= 0.9.1 && < 0.10
37+ , bytestring >= 0.10 && < 0.11
41 , aeson >= 0.7 && < 1.3
38 , aeson >= 0.7 && < 1.3
42 , attoparsec >= 0.12 && < 0.14
39 , attoparsec >= 0.12 && < 0.14
43− , base64-bytestring >= 1.0.0.1 && < 1.1
40+ , containers >= 0.5 && < 0.6
44− , bytestring >= 0.10 && < 0.11
45− , exceptions >= 0.8 && < 0.9
46− , generics-sop >= 0.1.0.0 && < 0.4
47− , http-api-data >= 0.3.6 && < 0.4
48− , http-client >= 0.4.18.1 && < 0.6
41+ , http-client >= 0.4.30 && < 0.6
49 , http-client-tls >= 0.2.2 && < 0.4
42 , http-client-tls >= 0.2.2 && < 0.4
50 , http-media >= 0.6.2 && < 0.8
43 , http-media >= 0.6.2 && < 0.8
51 , http-types >= 0.8.6 && < 0.10
44 , http-types >= 0.8.6 && < 0.10
45+ , exceptions >= 0.8 && < 0.9
52 , monad-control >= 1.0.0.4 && < 1.1
46 , monad-control >= 1.0.0.4 && < 1.1
53− , network-uri >= 2.6 && < 2.7
47+ , mtl >= 2.1 && < 2.3
54− , safe >= 0.3.9 && < 0.4
55 , semigroupoids >= 4.3 && < 5.3
48 , semigroupoids >= 4.3 && < 5.3
56− , servant == 0.11.*
49+ , servant-client-core == 0.11.*
57− , string-conversions >= 0.3 && < 0.5
58 , text >= 1.2 && < 1.3
50 , text >= 1.2 && < 1.3
59 , transformers >= 0.3 && < 0.6
51 , transformers >= 0.3 && < 0.6
60 , transformers-base >= 0.4.4 && < 0.5
52 , transformers-base >= 0.4.4 && < 0.5
61 , transformers-compat >= 0.4 && < 0.6
53 , transformers-compat >= 0.4 && < 0.6
62− , mtl
63− if !impl(ghc >= 8.0)
64− build-depends:
65− semigroups >=0.16.2.2 && <0.19
66 hs-source-dirs: src
54 hs-source-dirs: src
67 default-language: Haskell2010
55 default-language: Haskell2010
68 ghc-options: -Wall
56 ghc-options: -Wall
@@ -78,12 +66,12 @@ test-suite spec
78 main-is: Spec.hs
66 main-is: Spec.hs
79 other-modules:
67 other-modules:
80 Servant.ClientSpec
68 Servant.ClientSpec
81− , Servant.Common.BaseUrlSpec
82 build-depends:
69 build-depends:
83 base == 4.*
70 base == 4.*
84 , aeson
71 , aeson
85 , base-compat
72 , base-compat
86 , bytestring
73 , bytestring
74+ , containers
87 , deepseq
75 , deepseq
88 , hspec == 2.*
76 , hspec == 2.*
89 , http-api-data
77 , http-api-data
@@ -96,6 +84,7 @@ test-suite spec
96 , QuickCheck >= 2.7
84 , QuickCheck >= 2.7
97 , servant
85 , servant
98 , servant-client
86 , servant-client
87+ , servant-client-core
99 , servant-server == 0.11.*
88 , servant-server == 0.11.*
100 , text
89 , text
101 , transformers
90 , transformers
servant-client/src/Servant/Client.hs+5−502
@@ -1,510 +1,13 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE InstanceSigs #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE PolyKinds #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
9−{-# LANGUAGE TypeFamilies #-}
10−{-# LANGUAGE TypeOperators #-}
11−{-# LANGUAGE UndecidableInstances #-}
12−
13−#include "overlapping-compat.h"
14-- | This module provides 'client' which can automatically generate
1-- | This module provides 'client' which can automatically generate
15-- querying functions for each endpoint just from the type representing your
2-- querying functions for each endpoint just from the type representing your
16-- API.
3-- API.
17module Servant.Client
4module Servant.Client
18− ( AuthClientData
19− , AuthenticateReq(..)
20− , client
5+ ( client
21− , HasClient(..)
22 , ClientM
6 , ClientM
23 , runClientM
7 , runClientM
24− , ClientEnv (ClientEnv)
8+ , ClientEnv(..)
25− , mkAuthenticateReq
26− , ServantError(..)
27− , EmptyClient(..)
28− , module Servant.Common.BaseUrl
9+ , module Servant.Client.Core.Reexport
29 ) where
10 ) where
30
11
31−import Data.ByteString.Lazy (ByteString)
12+import Servant.Client.Internal.HttpClient
32−import Data.List
13+import Servant.Client.Core.Reexport
33−import Data.Proxy
34−import Data.String.Conversions
35−import Data.Text (unpack)
36−import GHC.TypeLits
37−import Network.HTTP.Client (Response)
38−import Network.HTTP.Media
39−import qualified Network.HTTP.Types as H
40−import qualified Network.HTTP.Types.Header as HTTP
41−import Prelude ()
42−import Prelude.Compat
43−import Servant.API
44−import Servant.Client.Experimental.Auth
45−import Servant.Common.BaseUrl
46−import Servant.Common.BasicAuth
47−import Servant.Common.Req
48−
49−-- * Accessing APIs as a Client
50−
51−-- | 'client' allows you to produce operations to query an API from a client.
52−--
53−-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
54−-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books
55−-- >
56−-- > myApi :: Proxy MyApi
57−-- > myApi = Proxy
58−-- >
59−-- > getAllBooks :: ClientM [Book]
60−-- > postNewBook :: Book -> ClientM Book
61−-- > (getAllBooks :<|> postNewBook) = client myApi
62−client :: HasClient api => Proxy api -> Client api
63−client p = clientWithRoute p defReq
64−
65−-- | This class lets us define how each API combinator
66−-- influences the creation of an HTTP request. It's mostly
67−-- an internal class, you can just use 'client'.
68−class HasClient api where
69− type Client api :: *
70− clientWithRoute :: Proxy api -> Req -> Client api
71−
72−
73−-- | A client querying function for @a ':<|>' b@ will actually hand you
74−-- one function for querying @a@ and another one for querying @b@,
75−-- stitching them together with ':<|>', which really is just like a pair.
76−--
77−-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
78−-- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
79−-- >
80−-- > myApi :: Proxy MyApi
81−-- > myApi = Proxy
82−-- >
83−-- > getAllBooks :: ClientM [Book]
84−-- > postNewBook :: Book -> ClientM Book
85−-- > (getAllBooks :<|> postNewBook) = client myApi
86−instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
87− type Client (a :<|> b) = Client a :<|> Client b
88− clientWithRoute Proxy req =
89− clientWithRoute (Proxy :: Proxy a) req :<|>
90− clientWithRoute (Proxy :: Proxy b) req
91−
92−-- | Singleton type representing a client for an empty API.
93−data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
94−
95−-- | The client for 'EmptyAPI' is simply 'EmptyClient'.
96−--
97−-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books
98−-- > :<|> "nothing" :> EmptyAPI
99−-- >
100−-- > myApi :: Proxy MyApi
101−-- > myApi = Proxy
102−-- >
103−-- > getAllBooks :: ClientM [Book]
104−-- > (getAllBooks :<|> EmptyClient) = client myApi
105−instance HasClient EmptyAPI where
106− type Client EmptyAPI = EmptyClient
107− clientWithRoute Proxy _ = EmptyClient
108−
109−-- | If you use a 'Capture' in one of your endpoints in your API,
110−-- the corresponding querying function will automatically take
111−-- an additional argument of the type specified by your 'Capture'.
112−-- That function will take care of inserting a textual representation
113−-- of this value at the right place in the request path.
114−--
115−-- You can control how values for this type are turned into
116−-- text by specifying a 'ToHttpApiData' instance for your type.
117−--
118−-- Example:
119−--
120−-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
121−-- >
122−-- > myApi :: Proxy MyApi
123−-- > myApi = Proxy
124−-- >
125−-- > getBook :: Text -> ClientM Book
126−-- > getBook = client myApi
127−-- > -- then you can just use "getBook" to query that endpoint
128−instance (KnownSymbol capture, ToHttpApiData a, HasClient api)
129− => HasClient (Capture capture a :> api) where
130−
131− type Client (Capture capture a :> api) =
132− a -> Client api
133−
134− clientWithRoute Proxy req val =
135− clientWithRoute (Proxy :: Proxy api)
136− (appendToPath p req)
137−
138− where p = unpack (toUrlPiece val)
139−
140−-- | If you use a 'CaptureAll' in one of your endpoints in your API,
141−-- the corresponding querying function will automatically take an
142−-- additional argument of a list of the type specified by your
143−-- 'CaptureAll'. That function will take care of inserting a textual
144−-- representation of this value at the right place in the request
145−-- path.
146−--
147−-- You can control how these values are turned into text by specifying
148−-- a 'ToHttpApiData' instance of your type.
149−--
150−-- Example:
151−--
152−-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile
153−-- >
154−-- > myApi :: Proxy
155−-- > myApi = Proxy
156−--
157−-- > getSourceFile :: [Text] -> ClientM SourceFile
158−-- > getSourceFile = client myApi
159−-- > -- then you can use "getSourceFile" to query that endpoint
160−instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
161− => HasClient (CaptureAll capture a :> sublayout) where
162−
163− type Client (CaptureAll capture a :> sublayout) =
164− [a] -> Client sublayout
165−
166− clientWithRoute Proxy req vals =
167− clientWithRoute (Proxy :: Proxy sublayout)
168− (foldl' (flip appendToPath) req ps)
169−
170− where ps = map (unpack . toUrlPiece) vals
171−
172−instance OVERLAPPABLE_
173− -- Note [Non-Empty Content Types]
174− (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
175− ) => HasClient (Verb method status cts' a) where
176− type Client (Verb method status cts' a) = ClientM a
177− clientWithRoute Proxy req = do
178− snd <$> performRequestCT (Proxy :: Proxy ct) method req
179− where method = reflectMethod (Proxy :: Proxy method)
180−
181−instance OVERLAPPING_
182− (ReflectMethod method) => HasClient (Verb method status cts NoContent) where
183− type Client (Verb method status cts NoContent)
184− = ClientM NoContent
185− clientWithRoute Proxy req = do
186− performRequestNoBody method req >> return NoContent
187− where method = reflectMethod (Proxy :: Proxy method)
188−
189−instance OVERLAPPING_
190− -- Note [Non-Empty Content Types]
191− ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
192− ) => HasClient (Verb method status cts' (Headers ls a)) where
193− type Client (Verb method status cts' (Headers ls a))
194− = ClientM (Headers ls a)
195− clientWithRoute Proxy req = do
196− let method = reflectMethod (Proxy :: Proxy method)
197− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req
198− return $ Headers { getResponse = resp
199− , getHeadersHList = buildHeadersTo hdrs
200− }
201−
202−instance OVERLAPPING_
203− ( BuildHeadersTo ls, ReflectMethod method
204− ) => HasClient (Verb method status cts (Headers ls NoContent)) where
205− type Client (Verb method status cts (Headers ls NoContent))
206− = ClientM (Headers ls NoContent)
207− clientWithRoute Proxy req = do
208− let method = reflectMethod (Proxy :: Proxy method)
209− hdrs <- performRequestNoBody method req
210− return $ Headers { getResponse = NoContent
211− , getHeadersHList = buildHeadersTo hdrs
212− }
213−
214−
215−-- | If you use a 'Header' in one of your endpoints in your API,
216−-- the corresponding querying function will automatically take
217−-- an additional argument of the type specified by your 'Header',
218−-- wrapped in Maybe.
219−--
220−-- That function will take care of encoding this argument as Text
221−-- in the request headers.
222−--
223−-- All you need is for your type to have a 'ToHttpApiData' instance.
224−--
225−-- Example:
226−--
227−-- > newtype Referer = Referer { referrer :: Text }
228−-- > deriving (Eq, Show, Generic, ToHttpApiData)
229−-- >
230−-- > -- GET /view-my-referer
231−-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
232−-- >
233−-- > myApi :: Proxy MyApi
234−-- > myApi = Proxy
235−-- >
236−-- > viewReferer :: Maybe Referer -> ClientM Book
237−-- > viewReferer = client myApi
238−-- > -- then you can just use "viewRefer" to query that endpoint
239−-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
240−instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
241− => HasClient (Header sym a :> api) where
242−
243− type Client (Header sym a :> api) =
244− Maybe a -> Client api
245−
246− clientWithRoute Proxy req mval =
247− clientWithRoute (Proxy :: Proxy api)
248− (maybe req
249− (\value -> Servant.Common.Req.addHeader hname value req)
250− mval
251− )
252−
253− where hname = symbolVal (Proxy :: Proxy sym)
254−
255−-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
256−-- functions.
257−instance HasClient api
258− => HasClient (HttpVersion :> api) where
259−
260− type Client (HttpVersion :> api) =
261− Client api
262−
263− clientWithRoute Proxy =
264− clientWithRoute (Proxy :: Proxy api)
265−
266−-- | Ignore @'Summary'@ in client functions.
267−instance HasClient api => HasClient (Summary desc :> api) where
268− type Client (Summary desc :> api) = Client api
269−
270− clientWithRoute _ = clientWithRoute (Proxy :: Proxy api)
271−
272−-- | Ignore @'Description'@ in client functions.
273−instance HasClient api => HasClient (Description desc :> api) where
274− type Client (Description desc :> api) = Client api
275−
276− clientWithRoute _ = clientWithRoute (Proxy :: Proxy api)
277−
278−-- | If you use a 'QueryParam' in one of your endpoints in your API,
279−-- the corresponding querying function will automatically take
280−-- an additional argument of the type specified by your 'QueryParam',
281−-- enclosed in Maybe.
282−--
283−-- If you give Nothing, nothing will be added to the query string.
284−--
285−-- If you give a non-'Nothing' value, this function will take care
286−-- of inserting a textual representation of this value in the query string.
287−--
288−-- You can control how values for your type are turned into
289−-- text by specifying a 'ToHttpApiData' instance for your type.
290−--
291−-- Example:
292−--
293−-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
294−-- >
295−-- > myApi :: Proxy MyApi
296−-- > myApi = Proxy
297−-- >
298−-- > getBooksBy :: Maybe Text -> ClientM [Book]
299−-- > getBooksBy = client myApi
300−-- > -- then you can just use "getBooksBy" to query that endpoint.
301−-- > -- 'getBooksBy Nothing' for all books
302−-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
303−instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
304− => HasClient (QueryParam sym a :> api) where
305−
306− type Client (QueryParam sym a :> api) =
307− Maybe a -> Client api
308−
309− -- if mparam = Nothing, we don't add it to the query string
310− clientWithRoute Proxy req mparam =
311− clientWithRoute (Proxy :: Proxy api)
312− (maybe req
313− (flip (appendToQueryString pname) req . Just)
314− mparamText
315− )
316−
317− where pname = cs pname'
318− pname' = symbolVal (Proxy :: Proxy sym)
319− mparamText = fmap toQueryParam mparam
320−
321−-- | If you use a 'QueryParams' in one of your endpoints in your API,
322−-- the corresponding querying function will automatically take
323−-- an additional argument, a list of values of the type specified
324−-- by your 'QueryParams'.
325−--
326−-- If you give an empty list, nothing will be added to the query string.
327−--
328−-- Otherwise, this function will take care
329−-- of inserting a textual representation of your values in the query string,
330−-- under the same query string parameter name.
331−--
332−-- You can control how values for your type are turned into
333−-- text by specifying a 'ToHttpApiData' instance for your type.
334−--
335−-- Example:
336−--
337−-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
338−-- >
339−-- > myApi :: Proxy MyApi
340−-- > myApi = Proxy
341−-- >
342−-- > getBooksBy :: [Text] -> ClientM [Book]
343−-- > getBooksBy = client myApi
344−-- > -- then you can just use "getBooksBy" to query that endpoint.
345−-- > -- 'getBooksBy []' for all books
346−-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
347−-- > -- to get all books by Asimov and Heinlein
348−instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
349− => HasClient (QueryParams sym a :> api) where
350−
351− type Client (QueryParams sym a :> api) =
352− [a] -> Client api
353−
354− clientWithRoute Proxy req paramlist =
355− clientWithRoute (Proxy :: Proxy api)
356− (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
357− req
358− paramlist'
359− )
360−
361− where pname = cs pname'
362− pname' = symbolVal (Proxy :: Proxy sym)
363− paramlist' = map (Just . toQueryParam) paramlist
364−
365−-- | If you use a 'QueryFlag' in one of your endpoints in your API,
366−-- the corresponding querying function will automatically take
367−-- an additional 'Bool' argument.
368−--
369−-- If you give 'False', nothing will be added to the query string.
370−--
371−-- Otherwise, this function will insert a value-less query string
372−-- parameter under the name associated to your 'QueryFlag'.
373−--
374−-- Example:
375−--
376−-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
377−-- >
378−-- > myApi :: Proxy MyApi
379−-- > myApi = Proxy
380−-- >
381−-- > getBooks :: Bool -> ClientM [Book]
382−-- > getBooks = client myApi
383−-- > -- then you can just use "getBooks" to query that endpoint.
384−-- > -- 'getBooksBy False' for all books
385−-- > -- 'getBooksBy True' to only get _already published_ books
386−instance (KnownSymbol sym, HasClient api)
387− => HasClient (QueryFlag sym :> api) where
388−
389− type Client (QueryFlag sym :> api) =
390− Bool -> Client api
391−
392− clientWithRoute Proxy req flag =
393− clientWithRoute (Proxy :: Proxy api)
394− (if flag
395− then appendToQueryString paramname Nothing req
396− else req
397− )
398−
399− where paramname = cs $ symbolVal (Proxy :: Proxy sym)
400−
401−
402−-- | Pick a 'Method' and specify where the server you want to query is. You get
403−-- back the full `Response`.
404−instance HasClient Raw where
405− type Client Raw
406− = H.Method -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
407−
408− clientWithRoute :: Proxy Raw -> Req -> Client Raw
409− clientWithRoute Proxy req httpMethod = do
410− performRequest httpMethod req
411−
412−-- | If you use a 'ReqBody' in one of your endpoints in your API,
413−-- the corresponding querying function will automatically take
414−-- an additional argument of the type specified by your 'ReqBody'.
415−-- That function will take care of encoding this argument as JSON and
416−-- of using it as the request body.
417−--
418−-- All you need is for your type to have a 'ToJSON' instance.
419−--
420−-- Example:
421−--
422−-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
423−-- >
424−-- > myApi :: Proxy MyApi
425−-- > myApi = Proxy
426−-- >
427−-- > addBook :: Book -> ClientM Book
428−-- > addBook = client myApi
429−-- > -- then you can just use "addBook" to query that endpoint
430−instance (MimeRender ct a, HasClient api)
431− => HasClient (ReqBody (ct ': cts) a :> api) where
432−
433− type Client (ReqBody (ct ': cts) a :> api) =
434− a -> Client api
435−
436− clientWithRoute Proxy req body =
437− clientWithRoute (Proxy :: Proxy api)
438− (let ctProxy = Proxy :: Proxy ct
439− in setReqBodyLBS (mimeRender ctProxy body)
440− -- We use first contentType from the Accept list
441− (contentType ctProxy)
442− req
443− )
444−
445−-- | Make the querying function append @path@ to the request path.
446−instance (KnownSymbol path, HasClient api) => HasClient (path :> api) where
447− type Client (path :> api) = Client api
448−
449− clientWithRoute Proxy req =
450− clientWithRoute (Proxy :: Proxy api)
451− (appendToPath p req)
452−
453− where p = symbolVal (Proxy :: Proxy path)
454−
455−instance HasClient api => HasClient (Vault :> api) where
456− type Client (Vault :> api) = Client api
457−
458− clientWithRoute Proxy req =
459− clientWithRoute (Proxy :: Proxy api) req
460−
461−instance HasClient api => HasClient (RemoteHost :> api) where
462− type Client (RemoteHost :> api) = Client api
463−
464− clientWithRoute Proxy req =
465− clientWithRoute (Proxy :: Proxy api) req
466−
467−instance HasClient api => HasClient (IsSecure :> api) where
468− type Client (IsSecure :> api) = Client api
469−
470− clientWithRoute Proxy req =
471− clientWithRoute (Proxy :: Proxy api) req
472−
473−instance HasClient subapi =>
474− HasClient (WithNamedContext name context subapi) where
475−
476− type Client (WithNamedContext name context subapi) = Client subapi
477− clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
478−
479−instance ( HasClient api
480− ) => HasClient (AuthProtect tag :> api) where
481− type Client (AuthProtect tag :> api)
482− = AuthenticateReq (AuthProtect tag) -> Client api
483−
484− clientWithRoute Proxy req (AuthenticateReq (val,func)) =
485− clientWithRoute (Proxy :: Proxy api) (func val req)
486−
487−-- * Basic Authentication
488−
489−instance HasClient api => HasClient (BasicAuth realm usr :> api) where
490− type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api
491−
492− clientWithRoute Proxy req val =
493− clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req)
494−
495−
496−{- Note [Non-Empty Content Types]
497−~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
498−Rather than have
499−
500− instance (..., cts' ~ (ct ': cts)) => ... cts' ...
501−
502−It may seem to make more sense to have:
503−
504− instance (...) => ... (ct ': cts) ...
505−
506−But this means that if another instance exists that does *not* require
507−non-empty lists, but is otherwise more specific, no instance will be overall
508−more specific. This in turn generally means adding yet another instance (one
509−for empty and one for non-empty lists).
510−-}
servant-client/src/Servant/Client/Internal/HttpClient.hsnew file+149
@@ -0,0 +1,149 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TypeFamilies #-}
11+
12+-- | @http-client@-based client requests executor
13+module Servant.Client.Internal.HttpClient where
14+
15+
16+import Prelude ()
17+import Prelude.Compat
18+
19+import Control.Exception
20+import Control.Monad
21+import Control.Monad.Base (MonadBase (..))
22+import Control.Monad.Catch (MonadCatch, MonadThrow)
23+import Control.Monad.Error.Class (MonadError (..))
24+import Control.Monad.Reader
25+import Control.Monad.Trans.Control (MonadBaseControl (..))
26+import Control.Monad.Trans.Except
27+import Data.ByteString.Builder (toLazyByteString)
28+import qualified Data.ByteString.Lazy as BSL
29+import Data.Foldable (toList)
30+import Data.Functor.Alt (Alt (..))
31+import Data.Monoid ((<>))
32+import Data.Proxy (Proxy (..))
33+import Data.Sequence (fromList)
34+import Data.String (fromString)
35+import qualified Data.Text as T
36+import GHC.Generics
37+import Network.HTTP.Media (renderHeader)
38+import Network.HTTP.Types (hContentType, renderQuery,
39+ statusCode)
40+import Servant.Client.Core
41+
42+import qualified Network.HTTP.Client as Client
43+
44+-- | The environment in which a request is run.
45+data ClientEnv
46+ = ClientEnv
47+ { manager :: Client.Manager
48+ , baseUrl :: BaseUrl
49+ }
50+
51+-- | Generates a set of client functions for an API.
52+--
53+-- Example:
54+--
55+-- > type API = Capture "no" Int :> Get '[JSON] Int
56+-- > :<|> Get '[JSON] [Bool]
57+-- >
58+-- > api :: Proxy API
59+-- > api = Proxy
60+-- >
61+-- > getInt :: Int -> ClientM Int
62+-- > getBools :: ClientM [Bool]
63+-- > getInt :<|> getBools = client api
64+client :: HasClient ClientM api => Proxy api -> Client ClientM api
65+client api = api `clientIn` (Proxy :: Proxy ClientM)
66+
67+-- | @ClientM@ is the monad in which client functions run. Contains the
68+-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
69+newtype ClientM a = ClientM
70+ { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }
71+ deriving ( Functor, Applicative, Monad, MonadIO, Generic
72+ , MonadReader ClientEnv, MonadError ServantError, MonadThrow
73+ , MonadCatch)
74+
75+instance MonadBase IO ClientM where
76+ liftBase = ClientM . liftBase
77+
78+instance MonadBaseControl IO ClientM where
79+ type StM ClientM a = Either ServantError a
80+
81+ liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))
82+
83+ restoreM st = ClientM (restoreM st)
84+
85+-- | Try clients in order, last error is preserved.
86+instance Alt ClientM where
87+ a <!> b = a `catchError` \_ -> b
88+
89+instance RunClient ClientM where
90+ runRequest = performRequest
91+ throwServantError = throwError
92+ catchServantError = catchError
93+
94+instance ClientLike (ClientM a) (ClientM a) where
95+ mkClient = id
96+
97+runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
98+runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
99+
100+
101+performRequest :: Request -> ClientM Response
102+performRequest req = do
103+ m <- asks manager
104+ burl <- asks baseUrl
105+ let request = requestToClientRequest burl req
106+
107+ eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m
108+ case eResponse of
109+ Left err -> throwError $ err
110+ Right response -> do
111+ let status = Client.responseStatus response
112+ status_code = statusCode status
113+ ourResponse = clientResponseToReponse response
114+ unless (status_code >= 200 && status_code < 300) $
115+ throwError $ FailureResponse ourResponse
116+ return ourResponse
117+
118+clientResponseToReponse :: Client.Response BSL.ByteString -> Response
119+clientResponseToReponse r = Response
120+ { responseStatusCode = Client.responseStatus r
121+ , responseBody = Client.responseBody r
122+ , responseHeaders = fromList $ Client.responseHeaders r
123+ , responseHttpVersion = Client.responseVersion r
124+ }
125+
126+requestToClientRequest :: BaseUrl -> Request -> Client.Request
127+requestToClientRequest burl r = Client.defaultRequest
128+ { Client.method = requestMethod r
129+ , Client.host = fromString $ baseUrlHost burl
130+ , Client.port = baseUrlPort burl
131+ , Client.path = BSL.toStrict
132+ $ fromString (baseUrlPath burl)
133+ <> toLazyByteString (requestPath r)
134+ , Client.queryString = renderQuery True . toList $ requestQueryString r
135+ , Client.requestHeaders =
136+ let orig = toList $ requestHeaders r
137+ in maybe orig (: orig) contentTypeHdr
138+ , Client.requestBody = body
139+ }
140+ where
141+ (body, contentTypeHdr) = case requestBody r of
142+ Nothing -> (Client.RequestBodyLBS "", Nothing)
143+ Just (RequestBodyLBS body', typ)
144+ -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))
145+
146+catchConnectionError :: IO a -> IO (Either ServantError a)
147+catchConnectionError action =
148+ catch (Right <$> action) $ \e ->
149+ pure . Left . ConnectionError . T.pack $ show (e :: Client.HttpException)
servant-client/src/Servant/Common/BasicAuth.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE TypeSynonymInstances #-}
3−{-# LANGUAGE TypeFamilies #-}
4−
5−-- | Basic Authentication for clients
6−
7−module Servant.Common.BasicAuth (
8− basicAuthReq
9− ) where
10−
11−import Data.ByteString.Base64 (encode)
12−import Data.Monoid ((<>))
13−import Data.Text.Encoding (decodeUtf8)
14−import Servant.Common.Req (addHeader, Req)
15−import Servant.API.BasicAuth (BasicAuthData(BasicAuthData))
16−
17−-- | Authenticate a request using Basic Authentication
18−basicAuthReq :: BasicAuthData -> Req -> Req
19−basicAuthReq (BasicAuthData user pass) req =
20− let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass))
21− in addHeader "Authorization" authText req
servant-client/src/Servant/Common/Req.hsdeleted−285
@@ -1,285 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE TypeFamilies #-}
7−{-# LANGUAGE OverloadedStrings #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
9−
10−module Servant.Common.Req where
11−
12−import Prelude ()
13−import Prelude.Compat
14−
15−import Control.Exception
16−import Control.Monad
17−import Control.Monad.Catch (MonadThrow, MonadCatch)
18−import Data.Foldable (toList)
19−import Data.Functor.Alt (Alt (..))
20−import Data.Semigroup ((<>))
21−
22−import Control.Monad.Error.Class (MonadError(..))
23−import Control.Monad.Trans.Except
24−
25−import GHC.Generics
26−import Control.Monad.Base (MonadBase (..))
27−import Control.Monad.IO.Class ()
28−import Control.Monad.Reader
29−import Control.Monad.Trans.Control (MonadBaseControl (..))
30−import qualified Data.ByteString.Builder as BS
31−import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
32−import Data.String
33−import Data.String.Conversions (cs)
34−import Data.Proxy
35−import Data.Text (Text)
36−import Data.Text.Encoding
37−import Data.Typeable
38−import Network.HTTP.Media
39−import Network.HTTP.Types
40−import Network.HTTP.Client hiding (Proxy, path)
41−import qualified Network.HTTP.Types.Header as HTTP
42−import Network.URI hiding (path)
43−import Servant.API.ContentTypes
44−import Servant.Common.BaseUrl
45−
46−import qualified Network.HTTP.Client as Client
47−
48−import Web.HttpApiData
49−
50−data ServantError
51− = FailureResponse
52− { failingRequest :: UrlReq
53− , responseStatus :: Status
54− , responseContentType :: MediaType
55− , responseBody :: ByteString
56− }
57− | DecodeFailure
58− { decodeError :: String
59− , responseContentType :: MediaType
60− , responseBody :: ByteString
61− }
62− | UnsupportedContentType
63− { responseContentType :: MediaType
64− , responseBody :: ByteString
65− }
66− | InvalidContentTypeHeader
67− { responseContentTypeHeader :: ByteString
68− , responseBody :: ByteString
69− }
70− | ConnectionError
71− { connectionError :: SomeException
72− }
73− deriving (Show, Typeable)
74−
75−instance Eq ServantError where
76− FailureResponse _ a b c == FailureResponse _ x y z =
77− (a, b, c) == (x, y, z)
78− DecodeFailure a b c == DecodeFailure x y z =
79− (a, b, c) == (x, y, z)
80− UnsupportedContentType a b == UnsupportedContentType x y =
81− (a, b) == (x, y)
82− InvalidContentTypeHeader a b == InvalidContentTypeHeader x y =
83− (a, b) == (x, y)
84− ConnectionError a == ConnectionError x =
85− show a == show x
86− _ == _ = False
87−
88−instance Exception ServantError
89−
90−data UrlReq = UrlReq BaseUrl Req
91−
92−instance Show UrlReq where
93− show (UrlReq url req) = showBaseUrl url ++ path ++ "?" ++ show (qs req)
94− where
95− path = cs (BS.toLazyByteString (reqPath req))
96−
97−data Req = Req
98− { reqPath :: BS.Builder
99− , qs :: QueryText
100− , reqBody :: Maybe (RequestBody, MediaType)
101− , reqAccept :: [MediaType]
102− , headers :: [(String, Text)]
103− }
104−
105−defReq :: Req
106−defReq = Req "" [] Nothing [] []
107−
108−appendToPath :: String -> Req -> Req
109−appendToPath p req =
110− req { reqPath = reqPath req <> "/" <> toEncodedUrlPiece p }
111−
112−appendToQueryString :: Text -- ^ param name
113− -> Maybe Text -- ^ param value
114− -> Req
115− -> Req
116−appendToQueryString pname pvalue req =
117− req { qs = qs req ++ [(pname, pvalue)]
118− }
119−
120−addHeader :: ToHttpApiData a => String -> a -> Req -> Req
121−addHeader name val req = req { headers = headers req
122− ++ [(name, decodeUtf8 (toHeader val))]
123− }
124−
125−-- | Set body and media type of the request being constructed.
126−--
127−-- The body is set to the given bytestring using the 'RequestBodyLBS'
128−-- constructor.
129−--
130−{-# DEPRECATED setRQBody "Use setReqBodyLBS instead" #-}
131−setRQBody :: ByteString -> MediaType -> Req -> Req
132−setRQBody = setReqBodyLBS
133−
134−-- | Set body and media type of the request being constructed.
135−--
136−-- The body is set to the given bytestring using the 'RequestBodyLBS'
137−-- constructor.
138−--
139−-- @since 0.9.2.0
140−--
141−setReqBodyLBS :: ByteString -> MediaType -> Req -> Req
142−setReqBodyLBS b t req = req { reqBody = Just (RequestBodyLBS b, t) }
143−
144−-- | Set body and media type of the request being constructed.
145−--
146−-- @since 0.9.2.0
147−--
148−setReqBody :: RequestBody -> MediaType -> Req -> Req
149−setReqBody b t req = req { reqBody = Just (b, t) }
150−
151−reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
152−reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
153− setheaders . setAccept . setrqb . setQS <$> parseRequest url
154−
155− where url = show $ nullURI { uriScheme = case reqScheme of
156− Http -> "http:"
157− Https -> "https:"
158− , uriAuthority = Just $
159− URIAuth { uriUserInfo = ""
160− , uriRegName = reqHost
161− , uriPort = ":" ++ show reqPort
162− }
163− , uriPath = fullPath
164− }
165− fullPath = path ++ cs (BS.toLazyByteString (reqPath req))
166−
167− setrqb r = case reqBody req of
168− Nothing -> r
169− Just (b,t) -> r { requestBody = b
170− , requestHeaders = requestHeaders r
171− ++ [(hContentType, cs . show $ t)] }
172− setQS = setQueryString $ queryTextToQuery (qs req)
173− setheaders r = r { requestHeaders = requestHeaders r
174− <> fmap toProperHeader (headers req) }
175− setAccept r = r { requestHeaders = filter ((/= "Accept") . fst) (requestHeaders r)
176− <> [("Accept", renderHeader $ reqAccept req)
177− | not . null . reqAccept $ req] }
178− toProperHeader (name, val) =
179− (fromString name, encodeUtf8 val)
180−
181−#if !MIN_VERSION_http_client(0,4,30)
182−-- 'parseRequest' is introduced in http-client-0.4.30
183−-- it differs from 'parseUrl', by not throwing exceptions on non-2xx http statuses
184−--
185−-- See for implementations:
186−-- http://hackage.haskell.org/package/http-client-0.4.30/docs/src/Network-HTTP-Client-Request.html#parseRequest
187−-- http://hackage.haskell.org/package/http-client-0.5.0/docs/src/Network-HTTP-Client-Request.html#parseRequest
188−parseRequest :: MonadThrow m => String -> m Request
189−parseRequest url = liftM disableStatusCheck (parseUrl url)
190− where
191− disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing }
192−#endif
193−
194−
195−-- * performing requests
196−
197−displayHttpRequest :: Method -> String
198−displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
199−
200−data ClientEnv
201− = ClientEnv
202− { manager :: Manager
203− , baseUrl :: BaseUrl
204− }
205−
206−
207−-- | @ClientM@ is the monad in which client functions run. Contains the
208−-- 'Manager' and 'BaseUrl' used for requests in the reader environment.
209−
210−newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }
211− deriving ( Functor, Applicative, Monad, MonadIO, Generic
212− , MonadReader ClientEnv
213− , MonadError ServantError
214− , MonadThrow, MonadCatch
215− )
216−
217−instance MonadBase IO ClientM where
218− liftBase = ClientM . liftBase
219−
220−instance MonadBaseControl IO ClientM where
221− type StM ClientM a = Either ServantError a
222−
223− -- liftBaseWith :: (RunInBase ClientM IO -> IO a) -> ClientM a
224− liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))
225−
226− -- restoreM :: StM ClientM a -> ClientM a
227− restoreM st = ClientM (restoreM st)
228−
229−-- | Try clients in order, last error is preserved.
230−instance Alt ClientM where
231− a <!> b = a `catchError` \_ -> b
232−
233−runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
234−runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
235−
236−
237−performRequest :: Method -> Req
238− -> ClientM ( Int, ByteString, MediaType
239− , [HTTP.Header], Response ByteString)
240−performRequest reqMethod req = do
241− m <- asks manager
242− reqHost <- asks baseUrl
243− partialRequest <- liftIO $ reqToRequest req reqHost
244−
245− let request = partialRequest { Client.method = reqMethod }
246−
247− eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m
248− case eResponse of
249− Left err ->
250− throwError . ConnectionError $ SomeException err
251−
252− Right response -> do
253− let status = Client.responseStatus response
254− body = Client.responseBody response
255− hdrs = Client.responseHeaders response
256− status_code = statusCode status
257− ct <- case lookup "Content-Type" $ Client.responseHeaders response of
258− Nothing -> pure $ "application"//"octet-stream"
259− Just t -> case parseAccept t of
260− Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
261− Just t' -> pure t'
262− unless (status_code >= 200 && status_code < 300) $
263− throwError $ FailureResponse (UrlReq reqHost req) status ct body
264− return (status_code, body, ct, hdrs, response)
265−
266−performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
267− -> ClientM ([HTTP.Header], result)
268−performRequestCT ct reqMethod req = do
269− let acceptCTS = contentTypes ct
270− (_status, respBody, respCT, hdrs, _response) <-
271− performRequest reqMethod (req { reqAccept = toList acceptCTS })
272− unless (any (matches respCT) acceptCTS) $ throwError $ UnsupportedContentType respCT respBody
273− case mimeUnrender ct respBody of
274− Left err -> throwError $ DecodeFailure err respCT respBody
275− Right val -> return (hdrs, val)
276−
277−performRequestNoBody :: Method -> Req -> ClientM [HTTP.Header]
278−performRequestNoBody reqMethod req = do
279− (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req
280− return hdrs
281−
282−catchConnectionError :: IO a -> IO (Either ServantError a)
283−catchConnectionError action =
284− catch (Right <$> action) $ \e ->
285− pure . Left . ConnectionError $ SomeException (e :: HttpException)
servant-client/test/Servant/ClientSpec.hs+130−113
@@ -24,40 +24,57 @@
24{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
24{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
25
25
26#include "overlapping-compat.h"
26#include "overlapping-compat.h"
27−module Servant.ClientSpec where
27+module Servant.ClientSpec (spec) where
28
28
29+import Prelude ()
30+import Prelude.Compat
31+
29−import Control.Arrow (left)
32+import Control.Arrow (left)
30−import Control.Concurrent (forkIO, killThread, ThreadId)
33+import Control.Concurrent (ThreadId, forkIO,
34+ killThread)
31−import Control.Exception (bracket)
35+import Control.Exception (bracket)
32−import Control.Monad.Error.Class (throwError )
36+import Control.Monad.Error.Class (throwError)
33import Data.Aeson
37import Data.Aeson
34−import qualified Data.ByteString.Lazy as BS
35−import Data.Char (chr, isPrint)
38+import Data.Char (chr, isPrint)
36−import Data.Foldable (forM_)
39+import Data.Foldable (forM_)
37−import Data.Monoid hiding (getLast)
40+import Data.Monoid hiding (getLast)
38import Data.Proxy
41import Data.Proxy
39−import qualified Generics.SOP as SOP
42+import qualified Generics.SOP as SOP
40−import GHC.Generics (Generic)
43+import GHC.Generics (Generic)
41−import qualified Network.HTTP.Client as C
44+import qualified Network.HTTP.Client as C
42−import Network.HTTP.Media
43−import qualified Network.HTTP.Types as HTTP
45+import qualified Network.HTTP.Types as HTTP
44import Network.Socket
46import Network.Socket
45−import Network.Wai (Request, requestHeaders, responseLBS)
47+import qualified Network.Wai as Wai
46import Network.Wai.Handler.Warp
48import Network.Wai.Handler.Warp
47−import Prelude ()
48−import Prelude.Compat
49−import System.IO.Unsafe (unsafePerformIO)
49+import System.IO.Unsafe (unsafePerformIO)
50−import Test.HUnit
51import Test.Hspec
50import Test.Hspec
52import Test.Hspec.QuickCheck
51import Test.Hspec.QuickCheck
52+import Test.HUnit
53import Test.QuickCheck
53import Test.QuickCheck
54−import Web.FormUrlEncoded (FromForm, ToForm)
54+import Web.FormUrlEncoded (FromForm, ToForm)
55−
55+
56−import Servant.API
56+import Servant.API ((:<|>) ((:<|>)),
57+ (:>), AuthProtect,
58+ BasicAuth,
59+ BasicAuthData (..),
60+ Capture,
61+ CaptureAll, Delete,
62+ DeleteNoContent,
63+ EmptyAPI, addHeader,
64+ FormUrlEncoded,
65+ Get, Header,
66+ Headers, JSON,
67+ NoContent (NoContent),
68+ Post, Put, Raw,
69+ QueryFlag,
70+ QueryParam,
71+ QueryParams,
72+ ReqBody,
73+ getHeaders)
57import Servant.API.Internal.Test.ComprehensiveAPI
74import Servant.API.Internal.Test.ComprehensiveAPI
58import Servant.Client
75import Servant.Client
59−import Servant.Client.Generic
76+import qualified Servant.Client.Core.Internal.Request as Req
60−import qualified Servant.Common.Req as SCR
77+import qualified Servant.Client.Core.Internal.Auth as Auth
61import Servant.Server
78import Servant.Server
62import Servant.Server.Experimental.Auth
79import Servant.Server.Experimental.Auth
63
80
@@ -75,17 +92,16 @@ spec = describe "Servant.Client" $ do
75
92
76-- * test data types
93-- * test data types
77
94
78−data Person = Person {
95+data Person = Person
79− name :: String,
96+ { _name :: String
80− age :: Integer
97+ , _age :: Integer
81− }
82− deriving (Eq, Show, Generic)
98+ } deriving (Eq, Show, Generic)
83
99
84instance ToJSON Person
100instance ToJSON Person
85instance FromJSON Person
101instance FromJSON Person
86
102
87−instance ToForm Person where
103+instance ToForm Person
88−instance FromForm Person where
104+instance FromForm Person
89
105
90alice :: Person
106alice :: Person
91alice = Person "Alice" 42
107alice = Person "Alice" 42
@@ -116,22 +132,20 @@ type Api =
116api :: Proxy Api
132api :: Proxy Api
117api = Proxy
133api = Proxy
118
134
119−getGet :: SCR.ClientM Person
135+getGet :: ClientM Person
120−getDeleteEmpty :: SCR.ClientM NoContent
136+getDeleteEmpty :: ClientM NoContent
121−getCapture :: String -> SCR.ClientM Person
137+getCapture :: String -> ClientM Person
122−getCaptureAll :: [String] -> SCR.ClientM [Person]
138+getCaptureAll :: [String] -> ClientM [Person]
123−getBody :: Person -> SCR.ClientM Person
139+getBody :: Person -> ClientM Person
124−getQueryParam :: Maybe String -> SCR.ClientM Person
140+getQueryParam :: Maybe String -> ClientM Person
125−getQueryParams :: [String] -> SCR.ClientM [Person]
141+getQueryParams :: [String] -> ClientM [Person]
126−getQueryFlag :: Bool -> SCR.ClientM Bool
142+getQueryFlag :: Bool -> ClientM Bool
127−getRawSuccess :: HTTP.Method
143+getRawSuccess :: HTTP.Method -> ClientM Response
128− -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
129−getRawFailure :: HTTP.Method
144+getRawFailure :: HTTP.Method -> ClientM Response
130− -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
131getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
145getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
132− -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
146+ -> ClientM (String, Maybe Int, Bool, [(String, [Rational])])
133−getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)
147+getRespHeaders :: ClientM (Headers TestHeaders Bool)
134−getDeleteContentType :: SCR.ClientM NoContent
148+getDeleteContentType :: ClientM NoContent
135
149
136getGet
150getGet
137 :<|> getDeleteEmpty
151 :<|> getDeleteEmpty
@@ -161,8 +175,8 @@ server = serve api (
161 Nothing -> throwError $ ServantErr 400 "missing parameter" "" [])
175 Nothing -> throwError $ ServantErr 400 "missing parameter" "" [])
162 :<|> (\ names -> return (zipWith Person names [0..]))
176 :<|> (\ names -> return (zipWith Person names [0..]))
163 :<|> return
177 :<|> return
164− :<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")
178+ :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
165− :<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure")
179+ :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")
166 :<|> (\ a b c d -> return (a, b, c, d))
180 :<|> (\ a b c d -> return (a, b, c, d))
167 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
181 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
168 :<|> return NoContent
182 :<|> return NoContent
@@ -178,9 +192,9 @@ failApi = Proxy
178
192
179failServer :: Application
193failServer :: Application
180failServer = serve failApi (
194failServer = serve failApi (
181− (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
195+ (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "")
182− :<|> (\ _capture -> Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")
196+ :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
183− :<|> (Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
197+ :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
184 )
198 )
185
199
186-- * basic auth stuff
200-- * basic auth stuff
@@ -214,16 +228,16 @@ genAuthAPI :: Proxy GenAuthAPI
214genAuthAPI = Proxy
228genAuthAPI = Proxy
215
229
216type instance AuthServerData (AuthProtect "auth-tag") = ()
230type instance AuthServerData (AuthProtect "auth-tag") = ()
217−type instance AuthClientData (AuthProtect "auth-tag") = ()
231+type instance Auth.AuthClientData (AuthProtect "auth-tag") = ()
218
232
219−genAuthHandler :: AuthHandler Request ()
233+genAuthHandler :: AuthHandler Wai.Request ()
220genAuthHandler =
234genAuthHandler =
221− let handler req = case lookup "AuthHeader" (requestHeaders req) of
235+ let handler req = case lookup "AuthHeader" (Wai.requestHeaders req) of
222 Nothing -> throwError (err401 { errBody = "Missing auth header" })
236 Nothing -> throwError (err401 { errBody = "Missing auth header" })
223 Just _ -> return ()
237 Just _ -> return ()
224 in mkAuthHandler handler
238 in mkAuthHandler handler
225
239
226−genAuthServerContext :: Context '[ AuthHandler Request () ]
240+genAuthServerContext :: Context '[ AuthHandler Wai.Request () ]
227genAuthServerContext = genAuthHandler :. EmptyContext
241genAuthServerContext = genAuthHandler :. EmptyContext
228
242
229genAuthServer :: Application
243genAuthServer :: Application
@@ -236,11 +250,11 @@ type GenericClientAPI
236 :<|> Capture "foo" String :> NestedAPI1
250 :<|> Capture "foo" String :> NestedAPI1
237
251
238data GenericClient = GenericClient
252data GenericClient = GenericClient
239− { getSqr :: Maybe Int -> SCR.ClientM Int
253+ { getSqr :: Maybe Int -> ClientM Int
240 , mkNestedClient1 :: String -> NestedClient1
254 , mkNestedClient1 :: String -> NestedClient1
241 } deriving Generic
255 } deriving Generic
242instance SOP.Generic GenericClient
256instance SOP.Generic GenericClient
243−instance (Client GenericClientAPI ~ client) => ClientLike client GenericClient
257+instance (Client ClientM GenericClientAPI ~ client) => ClientLike client GenericClient
244
258
245type NestedAPI1
259type NestedAPI1
246 = QueryParam "int" Int :> NestedAPI2
260 = QueryParam "int" Int :> NestedAPI2
@@ -248,21 +262,21 @@ type NestedAPI1
248
262
249data NestedClient1 = NestedClient1
263data NestedClient1 = NestedClient1
250 { mkNestedClient2 :: Maybe Int -> NestedClient2
264 { mkNestedClient2 :: Maybe Int -> NestedClient2
251− , idChar :: Maybe Char -> SCR.ClientM Char
265+ , idChar :: Maybe Char -> ClientM Char
252 } deriving Generic
266 } deriving Generic
253instance SOP.Generic NestedClient1
267instance SOP.Generic NestedClient1
254−instance (Client NestedAPI1 ~ client) => ClientLike client NestedClient1
268+instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1
255
269
256type NestedAPI2
270type NestedAPI2
257 = "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
271 = "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
258 :<|> "void" :> Post '[JSON] ()
272 :<|> "void" :> Post '[JSON] ()
259
273
260data NestedClient2 = NestedClient2
274data NestedClient2 = NestedClient2
261− { getSum :: Int -> Int -> SCR.ClientM Int
275+ { getSum :: Int -> Int -> ClientM Int
262− , doNothing :: SCR.ClientM ()
276+ , doNothing :: ClientM ()
263 } deriving Generic
277 } deriving Generic
264instance SOP.Generic NestedClient2
278instance SOP.Generic NestedClient2
265−instance (Client NestedAPI2 ~ client) => ClientLike client NestedClient2
279+instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2
266
280
267genericClientServer :: Application
281genericClientServer :: Application
268genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
282genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
@@ -276,67 +290,70 @@ genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
276 nestedServer1 _str = nestedServer2 :<|> (maybe (throwError $ ServantErr 400 "missing parameter" "" []) return)
290 nestedServer1 _str = nestedServer2 :<|> (maybe (throwError $ ServantErr 400 "missing parameter" "" []) return)
277 nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()
291 nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()
278
292
279−{-# NOINLINE manager #-}
293+{-# NOINLINE manager' #-}
280−manager :: C.Manager
294+manager' :: C.Manager
281−manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
295+manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
296+
297+runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)
298+runClient x baseUrl' = runClientM x (ClientEnv manager' baseUrl')
282
299
283sucessSpec :: Spec
300sucessSpec :: Spec
284sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
301sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
285
302
286 it "Servant.API.Get" $ \(_, baseUrl) -> do
303 it "Servant.API.Get" $ \(_, baseUrl) -> do
287− (left show <$> (runClientM getGet (ClientEnv manager baseUrl))) `shouldReturn` Right alice
304+ left show <$> runClient getGet baseUrl `shouldReturn` Right alice
288
305
289 describe "Servant.API.Delete" $ do
306 describe "Servant.API.Delete" $ do
290 it "allows empty content type" $ \(_, baseUrl) -> do
307 it "allows empty content type" $ \(_, baseUrl) -> do
291− (left show <$> (runClientM getDeleteEmpty (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent
308+ left show <$> runClient getDeleteEmpty baseUrl `shouldReturn` Right NoContent
292
309
293 it "allows content type" $ \(_, baseUrl) -> do
310 it "allows content type" $ \(_, baseUrl) -> do
294− (left show <$> (runClientM getDeleteContentType (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent
311+ left show <$> runClient getDeleteContentType baseUrl `shouldReturn` Right NoContent
295
312
296 it "Servant.API.Capture" $ \(_, baseUrl) -> do
313 it "Servant.API.Capture" $ \(_, baseUrl) -> do
297− (left show <$> (runClientM (getCapture "Paula") (ClientEnv manager baseUrl))) `shouldReturn` Right (Person "Paula" 0)
314+ left show <$> runClient (getCapture "Paula") baseUrl `shouldReturn` Right (Person "Paula" 0)
298
315
299 it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do
316 it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do
300 let expected = [(Person "Paula" 0), (Person "Peta" 1)]
317 let expected = [(Person "Paula" 0), (Person "Peta" 1)]
301− (left show <$> (runClientM (getCaptureAll ["Paula", "Peta"]) (ClientEnv manager baseUrl))) `shouldReturn` Right expected
318+ left show <$> runClient (getCaptureAll ["Paula", "Peta"]) baseUrl `shouldReturn` Right expected
302
319
303 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
320 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
304 let p = Person "Clara" 42
321 let p = Person "Clara" 42
305− (left show <$> runClientM (getBody p) (ClientEnv manager baseUrl)) `shouldReturn` Right p
322+ left show <$> runClient (getBody p) baseUrl `shouldReturn` Right p
306
323
307 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
324 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
308− left show <$> runClientM (getQueryParam (Just "alice")) (ClientEnv manager baseUrl) `shouldReturn` Right alice
325+ left show <$> runClient (getQueryParam (Just "alice")) baseUrl `shouldReturn` Right alice
309− Left FailureResponse{..} <- runClientM (getQueryParam (Just "bob")) (ClientEnv manager baseUrl)
326+ Left (FailureResponse r) <- runClient (getQueryParam (Just "bob")) baseUrl
310− responseStatus `shouldBe` HTTP.Status 400 "bob not found"
327+ responseStatusCode r `shouldBe` HTTP.Status 400 "bob not found"
311
328
312 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
329 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
313− (left show <$> runClientM (getQueryParams []) (ClientEnv manager baseUrl)) `shouldReturn` Right []
330+ left show <$> runClient (getQueryParams []) baseUrl `shouldReturn` Right []
314− (left show <$> runClientM (getQueryParams ["alice", "bob"]) (ClientEnv manager baseUrl))
331+ left show <$> runClient (getQueryParams ["alice", "bob"]) baseUrl
315 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
332 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
316
333
317 context "Servant.API.QueryParam.QueryFlag" $
334 context "Servant.API.QueryParam.QueryFlag" $
318 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
335 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
319− (left show <$> runClientM (getQueryFlag flag) (ClientEnv manager baseUrl)) `shouldReturn` Right flag
336+ left show <$> runClient (getQueryFlag flag) baseUrl `shouldReturn` Right flag
320
337
321 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
338 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
322− res <- runClientM (getRawSuccess HTTP.methodGet) (ClientEnv manager baseUrl)
339+ res <- runClient (getRawSuccess HTTP.methodGet) baseUrl
323 case res of
340 case res of
324 Left e -> assertFailure $ show e
341 Left e -> assertFailure $ show e
325− Right (code, body, ct, _, response) -> do
342+ Right r -> do
326− (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
343+ responseStatusCode r `shouldBe` HTTP.status200
327− C.responseBody response `shouldBe` body
344+ responseBody r `shouldBe` "rawSuccess"
328− C.responseStatus response `shouldBe` HTTP.ok200
329
345
330 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
346 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
331− res <- runClientM (getRawFailure HTTP.methodGet) (ClientEnv manager baseUrl)
347+ res <- runClient (getRawFailure HTTP.methodGet) baseUrl
332 case res of
348 case res of
333 Right _ -> assertFailure "expected Left, but got Right"
349 Right _ -> assertFailure "expected Left, but got Right"
334− Left e -> do
350+ Left (FailureResponse r) -> do
335− Servant.Client.responseStatus e `shouldBe` HTTP.status400
351+ responseStatusCode r `shouldBe` HTTP.status400
336− Servant.Client.responseBody e `shouldBe` "rawFailure"
352+ responseBody r `shouldBe` "rawFailure"
353+ Left e -> assertFailure $ "expected FailureResponse, but got " ++ show e
337
354
338 it "Returns headers appropriately" $ \(_, baseUrl) -> do
355 it "Returns headers appropriately" $ \(_, baseUrl) -> do
339− res <- runClientM getRespHeaders (ClientEnv manager baseUrl)
356+ res <- runClient getRespHeaders baseUrl
340 case res of
357 case res of
341 Left e -> assertFailure $ show e
358 Left e -> assertFailure $ show e
342 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
359 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
@@ -345,7 +362,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
345 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
362 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
346 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
363 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
347 ioProperty $ do
364 ioProperty $ do
348− result <- left show <$> runClientM (getMultiple cap num flag body) (ClientEnv manager baseUrl)
365+ result <- left show <$> runClient (getMultiple cap num flag body) baseUrl
349 return $
366 return $
350 result === Right (cap, num, flag, body)
367 result === Right (cap, num, flag, body)
351
368
@@ -357,10 +374,10 @@ wrappedApiSpec = describe "error status codes" $ do
357 let test :: (WrappedApi, String) -> Spec
374 let test :: (WrappedApi, String) -> Spec
358 test (WrappedApi api, desc) =
375 test (WrappedApi api, desc) =
359 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
376 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
360− let getResponse :: SCR.ClientM ()
377+ let getResponse :: ClientM ()
361 getResponse = client api
378 getResponse = client api
362− Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl)
379+ Left (FailureResponse r) <- runClient getResponse baseUrl
363− responseStatus `shouldBe` (HTTP.Status 500 "error message")
380+ responseStatusCode r `shouldBe` (HTTP.Status 500 "error message")
364 in mapM_ test $
381 in mapM_ test $
365 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
382 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
366 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
383 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
@@ -374,42 +391,42 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
374 context "client returns errors appropriately" $ do
391 context "client returns errors appropriately" $ do
375 it "reports FailureResponse" $ \(_, baseUrl) -> do
392 it "reports FailureResponse" $ \(_, baseUrl) -> do
376 let (_ :<|> getDeleteEmpty :<|> _) = client api
393 let (_ :<|> getDeleteEmpty :<|> _) = client api
377− Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
394+ Left res <- runClient getDeleteEmpty baseUrl
378 case res of
395 case res of
379− FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return ()
396+ FailureResponse r | responseStatusCode r == HTTP.status404 -> return ()
380 _ -> fail $ "expected 404 response, but got " <> show res
397 _ -> fail $ "expected 404 response, but got " <> show res
381
398
382 it "reports DecodeFailure" $ \(_, baseUrl) -> do
399 it "reports DecodeFailure" $ \(_, baseUrl) -> do
383 let (_ :<|> _ :<|> getCapture :<|> _) = client api
400 let (_ :<|> _ :<|> getCapture :<|> _) = client api
384− Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl)
401+ Left res <- runClient (getCapture "foo") baseUrl
385 case res of
402 case res of
386− DecodeFailure _ ("application/json") _ -> return ()
403+ DecodeFailure _ _ -> return ()
387 _ -> fail $ "expected DecodeFailure, but got " <> show res
404 _ -> fail $ "expected DecodeFailure, but got " <> show res
388
405
389 it "reports ConnectionError" $ \_ -> do
406 it "reports ConnectionError" $ \_ -> do
390 let (getGetWrongHost :<|> _) = client api
407 let (getGetWrongHost :<|> _) = client api
391− Left res <- runClientM getGetWrongHost (ClientEnv manager (BaseUrl Http "127.0.0.1" 19872 ""))
408+ Left res <- runClient getGetWrongHost (BaseUrl Http "127.0.0.1" 19872 "")
392 case res of
409 case res of
393 ConnectionError _ -> return ()
410 ConnectionError _ -> return ()
394 _ -> fail $ "expected ConnectionError, but got " <> show res
411 _ -> fail $ "expected ConnectionError, but got " <> show res
395
412
396 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
413 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
397 let (getGet :<|> _ ) = client api
414 let (getGet :<|> _ ) = client api
398− Left res <- runClientM getGet (ClientEnv manager baseUrl)
415+ Left res <- runClient getGet baseUrl
399 case res of
416 case res of
400 UnsupportedContentType ("application/octet-stream") _ -> return ()
417 UnsupportedContentType ("application/octet-stream") _ -> return ()
401 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
418 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
402
419
403 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
420 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
404 let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
421 let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
405− Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl)
422+ Left res <- runClient (getBody alice) baseUrl
406 case res of
423 case res of
407− InvalidContentTypeHeader "fooooo" _ -> return ()
424+ InvalidContentTypeHeader _ -> return ()
408 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
425 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
409
426
410data WrappedApi where
427data WrappedApi where
411 WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,
428 WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,
412− HasClient api, Client api ~ SCR.ClientM ()) =>
429+ HasClient ClientM api, Client ClientM api ~ ClientM ()) =>
413 Proxy api -> WrappedApi
430 Proxy api -> WrappedApi
414
431
415basicAuthSpec :: Spec
432basicAuthSpec :: Spec
@@ -419,15 +436,15 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
419 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
436 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
420 let getBasic = client basicAuthAPI
437 let getBasic = client basicAuthAPI
421 let basicAuthData = BasicAuthData "servant" "server"
438 let basicAuthData = BasicAuthData "servant" "server"
422− (left show <$> runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)) `shouldReturn` Right alice
439+ left show <$> runClient (getBasic basicAuthData) baseUrl `shouldReturn` Right alice
423
440
424 context "Authentication is rejected when requests are not authenticated properly" $ do
441 context "Authentication is rejected when requests are not authenticated properly" $ do
425
442
426 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
443 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
427 let getBasic = client basicAuthAPI
444 let getBasic = client basicAuthAPI
428 let basicAuthData = BasicAuthData "not" "password"
445 let basicAuthData = BasicAuthData "not" "password"
429− Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)
446+ Left (FailureResponse r) <- runClient (getBasic basicAuthData) baseUrl
430− responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
447+ responseStatusCode r `shouldBe` HTTP.Status 403 "Forbidden"
431
448
432genAuthSpec :: Spec
449genAuthSpec :: Spec
433genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
450genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
@@ -435,16 +452,16 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
435
452
436 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
453 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
437 let getProtected = client genAuthAPI
454 let getProtected = client genAuthAPI
438− let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
455+ let authRequest = Auth.mkAuthenticatedRequest () (\_ req -> Req.addHeader "AuthHeader" ("cool" :: String) req)
439− (left show <$> runClientM (getProtected authRequest) (ClientEnv manager baseUrl)) `shouldReturn` Right alice
456+ left show <$> runClient (getProtected authRequest) baseUrl `shouldReturn` Right alice
440
457
441 context "Authentication is rejected when requests are not authenticated properly" $ do
458 context "Authentication is rejected when requests are not authenticated properly" $ do
442
459
443 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
460 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
444 let getProtected = client genAuthAPI
461 let getProtected = client genAuthAPI
445− let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
462+ let authRequest = Auth.mkAuthenticatedRequest () (\_ req -> Req.addHeader "Wrong" ("header" :: String) req)
446− Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)
463+ Left (FailureResponse r) <- runClient (getProtected authRequest) baseUrl
447− responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
464+ responseStatusCode r `shouldBe` (HTTP.Status 401 "Unauthorized")
448
465
449genericClientSpec :: Spec
466genericClientSpec :: Spec
450genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
467genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
@@ -454,13 +471,13 @@ genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWa
454 NestedClient1{..} = mkNestedClient1 "example"
471 NestedClient1{..} = mkNestedClient1 "example"
455 NestedClient2{..} = mkNestedClient2 (Just 42)
472 NestedClient2{..} = mkNestedClient2 (Just 42)
456
473
457− it "works for top-level client function" $ \(_, baseUrl) -> do
474+ it "works for top-level client inClientM function" $ \(_, baseUrl) -> do
458− (left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25
475+ left show <$> runClient (getSqr (Just 5)) baseUrl `shouldReturn` Right 25
459
476
460 it "works for nested clients" $ \(_, baseUrl) -> do
477 it "works for nested clients" $ \(_, baseUrl) -> do
461− (left show <$> (runClientM (idChar (Just 'c')) (ClientEnv manager baseUrl))) `shouldReturn` Right 'c'
478+ left show <$> runClient (idChar (Just 'c')) baseUrl `shouldReturn` Right 'c'
462− (left show <$> (runClientM (getSum 3 4) (ClientEnv manager baseUrl))) `shouldReturn` Right 7
479+ left show <$> runClient (getSum 3 4) baseUrl `shouldReturn` Right 7
463− (left show <$> (runClientM doNothing (ClientEnv manager baseUrl))) `shouldReturn` Right ()
480+ left show <$> runClient doNothing baseUrl `shouldReturn` Right ()
464
481
465-- * utils
482-- * utils
466
483
stack-ghc-7.10.3.yaml+1
@@ -2,6 +2,7 @@ flags: {}
2packages:
2packages:
3- servant/
3- servant/
4- servant-client/
4- servant-client/
5+- servant-client-core/
5- servant-docs/
6- servant-docs/
6- servant-foreign/
7- servant-foreign/
7- servant-server/
8- servant-server/
stack-ghc-7.8.4.yaml+2
@@ -2,6 +2,7 @@ flags: {}
2packages:
2packages:
3- servant/
3- servant/
4- servant-client/
4- servant-client/
5+- servant-client-core/
5- servant-docs/
6- servant-docs/
6- servant-foreign/
7- servant-foreign/
7- servant-server/
8- servant-server/
@@ -19,6 +20,7 @@ extra-deps:
19- hspec-expectations-0.8.2
20- hspec-expectations-0.8.2
20- hspec-wai-0.8.0
21- hspec-wai-0.8.0
21- http-api-data-0.3.6
22- http-api-data-0.3.6
23+- http-client-0.4.30
22- natural-transformation-0.4
24- natural-transformation-0.4
23- primitive-0.6.1.0
25- primitive-0.6.1.0
24- servant-js-0.9.3
26- servant-js-0.9.3
stack-ghc-8.2.1.yaml+1
@@ -1,6 +1,7 @@
1resolver: nightly-2017-09-01
1resolver: nightly-2017-09-01
2packages:
2packages:
3- servant-client/
3- servant-client/
4+- servant-client-core/
4- servant-docs/
5- servant-docs/
5- servant-foreign/
6- servant-foreign/
6- servant-server/
7- servant-server/
stack.yaml+1
@@ -2,6 +2,7 @@ resolver: nightly-2017-04-01
2packages:
2packages:
3- servant/
3- servant/
4- servant-client/
4- servant-client/
5+- servant-client-core/
5- servant-docs/
6- servant-docs/
6- servant-foreign/
7- servant-foreign/
7- servant-server/
8- servant-server/