feat(allocations): notify about new courses

2020-09-24 21:48:23 +02:00 · 2020-09-24 21:48:23 +02:00 · 18921e06d1
commit 18921e06d1
parent b359468593
27 changed files with 550 additions and 139 deletions
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@ -789,6 +789,15 @@ FormBehaviour: Verhalten
 FormCosmetics: Oberfläche
 FormPersonalAppearance: Öffentliche Daten
 FormFieldRequiredTip: Gekennzeichnete Pflichtfelder sind immer auszufüllen
+FormAllocationNotifications: Benachrichtigungen für neue Zentralanmeldungskurse
+FormAllocationNotificationsTip: Wollen Sie eine Benachrichtigung per E-Mail erhalten wenn ein neuer Kurs zur Zentralanmeldung eingetragen wird? „Ja“ und „Nein“ überschreiben die entsprechende systemweite Einstellung unter "Benachrichtigungen"
+
+AllocNotifyNewCourseDefault: Systemweite Einstellung
+AllocNotifyNewCourseForceOff: Nein
+AllocNotifyNewCourseForceOn: Ja
+
+BtnNotifyNewCourseForceOn: Benachrichtigen
+BtnNotifyNewCourseForceOff: Nicht benachrichtigen

 PersonalInfoExamAchievementsWip: Die Anzeige von Prüfungsergebnissen wird momentan an dieser Stelle leider noch nicht unterstützt.
 PersonalInfoOwnTutorialsWip: Die Anzeige von Tutorien, zu denen Sie als Tutor eingetragen sind wird momentan an dieser Stelle leider noch nicht unterstützt.
@ -1132,6 +1141,8 @@ NotificationTriggerCourseRegistered: Ein Kursverwalter hat mich zu einem Kurs an
 NotificationTriggerSubmissionUserCreated: Ich wurde als Mitabgebender zu einer Übungsblatt-Abgabe hinzugefügt
 NotificationTriggerSubmissionEdited: Eine meiner Übungsblatt-Abgaben wurde verändert
 NotificationTriggerSubmissionUserDeleted: Ich wurde als Mitabgebender von einer Übungsblatt-Abgabe entfernt
+NotificationTriggerAllocationNewCourse: Es wurde ein neuer Kurs eingetragen zu einer Zentralanmeldungen, für die ich mich beworben habe
+NotificationTriggerAllocationNewCourseTip: Kann pro Zentralanmeldung überschrieben werden

 NotificationTriggerKindAll: Für alle Benutzer
 NotificationTriggerKindCourseParticipant: Für Kursteilnehmer
@ -2200,6 +2211,13 @@ ApplicationRatingCommentVisibleTip: Feedback an den Bewerbers
 ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursverwalter
 ApplicationRatingSection: Bewertung
 ApplicationRatingSectionSelfTip: Sie verfügen über hinreichende Authorisierung um sowohl die Bewerbung als auch ihre Bewertung zu editieren.
+AllocationNotificationNewCourse: Benachrichtigung bei neuen Kursen
+AllocationNotificationNewCourseTip: Wollen Sie per E-Mail benachrichtigt werden, wenn für diese Zentralanmeldung ein neuer Kurs eingetragen wird? Dies überschreibt die systemweite Einstellung in "Anpassen".
+AllocationNotificationNewCourseSuccessForceOn: Sie werden benachrichtigt, wenn ein neuer Kurs eingetragen wird
+AllocationNotificationNewCourseSuccessForceOff: Sie werden nicht benachrichtigt, wenn ein neuer Kurs eingetragen wird
+AllocationNotificationNewCourseCurrentlyOff: Aktuell würden Sie keine Benachrichtigung erhalten.
+AllocationNotificationNewCourseCurrentlyOn: Aktuell würden Sie benachrichtigt werden.
+AllocationNotificationLoginFirst: Um Ihre Benachrichtigungseinstellungen zu ändern, loggen Sie sich bitte zunächst ein.

 AllocationSchoolShort: Institut
 Allocation: Zentralanmeldung
@ -2291,6 +2309,11 @@ MailAllocationUnratedApplicationsIntroMultiple n@Int: Es stehen noch Bewertungen
 MailAllocationUnratedApplications n@Int: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"} an den jeweiligen Kurs gestellt wurden, die entweder noch nicht bewertet wurden oder die nach der Bewertung noch verändert wurden und deswegen neu bewertet werden müssen.
 MailAllocationUnratedApplicationsCount i@Natural: #{i} #{pluralDE i "Bewerbung" "Bewerbungen"}

+MailSubjectAllocationNewCourse allocation@AllocationName: Es wurde ein zusätzlicher Kurs zur Zentralanmeldung „#{allocation}” eingetragen
+MailAllocationNewCourseTip: Es wurde der folgende Kurs zur Zentralanmeldung eingetragen:
+MailAllocationNewCourseEditApplicationsHere: Sie können Ihre Bewerbung(en) hier anpassen:
+MailAllocationNewCourseApplyHere: Sie können sich hier bewerben:
+
 ExamOfficeSubscribedUsers: Benutzer
 ExamOfficeSubscribedUsersTip: Sie können mehrere Matrikelnummern mit Komma separieren

--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@ -786,6 +786,15 @@ FormBehaviour: Behaviour
 FormCosmetics: Interface
 FormPersonalAppearance: Public data
 FormFieldRequiredTip: Required fields
+FormAllocationNotifications: Notifications for new central allocation courses
+FormAllocationNotificationsTip: Do you want to receive a notification if a new course is added to the central allocation? “Yes” and “No” override the system wide setting under “Notifications”
+
+AllocNotifyNewCourseDefault: System wide setting
+AllocNotifyNewCourseForceOff: No
+AllocNotifyNewCourseForceOn: Yes
+
+BtnNotifyNewCourseForceOn: Notify me
+BtnNotifyNewCourseForceOff: Do not notify me

 PersonalInfoExamAchievementsWip: The feature to display your exam achievements has not yet been implemented.
 PersonalInfoOwnTutorialsWip: The feature to display tutorials you have been assigned to as tutor has not yet been implemented.
@ -1133,6 +1142,8 @@ NotificationTriggerCourseRegistered: A course administrator has enrolled me in a
 NotificationTriggerSubmissionUserCreated: I was added to an exercise sheet submission
 NotificationTriggerSubmissionEdited: One of my exercise sheet submissions was changed
 NotificationTriggerSubmissionUserDeleted: I was removed from one of my exercise sheet submissions
+NotificationTriggerAllocationNewCourse: A new course was added to a central allocation for which I have already made applications
+NotificationTriggerAllocationNewCourseTip: Can be overridden per central allocation

 NotificationTriggerKindAll: For all users
 NotificationTriggerKindCourseParticipant: For course participants
@ -2199,6 +2210,13 @@ ApplicationRatingCommentVisibleTip: Feedback for the applicant
 ApplicationRatingCommentInvisibleTip: Currently only a note for course administrators
 ApplicationRatingSection: Grading
 ApplicationRatingSectionSelfTip: You are authorised to edit the application as well as it's grading.
+AllocationNotificationNewCourse: Notifications for new courses
+AllocationNotificationNewCourseTip: Do you want to be notified if a new course is added to this central allocation? This overrides the system wide setting under “Settings”.
+AllocationNotificationNewCourseSuccessForceOn: You will be notified if a new course is added
+AllocationNotificationNewCourseSuccessForceOff: You will not be notified if a new course is added
+AllocationNotificationNewCourseCurrentlyOff: Currently you would not receive a notification.
+AllocationNotificationNewCourseCurrentlyOn: Currently you would be notified.
+AllocationNotificationLoginFirst: To change your notification settings, please log in first.

 AllocationSchoolShort: Department
 Allocation: Central allocation
@ -2291,6 +2309,11 @@ MailAllocationUnratedApplicationsIntroMultiple n: There are unrated applications
 MailAllocationUnratedApplications n: For there courses listed below, there exist applications made in the context of #{pluralEN n "the central allocation" "one of the central allocations"} which have either not yet been rated or which have changed since they were rated.
 MailAllocationUnratedApplicationsCount i: #{i} #{pluralDE i "application" "applications"}

