feat(allocations): notifications

messages/uniworx/de.msg

@@ -860,6 +860,11 @@ NotificationTriggerCorrectionsNotDistributed: Nicht alle Abgaben eines meiner Ü
 NotificationTriggerUserRightsUpdate: Meine Berechtigungen wurden geändert
 NotificationTriggerUserAuthModeUpdate: Mein Anmelde-Modus wurde geändert
 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
+NotificationTriggerAllocationRegister: Ich kann mich bei einer neuen Zentralanmeldung bewerben
+NotificationTriggerAllocationOutdatedRatings: Zentralanmeldung-Bewerbungen für einen meiner Kurse wurden verändert, nachdem sie bewertet wurden
+NotificationTriggerAllocationUnratedApplications: Bewertungen zu Zentralanmeldung-Bewerbungen für einen meiner Kurse stehen aus
 
 NotificationTriggerKindAll: Für alle Benutzer
 NotificationTriggerKindCourseParticipant: Für Kursteilnehmer
@@ -869,6 +874,7 @@ NotificationTriggerKindLecturer: Für Dozenten
 NotificationTriggerKindAdmin: Für Administratoren
 NotificationTriggerKindExamOffice: Für das Prüfungsamt
 NotificationTriggerKindEvaluation: Für Vorlesungsumfragen
+NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen
 
 CorrCreate: Abgaben erstellen
 UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"
@@ -1596,4 +1602,24 @@ ApplicationEditTip: Während des Bewerbungszeitraums können eigene Bewerbungen
 
 UserLdapSync: LDAP-Synchronisieren
 SynchroniseLdapUserQueued n@Int: LDAP-Synchronisation von #{n} #{pluralDE n "Benutzer" "Benutzern"} angestoßen
-UserHijack: Sitzung übernehmen
+UserHijack: Sitzung übernehmen
+
+MailSubjectAllocationStaffRegister allocation@AllocationName: Sie können nun Kurse für die Zentralameldung „#{allocation}“ registrieren
+MailAllocationStaffRegisterNewCourse: Sie können auf der unten aufgeführten Seite neue Kurse in Uni2work anlegen. Hierbei haben Sie die Möglichkeit anzugeben, dass der Kurs an der Zentralanmeldung teilnimmt.
+MailAllocationStaffRegisterDeadline deadline@Text: Bitte beachten Sie, dass alle Kurse, die an der Zentralanmeldung teilnehmen, bis #{deadline} eingetragen sein müssen.
+
+MailSubjectAllocationRegister allocation@AllocationName: Sie können sich nun für Kurse der Zentralameldung „#{allocation}“ bewerben
+MailAllocationRegister: Sie können sich, auf der unten aufgeführten Seite, für alle Kurse der Zentralanmeldung jeweils einzeln bewerben.
+MailAllocationRegisterDeadline deadline@Text: Bitte beachten Sie, dass alle Bewerbungen bis #{deadline} eingegangen sein müssen.
+
+MailSubjectAllocationAllocation allocation@AllocationName: Sie können nun Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ bewerten
+MailAllocationAllocation: Sie können nun auf den unten aufgeführten Seiten Bewerbungen, die im Rahmen der Zentralanmeldung an ihre Kurse gestellt wurden, bewerten. Die Bewertungen werden bei der Vergabe der Plätze berücksichtigt.
+MailAllocationApplicationsMayChange deadline@Text: Bitte beachten Sie, dass Studierende noch bis #{deadline} Bewerbungen stellen, verändern und zurückziehen können. Bewerbungen, die sich nach ihrer Bewertung noch verändern, müssen neu bewertet werden.
+MailAllocationAllocationDeadline deadline@Text: Bitte beachten Sie, dass alle Bewertungen bis #{deadline} erfolgt sein müssen.
+
+MailSubjectAllocationUnratedApplications allocation@AllocationName: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ aus
+MailAllocationUnratedApplications: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der Zentralanmeldung an den jeweiligen Kurs gestellt wurden, die noch nicht bewertet wurden.
+
+MailSubjectAllocationOutdatedRatings allocation@AllocationName: Bereits bewertete Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ haben sich geändert
+MailAllocationOutdatedRatings: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der Zentralanmeldung an den jeweiligen Kurs gestellt wurden, die sich verändert haben, seit sie zuletzt bewertet wurden.
+MailAllocationOutdatedRatingsWarning: Bewerbungen deren Bewertung veraltet ist (d.h. die Bewerbung wurde nach der Bewertung verändert) zählen als nicht bewertet.

