diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs index 8ce5e9c7..6acf45ee 100644 --- a/yesod-auth/Yesod/Auth/Email.hs +++ b/yesod-auth/Yesod/Auth/Email.hs @@ -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|