admin can now change media settings

This commit is contained in:
nek0 2014-09-09 04:25:47 +02:00
parent dfbc7b8e87
commit a20d32ff34
12 changed files with 221 additions and 2 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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