From a20d32ff34c1588d478b6db7eebedcc695ccf5ee Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 9 Sep 2014 04:25:47 +0200 Subject: [PATCH] admin can now change media settings --- Application.hs | 1 + Handler/AdminAlbumSettings.hs | 25 +++++ Handler/AdminMediumSettings.hs | 130 ++++++++++++++++++++++++++ Handler/AdminProfileSettings.hs | 25 +++++ config/routes | 5 + eidolon.cabal | 1 + templates/adminBase.hamlet | 2 + templates/adminMedia.hamlet | 10 ++ templates/adminMediumSet.cassius | 10 ++ templates/adminMediumSet.hamlet | 10 ++ templates/adminProfileSettings.hamlet | 2 +- templates/adminUserAlbums.hamlet | 2 +- 12 files changed, 221 insertions(+), 2 deletions(-) create mode 100644 Handler/AdminMediumSettings.hs create mode 100644 templates/adminMedia.hamlet create mode 100644 templates/adminMediumSet.cassius create mode 100644 templates/adminMediumSet.hamlet diff --git a/Application.hs b/Application.hs index be31137..e3e25b5 100644 --- a/Application.hs +++ b/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 diff --git a/Handler/AdminAlbumSettings.hs b/Handler/AdminAlbumSettings.hs index cea6413..368e788 100644 --- a/Handler/AdminAlbumSettings.hs +++ b/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" diff --git a/Handler/AdminMediumSettings.hs b/Handler/AdminMediumSettings.hs new file mode 100644 index 0000000..4fa936f --- /dev/null +++ b/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 diff --git a/Handler/AdminProfileSettings.hs b/Handler/AdminProfileSettings.hs index 5b435d8..fcca07c 100644 --- a/Handler/AdminProfileSettings.hs +++ b/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" diff --git a/config/routes b/config/routes index 7ee5260..876bef6 100644 --- a/config/routes +++ b/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 diff --git a/eidolon.cabal b/eidolon.cabal index 50d5fa8..ab84d61 100644 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -37,6 +37,7 @@ library Handler.Admin Handler.AdminProfileSettings Handler.AdminAlbumSettings + Handler.AdminMediumSettings if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT diff --git a/templates/adminBase.hamlet b/templates/adminBase.hamlet index c7a394c..f7b227c 100644 --- a/templates/adminBase.hamlet +++ b/templates/adminBase.hamlet @@ -9,3 +9,5 @@ $newline always User profiles
  • Albums +
  • + Media diff --git a/templates/adminMedia.hamlet b/templates/adminMedia.hamlet new file mode 100644 index 0000000..ef6cdf6 --- /dev/null +++ b/templates/adminMedia.hamlet @@ -0,0 +1,10 @@ +$newline always +

    Media + +$if null media + There are no media yet +$else + $forall (Entity mId m) <- media +