Allow Yesod.Auth.Email handlers to be overriden.

The main purpose is to allow more customization of the Yesod.Auth.Email
handlers by not only changing the CSS but also the DOM.
This commit is contained in:
Felipe Lessa 2014-02-25 19:28:09 -03:00
parent 9e6db27be2
commit 6f7e8c8e04

View File

@ -2,6 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Rank2Types #-}
module Yesod.Auth.Email
( -- * Plugin
authEmail
@ -24,6 +25,10 @@ module Yesod.Auth.Email
-- * Misc
, loginLinkKey
, setLoginLinkKey
-- * Default handlers
, defaultRegisterHandler
, defaultForgotPasswordHandler
, defaultSetPasswordHandler
) where
import Network.Mail.Mime (randomString)
@ -180,6 +185,43 @@ class (YesodAuth site, PathPiece (AuthEmailId site)) => YesodAuthEmail site wher
normalizeEmailAddress :: site -> Text -> Text
normalizeEmailAddress _ = TS.toLower
-- | Handler called to render the registration page. The
-- default works fine, but you may want to override it in
-- order to have a different DOM.
--
-- Default: 'defaultRegisterHandler'.
--
-- Since: 1.2.6.
registerHandler :: AuthHandler site Html
registerHandler = defaultRegisterHandler
-- | Handler called to render the \"forgot password\" page.
-- The default works fine, but you may want to override it in
-- order to have a different DOM.
--
-- Default: 'defaultForgotPasswordHandler'.
--
-- Since: 1.2.6.
forgotPasswordHandler :: AuthHandler site Html
forgotPasswordHandler = defaultForgotPasswordHandler
-- | Handler called to render the \"set password\" page. The
-- default works fine, but you may want to override it in
-- order to have a different DOM.
--
-- Default: 'defaultSetPasswordHandler'.
--
-- Since: 1.2.6.
setPasswordHandler ::
Bool
-- ^ Whether the old password is needed. If @True@, a
-- field for the old password should be presented.
-- Otherwise, just two fields for the new password are
-- needed.
-> AuthHandler site Html
setPasswordHandler = defaultSetPasswordHandler
authEmail :: YesodAuthEmail m => AuthPlugin m
authEmail =
AuthPlugin "email" dispatch $ \tm ->
@ -215,7 +257,13 @@ $newline never
dispatch _ _ = notFound
getRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
getRegisterR = do
getRegisterR = registerHandler
-- | Default implementation of 'registerHandler'.
--
-- Since: 1.2.6
defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html
defaultRegisterHandler = do
email <- newIdent
tp <- getRouteToParent
lift $ authLayout $ do
@ -269,7 +317,13 @@ postRegisterR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Htm
postRegisterR = registerHelper False registerR
getForgotPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
getForgotPasswordR = do
getForgotPasswordR = forgotPasswordHandler
-- | Default implementation of 'forgotPasswordHandler'.
--
-- Since: 1.2.6
defaultForgotPasswordHandler :: YesodAuthEmail master => AuthHandler master Html
defaultForgotPasswordHandler = do
tp <- getRouteToParent
email <- newIdent
lift $ authLayout $ do
@ -347,14 +401,21 @@ postLoginR = do
getPasswordR :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
getPasswordR = do
maid <- lift maybeAuthId
pass0 <- newIdent
pass1 <- newIdent
pass2 <- newIdent
case maid of
Just _ -> return ()
Nothing -> loginErrorMessageI LoginR Msg.BadSetPass
tp <- getRouteToParent
needOld <- maybe (return True) (lift . needOldPassword) maid
setPasswordHandler needOld
-- | Default implementation of 'setPasswordHandler'.
--
-- Since: 1.2.6
defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> AuthHandler master Html
defaultSetPasswordHandler needOld = do
tp <- getRouteToParent
pass0 <- newIdent
pass1 <- newIdent
pass2 <- newIdent
lift $ authLayout $ do
setTitleI Msg.SetPassTitle
[whamlet|