diff --git a/Yesod/Auth.hs b/Yesod/Auth.hs index 4d4a966e..a0fca3cc 100644 --- a/Yesod/Auth.hs +++ b/Yesod/Auth.hs @@ -36,8 +36,8 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) -import Data.Monoid (mconcat) import Web.Routes.Quasi (toSinglePiece, fromSinglePiece) +import Yesod.Auth.Message (AuthMessage, defaultMessage) data Auth = Auth @@ -82,53 +82,10 @@ class (Yesod m, SinglePiece (AuthId m)) => YesodAuth m where tm <- lift getRouteToMaster mapM_ (flip apLogin tm) authPlugins - ----- Message strings. In theory in the future make this localizable - ----- See gist: https://gist.github.com/778712 - messageNoOpenID :: m -> Html - messageNoOpenID _ = "No OpenID identifier found" - messageLoginOpenID :: m -> Html - messageLoginOpenID _ = "Login via OpenID" - - messageEmail :: m -> Html - messageEmail _ = "Email" - messagePassword :: m -> Html - messagePassword _ = "Password" - messageRegister :: m -> Html - messageRegister _ = "Register" - messageRegisterLong :: m -> Html - messageRegisterLong _ = "Register a new account" - messageEnterEmail :: m -> Html - messageEnterEmail _ = "Enter your e-mail address below, and a confirmation e-mail will be sent to you." - messageConfirmationEmailSentTitle :: m -> Html - messageConfirmationEmailSentTitle _ = "Confirmation e-mail sent" - messageConfirmationEmailSent :: m -> Text -> Html - messageConfirmationEmailSent _ email = toHtml $ mconcat - ["A confirmation e-mail has been sent to ", email, "."] - messageAddressVerified :: m -> Html - messageAddressVerified _ = "Address verified, please set a new password" - messageInvalidKeyTitle :: m -> Html - messageInvalidKeyTitle _ = "Invalid verification key" - messageInvalidKey :: m -> Html - messageInvalidKey _ = "I'm sorry, but that was an invalid verification key." - messageInvalidEmailPass :: m -> Html - messageInvalidEmailPass _ = "Invalid email/password combination" - messageBadSetPass :: m -> Html - messageBadSetPass _ = "You must be logged in to set a password" - messageSetPassTitle :: m -> Html - messageSetPassTitle _ = "Set password" - messageSetPass :: m -> Html - messageSetPass _ = "Set a new password" - messageNewPass :: m -> Html - messageNewPass _ = "New password" - messageConfirmPass :: m -> Html - messageConfirmPass _ = "Confirm" - messagePassMismatch :: m -> Html - messagePassMismatch _ = "Passwords did not match, please try again" - messagePassUpdated :: m -> Html - messagePassUpdated _ = "Password updated" - - messageFacebook :: m -> Html - messageFacebook _ = "Login with Facebook" + renderAuthMessage :: m + -> [Text] -- ^ languages + -> AuthMessage -> Html + renderAuthMessage _ _ = defaultMessage type Texts = [Text] @@ -268,3 +225,7 @@ redirectLogin = do case authRoute y of 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 diff --git a/Yesod/Auth/Email.hs b/Yesod/Auth/Email.hs index 4708e72c..8ca0a996 100644 --- a/Yesod/Auth/Email.hs +++ b/Yesod/Auth/Email.hs @@ -30,10 +30,10 @@ import Yesod.Handler import Yesod.Content import Yesod.Widget import Yesod.Core -import Text.Hamlet (hamlet) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Web.Routes.Quasi (toSinglePiece, fromSinglePiece) +import qualified Yesod.Auth.Message as Msg loginR, registerR, setpassR :: AuthRoute loginR = PluginR "email" ["login"] @@ -80,24 +80,26 @@ authEmail :: YesodAuthEmail m => AuthPlugin m authEmail = AuthPlugin "email" dispatch $ \tm -> do y <- lift getYesod + l <- lift languages + let mr = renderMessage (getAuth 'x') y l #if GHC7 - [hamlet| + [whamlet| #else - [$hamlet| + [$whamlet| #endif
- -
#{messageEmail y} + #{mr Msg.Email}
#{messagePassword y} + #{mr Msg.Password}
- + I don't have an account |] where @@ -114,21 +116,21 @@ authEmail = getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml getRegisterR = do - y <- getYesod toMaster <- getRouteToMaster + mr <- getMessageRender defaultLayout $ do - setTitle $ messageRegisterLong y - addHamlet + setTitle $ mr Msg.RegisterLong + addWidget #if GHC7 - [hamlet| + [whamlet| #else - [$hamlet| + [$whamlet| #endif -

