feat(exam-office): notifications

This commit is contained in:
Gregor Kleen 2019-09-11 15:46:01 +02:00
parent 651f0bc4d4
commit 52e1844d5e
13 changed files with 192 additions and 19 deletions

View File

@ -24,8 +24,8 @@ job-flush-interval: "_env:JOB_FLUSH:30"
job-cron-interval: "_env:CRON_INTERVAL:60"
job-stale-threshold: 300
notification-rate-limit: 3600
notification-collate-delay: 300
notification-expiration: 259201
notification-collate-delay: 7200
notification-expiration: 259200
session-timeout: 7200
jwt-expiration: 604800
jwt-encoding: HS256

View File

@ -767,6 +767,12 @@ 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.
MailSubjectExamOfficeExamResults csh@CourseShorthand examn@ExamName: Ergebnisse für #{examn} in #{csh} sind fertiggestellt
MailExamOfficeExamResultsIntro courseName@Text termDesc@Text examn@ExamName: Ein Kursverwalter hat die Prüfungsleistungen für #{examn} im Kurs #{courseName} (#{termDesc}) freigegeben.
MailSubjectExamOfficeExamResultsChanged csh@CourseShorthand examn@ExamName: Ergebnisse für #{examn} in #{csh} wurden verändert
MailExamOfficeExamResultsChangedIntro courseName@Text termDesc@Text examn@ExamName: Ein Kursverwalter hat Prüfungsleistungen für #{examn} im Kurs #{courseName} (#{termDesc}) verändert.
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.
@ -871,6 +877,8 @@ NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldung-Bewerbungen f
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
NotificationTriggerExamOfficeExamResults: Ich kann neue Prüfungsergebnisse einsehen
NotificationTriggerExamOfficeExamResultsChanged: Prüfungsergebnisse wurden verändert
NotificationTriggerKindAll: Für alle Benutzer
NotificationTriggerKindCourseParticipant: Für Kursteilnehmer
@ -1293,11 +1301,11 @@ ExamFinished: Bewertung abgeschlossen ab
ExamFinishedParticipant: Bewertung vorrausichtlich abgeschlossen
ExamFinishedTip: Zeitpunkt zu dem Prüfungergebnisse den Teilnehmern gemeldet werden
ExamClosed: Noten stehen fest ab
ExamClosedTip: Zeitpunkt ab dem keine Änderungen an den Ergebnissen zulässig sind; Prüfungsämter bekommen Einsicht
ExamShowGrades: Noten anzeigen
ExamShowGradesTip: Soll den Teilnehmern ihre genaue Note angezeigt werden, oder sollen sie nur informiert werden, ob sie bestanden haben?
ExamClosedTip: Prüfungsämter, die im System Noten einsehen, werden zu diesem Zeitpunkt benachrichtigt und danach bei Änderungen informiert
ExamShowGrades: Klausur ist benotet
ExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsämter nur informiert werden, ob die Klausur bestanden wurde?
ExamPublicStatistics: Statistik veröffentlichen
ExamPublicStatisticsTip: Soll die statistische Auswertung auch den Teilnehmer angezeigt werden, sobald diese ihre Noten einsehen können?
ExamPublicStatisticsTip: Soll die statistische Auswertung auch den Teilnehmern angezeigt werden, sobald diese ihre Noten einsehen können?
ExamGradingRule: Notenberechnung
ExamGradingManual': Keine automatische Berechnung
ExamGradingKey': Nach Schlüssel

2
routes
View File

@ -161,7 +161,7 @@
/exams CExamListR GET !free
/exams/new CExamNewR GET POST
/exams/#ExamName ExamR:
/show EShowR GET !time
/show EShowR GET !time !exam-office
/edit EEditR GET POST
/corrector-invite ECInviteR GET POST
/users EUsersR GET POST

View File

