media can now be deleted

This commit is contained in:
nek0 2014-08-30 21:19:41 +02:00
parent 8a15b7d71d
commit 2b5e1f7795
5 changed files with 79 additions and 1 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -0,0 +1,10 @@
$newline always
<h3>Delete Medium #{mediumTitle medium}
<p>
Do you wish to delete this image?
<form method="POST" action=@{MediumDeleteR mediumId}>
<label for="confirm">Really delete this medium
<input type="checkbox" id="confirm" name="confirm" value="confirm" required>
<input id="delete" type="submit" value="Delete medium">

View file

@ -6,3 +6,4 @@ $newline always
<div>
<input type=submit value="Change settings">
<a href=@{MediumDeleteR mediumId}>Delete this image