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 Import
import Yesod import Yesod
import Helper
import Data.String import Data.String
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ()) loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
@ -18,3 +19,22 @@ loginIsAdmin = do
return $ Left ("You have no admin rights", HomeR) return $ Left ("You have no admin rights", HomeR)
Nothing -> Nothing ->
return $ Left ("You are not logged in", LoginR) 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 module Handler.ProfileDelete where
import Import import Import
import Handler.Commons
import qualified Data.Text as T import qualified Data.Text as T
import Data.Maybe import Data.Maybe
import qualified Data.List as L import qualified Data.List as L
@ -9,72 +10,46 @@ import System.FilePath
getProfileDeleteR :: UserId -> Handler Html getProfileDeleteR :: UserId -> Handler Html
getProfileDeleteR userId = do getProfileDeleteR userId = do
tempUser <- runDB $ get userId checkRes <- profileCheck userId
case tempUser of case checkRes of
Just user -> do Right user -> do
username <- return $ userName user defaultLayout $ do
msu <- lookupSession "userId" setTitle "Eidolon :: Delete user profile"
case msu of $(widgetFile "profileDelete")
Just tempLoginId -> do Left (errorMsg, route) -> do
loginId <- return $ getUserIdFromText tempLoginId setMessage errorMsg
case loginId == userId of redirect $ route
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
postProfileDeleteR :: UserId -> Handler Html postProfileDeleteR :: UserId -> Handler Html
postProfileDeleteR userId = do postProfileDeleteR userId = do
tempUser <- runDB $ get userId checkRes <- profileCheck userId
case tempUser of case checkRes of
Just user -> do Right user -> do
username <- return $ userName user confirm <- lookupPostParam "confirm"
msu <- lookupSession "userId" case confirm of
case msu of Just "confirm" -> do
Just tempLoginId -> do albumList <- return $ userAlbums user
loginId <- return $ getUserIdFromText tempLoginId mapM (\albumId -> do
case loginId == userId of album <- runDB $ getJust albumId
True -> do mediaList <- return $ albumContent album
confirm <- lookupPostParam "confirm" mapM (\med -> do
case confirm of commEnts <- runDB $ selectList [CommentOrigin ==. med] []
Just "confirm" -> do mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
albumList <- return $ userAlbums user medium <- runDB $ getJust med
mapM (\albumId -> do liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
album <- runDB $ getJust albumId liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
mediaList <- return $ albumContent album runDB $ delete med
mapM (\med -> do ) mediaList
commEnts <- runDB $ selectList [CommentOrigin ==. med] [] runDB $ delete albumId
mapM (\ent -> runDB $ delete $ entityKey ent) commEnts ) albumList
medium <- runDB $ getJust med runDB $ delete userId
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium) liftIO $ removeDirectoryRecursive $ "static" </> "data" </> (T.unpack $ extractKey userId)
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium) deleteSession "userId"
runDB $ delete med setMessage "User deleted successfully"
) mediaList redirect $ HomeR
runDB $ delete albumId _ -> do
) albumList setMessage "You must confirm the deletion"
runDB $ delete userId redirect $ ProfileSettingsR userId
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> (T.unpack $ extractKey userId) Left (errorMsg, route) -> do
deleteSession "userId" setMessage errorMsg
setMessage "User deleted successfully" redirect $ route
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

@ -1,67 +1,42 @@
module Handler.ProfileSettings where module Handler.ProfileSettings where
import Import import Import
import Handler.Commons
getProfileSettingsR :: UserId -> Handler Html getProfileSettingsR :: UserId -> Handler Html
getProfileSettingsR userId = do getProfileSettingsR userId = do
tempUser <- runDB $ get userId checkRes <- profileCheck userId
case tempUser of case checkRes of
Just user -> do Right user -> do
username <- return $ userName user (profileSettingsWidget, enctype) <- generateFormPost $ profileSettingsForm user
msu <- lookupSession "userId" defaultLayout $ do
case msu of setTitle "Eidolon :: Profile settings"
Just tempLoginId -> do $(widgetFile "profileSettings")
loginId <- return $ getUserIdFromText tempLoginId Left (errorMsg, route) -> do
case loginId == userId of setMessage errorMsg
True -> do redirect $ route
(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
postProfileSettingsR :: UserId -> Handler Html postProfileSettingsR :: UserId -> Handler Html
postProfileSettingsR userId = do postProfileSettingsR userId = do
tempUser <- runDB $ get userId checkRes <- profileCheck userId
case tempUser of case checkRes of
Just user -> do Right user -> do
username <- return $ userName user ((result, profileSettingsWidget), enctype) <- runFormPost $ profileSettingsForm user
msu <- lookupSession "userId" case result of
case msu of FormSuccess temp -> do
Just tempLoginId -> do runDB $ update userId [
loginId <- return $ getUserIdFromText tempLoginId UserName =. (userName temp)
case loginId == userId of , UserSlug =. (userSlug temp)
True -> do , UserEmail =. (userEmail temp)
((result, profileSettingsWidget), enctype) <- runFormPost $ profileSettingsForm user ]
case result of setMessage "Profile settings changed successfully"
FormSuccess temp -> do redirect $ UserR $ userName user
runDB $ update userId [ _ -> do
UserName =. (userName temp) setMessage "There was an error changing your settings"
, UserSlug =. (userSlug temp) redirect $ ProfileSettingsR userId
, UserEmail =. (userEmail temp) Left (errorMsg, route) -> do
] setMessage errorMsg
setMessage "Profile settings changed successfully" redirect $ route
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 -> Form User