src/Handler/Course/Application/Edit.hs

@@ -13,18 +13,18 @@ getCAEditR = postCAEditR
 postCAEditR tid ssh csh cID = do
   uid <- requireAuthId
   appId <- decrypt cID
-  (mAlloc, Entity cid Course{..}, CourseApplication{..}, isAdmin, User{..}) <- runDB $ do
+  (mAlloc, Entity cid Course{..}, CourseApplication{..}, User{..}) <- runDB $ do
     course <- getBy404 $ TermSchoolCourseShort tid ssh csh
     app <- get404 appId
     mAlloc <- traverse getEntity404 $ courseApplicationAllocation app
     appUser <- get404 $ courseApplicationUser app
-    isAdmin <- case mAlloc of
+    return (mAlloc, course, app, appUser)
-      Just alloc -> exists [UserFunctionUser ==. uid, UserFunctionSchool ==. alloc ^. _entityVal . _allocationSchool, UserFunctionFunction ==. SchoolAdmin]
-      Nothing    -> exists [UserFunctionUser ==. uid, UserFunctionSchool ==. course ^. _entityVal . _courseSchool, UserFunctionFunction ==. SchoolAdmin]
-    return (mAlloc, course, app, isAdmin, appUser)
 
+  isAdmin <- case mAlloc of
+    Just alloc -> hasWriteAccessTo $ SchoolR (alloc  ^. _entityVal . _allocationSchool) SchoolEditR
+    Nothing    -> hasWriteAccessTo $ SchoolR (course ^. _entityVal . _courseSchool    ) SchoolEditR
   afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
-  afmApplicantEdit <- hasWriteAccessTo $ CApplicationR tid ssh csh cID CAEditR
+  afmApplicantEdit <- hasWriteAccessTo $ CApplicationR tid ssh csh cID CAEditR -- TODO: Wrong.
   courseCID <- encrypt cid :: Handler CryptoUUIDCourse
 
   let afMode = ApplicationFormMode
@@ -33,7 +33,7 @@ postCAEditR tid ssh csh cID = do
         , afmLecturer
         }
 
-  (ApplicationFormView{..}, appEnc) <- editApplicationR (entityKey <$> mAlloc) uid cid (Just appId) afMode (/= BtnAllocationApply) $ if
+  (ApplicationFormView{..}, appEnc) <- editApplicationR (entityKey <$> mAlloc) courseApplicationUser cid (Just appId) afMode (/= BtnAllocationApply) $ if
     | uid == courseApplicationUser
     , Just (Entity _ Allocation{..}) <- mAlloc
       -> SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: courseCID

src/Handler/Profile.hs

@@ -35,6 +35,7 @@ data NotificationTriggerKind
   | NTKCourseParticipant
   | NTKExamParticipant
   | NTKCorrector
+  | NTKAllocationStaff
   | NTKFunctionary SchoolFunction
   deriving (Eq, Ord, Generic, Typeable)
 deriveFinite ''NotificationTriggerKind
@@ -45,6 +46,7 @@ instance RenderMessage UniWorX NotificationTriggerKind where
     NTKCourseParticipant -> mr MsgNotificationTriggerKindCourseParticipant
     NTKExamParticipant -> mr MsgNotificationTriggerKindExamParticipant
     NTKCorrector -> mr MsgNotificationTriggerKindCorrector
+    NTKAllocationStaff -> mr MsgNotificationTriggerKindAllocationStaff
     NTKFunctionary SchoolAdmin -> mr MsgNotificationTriggerKindAdmin
     NTKFunctionary SchoolLecturer -> mr MsgNotificationTriggerKindLecturer
     NTKFunctionary SchoolExamOffice -> mr MsgNotificationTriggerKindExamOffice
@@ -149,17 +151,22 @@ 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
+      NTExamResult                    -> Just NTKExamParticipant
-      -- _other                      -> Nothing
+      NTAllocationStaffRegister       -> Just $ NTKFunctionary SchoolLecturer
+      NTAllocationAllocation          -> Just NTKAllocationStaff
+      NTAllocationRegister            -> Just NTKAll
+      NTAllocationOutdatedRatings     -> Just NTKAllocationStaff
+      NTAllocationUnratedApplications -> Just NTKAllocationStaff
+      -- _other                       -> Nothing
 
     forcedTriggers = [NTUserRightsUpdate, NTUserAuthModeUpdate]
 

