feat(exams): notifications wrt. registration

messages/uniworx/de.msg

@@ -766,6 +766,15 @@ MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie kön
 MailSubjectExamResult csh@CourseShorthand examn@ExamName: Ergebnisse für #{examn} in #{csh} wurden herausgegeben
 MailExamResultIntro courseName@Text termDesc@Text examn@ExamName: Sie können nun Ihr Ergebnis für #{examn} im Kurs #{courseName} (#{termDesc}) einsehen.
 
+MailSubjectExamRegistrationActive csh@CourseShorthand examn@ExamName: Anmeldung für #{examn} in #{csh} ist möglich
+MailExamRegistrationActiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich nun für #{examn} im Kurs #{courseName} (#{termDesc}) anmelden.
+
+MailSubjectExamRegistrationSoonInactive csh@CourseShorthand examn@ExamName: Anmeldung für #{examn} in #{csh} ist nur noch kurze Zeit möglich
+MailExamRegistrationSoonInactiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich bald nicht mehr für #{examn} im Kurs #{courseName} (#{termDesc}) anmelden.
+
+MailSubjectExamDeregistrationSoonInactive csh@CourseShorthand examn@ExamName: Abmeldung für #{examn} in #{csh} ist nur noch kurze Zeit möglich
+MailExamDeregistrationSoonInactiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich bald nicht mehr von #{examn} im Kurs #{courseName} (#{termDesc}) abmelden.
+
 MailSubjectSubmissionsUnassigned csh@CourseShorthand sheetName@SheetName: Abgaben zu #{sheetName} in #{csh} konnten nicht verteilt werden
 MailSubmissionsUnassignedIntro n@Int courseName@Text termDesc@Text sheetName@SheetName: #{n} Abgaben zu #{sheetName} im Kurs #{courseName} (#{termDesc}) konnten nicht automatisiert verteilt werden.
 
@@ -866,6 +875,9 @@ NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugetei
 NotificationTriggerCorrectionsNotDistributed: Nicht alle Abgaben eines meiner Übungsblätter konnten einem Korrektor zugeteilt werden
 NotificationTriggerUserRightsUpdate: Meine Berechtigungen wurden geändert
 NotificationTriggerUserAuthModeUpdate: Mein Anmelde-Modus wurde geändert
+NotificationTriggerExamRegistrationActive: Ich kann mich für eine Prüfung anmelden
+NotificationTriggerExamRegistrationSoonInactive: Ich kann mich bald nicht mehr für eine Prüfung anmelden
+NotificationTriggerExamDeregistrationSoonInactive: Ich kann mich bald nicht mehr von einer Prüfung abmelden
 NotificationTriggerExamResult: Ich kann ein neues Prüfungsergebnis einsehen
 NotificationTriggerAllocationStaffRegister: Ich kann Kurse bei einer neuen Zentralanmeldung eintragen 
 NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldung-Bewerbungen für einen meiner Kurse bewerten

src/Handler/Profile.hs

@@ -161,22 +161,25 @@ notificationForm template = wFormToAForm $ do
       = apopt checkBoxField (fslI nt) (flip notificationAllowed nt <$> template)
 
     ntSection = \case
-      NTSubmissionRatedGraded         -> Just NTKCourseParticipant
+      NTSubmissionRatedGraded          -> Just NTKCourseParticipant
-      NTSubmissionRated               -> Just NTKCourseParticipant
+      NTSubmissionRated                -> Just NTKCourseParticipant
-      NTSheetActive                   -> Just NTKCourseParticipant
+      NTSheetActive                    -> Just NTKCourseParticipant
-      NTSheetSoonInactive             -> Just NTKCourseParticipant
+      NTSheetSoonInactive              -> Just NTKCourseParticipant
-      NTSheetInactive                 -> Just $ NTKFunctionary SchoolLecturer
+      NTSheetInactive                  -> Just $ NTKFunctionary SchoolLecturer
-      NTCorrectionsAssigned           -> Just NTKCorrector
+      NTCorrectionsAssigned            -> Just NTKCorrector
-      NTCorrectionsNotDistributed     -> Just $ NTKFunctionary SchoolLecturer
+      NTCorrectionsNotDistributed      -> Just $ NTKFunctionary SchoolLecturer
-      NTUserRightsUpdate              -> Just NTKAll
+      NTUserRightsUpdate               -> Just NTKAll
-      NTUserAuthModeUpdate            -> Just NTKAll
+      NTUserAuthModeUpdate             -> Just NTKAll
-      NTExamResult                    -> Just NTKExamParticipant
+      NTExamRegistrationActive         -> Just NTKCourseParticipant
-      NTAllocationStaffRegister       -> Just $ NTKFunctionary SchoolLecturer
+      NTExamRegistrationSoonInactive   -> Just NTKCourseParticipant
-      NTAllocationAllocation          -> Just NTKAllocationStaff
+      NTExamDeregistrationSoonInactive -> Just NTKCourseParticipant
-      NTAllocationRegister            -> Just NTKAll
+      NTExamResult                     -> Just NTKExamParticipant
-      NTAllocationOutdatedRatings     -> Just NTKAllocationStaff
+      NTAllocationStaffRegister        -> Just $ NTKFunctionary SchoolLecturer
-      NTAllocationUnratedApplications -> Just NTKAllocationStaff
+      NTAllocationAllocation           -> Just NTKAllocationStaff
-      -- _other                       -> Nothing
+      NTAllocationRegister             -> Just NTKAll
+      NTAllocationOutdatedRatings      -> Just NTKAllocationStaff
+      NTAllocationUnratedApplications  -> Just NTKAllocationStaff
+      -- _other                        -> Nothing
 
     forcedTriggers = [NTUserRightsUpdate, NTUserAuthModeUpdate]
 

