Customized messages

Yesod/Helpers/Auth.hs

@@ -84,6 +84,53 @@ class Yesod m => YesodAuth m where
         tm <- liftHandler 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 _ = string "No OpenID identifier found"
+    messageLoginOpenID :: m -> Html
+    messageLoginOpenID _ = string "Login via OpenID"
+
+    messageEmail :: m -> Html
+    messageEmail _ = string "Email"
+    messagePassword :: m -> Html
+    messagePassword _ = string "Password"
+    messageRegister :: m -> Html
+    messageRegister _ = string "Register"
+    messageRegisterLong :: m -> Html
+    messageRegisterLong _ = string "Register a new account"
+    messageEnterEmail :: m -> Html
+    messageEnterEmail _ = string "Enter your e-mail address below, and a confirmation e-mail will be sent to you."
+    messageConfirmationEmailSentTitle :: m -> Html
+    messageConfirmationEmailSentTitle _ = string "Confirmation e-mail sent"
+    messageConfirmationEmailSent :: m -> String -> Html
+    messageConfirmationEmailSent _ email = string $ "A confirmation e-mail has been sent to " ++ email ++ "."
+    messageAddressVerified :: m -> Html
+    messageAddressVerified _ = string "Address verified, please set a new password"
+    messageInvalidKeyTitle :: m -> Html
+    messageInvalidKeyTitle _ = string "Invalid verification key"
+    messageInvalidKey :: m -> Html
+    messageInvalidKey _ = string "I'm sorry, but that was an invalid verification key."
+    messageInvalidEmailPass :: m -> Html
+    messageInvalidEmailPass _ = string "Invalid email/password combination"
+    messageBadSetPass :: m -> Html
+    messageBadSetPass _ = string "You must be logged in to set a password"
+    messageSetPassTitle :: m -> Html
+    messageSetPassTitle _ = string "Set password"
+    messageSetPass :: m -> Html
+    messageSetPass _ = string "Set a new password"
+    messageNewPass :: m -> Html
+    messageNewPass _ = string "New password"
+    messageConfirmPass :: m -> Html
+    messageConfirmPass _ = string "Confirm"
+    messagePassMismatch :: m -> Html
+    messagePassMismatch _ = string "Passwords did not match, please try again"
+    messagePassUpdated :: m -> Html
+    messagePassUpdated _ = string "Password updated"
+
+    messageFacebook :: m -> Html
+    messageFacebook _ = string "Login with Facebook"
+
 mkYesodSub "Auth"
     [ ClassP ''YesodAuth [VarT $ mkName "master"]
     ]

Yesod/Helpers/Auth/Email.hs

@@ -22,7 +22,6 @@ import Yesod.Content
 import Yesod.Widget
 import Yesod.Core
 import Text.Hamlet (hamlet)
-import Text.Blaze (string)
 import Control.Monad.IO.Class (liftIO)
 
 login, register, setpass :: AuthRoute
@@ -71,7 +70,8 @@ class YesodAuth m => YesodAuthEmail m where
 
 authEmail :: YesodAuthEmail m => AuthPlugin m
 authEmail =
