Unverified login and dedicated route for verification email resend form
This commit is contained in:
parent
f196bf38d6
commit
baeef7873e
3 changed files with 18 additions and 8 deletions
|
@ -30,6 +30,9 @@ import Yesod.Core.Types (Logger)
|
||||||
import Yesod.Default.Util (addStaticContentExternal)
|
import Yesod.Default.Util (addStaticContentExternal)
|
||||||
|
|
||||||
import Text.Email.Local
|
import Text.Email.Local
|
||||||
|
|
||||||
|
import Yesod.Auth.Unverified
|
||||||
|
import Yesod.Auth.Unverified.Creds
|
||||||
import Yesod.Mail.Send
|
import Yesod.Mail.Send
|
||||||
|
|
||||||
import qualified Yesod.Core.Unsafe as Unsafe
|
import qualified Yesod.Core.Unsafe as Unsafe
|
||||||
|
@ -379,6 +382,8 @@ instance YesodAuth App where
|
||||||
|
|
||||||
authHttpManager = getHttpManager
|
authHttpManager = getHttpManager
|
||||||
|
|
||||||
|
onLogout = clearUnverifiedCreds False
|
||||||
|
|
||||||
instance YesodAuthPersist App
|
instance YesodAuthPersist App
|
||||||
|
|
||||||
newtype AccountPersistDB' a = AccountPersistDB'
|
newtype AccountPersistDB' a = AccountPersistDB'
|
||||||
|
@ -436,13 +441,14 @@ instance AccountSendEmail App where
|
||||||
, url
|
, url
|
||||||
]
|
]
|
||||||
|
|
||||||
|
instance YesodAuthVerify App where
|
||||||
|
verificationRoute _ = ResendVerifyEmailR
|
||||||
|
|
||||||
instance YesodAuthAccount AccountPersistDB' App where
|
instance YesodAuthAccount AccountPersistDB' App where
|
||||||
runAccountDB = unAccountPersistDB'
|
runAccountDB = unAccountPersistDB'
|
||||||
--unregisteredLogin u = do
|
unregisteredLogin u = do
|
||||||
-- set creds unverified
|
lift $ setUnverifiedCreds True $ Creds "account" (username u) []
|
||||||
--setUnverifiedCreds True $ Creds "account" (username u) []
|
return mempty
|
||||||
-- redirect to resend form
|
|
||||||
-- ?
|
|
||||||
|
|
||||||
-- This instance is required to use forms. You can modify renderMessage to
|
-- This instance is required to use forms. You can modify renderMessage to
|
||||||
-- achieve customized and internationalized form validation messages.
|
-- achieve customized and internationalized form validation messages.
|
||||||
|
|
|
@ -61,6 +61,10 @@
|
||||||
-- changes from yesod-auth 1.4.13.2, which is in LTS 6.5, to 1.6.2, which is
|
-- changes from yesod-auth 1.4.13.2, which is in LTS 6.5, to 1.6.2, which is
|
||||||
-- the latest release and where I copied from
|
-- the latest release and where I copied from
|
||||||
-- * Instead of loginDest and onLogin, use my custom unverified counterparts
|
-- * Instead of loginDest and onLogin, use my custom unverified counterparts
|
||||||
|
-- * Not call onLogout in clearUnverifiedCreds, because I use onLogout to clear
|
||||||
|
-- these creds, so it would either cause an infinite loop (if not
|
||||||
|
-- redirecting), or, if redirecting, the regular yesod-auth login session key
|
||||||
|
-- wouldn't get to be cleared
|
||||||
module Yesod.Auth.Unverified.Creds
|
module Yesod.Auth.Unverified.Creds
|
||||||
( setUnverifiedCreds
|
( setUnverifiedCreds
|
||||||
, setUnverifiedCredsRedirect
|
, setUnverifiedCredsRedirect
|
||||||
|
@ -275,7 +279,7 @@ clearUnverifiedCreds :: YesodAuth master
|
||||||
-> HandlerT master IO ()
|
-> HandlerT master IO ()
|
||||||
clearUnverifiedCreds doRedirects = do
|
clearUnverifiedCreds doRedirects = do
|
||||||
y <- getYesod
|
y <- getYesod
|
||||||
onLogout
|
-- onLogout
|
||||||
deleteSession credsKey
|
deleteSession credsKey
|
||||||
when doRedirects $ do
|
when doRedirects $ do
|
||||||
redirectUltDest $ logoutDest y
|
redirectUltDest $ logoutDest y
|
||||||
|
|
|
@ -38,9 +38,9 @@ class YesodAuth site => YesodAuthVerify site where
|
||||||
verificationRoute :: site -> Route site
|
verificationRoute :: site -> Route site
|
||||||
|
|
||||||
-- | Default destination on successful unverified login, if no other
|
-- | Default destination on successful unverified login, if no other
|
||||||
-- destination exists. Default: 'loginDest'
|
-- destination exists. Default: 'verificationRoute'
|
||||||
unverifiedLoginDest :: site -> Route site
|
unverifiedLoginDest :: site -> Route site
|
||||||
unverifiedLoginDest = loginDest
|
unverifiedLoginDest = verificationRoute
|
||||||
|
|
||||||
-- | Called on a successful unverified login. Default: 'onLogin'
|
-- | Called on a successful unverified login. Default: 'onLogin'
|
||||||
--onUnverifiedLogin :: (MonadHandler m, site ~ HandlerSite m) => m ()
|
--onUnverifiedLogin :: (MonadHandler m, site ~ HandlerSite m) => m ()
|
||||||
|
|
Loading…
Reference in a new issue