280 lines
18 KiB
Haskell
280 lines
18 KiB
Haskell
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 Jobs.Queue
|
|
|
|
import qualified Data.Set as Set
|
|
|
|
import Handler.Utils.ExamOffice.Exam
|
|
import Handler.Utils.ExamOffice.ExternalExam
|
|
|
|
|
|
dispatchJobQueueNotification :: Notification -> JobHandler UniWorX
|
|
dispatchJobQueueNotification jNotification = JobHandlerAtomic $ 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
|