Client Raw: returns Right (status, body) even for failure statuses

src/Servant/API/Raw.hs

@@ -26,7 +26,7 @@ instance HasServer Raw where
     rawApplication request (respond . succeedWith)
 
 instance HasClient Raw where
-  type Client Raw = Method -> BaseUrl -> EitherT String IO ByteString
+  type Client Raw = Method -> BaseUrl -> EitherT String IO (Int, ByteString)
 
   clientWithRoute :: Proxy Raw -> Req -> Client Raw
   clientWithRoute Proxy req method host =

src/Servant/Common/Req.hs

@@ -82,11 +82,12 @@ displayHttpRequest :: Method -> String
 displayHttpRequest method = "HTTP " ++ cs method ++ " request"
 
 
-performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO ByteString
+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString)
 performRequest method req isWantedStatus host = do
   partialRequest <- liftIO $ reqToRequest req host
 
   let request = partialRequest { Client.method = method
+                               , checkStatus = \ _status _headers _cookies -> Nothing
                                }
 
   eResponse <- liftIO $ __withGlobalManager $ \ manager ->
@@ -100,7 +101,7 @@ performRequest method req isWantedStatus host = do
       let status = Client.responseStatus response
       unless (isWantedStatus (statusCode status)) $
         left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)
-      return $ Client.responseBody response
+      return $ (statusCode status, Client.responseBody response)
   where
     showStatus (Status code message) =
       show code ++ " - " ++ cs message
@@ -109,7 +110,7 @@ performRequest method req isWantedStatus host = do
 performRequestJSON :: FromJSON result =>
   Method -> Req -> Int -> BaseUrl -> EitherT String IO result
 performRequestJSON method req wantedStatus host = do
-  responseBody <- performRequest method req (== wantedStatus) host
+  (_status, responseBody) <- performRequest method req (== wantedStatus) host
   either
     (\ message -> left (displayHttpRequest method ++ " returned invalid json: " ++ message))
     return

test/Servant/ClientSpec.hs

@@ -72,8 +72,8 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person
 getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
 getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
 getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
-getRawSuccess :: Method -> BaseUrl -> EitherT String IO ByteString
-getRawFailure :: Method -> BaseUrl -> EitherT String IO ByteString
+getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)
+getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)
 getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
   -> BaseUrl
   -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
@@ -115,6 +115,12 @@ spec = do
     it (show flag) $ withServer $ \ host -> do
       runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
 
+  it "Servant.API.Raw on success" $ withServer $ \ host -> do
+    runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess")
+
+  it "Servant.API.Raw on failure" $ withServer $ \ host -> do
+    runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure")
+
   modifyMaxSuccess (const 20) $ do
     it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
       property $ forAllShrink pathGen shrink $ \ a -> \ b c d ->