diff --git a/Handler/Commons.hs b/Handler/Commons.hs index 73e4041..3540c89 100644 --- a/Handler/Commons.hs +++ b/Handler/Commons.hs @@ -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) diff --git a/Handler/ProfileDelete.hs b/Handler/ProfileDelete.hs index a5ad09a..bc3903e 100644 --- a/Handler/ProfileDelete.hs +++ b/Handler/ProfileDelete.hs @@ -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 diff --git a/Handler/ProfileSettings.hs b/Handler/ProfileSettings.hs index 4270850..db4be5c 100644 --- a/Handler/ProfileSettings.hs +++ b/Handler/ProfileSettings.hs @@ -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