src/Handler/Utils/Form.hs

@@ -981,15 +981,16 @@ sectionedFuncForm mkSection mkForm FieldSettings{fsName = _, fsAttrs = _, ..} is
       aFormToWForm $ Map.union <$> wFormToAForm (pure res) <*> acc
   
     funcFieldView :: (FormResult (k -> v), Widget) -> MForm m (FormResult (k -> v), [FieldView UniWorX])
-    funcFieldView (res, fvInput) = do
+    funcFieldView (res, formView) = do
       mr <- getMessageRender
+      fvId <- maybe newIdent return fsId
       let fvLabel = toHtml $ mr fsLabel
           fvTooltip = fmap (toHtml . mr) fsTooltip
           fvRequired = isRequired
           fvErrors
             | FormFailure (err:_) <- res = Just $ toHtml err
             | otherwise = Nothing
-      fvId <- maybe newIdent return fsId
+          fvInput = $(widgetFile "widgets/fields/funcField")
       return (res, pure FieldView{..})
     -- areq nsField (fslI MsgNotificationSettings) (stgNotficationSettings <$> template)
 

src/Jobs/Crontab.hs

@@ -207,21 +207,50 @@ determineCrontab = execWriterT $ do
   
   let
     examJobs (Entity nExam Exam{..}) = do
-      newestResult <- lift . E.select . E.from $ \examResult -> do
+      whenIsJust examVisibleFrom $ \visibleFrom -> do
-        E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
+        newestResult <- lift . E.select . E.from $ \examResult -> do
-        return . E.max_ $ examResult E.^. ExamResultLastChanged
+          E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
+          return . E.max_ $ examResult E.^. ExamResultLastChanged
 
-      case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of
+        case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of
-        [E.Value (NTop (Just ts))] -> 
+          [E.Value (NTop (Just ts))] -> 
+            tell $ HashMap.singleton
+              (JobCtlQueue $ JobQueueNotification NotificationExamResult{..})
+              Cron
+                { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom ts
+                , cronRepeat = CronRepeatOnChange
+                , cronRateLimit = appNotificationRateLimit
+                , cronNotAfter = Left appNotificationExpiration
+                }
+          _other -> return ()
+
+        whenIsJust examRegisterFrom $ \registerFrom ->
           tell $ HashMap.singleton
-            (JobCtlQueue $ JobQueueNotification NotificationExamResult{..})
+            (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationActive{..})
             Cron
-              { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ ts
+              { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom registerFrom
-              , cronRepeat = CronRepeatOnChange
+              , cronRepeat    = CronRepeatOnChange
               , cronRateLimit = appNotificationRateLimit
-              , cronNotAfter = Left $ 14 * nominalDay
+              , cronNotAfter  = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) examRegisterTo
+              }
+        whenIsJust ((,) <$> examRegisterFrom <*> examRegisterTo) $ \(registerFrom, registerTo) ->
+          tell $ HashMap.singleton
+            (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationSoonInactive{..})
+            Cron
+              { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) registerTo
+              , cronRepeat    = CronRepeatOnChange
+              , cronRateLimit = appNotificationRateLimit
+              , cronNotAfter  = Right . CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
+              }
+        whenIsJust ((,) <$> examRegisterFrom <*> examDeregisterUntil) $ \(registerFrom, deregisterUntil) ->
+          tell $ HashMap.singleton
+            (JobCtlQueue $ JobQueueNotification NotificationExamDeregistrationSoonInactive{..})
+            Cron
+              { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) deregisterUntil
+              , cronRepeat    = CronRepeatOnChange
+              , cronRateLimit = appNotificationRateLimit
+              , cronNotAfter  = Right . CronTimestamp $ utcToLocalTimeTZ appTZ deregisterUntil
               }
