fix(cron): work around extraneous sheet notifications
This commit is contained in:
Gregor Kleen
parent
9a35c8542c
commit
cbe211bf23
@ -162,54 +162,57 @@ determineCrontab = execWriterT $ do
|
||||
|
||||
let
|
||||
sheetJobs (Entity nSheet Sheet{..}) = do
|
||||
for_ sheetActiveFrom $ \aFrom ->
|
||||
for_ (max <$> sheetVisibleFrom <*> sheetActiveFrom) $ \aFrom ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetActive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ maybe id max sheetVisibleFrom aFrom
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ aFrom
|
||||
, cronRepeat = CronRepeatNever
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) sheetActiveTo
|
||||
}
|
||||
for_ sheetHintFrom $ \hFrom -> maybeT (return ()) $ do
|
||||
for_ (max <$> sheetVisibleFrom <*> sheetHintFrom) $ \hFrom -> maybeT (return ()) $ do
|
||||
guard $ maybe True (\aFrom -> abs (diffUTCTime aFrom hFrom) > 300) sheetActiveFrom
|
||||
guardM $ or2M (return $ maybe True (\sFrom -> abs (diffUTCTime sFrom hFrom) > 300) sheetSolutionFrom)
|
||||
(fmap not . lift . lift $ exists [SheetFileType ==. SheetSolution, SheetFileSheet ==. nSheet])
|
||||
guardM . lift . lift $ exists [SheetFileType ==. SheetHint, SheetFileSheet ==. nSheet]
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetHint{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ maybe id max sheetVisibleFrom hFrom
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ hFrom
|
||||
, cronRepeat = CronRepeatNever
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
, cronNotAfter = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) sheetActiveTo
|
||||
}
|
||||
for_ sheetSolutionFrom $ \hFrom -> maybeT (return ()) $ do
|
||||
guard $ maybe True (\aFrom -> abs (diffUTCTime aFrom hFrom) > 300) sheetActiveFrom
|
||||
for_ (max <$> sheetVisibleFrom <*> sheetSolutionFrom) $ \sFrom -> maybeT (return ()) $ do
|
||||
guard $ maybe True (\aFrom -> abs (diffUTCTime aFrom sFrom) > 300) sheetActiveFrom
|
||||
guardM . lift . lift $ exists [SheetFileType ==. SheetSolution, SheetFileSheet ==. nSheet]
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetSolution{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ maybe id max sheetVisibleFrom hFrom
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sFrom
|
||||
, cronRepeat = CronRepeatNever
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
, cronNotAfter = Left nominalDay
|
||||
}
|
||||
for_ sheetActiveTo $ \aTo -> do
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . maybe id max sheetActiveFrom . maybe id max sheetVisibleFrom $ addUTCTime (-nominalDay) aTo
|
||||
, cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ aTo
|
||||
}
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ maybe id max sheetVisibleFrom aTo
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
}
|
||||
whenIsJust (max aTo <$> sheetVisibleFrom) $ \aTo' -> do
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . maybe id max sheetActiveFrom $ addUTCTime (-nominalDay) aTo'
|
||||
, cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ aTo
|
||||
}
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ aTo
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
}
|
||||
when sheetAutoDistribute $
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobDistributeCorrections nSheet)
|
||||
|
||||
@ -15,82 +15,82 @@ import qualified Data.Set as Set
|
||||
import Handler.Utils.ExamOffice.Exam
|
||||
import Handler.Utils.ExamOffice.ExternalExam
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
|
||||
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
|
||||
runConduit $ transPipe (hoist lift) (determineNotificationCandidates jNotification)
|
||||
.| C.filter (\(Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings nClass)
|
||||
.| C.map (flip JobSendNotification jNotification . entityKey) .| sinkDBJobs
|
||||
|
||||
|
||||
determineNotificationCandidates :: Notification -> DB [Entity User]
|
||||
determineNotificationCandidates :: Notification -> ConduitT () (Entity User) DB ()
|
||||
determineNotificationCandidates NotificationSubmissionRated{..}
|
||||
= E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
= 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
|
||||
determineNotificationCandidates NotificationSheetActive{..}
|
||||
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
= 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
|
||||
determineNotificationCandidates NotificationSheetHint{..}
|
||||
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
= 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
|
||||
determineNotificationCandidates NotificationSheetSolution{..}
|
||||
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
= 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
|
||||
determineNotificationCandidates NotificationSheetSoonInactive{..}
|
||||
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
= 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
|
||||
determineNotificationCandidates NotificationSheetInactive{..}
|
||||
= E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
= 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
|
||||
determineNotificationCandidates NotificationCorrectionsAssigned{..}
|
||||
= selectList [UserId ==. nUser] []
|
||||
= selectSource [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.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
|
||||
determineNotificationCandidates NotificationUserRightsUpdate{..} = do
|
||||
-- always send to affected user
|
||||
affectedUser <- selectList [UserId ==. nUser] []
|
||||
affectedUser <- lift $ selectList [UserId ==. nUser] []
|
||||
-- send to same-school admins only if there was an update
|
||||
currentAdminSchools <- setOf (folded . _entityVal . _userFunctionSchool) <$> selectList [UserFunctionUser ==. nUser, UserFunctionFunction ==. SchoolAdmin] []
|
||||
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 <- E.select . E.from $ \(user `E.InnerJoin` admin) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
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
|
||||
return . nub $ affectedUser <> affectedAdmins
|
||||
yieldMany . nub $ affectedUser <> affectedAdmins
|
||||
determineNotificationCandidates NotificationUserAuthModeUpdate{..}
|
||||
= selectList [UserId ==. nUser] []
|
||||
= selectSource [UserId ==. nUser] []
|
||||
determineNotificationCandidates NotificationExamRegistrationActive{..} =
|
||||
E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
|
||||
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
|
||||
@ -100,7 +100,7 @@ determineNotificationCandidates NotificationExamRegistrationActive{..} =
|
||||
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.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
|
||||
@ -110,21 +110,21 @@ determineNotificationCandidates NotificationExamRegistrationSoonInactive{..} =
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
return user
|
||||
determineNotificationCandidates NotificationExamDeregistrationSoonInactive{..} =
|
||||
E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
|
||||
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
|
||||
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
|
||||
lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
||||
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
|
||||
determineNotificationCandidates NotificationAllocationStaffRegister{..} = do
|
||||
Allocation{..} <- getJust nAllocation
|
||||
E.select . E.from $ \(user `E.InnerJoin` userFunction) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
Allocation{..} <- lift $ getJust nAllocation
|
||||
E.selectSource . 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
|
||||
@ -143,7 +143,7 @@ determineNotificationCandidates NotificationAllocationStaffRegister{..} = do
|
||||
|
||||
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.selectSource . 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
|
||||
@ -162,7 +162,7 @@ determineNotificationCandidates NotificationAllocationAllocation{..} =
|
||||
|
||||
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.selectSource . 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
|
||||
@ -176,8 +176,8 @@ determineNotificationCandidates NotificationAllocationUnratedApplications{..} =
|
||||
|
||||
return user
|
||||
determineNotificationCandidates NotificationAllocationRegister{..} = do
|
||||
Allocation{..} <- getJust nAllocation
|
||||
E.select . E.from $ \user -> do
|
||||
Allocation{..} <- lift $ getJust nAllocation
|
||||
E.selectSource . 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
|
||||
@ -189,7 +189,7 @@ determineNotificationCandidates NotificationAllocationRegister{..} = do
|
||||
|
||||
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.selectSource . 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
|
||||
@ -203,26 +203,26 @@ determineNotificationCandidates NotificationAllocationOutdatedRatings{..} =
|
||||
|
||||
return user
|
||||
determineNotificationCandidates NotificationExamOfficeExamResults{..} =
|
||||
E.select . E.from $ \user -> do
|
||||
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
|
||||
determineNotificationCandidates NotificationExamOfficeExamResultsChanged{..} =
|
||||
E.select . E.from $ \user -> do
|
||||
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
|
||||
determineNotificationCandidates NotificationExamOfficeExternalExamResults{..} =
|
||||
E.select . E.from $ \user -> do
|
||||
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
|
||||
determineNotificationCandidates notif@NotificationAllocationResults{..} = do
|
||||
lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
||||
E.select . E.from $ \user -> do
|
||||
lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
||||
E.selectSource . 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
|
||||
@ -248,17 +248,17 @@ determineNotificationCandidates notif@NotificationAllocationResults{..} = do
|
||||
|
||||
return user
|
||||
determineNotificationCandidates NotificationCourseRegistered{..} =
|
||||
maybeToList <$> getEntity nUser
|
||||
yieldMMany $ getEntity nUser
|
||||
determineNotificationCandidates NotificationSubmissionEdited{..} =
|
||||
E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do
|
||||
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
|
||||
determineNotificationCandidates NotificationSubmissionUserCreated{..} =
|
||||
maybeToList <$> getEntity nUser
|
||||
yieldMMany $ getEntity nUser
|
||||
determineNotificationCandidates NotificationSubmissionUserDeleted{..} =
|
||||
maybeToList <$> getEntity nUser
|
||||
yieldMMany $ getEntity nUser
|
||||
|
||||
|
||||
classifyNotification :: Notification -> DB NotificationTrigger
|
||||
|
||||
@ -43,7 +43,8 @@ import qualified Data.List as List
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import qualified Data.Vector as V
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
-- import qualified Data.Conduit.List as C
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens as Utils (none)
|
||||
@ -815,6 +816,9 @@ anyMC, allMC :: forall a o m. Monad m => (a -> m Bool) -> ConduitT a o m Bool
|
||||
anyMC f = C.mapM f .| orC
|
||||
allMC f = C.mapM f .| andC
|
||||
|
||||
yieldMMany :: forall mono m a. (Monad m, MonoFoldable mono) => m mono -> ConduitT a (Element mono) m ()
|
||||
yieldMMany = C.yieldMany <=< lift
|
||||
|
||||
-----------------
|
||||
-- Alternative --
|
||||
-----------------
|
||||
|
||||
@ -819,8 +819,8 @@ fillDb = do
|
||||
, sheetVisibleFrom = Just $ termTime True Summer prog False Monday toMidnight
|
||||
, sheetActiveFrom = Just $ termTime True Summer (prog + 1) False Monday toMidnight
|
||||
, sheetActiveTo = Just $ termTime True Summer (prog + 2) False Sunday beforeMidnight
|
||||
, sheetHintFrom = Nothing
|
||||
, sheetSolutionFrom = Nothing
|
||||
, sheetHintFrom = Just $ termTime True Summer (prog + 1) False Sunday beforeMidnight
|
||||
, sheetSolutionFrom = Just $ termTime True Summer (prog + 2) False Sunday beforeMidnight
|
||||
, sheetAutoDistribute = True
|
||||
, sheetAnonymousCorrection = True
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user