From c163e2156c593c3437d442e6303af19d085d725c Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Tue, 14 Oct 2014 19:23:56 -0700
Subject: [PATCH] Indicate input json parse error with better message

Fixes #42
---
 src/Dbapi.hs               | 2 +-
 test/Feature/InsertSpec.hs | 9 +++++++++
 2 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/src/Dbapi.hs b/src/Dbapi.hs
index 20532e054..6cba560f0 100644
--- a/src/Dbapi.hs
+++ b/src/Dbapi.hs
@@ -59,7 +59,7 @@ jsonBodyAction req handler = do
   parse <- jsonBody req
   case parse of
     Left err -> return $ responseLBS status400 [jsonContentType] json
-      where json = JSON.encode . JSON.object $ [("error", JSON.String $ cs err)]
+      where json = JSON.encode . JSON.object $ [("error", JSON.String $ "Failed to parse JSON payload. " <> cs err) ]
     Right body -> handler body
 
 jsonBody :: Request -> IO (Either String SqlRow)
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index de85d7442..6678fba7f 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -68,6 +68,15 @@ spec = around appWithFixture $ do
             matchHeaders = ["Location" <:> "/compound_pk?k1=eq.12&k2=eq.42"]
           }
 
+    context "with invalid json payload" $
+      it "fails with 400 and error" $
+        post "/simple_pk" "}{ x = 2"
+          `shouldRespondWith` ResponseMatcher {
+            matchBody    = Just [json| {"error":"Failed to parse JSON payload. Failed reading: satisfy"} |]
+          , matchStatus  = 400
+          , matchHeaders = []
+          }
+
   describe "Putting record" $ do
 
     context "to unkonwn uri" $