diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 07095c592..1a687b865 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -457,6 +457,7 @@ UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut e UnauthorizedAdminEscalation: Sie sind nicht Administrator für alle Institute, für die dieser Nutzer Administrator oder Veranstalter ist. UnauthorizedExamOffice: Sie sind nicht mit Prüfungsverwaltung beauftragt. UnauthorizedExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer, für die Sie mit der Prüfungsverwaltung beauftragt sind. +UnauthorizedSystemExamOffice: Sie sind nicht mit systemweiter Prüfungsverwaltung beauftragt. UnauthorizedExternalExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer, für die Sie mit der Prüfungsverwaltung beauftragt sind. UnauthorizedEvaluation: Sie sind nicht mit der Kursumfragenverwaltung beauftragt. UnauthorizedAllocationAdmin: Sie sind nicht mit der Administration von Zentralanmeldungen beauftragt. @@ -765,6 +766,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 +1018,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 @@ -1448,6 +1456,7 @@ AuthPredsActiveChanged: Authorisierungseinstellungen für aktuelle Sitzung gespe AuthTagFree: Seite ist universell zugänglich AuthTagAdmin: Nutzer ist Administrator AuthTagExamOffice: Nutzer ist mit Prüfungsverwaltung beauftragt +AuthTagSystemExamOffice: Nutzer ist mit systemweiter Prüfungsverwaltung beauftragt AuthTagEvaluation: Nutzer ist mit Kursumfragenverwaltung beauftragt AuthTagAllocationAdmin: Nutzer ist mit der Administration von Zentralanmeldungen beauftragt AuthTagToken: Nutzer präsentiert Authorisierungs-Token @@ -2750,3 +2759,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..a33b05a8f 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -457,6 +457,7 @@ UnauthorizedExamOffice: You are not part of an exam office. UnauthorizedEvaluation: You are not charged with course evaluation. UnauthorizedAllocationAdmin: You are not charged with the administration of central allocations. UnauthorizedExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam. +UnauthorizedSystemExamOffice: You are not charged with system wide exam administration UnauthorizedExternalExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam. UnauthorizedSchoolLecturer: You are no lecturer for this department. UnauthorizedLecturer: You are no administrator for this course. @@ -762,6 +763,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 +1018,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 @@ -1448,6 +1456,7 @@ AuthPredsActiveChanged: Authorisation settings saved for the current session AuthTagFree: Page is freely accessable AuthTagAdmin: User is administrator AuthTagExamOffice: User is part of an exam office +AuthTagSystemExamOffice: User is charged with system wide exam administration AuthTagEvaluation: User is charged with course evaluation AuthTagAllocationAdmin: User is charged with administration of central allocations AuthTagToken: User is presenting an authorisation-token @@ -2751,3 +2760,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..2d18206b3 100644 --- a/models/users.model +++ b/models/users.model @@ -42,6 +42,12 @@ UserFunction -- Administratively assigned functions (lecturer, admin, evaluation school SchoolId function SchoolFunction UniqueUserFunction user school function +UserSystemFunction + user UserId + function SystemFunction + manual Bool + isOptOut Bool + UniqueUserSystemFunction user function UserExamOffice user UserId field StudyTermsId diff --git a/routes b/routes index 1bb1c3f9a..810aeb824 100644 --- a/routes +++ b/routes @@ -79,10 +79,10 @@ /user/storage-key StorageKeyR POST !free /exam-office ExamOfficeR !exam-office: - / EOExamsR GET + / EOExamsR GET !system-exam-office /fields EOFieldsR GET POST - /users EOUsersR GET POST - /users/invite EOUsersInviteR GET POST + /users EOUsersR GET POST !system-exam-office + /users/invite EOUsersInviteR GET POST !system-exam-office /external-exam EExamListR GET !lecturer !¬empty /external-exam/new EExamNewR GET POST !lecturer diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 9b57c8904..57270e2c6 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -10,6 +10,7 @@ module Auth.LDAP , ldapUserMatriculation, ldapUserFirstName, ldapUserSurname , ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName , ldapUserSchoolAssociation, ldapUserSubTermsSemester, ldapSex + , ldapAffiliation ) where import Import.NoFoundation @@ -68,7 +69,7 @@ userSearchSettings LdapConf{..} = mconcat , Ldap.derefAliases Ldap.DerefAlways ] -ldapUserPrincipalName, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation, ldapSex, ldapUserSubTermsSemester :: Ldap.Attr +ldapUserPrincipalName, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation, ldapSex, ldapUserSubTermsSemester, ldapAffiliation :: Ldap.Attr ldapUserPrincipalName = Ldap.Attr "userPrincipalName" ldapUserDisplayName = Ldap.Attr "displayName" ldapUserMatriculation = Ldap.Attr "LMU-Stud-Matrikelnummer" @@ -80,6 +81,7 @@ ldapUserFieldName = Ldap.Attr "LMU-Stg-Fach" ldapUserSchoolAssociation = Ldap.Attr "LMU-IFI-eduPersonOrgUnitDNString" ldapSex = Ldap.Attr "schacGender" ldapUserSubTermsSemester = Ldap.Attr "LMU-Stg-FachundFS" +ldapAffiliation = Ldap.Attr "eduPersonAffiliation" ldapUserEmail :: NonEmpty Ldap.Attr ldapUserEmail = Ldap.Attr "mail" :| diff --git a/src/Foundation/Authorization.hs b/src/Foundation/Authorization.hs index 991224b2f..0997791f4 100644 --- a/src/Foundation/Authorization.hs +++ b/src/Foundation/Authorization.hs @@ -324,6 +324,11 @@ tagAccessPredicate AuthAdmin = APDB $ \mAuthId route _ -> case route of adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin] [] guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin) return Authorized +tagAccessPredicate AuthSystemExamOffice = APDB $ \mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do + authId <- maybeExceptT AuthenticationRequired $ return mAuthId + isExamOffice <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemExamOffice, UserSystemFunctionIsOptOut ==. False] + guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedSystemExamOffice + return Authorized tagAccessPredicate AuthExamOffice = APDB $ \mAuthId route _ -> case route of CExamR tid ssh csh examn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, examn) . exceptT return return $ do authId <- maybeExceptT AuthenticationRequired $ return mAuthId 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/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index 8be3e80b9..12fb36028 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -14,6 +14,7 @@ import Foundation.I18n import Handler.Utils.Profile import Handler.Utils.StudyFeatures import Handler.Utils.SchoolLdap +import Handler.Utils.LdapSystemFunctions import Yesod.Auth.Message import Auth.LDAP @@ -22,6 +23,7 @@ import qualified Data.CaseInsensitive as CI import qualified Control.Monad.Catch as C (Handler(..)) import qualified Data.List.NonEmpty as NonEmpty import qualified Ldap.Client as Ldap +import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.ByteString as ByteString import qualified Data.Set as Set @@ -425,6 +427,19 @@ upsertCampusUser plugin ldapData = do forM_ ss $ void . insertUnique . SchoolLdap Nothing + let + userSystemFunctions = determineSystemFunctions . Set.fromList $ map CI.mk userSystemFunctions' + userSystemFunctions' = do + (k, v) <- ldapData + guard $ k == ldapAffiliation + v' <- v + Right str <- return $ Text.decodeUtf8' v' + assertM' (not . Text.null) $ Text.strip str + + iforM_ userSystemFunctions $ \func preset -> if + | preset -> void $ upsert (UserSystemFunction userId func False False) [] + | otherwise -> deleteWhere [UserSystemFunctionUser ==. userId, UserSystemFunctionFunction ==. func, UserSystemFunctionIsOptOut ==. False, UserSystemFunctionManual ==. False] + return user where insertMaybe key val = get key >>= maybe (insert_ val) (\_ -> return ()) diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 88d0340fd..b5e8313e9 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -101,6 +101,9 @@ postUsersR = do $forall (E.Value sh) <- schools
  • #{sh} |] + , sortable Nothing (i18nCell MsgUserSystemFunctions) $ \DBRow{ dbrOutput = Entity uid _ } -> + let getFunctions = fmap (map $ userSystemFunctionFunction . entityVal) . liftHandler . runDB $ selectList [ UserSystemFunctionUser ==. uid, UserSystemFunctionIsOptOut ==. False ] [ Asc UserSystemFunctionFunction ] + in listCell' getFunctions i18nCell , sortable Nothing (mempty & cellAttrs <>~ pure ("hide-columns--hider-label", mr MsgActionsHead)) $ \inp@DBRow{ dbrOutput = Entity uid _ } -> FormCell { formCellAttrs = [] , formCellLens = id @@ -277,7 +280,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 +292,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, UserSystemFunctionIsOptOut ==. False] [] + 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 +318,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 +376,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 $ upsert (UserSystemFunction uid func True False) [ UserSystemFunctionIsOptOut =. False, UserSystemFunctionManual =. True ] + | otherwise + -> void $ upsert (UserSystemFunction uid func True True) [ UserSystemFunctionIsOptOut =. True, UserSystemFunctionManual =. True ] + 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 +403,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/Handler/Utils/LdapSystemFunctions.hs b/src/Handler/Utils/LdapSystemFunctions.hs new file mode 100644 index 000000000..c87b3f252 --- /dev/null +++ b/src/Handler/Utils/LdapSystemFunctions.hs @@ -0,0 +1,13 @@ +module Handler.Utils.LdapSystemFunctions + ( determineSystemFunctions + ) where + +import Import.NoFoundation + +import qualified Data.Set as Set + + +determineSystemFunctions :: Set (CI Text) -> (SystemFunction -> Bool) +determineSystemFunctions ldapFuncs = \case + SystemExamOffice -> False + SystemFaculty -> "faculty" `Set.member` ldapFuncs 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/Security.hs b/src/Model/Types/Security.hs index 8fa709687..9df7be8ab 100644 --- a/src/Model/Types/Security.hs +++ b/src/Model/Types/Security.hs @@ -52,6 +52,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä | AuthTutor | AuthTutorControl | AuthExamOffice + | AuthSystemExamOffice | AuthEvaluation | AuthAllocationAdmin | AuthAllocationRegistered 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 +\ + + + +