+MailSubjectAllocationNewCourse allocation: A new course was added to the central allocation “#{allocation}”
+MailAllocationNewCourseTip: The following course was added to the central allocation:
+MailAllocationNewCourseEditApplicationsHere: You can modify your application here:
+MailAllocationNewCourseApplyHere: You can apply here:
+
 ExamOfficeSubscribedUsers: Users
 ExamOfficeSubscribedUsersTip: You may specify multiple matriculations; comma-separated

--- a/models/allocations.model
+++ b/models/allocations.model
@ -50,3 +50,9 @@ AllocationDeregister -- self-inflicted user-deregistrations from an allocated co
    course              CourseId Maybe
    time                UTCTime
    reason              Text Maybe -- if this deregistration was done by proxy (e.g. the lecturer pressed the button)
+
+AllocationNotificationSetting
+    user                UserId
+    allocation          AllocationId
+    isOptOut            Bool
+    UniqueAllocationNotificationSetting user allocation
--- a/package.yaml
+++ b/package.yaml
@ -25,7 +25,7 @@ dependencies:
  - directory
  - warp
  - data-default
-  - aeson
+  - aeson >=1.5
  - conduit
  - monad-logger
  - fast-logger
--- a/2
+++ b/2
@ -109,7 +109,7 @@

 /allocation/               AllocationListR     GET             !free
 /allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR:
-  /                                              AShowR         GET             !free
+  /                                              AShowR         GET POST        !free
  /register                                      ARegisterR         POST        !time
  /course/#CryptoUUIDCourse/apply                AApplyR            POST        !timeANDallocation-registered
  /users                                         AUsersR        GET POST        !allocation-admin
--- a/src/Data/Universe/Instances/Reverse/WithIndex.hs
+++ b/src/Data/Universe/Instances/Reverse/WithIndex.hs
@ -11,7 +11,7 @@ import Control.Lens.Indexed

 import Data.Universe.Instances.Reverse ()

-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map


 instance Finite a => FoldableWithIndex a ((->) a) where
--- a/src/Data/Void/Instances.hs
+++ b/src/Data/Void/Instances.hs
@ -10,3 +10,6 @@ instance ToContent Void where
  toContent = absurd
 instance ToTypedContent Void where
  toTypedContent = absurd
+
+instance RenderMessage site Void where
+  renderMessage _ _ = absurd
--- a/src/Handler/Allocation/Application.hs
+++ b/src/Handler/Allocation/Application.hs
@ -19,10 +19,11 @@ import qualified Database.Esqueleto as E
 import qualified Data.Conduit.List as C


-data AllocationApplicationButton = BtnAllocationApply
-                                 | BtnAllocationApplicationEdit
-                                 | BtnAllocationApplicationRetract
-                                 | BtnAllocationApplicationRate
+data AllocationApplicationButton
+  = BtnAllocationApply
+  | BtnAllocationApplicationEdit
+  | BtnAllocationApplicationRetract
+  | BtnAllocationApplicationRate
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 instance Universe AllocationApplicationButton
 instance Finite AllocationApplicationButton
@ -32,6 +33,11 @@ embedRenderMessage ''UniWorX ''AllocationApplicationButton id
 makePrisms ''AllocationApplicationButton

 instance Button UniWorX AllocationApplicationButton where
