Merge branch 'master' into exam-office

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)
 
 

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;

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

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)
+    displayName    UserDisplayName
-    email          (CI Text)                -- Case-insensitive eMail address
+    displayEmail   UserEmail
-    ident          (CI Text)                -- Case-insensitive user-identifier
+    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()

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "6.7.0",
+  "version": "6.10.0",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "6.7.0",
+  "version": "6.10.0",
   "description": "",
   "keywords": [],
   "author": "",

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

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

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 ProfileR         = return ("Einstellungen"    , Just HomeR)
-  breadcrumb ProfileDataR     = return ("Profile"          , Just ProfileR)
+  breadcrumb SetDisplayEmailR = return ("Öffentliche E-Mail Adresse", Just ProfileR)
-  breadcrumb AuthPredsR       = return ("Authentifizierung", 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
+  userDisplayName' <- if
-    | [bs] <- userDisplayName'
+    | [bs] <- userDisplayName''
-    , Right userDisplayName <- Text.decodeUtf8' bs
+    , Right userDisplayName' <- Text.decodeUtf8' bs
-      -> return userDisplayName
+      -> 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

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
+  (table, allocationsBounds) <- runDB $ do
-    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+    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")

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

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)

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
+      NTSubmissionRatedGraded          -> Just NTKCourseParticipant
-      NTSubmissionRated               -> Just NTKCourseParticipant
+      NTSubmissionRated                -> Just NTKCourseParticipant
-      NTSheetActive                   -> Just NTKCourseParticipant
+      NTSheetActive                    -> Just NTKCourseParticipant
-      NTSheetSoonInactive             -> Just NTKCourseParticipant
+      NTSheetSoonInactive              -> Just NTKCourseParticipant
-      NTSheetInactive                 -> Just $ NTKFunctionary SchoolLecturer
+      NTSheetInactive                  -> Just $ NTKFunctionary SchoolLecturer
-      NTCorrectionsAssigned           -> Just NTKCorrector
+      NTCorrectionsAssigned            -> Just NTKCorrector
-      NTCorrectionsNotDistributed     -> Just $ NTKFunctionary SchoolLecturer
+      NTCorrectionsNotDistributed      -> Just $ NTKFunctionary SchoolLecturer
-      NTUserRightsUpdate              -> Just NTKAll
+      NTUserRightsUpdate               -> Just NTKAll
-      NTUserAuthModeUpdate            -> Just NTKAll
+      NTUserAuthModeUpdate             -> Just NTKAll
-      NTExamResult                    -> Just NTKExamParticipant
+      NTExamRegistrationActive         -> Just NTKCourseParticipant
-      NTAllocationStaffRegister       -> Just $ NTKFunctionary SchoolLecturer
+      NTExamRegistrationSoonInactive   -> Just NTKCourseParticipant
-      NTAllocationAllocation          -> Just NTKAllocationStaff
+      NTExamDeregistrationSoonInactive -> Just NTKCourseParticipant
-      NTAllocationRegister            -> Just NTKAll
+      NTExamResult                     -> Just NTKExamParticipant
-      NTAllocationOutdatedRatings     -> Just NTKAllocationStaff
+      NTAllocationStaffRegister        -> Just $ NTKFunctionary SchoolLecturer
-      NTAllocationUnratedApplications -> Just NTKAllocationStaff
+      NTAllocationAllocation           -> Just NTKAllocationStaff
-      NTExamOfficeExamResults         -> Just $ NTKFunctionary SchoolExamOffice
+      NTAllocationRegister             -> Just NTKAll
-      NTExamOfficeExamResultsChanged  -> Just $ NTKFunctionary SchoolExamOffice
+      NTAllocationOutdatedRatings      -> Just NTKAllocationStaff
-      -- _other                       -> Nothing
+      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
+    runDBJobs $ do
-      update uid  [ UserMaxFavourites  =. stgMaxFavourties
+      update uid $
-                  , UserTheme          =. stgTheme
+        [ UserDisplayName    =. stgDisplayName
-                  , UserDateTimeFormat =. stgDateTime
+        , UserMaxFavourites  =. stgMaxFavourties
-                  , UserDateFormat     =. stgDate
+        , UserTheme          =. stgTheme
-                  , UserTimeFormat     =. stgTime
+        , UserDateTimeFormat =. stgDateTime
-                  , UserDownloadFiles  =. stgDownloadFiles
+        , UserDateFormat     =. stgDate
-                  , UserWarningDays    =. stgWarningDays
+        , UserTimeFormat     =. stgTime
-                  , UserNotificationSettings =. stgNotificationSettings
+        , 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")

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

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)
 

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 [' ']

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
 

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
+      whenIsJust examVisibleFrom $ \visibleFrom -> do
-        [E.Value (NTop (Just ts))] -> 
+        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
+              { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom registerFrom
-              , cronRepeat = CronRepeatOnChange
+              , 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

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

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 NotificationSheetActive{}                    = return NTSheetActive
-classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive
+classifyNotification NotificationSheetSoonInactive{}              = return NTSheetSoonInactive
-classifyNotification NotificationSheetInactive{} = return NTSheetInactive
+classifyNotification NotificationSheetInactive{}                  = return NTSheetInactive
-classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned
+classifyNotification NotificationCorrectionsAssigned{}            = return NTCorrectionsAssigned
-classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed
+classifyNotification NotificationCorrectionsNotDistributed{}      = return NTCorrectionsNotDistributed
-classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate
+classifyNotification NotificationUserRightsUpdate{}               = return NTUserRightsUpdate
-classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate
+classifyNotification NotificationUserAuthModeUpdate{}             = return NTUserAuthModeUpdate
-classifyNotification NotificationExamResult{} = return NTExamResult
+classifyNotification NotificationExamRegistrationActive{}         = return NTExamRegistrationActive
-classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
+classifyNotification NotificationExamRegistrationSoonInactive{}   = return NTExamRegistrationSoonInactive
-classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
+classifyNotification NotificationExamDeregistrationSoonInactive{} = return NTExamDeregistrationSoonInactive
-classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
+classifyNotification NotificationExamResult{}                     = return NTExamResult
-classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings
+classifyNotification NotificationAllocationStaffRegister{}        = return NTAllocationStaffRegister
-classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
+classifyNotification NotificationAllocationAllocation{}           = return NTAllocationAllocation
-classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
+classifyNotification NotificationAllocationRegister{}             = return NTAllocationRegister
-classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
+classifyNotification NotificationAllocationOutdatedRatings{}      = return NTAllocationOutdatedRatings
+classifyNotification NotificationAllocationUnratedApplications{}  = return NTAllocationUnratedApplications
+classifyNotification NotificationExamOfficeExamResults{}          = return NTExamOfficeExamResults
+classifyNotification NotificationExamOfficeExamResultsChanged{}   = return NTExamOfficeExamResultsChanged

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

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

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 }

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;
+        |]
+    )
   ]
 
 

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

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

