diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index 480ee16b..e7939043 100644 --- a/Yesod/Helpers/Auth.hs +++ b/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"] ] diff --git a/Yesod/Helpers/Auth/Email.hs b/Yesod/Helpers/Auth/Email.hs index 9cbd8b97..7bb31ab8 100644 --- a/Yesod/Helpers/Auth/Email.hs +++ b/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" - y <- getYesod + setMessage $ messagePassUpdated y redirect RedirectTemporary $ loginDest y saltLength :: Int diff --git a/Yesod/Helpers/Auth/Facebook.hs b/Yesod/Helpers/Auth/Facebook.hs index 07ebfd9d..4cfe7869 100644 --- a/Yesod/Helpers/Auth/Facebook.hs +++ b/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$ |] diff --git a/Yesod/Helpers/Auth/OpenId.hs b/Yesod/Helpers/Auth/OpenId.hs index 8dc28914..5560601a 100644 --- a/Yesod/Helpers/Auth/OpenId.hs +++ b/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