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

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