+  btnLabel BtnAllocationApply              = [whamlet|#{iconApply True} _{MsgBtnAllocationApply}|]
+  btnLabel BtnAllocationApplicationRetract = [whamlet|#{iconApply False} _{MsgBtnAllocationApplicationRetract}|]
+  btnLabel BtnAllocationApplicationEdit    = [whamlet|#{iconAllocationApplicationEdit} _{MsgBtnAllocationApplicationEdit}|]
+  btnLabel BtnAllocationApplicationRate = i18n BtnAllocationApplicationRate
+  
  btnClasses BtnAllocationApplicationRetract = [BCIsButton, BCDanger]
  btnClasses _ = [BCIsButton, BCPrimary]

--- a/src/Handler/Allocation/Register.hs
+++ b/src/Handler/Allocation/Register.hs
@ -36,6 +36,19 @@ nullaryPathPiece ''AllocationRegisterButton $ camelToPathPiece' 1
 embedRenderMessage ''UniWorX ''AllocationRegisterButton id

 instance Button UniWorX AllocationRegisterButton where
+  btnLabel BtnAllocationRegister
+    = [whamlet|
+        $newline never
+        #{iconAllocationRegister} \
+        _{BtnAllocationRegister}
+      |]
+  btnLabel BtnAllocationRegistrationEdit
+    = [whamlet|
+        $newline never
+        #{iconAllocationRegistrationEdit} \
+        _{BtnAllocationRegistrationEdit}
+      |]
+  
  btnClasses _ = [BCIsButton, BCPrimary]

 postARegisterR :: TermId -> SchoolId -> AllocationShorthand -> Handler Void
--- a/src/Handler/Allocation/Show.hs
+++ b/src/Handler/Allocation/Show.hs
@ -1,5 +1,5 @@
 module Handler.Allocation.Show
-  ( getAShowR
+  ( getAShowR, postAShowR
  ) where

 import Import
@ -15,9 +15,36 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E


-getAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
-getAShowR tid ssh ash = do
-  muid <- maybeAuthId
+data NotifyNewCourseButton
+  = BtnNotifyNewCourseForceOn
+  | BtnNotifyNewCourseForceOff
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+embedRenderMessage ''UniWorX ''NotifyNewCourseButton id
+nullaryPathPiece ''NotifyNewCourseButton $ camelToPathPiece' 2
+
+instance Button UniWorX NotifyNewCourseButton where
+  btnLabel BtnNotifyNewCourseForceOn
+    = [whamlet|
+        $newline never
+        #{iconNotification} \
+        _{BtnNotifyNewCourseForceOn}
+      |]
+  btnLabel BtnNotifyNewCourseForceOff
+    = [whamlet|
+        $newline never
+        #{iconNoNotification} \
+        _{BtnNotifyNewCourseForceOff}
+      |]
+
+  btnClasses _ = [BCIsButton]
+
+
+getAShowR, postAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
+getAShowR = postAShowR
+postAShowR tid ssh ash = do
+  mAuth <- maybeAuth
+  let muid = entityKey <$> mAuth
  now  <- liftIO getCurrentTime
  ata  <- getSessionActiveAuthTags

@ -33,7 +60,7 @@ getAShowR tid ssh ash = do
    resultCourseVisible :: Simple Field5 a (E.Value Bool) => Lens' a Bool
    resultCourseVisible = _5 . _Value

-  (Entity aId Allocation{..}, School{..}, isAnyLecturer, courses, registration) <- runDB $ do
+  (Entity aId Allocation{..}, School{..}, isAnyLecturer, courses, registration, notificationSetting) <- runDB $ do
    alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
    school <- getJust allocationSchool

@ -58,7 +85,9 @@ getAShowR tid ssh ash = do

    isAnyLecturer <- hasWriteAccessTo CourseNewR

-    return (alloc, school, isAnyLecturer, nubOn (view $ resultCourse . _entityKey) courses, registration)
+    notificationSetting <- fmap join . for muid $ getBy . flip UniqueAllocationNotificationSetting aId
+
+    return (alloc, school, isAnyLecturer, nubOn (view $ resultCourse . _entityKey) courses, registration, notificationSetting)

  MsgRenderer mr <- getMsgRenderer
  let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName
@ -67,7 +96,7 @@ getAShowR tid ssh ash = do
  -- staffInformation <- anyM courses $ \(view $ resultCourse . _entityVal -> Course{..}) ->
  --   hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CApplicationsR
  mayRegister <- hasWriteAccessTo $ AllocationR tid ssh ash ARegisterR
-  (registerForm, registerEnctype) <- generateFormPost . renderAForm FormStandard . allocationRegisterForm $ allocationUserToForm . entityVal <$> registration
+  (registerForm, registerEnctype) <- generateFormPost . identifyForm FIDAllocationRegister . renderAForm FormStandard . allocationRegisterForm $ allocationUserToForm . entityVal <$> registration
  let
    registerBtn = bool BtnAllocationRegister BtnAllocationRegistrationEdit $ is _Just registration
    registerForm' = wrapForm' registerBtn registerForm FormSettings
@ -79,6 +108,42 @@ getAShowR tid ssh ash = do
      , formAnchor = Nothing :: Maybe Text
      }

+  let wouldNotifyNewCourse = case (mAuth, notificationSetting) of
+        (_, Just (Entity _ AllocationNotificationSetting{..}))
+          -> not allocationNotificationSettingIsOptOut
+        (Just (Entity _ User{..}), _)
+          -> any (has $ _2 . _Just) courses && notificationAllowed userNotificationSettings NTAllocationNewCourse
+        _other
+          -> False
+  ((notificationResult, notificationForm), notificationEnctype) <- runFormPost . identifyForm FIDAllocationNotification . buttonForm' $ if
+    | wouldNotifyNewCourse
+      -> [BtnNotifyNewCourseForceOff]
+    | otherwise
+      -> [BtnNotifyNewCourseForceOn]
+  let
+    allocationNotificationIdent = "allocation-notification" :: Text
+    notificationForm' = wrapForm notificationForm FormSettings
+      { formMethod = POST
+      , formAction = Just . SomeRoute $ AllocationR tid ssh ash AShowR
+      , formEncoding = notificationEnctype
+      , formAttrs = []
+      , formSubmit = FormNoSubmit
+      , formAnchor = Just allocationNotificationIdent
+      }
+
+  whenIsJust muid $ \uid -> formResult notificationResult $ \notificationBtn -> do
+    let allocationNotificationSettingIsOptOut = case notificationBtn of
+          BtnNotifyNewCourseForceOn  -> False
+          BtnNotifyNewCourseForceOff -> True
+    runDB . void $ upsertBy (UniqueAllocationNotificationSetting uid aId) AllocationNotificationSetting
+      { allocationNotificationSettingUser = uid
+      , allocationNotificationSettingAllocation = aId
+      , allocationNotificationSettingIsOptOut
+      }
+      [ AllocationNotificationSettingIsOptOut =. allocationNotificationSettingIsOptOut ]
+    addMessageI Success $ bool MsgAllocationNotificationNewCourseSuccessForceOn MsgAllocationNotificationNewCourseSuccessForceOff allocationNotificationSettingIsOptOut
+    redirect $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: allocationNotificationIdent
+
  siteLayoutMsg title $ do
    setTitleI shortTitle

--- a/src/Handler/Course/Edit.hs
+++ b/src/Handler/Course/Edit.hs
@ -563,18 +563,18 @@ courseEditHandler miButtonAction mbCourseForm = do
        , formEncoding = formEnctype
        }

-upsertAllocationCourse :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => CourseId -> Maybe AllocationCourseForm -> ReaderT SqlBackend m ()
+upsertAllocationCourse :: CourseId -> Maybe AllocationCourseForm -> YesodJobDB UniWorX ()
 upsertAllocationCourse cid cfAllocation = do
  now <- liftIO getCurrentTime
  Course{} <- getJust cid
  prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
-  prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
-  userAdmin <- fromMaybe False <$> for prevAllocation (\Allocation{..} -> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR)
+  prevAllocation <- fmap join . traverse getEntity $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
+  userAdmin <- fromMaybe False <$> for prevAllocation (\(Entity _ Allocation{..}) -> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR)

  doEdit <- if
    | userAdmin
      -> return True
-    | Just Allocation{allocationStaffRegisterTo} <- prevAllocation
+    | Just (Entity _ Allocation{allocationStaffRegisterTo}) <- prevAllocation
    , NTop allocationStaffRegisterTo <= NTop (Just now)
      -> let anyChanges
               | Just AllocationCourseForm{..} <- cfAllocation
@ -590,7 +590,7 @@ upsertAllocationCourse cid cfAllocation = do

  when doEdit $
    case cfAllocation of
-      Just AllocationCourseForm{..} ->
+      Just AllocationCourseForm{..} -> do
        void $ upsert AllocationCourse
          { allocationCourseAllocation  =  acfAllocation
          , allocationCourseCourse      =  cid
@ -600,6 +600,9 @@ upsertAllocationCourse cid cfAllocation = do
          , AllocationCourseCourse      =. cid
          , AllocationCourseMinCapacity =. acfMinCapacity
          ]
+
+        when (Just acfAllocation /= fmap entityKey prevAllocation) $
+          queueDBJob . JobQueueNotification $ NotificationAllocationNewCourse acfAllocation cid
      Nothing
        | Just (Entity prevId _) <- prevAllocationCourse
          -> delete prevId
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@ -45,6 +45,7 @@ data SettingsForm = SettingsForm
      , stgShowSex              :: Bool
      , stgSchools              :: Set SchoolId
      , stgNotificationSettings :: NotificationSettings
+      , stgAllocationNotificationSettings :: Map AllocationId (Maybe Bool)
      }
 makeLenses_ ''SettingsForm

@ -79,6 +80,15 @@ instance RenderMessage UniWorX NotificationTriggerKind where
    where
      mr = renderMessage f ls

+data AllocationNotificationState
+  = AllocNotifyNewCourseDefault
+  | AllocNotifyNewCourseForceOff
+  | AllocNotifyNewCourseForceOn
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+embedRenderMessage ''UniWorX ''AllocationNotificationState id
+nullaryPathPiece ''AllocationNotificationState $ camelToPathPiece' 2
+

 makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
 makeSettingForm template html = do
@ -108,6 +118,7 @@ makeSettingForm template html = do
        <*  aformSection MsgFormNotifications
        <*> schoolsForm (stgSchools <$> template)
        <*> notificationForm (stgNotificationSettings <$> template)
+        <*> allocationNotificationForm (stgAllocationNotificationSettings <$> template)
    return (result, widget) -- no validation required here
  where
    themeList = [Option (toMessage t) t (toPathPiece t) | t <- universeF]
@ -196,13 +207,17 @@ notificationForm template = wFormToAForm $ do
            & fmap (!)

  let
+    ntfs nt = fslI nt & case nt of
+      NTAllocationNewCourse -> setTooltip MsgNotificationTriggerAllocationNewCourseTip
+      _other -> id
+    
    nsForm nt
      | maybe False ntHidden $ ntSection nt
      = pure $ notificationAllowed def nt
      | nt `elem` forcedTriggers
-      = aforced checkBoxField (fslI nt) (notificationAllowed def nt)
+      = aforced checkBoxField (ntfs nt) (notificationAllowed def nt)
      | otherwise
-      = apopt checkBoxField (fslI nt) (flip notificationAllowed nt <$> template)
+      = apopt checkBoxField (ntfs nt) (flip notificationAllowed nt <$> template)

    ntSection = \case
      NTSubmissionRatedGraded          -> Just NTKCourseParticipant
@ -229,6 +244,7 @@ notificationForm template = wFormToAForm $ do
      NTAllocationOutdatedRatings      -> Just NTKAllocationStaff
      NTAllocationUnratedApplications  -> Just NTKAllocationStaff
      NTAllocationResults              -> Just NTKAllocationParticipant
+      NTAllocationNewCourse            -> Just NTKAllocationParticipant
      NTExamOfficeExamResults          -> Just $ NTKFunctionary SchoolExamOffice
      NTExamOfficeExamResultsChanged   -> Just $ NTKFunctionary SchoolExamOffice
      NTCourseRegistered               -> Just NTKAll
@ -238,6 +254,62 @@ notificationForm template = wFormToAForm $ do

  aFormToWForm $ NotificationSettings <$> sectionedFuncForm ntSection nsForm (fslI MsgNotificationSettings) False

+getAllocationNotifications :: UserId -> DB (Map AllocationId (Maybe Bool))
+getAllocationNotifications uid
+  = fmap (fmap (fmap getAny) . unMergeMap) . getAp $ foldMap (Ap . fmap (MergeMap . fmap (fmap Any)))
+      [ getBySettings
+      , getByApplications
+      , getByAllocationUser
+      ]
+  where
+    getBySettings = toMap <$> selectList [ AllocationNotificationSettingUser ==. uid ] []
+      where toMap settings = Map.fromList [ ( allocationNotificationSettingAllocation
+                                            , Just $ not allocationNotificationSettingIsOptOut
+                                            )
+                                          | Entity _ AllocationNotificationSetting{..} <- settings
+                                          ]
+    getByApplications = toMap <$> selectList [ CourseApplicationAllocation !=. Nothing, CourseApplicationUser ==. uid ] []
+      where toMap applications = Map.fromList [ (alloc, Nothing)
+                                              | Entity _ CourseApplication{..} <- applications
+                                              , alloc <- hoistMaybe courseApplicationAllocation
+                                              ]
+    getByAllocationUser = toMap <$> selectList [ AllocationUserUser ==. uid ] []
+      where toMap allocsUser = Map.fromList [ (allocationUserAllocation, Nothing)
+                                            | Entity _ AllocationUser{..} <- allocsUser
+                                            ]
+
+setAllocationNotifications :: forall m. MonadIO m => UserId -> Map AllocationId (Maybe Bool) -> SqlPersistT m ()
+setAllocationNotifications allocationNotificationSettingUser allocs = do
+  deleteWhere [ AllocationNotificationSettingUser ==. allocationNotificationSettingUser ]
+  void . insertMany $ do
+    (allocationNotificationSettingAllocation, settingSt) <- Map.toList allocs
+    allocationNotificationSettingIsOptOut <- not <$> hoistMaybe settingSt
+    return AllocationNotificationSetting{..}
+  
+allocationNotificationForm :: Maybe (Map AllocationId (Maybe Bool)) -> AForm Handler (Map AllocationId (Maybe Bool))
+allocationNotificationForm = maybe (pure mempty) allocationNotificationForm' . (fromNullable =<<)
+  where
+    allocationNotificationForm' :: NonNull (Map AllocationId (Maybe Bool)) -> AForm Handler (Map AllocationId (Maybe Bool))
+    allocationNotificationForm' (toNullable -> allocs) = funcForm' . flip imap allocs $ \allocId mPrev -> wFormToAForm $ do
+      let _AllocNotify :: Iso' (Maybe Bool) AllocationNotificationState
+          _AllocNotify = iso toNotify fromNotify
+            where fromNotify = \case
+                    AllocNotifyNewCourseDefault  -> Nothing
+                    AllocNotifyNewCourseForceOn  -> Just True
+                    AllocNotifyNewCourseForceOff -> Just False
+                  toNotify = \case
+                    Nothing    -> AllocNotifyNewCourseDefault
+                    Just True  -> AllocNotifyNewCourseForceOn
+                    Just False -> AllocNotifyNewCourseForceOff
+
+      Allocation{..} <- liftHandler . runDB $ getJust allocId
+      MsgRenderer mr <- getMsgRenderer
+      let allocDesc = [st|#{mr (ShortTermIdentifier $ unTermKey allocationTerm)}, #{unSchoolKey allocationSchool}, #{allocationName}|]
+      cID <- encrypt allocId :: _ CryptoUUIDAllocation
+
+      fmap (review _AllocNotify) <$> wpopt (radioGroupField Nothing optionsFinite) (fsl allocDesc & addName [st|alloc-notify__#{toPathPiece cID}|]) (Just $ mPrev ^. _AllocNotify)
+      where funcForm' forms = funcForm forms (fslI MsgFormAllocationNotifications & setTooltip MsgFormAllocationNotificationsTip) False
+

 validateSettings :: User -> FormValidator SettingsForm Handler ()
 validateSettings User{..} = do
@ -276,6 +348,7 @@ postProfileR = do
           E.&&. userSchool E.^. UserSchoolUser E.==. E.val uid
           E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
    return $ school E.^. SchoolId
+  allocs <- runDB $ getAllocationNotifications uid
  let settingsTemplate = Just SettingsForm
        { stgDisplayName          = userDisplayName
        , stgDisplayEmail         = userDisplayEmail
@ -290,6 +363,7 @@ postProfileR = do
        , stgNotificationSettings = userNotificationSettings
        , stgWarningDays          = userWarningDays
        , stgShowSex              = userShowSex
+        , stgAllocationNotificationSettings = allocs
        }
  ((res,formWidget), formEnctype) <- runFormPost . validateForm (validateSettings user) . identifyForm ProfileSettings $ makeSettingForm settingsTemplate

@ -308,6 +382,7 @@ postProfileR = do
        , UserNotificationSettings =. stgNotificationSettings
        , UserShowSex              =. stgShowSex
        ] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ]
+      setAllocationNotifications uid stgAllocationNotificationSettings
      updateFavourites Nothing
      when (stgDisplayEmail /= userDisplayEmail) $ do
        queueDBJob $ JobChangeUserDisplayEmail uid stgDisplayEmail
@ -777,9 +852,13 @@ getUserNotificationR, postUserNotificationR :: CryptoUUIDUser -> Handler Html
 getUserNotificationR = postUserNotificationR
 postUserNotificationR cID = do
  uid <- decrypt cID
-  User{userNotificationSettings, userDisplayName} <- runDB $ get404 uid
+  (User{userNotificationSettings, userDisplayName}, allocs) <- runDB $ (,)
+    <$> get404 uid
+    <*> getAllocationNotifications uid

-  ((nsRes, nsInnerWdgt), nsEnc) <- runFormPost . formEmbedBearerPost . renderAForm FormStandard . notificationForm $ Just userNotificationSettings
+  ((nsRes, nsInnerWdgt), nsEnc) <- runFormPost . formEmbedBearerPost . renderAForm FormStandard $ (,)
+    <$> notificationForm (Just userNotificationSettings)
+    <*> allocationNotificationForm (Just allocs)
  mBearer <- askBearer
  isModal <- hasCustomHeader HeaderIsModal
  let formWidget = wrapForm nsInnerWdgt def
@ -788,8 +867,10 @@ postUserNotificationR cID = do
        , formAttrs = [ asyncSubmitAttr | isModal ]
        }

-  formResultModal nsRes (UserNotificationR cID, [ (toPathPiece GetBearer, toPathPiece bearer) | Just bearer <- pure mBearer ]) $ \ns -> do
-    lift . runDB $ update uid [ UserNotificationSettings =. ns ]
+  formResultModal nsRes (UserNotificationR cID, [ (toPathPiece GetBearer, toPathPiece bearer) | Just bearer <- pure mBearer ]) $ \(ns, ans) -> do
+    lift . runDB $ do
+      update uid [ UserNotificationSettings =. ns ]
+      setAllocationNotifications uid ans
    tell . pure =<< messageI Success MsgNotificationSettingsUpdate

  siteLayoutMsg (MsgNotificationSettingsHeading userDisplayName) $ do
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@ -1327,35 +1327,28 @@ boolField mkNone = radioGroupField mkNone $ do



-sectionedFuncForm  :: forall k v m sec.
-                      ( Finite k, Ord k
+sectionedFuncForm  :: forall f k v m sec.
+                      ( TraversableWithIndex k f
                      , MonadHandler m
                      , HandlerSite m ~ UniWorX
                      , RenderMessage UniWorX sec
                      , Ord sec
                      )
-                   => (k -> Maybe sec) -> (k -> AForm m v) -> FieldSettings UniWorX -> Bool -> AForm m (k -> v)
+                   => (k -> Maybe sec) -> f (AForm m v) -> FieldSettings UniWorX -> Bool -> AForm m (f v)
 sectionedFuncForm mkSection mkForm FieldSettings{fsName = _, fsAttrs = _, ..} isRequired = formToAForm $ funcFieldView =<< renderAForm FormStandard funcForm' mempty
  where
-    funcForm' :: AForm m (k -> v)
-    funcForm' = Set.fromList universeF
-              & foldr (\v -> Map.unionWith Set.union $ Map.singleton (mkSection v) (Set.singleton v)) Map.empty
-              & fmap (Map.fromSet mkForm)
-              & fmap sequenceA
-              & Map.foldrWithKey accSections (pure Map.empty)
-              & fmap (!)
-    accSections mSection optsForm acc = wFormToAForm $ do
-      (res, fs) <- wFormFields $ aFormToWForm optsForm
-      if
-        | not $ null fs
-        , Just section <- mSection
-          -> wformSection section
-        | otherwise
-          -> return ()
-      lift $ tell fs
-      aFormToWForm $ Map.union <$> wFormToAForm (pure res) <*> acc
+    funcForm' :: AForm m (f v)
+    funcForm' = wFormToAForm $ do
+      (res, MergeMap fs) <- runWriterT . ifor mkForm $ \k form
+        -> WriterT . fmap (over _2 $ MergeMap . Map.singleton (mkSection k)) . wFormFields $ aFormToWForm form

-    funcFieldView :: (FormResult (k -> v), Widget) -> MForm m (FormResult (k -> v), [FieldView UniWorX])
+      iforM_ fs $ \mSection secfs -> unless (null secfs) $ do
+        traverse_ wformSection mSection
+        lift $ tell secfs
+
+      return $ sequenceA res
+
+    funcFieldView :: (FormResult (f v), Widget) -> MForm m (FormResult (f v), [FieldView UniWorX])
    funcFieldView (res, formView) = do
      mr <- getMessageRender
      fvId <- maybe newIdent return fsId
@ -1367,16 +1360,15 @@ sectionedFuncForm mkSection mkForm FieldSettings{fsName = _, fsAttrs = _, ..} is
            | otherwise = Nothing
          fvInput = $(widgetFile "widgets/fields/funcField")
      return (res, pure FieldView{..})
-    -- areq nsField (fslI MsgNotificationSettings) (stgNotficationSettings <$> template)


-funcForm :: forall k v m.
-            ( Finite k, Ord k
+funcForm :: forall f k v m.
+            ( TraversableWithIndex k f
            , MonadHandler m
            , HandlerSite m ~ UniWorX
            )
-         => (k -> AForm m v) -> FieldSettings UniWorX -> Bool -> AForm m (k -> v)
-funcForm = sectionedFuncForm $ const (Nothing :: Maybe Text)
+         => f (AForm m v) -> FieldSettings UniWorX -> Bool -> AForm m (f v)
+funcForm = sectionedFuncForm $ pure (Nothing :: Maybe Void)



--- a/src/Import/NoModel.hs
+++ b/src/Import/NoModel.hs
@ -65,7 +65,7 @@ import Data.List              as Import (elemIndex)
 import Data.List.NonEmpty     as Import (NonEmpty(..), nonEmpty)
 import Data.Text.Encoding.Error as Import(UnicodeException(..))
 import Data.Semigroup         as Import (Min(..), Max(..))
-import Data.Monoid            as Import (Last(..), First(..), Any(..), All(..), Sum(..), Endo(..), Alt(..), Dual(..))
+import Data.Monoid            as Import (Last(..), First(..), Any(..), All(..), Sum(..), Endo(..), Alt(..), Dual(..), Ap(..))
 import Data.Binary            as Import (Binary)
 import Data.Binary.Instances  as Import ()

--- a/src/Jobs/Handler/QueueNotification.hs
+++ b/src/Jobs/Handler/QueueNotification.hs
@ -22,21 +22,24 @@ dispatchJobQueueNotification :: Notification -> JobHandler UniWorX
 dispatchJobQueueNotification jNotification = JobHandlerAtomic $
  runConduit $ yield jNotification
            .| transPipe (hoist lift) determineNotificationCandidates
-            .| C.filterM (\(notification', Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings <$> hoist lift (classifyNotification notification'))
-            .| C.map (\(notification', Entity uid _) -> JobSendNotification uid notification')
+            .| C.filterM (\(notification', override, Entity _ User{userNotificationSettings}) -> or2M (return override) $ notificationAllowed userNotificationSettings <$> hoist lift (classifyNotification notification'))
+            .| C.map (\(notification', _, Entity uid _) -> JobSendNotification uid notification')
            .| sinkDBJobs


-determineNotificationCandidates :: ConduitT Notification (Notification, Entity User) DB ()
+determineNotificationCandidates :: ConduitT Notification (Notification, Bool, Entity User) DB ()
 determineNotificationCandidates = awaitForever $ \notif -> do
-  let withNotif :: ConduitT () (Entity User) DB () -> ConduitT Notification (Notification, Entity User) DB ()
-      withNotif c = toProducer c .| C.map (notif, )
+  let withNotif :: ConduitT () (Entity User) DB () -> ConduitT Notification (Notification, Bool, Entity User) DB ()
+      withNotif c = toProducer c .| C.map (notif, False, )
+
+      withNotifOverride :: ConduitT () (E.Value Bool, Entity User) DB () -> ConduitT Notification (Notification, Bool, Entity User) DB ()
+      withNotifOverride c = toProducer c .| C.map (\(E.Value override, user) -> (notif, override, user))

      -- | Assumes that conduit produces output sorted by `UserId`
      separateTargets :: Ord target
                      => (Set target -> Notification)
                      -> ConduitT () (Entity User, E.Value target) DB ()
-                      -> ConduitT Notification (Notification, Entity User) DB ()
+                      -> ConduitT Notification (Notification, Bool, Entity User) DB ()
      separateTargets mkNotif' c = toProducer c .| go Nothing Set.empty
        where go Nothing _ = do
                next <- await
@ -46,10 +49,10 @@ determineNotificationCandidates = awaitForever $ \notif -> do
              go (Just uent) ts = do
                next <- await
                case next of
-                  Nothing -> yield (mkNotif' ts, uent)
+                  Nothing -> yield (mkNotif' ts, False, uent)
                  Just next'@(uent', E.Value t)
                    | ((==) `on` entityKey) uent uent' -> go (Just uent) $ Set.insert t ts
-                    | otherwise -> yield (mkNotif' ts, uent) >> leftover next' >> go Nothing Set.empty
+                    | otherwise -> yield (mkNotif' ts, False, uent) >> leftover next' >> go Nothing Set.empty
                
  case notif of
    NotificationSubmissionRated{..}
@ -281,6 +284,27 @@ determineNotificationCandidates = awaitForever $ \notif -> do
      -> withNotif . yieldMMany $ getEntity nUser
    NotificationSubmissionUserDeleted{..}
      -> withNotif . yieldMMany $ getEntity nUser
+    NotificationAllocationNewCourse{..}
+      -> withNotifOverride . E.selectSource . E.from $ \user -> do
+           let hasOverride overrideVal = E.exists . E.from $ \allocationNotificationSetting ->
+                 E.where_ $ allocationNotificationSetting E.^. AllocationNotificationSettingUser E.==. user E.^. UserId
+                      E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingAllocation E.==. E.val nAllocation
+                      E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingIsOptOut E.==. E.val (not overrideVal)
+
+               hasApplication = E.exists . E.from $ \application ->
+                 E.where_ $ application E.^. CourseApplicationAllocation E.==. E.justVal nAllocation
+                      E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
+
+           E.where_ $ hasOverride True E.||. hasApplication
+
+           E.where_ . E.not_ $ hasOverride False
+
+           E.where_ . E.not_ . E.exists . E.from $ \application ->
+             E.where_ $ application E.^. CourseApplicationAllocation E.==. E.justVal nAllocation
+                  E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
+                  E.&&. application E.^. CourseApplicationCourse E.==. E.val nCourse
+           
+           return (hasOverride True, user)


 classifyNotification :: Notification -> DB NotificationTrigger
@ -315,3 +339,4 @@ classifyNotification NotificationCourseRegistered{}               = return NTCou
 classifyNotification NotificationSubmissionEdited{}               = return NTSubmissionEdited
 classifyNotification NotificationSubmissionUserCreated{}          = return NTSubmissionUserCreated
 classifyNotification NotificationSubmissionUserDeleted{}          = return NTSubmissionUserDeleted
+classifyNotification NotificationAllocationNewCourse{}            = return NTAllocationNewCourse
--- a/src/Jobs/Handler/SendNotification/Allocation.hs
+++ b/src/Jobs/Handler/SendNotification/Allocation.hs
@ -6,6 +6,7 @@ module Jobs.Handler.SendNotification.Allocation
  , dispatchNotificationAllocationAllocation
  , dispatchNotificationAllocationUnratedApplications
  , dispatchNotificationAllocationResults
+  , dispatchNotificationAllocationNewCourse
  ) where

 import Import
@ -183,3 +184,24 @@ dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipi
  editNotifications <- mkEditNotifications jRecipient

  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationResults.hamlet")
+
+dispatchNotificationAllocationNewCourse :: AllocationId -> CourseId -> UserId -> Handler ()
+dispatchNotificationAllocationNewCourse nAllocation nCourse jRecipient = userMailT jRecipient $ do
+  (Allocation{..}, Course{..}, hasApplied) <- liftHandler . runDB $ (,,)
+    <$> getJust nAllocation
+    <*> getJust nCourse
+    <*> exists [CourseApplicationAllocation ==. Just nAllocation, CourseApplicationUser ==. jRecipient]
+
+  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+  setSubjectI $ MsgMailSubjectAllocationNewCourse allocationName
+  editNotifications <- mkEditNotifications jRecipient
+
+  cID <- encrypt nCourse
+  mayApply <- orM
+    [ is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand ARegisterR) True
+    , is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand $ AApplyR cID) True
+    ]
+
+  allocUrl <- toTextUrl $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID
+
+  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationNewCourse.hamlet")
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@ -43,83 +43,86 @@ import System.Clock (getTime, Clock(Monotonic), TimeSpec)
 import GHC.Conc (unsafeIOToSTM)


-data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notification }
-         | JobSendTestEmail { jEmail :: Email, jMailContext :: MailContext }
-         | JobQueueNotification { jNotification :: Notification }
-         | JobHelpRequest { jHelpSender :: Either (Maybe Address) UserId
-                          , jRequestTime :: UTCTime
-                          , jSubject :: Maybe Text
-                          , jHelpRequest :: Maybe Html
-                          , jReferer :: Maybe Text
-                          , jError :: Maybe ErrorResponse
-                          }
-         | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings }
-         | JobDistributeCorrections { jSheet :: SheetId }
-         | JobSendCourseCommunication { jRecipientEmail :: Either UserEmail UserId
-                                      , jAllRecipientAddresses :: Set Address
-                                      , jCourse :: CourseId
-                                      , jSender :: UserId
-                                      , jMailObjectUUID :: UUID
-                                      , jSubject :: Maybe Text
-                                      , jMailContent :: Html
-                                      }
-         | JobInvitation { jInviter :: Maybe UserId
-                         , jInvitee :: UserEmail
-                         , jInvitationUrl :: Text
-                         , jInvitationSubject :: Text
-                         , jInvitationExplanation :: Html
+data Job
+  = JobSendNotification { jRecipient :: UserId, jNotification :: Notification }
+  | JobSendTestEmail { jEmail :: Email, jMailContext :: MailContext }
+  | JobQueueNotification { jNotification :: Notification }
+  | JobHelpRequest { jHelpSender :: Either (Maybe Address) UserId
+                   , jRequestTime :: UTCTime
+                   , jSubject :: Maybe Text
+                   , jHelpRequest :: Maybe Html
+                   , jReferer :: Maybe Text
+                   , jError :: Maybe ErrorResponse
+                   }
+  | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings }
+  | JobDistributeCorrections { jSheet :: SheetId }
+  | JobSendCourseCommunication { jRecipientEmail :: Either UserEmail UserId
+                               , jAllRecipientAddresses :: Set Address
+                               , jCourse :: CourseId
+                               , jSender :: UserId
+                               , jMailObjectUUID :: UUID
+                               , jSubject :: Maybe Text
+                               , jMailContent :: Html
+                               }
+  | JobInvitation { jInviter :: Maybe UserId
+                  , jInvitee :: UserEmail
+                  , jInvitationUrl :: Text
+                  , jInvitationSubject :: Text
+                  , jInvitationExplanation :: Html
+                  }
+  | JobSendPasswordReset { jRecipient :: UserId
                         }
-         | JobSendPasswordReset { jRecipient :: UserId
-                                }
-         | JobTruncateTransactionLog
-         | JobPruneInvitations
-         | JobDeleteTransactionLogIPs
-         | JobSynchroniseLdap { jNumIterations
+  | JobTruncateTransactionLog
+  | JobPruneInvitations
+  | JobDeleteTransactionLogIPs
+  | JobSynchroniseLdap { jNumIterations
+                       , jEpoch
+                       , jIteration :: Natural
+                       }
+  | JobSynchroniseLdapUser { jUser :: UserId
+                           }
+  | JobChangeUserDisplayEmail { jUser :: UserId
+                              , jDisplayEmail :: UserEmail
+                              }
+  | JobPruneSessionFiles
+  | JobPruneUnreferencedFiles { jNumIterations
                              , jEpoch
                              , jIteration :: Natural
                              }
-         | JobSynchroniseLdapUser { jUser :: UserId
-                                  }
-         | JobChangeUserDisplayEmail { jUser :: UserId
-                                     , jDisplayEmail :: UserEmail
-                                     }
-         | JobPruneSessionFiles
-         | JobPruneUnreferencedFiles { jNumIterations
-                                     , jEpoch
-                                     , jIteration :: Natural
-                                     }
-         | JobInjectFiles
-         | JobPruneFallbackPersonalisedSheetFilesKeys
-         | JobRechunkFiles
-         | JobDetectMissingFiles
+  | JobInjectFiles
+  | JobPruneFallbackPersonalisedSheetFilesKeys
+  | JobRechunkFiles
+  | JobDetectMissingFiles
  deriving (Eq, Ord, Show, Read, Generic, Typeable)
-data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
-                  | NotificationSheetActive { nSheet :: SheetId }
-                  | NotificationSheetSoonInactive { nSheet :: SheetId }
-                  | NotificationSheetInactive { nSheet :: SheetId }
-                  | NotificationSheetHint { nSheet :: SheetId }
-                  | NotificationSheetSolution { nSheet :: SheetId }
-                  | NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId }
-                  | NotificationCorrectionsNotDistributed { nSheet :: SheetId }
-                  | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) }
-                  | NotificationUserSystemFunctionsUpdate { nUser :: UserId, nOriginalSystemFunctions :: Set SystemFunction }
-                  | NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode }
-                  | NotificationExamRegistrationActive { nExam :: ExamId }
-                  | NotificationExamRegistrationSoonInactive { nExam :: ExamId }
-                  | NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
-                  | NotificationExamResult { nExam :: ExamId }
-                  | NotificationAllocationStaffRegister { nAllocations :: Set AllocationId }
-                  | NotificationAllocationRegister { nAllocations :: Set AllocationId }
-                  | NotificationAllocationAllocation { nAllocations :: Set AllocationId }
-                  | NotificationAllocationUnratedApplications { nAllocations :: Set AllocationId }
-                  | NotificationExamOfficeExamResults { nExam :: ExamId }
-                  | NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
-                  | NotificationExamOfficeExternalExamResults { nExternalExam :: ExternalExamId }
-                  | NotificationAllocationResults { nAllocation :: AllocationId }
-                  | NotificationCourseRegistered { nUser :: UserId, nCourse :: CourseId }
-                  | NotificationSubmissionEdited { nInitiator :: UserId, nSubmission :: SubmissionId }
-                  | NotificationSubmissionUserCreated { nUser :: UserId, nSubmission :: SubmissionId }
-                  | NotificationSubmissionUserDeleted { nUser :: UserId, nSheet :: SheetId, nSubmission :: SubmissionId }
+data Notification
+  = NotificationSubmissionRated { nSubmission :: SubmissionId }
+  | NotificationSheetActive { nSheet :: SheetId }
+  | NotificationSheetSoonInactive { nSheet :: SheetId }
+  | NotificationSheetInactive { nSheet :: SheetId }
+  | NotificationSheetHint { nSheet :: SheetId }
+  | NotificationSheetSolution { nSheet :: SheetId }
+  | NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId }
+  | NotificationCorrectionsNotDistributed { nSheet :: SheetId }
+  | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) }
+  | NotificationUserSystemFunctionsUpdate { nUser :: UserId, nOriginalSystemFunctions :: Set SystemFunction }
+  | NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode }
+  | NotificationExamRegistrationActive { nExam :: ExamId }
+  | NotificationExamRegistrationSoonInactive { nExam :: ExamId }
+  | NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
+  | NotificationExamResult { nExam :: ExamId }
+  | NotificationAllocationStaffRegister { nAllocations :: Set AllocationId }
+  | NotificationAllocationRegister { nAllocations :: Set AllocationId }
+  | NotificationAllocationAllocation { nAllocations :: Set AllocationId }
+  | NotificationAllocationUnratedApplications { nAllocations :: Set AllocationId }
+  | NotificationAllocationNewCourse { nAllocation :: AllocationId, nCourse :: CourseId }
+  | NotificationExamOfficeExamResults { nExam :: ExamId }
+  | NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
+  | NotificationExamOfficeExternalExamResults { nExternalExam :: ExternalExamId }
+  | NotificationAllocationResults { nAllocation :: AllocationId }
+  | NotificationCourseRegistered { nUser :: UserId, nCourse :: CourseId }
+  | NotificationSubmissionEdited { nInitiator :: UserId, nSubmission :: SubmissionId }
+  | NotificationSubmissionUserCreated { nUser :: UserId, nSubmission :: SubmissionId }
+  | NotificationSubmissionUserDeleted { nUser :: UserId, nSheet :: SheetId, nSubmission :: SubmissionId }
  deriving (Eq, Ord, Show, Read, Generic, Typeable)

 instance Hashable Job
