diff --git a/servant-client.cabal b/servant-client.cabal index b743e1a5..512b64bd 100644 --- a/servant-client.cabal +++ b/servant-client.cabal @@ -74,6 +74,7 @@ test-suite spec , http-client , http-media , http-types + , HUnit , network >= 2.6 , QuickCheck >= 2.7 , servant >= 0.2.1 diff --git a/src/Servant/Client.hs b/src/Servant/Client.hs index f6b097a8..0cff69c2 100644 --- a/src/Servant/Client.hs +++ b/src/Servant/Client.hs @@ -23,6 +23,7 @@ import Data.Proxy import Data.String.Conversions import Data.Text (unpack) import GHC.TypeLits +import Network.HTTP.Client (Response) import Network.HTTP.Media import qualified Network.HTTP.Types as H import Servant.API @@ -411,12 +412,12 @@ instance (KnownSymbol sym, HasClient sublayout) where paramname = cs $ symbolVal (Proxy :: Proxy sym) -- | Pick a 'Method' and specify where the server you want to query is. You get --- back the status code and the response body as a 'ByteString'. +-- back the full `Response`. instance HasClient Raw where - type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType) + type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, Response ByteString) clientWithRoute :: Proxy Raw -> Req -> Client Raw - clientWithRoute Proxy req httpMethod host = + clientWithRoute Proxy req httpMethod host = do performRequest httpMethod req (const True) host -- | If you use a 'ReqBody' in one of your endpoints in your API, diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs index 03e6b71b..d87045cc 100644 --- a/src/Servant/Common/Req.hs +++ b/src/Servant/Common/Req.hs @@ -133,7 +133,7 @@ displayHttpRequest :: Method -> String displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request" -performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType) +performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, Response ByteString) performRequest reqMethod req isWantedStatus reqHost = do partialRequest <- liftIO $ reqToRequest req reqHost @@ -159,13 +159,13 @@ performRequest reqMethod req isWantedStatus reqHost = do Just t' -> pure t' unless (isWantedStatus status_code) $ left $ FailureResponse status ct body - return (status_code, body, ct) + return (status_code, body, ct, response) performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO result performRequestCT ct reqMethod req wantedStatus reqHost = do let acceptCT = contentType ct - (_status, respBody, respCT) <- + (_status, respBody, respCT, _response) <- performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost unless (matches respCT (acceptCT)) $ left $ UnsupportedContentType respCT respBody diff --git a/test/Servant/ClientSpec.hs b/test/Servant/ClientSpec.hs index f3fb67c3..7b1645c0 100644 --- a/test/Servant/ClientSpec.hs +++ b/test/Servant/ClientSpec.hs @@ -23,14 +23,15 @@ import Data.Monoid import Data.Proxy import qualified Data.Text as T import GHC.Generics -import Network.HTTP.Client (HttpException(..)) +import qualified Network.HTTP.Client as C import Network.HTTP.Media import Network.HTTP.Types import Network.Socket -import Network.Wai +import Network.Wai hiding (Response) import Network.Wai.Handler.Warp import Test.Hspec import Test.Hspec.QuickCheck +import Test.HUnit import Test.QuickCheck import Servant.API @@ -64,7 +65,7 @@ instance FromFormUrlEncoded Person where deriving instance Eq ServantError -instance Eq HttpException where +instance Eq C.HttpException where a == b = show a == show b alice :: Person @@ -128,8 +129,8 @@ getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person] getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool -getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType) -getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType) +getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, C.Response ByteString) +getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, C.Response ByteString) getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> BaseUrl -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])]) @@ -211,12 +212,22 @@ spec = do Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag it "Servant.API.Raw on success" $ withServer $ \ host -> do - (Arrow.left show <$> runEitherT (getRawSuccess methodGet host)) - `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream") + res <- runEitherT (getRawSuccess methodGet host) + case res of + Left e -> assertFailure $ show e + Right (code, body, ct, response) -> do + (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream") + C.responseBody response `shouldBe` body + C.responseStatus response `shouldBe` ok200 it "Servant.API.Raw on failure" $ withServer $ \ host -> do - (Arrow.left show <$> runEitherT (getRawFailure methodGet host)) - `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream") + res <- runEitherT (getRawFailure methodGet host) + case res of + Left e -> assertFailure $ show e + Right (code, body, ct, response) -> do + (code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream") + C.responseBody response `shouldBe` body + C.responseStatus response `shouldBe` badRequest400 modifyMaxSuccess (const 20) $ do it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ @@ -262,7 +273,7 @@ spec = do Right host <- return $ parseBaseUrl "127.0.0.1:987654" Left res <- runEitherT (getGet host) case res of - ConnectionError (FailedConnectionException2 "127.0.0.1" 987654 False _) -> return () + ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return () _ -> fail $ "expected ConnectionError, but got " <> show res it "reports UnsupportedContentType" $ withFailServer $ \ host -> do