Merge pull request #17 from haskell-servant/raw-fullresponse

Return complete `Response` in client for Raw endpoint

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

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,

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

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)
+getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, C.Response ByteString)
-getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
+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))
+    res <- runEitherT (getRawSuccess methodGet host)
-      `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")
+    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))
+    res <- runEitherT (getRawFailure methodGet host)
-      `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")
+    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