87 lines
4.2 KiB
Haskell
87 lines
4.2 KiB
Haskell
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
|
|
|
|
|