@ -167,6 +167,18 @@ postEGradesR tid ssh csh examn = do
cID <- encrypt partId
return . SomeRoute . CourseR tid ssh csh $ CUserR cID
participantAnchor :: ExamUserTableData -> DBCell _ _ -> DBCell _ _
participantAnchor x = cellContents . mapped <>~ partAnchor
where
partAnchor :: Widget
partAnchor = do
let partId = x ^. resultUser . _entityKey
cID <- encrypt partId :: WidgetT UniWorX IO CryptoUUIDUser
[whamlet|
$newline never
<span ##{toPathPiece cID}>
|]
markSynced :: ExamResultId -> DB ()
markSynced resId
| null userFunctions =
@ -277,7 +289,7 @@ postEGradesR tid ssh csh examn = do
dbtColonnade = mconcat
[ dbSelect (applying _2) id $ return . view (resultExamResult . _entityKey)
, colSynced
, anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
, imapColonnade participantAnchor . anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
, colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
, emptyOpticColonnade (resultStudyField . _entityVal) colStudyTerms
, emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree

View File

@ -165,6 +165,8 @@ notificationForm template = wFormToAForm $ do
NTAllocationRegister -> Just NTKAll
NTAllocationOutdatedRatings -> Just NTKAllocationStaff
NTAllocationUnratedApplications -> Just NTKAllocationStaff
NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice
NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice
-- _other -> Nothing
forcedTriggers = [NTUserRightsUpdate, NTUserAuthModeUpdate]

View File

@ -7,6 +7,7 @@ import Import
import qualified Data.HashMap.Strict as HashMap
import Jobs.Types
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Semigroup (Max(..))
@ -222,6 +223,36 @@ determineCrontab = execWriterT $ do
, cronNotAfter = Left $ 14 * nominalDay
}
_other -> return ()
case examClosed of
Just close -> do
changedResults <- lift . E.select . E.from $ \examResult -> do
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
E.&&. examResult E.^. ExamResultLastChanged E.>. E.val close
return $ examResult E.^. ExamResultId
case newestResult of
[E.Value (Just lastChange)]
| not $ null changedResults
-> tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationExamOfficeExamResultsChanged{ nExamResults = Set.fromList $ map E.unValue changedResults })
Cron
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay lastChange
, cronRepeat = CronRepeatNever
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = Left appNotificationExpiration
}
_other -> return ()
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationExamOfficeExamResults{..})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ close
, cronRepeat = CronRepeatNever
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = Left appNotificationExpiration
}
Nothing -> return ()
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ examJobs

View File

@ -15,6 +15,8 @@ import Jobs.Queue
import qualified Data.Set as Set
import Handler.Utils.ExamOffice.Exam.Auth
dispatchJobQueueNotification :: Notification -> Handler ()
dispatchJobQueueNotification jNotification = runDBJobs . setSerializable $ do
@ -28,24 +30,24 @@ dispatchJobQueueNotification jNotification = runDBJobs . setSerializable $ do
determineNotificationCandidates :: Notification -> DB [Entity User]
determineNotificationCandidates NotificationSubmissionRated{..}
= E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do
= E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
return user
determineNotificationCandidates NotificationSheetActive{..}
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> do
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
return user
determineNotificationCandidates NotificationSheetSoonInactive{..}
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> do
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
return user
determineNotificationCandidates NotificationSheetInactive{..}
= E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do
= E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
@ -53,7 +55,7 @@ determineNotificationCandidates NotificationSheetInactive{..}
determineNotificationCandidates NotificationCorrectionsAssigned{..}
= selectList [UserId ==. nUser] []
determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet}
= E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do
= E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
@ -65,7 +67,7 @@ determineNotificationCandidates NotificationUserRightsUpdate{..} = do
currentAdminSchools <- setOf (folded . _entityVal . _userFunctionSchool) <$> selectList [UserFunctionUser ==. nUser, UserFunctionFunction ==. SchoolAdmin] []
let oldAdminSchools = setOf (folded . filtered ((== SchoolAdmin) . view _1) . _2 . from _SchoolId) nOriginalRights
newAdminSchools = currentAdminSchools `Set.difference` oldAdminSchools
affectedAdmins <- E.select . E.from $ \(user `E.InnerJoin` admin) -> do
affectedAdmins <- E.select . E.from $ \(user `E.InnerJoin` admin) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ admin E.^. UserFunctionUser E.==. user E.^. UserId
E.where_ $ admin E.^. UserFunctionSchool `E.in_` E.valList (Set.toList newAdminSchools)
E.&&. admin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
@ -75,7 +77,7 @@ determineNotificationCandidates NotificationUserAuthModeUpdate{..}
= selectList [UserId ==. nUser] []
determineNotificationCandidates notif@NotificationExamResult{..} = do
lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
E.select . E.from $ \(examResult `E.InnerJoin` user) -> do
E.select . E.from $ \(examResult `E.InnerJoin` user) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ examResult E.^. ExamResultUser E.==. user E.^. UserId
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
whenIsJust lastExec $ \lastExec' ->
@ -83,7 +85,7 @@ determineNotificationCandidates notif@NotificationExamResult{..} = do
return user
determineNotificationCandidates NotificationAllocationStaffRegister{..} = do
Allocation{..} <- getJust nAllocation
E.select . E.from $ \(user `E.InnerJoin` userFunction) -> do
E.select . E.from $ \(user `E.InnerJoin` userFunction) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ 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
@ -102,7 +104,7 @@ determineNotificationCandidates NotificationAllocationStaffRegister{..} = do
return user
determineNotificationCandidates NotificationAllocationAllocation{..} =
E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ 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
@ -121,7 +123,7 @@ determineNotificationCandidates NotificationAllocationAllocation{..} =
return user
determineNotificationCandidates NotificationAllocationUnratedApplications{..} =
E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ 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
@ -148,7 +150,7 @@ determineNotificationCandidates NotificationAllocationRegister{..} = do
return user
determineNotificationCandidates NotificationAllocationOutdatedRatings{..} =
E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ 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
@ -161,6 +163,18 @@ determineNotificationCandidates NotificationAllocationOutdatedRatings{..} =
E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
return user
determineNotificationCandidates NotificationExamOfficeExamResults{..} =
E.select . E.from $ \user -> do
E.where_ . E.exists . E.from $ \examResult -> do
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
return user
determineNotificationCandidates NotificationExamOfficeExamResultsChanged{..} =
E.select . E.from $ \user -> do
E.where_ . E.exists . E.from $ \examResult -> do
E.where_ $ examResult E.^. ExamResultId `E.in_` E.valList (Set.toList nExamResults)
E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
return user
classifyNotification :: Notification -> DB NotificationTrigger
@ -182,3 +196,5 @@ classifyNotification NotificationAllocationAllocation{} = return NTAllocationAll
classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged

