From 9e1ba9221d980353d86fc836f7efc673ecc2329a Mon Sep 17 00:00:00 2001 From: mbg Date: Wed, 30 Mar 2016 22:41:39 +0100 Subject: [PATCH] Manager and BaseUrl are now explicit parameters of all client functions, instead of ReaderTs --- servant-client/src/Servant/Client.hs | 50 ++++----- servant-client/src/Servant/Common/Req.hs | 39 +++---- servant-client/test/Servant/ClientSpec.hs | 125 +++++++++------------- 3 files changed, 93 insertions(+), 121 deletions(-) diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 91c07bcb..9c2fcfbc 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -33,7 +33,7 @@ import Data.Proxy import Data.String.Conversions import Data.Text (unpack) import GHC.TypeLits -import Network.HTTP.Client (Response) +import Network.HTTP.Client (Manager, Response) import Network.HTTP.Media import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as HTTP @@ -53,8 +53,8 @@ import Servant.Common.Req -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > getAllBooks :: ClientM [Book] --- > postNewBook :: Book -> ClientM Book +-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book] +-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > (getAllBooks :<|> postNewBook) = client myApi client :: HasClient layout => Proxy layout -> Client layout client p = clientWithRoute p defReq @@ -77,8 +77,8 @@ class HasClient layout where -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > getAllBooks :: ClientM [Book] --- > postNewBook :: Book -> ClientM Book +-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book] +-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > (getAllBooks :<|> postNewBook) = client myApi instance (HasClient a, HasClient b) => HasClient (a :<|> b) where type Client (a :<|> b) = Client a :<|> Client b @@ -102,7 +102,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > getBook :: Text -> ClientM Book +-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book -- > getBook = client myApi -- > -- then you can just use "getBook" to query that endpoint instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) @@ -121,26 +121,28 @@ instance OVERLAPPABLE_ -- 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) = ClientM a - clientWithRoute Proxy req = - snd <$> performRequestCT (Proxy :: Proxy ct) method req + 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 where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_ (ReflectMethod method) => HasClient (Verb method status cts NoContent) where - type Client (Verb method status cts NoContent) = ClientM NoContent - clientWithRoute Proxy req = - performRequestNoBody method req >> return NoContent + type Client (Verb method status cts NoContent) + = Manager -> BaseUrl -> ClientM NoContent + clientWithRoute Proxy req manager baseurl = + performRequestNoBody method req manager baseurl >> return NoContent where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_ -- Note [Non-Empty Content Types] ( 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)) = ClientM (Headers ls a) - clientWithRoute Proxy req = do + type Client (Verb method status cts' (Headers ls a)) + = Manager -> BaseUrl -> ClientM (Headers ls a) + clientWithRoute Proxy req manager baseurl = do let method = reflectMethod (Proxy :: Proxy method) - (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req + (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl return $ Headers { getResponse = resp , getHeadersHList = buildHeadersTo hdrs } @@ -149,10 +151,10 @@ instance OVERLAPPING_ ( BuildHeadersTo ls, ReflectMethod method ) => HasClient (Verb method status cts (Headers ls NoContent)) where type Client (Verb method status cts (Headers ls NoContent)) - = ClientM (Headers ls NoContent) - clientWithRoute Proxy req = do + = Manager -> BaseUrl -> ClientM (Headers ls NoContent) + clientWithRoute Proxy req manager baseurl = do let method = reflectMethod (Proxy :: Proxy method) - hdrs <- performRequestNoBody method req + hdrs <- performRequestNoBody method req manager baseurl return $ Headers { getResponse = NoContent , getHeadersHList = buildHeadersTo hdrs } @@ -179,7 +181,7 @@ instance OVERLAPPING_ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > viewReferer :: Maybe Referer -> ClientM Book +-- > viewReferer :: Maybe Referer -> Manager -> BaseUrl -> ClientM Book -- > viewReferer = client myApi -- > -- then you can just use "viewRefer" to query that endpoint -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments @@ -229,7 +231,7 @@ instance HasClient sublayout -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > getBooksBy :: Maybe Text -> ClientM [Book] +-- > getBooksBy :: Maybe Text -> Manager -> BaseUrl -> ClientM [Book] -- > getBooksBy = client myApi -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooksBy Nothing' for all books @@ -273,7 +275,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > getBooksBy :: [Text] -> ClientM [Book] +-- > getBooksBy :: [Text] -> Manager -> BaseUrl -> ClientM [Book] -- > getBooksBy = client myApi -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooksBy []' for all books @@ -312,7 +314,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > getBooks :: Bool -> ClientM [Book] +-- > getBooks :: Bool -> Manager -> BaseUrl -> ClientM [Book] -- > getBooks = client myApi -- > -- then you can just use "getBooks" to query that endpoint. -- > -- 'getBooksBy False' for all books @@ -337,7 +339,7 @@ instance (KnownSymbol sym, HasClient sublayout) -- back the full `Response`. instance HasClient Raw where type Client Raw - = H.Method -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) + = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) clientWithRoute :: Proxy Raw -> Req -> Client Raw clientWithRoute Proxy req httpMethod = do @@ -358,7 +360,7 @@ instance HasClient Raw where -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > addBook :: Book -> ClientM Book +-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > addBook = client myApi -- > -- then you can just use "addBook" to query that endpoint instance (MimeRender ct a, HasClient sublayout) diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index 44551464..52398637 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -11,9 +11,7 @@ import Control.Exception import Control.Monad import Control.Monad.Catch (MonadThrow) import Control.Monad.IO.Class -import Control.Monad.Trans.Class import Control.Monad.Trans.Except -import Control.Monad.Trans.Reader import Data.ByteString.Lazy hiding (pack, filter, map, null, elem) import Data.String import Data.String.Conversions @@ -125,21 +123,12 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) = displayHttpRequest :: Method -> String displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request" -type ClientM = ReaderT BaseUrl (ReaderT Manager (ExceptT ServantError IO)) +type ClientM = ExceptT ServantError IO -runClientM :: ClientM a -> BaseUrl -> Manager -> IO (Either ServantError a) -runClientM m baseUrl manager = runExceptT (runReaderT (runReaderT m baseUrl) manager) - --- to avoid adding a dependency on mtl -throwError :: ServantError -> ClientM a -throwError = lift . lift . throwE - -performRequest :: Method -> Req +performRequest :: Method -> Req -> Manager -> BaseUrl -> ClientM ( Int, ByteString, MediaType , [HTTP.Header], Response ByteString) -performRequest reqMethod req = do - reqHost <- ask - manager <- lift ask +performRequest reqMethod req manager reqHost = do partialRequest <- liftIO $ reqToRequest req reqHost let request = partialRequest { Client.method = reqMethod @@ -149,7 +138,7 @@ performRequest reqMethod req = do eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager case eResponse of Left err -> - throwError . ConnectionError $ SomeException err + throwE . ConnectionError $ SomeException err Right response -> do let status = Client.responseStatus response @@ -159,29 +148,29 @@ performRequest reqMethod req = do ct <- case lookup "Content-Type" $ Client.responseHeaders response of Nothing -> pure $ "application"//"octet-stream" Just t -> case parseAccept t of - Nothing -> throwError $ InvalidContentTypeHeader (cs t) body + Nothing -> throwE $ InvalidContentTypeHeader (cs t) body Just t' -> pure t' unless (status_code >= 200 && status_code < 300) $ - throwError $ FailureResponse status ct body + throwE $ FailureResponse status ct body return (status_code, body, ct, hdrs, response) performRequestCT :: MimeUnrender ct result => - Proxy ct -> Method -> Req + Proxy ct -> Method -> Req -> Manager -> BaseUrl -> ClientM ([HTTP.Header], result) -performRequestCT ct reqMethod req = do +performRequestCT ct reqMethod req manager reqHost = do let acceptCT = contentType ct (_status, respBody, respCT, hdrs, _response) <- - performRequest reqMethod (req { reqAccept = [acceptCT] }) - unless (matches respCT (acceptCT)) $ throwError $ UnsupportedContentType respCT respBody + performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost + unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody case mimeUnrender ct respBody of - Left err -> throwError $ DecodeFailure err respCT respBody + Left err -> throwE $ DecodeFailure err respCT respBody Right val -> return (hdrs, val) -performRequestNoBody :: Method -> Req +performRequestNoBody :: Method -> Req -> Manager -> BaseUrl -> ClientM [HTTP.Header] -performRequestNoBody reqMethod req = do - (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req +performRequestNoBody reqMethod req manager reqHost = do + (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost return hdrs catchConnectionError :: IO a -> IO (Either ServantError a) diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 999c69c9..2263e9e2 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -28,7 +28,7 @@ import Control.Applicative ((<$>)) import Control.Arrow (left) import Control.Concurrent (forkIO, killThread, ThreadId) import Control.Exception (bracket) -import Control.Monad.Trans.Except (ExceptT, throwE) +import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT) import Data.Aeson import qualified Data.ByteString.Lazy as BS import Data.Char (chr, isPrint) @@ -119,52 +119,33 @@ type Api = api :: Proxy Api api = Proxy -getGet :: SCR.ClientM Person -getDeleteEmpty :: SCR.ClientM NoContent -getCapture :: 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 - -> SCR.ClientM ( Int - , BS.ByteString - , MediaType - , [HTTP.Header] - , C.Response BS.ByteString ) -getMultiple :: String - -> Maybe Int - -> Bool - -> [(String, [Rational])] - -> SCR.ClientM ( String - , Maybe Int - , Bool - , [(String, [Rational])] ) -getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool) -getDeleteContentType :: SCR.ClientM NoContent +getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person +getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent +getCapture :: 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 + -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString) +getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl + -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString) +getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl + -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])]) +getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool) +getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent getGet - :<|> getDeleteEmpty - :<|> getCapture - :<|> getBody - :<|> getQueryParam - :<|> getQueryParams - :<|> getQueryFlag - :<|> getRawSuccess - :<|> getRawFailure - :<|> getMultiple - :<|> getRespHeaders - :<|> getDeleteContentType = client api + :<|> getDeleteEmpty + :<|> getCapture + :<|> getBody + :<|> getQueryParam + :<|> getQueryParams + :<|> getQueryFlag + :<|> getRawSuccess + :<|> getRawFailure + :<|> getMultiple + :<|> getRespHeaders + :<|> getDeleteContentType = client api server :: Application server = serve api ( @@ -254,38 +235,38 @@ sucessSpec :: Spec sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do it "Servant.API.Get" $ \(_, baseUrl) -> do - (left show <$> SCR.runClientM getGet baseUrl manager) `shouldReturn` Right alice + (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice describe "Servant.API.Delete" $ do it "allows empty content type" $ \(_, baseUrl) -> do - (left show <$> SCR.runClientM getDeleteEmpty baseUrl manager) `shouldReturn` Right NoContent + (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent it "allows content type" $ \(_, baseUrl) -> do - (left show <$> SCR.runClientM getDeleteContentType baseUrl manager) `shouldReturn` Right NoContent + (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent it "Servant.API.Capture" $ \(_, baseUrl) -> do - (left show <$> SCR.runClientM (getCapture "Paula") baseUrl manager) `shouldReturn` Right (Person "Paula" 0) + (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0) it "Servant.API.ReqBody" $ \(_, baseUrl) -> do let p = Person "Clara" 42 - (left show <$> SCR.runClientM (getBody p) baseUrl manager) `shouldReturn` Right p + (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p it "Servant.API.QueryParam" $ \(_, baseUrl) -> do - left show <$> SCR.runClientM (getQueryParam (Just "alice")) baseUrl manager `shouldReturn` Right alice - Left FailureResponse{..} <- SCR.runClientM (getQueryParam (Just "bob")) baseUrl manager + left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice + Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl) responseStatus `shouldBe` HTTP.Status 400 "bob not found" it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do - (left show <$> SCR.runClientM (getQueryParams []) baseUrl manager) `shouldReturn` Right [] - (left show <$> SCR.runClientM (getQueryParams ["alice", "bob"]) baseUrl manager) + (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right [] + (left show <$> runExceptT (getQueryParams ["alice", "bob"] 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 <$> SCR.runClientM (getQueryFlag flag) baseUrl manager) `shouldReturn` Right flag + (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag it "Servant.API.Raw on success" $ \(_, baseUrl) -> do - res <- SCR.runClientM (getRawSuccess HTTP.methodGet) baseUrl manager + res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl) case res of Left e -> assertFailure $ show e Right (code, body, ct, _, response) -> do @@ -294,7 +275,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do C.responseStatus response `shouldBe` HTTP.ok200 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do - res <- SCR.runClientM (getRawFailure HTTP.methodGet) baseUrl manager + res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl) case res of Right _ -> assertFailure "expected Left, but got Right" Left e -> do @@ -302,7 +283,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do Servant.Client.responseBody e `shouldBe` "rawFailure" it "Returns headers appropriately" $ \(_, baseUrl) -> do - res <- SCR.runClientM getRespHeaders baseUrl manager + res <- runExceptT (getRespHeaders manager baseUrl) case res of Left e -> assertFailure $ show e Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")] @@ -311,7 +292,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do 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 <$> SCR.runClientM (getMultiple cap num flag body) baseUrl manager + result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl) return $ result === Right (cap, num, flag, body) @@ -323,9 +304,9 @@ wrappedApiSpec = describe "error status codes" $ do let test :: (WrappedApi, String) -> Spec test (WrappedApi api, desc) = it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do - let getResponse :: SCR.ClientM () + let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM () getResponse = client api - Left FailureResponse{..} <- SCR.runClientM getResponse baseUrl manager + Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl) responseStatus `shouldBe` (HTTP.Status 500 "error message") in mapM_ test $ (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") : @@ -340,42 +321,42 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do context "client returns errors appropriately" $ do it "reports FailureResponse" $ \(_, baseUrl) -> do let (_ :<|> getDeleteEmpty :<|> _) = client api - Left res <- SCR.runClientM getDeleteEmpty baseUrl manager + Left res <- runExceptT (getDeleteEmpty 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 <- SCR.runClientM (getCapture "foo") baseUrl manager + Left res <- runExceptT (getCapture "foo" 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 <- SCR.runClientM getGetWrongHost (BaseUrl Http "127.0.0.1" 19872 "") manager + Left res <- runExceptT (getGetWrongHost 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 <- SCR.runClientM getGet baseUrl manager + Left res <- runExceptT (getGet 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 <- SCR.runClientM (getBody alice) baseUrl manager + Left res <- runExceptT (getBody alice manager baseUrl) case res of InvalidContentTypeHeader "fooooo" _ -> return () _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res data WrappedApi where WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a, - HasClient api, Client api ~ SCR.ClientM ()) => + HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) => Proxy api -> WrappedApi basicAuthSpec :: Spec @@ -385,14 +366,14 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do let getBasic = client basicAuthAPI let basicAuthData = BasicAuthData "servant" "server" - (left show <$> SCR.runClientM (getBasic basicAuthData) baseUrl manager) `shouldReturn` Right alice + (left show <$> runExceptT (getBasic basicAuthData 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{..} <- SCR.runClientM (getBasic basicAuthData) baseUrl manager + Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl) responseStatus `shouldBe` HTTP.Status 403 "Forbidden" genAuthSpec :: Spec @@ -402,14 +383,14 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do 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 <$> SCR.runClientM (getProtected authRequest) baseUrl manager) `shouldReturn` Right alice + (left show <$> runExceptT (getProtected authRequest 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{..} <- SCR.runClientM (getProtected authRequest) baseUrl manager + Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl) responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized") -- * utils