--- a/src/Model/Types/Mail.hs
+++ b/src/Model/Types/Mail.hs
@ -43,6 +43,7 @@ data NotificationTrigger
  | NTAllocationStaffRegister
  | NTAllocationAllocation
  | NTAllocationRegister
+  | NTAllocationNewCourse
  | NTAllocationOutdatedRatings
  | NTAllocationUnratedApplications
  | NTAllocationResults
@ -72,6 +73,7 @@ instance Default NotificationSettings where
      defaultOff = HashSet.fromList
        [ NTSheetSoonInactive
        , NTExamRegistrationSoonInactive
+        , NTAllocationNewCourse
        ]

 instance ToJSON NotificationSettings where
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -114,7 +114,7 @@ import qualified Control.Monad.Random.Lazy as LazyRand
 import Data.Data (Data)
 import qualified Data.Text.Lazy.Builder as Builder

-import Unsafe.Coerce
+import Data.Coerce

 import System.FilePath as Utils (addExtension, isExtensionOf)
 import System.FilePath (dropDrive)
@ -1258,8 +1258,8 @@ instance (Eq k, Hashable k, Semigroup v) => Monoid (MergeHashMap k v) where
  mempty = MergeHashMap HashMap.empty
 instance (Eq k, Hashable k, FromJSON v, FromJSONKey k, Semigroup v) => FromJSON (MergeHashMap k v) where
  parseJSON = case Aeson.fromJSONKey of
