password change succesful

Application.hs

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

Handler/Activate.hs

@@ -12,8 +12,16 @@ getActivateR token = do
   t <- runDB $ selectFirst [ActivatorToken ==. token] []
   case t of
     Nothing -> do
-      setMessage "Invalid Token!"
+      mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] []
-      redirect $ HomeR
+      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 tokenUser uToken == Nothing of
-      case newUser of
+        True -> do
-        Just (Entity aId activ) -> do
+          newUser <- runDB $ selectFirst [ActivatorToken ==. token] []
-          -- putting user in active state
+          case newUser of
-          uId <- runDB $ insert $ activatorUser activ
+            Just (Entity aId activ) -> do
-          runDB $ update uId [UserSalted =. salted]
+              -- putting user in active state
-          -- create user directory
+              uId <- runDB $ insert $ activatorUser activ
-          liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> (unpack $ extractKey uId)
+              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 $ fromJust $ tokenUser uToken)
-          setSession "userId" (extractKey uId)
+          welcomeLink <- ($ ProfileR (fromJust $ tokenUser uToken)) <$> getUrlRender
-          welcomeLink <- ($ ProfileR uId) <$> getUrlRender
           returnJson ["welcome" .= welcomeLink]
-        Nothing -> do
-          returnJsonError "Invalid token"
     _ -> do
       returnJsonError "Invalid activation token!"
 

Handler/Reactivate.hs

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

config/routes

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

eidolon.cabal

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

templates/reactivate.hamlet

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