diff --git a/CHANGELOG.md b/CHANGELOG.md index 0df264d6b..9731f6f2b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,40 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [6.10.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.9.0...v6.10.0) (2019-09-13) + + +### Features + +* **exams:** notifications wrt. registration ([ae27ff0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/ae27ff0)) + + + +## [6.9.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.8.0...v6.9.0) (2019-09-12) + + +### Features + +* **users:** allow customisation of displayed email address ([2f38278](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/2f38278)), closes [#459](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/459) +* **users:** allow customisation of userDisplayName ([a85f317](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a85f317)), closes [#346](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/346) + + + +## [6.8.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.7.0...v6.8.0) (2019-09-12) + + +### Bug Fixes + +* **allocations:** better explain capped allocation bounds ([a890e34](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a890e34)) + + +### Features + +* **allocations:** allow changing course capacity during allocation ([83e1c94](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/83e1c94)) +* **allocations:** show bounds on assignments due to allocation ([91b249e](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/91b249e)) + + + ## [6.7.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.6.0...v6.7.0) (2019-09-12) diff --git a/frontend/src/utils/form/datepicker.js b/frontend/src/utils/form/datepicker.js index 932d3b515..11d7394bc 100644 --- a/frontend/src/utils/form/datepicker.js +++ b/frontend/src/utils/form/datepicker.js @@ -3,7 +3,6 @@ import { Utility } from '../../core/utility'; import moment from 'moment'; const KEYCODE_ESCAPE = 27; -const Z_INDEX_MODAL = 9999; // INTERNAL (Uni2work specific) formats for formatting dates and/or times const FORM_DATE_FORMAT = { @@ -140,16 +139,6 @@ export class Datepicker { // initialize tail.datetime (datepicker) instance this.datepickerInstance = datetime(this._element, { ...datepickerGlobalConfig, ...datepickerConfig }); - // append the datepicker element (dt) to the form - this._element.form.appendChild(this.datepickerInstance.dt); - - // if the input element is in any open modal, increase the z-index of the datepicker and set its position to fixed to avoid repositioning on page scroll - // FIXME: instead of setting the position to fixed, use absolute and reposition (decrease left) - if (this._element.closest('.modal--open')) { - this.datepickerInstance.dt.style.zIndex = Z_INDEX_MODAL; - this.datepickerInstance.dt.style.position = 'fixed'; - } - // register this datepicker instance with the formID of the given element in the datepicker collection const formID = this._element.form.id; const elemID = this._element.id; diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 6eefda159..412152b30 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -640,6 +640,7 @@ UserSchoolsTip: Sie erhalten nur institutweite Benachrichtigungen für Institute FormNotifications: Benachrichtigungen FormBehaviour: Verhalten FormCosmetics: Oberfläche +FormPersonalAppearance: Öffentliche Daten FormFieldRequiredTip: Gekennzeichnete Pflichtfelder sind immer auszufüllen ActiveAuthTags: Aktivierte Authorisierungsprädikate @@ -773,6 +774,15 @@ MailExamOfficeExamResultsIntro courseName@Text termDesc@Text examn@ExamName: Ein MailSubjectExamOfficeExamResultsChanged csh@CourseShorthand examn@ExamName: Ergebnisse für #{examn} in #{csh} wurden verändert MailExamOfficeExamResultsChangedIntro courseName@Text termDesc@Text examn@ExamName: Ein Kursverwalter hat Prüfungsleistungen für #{examn} im Kurs #{courseName} (#{termDesc}) verändert. +MailSubjectExamRegistrationActive csh@CourseShorthand examn@ExamName: Anmeldung für #{examn} in #{csh} ist möglich +MailExamRegistrationActiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich nun für #{examn} im Kurs #{courseName} (#{termDesc}) anmelden. + +MailSubjectExamRegistrationSoonInactive csh@CourseShorthand examn@ExamName: Anmeldung für #{examn} in #{csh} ist nur noch kurze Zeit möglich +MailExamRegistrationSoonInactiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich bald nicht mehr für #{examn} im Kurs #{courseName} (#{termDesc}) anmelden. + +MailSubjectExamDeregistrationSoonInactive csh@CourseShorthand examn@ExamName: Abmeldung für #{examn} in #{csh} ist nur noch kurze Zeit möglich +MailExamDeregistrationSoonInactiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich bald nicht mehr von #{examn} im Kurs #{courseName} (#{termDesc}) abmelden. + MailSubjectSubmissionsUnassigned csh@CourseShorthand sheetName@SheetName: Abgaben zu #{sheetName} in #{csh} konnten nicht verteilt werden MailSubmissionsUnassignedIntro n@Int courseName@Text termDesc@Text sheetName@SheetName: #{n} Abgaben zu #{sheetName} im Kurs #{courseName} (#{termDesc}) konnten nicht automatisiert verteilt werden. @@ -875,6 +885,9 @@ NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugetei NotificationTriggerCorrectionsNotDistributed: Nicht alle Abgaben eines meiner Übungsblätter konnten einem Korrektor zugeteilt werden NotificationTriggerUserRightsUpdate: Meine Berechtigungen wurden geändert NotificationTriggerUserAuthModeUpdate: Mein Anmelde-Modus wurde geändert +NotificationTriggerExamRegistrationActive: Ich kann mich für eine Prüfung anmelden +NotificationTriggerExamRegistrationSoonInactive: Ich kann mich bald nicht mehr für eine Prüfung anmelden +NotificationTriggerExamDeregistrationSoonInactive: Ich kann mich bald nicht mehr von einer Prüfung abmelden NotificationTriggerExamResult: Ich kann ein neues Prüfungsergebnis einsehen NotificationTriggerAllocationStaffRegister: Ich kann Kurse bei einer neuen Zentralanmeldung eintragen NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldung-Bewerbungen für einen meiner Kurse bewerten @@ -1632,9 +1645,16 @@ CourseApplicationNoVeto: Kein Veto CourseApplicationNoRatingPoints: Keine Bewertung CourseApplicationNoRatingComment: Kein Kommentar -UserDisplayName: Voller Name +UserDisplayName: Angezeigter Name +UserDisplayNameInvalid: Angezeigter Name erfüllt nicht die Vorgaben +UserDisplayNameRules: Vorgaben für den angezeigten Namen +UserDisplayNameRulesBelow: Vorgaben für den angezeigten Namen finden sich weiter unten auf der Seite UserMatriculation: Matrikelnummer +UserDisplayEmail: Angezeigte E-Mail Adresse +UserDisplayEmailTip: Diese Adresse wird in öffentlich zugänglichen Teilen des Systems im Zusammenhang mit Ihrem Namen angezeigt. Benachrichtigungen und andere Kommunikation von Uni2work und Nutzern mit erweiterten Rechten erhalten sie stets, unabhängig von dieser Einstellung, an die in Ihren Persönlichen Daten hinterlegte primäre Adresse. +UserDisplayEmailChangeSent displayEmail@UserEmail: Anweisungen zum Ändern der angezeigten E-Mail Adresse wurden an „#{displayEmail}” versandt + SchoolShort: Kürzel SchoolName: Name SchoolLdapOrganisations: Assoziierte LDAP-Fragmente @@ -1701,6 +1721,7 @@ AdminUserFirstName: Vorname AdminUserSurname: Nachname AdminUserDisplayName: Anzeige-Name AdminUserEmail: E-Mail Addresse +AdminUserDisplayEmail: Anzeige-E-Mail AdminUserIdent: Identifikation AdminUserAuth: Authentifizierung AdminUserMatriculation: Matrikelnummer @@ -1708,3 +1729,17 @@ AuthKindLDAP: Campus-Kennung AuthKindPWHash: Uni2work-Kennung UserAdded: Benutzer erfolgreich angelegt UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden + +CourseAllocationsBounds n@Int: Voraussichtliche Zuteilungen durch #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"} +CourseAllocationsBoundCoincide numFirstChoice@Int: Vstl. #{numFirstChoice} Teilnehmer +CourseAllocationsBound numApps@Int numFirstChoice@Int: Vstl. zwischen #{numFirstChoice} und #{numApps} Teilnehmer +CourseAllocationsBoundCapped: Die obige Anzeige wurde durch die aktuell angegebene Kurskapazität reduziert. +CourseAllocationsBoundWarningOpen: Diese Informationen entsprechen nur dem aktuellen Stand der Bewerbungen und können sich noch ändern. + +BtnSetDisplayEmail: E-Mail Adresse setzen +UserDisplayEmailChanged: Öffentliche E-Mail Adresse erfolgreich gesetzt +TitleChangeUserDisplayEmail: Öffentliche E-Mail Adresse setzen + +MailSubjectChangeUserDisplayEmail: Diese E-Mail Adresse in Uni2work veröffentlichen +MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer möchte „#{displayEmail}“ als öffentliche Adresse, assoziiert mit sich selbst, angeben. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte! +MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail Adresse in Uni2work veröffentlichen diff --git a/models/users b/models/users index 223cd2b8a..22c14f1dc 100644 --- a/models/users +++ b/models/users @@ -9,9 +9,10 @@ -- User json -- Each Uni2work user has a corresponding row in this table; created upon first login. surname UserSurname -- Display user names always through 'nameWidget displayName surname' - displayName UserDisplayName -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained) - email (CI Text) -- Case-insensitive eMail address - ident (CI Text) -- Case-insensitive user-identifier + displayName UserDisplayName + displayEmail UserEmail + email UserEmail -- Case-insensitive eMail address + ident UserIdent -- Case-insensitive user-identifier authentication AuthenticationMode -- 'AuthLDAP' or ('AuthPWHash'+password-hash) lastAuthentication UTCTime Maybe -- last login date created UTCTime default=now() diff --git a/package-lock.json b/package-lock.json index fcb1215fb..89f8e3fbf 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "6.7.0", + "version": "6.10.0", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index fc9399b98..d2d4ccabf 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "6.7.0", + "version": "6.10.0", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 937849fb1..cc302b8a5 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 6.7.0 +version: 6.10.0 dependencies: # Due to a bug in GHC 8.0.1, we block its usage @@ -137,6 +137,7 @@ dependencies: - memory - pqueue - deepseq + - multiset other-extensions: - GeneralizedNewtypeDeriving diff --git a/routes b/routes index bbc84d540..f19b94a9a 100644 --- a/routes +++ b/routes @@ -71,6 +71,7 @@ /user ProfileR GET POST !free /user/profile ProfileDataR GET !free /user/authpreds AuthPredsR GET POST !free +/user/set-display-email SetDisplayEmailR GET POST !free /exam-office ExamOfficeR !exam-office: / EOExamsR GET diff --git a/src/Foundation.hs b/src/Foundation.hs index 53782fbec..2db44e9ad 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -67,6 +67,7 @@ import qualified Control.Monad.Catch as C import Handler.Utils.StudyFeatures import Handler.Utils.SchoolLdap import Handler.Utils.ExamOffice.Exam.Auth +import Handler.Utils.Profile import Utils.Form import Utils.Sheet import Utils.SystemMessage @@ -1803,9 +1804,10 @@ instance YesodBreadcrumbs UniWorX where breadcrumb InstanceR = return ("Identifikation", Nothing) - breadcrumb ProfileR = return ("User" , Just HomeR) - breadcrumb ProfileDataR = return ("Profile" , Just ProfileR) - breadcrumb AuthPredsR = return ("Authentifizierung", Just ProfileR) + breadcrumb ProfileR = return ("Einstellungen" , Just HomeR) + breadcrumb SetDisplayEmailR = return ("Öffentliche E-Mail Adresse", Just ProfileR) + breadcrumb ProfileDataR = return ("Persönliche Daten", Just ProfileR) + breadcrumb AuthPredsR = return ("Authorisierung" , Just ProfileR) breadcrumb TermShowR = return ("Semester" , Just HomeR) breadcrumb TermCurrentR = return ("Aktuell" , Just TermShowR) @@ -3142,7 +3144,7 @@ upsertCampusUser ldapData Creds{..} = do let userMatrikelnummer' = fold [ v | (k, v) <- ldapData, k == ldapUserMatriculation ] userEmail' = fold [ v | (k, v) <- ldapData, k == ldapUserEmail ] - userDisplayName' = fold [ v | (k, v) <- ldapData, k == ldapUserDisplayName ] + userDisplayName'' = fold [ v | (k, v) <- ldapData, k == ldapUserDisplayName ] userFirstName' = fold [ v | (k, v) <- ldapData, k == ldapUserFirstName ] userSurname' = fold [ v | (k, v) <- ldapData, k == ldapUserSurname ] userTitle' = fold [ v | (k, v) <- ldapData, k == ldapUserTitle ] @@ -3158,10 +3160,10 @@ upsertCampusUser ldapData Creds{..} = do -> return $ mk userEmail | otherwise -> throwM CampusUserInvalidEmail - userDisplayName <- if - | [bs] <- userDisplayName' - , Right userDisplayName <- Text.decodeUtf8' bs - -> return userDisplayName + userDisplayName' <- if + | [bs] <- userDisplayName'' + , Right userDisplayName' <- Text.decodeUtf8' bs + -> return userDisplayName' | otherwise -> throwM CampusUserInvalidDisplayName userFirstName <- if @@ -3208,17 +3210,23 @@ upsertCampusUser ldapData Creds{..} = do , userTokensIssuedAfter = Nothing , userCreated = now , userLastLdapSynchronisation = Just now + , userDisplayName = userDisplayName' + , userDisplayEmail = userEmail , .. } userUpdate = [ UserMatrikelnummer =. userMatrikelnummer - , UserDisplayName =. userDisplayName + -- , UserDisplayName =. userDisplayName + , UserFirstName =. userFirstName , UserSurname =. userSurname + , UserTitle =. userTitle , UserEmail =. userEmail , UserLastLdapSynchronisation =. Just now ] ++ [ UserLastAuthentication =. Just now | not isDummy ] - user@(Entity userId _) <- upsertBy (UniqueAuthentication $ mk credsIdent) newUser userUpdate + user@(Entity userId userRec) <- upsertBy (UniqueAuthentication $ mk credsIdent) newUser userUpdate + unless (validDisplayName userTitle userFirstName userSurname $ userDisplayName userRec) $ + update userId [ UserDisplayName =. userDisplayName' ] let userStudyFeatures = fmap concat . forM userStudyFeatures' $ parseStudyFeatures userId now diff --git a/src/Handler/Course/Application/List.hs b/src/Handler/Course/Application/List.hs index 4ca11700d..d01699a2a 100644 --- a/src/Handler/Course/Application/List.hs +++ b/src/Handler/Course/Application/List.hs @@ -209,8 +209,8 @@ embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvException id getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCApplicationsR = postCApplicationsR postCApplicationsR tid ssh csh = do - table <- runDB $ do - cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh + (table, allocationsBounds) <- runDB $ do + Entity cid Course{..} <- getBy404 $ TermSchoolCourseShort tid ssh csh csvName <- getMessageRender <*> pure (MsgCourseApplicationsTableCsvName tid ssh csh) let @@ -531,10 +531,46 @@ postCApplicationsR tid ssh csh = do psValidator = def & defaultSorting [SortAscBy "user-name"] - dbTableWidget' psValidator DBTable{..} + participants <- count [ CourseParticipantCourse ==. cid ] + let remainingCapacity = subtract participants <$> courseCapacity + allocationsBounds' <- E.select . E.from $ \(allocation `E.InnerJoin` allocationCourse) -> do + E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation + E.&&. allocationCourse E.^. AllocationCourseCourse E.==. E.val cid + + let numApps addWhere = E.sub_select . E.from $ \courseApplication -> do + E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid + E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation) + addWhere courseApplication + return E.countRows + + numApps' = numApps . const $ return () + + numFirstChoice = numApps $ \courseApplication -> + E.where_ . E.not_ . E.exists . E.from $ \courseApplication' -> do + E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. courseApplication' E.^. CourseApplicationAllocation + E.&&. courseApplication E.^. CourseApplicationUser E.==. courseApplication' E.^. CourseApplicationUser + E.where_ . E.not_ $ E.isNothing (courseApplication E.^. CourseApplicationAllocationPriority) + E.||. E.isNothing (courseApplication' E.^. CourseApplicationAllocationPriority) + E.where_ $ courseApplication' E.^. CourseApplicationAllocationPriority E.>. courseApplication E.^. CourseApplicationAllocationPriority + + return (allocation, numApps', numFirstChoice) + + let + allocationsBounds = [ (allocation, numApps', numFirstChoice', capped) + | (Entity _ allocation, E.Value numApps, E.Value numFirstChoice) <- allocationsBounds' + , let numApps' = max 0 $ maybe id min remainingCapacity numApps + numFirstChoice' = max 0 $ maybe id min remainingCapacity numFirstChoice + capped = numApps' /= numApps + || numFirstChoice' /= numFirstChoice + ] + + (, allocationsBounds) <$> dbTableWidget' psValidator DBTable{..} + + now <- liftIO getCurrentTime let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle + registrationOpen = maybe True (now <) siteLayoutMsg title $ do setTitleI title - table + $(widgetFile "course/applications-list") diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index 67913bf09..6347b1d38 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -303,10 +303,11 @@ validateCourse = do prevAllocationCourse <- getBy $ UniqueAllocationCourse cid prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse - fmap join . for prevAllocation $ \Allocation{allocationStaffRegisterTo} -> if + fmap join . for prevAllocation $ \Allocation{allocationStaffAllocationTo, allocationRegisterByCourse} -> if | userAdmin -> return Nothing - | NTop allocationStaffRegisterTo <= NTop (Just now) + | NTop allocationStaffAllocationTo <= NTop (Just now) + , NTop allocationRegisterByCourse > NTop (Just now) -> Just . courseCapacity <$> getJust cid | otherwise -> return Nothing diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs index 47796f8da..085cc048a 100644 --- a/src/Handler/Course/Show.hs +++ b/src/Handler/Course/Show.hs @@ -46,7 +46,7 @@ getCShowR tid ssh csh = do E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName ] return ( lecturer E.^. LecturerType - , user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname) + , user E.^. UserDisplayEmail, user E.^. UserDisplayName, user E.^. UserSurname) let partStaff :: (LecturerType, UserEmail, Text, Text) -> Either (UserEmail, Text, Text) (UserEmail, Text, Text) partStaff (CourseLecturer ,name,surn,mail) = Right (name,surn,mail) partStaff (_courseAssistant,name,surn,mail) = Left (name,surn,mail) diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index cbbe6631a..e6999d947 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -3,6 +3,8 @@ module Handler.Profile where import Import import Handler.Utils +import Handler.Utils.Profile +import Handler.Utils.Tokens -- import Colonnade hiding (fromMaybe, singleton) -- import Yesod.Colonnade @@ -16,9 +18,13 @@ import qualified Database.Esqueleto.Utils as E import qualified Data.CaseInsensitive as CI +import Jobs + data SettingsForm = SettingsForm - { stgMaxFavourties :: Int + { stgDisplayName :: UserDisplayName + , stgDisplayEmail :: UserEmail + , stgMaxFavourties :: Int , stgTheme :: Theme , stgDateTime :: DateTimeFormat , stgDate :: DateTimeFormat @@ -28,6 +34,7 @@ data SettingsForm = SettingsForm , stgSchools :: Set SchoolId , stgNotificationSettings :: NotificationSettings } +makeLenses_ ''SettingsForm data NotificationTriggerKind = NTKAll @@ -57,7 +64,10 @@ instance RenderMessage UniWorX NotificationTriggerKind where makeSettingForm :: Maybe SettingsForm -> Form SettingsForm makeSettingForm template html = do (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm - <$ aformSection MsgFormCosmetics + <$ aformSection MsgFormPersonalAppearance + <*> areq (textField & cfStrip) (fslI MsgUserDisplayName & setTooltip MsgUserDisplayNameRulesBelow) (stgDisplayName <$> template) + <*> areq (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUserDisplayEmailTip) (stgDisplayEmail <$> template) + <* aformSection MsgFormCosmetics <*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template) <*> areq (selectField . return $ mkOptionList themeList) @@ -150,30 +160,41 @@ notificationForm template = wFormToAForm $ do = apopt checkBoxField (fslI nt) (flip notificationAllowed nt <$> template) ntSection = \case - NTSubmissionRatedGraded -> Just NTKCourseParticipant - NTSubmissionRated -> Just NTKCourseParticipant - NTSheetActive -> Just NTKCourseParticipant - NTSheetSoonInactive -> Just NTKCourseParticipant - NTSheetInactive -> Just $ NTKFunctionary SchoolLecturer - NTCorrectionsAssigned -> Just NTKCorrector - NTCorrectionsNotDistributed -> Just $ NTKFunctionary SchoolLecturer - NTUserRightsUpdate -> Just NTKAll - NTUserAuthModeUpdate -> Just NTKAll - NTExamResult -> Just NTKExamParticipant - NTAllocationStaffRegister -> Just $ NTKFunctionary SchoolLecturer - NTAllocationAllocation -> Just NTKAllocationStaff - NTAllocationRegister -> Just NTKAll - NTAllocationOutdatedRatings -> Just NTKAllocationStaff - NTAllocationUnratedApplications -> Just NTKAllocationStaff - NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice - NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice - -- _other -> Nothing + NTSubmissionRatedGraded -> Just NTKCourseParticipant + NTSubmissionRated -> Just NTKCourseParticipant + NTSheetActive -> Just NTKCourseParticipant + NTSheetSoonInactive -> Just NTKCourseParticipant + NTSheetInactive -> Just $ NTKFunctionary SchoolLecturer + NTCorrectionsAssigned -> Just NTKCorrector + NTCorrectionsNotDistributed -> Just $ NTKFunctionary SchoolLecturer + NTUserRightsUpdate -> Just NTKAll + NTUserAuthModeUpdate -> Just NTKAll + NTExamRegistrationActive -> Just NTKCourseParticipant + NTExamRegistrationSoonInactive -> Just NTKCourseParticipant + NTExamDeregistrationSoonInactive -> Just NTKCourseParticipant + NTExamResult -> Just NTKExamParticipant + NTAllocationStaffRegister -> Just $ NTKFunctionary SchoolLecturer + NTAllocationAllocation -> Just NTKAllocationStaff + NTAllocationRegister -> Just NTKAll + NTAllocationOutdatedRatings -> Just NTKAllocationStaff + NTAllocationUnratedApplications -> Just NTKAllocationStaff + NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice + NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice + -- _other -> Nothing forcedTriggers = [NTUserRightsUpdate, NTUserAuthModeUpdate] aFormToWForm $ NotificationSettings <$> sectionedFuncForm ntSection nsForm (fslI MsgNotificationSettings) False +validateSettings :: User -> FormValidator SettingsForm Handler () +validateSettings User{..} = do + userDisplayName' <- use _stgDisplayName + + guardValidation MsgUserDisplayNameInvalid $ + validDisplayName userTitle userFirstName userSurname userDisplayName' + + data ButtonResetTokens = BtnResetTokens deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) instance Universe ButtonResetTokens @@ -196,7 +217,7 @@ nullaryPathPiece ''ProfileAnchor $ camelToPathPiece' 1 getProfileR, postProfileR :: Handler Html getProfileR = postProfileR postProfileR = do - (uid, User{..}) <- requireAuthPair + (uid, user@User{..}) <- requireAuthPair userSchools <- fmap (setOf $ folded . _Value) . runDB . E.select . E.from $ \school -> do E.where_ . E.exists . E.from $ \userSchool -> E.where_ $ E.not_ (userSchool E.^. UserSchoolIsOptOut) @@ -204,7 +225,9 @@ postProfileR = do E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId return $ school E.^. SchoolId let settingsTemplate = Just SettingsForm - { stgMaxFavourties = userMaxFavourites + { stgDisplayName = userDisplayName + , stgDisplayEmail = userDisplayEmail + , stgMaxFavourties = userMaxFavourites , stgTheme = userTheme , stgDateTime = userDateTimeFormat , stgDate = userDateFormat @@ -214,19 +237,24 @@ postProfileR = do , stgNotificationSettings = userNotificationSettings , stgWarningDays = userWarningDays } - ((res,formWidget), formEnctype) <- runFormPost . identifyForm ProfileSettings $ makeSettingForm settingsTemplate + ((res,formWidget), formEnctype) <- runFormPost . validateForm (validateSettings user) . identifyForm ProfileSettings $ makeSettingForm settingsTemplate formResult res $ \SettingsForm{..} -> do - runDB $ do - update uid [ UserMaxFavourites =. stgMaxFavourties - , UserTheme =. stgTheme - , UserDateTimeFormat =. stgDateTime - , UserDateFormat =. stgDate - , UserTimeFormat =. stgTime - , UserDownloadFiles =. stgDownloadFiles - , UserWarningDays =. stgWarningDays - , UserNotificationSettings =. stgNotificationSettings - ] + runDBJobs $ do + update uid $ + [ UserDisplayName =. stgDisplayName + , UserMaxFavourites =. stgMaxFavourties + , UserTheme =. stgTheme + , UserDateTimeFormat =. stgDateTime + , UserDateFormat =. stgDate + , UserTimeFormat =. stgTime + , UserDownloadFiles =. stgDownloadFiles + , UserWarningDays =. stgWarningDays + , UserNotificationSettings =. stgNotificationSettings + ] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ] + when (stgDisplayEmail /= userDisplayEmail) $ do + queueDBJob $ JobChangeUserDisplayEmail uid stgDisplayEmail + addMessageI Info $ MsgUserDisplayEmailChangeSent stgDisplayEmail when (stgMaxFavourties < userMaxFavourites) $ do -- prune Favourites to user-defined size oldFavs <- selectKeysList [ CourseFavouriteUser ==. uid] @@ -253,7 +281,7 @@ postProfileR = do } [ UserSchoolIsOptOut =. True ] - addMessageI Info MsgSettingsUpdate + addMessageI Success MsgSettingsUpdate redirect $ ProfileR :#: ProfileSettings ((tokenRes, tokenFormWidget), tokenEnctype) <- runFormPost . identifyForm ProfileResetTokens $ buttonForm @@ -287,6 +315,7 @@ postProfileR = do , formAnchor = Just ProfileResetTokens } tokenExplanation = $(i18nWidgetFile "profile/tokenExplanation") + displayNameRules = $(i18nWidgetFile "profile/displayNameRules") $(widgetFile "profile/profile") @@ -727,3 +756,43 @@ postUserNotificationR cID = do siteLayoutMsg (MsgNotificationSettingsHeading userDisplayName) $ do setTitleI $ MsgNotificationSettingsHeading userDisplayName formWidget + + +data ButtonSetDisplayEmail = BtnSetDisplayEmail + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) +instance Universe ButtonSetDisplayEmail +instance Finite ButtonSetDisplayEmail + +nullaryPathPiece ''ButtonSetDisplayEmail $ camelToPathPiece' 1 +embedRenderMessage ''UniWorX ''ButtonSetDisplayEmail id + +instance Button UniWorX ButtonSetDisplayEmail where + btnClasses _ = [BCIsButton] + + +getSetDisplayEmailR, postSetDisplayEmailR :: Handler Html +getSetDisplayEmailR = postSetDisplayEmailR +postSetDisplayEmailR = do + uid <- requireAuthId + mDisplayEmail <- requireCurrentTokenRestrictions + + case mDisplayEmail of + Nothing -> invalidArgs ["Bearer token required"] + Just displayEmail -> do + ((btnRes, btnView), btnEnc) <- runFormPost $ formEmbedJwtPost buttonForm + let btnView' = wrapForm btnView def + { formSubmit = FormNoSubmit + , formAction = Just $ SomeRoute SetDisplayEmailR + , formEncoding = btnEnc + } + + formResult btnRes $ \case + BtnSetDisplayEmail -> do + runDB $ + update uid [UserDisplayEmail =. displayEmail] + addMessageI Success MsgUserDisplayEmailChanged + redirect ProfileR + + siteLayoutMsg MsgTitleChangeUserDisplayEmail $ do + setTitleI MsgTitleChangeUserDisplayEmail + $(i18nWidgetFile "set-display-email") diff --git a/src/Handler/Users/Add.hs b/src/Handler/Users/Add.hs index 42834eb2e..b8e6efd35 100644 --- a/src/Handler/Users/Add.hs +++ b/src/Handler/Users/Add.hs @@ -16,6 +16,7 @@ data AdminUserForm = AdminUserForm , aufFirstName :: Text , aufSurname :: UserSurname , aufDisplayName :: UserDisplayName + , aufDisplayEmail :: UserEmail , aufMatriculation :: Maybe UserMatriculation , aufEmail :: UserEmail , aufIdent :: UserIdent @@ -44,6 +45,7 @@ adminUserForm template = renderAForm FormStandard <*> areq (textField & cfStrip) (fslI MsgAdminUserFirstName) (aufFirstName <$> template) <*> areq (textField & cfStrip) (fslI MsgAdminUserSurname) (aufSurname <$> template) <*> areq (textField & cfStrip) (fslI MsgAdminUserDisplayName) (aufDisplayName <$> template) + <*> areq (emailField & cfCI) (fslI MsgAdminUserDisplayEmail) (aufDisplayEmail <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserMatriculation) (aufMatriculation <$> template) <*> areq (emailField & cfCI) (fslI MsgAdminUserEmail) (aufEmail <$> template) <*> areq (textField & cfStrip & cfCI) (fslI MsgAdminUserIdent) (aufIdent <$> template) @@ -77,6 +79,7 @@ postAdminUserAddR = do , userLastAuthentication = Nothing , userEmail = aufEmail , userDisplayName = aufDisplayName + , userDisplayEmail = aufDisplayEmail , userFirstName = aufFirstName , userSurname = aufSurname , userTitle = aufTitle diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 3bc9955ba..20d04f535 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -981,15 +981,16 @@ sectionedFuncForm mkSection mkForm FieldSettings{fsName = _, fsAttrs = _, ..} is aFormToWForm $ Map.union <$> wFormToAForm (pure res) <*> acc funcFieldView :: (FormResult (k -> v), Widget) -> MForm m (FormResult (k -> v), [FieldView UniWorX]) - funcFieldView (res, fvInput) = do + funcFieldView (res, formView) = do mr <- getMessageRender + fvId <- maybe newIdent return fsId let fvLabel = toHtml $ mr fsLabel fvTooltip = fmap (toHtml . mr) fsTooltip fvRequired = isRequired fvErrors | FormFailure (err:_) <- res = Just $ toHtml err | otherwise = Nothing - fvId <- maybe newIdent return fsId + fvInput = $(widgetFile "widgets/fields/funcField") return (res, pure FieldView{..}) -- areq nsField (fslI MsgNotificationSettings) (stgNotficationSettings <$> template) diff --git a/src/Handler/Utils/Profile.hs b/src/Handler/Utils/Profile.hs new file mode 100644 index 000000000..ca272d6b8 --- /dev/null +++ b/src/Handler/Utils/Profile.hs @@ -0,0 +1,35 @@ +module Handler.Utils.Profile + ( validDisplayName + ) where + +import Import.NoFoundation + +import qualified Data.Text as Text +import qualified Data.MultiSet as MultiSet +import qualified Data.Set as Set + +import qualified Data.Char as Char + + +validDisplayName :: Maybe UserTitle + -> UserFirstName + -> UserSurname + -> UserDisplayName + -> Bool +validDisplayName (fmap Text.strip -> mTitle) (Text.strip -> fName) (Text.strip -> sName) (Text.strip -> dName) + = and [ dNameFrags `MultiSet.isSubsetOf` MultiSet.unions [titleFrags, fNameFrags, sNameFrags] + , sName `Text.isInfixOf` dName + , all ((<= 1) . Text.length) . filter (Text.any Char.isSpace) $ Text.groupBy ((==) `on` Char.isSpace) dName + , dNameLetters `Set.isSubsetOf` Set.unions [titleLetters, fNameLetters, sNameLetters, addLetters] + ] + where + titleFrags = MultiSet.fromList $ maybe [] Text.words mTitle + fNameFrags = MultiSet.fromList $ Text.words fName + sNameFrags = MultiSet.fromList $ Text.words sName + dNameFrags = MultiSet.fromList $ Text.words dName + + titleLetters = Set.fromList $ maybe [] unpack mTitle + fNameLetters = Set.fromList $ unpack fName + sNameLetters = Set.fromList $ unpack sName + dNameLetters = Set.fromList $ unpack dName + addLetters = Set.fromList [' '] diff --git a/src/Jobs.hs b/src/Jobs.hs index e5fee67d6..4a8654d90 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -68,6 +68,7 @@ import Jobs.Handler.SendPasswordReset import Jobs.Handler.TransactionLog import Jobs.Handler.SynchroniseLdap import Jobs.Handler.PruneInvitations +import Jobs.Handler.ChangeUserDisplayEmail import Jobs.HealthReport diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 3e6a489b9..1fde2b42c 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -212,17 +212,46 @@ determineCrontab = execWriterT $ do E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam return . E.max_ $ examResult E.^. ExamResultLastChanged - case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of - [E.Value (NTop (Just ts))] -> + whenIsJust examVisibleFrom $ \visibleFrom -> do + case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of + [E.Value (NTop (Just ts))] -> + tell $ HashMap.singleton + (JobCtlQueue $ JobQueueNotification NotificationExamResult{..}) + Cron + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom ts + , cronRepeat = CronRepeatOnChange + , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Left appNotificationExpiration + } + _other -> return () + + whenIsJust examRegisterFrom $ \registerFrom -> tell $ HashMap.singleton - (JobCtlQueue $ JobQueueNotification NotificationExamResult{..}) + (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationActive{..}) Cron - { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ ts - , cronRepeat = CronRepeatOnChange + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom registerFrom + , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit - , cronNotAfter = Left $ 14 * nominalDay + , cronNotAfter = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) examRegisterTo + } + whenIsJust ((,) <$> examRegisterFrom <*> examRegisterTo) $ \(registerFrom, registerTo) -> + tell $ HashMap.singleton + (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationSoonInactive{..}) + Cron + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) registerTo + , cronRepeat = CronRepeatOnChange + , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ registerTo + } + whenIsJust ((,) <$> examRegisterFrom <*> examDeregisterUntil) $ \(registerFrom, deregisterUntil) -> + tell $ HashMap.singleton + (JobCtlQueue $ JobQueueNotification NotificationExamDeregistrationSoonInactive{..}) + Cron + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) deregisterUntil + , cronRepeat = CronRepeatOnChange + , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ deregisterUntil } - _other -> return () case examClosed of Just close -> do diff --git a/src/Jobs/Handler/ChangeUserDisplayEmail.hs b/src/Jobs/Handler/ChangeUserDisplayEmail.hs new file mode 100644 index 000000000..dd5e8f0d4 --- /dev/null +++ b/src/Jobs/Handler/ChangeUserDisplayEmail.hs @@ -0,0 +1,29 @@ +module Jobs.Handler.ChangeUserDisplayEmail + ( dispatchJobChangeUserDisplayEmail + ) where + +import Import + +import Handler.Utils.Mail +import qualified Data.HashSet as HashSet +import qualified Data.CaseInsensitive as CI + +import Text.Hamlet + +dispatchJobChangeUserDisplayEmail :: UserId -> UserEmail -> Handler () +dispatchJobChangeUserDisplayEmail jUser jDisplayEmail = do + token <- tokenRestrict SetDisplayEmailR jDisplayEmail <$> bearerToken jUser (Just $ HashSet.singleton SetDisplayEmailR) Nothing Nothing Nothing + jwt <- encodeToken token + let + setDisplayEmailUrl :: SomeRoute UniWorX + setDisplayEmailUrl = SomeRoute (SetDisplayEmailR, [(toPathPiece GetBearer, toPathPiece jwt)]) + setDisplayEmailUrl' <- toTextUrl setDisplayEmailUrl + + user@User{..} <- runDB $ getJust jUser + + userMailT jUser $ do + _mailTo .= pure (userAddress user & _addressEmail .~ CI.original jDisplayEmail) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI MsgMailSubjectChangeUserDisplayEmail + addAlternatives $ + providePreferredAlternative ($(ihamletFile "templates/mail/changeUserDisplayEmail.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 040fe7982..2fb31851f 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -75,6 +75,29 @@ determineNotificationCandidates NotificationUserRightsUpdate{..} = do return . nub $ affectedUser <> affectedAdmins determineNotificationCandidates NotificationUserAuthModeUpdate{..} = selectList [UserId ==. nUser] [] +determineNotificationCandidates NotificationExamRegistrationActive{..} = + E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do + E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId + E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse + E.where_ $ exam E.^. ExamId E.==. E.val nExam + E.where_ . E.not_ . E.exists . E.from $ \examRegistration -> + E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId + E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam + return user +determineNotificationCandidates NotificationExamRegistrationSoonInactive{..} = + E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do + E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId + E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse + E.where_ $ exam E.^. ExamId E.==. E.val nExam + E.where_ . E.not_ . E.exists . E.from $ \examRegistration -> + E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId + E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam + return user +determineNotificationCandidates NotificationExamDeregistrationSoonInactive{..} = + E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do + E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId + E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val nExam + return user determineNotificationCandidates notif@NotificationExamResult{..} = do lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif E.select . E.from $ \(examResult `E.InnerJoin` user) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do @@ -183,18 +206,21 @@ classifyNotification NotificationSubmissionRated{..} = do return $ case sheetType of NotGraded -> NTSubmissionRated _other -> NTSubmissionRatedGraded -classifyNotification NotificationSheetActive{} = return NTSheetActive -classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive -classifyNotification NotificationSheetInactive{} = return NTSheetInactive -classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned -classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed -classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate -classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate -classifyNotification NotificationExamResult{} = return NTExamResult -classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister -classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation -classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister -classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings -classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications -classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults -classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged +classifyNotification NotificationSheetActive{} = return NTSheetActive +classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive +classifyNotification NotificationSheetInactive{} = return NTSheetInactive +classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned +classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed +classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate +classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate +classifyNotification NotificationExamRegistrationActive{} = return NTExamRegistrationActive +classifyNotification NotificationExamRegistrationSoonInactive{} = return NTExamRegistrationSoonInactive +classifyNotification NotificationExamDeregistrationSoonInactive{} = return NTExamDeregistrationSoonInactive +classifyNotification NotificationExamResult{} = return NTExamResult +classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister +classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation +classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister +classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings +classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications +classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults +classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs index 1813b1efd..b4cbaf0be 100644 --- a/src/Jobs/Handler/SendNotification.hs +++ b/src/Jobs/Handler/SendNotification.hs @@ -14,6 +14,7 @@ import Jobs.Handler.SendNotification.CorrectionsAssigned import Jobs.Handler.SendNotification.CorrectionsNotDistributed import Jobs.Handler.SendNotification.UserRightsUpdate import Jobs.Handler.SendNotification.UserAuthModeUpdate +import Jobs.Handler.SendNotification.ExamActive import Jobs.Handler.SendNotification.ExamResult import Jobs.Handler.SendNotification.Allocation import Jobs.Handler.SendNotification.ExamOffice diff --git a/src/Jobs/Handler/SendNotification/ExamActive.hs b/src/Jobs/Handler/SendNotification/ExamActive.hs new file mode 100644 index 000000000..9751a6bf7 --- /dev/null +++ b/src/Jobs/Handler/SendNotification/ExamActive.hs @@ -0,0 +1,78 @@ +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results + +module Jobs.Handler.SendNotification.ExamActive + ( dispatchNotificationExamRegistrationActive + , dispatchNotificationExamRegistrationSoonInactive + , dispatchNotificationExamDeregistrationSoonInactive + ) where + +import Import + +import Handler.Utils.Mail +import Jobs.Handler.SendNotification.Utils + +import Text.Hamlet +import qualified Data.CaseInsensitive as CI + +dispatchNotificationExamRegistrationActive :: ExamId -> UserId -> Handler () +dispatchNotificationExamRegistrationActive nExam jRecipient = userMailT jRecipient $ do + (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do + exam <- getJust nExam + course <- belongsToJust examCourse exam + return (course, exam) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI $ MsgMailSubjectExamRegistrationActive courseShorthand examName + + MsgRenderer mr <- getMailMsgRenderer + let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm + tid = courseTerm + ssh = courseSchool + csh = courseShorthand + examn = examName + + editNotifications <- mkEditNotifications jRecipient + + addAlternatives $ + providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + +dispatchNotificationExamRegistrationSoonInactive :: ExamId -> UserId -> Handler () +dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do + (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do + exam <- getJust nExam + course <- belongsToJust examCourse exam + return (course, exam) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI $ MsgMailSubjectExamRegistrationSoonInactive courseShorthand examName + + MsgRenderer mr <- getMailMsgRenderer + let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm + tid = courseTerm + ssh = courseSchool + csh = courseShorthand + examn = examName + + editNotifications <- mkEditNotifications jRecipient + + addAlternatives $ + providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + +dispatchNotificationExamDeregistrationSoonInactive :: ExamId -> UserId -> Handler () +dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do + (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do + exam <- getJust nExam + course <- belongsToJust examCourse exam + return (course, exam) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI $ MsgMailSubjectExamDeregistrationSoonInactive courseShorthand examName + + MsgRenderer mr <- getMailMsgRenderer + let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm + tid = courseTerm + ssh = courseSchool + csh = courseShorthand + examn = examName + + editNotifications <- mkEditNotifications jRecipient + + addAlternatives $ + providePreferredAlternative ($(ihamletFile "templates/mail/examDeregistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 2bcf132df..df8a0dbe7 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -64,6 +64,9 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica } | JobSynchroniseLdapUser { jUser :: UserId } + | JobChangeUserDisplayEmail { jUser :: UserId + , jDisplayEmail :: UserEmail + } deriving (Eq, Ord, Show, Read, Generic, Typeable) data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationSheetActive { nSheet :: SheetId } @@ -73,6 +76,9 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationCorrectionsNotDistributed { nSheet :: SheetId } | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) } | NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode } + | NotificationExamRegistrationActive { nExam :: ExamId } + | NotificationExamRegistrationSoonInactive { nExam :: ExamId } + | NotificationExamDeregistrationSoonInactive { nExam :: ExamId } | NotificationExamResult { nExam :: ExamId } | NotificationAllocationStaffRegister { nAllocation :: AllocationId } | NotificationAllocationRegister { nAllocation :: AllocationId } diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index c9a2b95ce..fb64f2129 100644 --- a/src/Model/Migration.hs +++ b/src/Model/Migration.hs @@ -485,6 +485,14 @@ customMigrations = Map.fromListWith (>>) DELETE FROM "invitation" WHERE "for"->'junction' = '"UserLecturer"'; |] ) + , ( AppliedMigrationKey [migrationVersion|19.0.0|] [version|20.0.0|] + , whenM (tableExists "user") $ do + [executeQQ| + ALTER TABLE "user" ADD COLUMN IF NOT EXISTS "display_email" citext; + UPDATE "user" SET "display_email" = "email" WHERE "display_email" IS NULL; + ALTER TABLE "user" ALTER COLUMN "display_email" SET NOT NULL; + |] + ) ] diff --git a/src/Model/Types/Common.hs b/src/Model/Types/Common.hs index a023f44d7..50048eb42 100644 --- a/src/Model/Types/Common.hs +++ b/src/Model/Types/Common.hs @@ -18,8 +18,10 @@ type Points = Centi type Email = Text -type UserDisplayName = Text +type UserTitle = Text +type UserFirstName = Text type UserSurname = Text +type UserDisplayName = Text type UserMatriculation = Text type StudyDegreeName = Text diff --git a/src/Model/Types/Mail.hs b/src/Model/Types/Mail.hs index 466aa0595..b0f937314 100644 --- a/src/Model/Types/Mail.hs +++ b/src/Model/Types/Mail.hs @@ -31,6 +31,9 @@ data NotificationTrigger | NTCorrectionsNotDistributed | NTUserRightsUpdate | NTUserAuthModeUpdate + | NTExamRegistrationActive + | NTExamRegistrationSoonInactive + | NTExamDeregistrationSoonInactive | NTExamResult | NTAllocationStaffRegister | NTAllocationAllocation @@ -67,6 +70,7 @@ instance Default NotificationSettings where defaultOff :: HashSet NotificationTrigger defaultOff = HashSet.fromList [ NTSheetSoonInactive + , NTExamRegistrationSoonInactive ] instance ToJSON NotificationSettings where diff --git a/templates/course/applications-list.hamlet b/templates/course/applications-list.hamlet new file mode 100644 index 000000000..9cb6253fc --- /dev/null +++ b/templates/course/applications-list.hamlet @@ -0,0 +1,22 @@ +$newline never +$if not (null allocationsBounds) +

