yesod-auth doesn't use redirects for JSON requests (fixes #479)

yesod-auth/Yesod/Auth.hs

@@ -162,26 +162,39 @@ mkYesodSub "Auth"
 /page/#Text/STRINGS PluginR
 |]
 
-setCreds :: YesodAuth master => Bool -> Creds master -> GHandler sub master ()
+setCreds :: YesodAuth master
+         => Bool
+         -> Creds master
+         -> GHandler sub master ()
 setCreds doRedirects creds = do
     y    <- getYesod
     maid <- getAuthId creds
     case maid of
-        Nothing ->
-          when doRedirects $ do
+        Nothing -> when doRedirects $ do
             case authRoute y of
-              Nothing -> do rh <- defaultLayout $ toWidget [shamlet|
-$newline never
-<h1>Invalid login
-|]
-                            sendResponse rh
-              Just ar -> do setMessageI Msg.InvalidLogin
-                            redirect ar
+                Nothing -> do
+                    res <- selectRep $ do
+                        provideRep $ defaultLayout $ toWidget [shamlet|<h1>Invalid login|]
+                        provideRep $ return $ object ["message" .= ("Invalid Login" :: Text)]
+                    sendResponse res
+                Just ar -> do
+                    res <- selectRep $ do
+                        provideRepType typeHtml $ do
+                            setMessageI Msg.InvalidLogin
+                            _ <- redirect ar
+                            return ()
+                        provideRep $ return $ object ["message" .= ("Invalid Login" :: Text)]
+                    sendResponse res
         Just aid -> do
             setSession credsKey $ toPathPiece aid
             when doRedirects $ do
-              onLogin
-              redirectUltDest $ loginDest y
+                onLogin
+                res <- selectRep $ do
+                    provideRepType typeHtml $ do
+                        _ <- redirectUltDest $ loginDest y
+                        return ()
+                    provideRep $ return $ object ["message" .= ("Login Successful" :: Text)]
+                sendResponse res
 
 getCheckR :: YesodAuth master => GHandler Auth master TypedContent
 getCheckR = do

yesod-core/Yesod/Core/Json.hs

@@ -11,7 +11,6 @@ module Yesod.Core.Json
 
       -- * Produce JSON values
     , J.Value (..)
-    , object
     , array
     , (.=)
 
@@ -26,14 +25,13 @@ import Yesod.Content (TypedContent)
 import Yesod.Internal.Core (defaultLayout, Yesod)
 import Yesod.Widget (GWidget)
 import Yesod.Routes.Class
-import Control.Arrow (second)
 import Control.Applicative ((<$>))
 import Control.Monad (join)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Parser as JP
 import Data.Aeson ((.=))
 import Data.Conduit.Attoparsec (sinkParser)
-import Data.Text (Text, pack)
+import Data.Text (pack)
 import qualified Data.Vector as V
 import Data.Conduit
 import Network.Wai (requestBody, requestHeaders)
@@ -87,10 +85,6 @@ parseJsonBody_ = do
         J.Error s -> invalidArgs [pack s]
         J.Success a -> return a
 
--- | Convert a list of pairs to an 'J.Object'.
-object :: J.ToJSON a => [(Text, a)] -> J.Value
-object = J.object . map (second J.toJSON)
-
 -- | Convert a list of values to an 'J.Array'.
 array :: J.ToJSON a => [a] -> J.Value
 array = J.Array . V.fromList . map J.toJSON