From abc37aca9c2aa5eafe7eea9333886b43189d5591 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 27 Aug 2020 17:04:52 +0200 Subject: [PATCH] feat: add user-system-function --- messages/uniworx/de-de-formal.msg | 10 +++++++ messages/uniworx/en-eu.msg | 10 +++++++ models/users.model | 4 +++ src/Foundation/I18n.hs | 1 + src/Handler/Users.hs | 29 ++++++++++++++++++- src/Jobs/Handler/QueueNotification.hs | 3 ++ .../SendNotification/UserRightsUpdate.hs | 14 +++++++++ src/Jobs/Types.hs | 1 + src/Model/Types.hs | 1 + src/Model/Types/User.hs | 16 ++++++++++ src/Utils.hs | 3 ++ src/Utils/Form.hs | 1 + templates/adminUser.hamlet | 1 + .../mail/userSystemFunctionsUpdate.hamlet | 21 ++++++++++++++ 14 files changed, 114 insertions(+), 1 deletion(-) create mode 100644 src/Model/Types/User.hs create mode 100644 templates/mail/userSystemFunctionsUpdate.hamlet diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 07095c592..de2ed76ba 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -765,6 +765,9 @@ CorrectorsFor n@Int: #{pluralDE n "Korrektor" "Korrektoren"} UserListTitle: Komprehensive Benutzerliste AccessRightsSaved: Berechtigungen erfolgreich verändert AccessRightsNotChanged: Berechtigungen wurden nicht verändert +UserSystemFunctions: Systemweite Rollen +UserSystemFunctionsSaved: Systemweite Rollen gespeichert +UserSystemFunctionsNotChanged: Es wurden keine systemweiten Rollen angepasst LecturersForN n@Int: #{pluralDE n "Dozent" "Dozenten"} @@ -1014,6 +1017,10 @@ MailUserRightsIntro name@Text email@UserEmail: #{name} <#{email}> hat folgende U MailNoLecturerRights: Sie haben derzeit keine Dozenten-Rechte. MailLecturerRights n@Int: Als Dozent dürfen Sie Veranstaltungen innerhalb #{pluralDE n "Ihres Instituts" "Ihrer Institute"} anlegen. +MailSubjectUserSystemFunctionsUpdate name@Text: Berechtigungen für #{name} aktualisiert +MailUserSystemFunctionsIntro name@Text email@UserEmail: #{name} <#{email}> hat folgende Uni2work nicht-institutsbezogene Berechtigungen: +MailUserSystemFunctionsNoFunctions: Keine + MailSubjectUserAuthModeUpdate: Ihr Uni2work-Login UserAuthModePWHashChangedToLDAP: Sie können sich nun mit Ihrer Campus-Kennung in Uni2work einloggen UserAuthModeLDAPChangedToPWHash: Sie können sich nun mit einer Uni2work-internen Kennung in Uni2work einloggen @@ -2750,3 +2757,6 @@ SheetPersonalisedFilesUsersList: Liste von Teilnehmern mit personalisierten Übu AdminCrontabNotGenerated: (Noch) keine Crontab generiert CronMatchAsap: ASAP CronMatchNone: Nie + +SystemExamOffice: Prüfungsverwaltung +SystemFaculty: Fakultätsmitglied \ No newline at end of file diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 1c236b868..ade2650a1 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -762,6 +762,9 @@ CorrectorsFor n: #{pluralEN n "Corrector" "Correctors"} UserListTitle: Comprehensive list of users AccessRightsSaved: Successfully updated permissions AccessRightsNotChanged: Permissions left unchanged +UserSystemFunctions: System wide roles +UserSystemFunctionsSaved: Successfully saved system wide roles +UserSystemFunctionsNotChanged: No system wide roles were changed LecturersForN n: #{pluralEN n "Lecturer" "Lecturers"} @@ -1014,6 +1017,10 @@ MailUserRightsIntro name email: #{name} <#{email}> now has the following permiss MailNoLecturerRights: You don't currently have lecturer permissions for any department. MailLecturerRights n: As a lecturer you may create new courses within your #{pluralEN n "department" "departments"}. +MailSubjectUserSystemFunctionsUpdate name: Permissions for #{name} changed +MailUserSystemFunctionsIntro name email: #{name} <#{email}> now has the following, not school restricted, permissions: +MailUserSystemFunctionsNoFunctions: None + MailSubjectUserAuthModeUpdate: Your Uni2work login UserAuthModePWHashChangedToLDAP: You can now log in to Uni2work using your Campus-account UserAuthModeLDAPChangedToPWHash: You can now log in to Uni2work using your Uni2work-internal account @@ -2751,3 +2758,6 @@ SheetPersonalisedFilesUsersList: List of course participants who have personalis AdminCrontabNotGenerated: Crontab not (yet) generated CronMatchAsap: ASAP CronMatchNone: Never + +SystemExamOffice: Exam office +SystemFaculty: Faculty member diff --git a/models/users.model b/models/users.model index 740de8186..95945d8a8 100644 --- a/models/users.model +++ b/models/users.model @@ -42,6 +42,10 @@ UserFunction -- Administratively assigned functions (lecturer, admin, evaluation school SchoolId function SchoolFunction UniqueUserFunction user school function +UserSystemFunction + user UserId + function SystemFunction + UniqueUserSystemFunction user function UserExamOffice user UserId field StudyTermsId diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index aa514a72d..71543f2d9 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -219,6 +219,7 @@ embedRenderMessage ''UniWorX ''UploadModeDescr id embedRenderMessage ''UniWorX ''SecretJSONFieldException id embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel embedRenderMessage ''UniWorX ''SchoolFunction id +embedRenderMessage ''UniWorX ''SystemFunction id embedRenderMessage ''UniWorX ''CsvPreset id embedRenderMessage ''UniWorX ''Quoting ("Csv" <>) embedRenderMessage ''UniWorX ''FavouriteReason id diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 88d0340fd..1f64d0da3 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -277,7 +277,7 @@ getAdminUserR = postAdminUserR postAdminUserR uuid = do adminId <- requireAuthId uid <- decrypt uuid - (user@User{..}, adminSchools, functions, schools) <- runDB $ do + (user@User{..}, adminSchools, functions, schools, systemFunctions) <- runDB $ do user <- get404 uid schools <- E.select . E.from $ \(school `E.LeftOuterJoin` userFunction) -> do @@ -289,10 +289,14 @@ postAdminUserR uuid = do E.&&. adminFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin return (school, userFunction E.?. UserFunctionFunction, isAdmin) + systemFunctionsF <- Set.fromList . map (userSystemFunctionFunction . entityVal) <$> selectList [UserSystemFunctionUser ==. uid] [] + let systemFunctions = (`Set.member` systemFunctionsF) + return ( user , setOf (folded . filtered (view $ _3 . _Value) . _1 . _entityKey) schools , setOf (folded . folding (\x -> (,) <$> preview (_2 . _Value . _Just) x <*> preview (_1 . _entityKey) x)) schools , setOf (folded . _1) schools + , systemFunctions ) let allFunctions = Set.fromList universeF allSchools = Set.mapMonotonic entityKey schools @@ -311,6 +315,8 @@ postAdminUserR uuid = do userAuthenticationForm = buttonForm' $ if | userAuthentication == AuthLDAP -> [BtnAuthPWHash] | otherwise -> [BtnAuthLDAP, BtnPasswordReset] + systemFunctionsForm' = funcForm systemFuncForm (fslI MsgUserSystemFunctions) False + where systemFuncForm func = apopt checkBoxField (fslI func) . Just $ systemFunctions func let userRightsAction changes = do let symDiff = (changes `Set.difference` functions) `Set.union` (functions `Set.difference` changes) updates = (allFunctions `setProduct` adminSchools) `Set.intersection` symDiff @@ -367,8 +373,24 @@ postAdminUserR uuid = do queueJob' $ JobSendPasswordReset uid addMessageI Success MsgPasswordResetQueued redirect $ AdminUserR uuid + + userSystemFunctionsAction newFuncs = do + let symmDiff = setFromFunc newFuncs `setSymmDiff` setFromFunc systemFunctions + if + | not $ Set.null symmDiff -> runDBJobs $ do + forM_ symmDiff $ \func -> if + | newFuncs func + -> void . insertUnique $ UserSystemFunction uid func + | otherwise + -> deleteBy $ UniqueUserSystemFunction uid func + queueDBJob . JobQueueNotification . NotificationUserSystemFunctionsUpdate uid $ setFromFunc systemFunctions + addMessageI Success MsgUserSystemFunctionsSaved + | otherwise + -> addMessageI Info MsgUserSystemFunctionsNotChanged + redirect $ AdminUserR uuid ((rightsResult, rightsFormWidget),rightsFormEnctype) <- runFormPost userRightsForm ((authResult, authFormWidget),authFormEnctype) <- runFormPost userAuthenticationForm + ((systemFunctionsResult, systemFunctionsWidget),systemFunctionsEnctype) <- runFormPost . identifyForm FIDUserSystemFunctions $ renderAForm FormStandard systemFunctionsForm' let rightsForm = wrapForm rightsFormWidget def { formAction = Just . SomeRoute $ AdminUserR uuid , formEncoding = rightsFormEnctype @@ -378,8 +400,13 @@ postAdminUserR uuid = do , formEncoding = authFormEnctype , formSubmit = FormNoSubmit } + systemFunctionsForm = wrapForm systemFunctionsWidget def + { formAction = Just . SomeRoute $ AdminUserR uuid + , formEncoding = systemFunctionsEnctype + } formResult rightsResult userRightsAction formResult authResult userAuthenticationAction + formResult systemFunctionsResult userSystemFunctionsAction let heading = [whamlet|_{MsgAdminUserHeadingFor} ^{nameEmailWidget userEmail userDisplayName userSurname}|] -- Delete Button needed in data-delete diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index fb225b98f..38fa2a3f0 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -113,6 +113,8 @@ determineNotificationCandidates = awaitForever $ \notif -> do E.&&. admin E.^. UserFunctionFunction E.==. E.val SchoolAdmin return user withNotif . yieldMany . nub $ affectedUser <> affectedAdmins + NotificationUserSystemFunctionsUpdate{..} + -> withNotif $ selectSource [UserId ==. nUser] [] NotificationUserAuthModeUpdate{..} -> withNotif $ selectSource [UserId ==. nUser] [] NotificationExamRegistrationActive{..} @@ -295,6 +297,7 @@ classifyNotification NotificationSheetInactive{} = return NTShe classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate +classifyNotification NotificationUserSystemFunctionsUpdate{} = return NTUserRightsUpdate classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate classifyNotification NotificationExamRegistrationActive{} = return NTExamRegistrationActive classifyNotification NotificationExamRegistrationSoonInactive{} = return NTExamRegistrationSoonInactive diff --git a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs index aec3f2a42..f2a7ba935 100644 --- a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs +++ b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs @@ -2,6 +2,7 @@ module Jobs.Handler.SendNotification.UserRightsUpdate ( dispatchNotificationUserRightsUpdate + , dispatchNotificationUserSystemFunctionsUpdate ) where import Import @@ -27,3 +28,16 @@ dispatchNotificationUserRightsUpdate nUser _originalRights jRecipient = userMai editNotifications <- mkEditNotifications jRecipient addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) + +dispatchNotificationUserSystemFunctionsUpdate :: UserId -> Set SystemFunction -> UserId -> Handler () +dispatchNotificationUserSystemFunctionsUpdate nUser _originalSystemFunctions jRecipient = userMailT jRecipient $ do + (User{..}, functions) <- liftHandler . runDB $ do + user <- getJust nUser + functions <- map (userSystemFunctionFunction . entityVal) <$> selectList [UserSystemFunctionUser ==. nUser] [] + return (user, Set.fromList functions) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI $ MsgMailSubjectUserSystemFunctionsUpdate userDisplayName + -- MsgRenderer mr <- getMailMsgRenderer + editNotifications <- mkEditNotifications jRecipient + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/userSystemFunctionsUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) + diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 729cd356b..065c806cc 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -99,6 +99,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId } | NotificationCorrectionsNotDistributed { nSheet :: SheetId } | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) } + | NotificationUserSystemFunctionsUpdate { nUser :: UserId, nOriginalSystemFunctions :: Set SystemFunction } | NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode } | NotificationExamRegistrationActive { nExam :: ExamId } | NotificationExamRegistrationSoonInactive { nExam :: ExamId } diff --git a/src/Model/Types.hs b/src/Model/Types.hs index fc3b1662f..b40e5c912 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -16,3 +16,4 @@ import Model.Types.School as Types import Model.Types.Allocation as Types import Model.Types.Languages as Types import Model.Types.File as Types +import Model.Types.User as Types diff --git a/src/Model/Types/User.hs b/src/Model/Types/User.hs new file mode 100644 index 000000000..09eba6393 --- /dev/null +++ b/src/Model/Types/User.hs @@ -0,0 +1,16 @@ +module Model.Types.User where + +import Import.NoModel +import Model.Types.TH.PathPiece + + +data SystemFunction + = SystemExamOffice + | SystemFaculty + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving anyclass (Universe, Finite, Hashable, NFData) + +nullaryPathPiece ''SystemFunction $ camelToPathPiece' 1 +pathPieceJSON ''SystemFunction +pathPieceJSONKey ''SystemFunction +derivePersistFieldPathPiece ''SystemFunction diff --git a/src/Utils.hs b/src/Utils.hs index 6a5bd9105..3a517d231 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -483,6 +483,9 @@ setProduct (Set.toAscList -> as) (Set.toAscList -> bs) = Set.fromDistinctAscList setPartitionEithers :: (Ord a, Ord b) => Set (Either a b) -> (Set a, Set b) setPartitionEithers = (,) <$> setMapMaybe (preview _Left) <*> setMapMaybe (preview _Right) +setFromFunc :: (Finite k, Ord k) => (k -> Bool) -> Set k +setFromFunc = Set.fromList . flip filter universeF + ---------- -- Maps -- ---------- diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index b894c3137..2fa06586a 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -215,6 +215,7 @@ data FormIdentifier | FIDDelete | FIDCourseRegister | FIDuserRights + | FIDUserSystemFunctions | FIDcUserNote | FIDcRegField | FIDcRegButton diff --git a/templates/adminUser.hamlet b/templates/adminUser.hamlet index af9c9f5c2..6012e38d7 100644 --- a/templates/adminUser.hamlet +++ b/templates/adminUser.hamlet @@ -4,6 +4,7 @@ $newline never

_{MsgAdminUserRightsHeading} + ^{systemFunctionsForm} ^{rightsForm}

diff --git a/templates/mail/userSystemFunctionsUpdate.hamlet b/templates/mail/userSystemFunctionsUpdate.hamlet new file mode 100644 index 000000000..263a626c5 --- /dev/null +++ b/templates/mail/userSystemFunctionsUpdate.hamlet @@ -0,0 +1,21 @@ +$newline never +\ + + + +