eidolon/Handler/Reactivate.hs

72 lines
2.6 KiB
Haskell
Executable File

-- eidolon -- A simple gallery in Haskell and Yesod
-- Copyright (C) 2015 Amedeo Molnár
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
module Handler.Reactivate where
import Import
import Control.Monad
import Data.Text.Encoding
getReactivateR :: Handler Html
getReactivateR = do
(reactivateWidget, enctype) <- generateFormPost reactivateForm
formLayout $ do
setTitle "Eidolon :: Reactivate account"
$(widgetFile "reactivate")
postReactivateR :: Handler Html
postReactivateR = do
((result, _), _) <- runFormPost reactivateForm
case result of
FormSuccess temp -> do
users <- runDB $ selectList [UserEmail ==. temp] []
if
null users
then do
userTokens <- foldM (\userTokens (Entity userId user) -> do
token <- liftIO $ generateString
_ <- runDB $ insert $ Token (encodeUtf8 token) "activate" (Just userId)
return $ (user, token) : userTokens
) [] users
_ <- 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 #{userName user}
To reset your password visit the following link:
<a href="#{activateLink}">#{activateLink}
See you soon!
|]
return True
) True userTokens
setMessage "Your new password activation will arrive in your e-mail"
redirect $ HomeR
else do
setMessage "No user mith this Email"
redirect $ LoginR
_ -> do
setMessage "There is something wrong with your email"
redirect $ ReactivateR
reactivateForm :: Form Text
reactivateForm = renderDivs $ (\a -> a)
<$> areq emailField "Email" Nothing