condensed medium settings code. Albumowner can now delete media not owned by him

This commit is contained in:
nek0 2014-12-28 01:09:19 +01:00
parent fef737f957
commit 2060de1ad9
2 changed files with 67 additions and 131 deletions

View file

@ -1,56 +1,29 @@
module Handler.MediumSettings where
import Import
import Handler.Commons
import System.Directory
import System.FilePath
import Data.List (tail)
getMediumSettingsR :: MediumId -> Handler Html
getMediumSettingsR 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
album <- runDB $ getJust $ mediumAlbum medium
presence <- return (userId == ownerId)
albumOwnerPresence <- return (userId == (albumOwner album))
case presence || albumOwnerPresence of
True -> do
checkRes <- mediumCheck mediumId
case checkRes of
Right medium -> do
(mediumSettingsWidget, enctype) <- generateFormPost $ mediumSettingsForm medium
defaultLayout $ do
setTitle "Eidolon :: Medium Settings"
$(widgetFile "mediumSettings")
False -> do
setMessage "You must own this medium to change its settings"
redirect $ MediumR mediumId
Nothing -> do
setMessage "You must be logged in to change settings"
redirect $ LoginR
Nothing -> do
setMessage "This medium does not exist"
redirect $ HomeR
Left (errorMsg, route) -> do
setMessage errorMsg
redirect $ route
postMediumSettingsR :: MediumId -> Handler Html
postMediumSettingsR 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
album <- runDB $ getJust $ mediumAlbum medium
presence <- return (userId == ownerId)
albumOwnerPresence <- return (userId == (albumOwner album))
case presence || albumOwnerPresence of
True -> do
checkRes <- mediumCheck mediumId
case checkRes of
Right medium -> do
((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium
case result of
FormSuccess temp -> do
@ -64,15 +37,9 @@ postMediumSettingsR mediumId = do
_ -> do
setMessage "There was an error changing the settings"
redirect $ MediumSettingsR mediumId
False -> do
setMessage "You must own this medium to change its settings"
redirect $ MediumR mediumId
Nothing -> do
setMessage "You must be logged in to change settings"
redirect $ LoginR
Nothing -> do
setMessage "This medium does not exist"
redirect $ HomeR
Left (errorMsg, route) -> do
setMessage errorMsg
redirect $ route
mediumSettingsForm :: Medium -> Form Medium
mediumSettingsForm medium = renderDivs $ Medium
@ -88,45 +55,21 @@ mediumSettingsForm medium = renderDivs $ 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
checkRes <- mediumCheck mediumId
case checkRes of
Right medium -> do
defaultLayout $ do
setTitle "Eidolon :: Delete Medium"
$(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
Left (errorMsg, route) -> do
setMessage errorMsg
redirect $ route
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
checkRes <- mediumCheck mediumId
case checkRes of
Right medium -> do
confirm <- lookupPostParam "confirm"
case confirm of
Just "confirm" -> do
@ -148,12 +91,6 @@ postMediumDeleteR mediumId = do
_ -> 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
Left (errorMsg, route) -> do
setMessage errorMsg
redirect $ route

View file

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