diff --git a/Handler/AlbumSettings.hs b/Handler/AlbumSettings.hs index b682117..6480eeb 100644 --- a/Handler/AlbumSettings.hs +++ b/Handler/AlbumSettings.hs @@ -133,7 +133,10 @@ postAlbumDeleteR albumId = do liftIO $ removeDirectoryRecursive $ "static" "data" (T.unpack $ extractKey userId) (T.unpack $ extractKey albumId) setMessage "Album deleted succesfully" redirect $ HomeR - False -> do + _ -> do + setMessage "You must confirm the deletion" + redirect $ AlbumSettingsR albumId + _ -> do setMessage "You must own this album to delete it" redirect $ AlbumR albumId Nothing -> do diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index 026557c..b29402e 100644 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -1,6 +1,9 @@ module Handler.MediumSettings where import Import +import System.Directory +import System.FilePath +import Data.List (tail) getMediumSettingsR :: MediumId -> Handler Html getMediumSettingsR mediumId = do @@ -75,3 +78,63 @@ mediumSettingsForm medium = renderDivs $ Medium <*> areq textareaField "Description" (Just $ mediumDescription medium) <*> areq tagField "tags" (Just $ mediumTags medium) <*> pure (mediumAlbum medium) + +getMediumDeleteR :: MediumId -> Handler Html +getMediumDeleteR mediumId = do + tempMedium <- runDB $ get mediumId + case tempMedium of + Just medium -> do + ownerId <- return $ mediumOwner medium + owner <- runDB $ getJust ownerId + msu <- lookupSession "userId" + case msu of + Just tempUserId -> do + userId <- return $ getUserIdFromText tempUserId + presence <- return (userId == ownerId) + case presence of + True -> do + defaultLayout $ do + $(widgetFile "mediumDelete") + False -> do + setMessage "You must own this medium to delete it" + redirect $ MediumR mediumId + Nothing -> do + setMessage "You must be logged in to delete media" + redirect $ LoginR + Nothing -> do + setMessage "This Medium does not exist" + redirect $ HomeR + +postMediumDeleteR :: MediumId -> Handler Html +postMediumDeleteR mediumId = do + tempMedium <- runDB $ get mediumId + case tempMedium of + Just medium -> do + ownerId <- return $ mediumOwner medium + owner <- runDB $ getJust ownerId + msu <- lookupSession "userId" + case msu of + Just tempUserId -> do + userId <- return $ getUserIdFromText tempUserId + presence <- return (userId == ownerId) + case presence of + True -> do + confirm <- lookupPostParam "confirm" + case confirm of + Just "confirm" -> do + liftIO $ removeFile (normalise $ tail $ mediumPath medium) + runDB $ delete mediumId + setMessage "Medium succesfully deleted" + redirect $ HomeR + _ -> do + setMessage "You must confirm the deletion" + redirect $ MediumSettingsR mediumId + False -> do + setMessage "You must own this medium to delete it" + redirect $ MediumR mediumId + Nothing -> do + setMessage "You must be logged in to delete media" + redirect $ LoginR + Nothing -> do + setMessage "This Medium does not exist" + redirect $ HomeR diff --git a/config/routes b/config/routes index 23c00a4..3b42dde 100644 --- a/config/routes +++ b/config/routes @@ -18,3 +18,4 @@ /album/#AlbumId/settings AlbumSettingsR GET POST /album/#AlbumId/delete AlbumDeleteR GET POST /medium/#MediumId/settings MediumSettingsR GET POST +/medium/#MediumId/delete MediumDeleteR GET POST diff --git a/templates/mediumDelete.hamlet b/templates/mediumDelete.hamlet new file mode 100644 index 0000000..31d76ee --- /dev/null +++ b/templates/mediumDelete.hamlet @@ -0,0 +1,10 @@ +$newline always +

Delete Medium #{mediumTitle medium} + +

+ Do you wish to delete this image? + +

+