From b8de9c8527881d144532c27bd3e7d8241cf22721 Mon Sep 17 00:00:00 2001
From: Stevan Andjelkovic <stevan@advancedtelematic.com>
Date: Fri, 5 May 2017 15:31:38 +0200
Subject: [PATCH] Include the request that failed in FailureResponse.

---
 servant-client/src/Servant/Common/Req.hs  | 13 +++++++------
 servant-client/test/Servant/ClientSpec.hs |  6 +++---
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs
index f3de9687..509d4f69 100644
--- a/servant-client/src/Servant/Common/Req.hs
+++ b/servant-client/src/Servant/Common/Req.hs
@@ -48,7 +48,8 @@ import Web.HttpApiData
 
 data ServantError
   = FailureResponse
-    { responseStatus            :: Status
+    { failingRequest            :: Request
+    , responseStatus            :: Status
     , responseContentType       :: MediaType
     , responseBody              :: ByteString
     }
@@ -71,8 +72,8 @@ data ServantError
   deriving (Show, Typeable)
 
 instance Eq ServantError where
-  FailureResponse a b c == FailureResponse x y z =
-    (a, b, c) == (x, y, z)
+  FailureResponse a b c d == FailureResponse w x y z =
+    (show a, b, c, d) == (show w, x, y, z)
   DecodeFailure a b c == DecodeFailure x y z =
     (a, b, c) == (x, y, z)
   UnsupportedContentType a b == UnsupportedContentType x y =
@@ -224,7 +225,7 @@ runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
 runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
 
 
-performRequest :: Method -> Req 
+performRequest :: Method -> Req
                -> ClientM ( Int, ByteString, MediaType
                           , [HTTP.Header], Response ByteString)
 performRequest reqMethod req = do
@@ -250,10 +251,10 @@ performRequest reqMethod req = do
                    Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
                    Just t' -> pure t'
       unless (status_code >= 200 && status_code < 300) $
-        throwError $ FailureResponse status ct body
+        throwError $ FailureResponse request status ct body
       return (status_code, body, ct, hdrs, response)
 
-performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req 
+performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
     -> ClientM ([HTTP.Header], result)
 performRequestCT ct reqMethod req = do
   let acceptCTS = contentTypes ct
diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs
index 0de8cb8f..fc6fc92f 100644
--- a/servant-client/test/Servant/ClientSpec.hs
+++ b/servant-client/test/Servant/ClientSpec.hs
@@ -122,9 +122,9 @@ getBody         :: Person -> SCR.ClientM Person
 getQueryParam   :: Maybe String -> SCR.ClientM Person
 getQueryParams  :: [String] -> SCR.ClientM [Person]
 getQueryFlag    :: Bool -> SCR.ClientM Bool
-getRawSuccess :: HTTP.Method 
+getRawSuccess :: HTTP.Method
   -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
-getRawFailure   :: HTTP.Method 
+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])])
@@ -372,7 +372,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
         let (_ :<|> getDeleteEmpty :<|> _) = client api
         Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
         case res of
-          FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
+          FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return ()
           _ -> fail $ "expected 404 response, but got " <> show res
 
       it "reports DecodeFailure" $ \(_, baseUrl) -> do