From 6db31ec3c42ebf8635c711fe742ec6c725f24903 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 7 May 2013 18:54:08 +0300
Subject: [PATCH] HashDB: JSON response on bad login #549

---
 yesod-auth/Yesod/Auth/HashDB.hs | 23 ++++++++++++++++++-----
 yesod-auth/yesod-auth.cabal     |  1 +
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/yesod-auth/Yesod/Auth/HashDB.hs b/yesod-auth/Yesod/Auth/HashDB.hs
index 16117e2a..d441475c 100644
--- a/yesod-auth/Yesod/Auth/HashDB.hs
+++ b/yesod-auth/Yesod/Auth/HashDB.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE ConstraintKinds            #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -81,6 +82,7 @@ import Text.Hamlet (hamlet)
 
 import Control.Applicative         ((<$>), (<*>))
 import Control.Monad               (replicateM,liftM)
+import Control.Monad.Trans.Resource (MonadResourceBase)
 
 import qualified Data.ByteString.Lazy.Char8 as BS (pack)
 import Data.Digest.Pure.SHA        (sha1, showDigest)
@@ -175,9 +177,22 @@ postLoginR uniq = do
                  (validateUser <$> (uniq =<< mu) <*> mp)
     if isValid 
        then lift $ setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
-       else do setMessage "Invalid username/password"
-               redirect LoginR
+       else loginMsg LoginR "Invalid username/password"
 
+loginMsg :: MonadResourceBase m
+         => Route site
+         -> Text
+         -> HandlerT site m a
+loginMsg dest msg = selectRep (do
+    provideRep $ do
+        setMessage $ toHtml msg
+        fmap asHtml $ redirect dest
+    provideRep $ return $ object
+        [ "message" .= msg
+        ]) >>= sendResponse
+  where
+    asHtml :: Html -> Html
+    asHtml = id
 
 -- | A drop in for the getAuthId method of your YesodAuth instance which
 --   can be used if authHashDB is the only plugin in use.
@@ -204,9 +219,7 @@ getAuthIdHashDB authR uniq creds = do
             case x of
                 -- user exists
                 Just (Entity uid _) -> return $ Just uid
-                Nothing       -> do
-                    setMessage "User not found"
-                    redirect $ authR LoginR
+                Nothing       -> loginMsg (authR LoginR) "User not found"
 
 -- | Prompt for username and password, validate that against a database
 --   which holds the username and a hash of the password
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index b5a27e35..dd22f5cc 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -48,6 +48,7 @@ library
                    , file-embed
                    , email-validate          >= 1.0
                    , data-default
+                   , resourcet
 
     exposed-modules: Yesod.Auth
                      Yesod.Auth.BrowserId