password change succesful

This commit is contained in:
nek0 2014-09-04 03:57:01 +02:00
parent 06c55cc449
commit 6f89c0bcb9
6 changed files with 96 additions and 16 deletions

View file

@ -38,6 +38,7 @@ import Handler.Album
import Handler.Medium
import Handler.AlbumSettings
import Handler.MediumSettings
import Handler.Reactivate
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the

View file

@ -12,8 +12,16 @@ getActivateR token = do
t <- runDB $ selectFirst [ActivatorToken ==. token] []
case t of
Nothing -> do
setMessage "Invalid Token!"
redirect $ HomeR
mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] []
case mToken of
Just (Entity uTokenId uToken) -> do
user <- runDB $ getJust (fromJust $ tokenUser uToken)
hexSalt <- return $ toHex $ userSalt user
defaultLayout $ do
$(widgetFile "activate")
_ -> do
setMessage "Invalid token!"
redirect $ HomeR
Just (Entity activatorKey activator) -> do
uSalt <- return $ userSalt $ activatorUser activator
mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] []
@ -33,23 +41,32 @@ postActivateR token = do
mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] []
case mToken of
Just (Entity uTokenId uToken) -> do
newUser <- runDB $ selectFirst [ActivatorToken ==. token] []
case newUser of
Just (Entity aId activ) -> do
-- putting user in active state
uId <- runDB $ insert $ activatorUser activ
runDB $ update uId [UserSalted =. salted]
-- create user directory
liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> (unpack $ extractKey uId)
case tokenUser uToken == Nothing of
True -> do
newUser <- runDB $ selectFirst [ActivatorToken ==. token] []
case newUser of
Just (Entity aId activ) -> do
-- putting user in active state
uId <- runDB $ insert $ activatorUser activ
runDB $ update uId [UserSalted =. salted]
-- create user directory
liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> (unpack $ extractKey uId)
-- cleanup
runDB $ delete aId
runDB $ delete uTokenId
-- login and redirect
setSession "userId" (extractKey uId)
welcomeLink <- ($ ProfileR uId) <$> getUrlRender
returnJson ["welcome" .= welcomeLink]
Nothing -> do
returnJsonError "Invalid token"
False -> do
runDB $ update (fromJust $ tokenUser uToken) [UserSalted =. salted]
-- cleanup
runDB $ delete aId
runDB $ delete uTokenId
-- login and redirect
setSession "userId" (extractKey uId)
welcomeLink <- ($ ProfileR uId) <$> getUrlRender
setSession "userId" (extractKey $ fromJust $ tokenUser uToken)
welcomeLink <- ($ ProfileR (fromJust $ tokenUser uToken)) <$> getUrlRender
returnJson ["welcome" .= welcomeLink]
Nothing -> do
returnJsonError "Invalid token"
_ -> do
returnJsonError "Invalid activation token!"

52
Handler/Reactivate.hs Normal file
View file

@ -0,0 +1,52 @@
module Handler.Reactivate where
import Import
import Control.Monad
import Data.Text.Encoding
getReactivateR :: Handler Html
getReactivateR = do
(reactivateWidget, enctype) <- generateFormPost reactivateForm
defaultLayout $ do
$(widgetFile "reactivate")
postReactivateR :: Handler Html
postReactivateR = do
((result, reactivateWidget), enctype) <- runFormPost reactivateForm
case result of
FormSuccess temp -> do
tempUsers <- runDB $ selectList [UserEmail ==. temp] []
case tempUsers of
users -> do
userTokens <- foldM (\userTokens (Entity userId user) -> do
token <- liftIO $ generateString
-- aId <- runDB $ insert $ Activator token user
-- runDB $ delete userId
tId <- runDB $ insert $ Token (encodeUtf8 token) "activate" (Just userId)
return $ (user, token) : userTokens
) [] users
sent <- foldM (\sent (user, token) ->
case sent of
False ->
return False
True -> do
activateLink <- ($ ActivateR token) <$> getUrlRender
sendMail (userEmail user) "Reset your password" $
[shamlet|
<h1>Welcome again to Eidolon
To reset your password visit the following link:
<a href="#{activateLink}">#{activateLink}
See you soon!
|]
return True
) True userTokens
setMessage "Your new passwort will arrive in your e-mail"
redirect $ HomeR
[] -> do
setMessage "No user mith this Email"
redirect $ LoginR
reactivateForm :: Form Text
reactivateForm = renderDivs $ (\a -> a)
<$> areq emailField "Email" Nothing

View file

@ -19,3 +19,4 @@
/album/#AlbumId/delete AlbumDeleteR GET POST
/medium/#MediumId/settings MediumSettingsR GET POST
/medium/#MediumId/delete MediumDeleteR GET POST
/reactivate ReactivateR GET POST

View file

@ -31,6 +31,7 @@ library
Handler.Medium
Handler.AlbumSettings
Handler.MediumSettings
Handler.Reactivate
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT

View file

@ -0,0 +1,8 @@
$newline always
<h3>Reset Password
<form method="post" enctype=#{enctype}>
^{reactivateWidget}
<div>
<input type=submit value="Send">