condensing code for profile settings

This commit is contained in:
nek0 2014-12-28 00:01:40 +01:00
parent 4b81a54503
commit aaaedd4f15
3 changed files with 91 additions and 121 deletions

View file

@ -2,6 +2,7 @@ module Handler.Commons where
import Import
import Yesod
import Helper
import Data.String
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
@ -18,3 +19,22 @@ loginIsAdmin = do
return $ Left ("You have no admin rights", HomeR)
Nothing ->
return $ Left ("You are not logged in", LoginR)
profileCheck :: IsString t => UserId -> Handler (Either (t, Route App) User)
profileCheck userId = do
tempUser <- runDB $ get userId
case tempUser of
Just user -> do
msu <- lookupSession "userId"
case msu of
Just tempLoginId -> do
loginId <- return $ getUserIdFromText tempLoginId
case loginId == userId of
True ->
return $ Right user
False ->
return $ Left ("You can only change your own profile settings", UserR $ userName user)
Nothing ->
return $ Left ("You nedd to be logged in to change settings", LoginR)
Nothing ->
return $ Left ("This user does not exist", HomeR)

View file

@ -1,6 +1,7 @@
module Handler.ProfileDelete where
import Import
import Handler.Commons
import qualified Data.Text as T
import Data.Maybe
import qualified Data.List as L
@ -9,72 +10,46 @@ 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
setTitle "Eidolon :: Delete user profile"
$(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
checkRes <- profileCheck userId
case checkRes of
Right user -> do
defaultLayout $ do
setTitle "Eidolon :: Delete user profile"
$(widgetFile "profileDelete")
Left (errorMsg, route) -> do
setMessage errorMsg
redirect $ route
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 -> do
commEnts <- runDB $ selectList [CommentOrigin ==. med] []
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
medium <- runDB $ getJust med
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
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
checkRes <- profileCheck userId
case checkRes of
Right user -> 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 -> do
commEnts <- runDB $ selectList [CommentOrigin ==. med] []
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
medium <- runDB $ getJust med
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
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
Left (errorMsg, route) -> do
setMessage errorMsg
redirect $ route

View file

@ -1,67 +1,42 @@
module Handler.ProfileSettings where
import Import
import Handler.Commons
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
setTitle "Eidolon :: Profile settings"
$(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
checkRes <- profileCheck userId
case checkRes of
Right user -> do
(profileSettingsWidget, enctype) <- generateFormPost $ profileSettingsForm user
defaultLayout $ do
setTitle "Eidolon :: Profile settings"
$(widgetFile "profileSettings")
Left (errorMsg, route) -> do
setMessage errorMsg
redirect $ route
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
checkRes <- profileCheck userId
case checkRes of
Right user -> 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 user
_ -> do
setMessage "There was an error changing your settings"
redirect $ ProfileSettingsR userId
Left (errorMsg, route) -> do
setMessage errorMsg
redirect $ route
profileSettingsForm :: User -> Form User