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:
parent
9e6db27be2
commit
6f7e8c8e04
@ -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|
|
||||
|
||||
Loading…
Reference in New Issue
Block a user