-      Aeson.FromJSONKeyCoerce _ -> Aeson.withObject "HashMap ~Text" $
-          uc . HashMap.traverseWithKey (\k v -> parseJSON v Aeson.<?> Aeson.Key k)
+      Aeson.FromJSONKeyCoerce -> Aeson.withObject "HashMap ~Text" $
+          coerce @(Aeson.Parser (HashMap k v)) @(Aeson.Parser (MergeHashMap k v)) . fmap HashMap.fromList . traverse (\(k, v) -> (coerce @Text @k k, ) <$> parseJSON v Aeson.<?> Aeson.Key k) . HashMap.toList
      Aeson.FromJSONKeyText f -> Aeson.withObject "HashMap" $
          fmap MergeHashMap . HashMap.foldrWithKey (\k v m -> HashMap.insertWith (<>) (f k) <$> parseJSON v Aeson.<?> Aeson.Key k <*> m) (pure mempty)
      Aeson.FromJSONKeyTextParser f -> Aeson.withObject "HashMap" $
@ -1267,9 +1267,6 @@ instance (Eq k, Hashable k, FromJSON v, FromJSONKey k, Semigroup v) => FromJSON
      Aeson.FromJSONKeyValue f -> Aeson.withArray "Map" $ \arr ->
          fmap (MergeHashMap . HashMap.fromListWith (<>)) . zipWithM (parseIndexedJSONPair f parseJSON) [0..] $ otoList arr
    where
