forked from filipg/gonito
create/verify password reset links
This commit is contained in:
parent
53c3647aaf
commit
62fb3ce251
@ -47,6 +47,7 @@ import Handler.Query
|
||||
import Handler.ShowChallenge
|
||||
import Handler.Shared
|
||||
import Handler.YourAccount
|
||||
import Handler.AccountReset
|
||||
import Handler.Presentation
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
|
@ -58,6 +58,13 @@ isTrustedAuthorized = do
|
||||
| isTrusted user -> return Authorized
|
||||
| otherwise -> return $ Unauthorized "???"
|
||||
|
||||
isAdmin = do
|
||||
mauth <- maybeAuth
|
||||
case mauth of
|
||||
Nothing -> return AuthenticationRequired
|
||||
Just (Entity _ user)
|
||||
| userIsAdmin user -> return Authorized
|
||||
| otherwise -> return $ Unauthorized "only permitted for the admin"
|
||||
|
||||
isTrusted :: User -> Bool
|
||||
isTrusted user =
|
||||
@ -124,6 +131,9 @@ instance Yesod App where
|
||||
|
||||
isAuthorized (AvatarR _) _ = return Authorized
|
||||
|
||||
isAuthorized CreateResetLinkR _ = isAdmin
|
||||
isAuthorized (ResetPasswordR _) _ = return Authorized
|
||||
|
||||
-- Default to Authorized for now.
|
||||
isAuthorized _ _ = isTrustedAuthorized
|
||||
|
||||
@ -196,6 +206,8 @@ instance YesodAuth App where
|
||||
, userLocalId = Nothing
|
||||
, userIsAnonymous = False
|
||||
, userAvatar = Nothing
|
||||
, userVerificationKey = Nothing
|
||||
, userKeyExpirationDate = Nothing
|
||||
}
|
||||
|
||||
-- You can add other plugins like BrowserID, email or OAuth here
|
||||
|
118
Handler/AccountReset.hs
Normal file
118
Handler/AccountReset.hs
Normal file
@ -0,0 +1,118 @@
|
||||
module Handler.AccountReset where
|
||||
|
||||
import Import
|
||||
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3, bfs)
|
||||
|
||||
import qualified Crypto.Nonce as Nonce
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
||||
import Data.Time.Clock (addUTCTime)
|
||||
|
||||
import Handler.Common (passwordConfirmField, updatePassword)
|
||||
|
||||
getCreateResetLinkR :: Handler Html
|
||||
getCreateResetLinkR = do
|
||||
(formWidget, formEnctype) <- generateFormPost createResetLinkForm
|
||||
defaultLayout $ do
|
||||
setTitle "Create a reset link"
|
||||
$(widgetFile "create-reset-link")
|
||||
|
||||
postCreateResetLinkR :: Handler Html
|
||||
postCreateResetLinkR = do
|
||||
((result, _), _) <- runFormPost createResetLinkForm
|
||||
let mEmail = case result of
|
||||
FormSuccess email -> Just email
|
||||
_ -> Nothing
|
||||
doCreateResetLink mEmail
|
||||
|
||||
doCreateResetLink :: Maybe Text -> Handler Html
|
||||
doCreateResetLink (Just email) = do
|
||||
mUserEnt <- runDB $ getBy $ UniqueUser email
|
||||
userId <- createOrUse mUserEnt email
|
||||
|
||||
key <- newVerifyKey
|
||||
theNow <- liftIO getCurrentTime
|
||||
let expirationMoment = addUTCTime (60*60*24) theNow
|
||||
runDB $ update userId [UserVerificationKey =. Just key, UserKeyExpirationDate =. Just expirationMoment]
|
||||
|
||||
defaultLayout $ do
|
||||
setTitle "Creating a reset link"
|
||||
$(widgetFile "reset-link-created")
|
||||
|
||||
doCreateResetLink Nothing = do
|
||||
setMessage $ toHtml ("No e-mail given" :: Text)
|
||||
getCreateResetLinkR
|
||||
|
||||
createOrUse :: Maybe (Entity User) -> Text -> Handler UserId
|
||||
createOrUse (Just userEnt) _ = return $ entityKey userEnt
|
||||
createOrUse Nothing email = do
|
||||
setMessage $ toHtml ("Created new user " ++ email)
|
||||
userId <- runDB $ insert $ User email Nothing Nothing False Nothing True Nothing Nothing Nothing
|
||||
return userId
|
||||
|
||||
createResetLinkForm :: Form Text
|
||||
createResetLinkForm = renderBootstrap3 BootstrapBasicForm
|
||||
$ areq textField (bfs MsgEMail) Nothing
|
||||
|
||||
|
||||
nonceGen :: Nonce.Generator
|
||||
nonceGen = unsafePerformIO Nonce.new
|
||||
{-# NOINLINE nonceGen #-}
|
||||
|
||||
-- | Randomly create a new verification key.
|
||||
newVerifyKey :: MonadIO m => m Text
|
||||
newVerifyKey = Nonce.nonce128urlT nonceGen
|
||||
|
||||
|
||||
getResetPasswordR :: Text -> Handler Html
|
||||
getResetPasswordR key = do
|
||||
(formWidget, formEnctype) <- generateFormPost changePasswordForm
|
||||
mUserId <- checkVerificationKey key
|
||||
master <- getYesod
|
||||
defaultLayout $ do
|
||||
setTitle "Reset password"
|
||||
$(widgetFile "reset-password")
|
||||
|
||||
postResetPasswordR :: Text -> Handler Html
|
||||
postResetPasswordR key = do
|
||||
((result, _), _) <- runFormPost changePasswordForm
|
||||
mUserId <- checkVerificationKey key
|
||||
let mPassword = case result of
|
||||
FormSuccess password -> Just password
|
||||
_ -> Nothing
|
||||
doResetPassword key mUserId mPassword
|
||||
|
||||
doResetPassword :: Text -> Maybe (Key User) -> Maybe Text -> Handler Html
|
||||
doResetPassword key _ Nothing = do
|
||||
setMessage $ toHtml ("Password not given or does not match! Make sure you entered the same password" :: Text)
|
||||
getResetPasswordR key
|
||||
|
||||
doResetPassword _ (Just userId) (Just password) = do
|
||||
updatePassword userId (Just password)
|
||||
runDB $ update userId removeVerificationKeyStatement
|
||||
defaultLayout $ do
|
||||
setTitle "Reset password"
|
||||
$(widgetFile "password-reset")
|
||||
|
||||
doResetPassword key Nothing _ = do
|
||||
runDB $ updateWhere [UserVerificationKey ==. Just key] removeVerificationKeyStatement
|
||||
master <- getYesod
|
||||
defaultLayout $ do
|
||||
setTitle "Reset password"
|
||||
$(widgetFile "password-reset-failed")
|
||||
|
||||
removeVerificationKeyStatement :: [Update User]
|
||||
removeVerificationKeyStatement = [UserVerificationKey =. Nothing, UserKeyExpirationDate =. Nothing]
|
||||
|
||||
|
||||
checkVerificationKey :: Text -> Handler (Maybe UserId)
|
||||
checkVerificationKey key = do
|
||||
theNow <- liftIO getCurrentTime
|
||||
userEnts <- runDB $ selectList [UserVerificationKey ==. Just key, UserKeyExpirationDate >. Just theNow] []
|
||||
return $ case userEnts of
|
||||
[Entity k _] -> Just k
|
||||
_ -> Nothing
|
||||
|
||||
changePasswordForm :: Form Text
|
||||
changePasswordForm = renderBootstrap3 BootstrapBasicForm
|
||||
$ areq passwordConfirmField (bfs MsgPassword) Nothing
|
@ -4,6 +4,10 @@ module Handler.Common where
|
||||
import Data.FileEmbed (embedFile)
|
||||
import Import
|
||||
|
||||
import Crypto.PasswordStore
|
||||
import Yesod.Auth.HashDB (defaultStrength)
|
||||
|
||||
|
||||
-- These handlers embed files in the executable at compile time to avoid a
|
||||
-- runtime dependency, and for efficiency.
|
||||
|
||||
@ -14,3 +18,29 @@ getFaviconR = return $ TypedContent "image/x-icon"
|
||||
getRobotsR :: Handler TypedContent
|
||||
getRobotsR = return $ TypedContent typePlain
|
||||
$ toContent $(embedFile "config/robots.txt")
|
||||
|
||||
|
||||
passwordConfirmField :: Field Handler Text
|
||||
passwordConfirmField = Field
|
||||
{ fieldParse = \rawVals _fileVals ->
|
||||
case rawVals of
|
||||
[a, b]
|
||||
| a == b -> return $ Right $ Just a
|
||||
| otherwise -> return $ Left "Passwords don't match"
|
||||
[] -> return $ Right Nothing
|
||||
_ -> return $ Left "You must enter two values"
|
||||
, fieldView = \idAttr nameAttr otherAttrs _ _ ->
|
||||
[whamlet|
|
||||
<input id=#{idAttr} name=#{nameAttr} *{otherAttrs} type=password>
|
||||
<div>confirm new password:
|
||||
<input id=#{idAttr}-confirm name=#{nameAttr} *{otherAttrs} type=password>
|
||||
|]
|
||||
, fieldEnctype = UrlEncoded
|
||||
}
|
||||
|
||||
updatePassword :: Key User -> Maybe Text -> Handler ()
|
||||
updatePassword _ Nothing = return ()
|
||||
updatePassword userId (Just password) = do
|
||||
encodedPassword <- liftIO $ makePassword (encodeUtf8 password) defaultStrength
|
||||
runDB $ update userId [UserPassword =. Just (decodeUtf8 encodedPassword)]
|
||||
setMessage $ toHtml ("Password set!" :: Text)
|
||||
|
@ -13,7 +13,6 @@ import System.Directory (doesFileExist)
|
||||
import qualified Data.Text as T
|
||||
|
||||
import qualified Yesod.Table as Table
|
||||
import Yesod.Table (Table)
|
||||
|
||||
import Handler.Extract
|
||||
import Handler.Shared
|
||||
@ -22,7 +21,6 @@ import Handler.Tables
|
||||
import GEval.Core
|
||||
import GEval.OptionsParser
|
||||
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import PersistSHA1
|
||||
|
@ -8,8 +8,8 @@ import Text.Regex.TDFA
|
||||
import Data.Conduit.Binary
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Crypto.PasswordStore
|
||||
import Yesod.Auth.HashDB (defaultStrength)
|
||||
|
||||
import Handler.Common (passwordConfirmField, updatePassword)
|
||||
|
||||
getYourAccountR :: Handler Html
|
||||
getYourAccountR = do
|
||||
@ -69,13 +69,6 @@ updateUserAccount userId name maybeLocalId maybePassword maybeSshPubKey maybeAva
|
||||
updateLocalIdAndPubKey userId maybeLocalId maybeSshPubKey
|
||||
updatePassword userId maybePassword
|
||||
|
||||
updatePassword :: Key User -> Maybe Text -> Handler ()
|
||||
updatePassword _ Nothing = return ()
|
||||
updatePassword userId (Just password) = do
|
||||
encodedPassword <- liftIO $ makePassword (encodeUtf8 password) defaultStrength
|
||||
runDB $ update userId [UserPassword =. Just (decodeUtf8 encodedPassword)]
|
||||
setMessage $ toHtml ("Password set!" :: Text)
|
||||
|
||||
updateAvatar :: Key User -> Maybe FileInfo -> Handler ()
|
||||
updateAvatar _ Nothing = return ()
|
||||
updateAvatar userId (Just avatarFile) = do
|
||||
@ -129,21 +122,3 @@ getAvatarR userId = do
|
||||
sendResponse (typePng, toContent avatarBytes)
|
||||
Nothing -> do
|
||||
sendFile typeSvg "static/images/male-avatar.svg"
|
||||
|
||||
passwordConfirmField :: Field Handler Text
|
||||
passwordConfirmField = Field
|
||||
{ fieldParse = \rawVals _fileVals ->
|
||||
case rawVals of
|
||||
[a, b]
|
||||
| a == b -> return $ Right $ Just a
|
||||
| otherwise -> return $ Left "Passwords don't match"
|
||||
[] -> return $ Right Nothing
|
||||
_ -> return $ Left "You must enter two values"
|
||||
, fieldView = \idAttr nameAttr otherAttrs _ _ ->
|
||||
[whamlet|
|
||||
<input id=#{idAttr} name=#{nameAttr} *{otherAttrs} type=password>
|
||||
<div>confirm new password:
|
||||
<input id=#{idAttr}-confirm name=#{nameAttr} *{otherAttrs} type=password>
|
||||
|]
|
||||
, fieldEnctype = UrlEncoded
|
||||
}
|
||||
|
@ -7,6 +7,8 @@ User
|
||||
localId Text Maybe
|
||||
isAnonymous Bool default=False
|
||||
avatar ByteString Maybe
|
||||
verificationKey Text Maybe
|
||||
keyExpirationDate UTCTime Maybe
|
||||
deriving Typeable
|
||||
PublicKey
|
||||
user UserId
|
||||
|
@ -28,5 +28,7 @@
|
||||
|
||||
/account YourAccountR GET POST
|
||||
/avatar/#UserId AvatarR GET
|
||||
/create-reset-link CreateResetLinkR GET POST
|
||||
/reset-password/#Text ResetPasswordR GET POST
|
||||
|
||||
/presentation/4real Presentation4RealR GET
|
||||
|
@ -43,6 +43,7 @@ library
|
||||
Handler.Query
|
||||
Handler.Tables
|
||||
Handler.YourAccount
|
||||
Handler.AccountReset
|
||||
Handler.Presentation
|
||||
|
||||
if flag(dev) || flag(library-only)
|
||||
@ -129,6 +130,7 @@ library
|
||||
, yesod-newsfeed
|
||||
, yesod-auth-hashdb
|
||||
, pwstore-fast
|
||||
, nonce
|
||||
|
||||
executable gonito
|
||||
if flag(library-only)
|
||||
|
@ -26,3 +26,6 @@ Send: Send
|
||||
Avatar: avatar
|
||||
About: about
|
||||
Password: new password
|
||||
EMail: e-mail
|
||||
CreateResetLink: create reset link
|
||||
LinkWrongOrExpired: Link wrong or expired, please ask the site admin again
|
||||
|
6
templates/create-reset-link.hamlet
Normal file
6
templates/create-reset-link.hamlet
Normal file
@ -0,0 +1,6 @@
|
||||
<h2>Create a link for account creation or password reset
|
||||
|
||||
<form method=post action=@{CreateResetLinkR}#form enctype=#{formEnctype}>
|
||||
^{formWidget}
|
||||
<button .btn .btn-primary type="submit">
|
||||
_{MsgSubmit} <span class="glyphicon glyphicon-upload"></span>
|
@ -7,9 +7,10 @@
|
||||
|
||||
<li><a href="@{HomeR}">_{MsgHome}</a>
|
||||
<li><a href="@{Presentation4RealR}">_{MsgAbout}</a>
|
||||
<li><a href="@{ListChallengesR}">_{MsgListChallenges}</a>
|
||||
$if userIsAdmin $ entityVal user
|
||||
<li><a href="@{CreateChallengeR}">_{MsgCreateChallenge}</a>
|
||||
<li><a href="@{ListChallengesR}">_{MsgListChallenges}</a>
|
||||
<li><a href="@{CreateResetLinkR}">_{MsgCreateResetLink}</a>
|
||||
|
||||
<ul class="nav navbar-nav navbar-right">
|
||||
<li class="dropdown">
|
||||
|
1
templates/password-reset-failed.hamlet
Normal file
1
templates/password-reset-failed.hamlet
Normal file
@ -0,0 +1 @@
|
||||
<h3>_{MsgLinkWrongOrExpired} #{contactEmailLabel master}.
|
1
templates/password-reset.hamlet
Normal file
1
templates/password-reset.hamlet
Normal file
@ -0,0 +1 @@
|
||||
<p>OK, the password has been changed.
|
1
templates/reset-link-created.hamlet
Normal file
1
templates/reset-link-created.hamlet
Normal file
@ -0,0 +1 @@
|
||||
<p>Reset link created: <a href=@{ResetPasswordR key}>@{ResetPasswordR key}</a>
|
7
templates/reset-password.hamlet
Normal file
7
templates/reset-password.hamlet
Normal file
@ -0,0 +1,7 @@
|
||||
$maybe _ <- mUserId
|
||||
<form method=post action=@{ResetPasswordR key}#form enctype=#{formEnctype}>
|
||||
^{formWidget}
|
||||
<button .btn .btn-primary type="submit">
|
||||
_{MsgSubmit} <span class="glyphicon glyphicon-upload"></span>
|
||||
$nothing
|
||||
<h3>_{MsgLinkWrongOrExpired} #{contactEmailLabel master}.
|
Loading…
Reference in New Issue
Block a user