fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(exams): notifications wrt. registration

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-13 10:06:38 +02:00
parent bcb9e16a09
commit ae27ff0bb1
15 changed files with 265 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
messages/uniworx/de.msg
View File

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

35
src/Handler/Profile.hs
View File

@ -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]

5
src/Handler/Utils/Form.hs
View File

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

49
src/Jobs/Crontab.hs
View File

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

52
src/Jobs/Handler/QueueNotification.hs
View File

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

1
src/Jobs/Handler/SendNotification.hs
View File

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

78
src/Jobs/Handler/SendNotification/ExamActive.hs Normal file
View File

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

3
src/Jobs/Types.hs
View File

@ -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 }

4
src/Model/Types/Mail.hs
View File

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

6
templates/i18n/changelog/de.hamlet
View File

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

18
templates/mail/examDeregistrationSoonInactive.hamlet Normal file
View File

@ -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}

18
templates/mail/examRegistrationActive.hamlet Normal file
View File

@ -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}

18
templates/mail/examRegistrationSoonInactive.hamlet Normal file
View File

@ -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}

3
templates/widgets/fields/funcField.hamlet Normal file
View File

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

4
templates/widgets/fields/funcField.lucius Normal file
View File

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