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

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
+  checkRes <- mediumCheck mediumId
-  case tempMedium of
+  case checkRes of
-    Just medium -> do
+    Right medium -> do
-      ownerId <- return $ mediumOwner medium
+      (mediumSettingsWidget, enctype) <- generateFormPost $ mediumSettingsForm medium
-      owner <- runDB $ getJust ownerId
+      defaultLayout $ do
-      msu <- lookupSession "userId"
+        setTitle "Eidolon :: Medium Settings"
-      case msu of
+        $(widgetFile "mediumSettings")
-        Just tempUserId -> do
+    Left (errorMsg, route) -> do
-          userId <- return $ getUserIdFromText tempUserId
+      setMessage errorMsg
-          album <- runDB $ getJust $ mediumAlbum medium
+      redirect $ route
-          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
 
 postMediumSettingsR :: MediumId -> Handler Html
 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
+      ((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium
-      owner <- runDB $ getJust ownerId
+      case result of
-      msu <- lookupSession "userId"
+        FormSuccess temp -> do
-      case msu of
+          mId <- runDB $ update mediumId
-        Just tempUserId -> do
+            [ MediumTitle =. mediumTitle temp
-          userId <- return $ getUserIdFromText tempUserId
+            , MediumDescription =. mediumDescription temp
-          album <- runDB $ getJust $ mediumAlbum medium
+            , MediumTags =. mediumTags temp
-          presence <- return (userId == ownerId)
+            ]
-          albumOwnerPresence <- return (userId == (albumOwner album))
+          setMessage "Medium settings changed succesfully"
-          case presence || albumOwnerPresence of
+          redirect $ MediumR mediumId
-            True -> do
+        _ -> do
-              ((result, mediumSettingsWidget), enctype) <- runFormPost $ mediumSettingsForm medium
+          setMessage "There was an error changing the settings"
-              case result of
+          redirect $ MediumSettingsR mediumId
-                FormSuccess temp -> do
+    Left (errorMsg, route) -> do
-                  mId <- runDB $ update mediumId
+      setMessage errorMsg
-                    [ MediumTitle =. mediumTitle temp
+      redirect $ route
-                    , 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
 
 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
+  checkRes <- mediumCheck mediumId
-  case tempMedium of
+  case checkRes of
-    Just medium -> do
+    Right medium -> do
-      ownerId <- return $ mediumOwner medium
+      defaultLayout $ do
-      owner <- runDB $ getJust ownerId
+        setTitle "Eidolon :: Delete Medium"
-      msu <- lookupSession "userId"
+        $(widgetFile "mediumDelete")
-      case msu of
+    Left (errorMsg, route) -> do
-        Just tempUserId -> do
+      setMessage errorMsg
-          userId <- return $ getUserIdFromText tempUserId
+      redirect $ route
-          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
 
 postMediumDeleteR :: MediumId -> Handler Html
 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
+      confirm <- lookupPostParam "confirm"
-      owner <- runDB $ getJust ownerId
+      case confirm of
-      msu <- lookupSession "userId"
+        Just "confirm" -> do
-      case msu of
+          -- delete comments
-        Just tempUserId -> do
+          commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
-          userId <- return $ getUserIdFromText tempUserId
+          mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
-          presence <- return (userId == ownerId)
+          -- delete references first
-          case presence of
+          albumId <- return $ mediumAlbum medium
-            True -> do
+          album <- runDB $ getJust albumId
-              confirm <- lookupPostParam "confirm"
+          mediaList <- return $ albumContent album
-              case confirm of
+          newMediaList <- return $ removeItem mediumId mediaList
-                Just "confirm" -> do
+          -- update reference List
-                  -- delete comments
+          runDB $ update albumId [AlbumContent =. newMediaList]
-                  commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
+          liftIO $ removeFile (normalise $ tail $ mediumPath medium)
-                  mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
+          liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
-                  -- delete references first
+          runDB $ delete mediumId
-                  albumId <- return $ mediumAlbum medium
+          setMessage "Medium succesfully deleted"
-                  album <- runDB $ getJust albumId
+          redirect $ HomeR
-                  mediaList <- return $ albumContent album
+        _ -> do
-                  newMediaList <- return $ removeItem mediumId mediaList
+          setMessage "You must confirm the deletion"
-                  -- update reference List
+          redirect $ MediumSettingsR mediumId
-                  runDB $ update albumId [AlbumContent =. newMediaList]
+    Left (errorMsg, route) -> do
-                  liftIO $ removeFile (normalise $ tail $ mediumPath medium)
+      setMessage errorMsg
-                  liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
+      redirect $ route
-                  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

templates/mediumSettings.hamlet

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