-      uc :: Aeson.Parser (HashMap Text v) -> Aeson.Parser (MergeHashMap k v)
-      uc = unsafeCoerce
-
      parseIndexedJSONPair :: (Value -> Aeson.Parser a) -> (Value -> Aeson.Parser b) -> Int -> Value -> Aeson.Parser (a, b)
      parseIndexedJSONPair keyParser valParser idx value = p value Aeson.<?> Aeson.Index idx
        where
@ -1284,6 +1281,61 @@ instance (Eq k, Hashable k, FromJSON v, FromJSONKey k, Semigroup v) => FromJSON
      parseJSONElemAtIndex :: (Value -> Aeson.Parser a) -> Int -> Vector Value -> Aeson.Parser a
      parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) Aeson.<?> Aeson.Index idx

+
+newtype MergeMap k v = MergeMap { unMergeMap :: Map k v }
+  deriving (Show, Generic, Typeable, Data)
+  deriving newtype ( Eq, Ord
+                   , Functor, Foldable, NFData
+                   , ToJSON
+                   )
+
+makePrisms ''MergeMap
+makeWrapped ''MergeMap
+
+type instance Element (MergeMap k v) = v
+  
+instance MonoFoldable (MergeMap k v)
+instance MonoFunctor (MergeMap k v)
+instance MonoTraversable (MergeMap k v)
+
+instance Traversable (MergeMap k) where
+  traverse = _MergeMap . traverse
+
+instance FunctorWithIndex k (MergeMap k)
+instance TraversableWithIndex k (MergeMap k) where
+  itraverse = _MergeMap .> itraverse
+instance FoldableWithIndex k (MergeMap k)
+
+instance (Ord k, Semigroup v) => Semigroup (MergeMap k v) where
+  (MergeMap a) <> (MergeMap b) = MergeMap $ Map.unionWith (<>) a b
+instance (Ord k, Semigroup v) => Monoid (MergeMap k v) where
+  mempty = MergeMap Map.empty
+instance (Ord k, FromJSON v, FromJSONKey k, Semigroup v) => FromJSON (MergeMap k v) where
+  parseJSON = case Aeson.fromJSONKey of
+      Aeson.FromJSONKeyCoerce -> Aeson.withObject "Map ~Text" $
+          coerce @(Aeson.Parser (Map k v)) @(Aeson.Parser (MergeMap k v)) . fmap Map.fromList . traverse (\(k, v) -> (coerce @Text @k k, ) <$> parseJSON v Aeson.<?> Aeson.Key k) . HashMap.toList
+      Aeson.FromJSONKeyText f -> Aeson.withObject "Map" $
+          fmap MergeMap . Map.foldrWithKey (\k v m -> Map.insertWith (<>) (f k) <$> parseJSON v Aeson.<?> Aeson.Key k <*> m) (pure mempty) . Map.fromList . HashMap.toList
+      Aeson.FromJSONKeyTextParser f -> Aeson.withObject "Map" $
+          fmap MergeMap . Map.foldrWithKey (\k v m -> Map.insertWith (<>) <$> f k Aeson.<?> Aeson.Key k <*> parseJSON v Aeson.<?> Aeson.Key k <*> m) (pure mempty) . Map.fromList . HashMap.toList
+      Aeson.FromJSONKeyValue f -> Aeson.withArray "Map" $ \arr ->
+          fmap (MergeMap . Map.fromListWith (<>)) . zipWithM (parseIndexedJSONPair f parseJSON) [0..] $ otoList arr
+    where
+      parseIndexedJSONPair :: (Value -> Aeson.Parser a) -> (Value -> Aeson.Parser b) -> Int -> Value -> Aeson.Parser (a, b)
+      parseIndexedJSONPair keyParser valParser idx value = p value Aeson.<?> Aeson.Index idx
+        where
+          p = Aeson.withArray "(k, v)" $ \ab ->
+              let n = V.length ab
+              in if n == 2
+                   then (,) <$> parseJSONElemAtIndex keyParser 0 ab
+                            <*> parseJSONElemAtIndex valParser 1 ab
+                   else fail $ "cannot unpack array of length " ++
+                               show n ++ " into a pair"
+
+      parseJSONElemAtIndex :: (Value -> Aeson.Parser a) -> Int -> Vector Value -> Aeson.Parser a
+      parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) Aeson.<?> Aeson.Index idx
+
+  
 --------------
 -- FilePath --
 --------------
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@ -229,6 +229,8 @@ data FormIdentifier
  | FIDExamAutoOccurrenceCalculate | FIDExamAutoOccurrenceConfirm | FIDExamAutoOccurrenceNudge UUID
  | FIDAllocationAccept
  | FIDTestDownload
