From fec1b02780893139a366bce528e510b85de2e087 Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 5 Sep 2014 20:40:12 +0200 Subject: [PATCH] Profile settings and user deletion --- Application.hs | 2 + Handler/ProfileDelete.hs | 71 +++++++++++++++++++++++++++++++ Handler/ProfileSettings.hs | 73 ++++++++++++++++++++++++++++++++ config/routes | 36 ++++++++-------- eidolon.cabal | 2 + templates/profile.hamlet | 4 +- templates/profileDelete.hamlet | 10 +++++ templates/profileSettings.hamlet | 9 ++++ 8 files changed, 189 insertions(+), 18 deletions(-) create mode 100644 Handler/ProfileDelete.hs create mode 100644 Handler/ProfileSettings.hs create mode 100644 templates/profileDelete.hamlet create mode 100644 templates/profileSettings.hamlet diff --git a/Application.hs b/Application.hs index 6385ec3..2aac568 100644 --- a/Application.hs +++ b/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 diff --git a/Handler/ProfileDelete.hs b/Handler/ProfileDelete.hs new file mode 100644 index 0000000..a185088 --- /dev/null +++ b/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 diff --git a/Handler/ProfileSettings.hs b/Handler/ProfileSettings.hs new file mode 100644 index 0000000..f8a0af7 --- /dev/null +++ b/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) diff --git a/config/routes b/config/routes index cb93b4c..0362a4c 100644 --- a/config/routes +++ b/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 diff --git a/eidolon.cabal b/eidolon.cabal index 61c8aaa..2bce717 100644 --- a/eidolon.cabal +++ b/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 diff --git a/templates/profile.hamlet b/templates/profile.hamlet index 00bd9c1..d6b471e 100644 --- a/templates/profile.hamlet +++ b/templates/profile.hamlet @@ -1,5 +1,7 @@ $newline always -

Profile of #{ownerName} +

Profile of #{ownerSlug} +$if presence == True + Change your profile settings $if null userAlbs This user has no albums yet diff --git a/templates/profileDelete.hamlet b/templates/profileDelete.hamlet new file mode 100644 index 0000000..cb0d9e7 --- /dev/null +++ b/templates/profileDelete.hamlet @@ -0,0 +1,10 @@ +$newline always +

Delete User #{userSlug user} + +

+ Do you wish to delete this user and all his albums in images? + +

+

Profile settings + + + ^{profileSettingsWidget} +