-        _other -> return ()
   
   runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ examJobs
 

src/Jobs/Handler/QueueNotification.hs

@@ -73,6 +73,29 @@ determineNotificationCandidates NotificationUserRightsUpdate{..} = do
   return . nub $ affectedUser <> affectedAdmins
 determineNotificationCandidates NotificationUserAuthModeUpdate{..}
   = selectList [UserId ==. nUser] []
+determineNotificationCandidates NotificationExamRegistrationActive{..} =
+  E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
+    E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
+    E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
+    E.where_ $ exam E.^. ExamId E.==. E.val nExam
+    E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
+      E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
+           E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
+    return user
+determineNotificationCandidates NotificationExamRegistrationSoonInactive{..} =
+  E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
+    E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
+    E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
+    E.where_ $ exam E.^. ExamId E.==. E.val nExam
+    E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
+      E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
+           E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
+    return user
+determineNotificationCandidates NotificationExamDeregistrationSoonInactive{..} =
+  E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
+    E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
+    E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
+    return user
 determineNotificationCandidates notif@NotificationExamResult{..} = do
   lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
   E.select . E.from $ \(examResult `E.InnerJoin` user) -> do
@@ -169,16 +192,19 @@ classifyNotification NotificationSubmissionRated{..} = do
   return $ case sheetType of
     NotGraded -> NTSubmissionRated
     _other -> NTSubmissionRatedGraded
-classifyNotification NotificationSheetActive{} = return NTSheetActive
+classifyNotification NotificationSheetActive{}                    = return NTSheetActive
-classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive
+classifyNotification NotificationSheetSoonInactive{}              = return NTSheetSoonInactive
-classifyNotification NotificationSheetInactive{} = return NTSheetInactive
+classifyNotification NotificationSheetInactive{}                  = return NTSheetInactive
-classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned
+classifyNotification NotificationCorrectionsAssigned{}            = return NTCorrectionsAssigned
-classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed
+classifyNotification NotificationCorrectionsNotDistributed{}      = return NTCorrectionsNotDistributed
-classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate
+classifyNotification NotificationUserRightsUpdate{}               = return NTUserRightsUpdate
-classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate
+classifyNotification NotificationUserAuthModeUpdate{}             = return NTUserAuthModeUpdate
-classifyNotification NotificationExamResult{} = return NTExamResult
+classifyNotification NotificationExamRegistrationActive{}         = return NTExamRegistrationActive
-classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
+classifyNotification NotificationExamRegistrationSoonInactive{}   = return NTExamRegistrationSoonInactive
-classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
+classifyNotification NotificationExamDeregistrationSoonInactive{} = return NTExamDeregistrationSoonInactive
-classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
+classifyNotification NotificationExamResult{}                     = return NTExamResult
-classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings
+classifyNotification NotificationAllocationStaffRegister{}        = return NTAllocationStaffRegister
-classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
+classifyNotification NotificationAllocationAllocation{}           = return NTAllocationAllocation
+classifyNotification NotificationAllocationRegister{}             = return NTAllocationRegister
+classifyNotification NotificationAllocationOutdatedRatings{}      = return NTAllocationOutdatedRatings
+classifyNotification NotificationAllocationUnratedApplications{}  = return NTAllocationUnratedApplications

src/Jobs/Handler/SendNotification.hs

@@ -14,6 +14,7 @@ import Jobs.Handler.SendNotification.CorrectionsAssigned
 import Jobs.Handler.SendNotification.CorrectionsNotDistributed
 import Jobs.Handler.SendNotification.UserRightsUpdate
 import Jobs.Handler.SendNotification.UserAuthModeUpdate
+import Jobs.Handler.SendNotification.ExamActive
 import Jobs.Handler.SendNotification.ExamResult
 import Jobs.Handler.SendNotification.Allocation
 

src/Jobs/Handler/SendNotification/ExamActive.hs

