Profile settings and user deletion

Application.hs

@@ -39,6 +39,8 @@ import Handler.Medium
 import Handler.AlbumSettings
 import Handler.MediumSettings
 import Handler.Reactivate
+import Handler.ProfileSettings
+import Handler.ProfileDelete
 
 -- 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/ProfileDelete.hs

@@ -0,0 +1,71 @@
+module Handler.ProfileDelete where
+
+import Import
+import qualified Data.Text as T
+import Data.Maybe
+import System.Directory
+import System.FilePath
+
+getProfileDeleteR :: UserId -> Handler Html
+getProfileDeleteR userId = do
+  tempUser <- runDB $ get userId
+  case tempUser of
+    Just user -> do
+      username <- return $ userName user
+      msu <- lookupSession "userId"
+      case msu of
+        Just tempLoginId -> do
+          loginId <- return $ getUserIdFromText tempLoginId
+          case loginId == userId of
+            True -> do
+              defaultLayout $ do
+                $(widgetFile "profileDelete")
+            False -> do
+              setMessage "You can only delete your own profile"
+              redirect $ UserR username
+        Nothing -> do
+          setMessage "You must be logged in to delete profiles"
+          redirect $ LoginR
+    Nothing -> do
+      setMessage "This user does not exist"
+      redirect $ HomeR
+
+postProfileDeleteR :: UserId -> Handler Html
+postProfileDeleteR userId = do
+  tempUser <- runDB $ get userId
+  case tempUser of
+    Just user -> do
+      username <- return $ userName user
+      msu <- lookupSession "userId"
+      case msu of
+        Just tempLoginId -> do
+          loginId <- return $ getUserIdFromText tempLoginId
+          case loginId == userId of
+            True -> do
+              confirm <- lookupPostParam "confirm"
+              case confirm of
+                Just "confirm" -> do
+                  albumList <- return $ userAlbums user
+                  mapM (\albumId -> do
+                    album <- runDB $ getJust albumId
+                    mediaList <- return $ albumContent album
+                    mapM (\med -> runDB $ delete med) mediaList
+                    runDB $ delete albumId
+                    ) albumList
+                  runDB $ delete userId
+                  liftIO $ removeDirectoryRecursive $ "static" </> "data" </> (T.unpack $ extractKey userId)
+                  deleteSession "userId"
+                  setMessage "User deleted successfully"
+                  redirect $ HomeR
+                _ -> do
+                  setMessage "You must confirm the deletion"
+                  redirect $ ProfileSettingsR userId
+            False -> do
+              setMessage "You can only delete your own profile"
+              redirect $ UserR username
+        Nothing -> do
+          setMessage "You must be logged in to delete profiles"
+          redirect $ LoginR
+    Nothing -> do
+      setMessage "This user does not exist"
+      redirect $ HomeR

Handler/ProfileSettings.hs

@@ -0,0 +1,73 @@
+module Handler.ProfileSettings where
+
+import Import
+
+getProfileSettingsR :: UserId -> Handler Html
+getProfileSettingsR userId = do
+  tempUser <- runDB $ get userId
+  case tempUser of
+    Just user -> do
+      username <- return $ userName user
+      msu <- lookupSession "userId"
+      case msu of
+        Just tempLoginId -> do
+          loginId <- return $ getUserIdFromText tempLoginId
+          case loginId == userId of
+            True -> do
+              (profileSettingsWidget, enctype) <- generateFormPost $ profileSettingsForm user
+              defaultLayout $ do
+                $(widgetFile "profileSettings")
+            False -> do
+              setMessage "You can only change your own profile settings"
+              redirect $ UserR username
+        Nothing -> do
+          setMessage "You need to be logged in to change settings"
+          redirect $ LoginR
+    Nothing -> do
+      setMessage "This user does not exist"
+      redirect $ HomeR
+
+postProfileSettingsR :: UserId -> Handler Html
+postProfileSettingsR userId = do
+  tempUser <- runDB $ get userId
+  case tempUser of
+    Just user -> do
+      username <- return $ userName user
+      msu <- lookupSession "userId"
+      case msu of
+        Just tempLoginId -> do
+          loginId <- return $ getUserIdFromText tempLoginId
+          case loginId == userId of
+            True -> do
+              ((result, profileSettingsWidget), enctype) <- runFormPost $ profileSettingsForm user
+              case result of
+                FormSuccess temp -> do
+                  runDB $ update userId [
+                      UserName =. (userName temp)
+                    , UserSlug =. (userSlug temp)
+                    , UserEmail =. (userEmail temp)
+                    ]
+                  setMessage "Profile settings changed successfully"
+                  redirect $ UserR username
+                _ -> do
+                  setMessage "There was an error changing your settings"
+                  redirect $ ProfileSettingsR userId
+            False -> do
+              setMessage "You can only change your own profile settings"
+              redirect $ UserR username
+        Nothing -> do
+          setMessage "You need to be logged in to change settings"
+          redirect $ LoginR
+    Nothing -> do
+      setMessage "This user does not exist"
+      redirect $ HomeR
+
+
+profileSettingsForm :: User -> Form User
+profileSettingsForm user = renderDivs $ User
+  <$> areq textField "Username" (Just $ userName user)
+  <*> areq textField "Userslug" (Just $ userSlug user)
+  <*> areq emailField "Email" (Just $ userEmail user)
+  <*> pure (userSalt user)
+  <*> pure (userSalted user)
+  <*> pure (userAlbums user)

