diff --git a/Yesod/Auth.hs b/Yesod/Auth.hs index a47f376d..71574336 100644 --- a/Yesod/Auth.hs +++ b/Yesod/Auth.hs @@ -25,7 +25,6 @@ module Yesod.Auth import Yesod.Core import Yesod.Persist import Yesod.Json -import Text.Blaze import Language.Haskell.TH.Syntax hiding (lift) import qualified Network.Wai as W import Text.Hamlet (hamlet) @@ -39,6 +38,7 @@ import Data.Text.Encoding.Error (lenientDecode) import Web.Routes.Quasi (toSinglePiece, fromSinglePiece) import Yesod.Auth.Message (AuthMessage, defaultMessage) import qualified Yesod.Auth.Message as Msg +import Yesod.Form (FormMessage) data Auth = Auth @@ -61,7 +61,7 @@ data Creds m = Creds , credsExtra :: [(Text, Text)] } -class (Yesod m, SinglePiece (AuthId m)) => YesodAuth m where +class (Yesod m, SinglePiece (AuthId m), RenderMessage m FormMessage) => YesodAuth m where type AuthId m -- | Default destination on successful login, if no other @@ -85,11 +85,9 @@ class (Yesod m, SinglePiece (AuthId m)) => YesodAuth m where renderAuthMessage :: m -> [Text] -- ^ languages - -> AuthMessage -> Html + -> AuthMessage -> Text renderAuthMessage _ _ = defaultMessage -type Texts = [Text] - mkYesodSub "Auth" [ ClassP ''YesodAuth [VarT $ mkName "master"] ] @@ -114,7 +112,6 @@ setCreds doRedirects creds = do y <- getYesod maid <- getAuthId creds l <- languages - let mr = renderMessage Auth y l case maid of Nothing -> if doRedirects @@ -131,14 +128,14 @@ setCreds doRedirects creds = do |] sendResponse rh Just ar -> do - setMessage $ mr Msg.InvalidLogin + setMessageI Msg.InvalidLogin redirect RedirectTemporary ar else return () Just aid -> do setSession credsKey $ toSinglePiece aid if doRedirects then do - setMessage $ mr Msg.NowLoggedIn + setMessageI Msg.NowLoggedIn redirectUltDest RedirectTemporary $ loginDest y else return () @@ -229,6 +226,5 @@ redirectLogin = do Just z -> redirect RedirectTemporary z Nothing -> permissionDenied "Please configure authRoute" -instance YesodAuth m => YesodMessage Auth m where - type Message Auth m = AuthMessage - renderMessage = const renderAuthMessage +instance YesodAuth m => RenderMessage m AuthMessage where + renderMessage = renderAuthMessage diff --git a/Yesod/Auth/Email.hs b/Yesod/Auth/Email.hs index 8c76173d..645201cc 100644 --- a/Yesod/Auth/Email.hs +++ b/Yesod/Auth/Email.hs @@ -81,7 +81,6 @@ authEmail = AuthPlugin "email" dispatch $ \tm -> do y <- lift getYesod l <- lift languages - let mr = renderMessage (getAuth 'x') y l #if GHC7 [whamlet| #else @@ -90,16 +89,16 @@ authEmail =
- -
#{mr Msg.Email} + _{Msg.Email}
#{mr Msg.Password} + _{Msg.Password}
- + I don't have an account |] where @@ -117,9 +116,8 @@ authEmail = getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml getRegisterR = do toMaster <- getRouteToMaster - mr <- getMessageRender defaultLayout $ do - setTitle $ mr Msg.RegisterLong + setTitleI Msg.RegisterLong addWidget #if GHC7 [whamlet| @@ -153,9 +151,8 @@ postRegisterR = do tm <- getRouteToMaster let verUrl = render $ tm $ verify (toSinglePiece lid) verKey sendVerifyEmail email verKey verUrl - mr <- getMessageRender defaultLayout $ do - setTitle $ mr Msg.ConfirmationEmailSentTitle + setTitleI Msg.ConfirmationEmailSentTitle addWidget #if GHC7 [whamlet| @@ -178,13 +175,11 @@ getVerifyR lid key = do Just _uid -> do setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid? toMaster <- getRouteToMaster - mr <- getMessageRender - setMessage $ mr Msg.AddressVerified + setMessageI Msg.AddressVerified redirect RedirectTemporary $ toMaster setpassR _ -> return () - mr <- getMessageRender defaultLayout $ do - setTitle $ mr Msg.InvalidKey + setTitleI Msg.InvalidKey addWidget #if GHC7 [whamlet| @@ -215,8 +210,7 @@ postLoginR = do Just _aid -> setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid? Nothing -> do - mr <- getMessageRender - setMessage $ mr Msg.InvalidEmailPass + setMessageI Msg.InvalidEmailPass toMaster <- getRouteToMaster redirect RedirectTemporary $ toMaster LoginR @@ -224,14 +218,13 @@ getPasswordR :: YesodAuthEmail master => GHandler Auth master RepHtml getPasswordR = do toMaster <- getRouteToMaster maid <- maybeAuthId - mr <- getMessageRender case maid of Just _ -> return () Nothing -> do - setMessage $ mr Msg.BadSetPass + setMessageI Msg.BadSetPass redirect RedirectTemporary $ toMaster loginR defaultLayout $ do - setTitle $ mr Msg.SetPassTitle + setTitleI Msg.SetPassTitle addWidget #if GHC7 [whamlet| @@ -262,20 +255,17 @@ postPasswordR = do toMaster <- getRouteToMaster y <- getYesod when (new /= confirm) $ do - mr <- getMessageRender - setMessage $ mr Msg.PassMismatch + setMessageI Msg.PassMismatch redirect RedirectTemporary $ toMaster setpassR maid <- maybeAuthId aid <- case maid of Nothing -> do - mr <- getMessageRender - setMessage $ mr Msg.BadSetPass + setMessageI Msg.BadSetPass redirect RedirectTemporary $ toMaster loginR Just aid -> return aid salted <- liftIO $ saltPass new setPassword aid salted - mr <- getMessageRender - setMessage $ mr Msg.PassUpdated + setMessageI Msg.PassUpdated redirect RedirectTemporary $ loginDest y saltLength :: Int diff --git a/Yesod/Auth/Facebook.hs b/Yesod/Auth/Facebook.hs index b3c84a95..29531057 100644 --- a/Yesod/Auth/Facebook.hs +++ b/Yesod/Auth/Facebook.hs @@ -15,8 +15,6 @@ import Data.Maybe (fromMaybe) import Yesod.Form import Yesod.Handler import Yesod.Widget -import Yesod.Request (languages) -import Text.Hamlet (hamlet) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Data.Text (Text) @@ -58,17 +56,13 @@ authFacebook cid secret perms = render <- lift getUrlRender let fb = Facebook.Facebook cid secret $ render $ tm url let furl = Facebook.getForwardUrl fb $ perms - y <- lift getYesod - l <- lift languages - let mr = renderMessage (getAuth 'x') y l - addHtml #if GHC7 - [hamlet| + [whamlet| #else - [$hamlet| + [$whamlet| #endif