@@ -0,0 +1,78 @@
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
+
+module Jobs.Handler.SendNotification.ExamActive
+  ( dispatchNotificationExamRegistrationActive
+  , dispatchNotificationExamRegistrationSoonInactive
+  , dispatchNotificationExamDeregistrationSoonInactive
+  ) where
+
+import Import
+
+import Handler.Utils.Mail
+import Jobs.Handler.SendNotification.Utils
+
+import Text.Hamlet
+import qualified Data.CaseInsensitive as CI
+
+dispatchNotificationExamRegistrationActive :: ExamId -> UserId -> Handler ()
+dispatchNotificationExamRegistrationActive nExam jRecipient = userMailT jRecipient $ do
+  (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do
+    exam <- getJust nExam
+    course <- belongsToJust examCourse exam
+    return (course, exam)
+  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+  setSubjectI $ MsgMailSubjectExamRegistrationActive courseShorthand examName
+
+  MsgRenderer mr <- getMailMsgRenderer
+  let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
+      tid = courseTerm
+      ssh = courseSchool
+      csh = courseShorthand
+      examn = examName
+
+  editNotifications <- mkEditNotifications jRecipient
+
+  addAlternatives $
+    providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+
+dispatchNotificationExamRegistrationSoonInactive :: ExamId -> UserId -> Handler ()
+dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do
+  (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do
+    exam <- getJust nExam
+    course <- belongsToJust examCourse exam
+    return (course, exam)
+  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+  setSubjectI $ MsgMailSubjectExamRegistrationSoonInactive courseShorthand examName
+
+  MsgRenderer mr <- getMailMsgRenderer
+  let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
+      tid = courseTerm
+      ssh = courseSchool
+      csh = courseShorthand
+      examn = examName
+
+  editNotifications <- mkEditNotifications jRecipient
+
+  addAlternatives $
+    providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+
+dispatchNotificationExamDeregistrationSoonInactive :: ExamId -> UserId -> Handler ()
+dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do
+  (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do
+    exam <- getJust nExam
+    course <- belongsToJust examCourse exam
+    return (course, exam)
+  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+  setSubjectI $ MsgMailSubjectExamDeregistrationSoonInactive courseShorthand examName
+
+  MsgRenderer mr <- getMailMsgRenderer
+  let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
+      tid = courseTerm
+      ssh = courseSchool
+      csh = courseShorthand
+      examn = examName
+
+  editNotifications <- mkEditNotifications jRecipient
+
+  addAlternatives $
+    providePreferredAlternative ($(ihamletFile "templates/mail/examDeregistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Types.hs

@@ -76,6 +76,9 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                   | NotificationCorrectionsNotDistributed { nSheet :: SheetId }
                   | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) }
                   | NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode }
+                  | NotificationExamRegistrationActive { nExam :: ExamId }
+                  | NotificationExamRegistrationSoonInactive { nExam :: ExamId }
+                  | NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
                   | NotificationExamResult { nExam :: ExamId }
                   | NotificationAllocationStaffRegister { nAllocation :: AllocationId }
                   | NotificationAllocationRegister { nAllocation :: AllocationId }

src/Model/Types/Mail.hs

@@ -31,6 +31,9 @@ data NotificationTrigger
   | NTCorrectionsNotDistributed
   | NTUserRightsUpdate
   | NTUserAuthModeUpdate
+  | NTExamRegistrationActive
+  | NTExamRegistrationSoonInactive
+  | NTExamDeregistrationSoonInactive
   | NTExamResult
   | NTAllocationStaffRegister
   | NTAllocationAllocation
@@ -65,6 +68,7 @@ instance Default NotificationSettings where
       defaultOff :: HashSet NotificationTrigger
       defaultOff = HashSet.fromList
         [ NTSheetSoonInactive
+        , NTExamRegistrationSoonInactive
         ]
 
 instance ToJSON NotificationSettings where

templates/i18n/changelog/de.hamlet

@@ -1,5 +1,11 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2019 09 13}
+  <dd .deflist__dd>
+    <ul>
+      <li>Benachrichtigungen bzgl. Klausur An- und Abmeldung
+
   <dt .deflist__dt>
     ^{formatGregorianW 2019 09 12}
   <dd .deflist__dd>

templates/mail/examDeregistrationSoonInactive.hamlet

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

templates/mail/examRegistrationActive.hamlet

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

templates/mail/examRegistrationSoonInactive.hamlet

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

templates/widgets/fields/funcField.hamlet

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

templates/widgets/fields/funcField.lucius

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