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

provide convenience functions for ClientM-based clients

Browse source
This commit is contained in:
Arnaud Bailly 2017-09-04 09:19:08 +02:00
parent d933ef281e
commit f3b31279ee
3 changed files with 32 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -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'.

3
servant-client/src/Servant/Client/HttpClient.hs
View file

@ -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.

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

@ -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