src/Import/NoModel.hs

@@ -57,7 +57,7 @@ import Data.Hashable          as Import
 import Data.List.NonEmpty     as Import (NonEmpty(..), nonEmpty)
 import Data.Text.Encoding.Error as Import(UnicodeException(..))
 import Data.Semigroup         as Import (Semigroup, Min(..), Max(..))
-import Data.Monoid            as Import (Last(..), First(..), Any(..), All(..), Sum(..), Endo(..))
+import Data.Monoid            as Import (Last(..), First(..), Any(..), All(..), Sum(..), Endo(..), Alt(..))
 import Data.Binary            as Import (Binary)
 
 import Numeric.Natural        as Import (Natural)

src/Jobs/Crontab.hs

@@ -224,3 +224,57 @@ determineCrontab = execWriterT $ do
         _other -> return ()
   
   runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ examJobs
+
+  let
+    allocationJobs (Entity nAllocation Allocation{..}) = do
+      whenIsJust allocationStaffRegisterFrom $ \staffRegisterFrom ->
+        tell $ HashMap.singleton
+          (JobCtlQueue $ JobQueueNotification NotificationAllocationStaffRegister{..})
+          Cron
+            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ staffRegisterFrom
+            , cronRepeat    = CronRepeatOnChange
+            , cronRateLimit = appNotificationRateLimit
+            , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffRegisterTo
+            }
+      whenIsJust allocationRegisterFrom $ \registerFrom ->
+        tell $ HashMap.singleton
+          (JobCtlQueue $ JobQueueNotification NotificationAllocationRegister{..})
+          Cron
+            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ registerFrom
+            , cronRepeat    = CronRepeatOnChange
+            , cronRateLimit = appNotificationRateLimit
+            , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationRegisterTo
+            }
+      whenIsJust allocationStaffAllocationFrom $ \allocationFrom ->
+        tell $ HashMap.singleton
+          (JobCtlQueue $ JobQueueNotification NotificationAllocationAllocation{..})
+          Cron
+            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ allocationFrom
+            , cronRepeat    = CronRepeatOnChange
+            , cronRateLimit = appNotificationRateLimit
+            , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
+            }
+      case allocationRegisterTo of
+        Just registerTo
+          | maybe True (> registerTo) allocationStaffAllocationTo
+            -> do
+              tell $ HashMap.singleton
+                (JobCtlQueue $ JobQueueNotification NotificationAllocationUnratedApplications{..})
+                Cron
+                  { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
+                  , cronRepeat    = CronRepeatOnChange
+                  , cronRateLimit = appNotificationRateLimit
+                  , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
+                  }
+              tell $ HashMap.singleton
+                (JobCtlQueue $ JobQueueNotification NotificationAllocationOutdatedRatings{..})
+                Cron
+                  { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
+                  , cronRepeat    = CronRepeatOnChange
+                  , cronRateLimit = appNotificationRateLimit
+                  , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
+                  }
+        _other
+          -> return ()
+
+  runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ allocationJobs

src/Jobs/Handler/QueueNotification.hs

@@ -9,6 +9,7 @@ import Data.List (nub)
 import Jobs.Types
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 import Utils.Sql
 import Jobs.Queue
 
@@ -80,6 +81,86 @@ determineNotificationCandidates notif@NotificationExamResult{..} = do
     whenIsJust lastExec $ \lastExec' ->
       E.where_ $ examResult E.^. ExamResultLastChanged E.>. E.val lastExec'
     return user