templates/course/applications-list.hamlet

@@ -0,0 +1,22 @@
+$newline never
+$if not (null allocationsBounds)
+  <h2>_{MsgCourseAllocationsBounds (length allocationsBounds)}
+  <dl .deflist>
+    $forall (Allocation{allocationName, allocationRegisterTo}, numApps, numFirstChoice, capped) <- allocationsBounds
+      <dt .deflist__dt>
+        #{allocationName}
+      <dd .deflist__dd>
+        <p>
+          $if numApps == numFirstChoice
+            _{MsgCourseAllocationsBoundCoincide numFirstChoice}
+          $else
+            _{MsgCourseAllocationsBound numApps numFirstChoice}
+        $if capped
+          <p .bound_explanation>
+            _{MsgCourseAllocationsBoundCapped}
+        $if registrationOpen allocationRegisterTo
+          <p .bound_explanation>
+            _{MsgCourseAllocationsBoundWarningOpen}
+
+<h2>_{MsgMenuCourseApplications}
+^{table}

templates/course/applications-list.lucius

@@ -0,0 +1,4 @@
+.bound_explanation {
+  color: var(--color-fontsec);
+  font-style: italic;
+}

templates/i18n/changelog/de.hamlet

@@ -1,5 +1,19 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2019 09 13}
+  <dd .deflist__dd>
+    <ul>
+      <li>Benachrichtigungen bzgl. Klausur An- und Abmeldung
+
+  <dt .deflist__dt>
+    ^{formatGregorianW 2019 09 12}
+  <dd .deflist__dd>
+    <ul>
+      <li>Abschätzung der durch Zentralanmeldung benötigten Kurskapazität
+      <li>Anpassbare angezeigte Namen
+      <li>Anpassbare angezeigte E-Mail Adressen
+      
   <dt .deflist__dt>
     ^{formatGregorianW 2019 09 05}
   <dd .deflist__dd>

