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