From 93232201f2b62b61ed6f543d84f6373a13bd1ca5 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 4 Oct 2019 11:12:10 +0200 Subject: [PATCH] feat(allocations): notification about finished allocation --- messages/uniworx/de.msg | 13 ++++++- src/Handler/Profile.hs | 3 ++ src/Jobs/Crontab.hs | 12 ++++++ src/Jobs/Handler/QueueNotification.hs | 13 +++++++ .../Handler/SendNotification/Allocation.hs | 39 +++++++++++++++++++ src/Jobs/Types.hs | 1 + src/Model/Types/Mail.hs | 1 + templates/mail/allocationResults.hamlet | 36 +++++++++++++++++ 8 files changed, 116 insertions(+), 2 deletions(-) create mode 100644 templates/mail/allocationResults.hamlet diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 4ed788aa7..c48d3d9fd 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -900,6 +900,7 @@ 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 +NotificationTriggerAllocationResults: Plätze wurden für eine meiner Zentralanmeldungen verteilt NotificationTriggerExamOfficeExamResults: Ich kann neue Prüfungsergebnisse einsehen NotificationTriggerExamOfficeExamResultsChanged: Prüfungsergebnisse wurden verändert @@ -911,7 +912,8 @@ NotificationTriggerKindLecturer: Für Dozenten NotificationTriggerKindAdmin: Für Administratoren NotificationTriggerKindExamOffice: Für das Prüfungsamt NotificationTriggerKindEvaluation: Für Vorlesungsumfragen -NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen +NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen (Dozenten) +NotificationTriggerKindAllocationParticipant: Für Zentralanmeldungen CorrCreate: Abgaben erstellen UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}" @@ -1864,4 +1866,11 @@ CourseDeregistrationAllocationLog: Ihr Platz in diesem Kurs stammt aus einer Zen CourseDeregistrationAllocationReason: Grund CourseDeregistrationAllocationReasonTip: Der angegebene Grund wird permanent im System hinterlegt und ist i.A. einziger Anhaltspunkt zur Schlichtung etwaiger Konflikte CourseDeregistrationAllocationShouldLog: Selbstverschuldet -CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist. \ No newline at end of file +CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist. + +MailSubjectAllocationResults allocation@AllocationName: Plätze für Zentralanmeldung „#{allocation}“ wurden verteilt +AllocationResultsLecturer: Es wurden Plätze zugewiesen, wie folgt: +AllocationResultLecturer csh@CourseShorthand count@Int64: #{count} Teilnehmer für #{csh} +AllocationResultsStudent: Sie haben Plätze erhalten in: +AllocationNoResultsStudent: Sie haben leider keine Plätze erhalten. +AllocationResultStudent csh@CourseShorthand: Sie haben einen Platz in #{csh} erhalten. \ No newline at end of file diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 6eec1dc0a..4fe6b8beb 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -49,6 +49,7 @@ data NotificationTriggerKind | NTKExamParticipant | NTKCorrector | NTKAllocationStaff + | NTKAllocationParticipant | NTKFunctionary SchoolFunction deriving (Eq, Ord, Generic, Typeable) deriveFinite ''NotificationTriggerKind @@ -60,6 +61,7 @@ instance RenderMessage UniWorX NotificationTriggerKind where NTKExamParticipant -> mr MsgNotificationTriggerKindExamParticipant NTKCorrector -> mr MsgNotificationTriggerKindCorrector NTKAllocationStaff -> mr MsgNotificationTriggerKindAllocationStaff + NTKAllocationParticipant -> mr MsgNotificationTriggerKindAllocationParticipant NTKFunctionary SchoolAdmin -> mr MsgNotificationTriggerKindAdmin NTKFunctionary SchoolLecturer -> mr MsgNotificationTriggerKindLecturer NTKFunctionary SchoolExamOffice -> mr MsgNotificationTriggerKindExamOffice @@ -185,6 +187,7 @@ notificationForm template = wFormToAForm $ do NTAllocationRegister -> Just NTKAll NTAllocationOutdatedRatings -> Just NTKAllocationStaff NTAllocationUnratedApplications -> Just NTKAllocationStaff + NTAllocationResults -> Just NTKAllocationParticipant NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice -- _other -> Nothing diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 1fde2b42c..6e8117e1a 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -336,5 +336,17 @@ determineCrontab = execWriterT $ do } _other -> return () + lastResult <- fmap (E.unValue <=< listToMaybe) . lift . E.select . E.from $ \participant -> do + E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation) + return . E.max_ $ participant E.^. CourseParticipantRegistration + whenIsJust lastResult $ \lastResult' -> + tell $ HashMap.singleton + (JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..}) + Cron + { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay lastResult' + , cronRepeat = CronRepeatNever + , cronRateLimit = appNotificationRateLimit + , cronNotAfter = Left appNotificationExpiration + } runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ allocationJobs diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 93f5d0c33..08a1b6ff0 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -198,6 +198,18 @@ determineNotificationCandidates NotificationExamOfficeExamResultsChanged{..} = E.where_ $ examResult E.^. ExamResultId `E.in_` E.valList (Set.toList nExamResults) E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult return user +determineNotificationCandidates NotificationAllocationResults{..} = + E.select . E.from $ \user -> do + let isStudent = E.exists . E.from $ \application -> + E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation) + E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId + isLecturer = E.exists . E.from $ \(lecturer `E.InnerJoin` allocationCourse) -> + E.on $ lecturer E.^. LecturerCourse E.==. allocationCourse E.^. AllocationCourseCourse + E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation + E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId + E.where_ $ isStudent E.||. isLecturer + + return user classifyNotification :: Notification -> DB NotificationTrigger @@ -224,3 +236,4 @@ classifyNotification NotificationAllocationOutdatedRatings{} = return NTAll classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged +classifyNotification NotificationAllocationResults{} = return NTAllocationResults diff --git a/src/Jobs/Handler/SendNotification/Allocation.hs b/src/Jobs/Handler/SendNotification/Allocation.hs index b4cc9330f..02ce0779c 100644 --- a/src/Jobs/Handler/SendNotification/Allocation.hs +++ b/src/Jobs/Handler/SendNotification/Allocation.hs @@ -6,6 +6,7 @@ module Jobs.Handler.SendNotification.Allocation , dispatchNotificationAllocationAllocation , dispatchNotificationAllocationUnratedApplications , dispatchNotificationAllocationOutdatedRatings + , dispatchNotificationAllocationResults ) where import Import @@ -157,3 +158,41 @@ dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do addAlternatives $ providePreferredAlternative $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet") +dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler () +dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do + (Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do + allocation <- getJust nAllocation + + lecturerResults' <- E.select . E.from $ \(lecturer `E.InnerJoin` course) -> do + E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId + E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient + E.&&. E.exists (E.from $ \allocationCourse -> + E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId + E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation + ) + let participantCount = E.sub_select . E.from $ \participant -> do + E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse + E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation) + return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int64)) + return (course, participantCount) + let lecturerResults = flip map lecturerResults' $ \(Entity _ Course{..}, E.Value partCount) -> SomeMessage $ MsgAllocationResultLecturer courseShorthand partCount + + doParticipantResults <- E.selectExists . E.from $ \application -> + E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation) + participantResults' <- E.select . E.from $ \(participant `E.InnerJoin` course) -> do + E.on $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId + E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation) + return course + let participantResults = case participantResults' of + [] | doParticipantResults -> Just [] + | otherwise -> Nothing + cs -> Just $ map (courseShorthand . entityVal) cs + + return (allocation, lecturerResults, participantResults) + + replaceMailHeader "Auto-Submitted" $ Just "auto-generated" + setSubjectI $ MsgMailSubjectAllocationResults allocationName + editNotifications <- mkEditNotifications jRecipient + + addAlternatives $ + providePreferredAlternative $(ihamletFile "templates/mail/allocationResults.hamlet") diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 4edfa2f10..85a410b89 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -87,6 +87,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationAllocationOutdatedRatings { nAllocation :: AllocationId } | NotificationExamOfficeExamResults { nExam :: ExamId } | NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId } + | NotificationAllocationResults { nAllocation :: AllocationId } deriving (Eq, Ord, Show, Read, Generic, Typeable) instance Hashable Job diff --git a/src/Model/Types/Mail.hs b/src/Model/Types/Mail.hs index 3e04dd5b8..2ee82574f 100644 --- a/src/Model/Types/Mail.hs +++ b/src/Model/Types/Mail.hs @@ -40,6 +40,7 @@ data NotificationTrigger | NTAllocationRegister | NTAllocationOutdatedRatings | NTAllocationUnratedApplications + | NTAllocationResults | NTExamOfficeExamResults | NTExamOfficeExamResultsChanged deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) diff --git a/templates/mail/allocationResults.hamlet b/templates/mail/allocationResults.hamlet new file mode 100644 index 000000000..6973dc619 --- /dev/null +++ b/templates/mail/allocationResults.hamlet @@ -0,0 +1,36 @@ +$newline never +\ + + + +