#{messageEnterEmail y} +

_{Msg.EnterEmail} -

#{messageConfirmationEmailSent y email} +

_{Msg.ConfirmationEmailSent email} |] getVerifyR :: YesodAuthEmail m @@ -167,7 +170,6 @@ getVerifyR :: YesodAuthEmail m getVerifyR lid key = do realKey <- getVerifyKey lid memail <- getEmail lid - y <- getYesod case (realKey == Just key, memail) of (True, Just email) -> do muid <- verifyAccount lid @@ -176,18 +178,20 @@ getVerifyR lid key = do Just _uid -> do setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid? toMaster <- getRouteToMaster - setMessage $ messageAddressVerified y + mr <- getMessageRender + setMessage $ mr Msg.AddressVerified redirect RedirectTemporary $ toMaster setpassR _ -> return () + mr <- getMessageRender defaultLayout $ do - setTitle $ messageInvalidKey y - addHtml + setTitle $ mr Msg.InvalidKey + addWidget #if GHC7 - [hamlet| + [whamlet| #else - [$hamlet| + [$whamlet| #endif -

#{messageInvalidKey y} +

_{Msg.InvalidKey} |] postLoginR :: YesodAuthEmail master => GHandler Auth master () @@ -212,7 +216,8 @@ postLoginR = do setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid? Nothing -> do y <- getYesod - setMessage $ messageInvalidEmailPass y + mr <- getMessageRender + setMessage $ mr Msg.InvalidEmailPass toMaster <- getRouteToMaster redirect RedirectTemporary $ toMaster LoginR @@ -220,34 +225,34 @@ getPasswordR :: YesodAuthEmail master => GHandler Auth master RepHtml getPasswordR = do toMaster <- getRouteToMaster maid <- maybeAuthId - y <- getYesod + mr <- getMessageRender case maid of Just _ -> return () Nothing -> do - setMessage $ messageBadSetPass y + setMessage $ mr Msg.BadSetPass redirect RedirectTemporary $ toMaster loginR defaultLayout $ do - setTitle $ messageSetPassTitle y - addHamlet + setTitle $ mr Msg.SetPassTitle + addWidget #if GHC7 - [hamlet| + [whamlet| #else - [$hamlet| + [$whamlet| #endif -

#{messageSetPass y} +

