-- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later module Jobs.Handler.QueueNotification ( dispatchJobQueueNotification , classifyNotification ) where import Import import Jobs.Types import qualified Database.Esqueleto.Legacy as E import Jobs.Queue import qualified Data.Set as Set import Handler.Utils.Profile (pickValidEmail') import Handler.Utils.ExamOffice.Exam import Handler.Utils.ExamOffice.ExternalExam import qualified Data.Conduit.Combinators as C dispatchJobQueueNotification :: Notification -> JobHandler UniWorX dispatchJobQueueNotification jNotification = JobHandlerAtomic $ runConduit $ yield jNotification .| transPipe (hoist lift) determineNotificationCandidates .| C.filterM (\(notification', override, Entity _ User{userNotificationSettings,userDisplayEmail,userEmail}) -> and2M (return $ isJust $ pickValidEmail' userDisplayEmail userEmail) $ or2M (return override) $ notificationAllowed userNotificationSettings <$> hoist lift (classifyNotification notification')) .| C.map (\(notification', _, Entity uid _) -> JobSendNotification uid notification') .| sinkDBJobs determineNotificationCandidates :: ConduitT Notification (Notification, Bool, Entity User) DB () determineNotificationCandidates = awaitForever $ \notif -> do let withNotif :: ConduitT () (Entity User) DB () -> ConduitT Notification (Notification, Bool, Entity User) DB () withNotif c = toProducer c .| C.map (notif, False, ) case notif of NotificationSubmissionRated{..} -> withNotif . E.selectSource . 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 NotificationSheetActive{..} -> withNotif . E.selectSource . 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_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user NotificationSheetHint{..} -> withNotif . E.selectSource . 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_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user NotificationSheetSolution{..} -> withNotif . E.selectSource . 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_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user NotificationSheetSoonInactive{..} -> withNotif . E.selectSource . 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_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user NotificationSheetInactive{..} -> withNotif . E.selectSource . 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 return user NotificationCorrectionsAssigned{..} -> withNotif $ selectSource [UserId ==. nUser] [] NotificationCorrectionsNotDistributed{nSheet} -> withNotif . E.selectSource . 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 return user NotificationUserRightsUpdate{..} -> do -- always send to affected user affectedUser <- lift $ selectList [UserId ==. nUser] [] -- send to same-school admins only if there was an update currentAdminSchools <- lift $ 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 <- lift . 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 return user withNotif . yieldMany . nubOrd $ affectedUser <> affectedAdmins NotificationUserSystemFunctionsUpdate{..} -> withNotif $ selectSource [UserId ==. nUser] [] NotificationUserAuthModeUpdate{..} -> withNotif $ selectSource [UserId ==. nUser] [] NotificationExamRegistrationActive{..} -> withNotif . E.selectSource . 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 E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive return user NotificationExamRegistrationSoonInactive{..} -> withNotif . E.selectSource . 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 E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive return user NotificationExamDeregistrationSoonInactive{..} -> withNotif . E.selectSource . 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 NotificationExamResult{..} -> do lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif withNotif . E.selectSource . 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' -> E.where_ $ examResult E.^. ExamResultLastChanged E.>. E.val lastExec' return user NotificationExamOfficeExamResults{..} -> withNotif . E.selectSource . 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 NotificationExamOfficeExamResultsChanged{..} -> withNotif . E.selectSource . 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 NotificationExamOfficeExternalExamResults{..} -> withNotif . E.selectSource . E.from $ \user -> do E.where_ . E.exists . E.from $ \externalExamResult -> do E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val nExternalExam E.where_ $ examOfficeExternalExamResultAuth (user E.^. UserId) externalExamResult return user NotificationCourseRegistered{..} -> withNotif . yieldMMany $ getEntity nUser NotificationSubmissionEdited{..} -> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> do E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission E.&&. user E.^. UserId E.!=. E.val nInitiator return user NotificationSubmissionUserCreated{..} -> withNotif . yieldMMany $ getEntity nUser NotificationSubmissionUserDeleted{..} -> withNotif . yieldMMany $ getEntity nUser NotificationQualificationExpiry{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known NotificationQualificationExpired{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known NotificationQualificationRenewal{} -> return mempty -- Not to be used with JobQueueNotification; recipients already known classifyNotification :: Notification -> DB NotificationTrigger classifyNotification NotificationSubmissionRated{..} = maybeM (return NTSubmissionRatedGraded) (fmap aux . belongsToJust submissionSheet) (get nSubmission) where aux Sheet{sheetType=NotGraded} = NTSubmissionRated aux _other = NTSubmissionRatedGraded classifyNotification NotificationSheetActive{} = return NTSheetActive classifyNotification NotificationSheetHint{} = return NTSheetHint classifyNotification NotificationSheetSolution{} = return NTSheetSolution classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive classifyNotification NotificationSheetInactive{} = return NTSheetInactive classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate classifyNotification NotificationUserSystemFunctionsUpdate{} = return NTUserRightsUpdate classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate classifyNotification NotificationExamRegistrationActive{} = return NTExamRegistrationActive classifyNotification NotificationExamRegistrationSoonInactive{} = return NTExamRegistrationSoonInactive classifyNotification NotificationExamDeregistrationSoonInactive{} = return NTExamDeregistrationSoonInactive classifyNotification NotificationExamResult{} = return NTExamResult classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged classifyNotification NotificationExamOfficeExternalExamResults{} = return NTExamOfficeExamResults classifyNotification NotificationCourseRegistered{} = return NTCourseRegistered classifyNotification NotificationSubmissionEdited{} = return NTSubmissionEdited classifyNotification NotificationSubmissionUserCreated{} = return NTSubmissionUserCreated classifyNotification NotificationSubmissionUserDeleted{} = return NTSubmissionUserDeleted classifyNotification NotificationQualificationExpiry{} = return NTQualificationExpiry classifyNotification NotificationQualificationExpired{} = return NTQualificationExpiry classifyNotification NotificationQualificationRenewal{nReminder} | nReminder = return NTQualificationReminder | otherwise = return NTQualificationExpiry