+determineNotificationCandidates NotificationAllocationStaffRegister{..} = do
+  Allocation{..} <- getJust nAllocation
+  E.select . E.from $ \(user `E.InnerJoin` userFunction) -> do
+    E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
+     E.&&. userFunction E.^. UserFunctionSchool E.==. E.val allocationSchool
+     E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer
+
+    E.where_ . E.exists . E.from $ \userSchool ->
+      E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
+           E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool
+           E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
+  
+    E.where_ . E.not_ . E.exists . E.from $ \(course `E.InnerJoin` lecturer) -> do
+      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
+       E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId
+      E.where_ . E.exists . E.from $ \allocationCourse ->
+        E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+             E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+
+    return user
+determineNotificationCandidates NotificationAllocationAllocation{..} =
+  E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
+    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+     E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+    E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
+    E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
+
+    E.where_ . E.not_ . E.exists . E.from $ \application ->
+      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
+           E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
+           E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId
+           E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)
+
+    E.where_ . E.exists . E.from $ \application -> 
+      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
+           E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
+           E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId
+
+    return user
+determineNotificationCandidates NotificationAllocationUnratedApplications{..} =
+  E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
+    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+     E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+    E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
+    E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
+  
+    E.where_ . E.exists . E.from $ \application ->
+      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
+           E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
+           E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId
+           E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
+
+    return user
+determineNotificationCandidates NotificationAllocationRegister{..} = do
+  Allocation{..} <- getJust nAllocation
+  E.select . E.from $ \user -> do
+    E.where_ . E.exists . E.from $ \userSchool ->
+      E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
+           E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool
+           E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
+
+    E.where_ . E.not_ . E.exists . E.from $ \application ->
+      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
+           E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
+
+    return user
+determineNotificationCandidates NotificationAllocationOutdatedRatings{..} =
+  E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
+    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+     E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+    E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
+    E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
+  
+    E.where_ . E.exists . E.from $ \application ->
+      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
+           E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
+           E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId
+           E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
+
+    return user
 
 
 classifyNotification :: Notification -> DB NotificationTrigger
@@ -96,3 +177,8 @@ classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrecti
 classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate
 classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate
 classifyNotification NotificationExamResult{} = return NTExamResult
+classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
+classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
+classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
+classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings
+classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications

src/Jobs/Handler/SendNotification.hs

@@ -15,6 +15,7 @@ import Jobs.Handler.SendNotification.CorrectionsNotDistributed
 import Jobs.Handler.SendNotification.UserRightsUpdate
 import Jobs.Handler.SendNotification.UserAuthModeUpdate
 import Jobs.Handler.SendNotification.ExamResult
+import Jobs.Handler.SendNotification.Allocation
 
 
 dispatchJobSendNotification :: UserId -> Notification -> Handler ()

src/Jobs/Handler/SendNotification/Allocation.hs