templates/i18n/profile/displayNameRules/de.hamlet

@@ -0,0 +1,9 @@
+$newline never
+<ul>
+  <li>Der Nachname („#{userSurname}“) muss im angezeigten Namen vollständig enthalten sein.
+  $maybe title <- userTitle
+    <li>Der angezeigte Name muss vollständig aus Fragmenten des akademischen Titels („#{title}“), des Vornamens („#{userFirstName}“) und des Nachnamens („#{userSurname}“) bestehen.
+  $nothing
+    <li>Der angezeigte Name muss vollständig aus Fragmenten des Vornamens („#{userFirstName}“) und des Nachnamens („#{userSurname}“) bestehen.
+  <li>Der angezeigte Name darf keine mehrfachen Leerzeichen enthalten.
+  <li>Der angezeigter Name darf keine Sonderzeichen enthalten, die in keinem der Namensbestandteile vorkommen.

templates/i18n/set-display-email/de.hamlet

@@ -0,0 +1,4 @@
+$newline never
+<p>
+  Möchten Sie die, öffentlich im Zusammenhang mit Ihrem Namen angezeigte, E-Mail Adresse wirklich auf „#{displayEmail}“ setzen?
+^{btnView'}

templates/mail/changeUserDisplayEmail.hamlet

@@ -0,0 +1,19 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{MsgMailTitleChangeUserDisplayEmail userDisplayName}
+    <p>
+      _{MsgMailIntroChangeUserDisplayEmail jDisplayEmail}
+    <p>
+      <a href=#{setDisplayEmailUrl'}>
+        _{MsgBtnSetDisplayEmail}

templates/mail/examDeregistrationSoonInactive.hamlet

@@ -0,0 +1,18 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{MsgMailExamDeregistrationSoonInactiveIntro (CI.original courseName) termDesc examName}
+    <p>
+      <a href=@{CExamR tid ssh csh examn EShowR}>
+        #{examName}
+    ^{editNotifications}

templates/mail/examRegistrationActive.hamlet

@@ -0,0 +1,18 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{MsgMailExamRegistrationActiveIntro (CI.original courseName) termDesc examName}
+    <p>
+      <a href=@{CExamR tid ssh csh examn EShowR}>
+        #{examName}
+    ^{editNotifications}

templates/mail/examRegistrationSoonInactive.hamlet

@@ -0,0 +1,18 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{MsgMailExamRegistrationSoonInactiveIntro (CI.original courseName) termDesc examName}
+    <p>
+      <a href=@{CExamR tid ssh csh examn EShowR}>
+        #{examName}
+    ^{editNotifications}

templates/profile/profile.hamlet

@@ -1,6 +1,10 @@
 $newline never
 <section>
   ^{settingsForm}
+<section>
+  <h3>_{MsgUserDisplayNameRules}
+  <p>
+    ^{displayNameRules}
 <section>
   ^{tokenExplanation}
   <p>

templates/widgets/fields/funcField.hamlet

@@ -0,0 +1,3 @@
+$newline never
+<div ##{fvId <> "-wrapper"}>
+  ^{formView}

templates/widgets/fields/funcField.lucius

@@ -0,0 +1,4 @@
+##{fvId <> "-wrapper"} {
+  max-height: 75vh;
+  overflow: auto;
+}

test/Database.hs

@@ -93,6 +93,7 @@ fillDb = do
     , userTokensIssuedAfter = Just now
     , userMatrikelnummer = Nothing
     , userEmail  = "G.Kleen@campus.lmu.de"
+    , userDisplayEmail = "gregor.kleen@ifi.lmu.de"
     , userDisplayName = "Gregor Kleen"
     , userSurname = "Kleen"
     , userFirstName = "Gregor Julius Arthur"
@@ -116,6 +117,7 @@ fillDb = do
     , userTokensIssuedAfter = Nothing
     , userMatrikelnummer = Nothing
     , userEmail  = "felix.hamann@campus.lmu.de"
+    , userDisplayEmail = "felix.hamann@campus.lmu.de"
     , userDisplayName = "Felix Hamann"
     , userSurname = "Hamann"
     , userFirstName = "Felix"
@@ -139,6 +141,7 @@ fillDb = do
     , userTokensIssuedAfter = Nothing
     , userMatrikelnummer = Nothing
     , userEmail  = "jost@tcs.ifi.lmu.de"
+    , userDisplayEmail = "jost@tcs.ifi.lmu.de"
     , userDisplayName = "Steffen Jost"
     , userSurname = "Jost"
     , userFirstName = "Steffen"
@@ -162,6 +165,7 @@ fillDb = do
     , userTokensIssuedAfter = Nothing
     , userMatrikelnummer = Just "1299"
     , userEmail  = "max@campus.lmu.de"
+    , userDisplayEmail = "max@max.com"
     , userDisplayName = "Max Musterstudent"
     , userSurname = "Musterstudent"
     , userFirstName = "Max"
@@ -185,6 +189,7 @@ fillDb = do
     , userTokensIssuedAfter = Nothing
     , userMatrikelnummer = Just "999"
     , userEmail  = "tester@campus.lmu.de"
+    , userDisplayEmail = "tina@tester.example"
     , userDisplayName = "Tina Tester"
     , userSurname = "von Terror"
     , userFirstName = "Sabrina"
@@ -208,6 +213,7 @@ fillDb = do
     , userTokensIssuedAfter = Nothing
     , userMatrikelnummer = Nothing
     , userEmail  = "vaupel.sarah@campus.lmu.de"
+    , userDisplayEmail = "vaupel.sarah@campus.lmu.de"
     , userDisplayName = "Sarah Vaupel"
     , userSurname = "Vaupel"
     , userFirstName = "Sarah"

test/ModelSpec.hs

@@ -80,6 +80,7 @@ instance Arbitrary User where
     userTokensIssuedAfter <- arbitrary
     userMatrikelnummer <- fmap pack . assertM' (not . null) <$> listOf (elements ['0'..'9'])
     userEmail <- CI.mk . decodeUtf8 . Email.toByteString <$> arbitrary
+    userDisplayEmail <- CI.mk . decodeUtf8 . Email.toByteString <$> arbitrary
 
     names <- listOf1 $ pack . getPrintableString <$> arbitrary
     userDisplayName <- unwords <$> sublistOf names

test/TestImport.hs

@@ -116,6 +116,7 @@ createUser adjUser = do
     userTokensIssuedAfter = Nothing
     userIdent = "dummy@example.invalid"
     userEmail = "dummy@example.invalid"
+    userDisplayEmail = "dummy@example.invalid"
     userDisplayName = "Dummy Example"
     userSurname = "Example"
     userFirstName = "Dummy"