servant-client 0.8.1 → 0.9
raw patch · 5 files changed
+124/−93 lines, 5 filesdep +mtldep ~http-api-datadep ~servantdep ~servant-server
Dependencies added: mtl
Dependency ranges changed: http-api-data, servant, servant-server
Files
- CHANGELOG.md +7/−0
- servant-client.cabal +7/−5
- src/Servant/Client.hs +16/−14
- src/Servant/Common/Req.hs +50/−19
- test/Servant/ClientSpec.hs +44/−55
CHANGELOG.md view
@@ -1,3 +1,10 @@+0.9+---++* BACKWARDS INCOMPATIBLE: `client` now returns a ClientM which is a Reader for+ BasicEnv. BasicEnv comprises the HttpManager and BaseUrl that have had to be+ passed to each method returned by `client`.+ 0.7.1 -----
servant-client.cabal view
@@ -1,5 +1,5 @@ name: servant-client-version: 0.8.1+version: 0.9 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that@@ -41,18 +41,19 @@ , base64-bytestring >= 1.0.0.1 && < 1.1 , bytestring >= 0.10 && < 0.11 , exceptions >= 0.8 && < 0.9- , http-api-data >= 0.1 && < 0.3+ , http-api-data >= 0.3 && < 0.4 , http-client >= 0.4.18.1 && < 0.6 , http-client-tls >= 0.2.2 && < 0.4 , http-media >= 0.6.2 && < 0.7 , http-types >= 0.8.6 && < 0.10 , network-uri >= 2.6 && < 2.7 , safe >= 0.3.9 && < 0.4- , servant == 0.8.*+ , servant == 0.9.* , string-conversions >= 0.3 && < 0.5 , text >= 1.2 && < 1.3 , transformers >= 0.3 && < 0.6 , transformers-compat >= 0.4 && < 0.6+ , mtl hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -77,15 +78,16 @@ , bytestring , deepseq , hspec == 2.*+ , http-api-data , http-client , http-media , http-types , HUnit , network >= 2.6 , QuickCheck >= 2.7- , servant == 0.8.*+ , servant == 0.9.* , servant-client- , servant-server == 0.8.*+ , servant-server == 0.9.* , text , wai , warp
src/Servant/Client.hs view
@@ -20,6 +20,8 @@ , client , HasClient(..) , ClientM+ , runClientM+ , ClientEnv (ClientEnv) , mkAuthenticateReq , ServantError(..) , module Servant.Common.BaseUrl@@ -34,7 +36,7 @@ import Data.String.Conversions import Data.Text (unpack) import GHC.TypeLits-import Network.HTTP.Client (Manager, Response)+import Network.HTTP.Client (Response) import Network.HTTP.Media import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as HTTP@@ -154,17 +156,17 @@ -- 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) = Manager -> BaseUrl -> ClientM a- clientWithRoute Proxy req manager baseurl =- snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl+ type Client (Verb method status cts' a) = ClientM a+ clientWithRoute Proxy req = do+ snd <$> performRequestCT (Proxy :: Proxy ct) method req where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_ (ReflectMethod method) => HasClient (Verb method status cts NoContent) where type Client (Verb method status cts NoContent)- = Manager -> BaseUrl -> ClientM NoContent- clientWithRoute Proxy req manager baseurl =- performRequestNoBody method req manager baseurl >> return NoContent+ = ClientM NoContent+ clientWithRoute Proxy req = do+ performRequestNoBody method req >> return NoContent where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_@@ -172,10 +174,10 @@ ( 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))- = Manager -> BaseUrl -> ClientM (Headers ls a)- clientWithRoute Proxy req manager baseurl = do+ = ClientM (Headers ls a)+ clientWithRoute Proxy req = do let method = reflectMethod (Proxy :: Proxy method)- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req return $ Headers { getResponse = resp , getHeadersHList = buildHeadersTo hdrs }@@ -184,10 +186,10 @@ ( BuildHeadersTo ls, ReflectMethod method ) => HasClient (Verb method status cts (Headers ls NoContent)) where type Client (Verb method status cts (Headers ls NoContent))- = Manager -> BaseUrl -> ClientM (Headers ls NoContent)- clientWithRoute Proxy req manager baseurl = do+ = ClientM (Headers ls NoContent)+ clientWithRoute Proxy req = do let method = reflectMethod (Proxy :: Proxy method)- hdrs <- performRequestNoBody method req manager baseurl+ hdrs <- performRequestNoBody method req return $ Headers { getResponse = NoContent , getHeadersHList = buildHeadersTo hdrs }@@ -372,7 +374,7 @@ -- back the full `Response`. instance HasClient Raw where type Client Raw- = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)+ = H.Method -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) clientWithRoute :: Proxy Raw -> Req -> Client Raw clientWithRoute Proxy req httpMethod = do
src/Servant/Common/Req.hs view
@@ -1,7 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Servant.Common.Req where #if !MIN_VERSION_base(4,8,0)@@ -10,8 +13,18 @@ import Control.Exception import Control.Monad import Control.Monad.Catch (MonadThrow)-import Control.Monad.IO.Class++#if MIN_VERSION_mtl(2,2,0)+import Control.Monad.Except (MonadError(..))+#else+import Control.Monad.Error.Class (MonadError(..))+#endif import Control.Monad.Trans.Except+++import GHC.Generics+import Control.Monad.IO.Class ()+import Control.Monad.Reader import Data.ByteString.Lazy hiding (pack, filter, map, null, elem) import Data.String import Data.String.Conversions@@ -19,9 +32,9 @@ import Data.Text (Text) import Data.Text.Encoding import Data.Typeable-import Network.HTTP.Client hiding (Proxy, path) import Network.HTTP.Media import Network.HTTP.Types+import Network.HTTP.Client hiding (Proxy, path) import qualified Network.HTTP.Types.Header as HTTP import Network.URI hiding (path) import Servant.API.ContentTypes@@ -149,20 +162,40 @@ displayHttpRequest :: Method -> String displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request" -type ClientM = ExceptT ServantError IO+data ClientEnv+ = ClientEnv+ { manager :: Manager+ , baseUrl :: BaseUrl+ } -performRequest :: Method -> Req -> Manager -> BaseUrl++-- | @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+ , MonadError ServantError+ )++runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)+runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm+++performRequest :: Method -> Req -> ClientM ( Int, ByteString, MediaType , [HTTP.Header], Response ByteString)-performRequest reqMethod req manager reqHost = do+performRequest reqMethod req = do+ m <- asks manager+ reqHost <- asks baseUrl partialRequest <- liftIO $ reqToRequest req reqHost let request = partialRequest { Client.method = reqMethod } - eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager+ eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m case eResponse of Left err ->- throwE . ConnectionError $ SomeException err+ throwError . ConnectionError $ SomeException err Right response -> do let status = Client.responseStatus response@@ -172,28 +205,26 @@ ct <- case lookup "Content-Type" $ Client.responseHeaders response of Nothing -> pure $ "application"//"octet-stream" Just t -> case parseAccept t of- Nothing -> throwE $ InvalidContentTypeHeader (cs t) body+ Nothing -> throwError $ InvalidContentTypeHeader (cs t) body Just t' -> pure t' unless (status_code >= 200 && status_code < 300) $- throwE $ FailureResponse status ct body+ throwError $ FailureResponse status ct body return (status_code, body, ct, hdrs, response) -performRequestCT :: MimeUnrender ct result =>- Proxy ct -> Method -> Req -> Manager -> BaseUrl+performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req -> ClientM ([HTTP.Header], result)-performRequestCT ct reqMethod req manager reqHost = do+performRequestCT ct reqMethod req = do let acceptCT = contentType ct (_status, respBody, respCT, hdrs, _response) <-- performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost- unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody+ performRequest reqMethod (req { reqAccept = [acceptCT] })+ unless (matches respCT (acceptCT)) $ throwError $ UnsupportedContentType respCT respBody case mimeUnrender ct respBody of- Left err -> throwE $ DecodeFailure err respCT respBody+ Left err -> throwError $ DecodeFailure err respCT respBody Right val -> return (hdrs, val) -performRequestNoBody :: Method -> Req -> Manager -> BaseUrl- -> ClientM [HTTP.Header]-performRequestNoBody reqMethod req manager reqHost = do- (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost+performRequestNoBody :: Method -> Req -> ClientM [HTTP.Header]+performRequestNoBody reqMethod req = do+ (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req return hdrs catchConnectionError :: IO a -> IO (Either ServantError a)
test/Servant/ClientSpec.hs view
@@ -32,14 +32,13 @@ import Control.Arrow (left) import Control.Concurrent (forkIO, killThread, ThreadId) import Control.Exception (bracket)-import Control.Monad.Trans.Except (throwE, runExceptT)+import Control.Monad.Trans.Except (throwE ) 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 qualified Network.HTTP.Client as C import Network.HTTP.Media@@ -52,6 +51,7 @@ import Test.Hspec.QuickCheck import Test.HUnit import Test.QuickCheck+import Web.FormUrlEncoded (FromForm, ToForm) import Servant.API import Servant.API.Internal.Test.ComprehensiveAPI@@ -82,19 +82,8 @@ instance ToJSON Person instance FromJSON Person -instance ToFormUrlEncoded Person where- toFormUrlEncoded Person{..} =- [("name", T.pack name), ("age", T.pack (show age))]--lookupEither :: (Show a, Eq a) => a -> [(a,b)] -> Either String b-lookupEither x xs = do- maybe (Left $ "could not find key " <> show x) return $ lookup x xs--instance FromFormUrlEncoded Person where- fromFormUrlEncoded xs = do- n <- lookupEither "name" xs- a <- lookupEither "age" xs- return $ Person (T.unpack n) (read $ T.unpack a)+instance ToForm Person where+instance FromForm Person where alice :: Person alice = Person "Alice" 42@@ -123,22 +112,22 @@ 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-getCaptureAll :: [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+getGet :: SCR.ClientM Person+getDeleteEmpty :: SCR.ClientM NoContent+getCapture :: String -> SCR.ClientM Person+getCaptureAll :: [String] -> SCR.ClientM [Person]+getBody :: Person -> SCR.ClientM Person+getQueryParam :: Maybe String -> SCR.ClientM Person+getQueryParams :: [String] -> SCR.ClientM [Person]+getQueryFlag :: Bool -> SCR.ClientM Bool+getRawSuccess :: HTTP.Method -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)-getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl+getRawFailure :: HTTP.Method -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)-getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])-getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool)-getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent+getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)+getDeleteContentType :: SCR.ClientM NoContent getGet :<|> getDeleteEmpty :<|> getCapture@@ -242,42 +231,42 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do it "Servant.API.Get" $ \(_, baseUrl) -> do- (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice+ (left show <$> (runClientM getGet (ClientEnv manager baseUrl))) `shouldReturn` Right alice describe "Servant.API.Delete" $ do it "allows empty content type" $ \(_, baseUrl) -> do- (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent+ (left show <$> (runClientM getDeleteEmpty (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent it "allows content type" $ \(_, baseUrl) -> do- (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent+ (left show <$> (runClientM getDeleteContentType (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent it "Servant.API.Capture" $ \(_, baseUrl) -> do- (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)+ (left show <$> (runClientM (getCapture "Paula") (ClientEnv manager baseUrl))) `shouldReturn` Right (Person "Paula" 0) it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do let expected = [(Person "Paula" 0), (Person "Peta" 1)]- (left show <$> runExceptT (getCaptureAll ["Paula", "Peta"] manager baseUrl)) `shouldReturn` Right expected+ (left show <$> (runClientM (getCaptureAll ["Paula", "Peta"]) (ClientEnv manager baseUrl))) `shouldReturn` Right expected it "Servant.API.ReqBody" $ \(_, baseUrl) -> do let p = Person "Clara" 42- (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p+ (left show <$> runClientM (getBody p) (ClientEnv manager baseUrl)) `shouldReturn` Right p it "Servant.API.QueryParam" $ \(_, baseUrl) -> do- left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice- Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)+ left show <$> runClientM (getQueryParam (Just "alice")) (ClientEnv manager baseUrl) `shouldReturn` Right alice+ Left FailureResponse{..} <- runClientM (getQueryParam (Just "bob")) (ClientEnv manager baseUrl) responseStatus `shouldBe` HTTP.Status 400 "bob not found" it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do- (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []- (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl))+ (left show <$> runClientM (getQueryParams []) (ClientEnv manager baseUrl)) `shouldReturn` Right []+ (left show <$> runClientM (getQueryParams ["alice", "bob"]) (ClientEnv manager baseUrl)) `shouldReturn` Right [Person "alice" 0, Person "bob" 1] context "Servant.API.QueryParam.QueryFlag" $ forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do- (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag+ (left show <$> runClientM (getQueryFlag flag) (ClientEnv manager baseUrl)) `shouldReturn` Right flag it "Servant.API.Raw on success" $ \(_, baseUrl) -> do- res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl)+ res <- runClientM (getRawSuccess HTTP.methodGet) (ClientEnv manager baseUrl) case res of Left e -> assertFailure $ show e Right (code, body, ct, _, response) -> do@@ -286,7 +275,7 @@ C.responseStatus response `shouldBe` HTTP.ok200 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do- res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl)+ res <- runClientM (getRawFailure HTTP.methodGet) (ClientEnv manager baseUrl) case res of Right _ -> assertFailure "expected Left, but got Right" Left e -> do@@ -294,7 +283,7 @@ Servant.Client.responseBody e `shouldBe` "rawFailure" it "Returns headers appropriately" $ \(_, baseUrl) -> do- res <- runExceptT (getRespHeaders manager baseUrl)+ res <- runClientM getRespHeaders (ClientEnv manager baseUrl) case res of Left e -> assertFailure $ show e Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]@@ -303,7 +292,7 @@ it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) -> property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body -> ioProperty $ do- result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl)+ result <- left show <$> runClientM (getMultiple cap num flag body) (ClientEnv manager baseUrl) return $ result === Right (cap, num, flag, body) @@ -315,9 +304,9 @@ let test :: (WrappedApi, String) -> Spec test (WrappedApi api, desc) = it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do- let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM ()+ let getResponse :: SCR.ClientM () getResponse = client api- Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl)+ Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl) responseStatus `shouldBe` (HTTP.Status 500 "error message") in mapM_ test $ (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :@@ -332,42 +321,42 @@ context "client returns errors appropriately" $ do it "reports FailureResponse" $ \(_, baseUrl) -> do let (_ :<|> getDeleteEmpty :<|> _) = client api- Left res <- runExceptT (getDeleteEmpty manager baseUrl)+ 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- Left res <- runExceptT (getCapture "foo" manager baseUrl)+ 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- Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 ""))+ 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- Left res <- runExceptT (getGet manager baseUrl)+ 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- Left res <- runExceptT (getBody alice manager baseUrl)+ Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl) case res of InvalidContentTypeHeader "fooooo" _ -> return () _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res data WrappedApi where WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,- HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) =>+ HasClient api, Client api ~ SCR.ClientM ()) => Proxy api -> WrappedApi basicAuthSpec :: Spec@@ -377,14 +366,14 @@ it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do let getBasic = client basicAuthAPI let basicAuthData = BasicAuthData "servant" "server"- (left show <$> runExceptT (getBasic basicAuthData 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 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do let getBasic = client basicAuthAPI let basicAuthData = BasicAuthData "not" "password"- Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)+ Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl) responseStatus `shouldBe` HTTP.Status 403 "Forbidden" genAuthSpec :: Spec@@ -394,14 +383,14 @@ it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do let getProtected = client genAuthAPI let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)- (left show <$> runExceptT (getProtected authRequest 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 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do let getProtected = client genAuthAPI let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)- Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)+ Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl) responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized") -- * utils