@@ -0,0 +1,159 @@
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
+
+module Jobs.Handler.SendNotification.Allocation
+  ( dispatchNotificationAllocationStaffRegister
+  , dispatchNotificationAllocationRegister
+  , dispatchNotificationAllocationAllocation
+  , dispatchNotificationAllocationUnratedApplications
+  , dispatchNotificationAllocationOutdatedRatings
+  ) where
+
+import Import
+
+import Handler.Utils
+import Jobs.Handler.SendNotification.Utils
+
+import Text.Hamlet
+
+import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
+  
+
+dispatchNotificationAllocationStaffRegister :: AllocationId -> UserId -> Handler ()
+dispatchNotificationAllocationStaffRegister nAllocation jRecipient = userMailT jRecipient $ do
+  Allocation{..} <- liftHandlerT . runDB $ getJust nAllocation
+
+  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+  setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationName
+  editNotifications <- mkEditNotifications jRecipient
+  registerDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
+  addAlternatives $
+    providePreferredAlternative $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")
+
+dispatchNotificationAllocationRegister :: AllocationId -> UserId -> Handler ()
+dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecipient $ do
+  Allocation{..} <- liftHandlerT . runDB $ getJust nAllocation
+
+  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+  setSubjectI $ MsgMailSubjectAllocationRegister allocationName
+  editNotifications <- mkEditNotifications jRecipient
+  registerDeadline <- traverse (formatTime SelFormatDateTime) allocationRegisterTo
+  addAlternatives $
+    providePreferredAlternative $(ihamletFile "templates/mail/allocationRegister.hamlet")
+
+dispatchNotificationAllocationAllocation :: AllocationId -> UserId -> Handler ()
+dispatchNotificationAllocationAllocation nAllocation jRecipient = do
+  (Allocation{..}, courses) <- liftHandlerT . runDB $ do
+    allocation <- getJust nAllocation
+    courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
+      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
+       E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
+      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+       E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+      return ( course E.^. CourseTerm
+             , course E.^. CourseSchool
+             , course E.^. CourseShorthand
+             , course E.^. CourseName
+             )
+    let courses' = courses
+          & over (traverse . _1) E.unValue
+          & over (traverse . _2) E.unValue
+          & over (traverse . _3) E.unValue
+          & over (traverse . _4) E.unValue
+    return (allocation, courses')
+
+  unless (null courses) . userMailT jRecipient $ do
+    now <- liftIO getCurrentTime
+
+    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+    setSubjectI $ MsgMailSubjectAllocationAllocation allocationName
+    editNotifications <- mkEditNotifications jRecipient
+    allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
+    registerDeadline <- traverse (formatTime SelFormatDateTime) $ assertM (> now) allocationRegisterTo
+    addAlternatives $
+      providePreferredAlternative $(ihamletFile "templates/mail/allocationAllocation.hamlet")
+
+dispatchNotificationAllocationUnratedApplications :: AllocationId -> UserId -> Handler ()
+dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do
+  (Allocation{..}, courses) <- liftHandlerT . runDB $ do
+    allocation <- getJust nAllocation
+    courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
+      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
+       E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
+      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+       E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+
+      let
+        unratedAppCount :: E.SqlExpr (E.Value Natural)
+        unratedAppCount = E.sub_select . E.from $ \application -> do
+          E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
+               E.&&. application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
+               E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
+          return E.countRows
+  
+      return ( course E.^. CourseTerm
+             , course E.^. CourseSchool
+             , course E.^. CourseShorthand
+             , course E.^. CourseName
+             , unratedAppCount
+             )
+    let courses' = courses
+          & over (traverse . _1) E.unValue
+          & over (traverse . _2) E.unValue
+          & over (traverse . _3) E.unValue
+          & over (traverse . _4) E.unValue
+          & over (traverse . _5) E.unValue
+          & filter ((> 0) . view _5)
+    return (allocation, courses')
+
+
+  unless (null courses) . userMailT jRecipient $ do
+    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+    setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationName
+    editNotifications <- mkEditNotifications jRecipient
+    allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
+    addAlternatives $
+      providePreferredAlternative $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet")
+
+dispatchNotificationAllocationOutdatedRatings :: AllocationId -> UserId -> Handler ()
+dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do
+  (Allocation{..}, courses) <- liftHandlerT . runDB $ do
+    allocation <- getJust nAllocation
+    courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
+      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
+       E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
+      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+       E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+
+      let
+        outdatedRatingsAppCount :: E.SqlExpr (E.Value Natural)
+        outdatedRatingsAppCount = E.sub_select . E.from $ \application -> do
+          E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
+               E.&&. application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
+               E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
+          return E.countRows
+  
+      return ( course E.^. CourseTerm
+             , course E.^. CourseSchool
+             , course E.^. CourseShorthand
+             , course E.^. CourseName
+             , outdatedRatingsAppCount
+             )
+    let courses' = courses
+          & over (traverse . _1) E.unValue
+          & over (traverse . _2) E.unValue
+          & over (traverse . _3) E.unValue
+          & over (traverse . _4) E.unValue
+          & over (traverse . _5) E.unValue
+          & filter ((> 0) . view _5)
+    return (allocation, courses')
+
+
+  unless (null courses) . userMailT jRecipient $ do
+    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+    setSubjectI $ MsgMailSubjectAllocationOutdatedRatings allocationName
+    editNotifications <- mkEditNotifications jRecipient
+    allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
+    addAlternatives $
+      providePreferredAlternative $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet")
+

src/Jobs/Types.hs

@@ -67,6 +67,11 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                   | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) }
                   | NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode }
                   | NotificationExamResult { nExam :: ExamId }
+                  | NotificationAllocationStaffRegister { nAllocation :: AllocationId }
+                  | NotificationAllocationRegister { nAllocation :: AllocationId }
+                  | NotificationAllocationAllocation { nAllocation :: AllocationId }
+                  | NotificationAllocationUnratedApplications { nAllocation :: AllocationId }
+                  | NotificationAllocationOutdatedRatings { nAllocation :: AllocationId }
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 
 instance Hashable Job

src/Model/Types/Mail.hs

@@ -14,6 +14,7 @@ import Import.NoModel
 
 import qualified Data.Aeson.Types as Aeson
 
+import qualified Data.HashSet as HashSet
 import qualified Data.HashMap.Strict as HashMap
 
 
@@ -31,6 +32,11 @@ data NotificationTrigger
   | NTUserRightsUpdate
   | NTUserAuthModeUpdate
   | NTExamResult
+  | NTAllocationStaffRegister
+  | NTAllocationAllocation
+  | NTAllocationRegister
+  | NTAllocationOutdatedRatings
+  | NTAllocationUnratedApplications
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 
 instance Universe NotificationTrigger
