From f3b31279ee4209b8fdcb00d3685d4eb4aafe021e Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Mon, 4 Sep 2017 09:19:08 +0200 Subject: [PATCH] provide convenience functions for ClientM-based clients --- servant-client/src/Servant/Client.hs | 21 ++++++++++++-- .../src/Servant/Client/HttpClient.hs | 3 -- servant-client/test/Servant/ClientSpec.hs | 28 +++++++++---------- 3 files changed, 32 insertions(+), 20 deletions(-) diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 25a92c7c..beeb589b 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -22,7 +22,7 @@ module Servant.Client , client , HasClient(..) , ClientM - , runClientM + , runClientM, inClientM, clientM , ClientEnv (ClientEnv) , mkAuthenticateReq , ServantError(..) @@ -52,7 +52,8 @@ import Servant.Common.Req -- * Accessing APIs as a Client --- | 'client' allows you to produce operations to query an API from a client. +-- | 'client' allows you to produce operations to query an API from a client within +-- a given monadic context `m` -- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books -- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books @@ -60,12 +61,26 @@ import Servant.Common.Req -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > +-- > clientM :: Proxy ClientM +-- > clientM = Proxy +-- > -- > getAllBooks :: ClientM [Book] -- > postNewBook :: Book -> ClientM Book --- > (getAllBooks :<|> postNewBook) = client myApi +-- > (getAllBooks :<|> postNewBook) = client clientM myApi client :: HasClient m api => Proxy m -> Proxy api -> Client m api client pm p = clientWithRoute pm p defReq +-- | Helper proxy to simplify common case of working in `ClientM` monad +inClientM :: Proxy ClientM +inClientM = Proxy + +-- | Convenience method to declare clients running in the `ClientM` monad. +-- +-- Simply pass `inClientM` to `client`.... +clientM :: (HasClient ClientM api) => Proxy api -> Client ClientM api +clientM = client inClientM + + -- | 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'. diff --git a/servant-client/src/Servant/Client/HttpClient.hs b/servant-client/src/Servant/Client/HttpClient.hs index 3d972db7..0934e53e 100644 --- a/servant-client/src/Servant/Client/HttpClient.hs +++ b/servant-client/src/Servant/Client/HttpClient.hs @@ -63,7 +63,6 @@ data ClientEnv -- | @ClientM@ is the monad in which client functions run. Contains the -- 'Manager' and 'BaseUrl' used for requests in the reader environment. - newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a } deriving ( Functor, Applicative, Monad, MonadIO, Generic , MonadReader ClientEnv @@ -77,10 +76,8 @@ instance MonadBase IO ClientM where instance MonadBaseControl IO ClientM where type StM ClientM a = Either ServantError a - -- liftBaseWith :: (RunInBase ClientM IO -> IO a) -> ClientM a liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM'))) - -- restoreM :: StM ClientM a -> ClientM a restoreM st = ClientM (restoreM st) -- | Try clients in order, last error is preserved. diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 602e1d59..49b35769 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 (Proxy :: Proxy ClientM) comprehensiveAPI +_ = client inClientM comprehensiveAPI spec :: Spec spec = describe "Servant.Client" $ do @@ -147,7 +147,7 @@ getGet :<|> getMultiple :<|> getRespHeaders :<|> getDeleteContentType - :<|> EmptyClient = client (Proxy :: Proxy ClientM) api + :<|> EmptyClient = client inClientM api server :: Application server = serve api ( @@ -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 (Proxy :: Proxy ClientM) api + getResponse = client inClientM 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 (Proxy :: Proxy ClientM) api + let (_ :<|> getDeleteEmpty :<|> _) = client inClientM 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 (Proxy :: Proxy ClientM) api + let (_ :<|> _ :<|> getCapture :<|> _) = client inClientM 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 (Proxy :: Proxy ClientM) api + let (getGetWrongHost :<|> _) = client inClientM 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 (Proxy :: Proxy ClientM) api + let (getGet :<|> _ ) = client inClientM 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 (Proxy :: Proxy ClientM) api + let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client inClientM api Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl) case res of InvalidContentTypeHeader "fooooo" _ -> return () @@ -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 (Proxy :: Proxy ClientM) basicAuthAPI + let getBasic = client inClientM 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 (Proxy :: Proxy ClientM) basicAuthAPI + let getBasic = client inClientM 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 (Proxy :: Proxy ClientM) genAuthAPI + let getProtected = client inClientM 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 (Proxy :: Proxy ClientM) genAuthAPI + let getProtected = client inClientM 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 ClientM) (Proxy :: Proxy GenericClientAPI)) + let GenericClient{..} = mkClient (client inClientM (Proxy :: Proxy GenericClientAPI)) NestedClient1{..} = mkNestedClient1 "example" NestedClient2{..} = mkNestedClient2 (Just 42) - it "works for top-level client (Proxy :: Proxy ClientM) function" $ \(_, baseUrl) -> do + it "works for top-level client inClientM function" $ \(_, baseUrl) -> do (left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25 it "works for nested clients" $ \(_, baseUrl) -> do