condensed medium settings code. Albumowner can now delete media not owned by him
This commit is contained in:
parent
fef737f957
commit
2060de1ad9
2 changed files with 67 additions and 131 deletions
|
@ -1,56 +1,29 @@
|
||||||
module Handler.MediumSettings where
|
module Handler.MediumSettings where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
import Handler.Commons
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Data.List (tail)
|
import Data.List (tail)
|
||||||
|
|
||||||
getMediumSettingsR :: MediumId -> Handler Html
|
getMediumSettingsR :: MediumId -> Handler Html
|
||||||
getMediumSettingsR mediumId = do
|
getMediumSettingsR mediumId = do
|
||||||
tempMedium <- runDB $ get mediumId
|
checkRes <- mediumCheck mediumId
|
||||||
case tempMedium of
|
case checkRes of
|
||||||
Just medium -> do
|
Right 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
|
|
||||||
(mediumSettingsWidget, enctype) <- generateFormPost $ mediumSettingsForm medium
|
(mediumSettingsWidget, enctype) <- generateFormPost $ mediumSettingsForm medium
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle "Eidolon :: Medium Settings"
|
setTitle "Eidolon :: Medium Settings"
|
||||||
$(widgetFile "mediumSettings")
|
$(widgetFile "mediumSettings")
|
||||||
False -> do
|
Left (errorMsg, route) -> do
|
||||||
setMessage "You must own this medium to change its settings"
|
setMessage errorMsg
|
||||||
redirect $ MediumR mediumId
|
redirect $ route
|
||||||
Nothing -> do
|
|
||||||
setMessage "You must be logged in to change settings"
|
|
||||||
redirect $ LoginR
|
|
||||||
Nothing -> do
|
|
||||||
setMessage "This medium does not exist"
|
|
||||||
redirect $ HomeR
|
|
||||||
|
|
||||||
postMediumSettingsR :: MediumId -> Handler Html
|
postMediumSettingsR :: MediumId -> Handler Html
|
||||||
postMediumSettingsR mediumId = do
|
postMediumSettingsR mediumId = do
|
||||||
tempMedium <- runDB $ get mediumId
|
checkRes <- mediumCheck mediumId
|
||||||
case tempMedium of
|
case checkRes of
|
||||||
Just medium -> do
|
Right 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
|
|
||||||
((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium
|
((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium
|
||||||
case result of
|
case result of
|
||||||
FormSuccess temp -> do
|
FormSuccess temp -> do
|
||||||
|
@ -64,15 +37,9 @@ postMediumSettingsR mediumId = do
|
||||||
_ -> do
|
_ -> do
|
||||||
setMessage "There was an error changing the settings"
|
setMessage "There was an error changing the settings"
|
||||||
redirect $ MediumSettingsR mediumId
|
redirect $ MediumSettingsR mediumId
|
||||||
False -> do
|
Left (errorMsg, route) -> do
|
||||||
setMessage "You must own this medium to change its settings"
|
setMessage errorMsg
|
||||||
redirect $ MediumR mediumId
|
redirect $ route
|
||||||
Nothing -> do
|
|
||||||
setMessage "You must be logged in to change settings"
|
|
||||||
redirect $ LoginR
|
|
||||||
Nothing -> do
|
|
||||||
setMessage "This medium does not exist"
|
|
||||||
redirect $ HomeR
|
|
||||||
|
|
||||||
mediumSettingsForm :: Medium -> Form Medium
|
mediumSettingsForm :: Medium -> Form Medium
|
||||||
mediumSettingsForm medium = renderDivs $ Medium
|
mediumSettingsForm medium = renderDivs $ Medium
|
||||||
|
@ -88,45 +55,21 @@ mediumSettingsForm medium = renderDivs $ Medium
|
||||||
|
|
||||||
getMediumDeleteR :: MediumId -> Handler Html
|
getMediumDeleteR :: MediumId -> Handler Html
|
||||||
getMediumDeleteR mediumId = do
|
getMediumDeleteR mediumId = do
|
||||||
tempMedium <- runDB $ get mediumId
|
checkRes <- mediumCheck mediumId
|
||||||
case tempMedium of
|
case checkRes of
|
||||||
Just medium -> do
|
Right 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
|
defaultLayout $ do
|
||||||
setTitle "Eidolon :: Delete Medium"
|
setTitle "Eidolon :: Delete Medium"
|
||||||
$(widgetFile "mediumDelete")
|
$(widgetFile "mediumDelete")
|
||||||
False -> do
|
Left (errorMsg, route) -> do
|
||||||
setMessage "You must own this medium to delete it"
|
setMessage errorMsg
|
||||||
redirect $ MediumR mediumId
|
redirect $ route
|
||||||
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 -> Handler Html
|
||||||
postMediumDeleteR mediumId = do
|
postMediumDeleteR mediumId = do
|
||||||
tempMedium <- runDB $ get mediumId
|
checkRes <- mediumCheck mediumId
|
||||||
case tempMedium of
|
case checkRes of
|
||||||
Just medium -> do
|
Right 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"
|
confirm <- lookupPostParam "confirm"
|
||||||
case confirm of
|
case confirm of
|
||||||
Just "confirm" -> do
|
Just "confirm" -> do
|
||||||
|
@ -148,12 +91,6 @@ postMediumDeleteR mediumId = do
|
||||||
_ -> do
|
_ -> do
|
||||||
setMessage "You must confirm the deletion"
|
setMessage "You must confirm the deletion"
|
||||||
redirect $ MediumSettingsR mediumId
|
redirect $ MediumSettingsR mediumId
|
||||||
False -> do
|
Left (errorMsg, route) -> do
|
||||||
setMessage "You must own this medium to delete it"
|
setMessage errorMsg
|
||||||
redirect $ MediumR mediumId
|
redirect $ route
|
||||||
Nothing -> do
|
|
||||||
setMessage "You must be logged in to delete media"
|
|
||||||
redirect $ LoginR
|
|
||||||
Nothing -> do
|
|
||||||
setMessage "This Medium does not exist"
|
|
||||||
redirect $ HomeR
|
|
||||||
|
|
|
@ -6,5 +6,4 @@ $newline always
|
||||||
<div>
|
<div>
|
||||||
<input type=submit value="Change settings">
|
<input type=submit value="Change settings">
|
||||||
|
|
||||||
$if presence == True
|
|
||||||
<a href=@{MediumDeleteR mediumId}>Delete this image
|
<a href=@{MediumDeleteR mediumId}>Delete this image
|
||||||
|
|
Loading…
Reference in a new issue