-    AuthPlugin "email" dispatch $ \tm ->
+    AuthPlugin "email" dispatch $ \tm -> do
+        y <- liftHandler getYesod
 #if GHC7
         [hamlet|
 #else
@@ -80,11 +80,11 @@ authEmail =
 %form!method=post!action=@tm.login@
     %table
         %tr
-            %th E-mail
+            %th $messageEmail.y$
             %td
                 %input!type=email!name=email
         %tr
-            %th Password
+            %th $messagePassword.y$
             %td
                 %input!type=password!name=password
         %tr
@@ -107,20 +107,21 @@ authEmail =
 
 getRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml
 getRegisterR = do
+    y <- getYesod
     toMaster <- getRouteToMaster
     defaultLayout $ do
-        setTitle $ string "Register a new account"
+        setTitle $ messageRegisterLong y
         addHamlet
 #if GHC7
             [hamlet|
 #else
             [$hamlet|
 #endif
-%p Enter your e-mail address below, and a confirmation e-mail will be sent to you.
+%p $messageEnterEmail.y$
 %form!method=post!action=@toMaster.register@
-    %label!for=email E-mail
+    %label!for=email $messageEmail y$
     %input!type=email!name=email!width=150
-    %input!type=submit!value=Register
+    %input!type=submit!value=$messageRegister y$
 |]
 
 postRegisterR :: YesodAuthEmail master => GHandler Auth master RepHtml
@@ -144,14 +145,14 @@ postRegisterR = do
     let verUrl = render $ tm $ verify (showAuthEmailId y lid) verKey
     sendVerifyEmail email verKey verUrl
     defaultLayout $ do
-        setTitle $ string "Confirmation e-mail sent"
+        setTitle $ messageConfirmationEmailSentTitle y
         addWidget
 #if GHC7
             [hamlet|
 #else
             [$hamlet|
 #endif
-%p A confirmation e-mail has been sent to $email$.
+%p $(messageConfirmationEmailSent y) email$
 |]
 
 getVerifyR :: YesodAuthEmail m
@@ -159,6 +160,7 @@ 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
@@ -167,18 +169,18 @@ getVerifyR lid key = do
                 Just _uid -> do
                     setCreds False $ Creds "email" email [("verifiedEmail", email)] -- FIXME uid?
                     toMaster <- getRouteToMaster
-                    setMessage $ string "Address verified, please set a new password"
+                    setMessage $ messageAddressVerified y
                     redirect RedirectTemporary $ toMaster setpass
         _ -> return ()
     defaultLayout $ do
-        setTitle $ string "Invalid verification key"
+        setTitle $ messageInvalidKey y
         addHtml
 #if GHC7
             [hamlet|
 #else
             [$hamlet|
 #endif
-%p I'm sorry, but that was an invalid verification key.
+%p $messageInvalidKey y$
 |]
 
 postLoginR :: YesodAuthEmail master => GHandler Auth master ()
@@ -202,7 +204,8 @@ postLoginR = do
         Just _aid ->
             setCreds True $ Creds "email" email [("verifiedEmail", email)] -- FIXME aid?
         Nothing -> do
-            setMessage $ string "Invalid email/password combination"
+            y <- getYesod
+            setMessage $ messageInvalidEmailPass y
             toMaster <- getRouteToMaster
             redirect RedirectTemporary $ toMaster LoginR
 
@@ -210,33 +213,34 @@ getPasswordR :: YesodAuthEmail master => GHandler Auth master RepHtml
 getPasswordR = do
     toMaster <- getRouteToMaster
     maid <- maybeAuthId
+    y <- getYesod
     case maid of
         Just _ -> return ()
         Nothing -> do
-            setMessage $ string "You must be logged in to set a password"
+            setMessage $ messageBadSetPass y
             redirect RedirectTemporary $ toMaster login
     defaultLayout $ do
-        setTitle $ string "Set password"
+        setTitle $ messageSetPassTitle y
         addHamlet
 #if GHC7
             [hamlet|
 #else
             [$hamlet|
 #endif
-%h3 Set a new password
+%h3 $messageSetPass y$
 %form!method=post!action=@toMaster.setpass@
     %table
         %tr
-            %th New password
+            %th $messageNewPass y$
             %td
                 %input!type=password!name=new
         %tr
-            %th Confirm
+            %th $messageConfirmPass y$
             %td
                 %input!type=password!name=confirm
         %tr
             %td!colspan=2
-                %input!type=submit!value=Submit
+                %input!type=submit!value=$messageSetPassTitle y$
 |]
 
 postPasswordR :: YesodAuthEmail master => GHandler Auth master ()
@@ -245,19 +249,19 @@ postPasswordR = do
         <$> stringInput "new"
         <*> stringInput "confirm"
     toMaster <- getRouteToMaster
+    y <- getYesod
     when (new /= confirm) $ do
-        setMessage $ string "Passwords did not match, please try again"
+        setMessage $ messagePassMismatch y
         redirect RedirectTemporary $ toMaster setpass
     maid <- maybeAuthId
     aid <- case maid of
             Nothing -> do
-                setMessage $ string "You must be logged in to set a password"
+                setMessage $ messageBadSetPass y
                 redirect RedirectTemporary $ toMaster login
             Just aid -> return aid
     salted <- liftIO $ saltPass new
     setPassword aid salted
-    setMessage $ string "Password updated"
+    setMessage $ messagePassUpdated y
-    y <- getYesod
     redirect RedirectTemporary $ loginDest y
 
 saltLength :: Int

Yesod/Helpers/Auth/Facebook.hs

@@ -59,6 +59,7 @@ authFacebook cid secret perms =
         render <- liftHandler getUrlRender
         let fb = Facebook.Facebook cid secret $ render $ tm url
         let furl = Facebook.getForwardUrl fb $ perms
+        y <- liftHandler getYesod
         addHtml
 #if GHC7
             [hamlet|
@@ -66,5 +67,5 @@ authFacebook cid secret perms =
             [$hamlet|
 #endif
 %p
-    %a!href=$furl$ Login with Facebook
+    %a!href=$furl$ $messageFacebook y$
 |]

Yesod/Helpers/Auth/OpenId.hs

@@ -29,6 +29,7 @@ authOpenId =
     name = "openid_identifier"
     login tm = do
         ident <- newIdent
+        y <- liftHandler getYesod
         addCassius
 #if GHC7
             [cassius|
@@ -48,10 +49,11 @@ authOpenId =
 %form!method=get!action=@tm.forwardUrl@
     %label!for=$ident$ OpenID: $
     %input#$ident$!type=text!name=$name$!value="http://"
-    %input!type=submit!value="Login via OpenID"
+    %input!type=submit!value=$messageLoginOpenID.y$
 |]
     dispatch "GET" ["forward"] = do
         (roid, _, _) <- runFormGet $ stringInput name
+        y <- getYesod
         case roid of
             FormSuccess oid -> do
                 render <- getUrlRender
@@ -67,7 +69,7 @@ authOpenId =
                   res
             _ -> do
                 toMaster <- getRouteToMaster
-                setMessage $ string "No OpenID identifier found"
+                setMessage $ messageNoOpenID y
                 redirect RedirectTemporary $ toMaster LoginR
     dispatch "GET" ["complete"] = do
         rr <- getRequest