From f5f2ac336d6a5f2f5f3881708b3bb2c603ba0f13 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 6 Sep 2014 08:56:36 +0200 Subject: [PATCH] admin interface added incl. profilemanipulation --- Application.hs | 2 + Handler/Admin.hs | 21 ++++ Handler/AdminProfileSettings.hs | 132 ++++++++++++++++++++++++++ Handler/ProfileSettings.hs | 1 + Handler/Signup.hs | 8 +- Import.hs | 1 + Model.hs | 1 + config/models | 1 + config/routes | 4 + eidolon.cabal | 2 + templates/adminBase.hamlet | 5 + templates/adminProfileSettings.hamlet | 9 ++ templates/adminProfiles.hamlet | 10 ++ 13 files changed, 196 insertions(+), 1 deletion(-) create mode 100644 Handler/Admin.hs create mode 100644 Handler/AdminProfileSettings.hs create mode 100644 templates/adminBase.hamlet create mode 100644 templates/adminProfileSettings.hamlet create mode 100644 templates/adminProfiles.hamlet diff --git a/Application.hs b/Application.hs index 2aac568..75fc564 100644 --- a/Application.hs +++ b/Application.hs @@ -41,6 +41,8 @@ import Handler.MediumSettings import Handler.Reactivate import Handler.ProfileSettings import Handler.ProfileDelete +import Handler.Admin +import Handler.AdminProfileSettings -- 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/Admin.hs b/Handler/Admin.hs new file mode 100644 index 0000000..35d4cb6 --- /dev/null +++ b/Handler/Admin.hs @@ -0,0 +1,21 @@ +module Handler.Admin where + +import Import + +getAdminR :: Handler Html +getAdminR = do + msu <- lookupSession "userId" + case msu of + Just tempUserId -> do + userId <- return $ getUserIdFromText tempUserId + user <- runDB $ getJust userId + case userAdmin user of + True -> do + defaultLayout $ do + $(widgetFile "adminBase") + False -> do + setMessage "You have no admin rights" + redirect $ HomeR + Nothing -> do + setMessage "You are not logged in" + redirect $ LoginR diff --git a/Handler/AdminProfileSettings.hs b/Handler/AdminProfileSettings.hs new file mode 100644 index 0000000..3cf80e7 --- /dev/null +++ b/Handler/AdminProfileSettings.hs @@ -0,0 +1,132 @@ +module Handler.AdminProfileSettings where + +import Import +import qualified Data.Text as T +import System.Directory +import System.FilePath + +getAdminProfiles :: Handler Html +getAdminProfiles = do + msu <- lookupSession "userId" + case msu of + Just tempUserId -> do + userId <- return $ getUserIdFromText tempUserId + user <- runDB $ getJust userId + case userAdmin user of + True -> do + profiles <- runDB $ selectList [] [Desc UserName] + defaultLayout $ do + $(widgetFile "adminProfiles") + 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" + 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 + (adminProfileSetWidget, enctype) <- generateFormPost $ adminProfileForm owner + defaultLayout $ do + $(widgetFile "adminProfileSettings") + Nothing -> do + setMessage "This user does not exist" + redirect $ AdminR + False -> do + setMessage "You are not an admin" + redirect $ HomeR + Nothing -> do + setMessage "You are not logged in" + redirect $ LoginR + + +postAdminProfileSettingsR :: UserId -> Handler Html +postAdminProfileSettingsR 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 + ((result, adminProfileSetWidget), enctype) <- runFormPost $ adminProfileForm owner + case result of + FormSuccess temp -> do + runDB $ update ownerId + [ UserName =. (userName temp) + , UserSlug =. (userSlug temp) + , UserEmail =. (userEmail temp) + , UserAdmin =. (userAdmin temp) + ] + setMessage "User data updated successfully" + redirect $ AdminR + _ -> do + setMessage "There was an error" + redirect $ AdminProfileSettingsR ownerId + Nothing -> do + setMessage "This user does not exist" + redirect $ AdminR + False -> do + setMessage "You are not an admin" + redirect $ HomeR + Nothing -> do + setMessage "You are not logged in" + redirect $ LoginR + + +adminProfileForm :: User -> Form User +adminProfileForm owner = renderDivs $ User + <$> areq textField "Username" (Just $ userName owner) + <*> areq textField "Userslug" (Just $ userSlug owner) + <*> areq emailField "Email" (Just $ userEmail owner) + <*> pure (userSalt owner) + <*> pure (userSalted owner) + <*> pure (userAlbums owner) + <*> areq boolField "Admin" (Just $ userAdmin owner) + +getAdminProfileDeleteR :: UserId -> Handler Html +getAdminProfileDeleteR 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 + albumList <- return $ userAlbums owner + mapM (\albumId -> do + album <- runDB $ getJust albumId + mediaList <- return $ albumContent album + mapM (\med -> runDB $ delete med) mediaList + runDB $ delete albumId + ) albumList + runDB $ delete ownerId + liftIO $ removeDirectoryRecursive $ "static" "data" (T.unpack $ extractKey ownerId) + setMessage "User successfully deleted" + redirect $ AdminR + 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 diff --git a/Handler/ProfileSettings.hs b/Handler/ProfileSettings.hs index f8a0af7..55db4a5 100644 --- a/Handler/ProfileSettings.hs +++ b/Handler/ProfileSettings.hs @@ -71,3 +71,4 @@ profileSettingsForm user = renderDivs $ User <*> pure (userSalt user) <*> pure (userSalted user) <*> pure (userAlbums user) + <*> pure (userAdmin user) diff --git a/Handler/Signup.hs b/Handler/Signup.hs index bba8a91..7dcc42e 100644 --- a/Handler/Signup.hs +++ b/Handler/Signup.hs @@ -39,7 +39,13 @@ postSignupR = do case namesakes of [] -> do salt <- liftIO generateSalt - newUser <- return $ User newUserName newUserName (fromJust mEmail) salt "" [] + newUser <- return $ User newUserName + newUserName + (fromJust mEmail) + salt + "" + [] + False activatorText <- liftIO generateString aId <- runDB $ insert $ Activator activatorText newUser tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing diff --git a/Import.hs b/Import.hs index a9d6118..2ffdd4b 100644 --- a/Import.hs +++ b/Import.hs @@ -18,6 +18,7 @@ import Settings.StaticFiles as Import -- custom imports import Helper as Import +import Data.Bool as Import -- end custom imports diff --git a/Model.hs b/Model.hs index 72fc004..c288679 100644 --- a/Model.hs +++ b/Model.hs @@ -6,6 +6,7 @@ import Database.Persist.Quasi import Data.Typeable (Typeable) import Data.Time (UTCTime) import Data.ByteString +import Data.Bool import System.FilePath (FilePath) -- You can define all of your database entities in the entities file. diff --git a/config/models b/config/models index 77aa1ea..b0fb82e 100644 --- a/config/models +++ b/config/models @@ -5,6 +5,7 @@ User salt ByteString salted ByteString albums [AlbumId] + admin Bool deriving Typeable Activator token Text diff --git a/config/routes b/config/routes index 0362a4c..84c0d65 100644 --- a/config/routes +++ b/config/routes @@ -22,3 +22,7 @@ /reactivate ReactivateR GET POST /profile/#UserId/settings ProfileSettingsR GET POST /profile/#UserId/delete ProfileDeleteR GET POST +/admin AdminR GET +/admin/profile AdminProfiles GET +/admin/profile/#UserId AdminProfileSettingsR GET POST +/admin/profile/#UserId/delete AdminProfileDeleteR GET diff --git a/eidolon.cabal b/eidolon.cabal index 2bce717..dca4e2d 100644 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -34,6 +34,8 @@ library Handler.Reactivate Handler.ProfileSettings Handler.ProfileDelete + Handler.Admin + Handler.AdminProfileSettings if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT diff --git a/templates/adminBase.hamlet b/templates/adminBase.hamlet new file mode 100644 index 0000000..d26c388 --- /dev/null +++ b/templates/adminBase.hamlet @@ -0,0 +1,5 @@ +$newline always +

Admin interface + +

+ Be careful with your actions here, every click will perform directly the advertised action. diff --git a/templates/adminProfileSettings.hamlet b/templates/adminProfileSettings.hamlet new file mode 100644 index 0000000..143e8ea --- /dev/null +++ b/templates/adminProfileSettings.hamlet @@ -0,0 +1,9 @@ +$newline always +

Profile settings + +
+ ^{adminProfileSetWidget} +
+ + +Delete user diff --git a/templates/adminProfiles.hamlet b/templates/adminProfiles.hamlet new file mode 100644 index 0000000..0ce4560 --- /dev/null +++ b/templates/adminProfiles.hamlet @@ -0,0 +1,10 @@ +$newline always +

User profiles + +$if null profiles + There are no profiles yet (How can you even see this?) +$else + $forall (Entity uId u) <- profiles +