+  | FIDAllocationRegister
+  | FIDAllocationNotification
  deriving (Eq, Ord, Read, Show)

 instance PathPiece FormIdentifier where
--- a/src/Utils/Icon.hs
+++ b/src/Utils/Icon.hs
@ -86,6 +86,9 @@ data Icon
  | IconFileUploadSession
  | IconStandaloneFieldError
  | IconFileUser
+  | IconNotification | IconNoNotification
+  | IconAllocationRegister | IconAllocationRegistrationEdit
+  | IconAllocationApplicationEdit
  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)

 iconText :: Icon -> Text
@ -150,6 +153,11 @@ iconText = \case
    IconFileUploadSession       -> "file-upload"
    IconStandaloneFieldError    -> "exclamation"
    IconFileUser                -> "file-user"
+    IconNotification            -> "envelope"
+    IconNoNotification          -> "times"
+    IconAllocationRegister      -> "user-plus"
+    IconAllocationRegistrationEdit -> "pencil-alt"
+    IconAllocationApplicationEdit -> "pencil-alt"

 instance Universe Icon
 instance Finite   Icon
--- a/stack.yaml
+++ b/stack.yaml
@ -75,6 +75,9 @@ extra-deps:
  - unidecode-0.1.0.4@sha256:99581ee1ea334a4596a09ae3642e007808457c66893b587e965b31f15cbf8c4d,1144
  - wai-middleware-prometheus-1.0.0@sha256:1625792914fb2139f005685be8ce519111451cfb854816e430fbf54af46238b4,1314
  - primitive-0.7.1.0@sha256:6a237bb338bcc43193077ff8e8c0f0ce2de14c652231496a15672e8b563a07e2,2604
