diff --git a/doc/tutorial/Client.lhs b/doc/tutorial/Client.lhs
index 9cb38a0e..a40ca7c6 100644
--- a/doc/tutorial/Client.lhs
+++ b/doc/tutorial/Client.lhs
@@ -15,14 +15,13 @@ need to have some language extensions and imports:
module Client where
-import Control.Monad.Trans.Except
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Data.Aeson
import Data.Proxy
import GHC.Generics
import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
import Servant.API
import Servant.Client
-import System.IO.Unsafe
```
Also, we need examples for some domain specific data types:
@@ -72,40 +71,34 @@ What we are going to get with **servant-client** here is 3 functions, one to que
``` haskell
position :: Int -- ^ value for "x"
-> Int -- ^ value for "y"
+ -> Manager -- ^ the HTTP client to use
+ -> BaseUrl -- ^ the URL at which the API can be found
-> ExceptT ServantError IO Position
hello :: Maybe String -- ^ an optional value for "name"
+ -> Manager -- ^ the HTTP client to use
+ -> BaseUrl -- ^ the URL at which the API can be found
-> ExceptT ServantError IO HelloMessage
marketing :: ClientInfo -- ^ value for the request body
+ -> Manager -- ^ the HTTP client to use
+ -> BaseUrl -- ^ the URL at which the API can be found
-> ExceptT ServantError IO Email
```
Each function makes available as an argument any value that the response may
depend on, as evidenced in the API type. How do we get these functions? By calling
-the function `client`. It takes three arguments:
+the function `client`. It takes one argument:
- a `Proxy` to your API,
-- a `BaseUrl`, consisting of the protocol, the host, the port and an optional subpath --
- this basically tells `client` where the service that you want to query is hosted,
-- a `Manager`, (from [http-client](http://hackage.haskell.org/package/http-client))
-which manages http connections.
``` haskell
api :: Proxy API
api = Proxy
-{-# NOINLINE __manager #-}
-__manager :: Manager
-__manager = unsafePerformIO $ newManager defaultManagerSettings
-
-position :<|> hello :<|> marketing =
- client api (BaseUrl Http "localhost" 8081 "") __manager
+position :<|> hello :<|> marketing = client api
```
-(Yes, the usage of `unsafePerformIO` is very ugly, we know. Hopefully soon it'll
-be possible to do without.)
-
As you can see in the code above, we just "pattern match our way" to these functions. If we try to derive less or more functions than there are endpoints in the API, we obviously get an error. The `BaseUrl` value there is just:
``` haskell ignore
@@ -127,16 +120,17 @@ data BaseUrl = BaseUrl
That's it. Let's now write some code that uses our client functions.
``` haskell
-queries :: ExceptT ServantError IO (Position, HelloMessage, Email)
-queries = do
- pos <- position 10 10
- message <- hello (Just "servant")
- em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])
+queries :: Manager -> BaseUrl -> ExceptT ServantError IO (Position, HelloMessage, Email)
+queries manager baseurl = do
+ pos <- position 10 10 manager baseurl
+ message <- hello (Just "servant") manager baseurl
+ em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) manager baseurl
return (pos, message, em)
run :: IO ()
run = do
- res <- runExceptT queries
+ manager <- newManager defaultManagerSettings
+ res <- runExceptT (queries manager (BaseUrl Http "localhost" 8081 ""))
case res of
Left err -> putStrLn $ "Error: " ++ show err
Right (pos, message, em) -> do
diff --git a/servant-client/CHANGELOG.md b/servant-client/CHANGELOG.md
index 0cddd5ea..cb2b720d 100644
--- a/servant-client/CHANGELOG.md
+++ b/servant-client/CHANGELOG.md
@@ -1,3 +1,6 @@
+
+* `client` no longer takes `BaseUrl` and `Manager` arguments. Instead, each function returned by `client` requires these two arguments.
+
0.5
----
diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs
index e73c05a4..9c2fcfbc 100644
--- a/servant-client/src/Servant/Client.hs
+++ b/servant-client/src/Servant/Client.hs
@@ -27,14 +27,13 @@ module Servant.Client
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
-import Control.Monad.Trans.Except
import Data.ByteString.Lazy (ByteString)
import Data.List
import Data.Proxy
import Data.String.Conversions
import Data.Text (unpack)
import GHC.TypeLits
-import Network.HTTP.Client (Response, Manager)
+import Network.HTTP.Client (Manager, Response)
import Network.HTTP.Media
import qualified Network.HTTP.Types as H
import qualified Network.HTTP.Types.Header as HTTP
@@ -54,19 +53,18 @@ import Servant.Common.Req
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
--- > getAllBooks :: ExceptT String IO [Book]
--- > postNewBook :: Book -> ExceptT String IO Book
--- > (getAllBooks :<|> postNewBook) = client myApi host manager
--- > where host = BaseUrl Http "localhost" 8080
-client :: HasClient layout => Proxy layout -> BaseUrl -> Manager -> Client layout
-client p baseurl = clientWithRoute p defReq baseurl
+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
+-- > (getAllBooks :<|> postNewBook) = client myApi
+client :: HasClient layout => Proxy layout -> Client layout
+client p = clientWithRoute p defReq
-- | This class lets us define how each API combinator
-- influences the creation of an HTTP request. It's mostly
-- an internal class, you can just use 'client'.
class HasClient layout where
type Client layout :: *
- clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Manager -> Client layout
+ clientWithRoute :: Proxy layout -> Req -> Client layout
-- | A client querying function for @a ':<|>' b@ will actually hand you
@@ -79,15 +77,14 @@ class HasClient layout where
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
--- > getAllBooks :: ExceptT String IO [Book]
--- > postNewBook :: Book -> ExceptT String IO Book
--- > (getAllBooks :<|> postNewBook) = client myApi host manager
--- > where host = BaseUrl Http "localhost" 8080
+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
+-- > (getAllBooks :<|> postNewBook) = client myApi
instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
type Client (a :<|> b) = Client a :<|> Client b
- clientWithRoute Proxy req baseurl manager =
- clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>
- clientWithRoute (Proxy :: Proxy b) req baseurl manager
+ clientWithRoute Proxy req =
+ clientWithRoute (Proxy :: Proxy a) req :<|>
+ clientWithRoute (Proxy :: Proxy b) req
-- | If you use a 'Capture' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
@@ -105,9 +102,8 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
--- > getBook :: Text -> ExceptT String IO Book
--- > getBook = client myApi host manager
--- > where host = BaseUrl Http "localhost" 8080
+-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book
+-- > getBook = client myApi
-- > -- then you can just use "getBook" to query that endpoint
instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
=> HasClient (Capture capture a :> sublayout) where
@@ -115,11 +111,9 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
type Client (Capture capture a :> sublayout) =
a -> Client sublayout
- clientWithRoute Proxy req baseurl manager val =
+ clientWithRoute Proxy req val =
clientWithRoute (Proxy :: Proxy sublayout)
(appendToPath p req)
- baseurl
- manager
where p = unpack (toUrlPiece val)
@@ -127,16 +121,17 @@ instance OVERLAPPABLE_
-- Note [Non-Empty Content Types]
(MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
) => HasClient (Verb method status cts' a) where
- type Client (Verb method status cts' a) = ExceptT ServantError IO a
- clientWithRoute Proxy req baseurl manager =
- snd <$> performRequestCT (Proxy :: Proxy ct) method req baseurl manager
+ type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a
+ clientWithRoute Proxy req manager baseurl =
+ snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl
where method = reflectMethod (Proxy :: Proxy method)
instance OVERLAPPING_
(ReflectMethod method) => HasClient (Verb method status cts NoContent) where
- type Client (Verb method status cts NoContent) = ExceptT ServantError IO NoContent
- clientWithRoute Proxy req baseurl manager =
- performRequestNoBody method req baseurl manager >> return NoContent
+ type Client (Verb method status cts NoContent)
+ = Manager -> BaseUrl -> ClientM NoContent
+ clientWithRoute Proxy req manager baseurl =
+ performRequestNoBody method req manager baseurl >> return NoContent
where method = reflectMethod (Proxy :: Proxy method)
instance OVERLAPPING_
@@ -144,10 +139,10 @@ instance OVERLAPPING_
( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
) => HasClient (Verb method status cts' (Headers ls a)) where
type Client (Verb method status cts' (Headers ls a))
- = ExceptT ServantError IO (Headers ls a)
- clientWithRoute Proxy req baseurl manager = do
+ = Manager -> BaseUrl -> ClientM (Headers ls a)
+ clientWithRoute Proxy req manager baseurl = do
let method = reflectMethod (Proxy :: Proxy method)
- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl manager
+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl
return $ Headers { getResponse = resp
, getHeadersHList = buildHeadersTo hdrs
}
@@ -156,10 +151,10 @@ instance OVERLAPPING_
( BuildHeadersTo ls, ReflectMethod method
) => HasClient (Verb method status cts (Headers ls NoContent)) where
type Client (Verb method status cts (Headers ls NoContent))
- = ExceptT ServantError IO (Headers ls NoContent)
- clientWithRoute Proxy req baseurl manager = do
+ = Manager -> BaseUrl -> ClientM (Headers ls NoContent)
+ clientWithRoute Proxy req manager baseurl = do
let method = reflectMethod (Proxy :: Proxy method)
- hdrs <- performRequestNoBody method req baseurl manager
+ hdrs <- performRequestNoBody method req manager baseurl
return $ Headers { getResponse = NoContent
, getHeadersHList = buildHeadersTo hdrs
}
@@ -186,9 +181,8 @@ instance OVERLAPPING_
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
--- > viewReferer :: Maybe Referer -> ExceptT String IO Book
--- > viewReferer = client myApi host
--- > where host = BaseUrl Http "localhost" 8080
+-- > viewReferer :: Maybe Referer -> Manager -> BaseUrl -> ClientM Book
+-- > viewReferer = client myApi
-- > -- then you can just use "viewRefer" to query that endpoint
-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
@@ -197,14 +191,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
type Client (Header sym a :> sublayout) =
Maybe a -> Client sublayout
- clientWithRoute Proxy req baseurl manager mval =
+ clientWithRoute Proxy req mval =
clientWithRoute (Proxy :: Proxy sublayout)
(maybe req
(\value -> Servant.Common.Req.addHeader hname value req)
mval
)
- baseurl
- manager
where hname = symbolVal (Proxy :: Proxy sym)
@@ -239,9 +231,8 @@ instance HasClient sublayout
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
--- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
--- > getBooksBy = client myApi host
--- > where host = BaseUrl Http "localhost" 8080
+-- > getBooksBy :: Maybe Text -> Manager -> BaseUrl -> ClientM [Book]
+-- > getBooksBy = client myApi
-- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books
-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
@@ -252,14 +243,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
Maybe a -> Client sublayout
-- if mparam = Nothing, we don't add it to the query string
- clientWithRoute Proxy req baseurl manager mparam =
+ clientWithRoute Proxy req mparam =
clientWithRoute (Proxy :: Proxy sublayout)
(maybe req
(flip (appendToQueryString pname) req . Just)
mparamText
)
- baseurl
- manager
where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym)
@@ -286,9 +275,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
--- > getBooksBy :: [Text] -> ExceptT String IO [Book]
--- > getBooksBy = client myApi host
--- > where host = BaseUrl Http "localhost" 8080
+-- > getBooksBy :: [Text] -> Manager -> BaseUrl -> ClientM [Book]
+-- > getBooksBy = client myApi
-- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy []' for all books
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
@@ -299,13 +287,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
type Client (QueryParams sym a :> sublayout) =
[a] -> Client sublayout
- clientWithRoute Proxy req baseurl manager paramlist =
+ clientWithRoute Proxy req paramlist =
clientWithRoute (Proxy :: Proxy sublayout)
(foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
req
paramlist'
)
- baseurl manager
where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym)
@@ -327,9 +314,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
--- > getBooks :: Bool -> ExceptT String IO [Book]
--- > getBooks = client myApi host
--- > where host = BaseUrl Http "localhost" 8080
+-- > getBooks :: Bool -> Manager -> BaseUrl -> ClientM [Book]
+-- > getBooks = client myApi
-- > -- then you can just use "getBooks" to query that endpoint.
-- > -- 'getBooksBy False' for all books
-- > -- 'getBooksBy True' to only get _already published_ books
@@ -339,13 +325,12 @@ instance (KnownSymbol sym, HasClient sublayout)
type Client (QueryFlag sym :> sublayout) =
Bool -> Client sublayout
- clientWithRoute Proxy req baseurl manager flag =
+ clientWithRoute Proxy req flag =
clientWithRoute (Proxy :: Proxy sublayout)
(if flag
then appendToQueryString paramname Nothing req
else req
)
- baseurl manager
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
@@ -353,11 +338,12 @@ instance (KnownSymbol sym, HasClient sublayout)
-- | Pick a 'Method' and specify where the server you want to query is. You get
-- back the full `Response`.
instance HasClient Raw where
- type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
+ type Client Raw
+ = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
- clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
- clientWithRoute Proxy req baseurl manager httpMethod = do
- performRequest httpMethod req baseurl manager
+ clientWithRoute :: Proxy Raw -> Req -> Client Raw
+ clientWithRoute Proxy req httpMethod = do
+ performRequest httpMethod req
-- | If you use a 'ReqBody' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
@@ -374,9 +360,8 @@ instance HasClient Raw where
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
--- > addBook :: Book -> ExceptT String IO Book
--- > addBook = client myApi host manager
--- > where host = BaseUrl Http "localhost" 8080
+-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book
+-- > addBook = client myApi
-- > -- then you can just use "addBook" to query that endpoint
instance (MimeRender ct a, HasClient sublayout)
=> HasClient (ReqBody (ct ': cts) a :> sublayout) where
@@ -384,43 +369,41 @@ instance (MimeRender ct a, HasClient sublayout)
type Client (ReqBody (ct ': cts) a :> sublayout) =
a -> Client sublayout
- clientWithRoute Proxy req baseurl manager body =
+ clientWithRoute Proxy req body =
clientWithRoute (Proxy :: Proxy sublayout)
(let ctProxy = Proxy :: Proxy ct
in setRQBody (mimeRender ctProxy body)
(contentType ctProxy)
req
)
- baseurl manager
-- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
type Client (path :> sublayout) = Client sublayout
- clientWithRoute Proxy req baseurl manager =
+ clientWithRoute Proxy req =
clientWithRoute (Proxy :: Proxy sublayout)
(appendToPath p req)
- baseurl manager
where p = symbolVal (Proxy :: Proxy path)
instance HasClient api => HasClient (Vault :> api) where
type Client (Vault :> api) = Client api
- clientWithRoute Proxy req baseurl manager =
- clientWithRoute (Proxy :: Proxy api) req baseurl manager
+ clientWithRoute Proxy req =
+ clientWithRoute (Proxy :: Proxy api) req
instance HasClient api => HasClient (RemoteHost :> api) where
type Client (RemoteHost :> api) = Client api
- clientWithRoute Proxy req baseurl manager =
- clientWithRoute (Proxy :: Proxy api) req baseurl manager
+ clientWithRoute Proxy req =
+ clientWithRoute (Proxy :: Proxy api) req
instance HasClient api => HasClient (IsSecure :> api) where
type Client (IsSecure :> api) = Client api
- clientWithRoute Proxy req baseurl manager =
- clientWithRoute (Proxy :: Proxy api) req baseurl manager
+ clientWithRoute Proxy req =
+ clientWithRoute (Proxy :: Proxy api) req
instance HasClient subapi =>
HasClient (WithNamedContext name context subapi) where
@@ -433,16 +416,16 @@ instance ( HasClient api
type Client (AuthProtect tag :> api)
= AuthenticateReq (AuthProtect tag) -> Client api
- clientWithRoute Proxy req baseurl manager (AuthenticateReq (val,func)) =
- clientWithRoute (Proxy :: Proxy api) (func val req) baseurl manager
+ clientWithRoute Proxy req (AuthenticateReq (val,func)) =
+ clientWithRoute (Proxy :: Proxy api) (func val req)
-- * Basic Authentication
instance HasClient api => HasClient (BasicAuth realm usr :> api) where
type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api
- clientWithRoute Proxy req baseurl manager val =
- clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) baseurl manager
+ clientWithRoute Proxy req val =
+ clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req)
{- Note [Non-Empty Content Types]
diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs
index 3d72acd9..52398637 100644
--- a/servant-client/src/Servant/Common/Req.hs
+++ b/servant-client/src/Servant/Common/Req.hs
@@ -123,11 +123,12 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
displayHttpRequest :: Method -> String
displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
+type ClientM = ExceptT ServantError IO
-performRequest :: Method -> Req -> BaseUrl -> Manager
- -> ExceptT ServantError IO ( Int, ByteString, MediaType
- , [HTTP.Header], Response ByteString)
-performRequest reqMethod req reqHost manager = do
+performRequest :: Method -> Req -> Manager -> BaseUrl
+ -> ClientM ( Int, ByteString, MediaType
+ , [HTTP.Header], Response ByteString)
+performRequest reqMethod req manager reqHost = do
partialRequest <- liftIO $ reqToRequest req reqHost
let request = partialRequest { Client.method = reqMethod
@@ -155,21 +156,21 @@ performRequest reqMethod req reqHost manager = do
performRequestCT :: MimeUnrender ct result =>
- Proxy ct -> Method -> Req -> BaseUrl -> Manager
- -> ExceptT ServantError IO ([HTTP.Header], result)
-performRequestCT ct reqMethod req reqHost manager = do
+ Proxy ct -> Method -> Req -> Manager -> BaseUrl
+ -> ClientM ([HTTP.Header], result)
+performRequestCT ct reqMethod req manager reqHost = do
let acceptCT = contentType ct
(_status, respBody, respCT, hdrs, _response) <-
- performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager
+ performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost
unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
case mimeUnrender ct respBody of
Left err -> throwE $ DecodeFailure err respCT respBody
Right val -> return (hdrs, val)
-performRequestNoBody :: Method -> Req -> BaseUrl -> Manager
- -> ExceptT ServantError IO [HTTP.Header]
-performRequestNoBody reqMethod req reqHost manager = do
- (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req reqHost manager
+performRequestNoBody :: Method -> Req -> Manager -> BaseUrl
+ -> ClientM [HTTP.Header]
+performRequestNoBody reqMethod req manager reqHost = do
+ (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost
return hdrs
catchConnectionError :: IO a -> IO (Either ServantError a)
diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs
index 0ad3b70e..2263e9e2 100644
--- a/servant-client/test/Servant/ClientSpec.hs
+++ b/servant-client/test/Servant/ClientSpec.hs
@@ -28,19 +28,18 @@ import Control.Applicative ((<$>))
import Control.Arrow (left)
import Control.Concurrent (forkIO, killThread, ThreadId)
import Control.Exception (bracket)
-import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
+import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
import Data.Aeson
+import qualified Data.ByteString.Lazy as BS
import Data.Char (chr, isPrint)
import Data.Foldable (forM_)
import Data.Monoid hiding (getLast)
import Data.Proxy
import qualified Data.Text as T
import GHC.Generics (Generic)
-import GHC.TypeLits
import qualified Network.HTTP.Client as C
import Network.HTTP.Media
-import Network.HTTP.Types (Status (..), badRequest400,
- methodGet, ok200, status400)
+import qualified Network.HTTP.Types as HTTP
import Network.Socket
import Network.Wai (Application, Request,
requestHeaders, responseLBS)
@@ -120,6 +119,34 @@ type Api =
api :: Proxy Api
api = Proxy
+getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person
+getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
+getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person
+getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person
+getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person
+getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]
+getQueryFlag :: Bool -> C.Manager -> BaseUrl -> SCR.ClientM Bool
+getRawSuccess :: HTTP.Method -> C.Manager -> BaseUrl
+ -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
+getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl
+ -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl
+ -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
+getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool)
+getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
+getGet
+ :<|> getDeleteEmpty
+ :<|> getCapture
+ :<|> getBody
+ :<|> getQueryParam
+ :<|> getQueryParams
+ :<|> getQueryFlag
+ :<|> getRawSuccess
+ :<|> getRawFailure
+ :<|> getMultiple
+ :<|> getRespHeaders
+ :<|> getDeleteContentType = client api
+
server :: Application
server = serve api (
return alice
@@ -132,8 +159,8 @@ server = serve api (
Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
- :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
- :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
+ :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")
+ :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure")
:<|> (\ a b c d -> return (a, b, c, d))
:<|> (return $ addHeader 1729 $ addHeader "eg2" True)
:<|> return NoContent
@@ -149,9 +176,9 @@ failApi = Proxy
failServer :: Application
failServer = serve failApi (
- (\ _request respond -> respond $ responseLBS ok200 [] "")
- :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
- :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
+ (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
+ :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")
+ :<|> (\_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
)
-- * basic auth stuff
@@ -208,76 +235,64 @@ sucessSpec :: Spec
sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
it "Servant.API.Get" $ \(_, baseUrl) -> do
- let getGet = getNth (Proxy :: Proxy 0) $ client api baseUrl manager
- (left show <$> runExceptT getGet) `shouldReturn` Right alice
+ (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice
describe "Servant.API.Delete" $ do
it "allows empty content type" $ \(_, baseUrl) -> do
- let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api baseUrl manager
- (left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right NoContent
+ (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent
it "allows content type" $ \(_, baseUrl) -> do
- let getDeleteContentType = getLast $ client api baseUrl manager
- (left show <$> runExceptT getDeleteContentType) `shouldReturn` Right NoContent
+ (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent
it "Servant.API.Capture" $ \(_, baseUrl) -> do
- let getCapture = getNth (Proxy :: Proxy 2) $ client api baseUrl manager
- (left show <$> runExceptT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
+ (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
let p = Person "Clara" 42
- getBody = getNth (Proxy :: Proxy 3) $ client api baseUrl manager
- (left show <$> runExceptT (getBody p)) `shouldReturn` Right p
+ (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p
it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
- let getQueryParam = getNth (Proxy :: Proxy 4) $ client api baseUrl manager
- left show <$> runExceptT (getQueryParam (Just "alice")) `shouldReturn` Right alice
- Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob"))
- responseStatus `shouldBe` Status 400 "bob not found"
+ left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice
+ Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)
+ responseStatus `shouldBe` HTTP.Status 400 "bob not found"
it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
- let getQueryParams = getNth (Proxy :: Proxy 5) $ client api baseUrl manager
- (left show <$> runExceptT (getQueryParams [])) `shouldReturn` Right []
- (left show <$> runExceptT (getQueryParams ["alice", "bob"]))
+ (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []
+ (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl))
`shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.QueryParam.QueryFlag" $
forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
- let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api baseUrl manager
- (left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag
+ (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag
it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
- let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api baseUrl manager
- res <- runExceptT (getRawSuccess methodGet)
+ res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl)
case res of
Left e -> assertFailure $ show e
Right (code, body, ct, _, response) -> do
(code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
C.responseBody response `shouldBe` body
- C.responseStatus response `shouldBe` ok200
+ C.responseStatus response `shouldBe` HTTP.ok200
it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
- let getRawFailure = getNth (Proxy :: Proxy 8) $ client api baseUrl manager
- res <- runExceptT (getRawFailure methodGet)
+ res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl)
case res of
Right _ -> assertFailure "expected Left, but got Right"
Left e -> do
- Servant.Client.responseStatus e `shouldBe` status400
+ Servant.Client.responseStatus e `shouldBe` HTTP.status400
Servant.Client.responseBody e `shouldBe` "rawFailure"
it "Returns headers appropriately" $ \(_, baseUrl) -> do
- let getRespHeaders = getNth (Proxy :: Proxy 10) $ client api baseUrl manager
- res <- runExceptT getRespHeaders
+ res <- runExceptT (getRespHeaders manager baseUrl)
case res of
Left e -> assertFailure $ show e
Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
modifyMaxSuccess (const 20) $ do
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
- let getMultiple = getNth (Proxy :: Proxy 9) $ client api baseUrl manager
- in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
+ property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
ioProperty $ do
- result <- left show <$> runExceptT (getMultiple cap num flag body)
+ result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl)
return $
result === Right (cap, num, flag, body)
@@ -289,10 +304,10 @@ wrappedApiSpec = describe "error status codes" $ do
let test :: (WrappedApi, String) -> Spec
test (WrappedApi api, desc) =
it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
- let getResponse :: ExceptT ServantError IO ()
- getResponse = client api baseUrl manager
- Left FailureResponse{..} <- runExceptT getResponse
- responseStatus `shouldBe` (Status 500 "error message")
+ let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM ()
+ getResponse = client api
+ Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl)
+ responseStatus `shouldBe` (HTTP.Status 500 "error message")
in mapM_ test $
(WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
@@ -305,43 +320,43 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
context "client returns errors appropriately" $ do
it "reports FailureResponse" $ \(_, baseUrl) -> do
- let (_ :<|> getDeleteEmpty :<|> _) = client api baseUrl manager
- Left res <- runExceptT getDeleteEmpty
+ let (_ :<|> getDeleteEmpty :<|> _) = client api
+ Left res <- runExceptT (getDeleteEmpty manager baseUrl)
case res of
- FailureResponse (Status 404 "Not Found") _ _ -> return ()
+ FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
_ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ \(_, baseUrl) -> do
- let (_ :<|> _ :<|> getCapture :<|> _) = client api baseUrl manager
- Left res <- runExceptT (getCapture "foo")
+ let (_ :<|> _ :<|> getCapture :<|> _) = client api
+ Left res <- runExceptT (getCapture "foo" manager baseUrl)
case res of
DecodeFailure _ ("application/json") _ -> return ()
_ -> fail $ "expected DecodeFailure, but got " <> show res
it "reports ConnectionError" $ \_ -> do
- let (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager
- Left res <- runExceptT getGetWrongHost
+ let (getGetWrongHost :<|> _) = client api
+ Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 ""))
case res of
ConnectionError _ -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
- let (getGet :<|> _ ) = client api baseUrl manager
- Left res <- runExceptT getGet
+ let (getGet :<|> _ ) = client api
+ Left res <- runExceptT (getGet manager baseUrl)
case res of
UnsupportedContentType ("application/octet-stream") _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
- let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api baseUrl manager
- Left res <- runExceptT (getBody alice)
+ let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
+ Left res <- runExceptT (getBody alice manager baseUrl)
case res of
InvalidContentTypeHeader "fooooo" _ -> return ()
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
data WrappedApi where
WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
- HasClient api, Client api ~ ExceptT ServantError IO ()) =>
+ HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) =>
Proxy api -> WrappedApi
basicAuthSpec :: Spec
@@ -349,34 +364,34 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
context "Authentication works when requests are properly authenticated" $ do
it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
- let getBasic = client basicAuthAPI baseUrl manager
+ let getBasic = client basicAuthAPI
let basicAuthData = BasicAuthData "servant" "server"
- (left show <$> runExceptT (getBasic basicAuthData)) `shouldReturn` Right alice
+ (left show <$> runExceptT (getBasic basicAuthData manager baseUrl)) `shouldReturn` Right alice
context "Authentication is rejected when requests are not authenticated properly" $ do
it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
- let getBasic = client basicAuthAPI baseUrl manager
+ let getBasic = client basicAuthAPI
let basicAuthData = BasicAuthData "not" "password"
- Left FailureResponse{..} <- runExceptT (getBasic basicAuthData)
- responseStatus `shouldBe` Status 403 "Forbidden"
+ Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)
+ responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
genAuthSpec :: Spec
genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
context "Authentication works when requests are properly authenticated" $ do
it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
- let getProtected = client genAuthAPI baseUrl manager
+ let getProtected = client genAuthAPI
let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
- (left show <$> runExceptT (getProtected authRequest)) `shouldReturn` Right alice
+ (left show <$> runExceptT (getProtected authRequest manager baseUrl)) `shouldReturn` Right alice
context "Authentication is rejected when requests are not authenticated properly" $ do
it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
- let getProtected = client genAuthAPI baseUrl manager
+ let getProtected = client genAuthAPI
let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
- Left FailureResponse{..} <- runExceptT (getProtected authRequest)
- responseStatus `shouldBe` (Status 401 "Unauthorized")
+ Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)
+ responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
-- * utils
@@ -407,25 +422,3 @@ pathGen = fmap NonEmpty path
filter (not . (`elem` ("?%[]/#;" :: String))) $
filter isPrint $
map chr [0..127]
-
-class GetNth (n :: Nat) a b | n a -> b where
- getNth :: Proxy n -> a -> b
-
-instance OVERLAPPING_
- GetNth 0 (x :<|> y) x where
- getNth _ (x :<|> _) = x
-
-instance OVERLAPPING_
- (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where
- getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x
-
-class GetLast a b | a -> b where
- getLast :: a -> b
-
-instance OVERLAPPING_
- (GetLast b c) => GetLast (a :<|> b) c where
- getLast (_ :<|> b) = getLast b
-
-instance OVERLAPPING_
- GetLast a a where
- getLast a = a