- #{mr Msg.Facebook} + _{Msg.Facebook} |] parseCreds :: Text -> Value -> Data.Aeson.Types.Parser (Creds m) diff --git a/Yesod/Auth/Message.hs b/Yesod/Auth/Message.hs index f2d22c2e..88e301b2 100644 --- a/Yesod/Auth/Message.hs +++ b/Yesod/Auth/Message.hs @@ -34,7 +34,7 @@ data AuthMessage = | InvalidLogin | NowLoggedIn -defaultMessage :: AuthMessage -> Html +defaultMessage :: AuthMessage -> Text defaultMessage NoOpenID = "No OpenID identifier found" defaultMessage LoginOpenID = "Login via OpenID" defaultMessage Email = "Email" @@ -45,7 +45,7 @@ defaultMessage EnterEmail = "Enter your e-mail address below, and a confirmation defaultMessage ConfirmationEmailSentTitle = "Confirmation e-mail sent" defaultMessage (ConfirmationEmailSent email) = "A confirmation e-mail has been sent to " `mappend` - toHtml email `mappend` + email `mappend` "." defaultMessage AddressVerified = "Address verified, please set a new password" defaultMessage InvalidKeyTitle = "Invalid verification key" diff --git a/Yesod/Auth/OpenId.hs b/Yesod/Auth/OpenId.hs index 68255862..861e04ce 100644 --- a/Yesod/Auth/OpenId.hs +++ b/Yesod/Auth/OpenId.hs @@ -43,17 +43,15 @@ authOpenId = padding-left: 18px; |] l <- lift languages - let mr = renderMessage (getAuth 'x') y l - addHamlet #if GHC7 - [hamlet| + [whamlet| #else - [$hamlet| + [$whamlet| #endif -