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)
|