diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index 7d34dbc3..aa0a2dff 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/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
-
Invalid login
-|]
- sendResponse rh
- Just ar -> do setMessageI Msg.InvalidLogin
- redirect ar
+ Nothing -> do
+ res <- selectRep $ do
+ provideRep $ defaultLayout $ toWidget [shamlet|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
diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs
index 1a4488e8..15572638 100644
--- a/yesod-core/Yesod/Core/Json.hs
+++ b/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