+  - aeson-1.5.3.0@sha256:05496710de6ae694e55dc77dbdaf7503f56c24e4aecc06045e42e75a02df8bc4,6906
+  - data-fix-0.3.0@sha256:058a266d1e658500e0ffb8babe68195b0ce06a081dcfc3814afc784b083fd9a5,1645
+  - strict-0.4@sha256:1b50c7c9c636c3a1bbc7f8873b9be48f6ca0faca4df6eec6a014de6208fb1c0e,4200

 resolver: nightly-2020-08-08
 compiler: ghc-8.10.2
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -359,6 +359,27 @@ packages:
      sha256: 924e88629b493abb6b2f3c3029cef076554a2b627091e3bb6887ec03487a707d
  original:
    hackage: primitive-0.7.1.0@sha256:6a237bb338bcc43193077ff8e8c0f0ce2de14c652231496a15672e8b563a07e2,2604
+- completed:
+    hackage: aeson-1.5.3.0@sha256:05496710de6ae694e55dc77dbdaf7503f56c24e4aecc06045e42e75a02df8bc4,6906
+    pantry-tree:
+      size: 39759
+      sha256: 6290ffac2ea3e52b57d869306d12dbf32c07d17099f695f035ff7f756677831d
+  original:
+    hackage: aeson-1.5.3.0@sha256:05496710de6ae694e55dc77dbdaf7503f56c24e4aecc06045e42e75a02df8bc4,6906
+- completed:
+    hackage: data-fix-0.3.0@sha256:058a266d1e658500e0ffb8babe68195b0ce06a081dcfc3814afc784b083fd9a5,1645
+    pantry-tree:
+      size: 261
+      sha256: 6cf43af344624e087dbe2f1e96e985de6142e85bb02db8449df6d72bee3c1013
+  original:
+    hackage: data-fix-0.3.0@sha256:058a266d1e658500e0ffb8babe68195b0ce06a081dcfc3814afc784b083fd9a5,1645
+- completed:
+    hackage: strict-0.4@sha256:1b50c7c9c636c3a1bbc7f8873b9be48f6ca0faca4df6eec6a014de6208fb1c0e,4200
+    pantry-tree:
+      size: 654
+      sha256: fdf523b8990567d69277b999d68d492ed0b3a98a89b1acdfb3087e3b95eb9908
+  original:
+    hackage: strict-0.4@sha256:1b50c7c9c636c3a1bbc7f8873b9be48f6ca0faca4df6eec6a014de6208fb1c0e,4200
 snapshots:
 - completed:
    size: 524392
--- a/templates/allocation/show.hamlet
+++ b/templates/allocation/show.hamlet
@ -65,7 +65,7 @@ $newline never
      <dd .deflist__dd>
        <p>^{formatTimeW SelFormatDateTime toT}

-<section id=allocation-participation>
+<section #allocation-participation>
  <h2>
    _{MsgAllocationParticipation}
  $if is _Nothing muid
@ -94,6 +94,18 @@ $newline never
      $# This redundant links prevents useless help requests from frantic users
      ^{allocationInfoModal}

+<section>
+  <h2>
+    _{MsgAllocationNotificationNewCourse}
+  $if is _Just muid
+    <p .explanation>
+      _{MsgAllocationNotificationNewCourseTip}
+      <br>
+      _{bool MsgAllocationNotificationNewCourseCurrentlyOff MsgAllocationNotificationNewCourseCurrentlyOn wouldNotifyNewCourse}
+    ^{notificationForm'}
+  $else
+    _{MsgAllocationNotificationLoginFirst}
+
 $if not (null courseWidgets)
  <section .allocation>
    <h2>
--- a/templates/i18n/changelog/de-de-formal.hamlet
+++ b/templates/i18n/changelog/de-de-formal.hamlet
@ -1,5 +1,12 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2020 09 24}
+  <dd .deflist__dd>
+    <ul>
+      <li>
+        Benachrichtigungen, wenn neue Kurse zu Zentralanmeldungen hinzugefügt werden
+
  <dt .deflist__dt>
    ^{formatGregorianW 2020 08 28}
  <dd .deflist__dd>
--- a/templates/i18n/changelog/en-eu.hamlet
+++ b/templates/i18n/changelog/en-eu.hamlet
@ -1,5 +1,12 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2020 09 24}
+  <dd .deflist__dd>
+    <ul>
+      <li>
+        Notifications for new courses being added to central allocations
+
  <dt .deflist__dt>
    ^{formatGregorianW 2020 08 28}
  <dd .deflist__dd>
--- a/templates/mail/allocationNewCourse.hamlet
+++ b/templates/mail/allocationNewCourse.hamlet
@ -0,0 +1,32 @@
+$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>
+      _{SomeMessage $ MsgMailSubjectAllocationNewCourse allocationName}
+
+    <p>
+      _{SomeMessage MsgMailAllocationNewCourseTip}
+      <br />
+      <a href=@{CourseR courseTerm courseSchool courseShorthand CShowR}>
+        #{courseName}
+
+    $if mayApply
+      <p>
+        $if hasApplied
+          _{SomeMessage MsgMailAllocationNewCourseEditApplicationsHere}
+        $else
+          _{SomeMessage MsgMailAllocationNewCourseApplyHere}
+        <br />
+        <a href=#{allocUrl}>
+          #{allocationName}
+
+    ^{ihamletSomeMessage editNotifications}