From 2e8078e4616f7904f0dbff0361f199bf87e15c13 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 10 Mar 2013 09:27:06 +0200
Subject: [PATCH 1/3] Deal with JSON parse errors #511

---
 yesod-json/Yesod/Json.hs    | 10 ++++++++--
 yesod-json/yesod-json.cabal | 14 +++++++++++++-
 2 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/yesod-json/Yesod/Json.hs b/yesod-json/Yesod/Json.hs
index eb46612a..dcc4dce8 100644
--- a/yesod-json/Yesod/Json.hs
+++ b/yesod-json/Yesod/Json.hs
@@ -45,7 +45,7 @@ import Data.Text.Lazy.Builder (fromLazyText)
 import Data.Text.Lazy.Encoding (decodeUtf8)
 import Data.Text.Lazy.Builder (toLazyText)
 import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
-import Data.Conduit (($$))
+import Data.Conduit
 import Network.Wai (requestBody, requestHeaders)
 import Network.Wai.Parse (parseHttpAccept)
 import qualified Data.ByteString.Char8 as B8
@@ -88,7 +88,13 @@ jsonToRepJson = return . RepJson . toContent . J.toJSON
 parseJsonBody :: J.FromJSON a => GHandler sub master (J.Result a)
 parseJsonBody = do
     req <- waiRequest
-    fmap J.fromJSON $ lift $ requestBody req $$ sinkParser JP.value'
+    eValue <- lift
+            $ runExceptionT
+            $ transPipe lift (requestBody req)
+           $$ sinkParser JP.value'
+    return $ case eValue of
+        Left e -> J.Error $ show e
+        Right value -> J.fromJSON value
 
 -- | Same as 'parseJsonBody', but return an invalid args response on a parse
 -- error.
diff --git a/yesod-json/yesod-json.cabal b/yesod-json/yesod-json.cabal
index 1048b3a4..3a29c9e9 100644
--- a/yesod-json/yesod-json.cabal
+++ b/yesod-json/yesod-json.cabal
@@ -7,7 +7,7 @@ maintainer:      Michael Snoyman <michael@snoyman.com>
 synopsis:        Generate content for Yesod using the aeson package.
 category:        Web, Yesod
 stability:       Stable
-cabal-version:   >= 1.6
+cabal-version:   >= 1.8
 build-type:      Simple
 homepage:        http://www.yesodweb.com/
 description:     Generate content for Yesod using the aeson package.
@@ -32,6 +32,18 @@ library
     exposed-modules: Yesod.Json
     ghc-options:     -Wall
 
+test-suite tests
+    type: exitcode-stdio-1.0
+    main-is: Spec.hs
+    hs-source-dirs: test
+    build-depends: base
+                 , wai-test
+                 , hspec
+                 , yesod-json
+                 , yesod-core
+                 , text
+                 , containers
+
 source-repository head
   type:     git
   location: https://github.com/yesodweb/yesod

From b8a8000ac7bdf5f59216195d2a53f639a3191599 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 10 Mar 2013 09:41:24 +0200
Subject: [PATCH 2/3] Version bump

---
 yesod-json/yesod-json.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/yesod-json/yesod-json.cabal b/yesod-json/yesod-json.cabal
index 3a29c9e9..42610e8c 100644
--- a/yesod-json/yesod-json.cabal
+++ b/yesod-json/yesod-json.cabal
@@ -1,5 +1,5 @@
 name:            yesod-json
-version:         1.1.2.1
+version:         1.1.2.2
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

From 90252618d657b284528c99f1b72d2e045ce13803 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 10 Mar 2013 09:43:21 +0200
Subject: [PATCH 3/3] Added missing test file

---
 yesod-json/test/Spec.hs | 47 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 47 insertions(+)
 create mode 100644 yesod-json/test/Spec.hs

diff --git a/yesod-json/test/Spec.hs b/yesod-json/test/Spec.hs
new file mode 100644
index 00000000..7ed8c3dd
--- /dev/null
+++ b/yesod-json/test/Spec.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-}
+import Yesod.Core
+import Yesod.Json
+import Test.Hspec
+import qualified Data.Map as Map
+import Network.Wai.Test
+import Data.Text (Text)
+
+data App = App
+
+mkYesod "App" [parseRoutes|
+/ HomeR GET
+|]
+
+instance Yesod App
+
+getHomeR :: Handler RepPlain
+getHomeR = do
+    val <- parseJsonBody_
+    case Map.lookup ("foo" :: Text) val of
+        Nothing -> invalidArgs ["foo not found"]
+        Just foo -> return $ RepPlain $ toContent (foo :: Text)
+
+main :: IO ()
+main = do
+    app <- toWaiApp App
+    hspec $ describe "Yesod.Json" $ do
+        it "parses valid content" $ flip runSession app $ do
+            sres <- srequest SRequest
+                { simpleRequest = defaultRequest
+                , simpleRequestBody = "{\"foo\":\"bar\"}"
+                }
+            assertStatus 200 sres
+            assertBody "bar" sres
+        it "400 for bad JSON" $ flip runSession app $ do
+            sres <- srequest SRequest
+                { simpleRequest = defaultRequest
+                , simpleRequestBody = "{\"foo\":\"bar\""
+                }
+            assertStatus 400 sres
+        it "400 for bad structure" $ flip runSession app $ do
+            sres <- srequest SRequest
+                { simpleRequest = defaultRequest
+                , simpleRequestBody = "{\"foo2\":\"bar\"}"
+                }
+            assertStatus 400 sres
+            assertBodyContains "foo not found" sres