diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 968fb84c9..66f6958e5 100644 --- a/messages/uniworx/de.msg +++ b/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 diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 1db807b6f..4ecb8fdab 100644 --- a/src/Handler/Profile.hs +++ b/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 - NTSubmissionRated -> Just NTKCourseParticipant - NTSheetActive -> Just NTKCourseParticipant - NTSheetSoonInactive -> Just NTKCourseParticipant - NTSheetInactive -> Just $ NTKFunctionary SchoolLecturer - NTCorrectionsAssigned -> Just NTKCorrector - NTCorrectionsNotDistributed -> Just $ NTKFunctionary SchoolLecturer - NTUserRightsUpdate -> Just NTKAll - NTUserAuthModeUpdate -> Just NTKAll - NTExamResult -> Just NTKExamParticipant - NTAllocationStaffRegister -> Just $ NTKFunctionary SchoolLecturer - NTAllocationAllocation -> Just NTKAllocationStaff - NTAllocationRegister -> Just NTKAll - NTAllocationOutdatedRatings -> Just NTKAllocationStaff - NTAllocationUnratedApplications -> Just NTKAllocationStaff - -- _other -> Nothing + NTSubmissionRatedGraded -> Just NTKCourseParticipant + NTSubmissionRated -> Just NTKCourseParticipant + NTSheetActive -> Just NTKCourseParticipant + NTSheetSoonInactive -> Just NTKCourseParticipant + NTSheetInactive -> Just $ NTKFunctionary SchoolLecturer + NTCorrectionsAssigned -> Just NTKCorrector + NTCorrectionsNotDistributed -> Just $ NTKFunctionary SchoolLecturer + NTUserRightsUpdate -> Just NTKAll + NTUserAuthModeUpdate -> Just NTKAll + NTExamRegistrationActive -> Just NTKCourseParticipant + NTExamRegistrationSoonInactive -> Just NTKCourseParticipant + NTExamDeregistrationSoonInactive -> Just NTKCourseParticipant + NTExamResult -> Just NTKExamParticipant + NTAllocationStaffRegister -> Just $ NTKFunctionary SchoolLecturer + NTAllocationAllocation -> Just NTKAllocationStaff + NTAllocationRegister -> Just NTKAll + NTAllocationOutdatedRatings -> Just NTKAllocationStaff + NTAllocationUnratedApplications -> Just NTKAllocationStaff + -- _other -> Nothing forcedTriggers = [NTUserRightsUpdate, NTUserAuthModeUpdate] diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 1571b13af..60d65fbac 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -981,15 +981,16 @@ sectionedFuncForm mkSection mkForm FieldSettings{fsName = _, fsAttrs = _, ..} is aFormToWForm $ Map.union <$> wFormToAForm (pure res) <*> acc funcFieldView :: (FormResult (k -> v), Widget) -> MForm m (FormResult (k -> v), [FieldView UniWorX]) - funcFieldView (res, fvInput) = do + funcFieldView (res, formView) = do mr <- getMessageRender + fvId <- maybe newIdent return fsId let fvLabel = toHtml $ mr fsLabel fvTooltip = fmap (toHtml . mr) fsTooltip fvRequired = isRequired fvErrors | FormFailure (err:_) <- res = Just $ toHtml err | otherwise = Nothing - fvId <- maybe newIdent return fsId + fvInput = $(widgetFile "widgets/fields/funcField") return (res, pure FieldView{..}) -- areq nsField (fslI MsgNotificationSettings) (stgNotficationSettings <$> template) diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 8131c2194..e4c922638 100644 --- a/src/Jobs/Crontab.hs +++ b/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 - E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam - return . E.max_ $ examResult E.^. ExamResultLastChanged + whenIsJust examVisibleFrom $ \visibleFrom -> do + newestResult <- lift . E.select . E.from $ \examResult -> do + E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam + return . E.max_ $ examResult E.^. ExamResultLastChanged - case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of - [E.Value (NTop (Just ts))] -> + case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of + [E.Value (NTop (Just ts))] -> + tell $ HashMap.singleton + (JobCtlQueue $ JobQueueNotification NotificationExamResult{..}) + Cron + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom ts + , cronRepeat = CronRepeatOnChange + , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Left appNotificationExpiration + } + _other -> return () + + whenIsJust examRegisterFrom $ \registerFrom -> tell $ HashMap.singleton - (JobCtlQueue $ JobQueueNotification NotificationExamResult{..}) + (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationActive{..}) Cron - { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ ts - , cronRepeat = CronRepeatOnChange + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom registerFrom + , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit - , cronNotAfter = Left $ 14 * nominalDay + , cronNotAfter = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) examRegisterTo + } + whenIsJust ((,) <$> examRegisterFrom <*> examRegisterTo) $ \(registerFrom, registerTo) -> + tell $ HashMap.singleton + (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationSoonInactive{..}) + Cron + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) registerTo + , cronRepeat = CronRepeatOnChange + , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ registerTo + } + whenIsJust ((,) <$> examRegisterFrom <*> examDeregisterUntil) $ \(registerFrom, deregisterUntil) -> + tell $ HashMap.singleton + (JobCtlQueue $ JobQueueNotification NotificationExamDeregistrationSoonInactive{..}) + Cron + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) deregisterUntil + , cronRepeat = CronRepeatOnChange + , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ deregisterUntil } - _other -> return () runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ examJobs diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 56b3b1bbb..08dbfcebf 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/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 NotificationSheetSoonInactive{} = return NTSheetSoonInactive -classifyNotification NotificationSheetInactive{} = return NTSheetInactive -classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned -classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed -classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate -classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate -classifyNotification NotificationExamResult{} = return NTExamResult -classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister -classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation -classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister -classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings -classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications +classifyNotification NotificationSheetActive{} = return NTSheetActive +classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive +classifyNotification NotificationSheetInactive{} = return NTSheetInactive +classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned +classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed +classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate +classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate +classifyNotification NotificationExamRegistrationActive{} = return NTExamRegistrationActive +classifyNotification NotificationExamRegistrationSoonInactive{} = return NTExamRegistrationSoonInactive +classifyNotification NotificationExamDeregistrationSoonInactive{} = return NTExamDeregistrationSoonInactive +classifyNotification NotificationExamResult{} = return NTExamResult +classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister +classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation +classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister +classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings +classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs index 82214fe04..500244031 100644 --- a/src/Jobs/Handler/SendNotification.hs +++ b/src/Jobs/Handler/SendNotification.hs @@ -14,6 +14,7 @@ import Jobs.Handler.SendNotification.CorrectionsAssigned import Jobs.Handler.SendNotification.CorrectionsNotDistributed import Jobs.Handler.SendNotification.UserRightsUpdate import Jobs.Handler.SendNotification.UserAuthModeUpdate +import Jobs.Handler.SendNotification.ExamActive import Jobs.Handler.SendNotification.ExamResult import Jobs.Handler.SendNotification.Allocation diff --git a/src/Jobs/Handler/SendNotification/ExamActive.hs b/src/Jobs/Handler/SendNotification/ExamActive.hs new file mode 100644 index 000000000..9751a6bf7 --- /dev/null +++ b/src/Jobs/Handler/SendNotification/ExamActive.hs @@ -0,0 +1,78 @@ +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results + +module Jobs.Handler.SendNotification.ExamActive + ( dispatchNotificationExamRegistrationActive + , dispatchNotificationExamRegistrationSoonInactive + , dispatchNotificationExamDeregistrationSoonInactive + ) where + +import Import + +import Handler.Utils.Mail +import Jobs.Handler.SendNotification.Utils + +import Text.Hamlet +import qualified Data.CaseInsensitive as CI + +dispatchNotificationExamRegistrationActive :: ExamId -> UserId -> Handler () +dispatchNotificationExamRegistrationActive nExam jRecipient = userMailT jRecipient $ do + (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do + exam <- getJust nExam + course <- belongsToJust examCourse exam + return (course, exam) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI $ MsgMailSubjectExamRegistrationActive courseShorthand examName + + MsgRenderer mr <- getMailMsgRenderer + let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm + tid = courseTerm + ssh = courseSchool + csh = courseShorthand + examn = examName + + editNotifications <- mkEditNotifications jRecipient + + addAlternatives $ + providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + +dispatchNotificationExamRegistrationSoonInactive :: ExamId -> UserId -> Handler () +dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do + (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do + exam <- getJust nExam + course <- belongsToJust examCourse exam + return (course, exam) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI $ MsgMailSubjectExamRegistrationSoonInactive courseShorthand examName + + MsgRenderer mr <- getMailMsgRenderer + let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm + tid = courseTerm + ssh = courseSchool + csh = courseShorthand + examn = examName + + editNotifications <- mkEditNotifications jRecipient + + addAlternatives $ + providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + +dispatchNotificationExamDeregistrationSoonInactive :: ExamId -> UserId -> Handler () +dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do + (Course{..}, Exam{..}) <- liftHandlerT . runDB $ do + exam <- getJust nExam + course <- belongsToJust examCourse exam + return (course, exam) + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI $ MsgMailSubjectExamDeregistrationSoonInactive courseShorthand examName + + MsgRenderer mr <- getMailMsgRenderer + let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm + tid = courseTerm + ssh = courseSchool + csh = courseShorthand + examn = examName + + editNotifications <- mkEditNotifications jRecipient + + addAlternatives $ + providePreferredAlternative ($(ihamletFile "templates/mail/examDeregistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index a5b6149d9..15001d73d 100644 --- a/src/Jobs/Types.hs +++ b/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 } diff --git a/src/Model/Types/Mail.hs b/src/Model/Types/Mail.hs index 4dda93065..4c5eddd9b 100644 --- a/src/Model/Types/Mail.hs +++ b/src/Model/Types/Mail.hs @@ -31,6 +31,9 @@ data NotificationTrigger | NTCorrectionsNotDistributed | NTUserRightsUpdate | NTUserAuthModeUpdate + | NTExamRegistrationActive + | NTExamRegistrationSoonInactive + | NTExamDeregistrationSoonInactive | NTExamResult | NTAllocationStaffRegister | NTAllocationAllocation @@ -65,6 +68,7 @@ instance Default NotificationSettings where defaultOff :: HashSet NotificationTrigger defaultOff = HashSet.fromList [ NTSheetSoonInactive + , NTExamRegistrationSoonInactive ] instance ToJSON NotificationSettings where diff --git a/templates/i18n/changelog/de.hamlet b/templates/i18n/changelog/de.hamlet index ec4302653..7c966d3ad 100644 --- a/templates/i18n/changelog/de.hamlet +++ b/templates/i18n/changelog/de.hamlet @@ -1,5 +1,11 @@ $newline never
+
+ ^{formatGregorianW 2019 09 13} +
+