eidolon/Handler/ProfileDelete.hs

81 lines
3 KiB
Haskell
Raw Normal View History

2014-09-05 18:40:12 +00:00
module Handler.ProfileDelete where
import Import
import qualified Data.Text as T
import Data.Maybe
2014-12-07 06:55:03 +00:00
import qualified Data.List as L
2014-09-05 18:40:12 +00:00
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
2014-09-24 21:03:18 +00:00
setTitle "Eidolon :: Delete user profile"
2014-09-05 18:40:12 +00:00
$(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
2014-12-07 06:55:03 +00:00
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
2014-09-05 18:40:12 +00:00
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