From e6e67b275bd0a32f966d93f25566b6a437aa9163 Mon Sep 17 00:00:00 2001
From: Timo von Holtz <tvh@anchor.com.au>
Date: Tue, 17 Feb 2015 10:55:35 +1100
Subject: [PATCH] Check for correct content-type in result.

---
 src/Servant/Common/Req.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs
index 13b12285..aa2bfdcd 100644
--- a/src/Servant/Common/Req.hs
+++ b/src/Servant/Common/Req.hs
@@ -142,7 +142,9 @@ performRequest reqMethod req isWantedStatus reqHost = do
 performRequestJSON :: FromJSON result =>
   Method -> Req -> Int -> BaseUrl -> EitherT String IO result
 performRequestJSON reqMethod req wantedStatus reqHost = do
-  (_status, respBody, _) <- performRequest reqMethod req (== wantedStatus) reqHost
+  (_status, respBody, contentType) <- performRequest reqMethod req (== wantedStatus) reqHost
+  unless (matches contentType ("application"//"json")) $
+    left $ "requested Content-Type application/json, but got " <> show contentType
   either
     (\ message -> left (displayHttpRequest reqMethod ++ " returned invalid json: " ++ message))
     return