_{Msg.SetPass} - -
#{messageNewPass y} + _{Msg.NewPass}
#{messageConfirmPass y} + _{Msg.ConfirmPass}
- + |] postPasswordR :: YesodAuthEmail master => GHandler Auth master () @@ -258,17 +263,20 @@ postPasswordR = do toMaster <- getRouteToMaster y <- getYesod when (new /= confirm) $ do - setMessage $ messagePassMismatch y + mr <- getMessageRender + setMessage $ mr Msg.PassMismatch redirect RedirectTemporary $ toMaster setpassR maid <- maybeAuthId aid <- case maid of Nothing -> do - setMessage $ messageBadSetPass y + mr <- getMessageRender + setMessage $ mr Msg.BadSetPass redirect RedirectTemporary $ toMaster loginR Just aid -> return aid salted <- liftIO $ saltPass new setPassword aid salted - setMessage $ messagePassUpdated y + mr <- getMessageRender + setMessage $ mr Msg.PassUpdated redirect RedirectTemporary $ loginDest y saltLength :: Int diff --git a/Yesod/Auth/Facebook.hs b/Yesod/Auth/Facebook.hs index 6d57aa92..b10713a1 100644 --- a/Yesod/Auth/Facebook.hs +++ b/Yesod/Auth/Facebook.hs @@ -15,6 +15,7 @@ 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) @@ -22,6 +23,7 @@ import Data.Text (Text) import Control.Monad (mzero) import Data.Monoid (mappend) import qualified Data.Aeson.Types +import qualified Yesod.Auth.Message as Msg facebookUrl :: AuthRoute facebookUrl = PluginR "facebook" ["forward"] @@ -57,6 +59,8 @@ authFacebook cid secret perms = 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| @@ -64,7 +68,7 @@ authFacebook cid secret perms = [$hamlet| #endif

- #{messageFacebook y} + #{mr Msg.Facebook} |] parseCreds :: Text -> Value -> Data.Aeson.Types.Parser (Creds m) diff --git a/Yesod/Auth/Message.hs b/Yesod/Auth/Message.hs new file mode 100644 index 00000000..8302a84c --- /dev/null +++ b/Yesod/Auth/Message.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings #-} +module Yesod.Auth.Message + ( AuthMessage (..) + , defaultMessage + ) where + +import Text.Blaze (Html, toHtml) +import Data.Monoid (mappend) +import Data.Text (Text) + +data AuthMessage = + NoOpenID + | LoginOpenID + | Email + | Password + | Register + | RegisterLong + | EnterEmail + | ConfirmationEmailSentTitle + | ConfirmationEmailSent Text + | AddressVerified + | InvalidKeyTitle + | InvalidKey + | InvalidEmailPass + | BadSetPass + | SetPassTitle + | SetPass + | NewPass + | ConfirmPass + | PassMismatch + | PassUpdated + | Facebook + | LoginViaEmail + +defaultMessage :: AuthMessage -> Html +defaultMessage NoOpenID = "No OpenID identifier found" +defaultMessage LoginOpenID = "Login via OpenID" +defaultMessage Email = "Email" +defaultMessage Password = "Password" +defaultMessage Register = "Register" +defaultMessage RegisterLong = "Register a new account" +defaultMessage EnterEmail = "Enter your e-mail address below, and a confirmation e-mail will be sent to you." +defaultMessage ConfirmationEmailSentTitle = "Confirmation e-mail sent" +defaultMessage (ConfirmationEmailSent email) = + "A confirmation e-mail has been sent to " `mappend` + toHtml email `mappend` + "." +defaultMessage AddressVerified = "Address verified, please set a new password" +defaultMessage InvalidKeyTitle = "Invalid verification key" +defaultMessage InvalidKey = "I'm sorry, but that was an invalid verification key." +defaultMessage InvalidEmailPass = "Invalid email/password combination" +defaultMessage BadSetPass = "You must be logged in to set a password" +defaultMessage SetPassTitle = "Set password" +defaultMessage SetPass = "Set a new password" +defaultMessage NewPass = "New password" +defaultMessage ConfirmPass = "Confirm" +defaultMessage PassMismatch = "Passwords did not match, please try again" +defaultMessage PassUpdated = "Password updated" +defaultMessage Facebook = "Login with Facebook" +defaultMessage LoginViaEmail = "Login via email" diff --git a/Yesod/Auth/OpenId.hs b/Yesod/Auth/OpenId.hs index 9828b352..8df638c6 100644 --- a/Yesod/Auth/OpenId.hs +++ b/Yesod/Auth/OpenId.hs @@ -19,6 +19,7 @@ import Text.Cassius (cassius) import Text.Blaze (toHtml) import Control.Monad.Trans.Class (lift) import Data.Text (Text) +import qualified Yesod.Auth.Message as Msg forwardUrl :: AuthRoute forwardUrl = PluginR "openid" ["forward"] @@ -41,6 +42,8 @@ authOpenId = background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%; padding-left: 18px; |] + l <- lift languages + let mr = renderMessage (getAuth 'x') y l addHamlet #if GHC7 [hamlet| @@ -50,7 +53,7 @@ authOpenId =