@@ -54,17 +60,12 @@ newtype NotificationSettings = NotificationSettings { notificationAllowed :: Not
   deriving newtype (Eq, Ord, Read, Show)
 
 instance Default NotificationSettings where
-  def = NotificationSettings $ \case
+  def = NotificationSettings $ not . flip HashSet.member defaultOff
-    NTSubmissionRatedGraded -> True
+    where
-    NTSubmissionRated -> True
+      defaultOff :: HashSet NotificationTrigger
-    NTSheetActive -> True
+      defaultOff = HashSet.fromList
-    NTSheetSoonInactive -> False
+        [ NTSheetSoonInactive
-    NTSheetInactive -> True
+        ]
-    NTCorrectionsAssigned -> True
-    NTCorrectionsNotDistributed -> True
-    NTUserRightsUpdate -> True
-    NTUserAuthModeUpdate -> True
-    NTExamResult -> True
 
 instance ToJSON NotificationSettings where
   toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF

templates/mail/allocationAllocation.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 $ MsgMailSubjectAllocationAllocation allocationName}
+
+    <p>
+      _{SomeMessage MsgMailAllocationAllocation}
+      <ul>
+        $forall (tid, ssh, csh, cName) <- courses
+          <li>
+            <a href=@{CourseR tid ssh csh CApplicationsR}>
+              #{cName}
+
+    $maybe until <- registerDeadline
+      <p>
+        _{SomeMessage $ MsgMailAllocationApplicationsMayChange until}
+
+    $maybe until <- allocationDeadline
+      <p>
+        _{SomeMessage $ MsgMailAllocationAllocationDeadline until}
+
+    ^{ihamletSomeMessage editNotifications}

templates/mail/allocationOutdatedRatings.hamlet

@@ -0,0 +1,37 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+
+      .emph {
+        font-style: italic;
+        font-weight: 600;
+      }
+  <body>
+    <h1>
+      _{SomeMessage $ MsgMailSubjectAllocationOutdatedRatings allocationName}
+
+    <p>
+      _{SomeMessage MsgMailAllocationOutdatedRatings}
+      <ul>
+        $forall (tid, ssh, csh, cName, numOutdated) <- courses
+          <li>
+            <a href=@{CourseR tid ssh csh CApplicationsR}>
+              #{cName}
+            \ (#{tshow numOutdated})
+
+    <p .emph>
+      _{SomeMessage MsgMailAllocationOutdatedRatingsWarning}
+
+    $maybe until <- allocationDeadline
+      <p>
+        _{SomeMessage $ MsgMailAllocationAllocationDeadline until}
+
+    ^{ihamletSomeMessage editNotifications}

templates/mail/allocationRegister.hamlet

@@ -0,0 +1,26 @@
+$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 $ MsgMailSubjectAllocationRegister allocationName}
+
+    <p>
+      _{SomeMessage MsgMailAllocationRegister}
+      <br>
+      <a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
+        #{allocationName}
+
+    $maybe until <- registerDeadline
+      <p>
+        _{SomeMessage $ MsgMailAllocationRegisterDeadline until}
+
+    ^{ihamletSomeMessage editNotifications}

templates/mail/allocationStaffRegister.hamlet

@@ -0,0 +1,26 @@
+$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 $ MsgMailSubjectAllocationStaffRegister allocationName}
+
+    <p>
+      _{SomeMessage MsgMailAllocationStaffRegisterNewCourse}
+      <br>
+      <a href=@{CourseNewR}>
+        _{SomeMessage MsgMenuCourseNew}
+
+    $maybe until <- registerDeadline
+      <p>
+        _{SomeMessage $ MsgMailAllocationStaffRegisterDeadline until}
+
+    ^{ihamletSomeMessage editNotifications}

templates/mail/allocationUnratedApplications.hamlet

@@ -0,0 +1,29 @@
+$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 $ MsgMailSubjectAllocationUnratedApplications allocationName}
+
+    <p>
+      _{SomeMessage MsgMailAllocationUnratedApplications}
+      <ul>
+        $forall (tid, ssh, csh, cName, numUnrated) <- courses
+          <li>
+            <a href=@{CourseR tid ssh csh CApplicationsR}>
+              #{cName}
+            \ (#{tshow numUnrated})
+
+    $maybe until <- allocationDeadline
+      <p>
+        _{SomeMessage $ MsgMailAllocationAllocationDeadline until}
+
+    ^{ihamletSomeMessage editNotifications}