module Jobs.Handler.QueueNotification ( dispatchJobQueueNotification ) where import Import import Jobs.Types import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E import Utils.Sql import Jobs.Queue import qualified Data.Set as Set import Handler.Utils.ExamOffice.Exam import Handler.Utils.ExamOffice.ExternalExam dispatchJobQueueNotification :: Notification -> Handler () dispatchJobQueueNotification jNotification = runDBJobs . setSerializable $ do candidates <- hoist lift $ determineNotificationCandidates jNotification nClass <- hoist lift $ classifyNotification jNotification mapM_ (queueDBJob . flip JobSendNotification jNotification) $ do Entity uid User{userNotificationSettings} <- candidates guard $ notificationAllowed userNotificationSettings nClass return uid determineNotificationCandidates :: Notification -> DB [Entity User] determineNotificationCandidates NotificationSubmissionRated{..} = 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) -> 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 determineNotificationCandidates NotificationSheetSoonInactive{..} = 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_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user determineNotificationCandidates NotificationSheetInactive{..} = 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 return user determineNotificationCandidates NotificationCorrectionsAssigned{..} = selectList [UserId ==. nUser] [] determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet} = 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 return user determineNotificationCandidates NotificationUserRightsUpdate{..} = do -- always send to affected user affectedUser <- selectList [UserId ==. nUser] [] -- send to same-school admins only if there was an update 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) -> 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 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 E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive 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 E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive 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) -> 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 determineNotificationCandidates NotificationAllocationStaffRegister{..} = do Allocation{..} <- getJust nAllocation 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 E.where_ . E.exists . E.from $ \userSchool -> E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut) E.where_ . E.not_ . E.exists . E.from $ \(course `E.InnerJoin` lecturer) -> do E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ . E.exists . E.from $ \allocationCourse -> E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation return user determineNotificationCandidates NotificationAllocationAllocation{..} = 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 E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ . E.not_ . E.exists . E.from $ \application -> E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation) E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime) E.where_ . E.exists . E.from $ \application -> E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation) E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId return user determineNotificationCandidates NotificationAllocationUnratedApplications{..} = 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 E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ . E.exists . E.from $ \application -> E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation) E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId E.&&. E.isNothing (application E.^. CourseApplicationRatingTime) return user determineNotificationCandidates NotificationAllocationRegister{..} = do Allocation{..} <- getJust nAllocation E.select . E.from $ \user -> do E.where_ . E.exists . E.from $ \userSchool -> E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut) E.where_ . E.not_ . E.exists . E.from $ \application -> E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation) E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId return user determineNotificationCandidates NotificationAllocationOutdatedRatings{..} = 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 E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ . E.exists . E.from $ \application -> E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation) E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId 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 determineNotificationCandidates NotificationExamOfficeExternalExamResults{..} = E.select . 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 determineNotificationCandidates notif@NotificationAllocationResults{..} = do lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif 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 wasAllocated t = E.exists . E.from $ \participant -> E.where_ $ participant E.^. CourseParticipantUser E.==. user E.^. UserId E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation) E.&&. participant E.^. CourseParticipantRegistration E.>. E.val t E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive hasAllocations t = E.exists . E.from $ \(lecturer `E.InnerJoin` participant) -> do E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.&&. lecturer E.^. LecturerCourse E.==. participant E.^. CourseParticipantCourse E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation) E.&&. participant E.^. CourseParticipantRegistration E.>. E.val t E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive case lastExec of Nothing -> E.where_ $ isStudent E.||. isLecturer Just t -> E.where_ $ wasAllocated t E.||. hasAllocations t return user determineNotificationCandidates NotificationCourseRegistered{..} = maybeToList <$> getEntity nUser determineNotificationCandidates NotificationSubmissionEdited{..} = E.select . 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 determineNotificationCandidates NotificationSubmissionUserCreated{..} = maybeToList <$> getEntity nUser determineNotificationCandidates NotificationSubmissionUserDeleted{..} = maybeToList <$> getEntity nUser classifyNotification :: Notification -> DB NotificationTrigger classifyNotification NotificationSubmissionRated{..} = do Sheet{sheetType} <- belongsToJust submissionSheet =<< getJust nSubmission 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 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 classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged classifyNotification NotificationExamOfficeExternalExamResults{} = return NTExamOfficeExamResults classifyNotification NotificationAllocationResults{} = return NTAllocationResults classifyNotification NotificationCourseRegistered{} = return NTCourseRegistered classifyNotification NotificationSubmissionEdited{} = return NTSubmissionEdited classifyNotification NotificationSubmissionUserCreated{} = return NTSubmissionUserCreated classifyNotification NotificationSubmissionUserDeleted{} = return NTSubmissionUserDeleted