haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adds export of verify route

Browse Source 
This allows users of the library to easily render VerUrl to use in
verification emails to new users, if the user was created outside
of the regular register functionality.
This commit is contained in:
Richard Zetterberg 2015-04-26 14:48:40 +02:00
parent 0b6035ffda
commit 770a7a29d2
1 changed files with 4 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
yesod-auth/Yesod/Auth/Email.hs
View File

@ -30,6 +30,7 @@ module Yesod.Auth.Email
, registerR , registerR
, forgotPasswordR , forgotPasswordR
, setpassR , setpassR
, verifyR
, isValidPass , isValidPass
-- * Types -- * Types
, Email , Email
@ -68,14 +69,12 @@ import Yesod.Form
import Data.Time (getCurrentTime, addUTCTime) import Data.Time (getCurrentTime, addUTCTime)
import Safe (readMay) import Safe (readMay)
loginR, registerR, forgotPasswordR, setpassR :: AuthRoute loginR, registerR, forgotPasswordR, setpassR, verifyR :: AuthRoute
loginR = PluginR "email" ["login"] loginR = PluginR "email" ["login"]
registerR = PluginR "email" ["register"] registerR = PluginR "email" ["register"]
forgotPasswordR = PluginR "email" ["forgot-password"] forgotPasswordR = PluginR "email" ["forgot-password"]
setpassR = PluginR "email" ["set-password"] setpassR = PluginR "email" ["set-password"]
verifyR eid verkey = PluginR "email" ["verify", eid, verkey]
verify :: Text -> Text -> AuthRoute -- FIXME
verify eid verkey = PluginR "email" ["verify", eid, verkey]
type Email = Text type Email = Text
type VerKey = Text type VerKey = Text
@ -345,7 +344,7 @@ registerHelper allowUsername dest = do
Nothing -> loginErrorMessageI dest (Msg.IdentifierNotFound identifier) Nothing -> loginErrorMessageI dest (Msg.IdentifierNotFound identifier)
Just (lid, verKey, email) -> do Just (lid, verKey, email) -> do
render <- getUrlRender render <- getUrlRender
let verUrl = render $ verify (toPathPiece lid) verKey let verUrl = render $ verifyR (toPathPiece lid) verKey
lift $ sendVerifyEmail email verKey verUrl lift $ sendVerifyEmail email verKey verUrl
lift $ confirmationEmailSentResponse identifier lift $ confirmationEmailSentResponse identifier