eidolon/Handler/ProfileDelete.hs

81 lines
3.1 KiB
Haskell
Raw Normal View History

2015-01-18 19:44:41 +00:00
-- eidolon -- A simple gallery in Haskell and Yesod
-- Copyright (C) 2015 Amedeo Molnár
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
2015-01-21 09:00:18 +00:00
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
2015-01-18 19:44:41 +00:00
2014-09-05 18:40:12 +00:00
module Handler.ProfileDelete where
import Import
2014-12-28 00:08:35 +00:00
import Handler.Commons
2015-09-14 16:54:46 +00:00
import Control.Monad (when)
2014-09-05 18:40:12 +00:00
import qualified Data.Text as T
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
2014-12-27 23:01:40 +00:00
checkRes <- profileCheck userId
case checkRes of
2015-09-14 16:54:46 +00:00
Right user ->
2016-09-07 15:32:56 +00:00
defaultLayout $ do
2014-12-27 23:01:40 +00:00
setTitle "Eidolon :: Delete user profile"
$(widgetFile "profileDelete")
Left (errorMsg, route) -> do
setMessage errorMsg
2015-09-14 16:54:46 +00:00
redirect route
2014-09-05 18:40:12 +00:00
postProfileDeleteR :: UserId -> Handler Html
postProfileDeleteR userId = do
2014-12-27 23:01:40 +00:00
checkRes <- profileCheck userId
case checkRes of
Right user -> do
confirm <- lookupPostParam "confirm"
case confirm of
Just "confirm" -> do
2015-09-14 16:54:46 +00:00
let albumList = userAlbums user
2014-12-28 06:12:25 +00:00
_ <- mapM (\albumId -> do
2014-12-27 23:01:40 +00:00
album <- runDB $ getJust albumId
2015-09-14 16:54:46 +00:00
when (albumOwner album == userId) $ do
let mediaList = albumContent album
_ <- mapM (\med -> do
commEnts <- runDB $ selectList [CommentOrigin ==. med] []
_ <- mapM (\ent -> do
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
_ <- mapM (\child -> do
-- delete comment children
runDB $ delete $ entityKey child
) children
-- delete comment
runDB $ delete $ entityKey ent) commEnts
2015-09-14 16:54:46 +00:00
medium <- runDB $ getJust med
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
2016-05-04 00:26:48 +00:00
liftIO $ removeFile (normalise $ L.tail $ mediumPreview medium)
2015-09-14 16:54:46 +00:00
runDB $ delete med
) mediaList
runDB $ delete albumId
2014-12-27 23:01:40 +00:00
) albumList
runDB $ delete userId
2015-09-14 16:54:46 +00:00
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey userId)
2014-12-27 23:01:40 +00:00
deleteSession "userId"
setMessage "User deleted successfully"
2015-09-14 16:54:46 +00:00
redirect HomeR
2014-12-27 23:01:40 +00:00
_ -> do
setMessage "You must confirm the deletion"
redirect $ ProfileSettingsR userId
Left (errorMsg, route) -> do
setMessage errorMsg
2015-09-14 16:54:46 +00:00
redirect route