eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

expose client runner as a typeclass with base implementation #798

Browse source 
* defined a typeclass abstracting the execution of a query
* provide ClientM-based instances for this typeclass
* changed signature of client and clientWithRoute to add proxy for
  context
* updated tests
This commit is contained in:
Arnaud Bailly 2017-09-03 08:49:24 +02:00
parent 3058a54458
commit 2dcc92bd9a
4 changed files with 126 additions and 117 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client/servant-client.cabal
View file

@ -30,6 +30,7 @@ source-repository head
library library
exposed-modules: exposed-modules:
Servant.Client Servant.Client
Servant.Client.Class
Servant.Client.HttpClient Servant.Client.HttpClient
Servant.Client.Generic Servant.Client.Generic
Servant.Client.Experimental.Auth Servant.Client.Experimental.Auth

199
servant-client/src/Servant/Client.hs
View file

@ -1,15 +1,16 @@
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#include "overlapping-compat.h" #include "overlapping-compat.h"
-- | This module provides 'client' which can automatically generate -- | This module provides 'client' which can automatically generate
@ -62,15 +63,15 @@ import Servant.Common.Req
-- > getAllBooks :: ClientM [Book] -- > getAllBooks :: ClientM [Book]
-- > postNewBook :: Book -> ClientM Book -- > postNewBook :: Book -> ClientM Book
-- > (getAllBooks :<|> postNewBook) = client myApi -- > (getAllBooks :<|> postNewBook) = client myApi
client :: HasClient api => Proxy api -> Client m api client :: HasClient m api => Proxy m -> Proxy api -> Client m api
client p = clientWithRoute p defReq client pm p = clientWithRoute pm p defReq
-- | This class lets us define how each API combinator -- | This class lets us define how each API combinator
-- influences the creation of an HTTP request. It's mostly -- influences the creation of an HTTP request. It's mostly
-- an internal class, you can just use 'client'. -- an internal class, you can just use 'client'.
class HasClient api where class HasClient m api where
type Client (m :: * -> *) (api :: *) :: * type Client (m :: * -> *) (api :: *) :: *
clientWithRoute :: Proxy api -> Req -> Client m api clientWithRoute :: Proxy m -> Proxy api -> Req -> Client m api
-- | A client querying function for @a ':<|>' b@ will actually hand you -- | A client querying function for @a ':<|>' b@ will actually hand you
@ -86,11 +87,11 @@ class HasClient api where
-- > getAllBooks :: ClientM [Book] -- > getAllBooks :: ClientM [Book]
-- > postNewBook :: Book -> ClientM Book -- > postNewBook :: Book -> ClientM Book
-- > (getAllBooks :<|> postNewBook) = client myApi -- > (getAllBooks :<|> postNewBook) = client myApi
instance (HasClient a, HasClient b) => HasClient (a :<|> b) where instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where
type Client m (a :<|> b) = Client m a :<|> Client m b type Client m (a :<|> b) = Client m a :<|> Client m b
clientWithRoute Proxy req = clientWithRoute pm Proxy req =
clientWithRoute (Proxy :: Proxy a) req :<|> clientWithRoute pm (Proxy :: Proxy a) req :<|>
clientWithRoute (Proxy :: Proxy b) req clientWithRoute pm (Proxy :: Proxy b) req
-- | Singleton type representing a client for an empty API. -- | Singleton type representing a client for an empty API.
data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum) data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
@ -105,9 +106,9 @@ data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
-- > -- >
-- > getAllBooks :: ClientM [Book] -- > getAllBooks :: ClientM [Book]
-- > (getAllBooks :<|> EmptyClient) = client myApi -- > (getAllBooks :<|> EmptyClient) = client myApi
instance HasClient EmptyAPI where instance HasClient m EmptyAPI where
type Client m EmptyAPI = EmptyClient type Client m EmptyAPI = EmptyClient
clientWithRoute Proxy _ = EmptyClient clientWithRoute pm Proxy _ = EmptyClient
-- | If you use a 'Capture' in one of your endpoints in your API, -- | If you use a 'Capture' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -128,14 +129,14 @@ instance HasClient EmptyAPI where
-- > getBook :: Text -> ClientM Book -- > getBook :: Text -> ClientM Book
-- > getBook = client myApi -- > getBook = client myApi
-- > -- then you can just use "getBook" to query that endpoint -- > -- then you can just use "getBook" to query that endpoint
instance (KnownSymbol capture, ToHttpApiData a, HasClient api) instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
=> HasClient (Capture capture a :> api) where => HasClient m (Capture capture a :> api) where
type Client m (Capture capture a :> api) = type Client m (Capture capture a :> api) =
a -> Client m api a -> Client m api
clientWithRoute Proxy req val = clientWithRoute pm Proxy req val =
clientWithRoute (Proxy :: Proxy api) clientWithRoute pm (Proxy :: Proxy api)
(appendToPath p req) (appendToPath p req)
where p = unpack (toUrlPiece val) where p = unpack (toUrlPiece val)
@ -160,14 +161,14 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient api)
-- > getSourceFile :: [Text] -> ClientM SourceFile -- > getSourceFile :: [Text] -> ClientM SourceFile
-- > getSourceFile = client myApi -- > getSourceFile = client myApi
-- > -- then you can use "getSourceFile" to query that endpoint -- > -- then you can use "getSourceFile" to query that endpoint
instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
=> HasClient (CaptureAll capture a :> sublayout) where => HasClient m (CaptureAll capture a :> sublayout) where
type Client m (CaptureAll capture a :> sublayout) = type Client m (CaptureAll capture a :> sublayout) =
[a] -> Client m sublayout [a] -> Client m sublayout
clientWithRoute Proxy req vals = clientWithRoute pm Proxy req vals =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute pm (Proxy :: Proxy sublayout)
(foldl' (flip appendToPath) req ps) (foldl' (flip appendToPath) req ps)
where ps = map (unpack . toUrlPiece) vals where ps = map (unpack . toUrlPiece) vals
@ -175,27 +176,31 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
instance OVERLAPPABLE_ instance OVERLAPPABLE_
-- Note [Non-Empty Content Types] -- Note [Non-Empty Content Types]
(RunClient m ct ([H.Header], a), MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts) (RunClient m ct ([H.Header], a), MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
) => HasClient (Verb method status cts' a) where ) => HasClient m (Verb method status cts' a) where
type Client m (Verb method status cts' a) = m a type Client m (Verb method status cts' a) = m a
clientWithRoute Proxy req = do clientWithRoute pm Proxy req = do
snd <$> runRequest (Proxy :: Proxy ct) method req (_hdrs, a) :: ([H.Header], a) <- runRequest (Proxy :: Proxy ct) method req
return a
where method = reflectMethod (Proxy :: Proxy method) where method = reflectMethod (Proxy :: Proxy method)
instance OVERLAPPING_ instance OVERLAPPING_
(RunClient m NoContent [H.Header], ReflectMethod method) => HasClient (Verb method status cts NoContent) where ( RunClient m NoContent [HTTP.Header]
, ReflectMethod method) => HasClient m (Verb method status cts NoContent) where
type Client m (Verb method status cts NoContent) type Client m (Verb method status cts NoContent)
= m NoContent = m NoContent
clientWithRoute Proxy req = do clientWithRoute pm Proxy req = do
runRequest (Proxy :: Proxy NoContent) method req >> return NoContent _hdrs :: [H.Header] <- runRequest (Proxy :: Proxy NoContent) method req
return NoContent
where method = reflectMethod (Proxy :: Proxy method) where method = reflectMethod (Proxy :: Proxy method)
instance OVERLAPPING_ instance OVERLAPPING_
-- Note [Non-Empty Content Types] -- Note [Non-Empty Content Types]
( RunClient m ct ([H.Header], a), MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts) ( RunClient m ct ([H.Header], a)
) => HasClient (Verb method status cts' (Headers ls a)) where , MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
) => HasClient m (Verb method status cts' (Headers ls a)) where
type Client m (Verb method status cts' (Headers ls a)) type Client m (Verb method status cts' (Headers ls a))
= m (Headers ls a) = m (Headers ls a)
clientWithRoute Proxy req = do clientWithRoute pm Proxy req = do
let method = reflectMethod (Proxy :: Proxy method) let method = reflectMethod (Proxy :: Proxy method)
(hdrs, resp) <- runRequest (Proxy :: Proxy ct) method req (hdrs, resp) <- runRequest (Proxy :: Proxy ct) method req
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -203,13 +208,14 @@ instance OVERLAPPING_
} }
instance OVERLAPPING_ instance OVERLAPPING_
( RunClient m NoContent [H.Header], BuildHeadersTo ls, ReflectMethod method ( RunClient m NoContent [H.Header]
) => HasClient (Verb method status cts (Headers ls NoContent)) where , BuildHeadersTo ls, ReflectMethod method
) => HasClient m (Verb method status cts (Headers ls NoContent)) where
type Client m (Verb method status cts (Headers ls NoContent)) type Client m (Verb method status cts (Headers ls NoContent))
= m (Headers ls NoContent) = m (Headers ls NoContent)
clientWithRoute Proxy req = do clientWithRoute pm Proxy req = do
let method = reflectMethod (Proxy :: Proxy method) let method = reflectMethod (Proxy :: Proxy method)
hdrs <- runRequest method req hdrs <- runRequest (Proxy :: Proxy NoContent) method req
return $ Headers { getResponse = NoContent return $ Headers { getResponse = NoContent
, getHeadersHList = buildHeadersTo hdrs , getHeadersHList = buildHeadersTo hdrs
} }
@ -240,14 +246,14 @@ instance OVERLAPPING_
-- > viewReferer = client myApi -- > viewReferer = client myApi
-- > -- then you can just use "viewRefer" to query that endpoint -- > -- then you can just use "viewRefer" to query that endpoint
-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
instance (KnownSymbol sym, ToHttpApiData a, HasClient api) instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
=> HasClient (Header sym a :> api) where => HasClient m (Header sym a :> api) where
type Client m (Header sym a :> api) = type Client m (Header sym a :> api) =
Maybe a -> Client m api Maybe a -> Client m api
clientWithRoute Proxy req mval = clientWithRoute pm Proxy req mval =
clientWithRoute (Proxy :: Proxy api) clientWithRoute pm (Proxy :: Proxy api)
(maybe req (maybe req
(\value -> Servant.Common.Req.addHeader hname value req) (\value -> Servant.Common.Req.addHeader hname value req)
mval mval
@ -257,26 +263,26 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
-- | Using a 'HttpVersion' combinator in your API doesn't affect the client -- | Using a 'HttpVersion' combinator in your API doesn't affect the client
-- functions. -- functions.
instance HasClient api instance HasClient m api
=> HasClient (HttpVersion :> api) where => HasClient m (HttpVersion :> api) where
type Client m (HttpVersion :> api) = type Client m (HttpVersion :> api) =
Client m api Client m api
clientWithRoute Proxy = clientWithRoute pm Proxy =
clientWithRoute (Proxy :: Proxy api) clientWithRoute pm (Proxy :: Proxy api)
-- | Ignore @'Summary'@ in client functions. -- | Ignore @'Summary'@ in client functions.
instance HasClient api => HasClient (Summary desc :> api) where instance HasClient m api => HasClient m (Summary desc :> api) where
type Client m (Summary desc :> api) = Client m api type Client m (Summary desc :> api) = Client m api
clientWithRoute _ = clientWithRoute (Proxy :: Proxy api) clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
-- | Ignore @'Description'@ in client functions. -- | Ignore @'Description'@ in client functions.
instance HasClient api => HasClient (Description desc :> api) where instance HasClient m api => HasClient m (Description desc :> api) where
type Client m (Description desc :> api) = Client m api type Client m (Description desc :> api) = Client m api
clientWithRoute _ = clientWithRoute (Proxy :: Proxy api) clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
-- | If you use a 'QueryParam' in one of your endpoints in your API, -- | If you use a 'QueryParam' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -303,15 +309,15 @@ instance HasClient api => HasClient (Description desc :> api) where
-- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy Nothing' for all books
-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
instance (KnownSymbol sym, ToHttpApiData a, HasClient api) instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
=> HasClient (QueryParam sym a :> api) where => HasClient m (QueryParam sym a :> api) where
type Client m (QueryParam sym a :> api) = type Client m (QueryParam sym a :> api) =
Maybe a -> Client m api Maybe a -> Client m api
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string
clientWithRoute Proxy req mparam = clientWithRoute pm Proxy req mparam =
clientWithRoute (Proxy :: Proxy api) clientWithRoute pm (Proxy :: Proxy api)
(maybe req (maybe req
(flip (appendToQueryString pname) req . Just) (flip (appendToQueryString pname) req . Just)
mparamText mparamText
@ -348,14 +354,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
-- > -- 'getBooksBy []' for all books -- > -- 'getBooksBy []' for all books
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
-- > -- to get all books by Asimov and Heinlein -- > -- to get all books by Asimov and Heinlein
instance (KnownSymbol sym, ToHttpApiData a, HasClient api) instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
=> HasClient (QueryParams sym a :> api) where => HasClient m (QueryParams sym a :> api) where
type Client m (QueryParams sym a :> api) = type Client m (QueryParams sym a :> api) =
[a] -> Client m api [a] -> Client m api
clientWithRoute Proxy req paramlist = clientWithRoute pm Proxy req paramlist =
clientWithRoute (Proxy :: Proxy api) clientWithRoute pm (Proxy :: Proxy api)
(foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just)) (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
req req
paramlist' paramlist'
@ -386,14 +392,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
-- > -- then you can just use "getBooks" to query that endpoint. -- > -- then you can just use "getBooks" to query that endpoint.
-- > -- 'getBooksBy False' for all books -- > -- 'getBooksBy False' for all books
-- > -- 'getBooksBy True' to only get _already published_ books -- > -- 'getBooksBy True' to only get _already published_ books
instance (KnownSymbol sym, HasClient api) instance (KnownSymbol sym, HasClient m api)
=> HasClient (QueryFlag sym :> api) where => HasClient m (QueryFlag sym :> api) where
type Client m (QueryFlag sym :> api) = type Client m (QueryFlag sym :> api) =
Bool -> Client m api Bool -> Client m api
clientWithRoute Proxy req flag = clientWithRoute pm Proxy req flag =
clientWithRoute (Proxy :: Proxy api) clientWithRoute pm (Proxy :: Proxy api)
(if flag (if flag
then appendToQueryString paramname Nothing req then appendToQueryString paramname Nothing req
else req else req
@ -404,12 +410,13 @@ instance (KnownSymbol sym, HasClient api)
-- | Pick a 'Method' and specify where the server you want to query is. You get -- | Pick a 'Method' and specify where the server you want to query is. You get
-- back the full `Response`. -- back the full `Response`.
instance HasClient Raw where instance (RunClient m NoContent (Int, ByteString, MediaType, [HTTP.Header], Response ByteString))
=> HasClient m Raw where
type Client m Raw type Client m Raw
= H.Method -> m (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) = H.Method -> m (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
clientWithRoute :: Proxy Raw -> Req -> Client Raw clientWithRoute :: Proxy m -> Proxy Raw -> Req -> Client m Raw
clientWithRoute Proxy req httpMethod = do clientWithRoute pm Proxy req httpMethod = do
runRequest (Proxy :: Proxy NoContent) httpMethod req runRequest (Proxy :: Proxy NoContent) httpMethod req
-- | If you use a 'ReqBody' in one of your endpoints in your API, -- | If you use a 'ReqBody' in one of your endpoints in your API,
@ -430,14 +437,14 @@ instance HasClient Raw where
-- > addBook :: Book -> ClientM Book -- > addBook :: Book -> ClientM Book
-- > addBook = client myApi -- > addBook = client myApi
-- > -- then you can just use "addBook" to query that endpoint -- > -- then you can just use "addBook" to query that endpoint
instance (MimeRender ct a, HasClient api) instance (MimeRender ct a, HasClient m api)
=> HasClient (ReqBody (ct ': cts) a :> api) where => HasClient m (ReqBody (ct ': cts) a :> api) where
type Client m (ReqBody (ct ': cts) a :> api) = type Client m (ReqBody (ct ': cts) a :> api) =
a -> Client m api a -> Client m api
clientWithRoute Proxy req body = clientWithRoute pm Proxy req body =
clientWithRoute (Proxy :: Proxy api) clientWithRoute pm (Proxy :: Proxy api)
(let ctProxy = Proxy :: Proxy ct (let ctProxy = Proxy :: Proxy ct
in setReqBodyLBS (mimeRender ctProxy body) in setReqBodyLBS (mimeRender ctProxy body)
-- We use first contentType from the Accept list -- We use first contentType from the Accept list
@ -446,54 +453,54 @@ instance (MimeRender ct a, HasClient api)
) )
-- | Make the querying function append @path@ to the request path. -- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient api) => HasClient (path :> api) where instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
type Client m (path :> api) = Client m api type Client m (path :> api) = Client m api
clientWithRoute Proxy req = clientWithRoute pm Proxy req =
clientWithRoute (Proxy :: Proxy api) clientWithRoute pm (Proxy :: Proxy api)
(appendToPath p req) (appendToPath p req)
where p = symbolVal (Proxy :: Proxy path) where p = symbolVal (Proxy :: Proxy path)
instance HasClient api => HasClient (Vault :> api) where instance HasClient m api => HasClient m (Vault :> api) where
type Client m (Vault :> api) = Client m api type Client m (Vault :> api) = Client m api
clientWithRoute Proxy req = clientWithRoute pm Proxy req =
clientWithRoute (Proxy :: Proxy api) req clientWithRoute pm (Proxy :: Proxy api) req
instance HasClient api => HasClient (RemoteHost :> api) where instance HasClient m api => HasClient m (RemoteHost :> api) where
type Client m (RemoteHost :> api) = Client m api type Client m (RemoteHost :> api) = Client m api
clientWithRoute Proxy req = clientWithRoute pm Proxy req =
clientWithRoute (Proxy :: Proxy api) req clientWithRoute pm (Proxy :: Proxy api) req
instance HasClient api => HasClient (IsSecure :> api) where instance HasClient m api => HasClient m (IsSecure :> api) where
type Client m (IsSecure :> api) = Client m api type Client m (IsSecure :> api) = Client m api
clientWithRoute Proxy req = clientWithRoute pm Proxy req =
clientWithRoute (Proxy :: Proxy api) req clientWithRoute pm (Proxy :: Proxy api) req
instance HasClient subapi => instance HasClient m subapi =>
HasClient (WithNamedContext name context subapi) where HasClient m (WithNamedContext name context subapi) where
type Client m (WithNamedContext name context subapi) = Client m subapi type Client m (WithNamedContext name context subapi) = Client m subapi
clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi) clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
instance ( HasClient api instance ( HasClient m api
) => HasClient (AuthProtect tag :> api) where ) => HasClient m (AuthProtect tag :> api) where
type Client m (AuthProtect tag :> api) type Client m (AuthProtect tag :> api)
= AuthenticateReq (AuthProtect tag) -> Client m api = AuthenticateReq (AuthProtect tag) -> Client m api
clientWithRoute Proxy req (AuthenticateReq (val,func)) = clientWithRoute pm Proxy req (AuthenticateReq (val,func)) =
clientWithRoute (Proxy :: Proxy api) (func val req) clientWithRoute pm (Proxy :: Proxy api) (func val req)
-- * Basic Authentication -- * Basic Authentication
instance HasClient api => HasClient (BasicAuth realm usr :> api) where instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api
clientWithRoute Proxy req val = clientWithRoute pm Proxy req val =
clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)
{- Note [Non-Empty Content Types] {- Note [Non-Empty Content Types]

7
servant-client/src/Servant/Client/Class.hs
View file

@ -10,6 +10,7 @@ import Servant.API
import Servant.Common.Req import Servant.Common.Req
class (Monad m) => RunClient m ct result where class (Monad m) => RunClient m ct result where
runRequest :: MimeUnrender ct result runRequest :: Proxy ct
=> Proxy ct -> Method
-> Method -> Req -> m result -> Req
-> m result

36
servant-client/test/Servant/ClientSpec.hs
View file

@ -63,7 +63,7 @@ import Servant.Server
import Servant.Server.Experimental.Auth import Servant.Server.Experimental.Auth
-- This declaration simply checks that all instances are in place. -- This declaration simply checks that all instances are in place.
_ = client comprehensiveAPI _ = client (Proxy :: Proxy ClientM) comprehensiveAPI
spec :: Spec spec :: Spec
spec = describe "Servant.Client" $ do spec = describe "Servant.Client" $ do
@ -147,7 +147,7 @@ getGet
:<|> getMultiple :<|> getMultiple
:<|> getRespHeaders :<|> getRespHeaders
:<|> getDeleteContentType :<|> getDeleteContentType
:<|> EmptyClient = client api :<|> EmptyClient = client (Proxy :: Proxy ClientM) api
server :: Application server :: Application
server = serve api ( server = serve api (
@ -241,7 +241,7 @@ data GenericClient = GenericClient
, mkNestedClient1 :: String -> NestedClient1 , mkNestedClient1 :: String -> NestedClient1
} deriving Generic } deriving Generic
instance SOP.Generic GenericClient instance SOP.Generic GenericClient
instance (Client GenericClientAPI ~ client) => ClientLike client GenericClient instance (Client ClientM GenericClientAPI ~ client) => ClientLike client GenericClient
type NestedAPI1 type NestedAPI1
= QueryParam "int" Int :> NestedAPI2 = QueryParam "int" Int :> NestedAPI2
@ -252,7 +252,7 @@ data NestedClient1 = NestedClient1
, idChar :: Maybe Char -> SCR.ClientM Char , idChar :: Maybe Char -> SCR.ClientM Char
} deriving Generic } deriving Generic
instance SOP.Generic NestedClient1 instance SOP.Generic NestedClient1
instance (Client NestedAPI1 ~ client) => ClientLike client NestedClient1 instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1
type NestedAPI2 type NestedAPI2
= "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int = "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
@ -263,7 +263,7 @@ data NestedClient2 = NestedClient2
, doNothing :: SCR.ClientM () , doNothing :: SCR.ClientM ()
} deriving Generic } deriving Generic
instance SOP.Generic NestedClient2 instance SOP.Generic NestedClient2
instance (Client NestedAPI2 ~ client) => ClientLike client NestedClient2 instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2
genericClientServer :: Application genericClientServer :: Application
genericClientServer = serve (Proxy :: Proxy GenericClientAPI) ( genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
@ -359,7 +359,7 @@ wrappedApiSpec = describe "error status codes" $ do
test (WrappedApi api, desc) = test (WrappedApi api, desc) =
it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
let getResponse :: SCR.ClientM () let getResponse :: SCR.ClientM ()
getResponse = client api getResponse = client (Proxy :: Proxy ClientM) api
Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl) Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl)
responseStatus `shouldBe` (HTTP.Status 500 "error message") responseStatus `shouldBe` (HTTP.Status 500 "error message")
in mapM_ test $ in mapM_ test $
@ -374,35 +374,35 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
context "client returns errors appropriately" $ do context "client returns errors appropriately" $ do
it "reports FailureResponse" $ \(_, baseUrl) -> do it "reports FailureResponse" $ \(_, baseUrl) -> do
let (_ :<|> getDeleteEmpty :<|> _) = client api let (_ :<|> getDeleteEmpty :<|> _) = client (Proxy :: Proxy ClientM) api
Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl) Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
case res of case res of
FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return () FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return ()
_ -> fail $ "expected 404 response, but got " <> show res _ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ \(_, baseUrl) -> do it "reports DecodeFailure" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> getCapture :<|> _) = client api let (_ :<|> _ :<|> getCapture :<|> _) = client (Proxy :: Proxy ClientM) api
Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl) Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl)
case res of case res of
DecodeFailure _ ("application/json") _ -> return () DecodeFailure _ ("application/json") _ -> return ()
_ -> fail $ "expected DecodeFailure, but got " <> show res _ -> fail $ "expected DecodeFailure, but got " <> show res
it "reports ConnectionError" $ \_ -> do it "reports ConnectionError" $ \_ -> do
let (getGetWrongHost :<|> _) = client api let (getGetWrongHost :<|> _) = client (Proxy :: Proxy ClientM) api
Left res <- runClientM getGetWrongHost (ClientEnv manager (BaseUrl Http "127.0.0.1" 19872 "")) Left res <- runClientM getGetWrongHost (ClientEnv manager (BaseUrl Http "127.0.0.1" 19872 ""))
case res of case res of
ConnectionError _ -> return () ConnectionError _ -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res _ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ \(_, baseUrl) -> do it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
let (getGet :<|> _ ) = client api let (getGet :<|> _ ) = client (Proxy :: Proxy ClientM) api
Left res <- runClientM getGet (ClientEnv manager baseUrl) Left res <- runClientM getGet (ClientEnv manager baseUrl)
case res of case res of
UnsupportedContentType ("application/octet-stream") _ -> return () UnsupportedContentType ("application/octet-stream") _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res _ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client (Proxy :: Proxy ClientM) api
Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl) Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl)
case res of case res of
InvalidContentTypeHeader "fooooo" _ -> return () InvalidContentTypeHeader "fooooo" _ -> return ()
@ -410,7 +410,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
data WrappedApi where data WrappedApi where
WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a, WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,
HasClient api, Client api ~ SCR.ClientM ()) => HasClient ClientM api, Client ClientM api ~ SCR.ClientM ()) =>
Proxy api -> WrappedApi Proxy api -> WrappedApi
basicAuthSpec :: Spec basicAuthSpec :: Spec
@ -418,14 +418,14 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
context "Authentication works when requests are properly authenticated" $ do context "Authentication works when requests are properly authenticated" $ do
it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
let getBasic = client basicAuthAPI let getBasic = client (Proxy :: Proxy ClientM) basicAuthAPI
let basicAuthData = BasicAuthData "servant" "server" let basicAuthData = BasicAuthData "servant" "server"
(left show <$> runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)) `shouldReturn` Right alice (left show <$> runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)) `shouldReturn` Right alice
context "Authentication is rejected when requests are not authenticated properly" $ do context "Authentication is rejected when requests are not authenticated properly" $ do
it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
let getBasic = client basicAuthAPI let getBasic = client (Proxy :: Proxy ClientM) basicAuthAPI
let basicAuthData = BasicAuthData "not" "password" let basicAuthData = BasicAuthData "not" "password"
Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl) Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)
responseStatus `shouldBe` HTTP.Status 403 "Forbidden" responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
@ -435,14 +435,14 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
context "Authentication works when requests are properly authenticated" $ do context "Authentication works when requests are properly authenticated" $ do
it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
let getProtected = client genAuthAPI let getProtected = client (Proxy :: Proxy ClientM) genAuthAPI
let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req) let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
(left show <$> runClientM (getProtected authRequest) (ClientEnv manager baseUrl)) `shouldReturn` Right alice (left show <$> runClientM (getProtected authRequest) (ClientEnv manager baseUrl)) `shouldReturn` Right alice
context "Authentication is rejected when requests are not authenticated properly" $ do context "Authentication is rejected when requests are not authenticated properly" $ do
it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
let getProtected = client genAuthAPI let getProtected = client (Proxy :: Proxy ClientM) genAuthAPI
let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req) let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl) Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)
responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized") responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
@ -451,11 +451,11 @@ genericClientSpec :: Spec
genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
describe "Servant.Client.Generic" $ do describe "Servant.Client.Generic" $ do
let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI)) let GenericClient{..} = mkClient (client (Proxy :: Proxy ClientM) (Proxy :: Proxy GenericClientAPI))
NestedClient1{..} = mkNestedClient1 "example" NestedClient1{..} = mkNestedClient1 "example"
NestedClient2{..} = mkNestedClient2 (Just 42) NestedClient2{..} = mkNestedClient2 (Just 42)
it "works for top-level client function" $ \(_, baseUrl) -> do it "works for top-level client (Proxy :: Proxy ClientM) function" $ \(_, baseUrl) -> do
(left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25 (left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25
it "works for nested clients" $ \(_, baseUrl) -> do it "works for nested clients" $ \(_, baseUrl) -> do