From 2060de1ad90414a58d2d620030fcd468fe9fdac3 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 28 Dec 2014 01:09:19 +0100 Subject: [PATCH] condensed medium settings code. Albumowner can now delete media not owned by him --- Handler/MediumSettings.hs | 195 +++++++++++--------------------- templates/mediumSettings.hamlet | 3 +- 2 files changed, 67 insertions(+), 131 deletions(-) diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index 92636f8..b1f2543 100644 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -1,78 +1,45 @@ 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 - (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 + checkRes <- mediumCheck mediumId + case checkRes of + Right medium -> do + (mediumSettingsWidget, enctype) <- generateFormPost $ mediumSettingsForm medium + defaultLayout $ do + setTitle "Eidolon :: Medium Settings" + $(widgetFile "mediumSettings") + 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 - ((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium - case result of - FormSuccess temp -> do - mId <- runDB $ update mediumId - [ MediumTitle =. mediumTitle temp - , MediumDescription =. mediumDescription temp - , MediumTags =. mediumTags temp - ] - setMessage "Medium settings changed succesfully" - redirect $ MediumR mediumId - _ -> 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 + checkRes <- mediumCheck mediumId + case checkRes of + Right medium -> do + ((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium + case result of + FormSuccess temp -> do + mId <- runDB $ update mediumId + [ MediumTitle =. mediumTitle temp + , MediumDescription =. mediumDescription temp + , MediumTags =. mediumTags temp + ] + setMessage "Medium settings changed succesfully" + redirect $ MediumR mediumId + _ -> do + setMessage "There was an error changing the settings" + redirect $ MediumSettingsR mediumId + Left (errorMsg, route) -> do + setMessage errorMsg + redirect $ route mediumSettingsForm :: Medium -> Form Medium mediumSettingsForm medium = renderDivs $ Medium @@ -88,72 +55,42 @@ 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 - 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 + checkRes <- mediumCheck mediumId + case checkRes of + Right medium -> do + defaultLayout $ do + setTitle "Eidolon :: Delete Medium" + $(widgetFile "mediumDelete") + 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 - confirm <- lookupPostParam "confirm" - case confirm of - Just "confirm" -> do - -- delete comments - commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] [] - mapM (\ent -> runDB $ delete $ entityKey ent) commEnts - -- delete references first - albumId <- return $ mediumAlbum medium - album <- runDB $ getJust albumId - mediaList <- return $ albumContent album - newMediaList <- return $ removeItem mediumId mediaList - -- update reference List - runDB $ update albumId [AlbumContent =. newMediaList] - liftIO $ removeFile (normalise $ tail $ mediumPath medium) - liftIO $ removeFile (normalise $ tail $ mediumThumb 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 + checkRes <- mediumCheck mediumId + case checkRes of + Right medium -> do + confirm <- lookupPostParam "confirm" + case confirm of + Just "confirm" -> do + -- delete comments + commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] [] + mapM (\ent -> runDB $ delete $ entityKey ent) commEnts + -- delete references first + albumId <- return $ mediumAlbum medium + album <- runDB $ getJust albumId + mediaList <- return $ albumContent album + newMediaList <- return $ removeItem mediumId mediaList + -- update reference List + runDB $ update albumId [AlbumContent =. newMediaList] + liftIO $ removeFile (normalise $ tail $ mediumPath medium) + liftIO $ removeFile (normalise $ tail $ mediumThumb medium) + runDB $ delete mediumId + setMessage "Medium succesfully deleted" + redirect $ HomeR + _ -> do + setMessage "You must confirm the deletion" + redirect $ MediumSettingsR mediumId + Left (errorMsg, route) -> do + setMessage errorMsg + redirect $ route diff --git a/templates/mediumSettings.hamlet b/templates/mediumSettings.hamlet index f8e7fd4..ec9989c 100644 --- a/templates/mediumSettings.hamlet +++ b/templates/mediumSettings.hamlet @@ -6,5 +6,4 @@ $newline always
-$if presence == True - Delete this image +Delete this image