admin can now change media settings

Application.hs

@@ -44,6 +44,7 @@ import Handler.ProfileDelete
 import Handler.Admin
 import Handler.AdminProfileSettings
 import Handler.AdminAlbumSettings
+import Handler.AdminMediumSettings
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

Handler/AdminAlbumSettings.hs

@@ -24,6 +24,31 @@ getAdminAlbumsR = do
       setMessage "You must be logged in"
       redirect $ LoginR
 
+getAdminAlbumMediaR :: AlbumId -> Handler Html
+getAdminAlbumMediaR albumId = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          tempAlbum <- runDB $ get albumId
+          case tempAlbum of
+            Just album -> do
+              media <- runDB $ selectList [MediumAlbum ==. albumId] [Desc MediumTitle]
+              defaultLayout $ do
+                $(widgetFile "adminAlbumMedia")
+            Nothing -> do
+              setMessage "This album does not exist"
+              redirect $ AdminR
+        False -> do
+          setMessage "You are no admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You must be logged in"
+      redirect $ LoginR
+
 getAdminAlbumSettingsR :: AlbumId -> Handler Html
 getAdminAlbumSettingsR albumId = do
   msu <- lookupSession "userId"

Handler/AdminMediumSettings.hs

@@ -0,0 +1,130 @@
+module Handler.AdminMediumSettings where
+
+import Import
+import System.FilePath
+import System.Directory
+import Data.List (tail)
+
+getAdminMediaR :: Handler Html
+getAdminMediaR = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          media <- runDB $ selectList [] [Desc MediumTitle]
+          defaultLayout $ do
+            $(widgetFile "adminMedia")
+        False -> do
+          setMessage "You are no admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You must be logged in"
+      redirect $ LoginR
+
+getAdminMediumSettingsR :: MediumId -> Handler Html
+getAdminMediumSettingsR mediumId = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          tempMedium <- runDB $ get mediumId
+          case tempMedium of
+            Just medium -> do
+              (adminMediumSetWidget, enctype) <- generateFormPost $ adminMediumSetForm medium
+              defaultLayout $ do
+                $(widgetFile "adminMediumSet")
+            Nothing -> do
+              setMessage "This medium does not exist"
+              redirect $ AdminR
+        False -> do
+          setMessage "You are no admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You must be logged in"
+      redirect $ LoginR
+
+postAdminMediumSettingsR :: MediumId -> Handler Html
+postAdminMediumSettingsR mediumId = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          tempMedium <- runDB $ get mediumId
+          case tempMedium of
+            Just medium -> do
+              ((res, adminMediumSetWidget), enctype) <- runFormPost $ adminMediumSetForm medium
+              case res of
+                FormSuccess temp -> do
+                  runDB $ update mediumId
+                    [ MediumTitle =. mediumTitle temp
+                    , MediumDescription =. mediumDescription temp
+                    , MediumTags =. mediumTags temp
+                    ]
+                  setMessage "Medium settings changed successfully"
+                  redirect $ AdminR
+                _ -> do
+                  setMessage "There was an error while changing the settings"
+                  redirect $ AdminMediumSettingsR mediumId
+            Nothing -> do
+              setMessage "This medium does not exist"
+              redirect $ AdminR
+        False -> do
+          setMessage "You are no admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You must be logged in"
+      redirect $ LoginR
+
+adminMediumSetForm :: Medium -> Form Medium
+adminMediumSetForm medium = renderDivs $ Medium
+  <$> areq textField "Title" (Just $ mediumTitle medium)
+  <*> pure (mediumPath medium)
+  <*> pure (mediumTime medium)
+  <*> pure (mediumOwner medium)
+  <*> areq textareaField "Description" (Just $ mediumDescription medium)
+  <*> areq tagField "Tags" (Just $ mediumTags medium)
+  <*> pure (mediumAlbum medium)
+
+getAdminMediumDeleteR :: MediumId -> Handler Html
+getAdminMediumDeleteR mediumId = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          tempMedium <- runDB $ get mediumId
+          case tempMedium of
+            Just medium -> do
+              -- remove reference from album
+              albumId <- return $ mediumAlbum medium
+              album <- runDB $ getJust albumId
+              mediaList <- return $ albumContent album
+              newMediaList <- return $ removeItem mediumId mediaList
+              runDB $ update albumId [AlbumContent =. newMediaList]
+              -- delete medium
+              runDB $ delete mediumId
+              -- delete file
+              liftIO $ removeFile (normalise $ tail $ mediumPath medium)
+              -- outro
+              setMessage "Medium deleted successfully"
+              redirect $ AdminR
+            Nothing -> do
+              setMessage "This medium does not exist"
+              redirect $ AdminR
+        False -> do
+          setMessage "You are no admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You must be logged in"
+      redirect $ LoginR

