Profile settings and user deletion

This commit is contained in:
nek0 2014-09-05 20:40:12 +02:00
parent af6f0f8ec7
commit fec1b02780
8 changed files with 189 additions and 18 deletions

View file

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

71
Handler/ProfileDelete.hs Normal file
View file

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

View file

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

View file

@ -20,3 +20,5 @@
/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

View file

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

View file

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

View file

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

View file

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