eidolon/Handler/Reactivate.hs

72 lines
2.7 KiB
Haskell
Raw Normal View History

2015-01-18 19:44:41 +00:00
-- 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
2015-01-21 09:00:18 +00:00
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
2015-01-18 19:44:41 +00:00
2014-09-04 01:57:01 +00:00
module Handler.Reactivate where
import Import
import Control.Monad
import Data.Text.Encoding
getReactivateR :: Handler Html
getReactivateR = do
2016-09-05 15:17:57 +00:00
(reactivateWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ reactivateForm
2016-09-07 15:32:56 +00:00
defaultLayout $ do
2014-09-24 21:03:18 +00:00
setTitle "Eidolon :: Reactivate account"
2014-09-04 01:57:01 +00:00
$(widgetFile "reactivate")
postReactivateR :: Handler Html
postReactivateR = do
2016-09-05 15:17:57 +00:00
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ reactivateForm
2014-09-04 01:57:01 +00:00
case result of
FormSuccess temp -> do
2014-12-08 05:14:26 +00:00
users <- runDB $ selectList [UserEmail ==. temp] []
2016-12-03 17:50:58 +00:00
if not $ null users
2015-09-14 16:54:46 +00:00
then do
2014-09-04 01:57:01 +00:00
userTokens <- foldM (\userTokens (Entity userId user) -> do
token <- liftIO $ generateString
2017-04-24 05:46:34 +00:00
_ <- runDB $ insert $ Token (encodeUtf8 token) "activate" (userName user)
2014-09-04 01:57:01 +00:00
return $ (user, token) : userTokens
) [] users
2014-12-28 06:12:25 +00:00
_ <- foldM (\sent (user, token) ->
2014-09-04 01:57:01 +00:00
case sent of
False ->
return False
True -> do
activateLink <- ($ ActivateR token) <$> getUrlRender
sendMail (userEmail user) "Reset your password" $
[shamlet|
2014-12-08 05:14:26 +00:00
<h1>Welcome again to Eidolon #{userName user}
2014-09-04 01:57:01 +00:00
To reset your password visit the following link:
<a href="#{activateLink}">#{activateLink}
See you soon!
|]
return True
) True userTokens
2014-12-08 05:14:26 +00:00
setMessage "Your new password activation will arrive in your e-mail"
2014-09-04 01:57:01 +00:00
redirect $ HomeR
2015-09-14 16:54:46 +00:00
else do
2014-09-04 01:57:01 +00:00
setMessage "No user mith this Email"
redirect $ LoginR
2014-12-08 05:14:26 +00:00
_ -> do
setMessage "There is something wrong with your email"
redirect $ ReactivateR
2014-09-04 01:57:01 +00:00
2016-09-05 15:17:57 +00:00
reactivateForm :: AForm Handler Text
reactivateForm = id
<$> areq emailField (bfs ("Email" :: Text)) Nothing
<* bootstrapSubmit ("Send" :: BootstrapSubmit Text)