Handler/AdminProfileSettings.hs

@@ -49,6 +49,31 @@ getAdminUserAlbumsR ownerId = do
       setMessage "You must be logged in"
       redirect $ LoginR
 
+getAdminUserMediaR :: UserId -> Handler Html
+getAdminUserMediaR ownerId = do
+  msu <- lookupSession "userId"
+  case msu of
+    Just tempUserId -> do
+      userId <- return $ getUserIdFromText tempUserId
+      user <- runDB $ getJust userId
+      case userAdmin user of
+        True -> do
+          tempOwner <- runDB $ get ownerId
+          case tempOwner of
+            Just owner -> do
+              media <- runDB $ selectList [MediumOwner ==. ownerId] [Desc MediumTitle]
+              defaultLayout $ do
+                $(widgetFile "adminUserMedia")
+            Nothing -> do
+              setMessage "This user does not exist"
+              redirect $ AdminR
+        False -> do
+          setMessage "You are no admin"
+          redirect $ HomeR
+    Nothing -> do
+      setMessage "You must be logged in"
+      redirect $ LoginR
+
 getAdminProfileSettingsR :: UserId -> Handler Html
 getAdminProfileSettingsR ownerId = do
   msu <- lookupSession "userId"

config/routes

@@ -22,11 +22,16 @@
 /reactivate			ReactivateR		GET POST
 /profile/#UserId/settings	ProfileSettingsR	GET POST
 /profile/#UserId/delete		ProfileDeleteR		GET POST
+
 /admin				AdminR			GET
 /admin/profile			AdminProfilesR		GET
 /admin/profile/#UserId		AdminProfileSettingsR	GET POST
 /admin/profile/#UserId/albums	AdminUserAlbumsR	GET
+/admin/profile/#UserId/media	AdminUserMediaR		GET
 /admin/profile/#UserId/delete	AdminProfileDeleteR	GET
 /admin/album			AdminAlbumsR		GET
 /admin/album/#AlbumId		AdminAlbumSettingsR	GET POST
 /admin/album/#AlbumId/delete	AdminAlbumDeleteR	GET
+/admin/medium			AdminMediaR		GET
+/admin/medium/#MediumId		AdminMediumSettingsR	GET POST
+/admin/meidum/#MediumId/delete	AdminMediumDeleteR	GET

eidolon.cabal

@@ -37,6 +37,7 @@ library
                      Handler.Admin
                      Handler.AdminProfileSettings
                      Handler.AdminAlbumSettings
+                     Handler.AdminMediumSettings
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT

templates/adminBase.hamlet

@@ -9,3 +9,5 @@ $newline always
     <a href=@{AdminProfilesR}>User profiles
   <li>
     <a href=@{AdminAlbumsR}>Albums
+  <li>
+    <a href=@{AdminMediaR}>Media

templates/adminMedia.hamlet

@@ -0,0 +1,10 @@
+$newline always
+<h3>Media
+
+$if null media
+  There are no media yet
+$else
+  $forall (Entity mId m) <- media
+    <ul>
+      <li>
+        <a href=@{AdminMediumSettingsR mId}>#{mediumTitle m}

templates/adminMediumSet.cassius

@@ -0,0 +1,10 @@
+.right
+  float:right
+  width:50%
+
+.left
+  float:left
+  width:50%
+
+footer
+  clear:both

templates/adminMediumSet.hamlet

@@ -0,0 +1,10 @@
+$newline always
+<h3>Meddium settings
+
+<div class="left">
+  <form method="post" enctype=#{enctype}>
+    ^{adminMediumSetWidget}
+    <div>
+      <input type=submit value="Change settings">
+
+  <a href=@{AdminMediumDeleteR mediumId}>Delete this medium

templates/adminProfileSettings.hamlet

@@ -14,4 +14,4 @@ $newline always
     <li>
       <a href=@{AdminUserAlbumsR ownerId}>Albums of this user
     <li>
-      Media of this user
+      <a href=@{AdminUserMediaR ownerId}>Media of this user

templates/adminUserAlbums.hamlet

@@ -2,7 +2,7 @@ $newline always
 <h3>Albums of #{userSlug owner}
 
 $if null albums
-  There are no albums yet
+  #{userSlug owner} has no albums yet
 $else
   $forall (Entity aId a) <- albums
     <ul>