config/routes

@@ -3,20 +3,22 @@
 /favicon.ico FaviconR GET
 /robots.txt RobotsR GET
 
-/				HomeR		GET
-/signup				SignupR		GET POST
-/login				LoginR		GET POST
-/logout				LogoutR		GET
-/activate/#Text			ActivateR	GET POST
-/profile/#UserId		ProfileR	GET
-/user/#Text			UserR		GET
-/upload				UploadR		GET POST
-/newalbum			NewAlbumR	GET POST
-/album/#AlbumId			AlbumR		GET
-/medium/#MediumId		MediumR		GET
-/album/#AlbumId/upload		DirectUploadR	GET POST
-/album/#AlbumId/settings	AlbumSettingsR	GET POST
-/album/#AlbumId/delete		AlbumDeleteR	GET POST
-/medium/#MediumId/settings	MediumSettingsR	GET POST
-/medium/#MediumId/delete	MediumDeleteR	GET POST
-/reactivate ReactivateR GET POST
+/				HomeR			GET
+/signup				SignupR			GET POST
+/login				LoginR			GET POST
+/logout				LogoutR			GET
+/activate/#Text			ActivateR		GET POST
+/profile/#UserId		ProfileR		GET
+/user/#Text			UserR			GET
+/upload				UploadR			GET POST
+/newalbum			NewAlbumR		GET POST
+/album/#AlbumId			AlbumR			GET
+/medium/#MediumId		MediumR			GET
+/album/#AlbumId/upload		DirectUploadR		GET POST
+/album/#AlbumId/settings	AlbumSettingsR		GET POST
+/album/#AlbumId/delete		AlbumDeleteR		GET POST
+/medium/#MediumId/settings	MediumSettingsR		GET POST
+/medium/#MediumId/delete	MediumDeleteR		GET POST
+/reactivate			ReactivateR		GET POST
+/profile/#UserId/settings	ProfileSettingsR	GET POST
+/profile/#UserId/delete		ProfileDeleteR		GET POST

eidolon.cabal

@@ -32,6 +32,8 @@ library
                      Handler.AlbumSettings
                      Handler.MediumSettings
                      Handler.Reactivate
+                     Handler.ProfileSettings
+                     Handler.ProfileDelete
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT

templates/profile.hamlet

@@ -1,5 +1,7 @@
 $newline always
-<h3>Profile of #{ownerName}
+<h3>Profile of #{ownerSlug}
+$if presence == True
+  <a href=@{ProfileSettingsR ownerId}>Change your profile settings
 
 $if null userAlbs
   This user has no albums yet

templates/profileDelete.hamlet

@@ -0,0 +1,10 @@
+$newline always
+<h3>Delete User #{userSlug user}
+
+<p>
+  Do you wish to delete this user and all his albums in images?
+
+<form method="POST" action=@{ProfileDeleteR userId}>
+  <label for="confirm">Really delete this user
+  <input type="checkbox" id="confirm" name="confirm" value="confirm" required>
+  <input id="delete" type="submit" value="Delete user">

templates/profileSettings.hamlet

@@ -0,0 +1,9 @@
+$newline always
+<h3>Profile settings
+
+<form method="post" enctype=#{enctype}>
+  ^{profileSettingsWidget}
+  <div>
+    <input type=submit value="Change settings">
+
+<a href=@{ProfileDeleteR userId}>Delete user