_{MsgCourseAllocationsBounds (length allocationsBounds)} +
+ $forall (Allocation{allocationName, allocationRegisterTo}, numApps, numFirstChoice, capped) <- allocationsBounds +
+ #{allocationName} +
+

+ $if numApps == numFirstChoice + _{MsgCourseAllocationsBoundCoincide numFirstChoice} + $else + _{MsgCourseAllocationsBound numApps numFirstChoice} + $if capped +

+ _{MsgCourseAllocationsBoundCapped} + $if registrationOpen allocationRegisterTo +

+ _{MsgCourseAllocationsBoundWarningOpen} + +

_{MsgMenuCourseApplications} +^{table} diff --git a/templates/course/applications-list.lucius b/templates/course/applications-list.lucius new file mode 100644 index 000000000..55579838c --- /dev/null +++ b/templates/course/applications-list.lucius @@ -0,0 +1,4 @@ +.bound_explanation { + color: var(--color-fontsec); + font-style: italic; +} diff --git a/templates/i18n/changelog/de.hamlet b/templates/i18n/changelog/de.hamlet index 3eb49216d..7c966d3ad 100644 --- a/templates/i18n/changelog/de.hamlet +++ b/templates/i18n/changelog/de.hamlet @@ -1,5 +1,19 @@ $newline never
+
+ ^{formatGregorianW 2019 09 13} +
+
    +
  • Benachrichtigungen bzgl. Klausur An- und Abmeldung + +
    + ^{formatGregorianW 2019 09 12} +
    +
      +
    • Abschätzung der durch Zentralanmeldung benötigten Kurskapazität +
    • Anpassbare angezeigte Namen +
    • Anpassbare angezeigte E-Mail Adressen +
      ^{formatGregorianW 2019 09 05}
      diff --git a/templates/i18n/profile/displayNameRules/de.hamlet b/templates/i18n/profile/displayNameRules/de.hamlet new file mode 100644 index 000000000..733c0baab --- /dev/null +++ b/templates/i18n/profile/displayNameRules/de.hamlet @@ -0,0 +1,9 @@ +$newline never +
        +
      • Der Nachname („#{userSurname}“) muss im angezeigten Namen vollständig enthalten sein. + $maybe title <- userTitle +
      • Der angezeigte Name muss vollständig aus Fragmenten des akademischen Titels („#{title}“), des Vornamens („#{userFirstName}“) und des Nachnamens („#{userSurname}“) bestehen. + $nothing +
      • Der angezeigte Name muss vollständig aus Fragmenten des Vornamens („#{userFirstName}“) und des Nachnamens („#{userSurname}“) bestehen. +
      • Der angezeigte Name darf keine mehrfachen Leerzeichen enthalten. +
      • Der angezeigter Name darf keine Sonderzeichen enthalten, die in keinem der Namensbestandteile vorkommen. diff --git a/templates/i18n/set-display-email/de.hamlet b/templates/i18n/set-display-email/de.hamlet new file mode 100644 index 000000000..72ce89746 --- /dev/null +++ b/templates/i18n/set-display-email/de.hamlet @@ -0,0 +1,4 @@ +$newline never +

        + Möchten Sie die, öffentlich im Zusammenhang mit Ihrem Namen angezeigte, E-Mail Adresse wirklich auf „#{displayEmail}“ setzen? +^{btnView'} diff --git a/templates/mail/changeUserDisplayEmail.hamlet b/templates/mail/changeUserDisplayEmail.hamlet new file mode 100644 index 000000000..6f4914d36 --- /dev/null +++ b/templates/mail/changeUserDisplayEmail.hamlet @@ -0,0 +1,19 @@ +$newline never +\ + + + +