View File

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

View File

@ -0,0 +1,63 @@
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
module Jobs.Handler.SendNotification.ExamOffice
( dispatchNotificationExamOfficeExamResults
, dispatchNotificationExamOfficeExamResultsChanged
) where
import Import
import Handler.Utils.Mail
import Jobs.Handler.SendNotification.Utils
import Text.Hamlet
import qualified Data.CaseInsensitive as CI
import qualified Data.Set as Set
dispatchNotificationExamOfficeExamResults :: ExamId -> UserId -> Handler ()
dispatchNotificationExamOfficeExamResults 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 $ MsgMailSubjectExamOfficeExamResults 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/examOffice/examResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
dispatchNotificationExamOfficeExamResultsChanged :: Set ExamResultId -> UserId -> Handler ()
dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient = do
entitiesExamResults <- runDB $ selectList [ ExamResultId <-. Set.toList nExamResults ] []
let exams = Set.fromList $ map (examResultExam . entityVal) entitiesExamResults
forM_ exams $ \nExam -> 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 $ MsgMailSubjectExamOfficeExamResultsChanged 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/examOffice/examResultsChanged.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

View File

@ -79,6 +79,8 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
| NotificationAllocationAllocation { nAllocation :: AllocationId }
| NotificationAllocationUnratedApplications { nAllocation :: AllocationId }
| NotificationAllocationOutdatedRatings { nAllocation :: AllocationId }
| NotificationExamOfficeExamResults { nExam :: ExamId }
| NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
deriving (Eq, Ord, Show, Read, Generic, Typeable)
instance Hashable Job

View File

@ -37,6 +37,8 @@ data NotificationTrigger
| NTAllocationRegister
| NTAllocationOutdatedRatings
| NTAllocationUnratedApplications
| NTExamOfficeExamResults
| NTExamOfficeExamResultsChanged
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
instance Universe NotificationTrigger

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>
_{MsgMailExamOfficeExamResultsIntro (CI.original courseName) termDesc examName}
<p>
<a href=@{CExamR tid ssh csh examn EGradesR}>
#{examName}
^{editNotifications}

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>
_{MsgMailExamOfficeExamResultsChangedIntro (CI.original courseName) termDesc examName}
<p>
<a href=@{CExamR tid ssh csh examn EGradesR}>
#{examName}
^{editNotifications}