From 8015906b53816d004a59f24d53f3797d3e3e96a3 Mon Sep 17 00:00:00 2001
From: Timo von Holtz <tvh@anchor.com.au>
Date: Mon, 9 Mar 2015 08:37:09 +1100
Subject: [PATCH] Record accessors for ServantError

---
 src/Servant/Common/Req.hs | 28 ++++++++++++++++++++++------
 1 file changed, 22 insertions(+), 6 deletions(-)

diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs
index 7405e5cd..d97109c2 100644
--- a/src/Servant/Common/Req.hs
+++ b/src/Servant/Common/Req.hs
@@ -28,11 +28,27 @@ import System.IO.Unsafe
 import qualified Network.HTTP.Client as Client
 
 data ServantError
-  = FailureResponse Status MediaType ByteString
-  | DecodeFailure String MediaType ByteString
-  | UnsupportedContentType MediaType ByteString
-  | ConnectionError HttpException
-  | InvalidContentTypeHeader String
+  = FailureResponse
+    { responseStatus            :: Status
+    , responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | DecodeFailure
+    { decodeError               :: String
+    , responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | UnsupportedContentType
+    { responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | ConnectionError
+    { connectionError           :: HttpException
+    }
+  | InvalidContentTypeHeader
+    { responseContentTypeHeader :: ByteString
+    , responseBody              :: ByteString
+    }
   deriving (Show)
 
 data Req = Req
@@ -139,7 +155,7 @@ performRequest reqMethod req isWantedStatus reqHost = do
       ct <- case lookup "Content-Type" $ Client.responseHeaders response of
                  Nothing -> pure $ "application"//"octet-stream"
                  Just t -> case parseAccept t of
-                   Nothing -> left . InvalidContentTypeHeader . cs $ t
+                   Nothing -> left $ InvalidContentTypeHeader (cs t) body
                    Just t' -> pure t'
       unless (isWantedStatus status_code) $
         left $ FailureResponse status ct body