module Jobs.Handler.QueueNotification ( dispatchJobQueueNotification ) where import Import hiding ((\\)) import Data.List ((\\)) import Jobs.Types import qualified Database.Esqueleto as E import Utils.Sql import Jobs.Queue 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) -> 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.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.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.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) -> 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 <- fmap (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. nUser] [] let oldAdminSchools = [ SchoolKey ssh | (ssh, True, _) <- originalRights ] newAdminSchools = currentAdminSchools \\ oldAdminSchools affectedAdmins <- E.select . E.from $ \(user `E.InnerJoin` admin) -> do E.on $ admin E.^. UserAdminUser E.==. user E.^. UserId E.where_ $ admin E.^. UserAdminSchool `E.in_` E.valList newAdminSchools return user return $ affectedUser <> affectedAdmins 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