From 2dcc92bd9abbead24dc01bd50259069578b6b94a Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Sun, 3 Sep 2017 08:49:24 +0200 Subject: [PATCH] expose client runner as a typeclass with base implementation #798 * 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 --- servant-client/servant-client.cabal | 1 + servant-client/src/Servant/Client.hs | 199 +++++++++++---------- servant-client/src/Servant/Client/Class.hs | 7 +- servant-client/test/Servant/ClientSpec.hs | 36 ++-- 4 files changed, 126 insertions(+), 117 deletions(-) diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index ba1d5f36..e2e85d45 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -30,6 +30,7 @@ source-repository head library exposed-modules: Servant.Client + Servant.Client.Class Servant.Client.HttpClient Servant.Client.Generic Servant.Client.Experimental.Auth diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index c6e7017a..a1a7b3ad 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -1,15 +1,16 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} #include "overlapping-compat.h" -- | This module provides 'client' which can automatically generate @@ -62,15 +63,15 @@ import Servant.Common.Req -- > getAllBooks :: ClientM [Book] -- > postNewBook :: Book -> ClientM Book -- > (getAllBooks :<|> postNewBook) = client myApi -client :: HasClient api => Proxy api -> Client m api -client p = clientWithRoute p defReq +client :: HasClient m api => Proxy m -> Proxy api -> Client m api +client pm p = clientWithRoute pm 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 api where +class HasClient m api where 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 @@ -86,11 +87,11 @@ class HasClient api where -- > getAllBooks :: ClientM [Book] -- > postNewBook :: Book -> ClientM Book -- > (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 - clientWithRoute Proxy req = - clientWithRoute (Proxy :: Proxy a) req :<|> - clientWithRoute (Proxy :: Proxy b) req + clientWithRoute pm Proxy req = + clientWithRoute pm (Proxy :: Proxy a) req :<|> + clientWithRoute pm (Proxy :: Proxy b) req -- | Singleton type representing a client for an empty API. data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum) @@ -105,9 +106,9 @@ data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum) -- > -- > getAllBooks :: ClientM [Book] -- > (getAllBooks :<|> EmptyClient) = client myApi -instance HasClient EmptyAPI where +instance HasClient m EmptyAPI where 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, -- the corresponding querying function will automatically take @@ -128,14 +129,14 @@ instance HasClient EmptyAPI where -- > getBook :: Text -> ClientM Book -- > getBook = client myApi -- > -- then you can just use "getBook" to query that endpoint -instance (KnownSymbol capture, ToHttpApiData a, HasClient api) - => HasClient (Capture capture a :> api) where +instance (KnownSymbol capture, ToHttpApiData a, HasClient m api) + => HasClient m (Capture capture a :> api) where type Client m (Capture capture a :> api) = a -> Client m api - clientWithRoute Proxy req val = - clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm Proxy req val = + clientWithRoute pm (Proxy :: Proxy api) (appendToPath p req) where p = unpack (toUrlPiece val) @@ -160,14 +161,14 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient api) -- > getSourceFile :: [Text] -> ClientM SourceFile -- > getSourceFile = client myApi -- > -- then you can use "getSourceFile" to query that endpoint -instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) - => HasClient (CaptureAll capture a :> sublayout) where +instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout) + => HasClient m (CaptureAll capture a :> sublayout) where type Client m (CaptureAll capture a :> sublayout) = [a] -> Client m sublayout - clientWithRoute Proxy req vals = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute pm Proxy req vals = + clientWithRoute pm (Proxy :: Proxy sublayout) (foldl' (flip appendToPath) req ps) where ps = map (unpack . toUrlPiece) vals @@ -175,27 +176,31 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) instance OVERLAPPABLE_ -- Note [Non-Empty Content Types] (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 - clientWithRoute Proxy req = do - snd <$> runRequest (Proxy :: Proxy ct) method req + clientWithRoute pm Proxy req = do + (_hdrs, a) :: ([H.Header], a) <- runRequest (Proxy :: Proxy ct) method req + return a where method = reflectMethod (Proxy :: Proxy method) 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) = m NoContent - clientWithRoute Proxy req = do - runRequest (Proxy :: Proxy NoContent) method req >> return NoContent + clientWithRoute pm Proxy req = do + _hdrs :: [H.Header] <- runRequest (Proxy :: Proxy NoContent) method req + return NoContent where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_ -- Note [Non-Empty Content Types] - ( RunClient m ct ([H.Header], a), MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts) - ) => HasClient (Verb method status cts' (Headers ls a)) where + ( RunClient m ct ([H.Header], a) + , 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)) = m (Headers ls a) - clientWithRoute Proxy req = do + clientWithRoute pm Proxy req = do let method = reflectMethod (Proxy :: Proxy method) (hdrs, resp) <- runRequest (Proxy :: Proxy ct) method req return $ Headers { getResponse = resp @@ -203,13 +208,14 @@ instance OVERLAPPING_ } instance OVERLAPPING_ - ( RunClient m NoContent [H.Header], BuildHeadersTo ls, ReflectMethod method - ) => HasClient (Verb method status cts (Headers ls NoContent)) where + ( RunClient m NoContent [H.Header] + , BuildHeadersTo ls, ReflectMethod method + ) => HasClient m (Verb method status cts (Headers ls NoContent)) where type Client m (Verb method status cts (Headers ls NoContent)) = m (Headers ls NoContent) - clientWithRoute Proxy req = do + clientWithRoute pm Proxy req = do let method = reflectMethod (Proxy :: Proxy method) - hdrs <- runRequest method req + hdrs <- runRequest (Proxy :: Proxy NoContent) method req return $ Headers { getResponse = NoContent , getHeadersHList = buildHeadersTo hdrs } @@ -240,14 +246,14 @@ instance OVERLAPPING_ -- > 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 api) - => HasClient (Header sym a :> api) where +instance (KnownSymbol sym, ToHttpApiData a, HasClient m api) + => HasClient m (Header sym a :> api) where type Client m (Header sym a :> api) = Maybe a -> Client m api - clientWithRoute Proxy req mval = - clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm Proxy req mval = + clientWithRoute pm (Proxy :: Proxy api) (maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval @@ -257,26 +263,26 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api) -- | Using a 'HttpVersion' combinator in your API doesn't affect the client -- functions. -instance HasClient api - => HasClient (HttpVersion :> api) where +instance HasClient m api + => HasClient m (HttpVersion :> api) where type Client m (HttpVersion :> api) = Client m api - clientWithRoute Proxy = - clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm Proxy = + clientWithRoute pm (Proxy :: Proxy api) -- | 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 - clientWithRoute _ = clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api) -- | 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 - 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, -- 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. -- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov -instance (KnownSymbol sym, ToHttpApiData a, HasClient api) - => HasClient (QueryParam sym a :> api) where +instance (KnownSymbol sym, ToHttpApiData a, HasClient m api) + => HasClient m (QueryParam sym a :> api) where type Client m (QueryParam sym a :> api) = Maybe a -> Client m api -- if mparam = Nothing, we don't add it to the query string - clientWithRoute Proxy req mparam = - clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm Proxy req mparam = + clientWithRoute pm (Proxy :: Proxy api) (maybe req (flip (appendToQueryString pname) req . Just) mparamText @@ -348,14 +354,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api) -- > -- 'getBooksBy []' for all books -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- > -- to get all books by Asimov and Heinlein -instance (KnownSymbol sym, ToHttpApiData a, HasClient api) - => HasClient (QueryParams sym a :> api) where +instance (KnownSymbol sym, ToHttpApiData a, HasClient m api) + => HasClient m (QueryParams sym a :> api) where type Client m (QueryParams sym a :> api) = [a] -> Client m api - clientWithRoute Proxy req paramlist = - clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm Proxy req paramlist = + clientWithRoute pm (Proxy :: Proxy api) (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just)) req paramlist' @@ -386,14 +392,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api) -- > -- then you can just use "getBooks" to query that endpoint. -- > -- 'getBooksBy False' for all books -- > -- 'getBooksBy True' to only get _already published_ books -instance (KnownSymbol sym, HasClient api) - => HasClient (QueryFlag sym :> api) where +instance (KnownSymbol sym, HasClient m api) + => HasClient m (QueryFlag sym :> api) where type Client m (QueryFlag sym :> api) = Bool -> Client m api - clientWithRoute Proxy req flag = - clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm Proxy req flag = + clientWithRoute pm (Proxy :: Proxy api) (if flag then appendToQueryString paramname Nothing 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 -- 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 = H.Method -> m (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) - clientWithRoute :: Proxy Raw -> Req -> Client Raw - clientWithRoute Proxy req httpMethod = do + clientWithRoute :: Proxy m -> Proxy Raw -> Req -> Client m Raw + clientWithRoute pm Proxy req httpMethod = do runRequest (Proxy :: Proxy NoContent) httpMethod req -- | 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 = client myApi -- > -- then you can just use "addBook" to query that endpoint -instance (MimeRender ct a, HasClient api) - => HasClient (ReqBody (ct ': cts) a :> api) where +instance (MimeRender ct a, HasClient m api) + => HasClient m (ReqBody (ct ': cts) a :> api) where type Client m (ReqBody (ct ': cts) a :> api) = a -> Client m api - clientWithRoute Proxy req body = - clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm Proxy req body = + clientWithRoute pm (Proxy :: Proxy api) (let ctProxy = Proxy :: Proxy ct in setReqBodyLBS (mimeRender ctProxy body) -- 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. -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 - clientWithRoute Proxy req = - clientWithRoute (Proxy :: Proxy api) + clientWithRoute pm Proxy req = + clientWithRoute pm (Proxy :: Proxy api) (appendToPath p req) 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 - clientWithRoute Proxy req = - clientWithRoute (Proxy :: Proxy api) req + clientWithRoute pm Proxy 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 - clientWithRoute Proxy req = - clientWithRoute (Proxy :: Proxy api) req + clientWithRoute pm Proxy 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 - clientWithRoute Proxy req = - clientWithRoute (Proxy :: Proxy api) req + clientWithRoute pm Proxy req = + clientWithRoute pm (Proxy :: Proxy api) req -instance HasClient subapi => - HasClient (WithNamedContext name context subapi) where +instance HasClient m subapi => + HasClient m (WithNamedContext name context subapi) where 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 - ) => HasClient (AuthProtect tag :> api) where +instance ( HasClient m api + ) => HasClient m (AuthProtect tag :> api) where type Client m (AuthProtect tag :> api) = AuthenticateReq (AuthProtect tag) -> Client m api - clientWithRoute Proxy req (AuthenticateReq (val,func)) = - clientWithRoute (Proxy :: Proxy api) (func val req) + clientWithRoute pm Proxy req (AuthenticateReq (val,func)) = + clientWithRoute pm (Proxy :: Proxy api) (func val req) -- * 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 - clientWithRoute Proxy req val = - clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) + clientWithRoute pm Proxy req val = + clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req) {- Note [Non-Empty Content Types] diff --git a/servant-client/src/Servant/Client/Class.hs b/servant-client/src/Servant/Client/Class.hs index e880188f..921352fa 100644 --- a/servant-client/src/Servant/Client/Class.hs +++ b/servant-client/src/Servant/Client/Class.hs @@ -10,6 +10,7 @@ import Servant.API import Servant.Common.Req class (Monad m) => RunClient m ct result where - runRequest :: MimeUnrender ct result - => Proxy ct - -> Method -> Req -> m result + runRequest :: Proxy ct + -> Method + -> Req + -> m result diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 15bc098d..602e1d59 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -63,7 +63,7 @@ import Servant.Server import Servant.Server.Experimental.Auth -- This declaration simply checks that all instances are in place. -_ = client comprehensiveAPI +_ = client (Proxy :: Proxy ClientM) comprehensiveAPI spec :: Spec spec = describe "Servant.Client" $ do @@ -147,7 +147,7 @@ getGet :<|> getMultiple :<|> getRespHeaders :<|> getDeleteContentType - :<|> EmptyClient = client api + :<|> EmptyClient = client (Proxy :: Proxy ClientM) api server :: Application server = serve api ( @@ -241,7 +241,7 @@ data GenericClient = GenericClient , mkNestedClient1 :: String -> NestedClient1 } deriving Generic instance SOP.Generic GenericClient -instance (Client GenericClientAPI ~ client) => ClientLike client GenericClient +instance (Client ClientM GenericClientAPI ~ client) => ClientLike client GenericClient type NestedAPI1 = QueryParam "int" Int :> NestedAPI2 @@ -252,7 +252,7 @@ data NestedClient1 = NestedClient1 , idChar :: Maybe Char -> SCR.ClientM Char } deriving Generic instance SOP.Generic NestedClient1 -instance (Client NestedAPI1 ~ client) => ClientLike client NestedClient1 +instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1 type NestedAPI2 = "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int @@ -263,7 +263,7 @@ data NestedClient2 = NestedClient2 , doNothing :: SCR.ClientM () } deriving Generic instance SOP.Generic NestedClient2 -instance (Client NestedAPI2 ~ client) => ClientLike client NestedClient2 +instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2 genericClientServer :: Application genericClientServer = serve (Proxy :: Proxy GenericClientAPI) ( @@ -359,7 +359,7 @@ wrappedApiSpec = describe "error status codes" $ do test (WrappedApi api, desc) = it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do let getResponse :: SCR.ClientM () - getResponse = client api + getResponse = client (Proxy :: Proxy ClientM) api Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl) responseStatus `shouldBe` (HTTP.Status 500 "error message") in mapM_ test $ @@ -374,35 +374,35 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do context "client returns errors appropriately" $ do it "reports FailureResponse" $ \(_, baseUrl) -> do - let (_ :<|> getDeleteEmpty :<|> _) = client api + let (_ :<|> getDeleteEmpty :<|> _) = client (Proxy :: Proxy ClientM) api Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl) case res of FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return () _ -> fail $ "expected 404 response, but got " <> show res it "reports DecodeFailure" $ \(_, baseUrl) -> do - let (_ :<|> _ :<|> getCapture :<|> _) = client api + let (_ :<|> _ :<|> getCapture :<|> _) = client (Proxy :: Proxy ClientM) api Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl) case res of DecodeFailure _ ("application/json") _ -> return () _ -> fail $ "expected DecodeFailure, but got " <> show res 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 "")) case res of ConnectionError _ -> return () _ -> fail $ "expected ConnectionError, but got " <> show res it "reports UnsupportedContentType" $ \(_, baseUrl) -> do - let (getGet :<|> _ ) = client api + let (getGet :<|> _ ) = client (Proxy :: Proxy ClientM) api Left res <- runClientM getGet (ClientEnv 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 + let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client (Proxy :: Proxy ClientM) api Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl) case res of InvalidContentTypeHeader "fooooo" _ -> return () @@ -410,7 +410,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do data WrappedApi where WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a, - HasClient api, Client api ~ SCR.ClientM ()) => + HasClient ClientM api, Client ClientM api ~ SCR.ClientM ()) => Proxy api -> WrappedApi basicAuthSpec :: Spec @@ -418,14 +418,14 @@ 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 + let getBasic = client (Proxy :: Proxy ClientM) basicAuthAPI let basicAuthData = BasicAuthData "servant" "server" (left show <$> runClientM (getBasic basicAuthData) (ClientEnv 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 + let getBasic = client (Proxy :: Proxy ClientM) basicAuthAPI let basicAuthData = BasicAuthData "not" "password" Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl) 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 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) (left show <$> runClientM (getProtected authRequest) (ClientEnv 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 + let getProtected = client (Proxy :: Proxy ClientM) genAuthAPI let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req) Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl) responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized") @@ -451,11 +451,11 @@ genericClientSpec :: Spec genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ 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" 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 it "works for nested clients" $ \(_, baseUrl) -> do