fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(allocations): merge notifications

Browse Source
This commit is contained in:
Gregor Kleen 2020-08-24 14:39:43 +02:00
parent 31150fc843
commit 9e9e53e76a
11 changed files with 636 additions and 470 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
messages/uniworx/de-de-formal.msg
View File

@ -2234,25 +2234,45 @@ SynchroniseLdapUserQueued n@Int: LDAP-Synchronisation von #{n} #{pluralDE n "Ben
SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzern angestoßen
UserHijack: Sitzung übernehmen
MailSubjectAllocationStaffRegister allocation@AllocationName: Sie können nun Kurse für die Zentralameldung „#{allocation}“ registrieren
MailAllocationStaffRegisterNewCourse: Sie können auf der unten aufgeführten Seite neue Kurse in Uni2work anlegen. Hierbei haben Sie die Möglichkeit anzugeben, dass der Kurs an der Zentralanmeldung teilnimmt.
MailAllocationStaffRegisterDeadline deadline@Text: Bitte beachten Sie, dass alle Kurse, die an der Zentralanmeldung teilnehmen, bis #{deadline} eingetragen sein müssen.
MailAllocationSchoolAndName allocationSchool@SchoolId allocation@AllocationName: #{allocationSchool}: „#{allocation}“
MailSubjectAllocationRegister allocation@AllocationName: Sie können sich nun für Kurse der Zentralameldung „#{allocation}“ bewerben
MailAllocationRegister: Sie können sich, auf der unten aufgeführten Seite, für alle Kurse der Zentralanmeldung jeweils einzeln bewerben.
MailSubjectAllocationStaffRegister allocationSchool@SchoolId allocation@AllocationName: Sie können nun Kurse für die Zentralameldung #{allocationSchool}: „#{allocation}“ registrieren
MailSubjectAllocationStaffRegisterMultiple n@Int: Sie können nun Kurse für #{n} Zentralameldungen registrieren
MailAllocationStaffRegisterIntroMultiple n@Int: Sie können nun Kurse für die folgenden #{n} Zentralameldungen registrieren:
MailAllocationStaffRegisterNewCourse: Sie können auf der unten aufgeführten Seite neue Kurse in Uni2work anlegen. Hierbei haben Sie die Möglichkeit anzugeben, dass der Kurs an einer Zentralanmeldung teilnimmt.
MailAllocationStaffRegisterDeadline n@Int deadline@Text: Bitte beachten Sie, dass alle Kurse, die an #{pluralDE n "dieser Zentralanmeldung" "diesen Zentralanmeldungen"} teilnehmen, bis #{deadline} eingetragen sein müssen.
MailAllocationStaffRegisterDeadlineMultiple: Bitte beachten Sie, dass alle Kurse, die an einer dieser Zentralanmeldungen teilnehmen, bis Ende der jeweiligen Regstrierungsphase (siehe unten) eingetragen sein müssen.
MailAllocationStaffRegisterDeadlineSingle deadline@Text: Registrierungsphase endet #{deadline}
MailAllocationStaffRegisterDeadlineSingleNothing: Aktuell kein Ende der Registrierungsphase festgelegt
MailSubjectAllocationRegister allocationSchool@SchoolId allocation@AllocationName: Es kann sich nun für Kurse der Zentralameldung #{allocationSchool}: „#{allocation}“ beworben werden
MailSubjectAllocationRegisterMultiple n@Int: Es kann sich nun für Kurse für #{n} Zentralanmeldungen beworben werden
MailAllocationRegisterIntroMultiple n@Int: Es kann sich nun für Kurse für die folgenden #{n} Zentralanmeldungen beworben werden:
MailAllocationRegister n@Int: Es kann sich nun, auf #{pluralDE n "der unten aufgeführten Seite" "den unten aufgeführten Seiten"}, für alle Kurse der #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"} jeweils einzeln beworben werden.
MailAllocationRegisterDeadline deadline@Text: Bitte beachten Sie, dass alle Bewerbungen bis #{deadline} eingegangen sein müssen.
MailAllocationRegisterDeadlineMultiple: Bitte beachten Sie, dass alle Bewerbungen bis Ende der jeweiligen Bewerbungsphase (siehe unten) eingegangen sein müssen.
MailAllocationRegisterDeadlineSingle deadline@Text: Bewerbungsphase endet #{deadline}
MailAllocationRegisterDeadlineSingleNothing: Aktuell kein Ende der Bewerbungsphase festgelegt
MailSubjectAllocationAllocation allocation@AllocationName: Sie können nun Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ bewerten
MailAllocationAllocation: Sie können nun auf den unten aufgeführten Seiten Bewerbungen, die im Rahmen der Zentralanmeldung an ihre Kurse gestellt wurden, bewerten. Die Bewertungen werden bei der Vergabe der Plätze berücksichtigt.
MailSubjectAllocationAllocation allocationSchool@SchoolId allocation@AllocationName: Sie können nun Bewerbungen für ihre Kurse in der Zentralanmeldung #{allocationSchool}: „#{allocation}“ bewerten
MailSubjectAllocationAllocationMultiple n@Int: Sie können nun Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen bewerten
MailAllocationAllocationIntroMultiple n@Int: Sie können nun Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen bewerten:
MailAllocationAllocation n@Int: Sie können nun auf den unten aufgeführten Seiten Bewerbungen, die im Rahmen der #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"} an ihre Kurse gestellt wurden, bewerten. Die Bewertungen werden bei der Vergabe der Plätze berücksichtigt.
MailAllocationApplicationsMayChange deadline@Text: Bitte beachten Sie, dass Studierende noch bis #{deadline} Bewerbungen stellen, verändern und zurückziehen können. Bewerbungen, die sich nach ihrer Bewertung noch verändern, müssen neu bewertet werden.
MailAllocationApplicationsRegisterDeadline deadline@Text: Bewerbungsphase endet #{deadline}
MailAllocationApplicationsRegisterDeadlineNothing: Aktuell kein Ende der Bewerbungsphase festgelegt
MailAllocationApplicationsMayChangeMultiple: Bitte beachten Sie, dass Studierende noch bis Ende der Bewerbungsphase (siehe unten) der jeweiligen Zentralanmeldung Bewerbungen stellen, verändern und zurückziehen können. Bewerbungen, die sich nach ihrer Bewertung noch verändern, müssen neu bewertet werden.
MailAllocationAllocationDeadline deadline@Text: Bitte beachten Sie, dass alle Bewertungen bis #{deadline} erfolgt sein müssen.
MailAllocationApplicationsAllocationDeadline deadline@Text: Bewertungsphase endet #{deadline}
MailAllocationApplicationsAllocationDeadlineNothing: Aktuell keine Ende der Bewertungsphase festgelegt
MailAllocationAllocationDeadlineMultiple: Bitte beachten Sie, dass alle Bewertungen bis Ende der Bewertungsphase (siehe unten) erfolgt sein müssen.
MailSubjectAllocationUnratedApplications allocation@AllocationName: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ aus
MailAllocationUnratedApplications: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der Zentralanmeldung an den jeweiligen Kurs gestellt wurden, die noch nicht bewertet wurden.
MailSubjectAllocationOutdatedRatings allocation@AllocationName: Bereits bewertete Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ haben sich geändert
MailAllocationOutdatedRatings: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der Zentralanmeldung an den jeweiligen Kurs gestellt wurden, die sich verändert haben, seit sie zuletzt bewertet wurden.
MailAllocationOutdatedRatingsWarning: Bewerbungen deren Bewertung veraltet ist (d.h. die Bewerbung wurde nach der Bewertung verändert) zählen als nicht bewertet.
MailSubjectAllocationUnratedApplications allocationSchool@SchoolId allocation@AllocationName: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in der Zentralanmeldung #{allocationSchool}: „#{allocation}“ aus
MailSubjectAllocationUnratedApplicationsMultiple n@Int: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen aus
MailAllocationUnratedApplicationsIntroMultiple n@Int: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in #{n} Zentralanmeldungen aus:
MailAllocationUnratedApplications n@Int: Für die unten aufgeführten Kurse liegen Bewerbungen vor, die im Rahmen der #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"} an den jeweiligen Kurs gestellt wurden, die entweder noch nicht bewertet wurden oder die nach der Bewertung noch verändert wurden und deswegen neu bewertet werden müssen.
MailAllocationUnratedApplicationsCount i@Natural: #{i} #{pluralDE i "Bewerbung" "Bewerbungen"}
ExamOfficeSubscribedUsers: Benutzer
ExamOfficeSubscribedUsersTip: Sie können mehrere Matrikelnummern mit Komma separieren

50
messages/uniworx/en-eu.msg
View File

@ -2234,25 +2234,45 @@ SynchroniseLdapUserQueued n: Triggered LDAP synchronisation of #{n} #{pluralEN n
SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users
UserHijack: Hijack session
MailSubjectAllocationStaffRegister allocation: You may now register courses for the central allocation “#{allocation}”
MailAllocationStaffRegisterNewCourse: You can create new courses on the page linked below. While doing so you now have to option to specifiy that the course should participate in the central allocation.
MailAllocationStaffRegisterDeadline deadline: Please consider that alle courses must be registered until #{deadline} in order to participate in the central allocation.
MailAllocationSchoolAndName allocationSchool allocation: #{allocationSchool}: “#{allocation}”
MailSubjectAllocationRegister allocation: You may now apply for the central allocation “#{allocation}”
MailAllocationRegister: You may now apply for each individual course particpating in the central allocation on the page linked below.
MailAllocationRegisterDeadline deadline: Please consider that all applications have to be made until #{deadline}.
MailSubjectAllocationStaffRegister allocationSchool allocation: You can now register courses for the central allocation #{allocationSchool}: “#{allocation}”
MailSubjectAllocationStaffRegisterMultiple n: You can now register courses for #{n} central allocations
MailAllocationStaffRegisterIntroMultiple n: You can now register courses for the following #{n} central allocations:
MailAllocationStaffRegisterNewCourse: You can create new courses in Uni2work on the site listed below. While doing so you can specify that the course should participate in a central allocation.
MailAllocationStaffRegisterDeadline n deadline: Please consider that all courses, that are to participate in #{pluralEN n "this central allocation" "these central allocations"}, must be registered before #{deadline}.
MailAllocationStaffRegisterDeadlineMultiple: Please consider that alle courses, that are to participate in these central allocations, must be registered before the ends of their respective course registration periods (see below).
MailAllocationStaffRegisterDeadlineSingle deadline: Course Registration period ends on #{deadline}
MailAllocationStaffRegisterDeadlineSingleNothing: Currently no end of course registration period configured
MailSubjectAllocationAllocation allocation: You may now grade applications made to your courses for the central allocation “#{allocation}”
MailAllocationAllocation: On the page linked below you may now grade applications made to your corses for the central allocation. The grades you specify will be considered during the allocation process.
MailAllocationApplicationsMayChange deadline: Please consider that students may continue to apply, retract, and edit their applications until #{deadline}. Applications that change after being graded will need to be graded again.
MailAllocationAllocationDeadline deadline: Please consider that grading of applications is only possible until #{deadline}.
MailSubjectAllocationRegister allocationSchool allocation: Applications can now be made for courses of the central allocation #{allocationSchool}: “#{allocation}”
MailSubjectAllocationRegisterMultiple n: Applications can now be made for courses of #{n} central allocations
MailAllocationRegisterIntroMultiple n: Applications can now be made for courses of the following #{n} central allocations:
MailAllocationRegister n: Applications can now be made for each of the courses participating in the central #{pluralEN n "allocation" "allocations"} on the #{pluralEN n "page" "pages"} listed below.
MailAllocationRegisterDeadline deadline: Please consider that all applications have to be made before #{deadline}.
MailAllocationRegisterDeadlineMultiple: Please consider that all applications for courses participating in central allocations have to be made before the ends of their respective application periods (see below).
MailAllocationRegisterDeadlineSingle deadline: Application periods ends on #{deadline}
MailAllocationRegisterDeadlineSingleNothing: Currently no end of application period configured
MailSubjectAllocationUnratedApplications allocation: Some applications made to your courses for the central allocation “#{allocation}” are not yet graded
MailAllocationUnratedApplications: Applications have been made to the courses listed below for the central allocation, which have not yet been graded.
MailSubjectAllocationOutdatedRatings allocation: Applications made to your courses for the central allocation “#{allocation}” have changed since being graded
MailAllocationOutdatedRatings: Applications have been made to the courses list below for the central allocation, which have changed since they were last graded.
MailAllocationOutdatedRatingsWarning: Applications whose grading is deprecated (i.e. that have been changed since they were graded) are considered not to have been graded during the allocation process.
MailSubjectAllocationAllocation allocationSchool allocation: You can now rate applications for your courses that participate in the central allocation #{allocationSchool}: “#{allocation}”
MailSubjectAllocationAllocationMultiple n: You can now rate applications for your courses that participate in #{n} central allocations
MailAllocationAllocationIntroMultiple n: You can now rate applications for your courses that participate in #{n} central allocations:
MailAllocationAllocation n: You can now rate applications made in the context of the central #{pluralEN n "allocation" "allocations"} for your courses on the pages listed below. Ratings made will have an effect on the allocation.
MailAllocationApplicationsMayChange deadline: Please consider that applicants may change or delete their applications until #{deadline}. If an application was rated before it was changed it needs to be rated again.
MailAllocationApplicationsRegisterDeadline deadline: Application period ends on #{deadline}
MailAllocationApplicationsRegisterDeadlineNothing: Currently no end of application period configured
MailAllocationApplicationsMayChangeMultiple: Please consider that applicants may change or delete their applications until the end of the respective central allocation's application period. If an application was rated before it was changed it needs to be rated again.
MailAllocationAllocationDeadline deadline: Please consider that all ratings have to be made before #{deadline}.
MailAllocationApplicationsAllocationDeadline deadline: Rating period ends on #{deadline}
MailAllocationApplicationsAllocationDeadlineNothing: Currently no end of rating period configured
MailAllocationAllocationDeadlineMultiple: Please consider that all ratings have to be made before the end of the respective rating period (see below).
MailSubjectAllocationUnratedApplications allocationSchool allocation: There are unrated applications for you courses participating in the central allocation #{allocationSchool}: “#{allocation}”
MailSubjectAllocationUnratedApplicationsMultiple n: There are unrated applications for your courses participating in #{n} central allocations
MailAllocationUnratedApplicationsIntroMultiple n: There are unrated applications for your courses participating in #{n} central allocations:
MailAllocationUnratedApplications n: For there courses listed below, there exist applications made in the context of #{pluralEN n "the central allocation" "one of the central allocations"} which have either not yet been rated or which have changed since they were rated.
MailAllocationUnratedApplicationsCount i: #{i} #{pluralDE i "application" "applications"}
ExamOfficeSubscribedUsers: Users
ExamOfficeSubscribedUsersTip: You may specify multiple matriculations; comma-separated

121
src/Jobs/Crontab.hs
View File

@ -373,69 +373,64 @@ determineCrontab = execWriterT $ do
runConduit $ transPipe lift (selectKeys [] []) .| C.mapM_ externalExamJobs
allocations <- lift $ selectList [] []
let
allocationJobs (Entity nAllocation Allocation{..}) = do
whenIsJust allocationStaffRegisterFrom $ \staffRegisterFrom ->
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationStaffRegister{..})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ staffRegisterFrom
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffRegisterTo
}
whenIsJust allocationRegisterFrom $ \registerFrom ->
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationRegister{..})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerFrom
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationRegisterTo
}
whenIsJust allocationStaffAllocationFrom $ \allocationFrom ->
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationAllocation{..})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ allocationFrom
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
}
case allocationRegisterTo of
Just registerTo
| maybe True (> registerTo) allocationStaffAllocationTo
-> do
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationUnratedApplications{..})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
}
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationOutdatedRatings{..})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
}
_other
-> return ()
doneSince <- lift $ fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \participant -> do
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
return . E.max_ $ participant E.^. CourseParticipantRegistration
allocationTimes :: EntityField Allocation (Maybe UTCTime) -> MergeHashMap UTCTime [Entity Allocation]
allocationTimes aField = flip foldMap allocations $ \allocEnt -> case allocEnt ^. fieldLens aField of
Nothing -> mempty
Just t -> _MergeHashMap # HashMap.singleton t (pure allocEnt)
whenIsJust doneSince $ \doneSince' ->
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..})
Cron
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay doneSince'
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationCollateDelay $ addUTCTime appNotificationExpiration doneSince'
}
forM_ allocations $ \(Entity nAllocation _) -> do
doneSince <- lift $ fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \participant -> do
E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
return . E.max_ $ participant E.^. CourseParticipantRegistration
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ allocationJobs
whenIsJust doneSince $ \doneSince' ->
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..})
Cron
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay doneSince'
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationCollateDelay $ addUTCTime appNotificationExpiration doneSince'
}
iforM_ (allocationTimes AllocationStaffRegisterFrom) $ \staffRegisterFrom allocs ->
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationStaffRegister{ nAllocations = setOf (folded . _entityKey) allocs })
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ staffRegisterFrom
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffRegisterTo . to NTop . filtered (> NTop (Just staffRegisterFrom))) allocs
}
iforM_ (allocationTimes AllocationRegisterFrom) $ \registerFrom allocs ->
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationRegister{ nAllocations = setOf (folded . _entityKey) allocs })
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerFrom
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationRegisterTo . to NTop . filtered (> NTop (Just registerFrom))) allocs
}
iforM_ (allocationTimes AllocationStaffAllocationFrom) $ \staffAllocationFrom allocs ->
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationAllocation{ nAllocations = setOf (folded . _entityKey) allocs })
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ staffAllocationFrom
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffAllocationTo . to NTop . filtered (> NTop (Just staffAllocationFrom))) allocs
}
iforM (allocationTimes AllocationRegisterTo) $ \registerTo allocs' -> do
let allocs = flip filter allocs' $ \(Entity _ Allocation{..}) -> maybe True (> registerTo) allocationStaffAllocationTo
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationAllocationUnratedApplications{ nAllocations = setOf (folded . _entityKey) allocs })
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffAllocationTo . to NTop . filtered (> NTop (Just registerTo))) allocs
}

469
src/Jobs/Handler/QueueNotification.hs
View File

@ -19,246 +19,266 @@ import qualified Data.Conduit.Combinators as C
dispatchJobQueueNotification :: Notification -> JobHandler UniWorX
dispatchJobQueueNotification jNotification = JobHandlerAtomic $ do
nClass <- hoist lift $ classifyNotification jNotification
runConduit $ transPipe (hoist lift) (determineNotificationCandidates jNotification)
.| C.filter (\(Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings nClass)
.| C.map (flip JobSendNotification jNotification . entityKey) .| sinkDBJobs
dispatchJobQueueNotification jNotification = JobHandlerAtomic $
runConduit $ yield jNotification
.| transPipe (hoist lift) determineNotificationCandidates
.| C.filterM (\(notification', Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings <$> hoist lift (classifyNotification notification'))
.| C.map (\(notification', Entity uid _) -> JobSendNotification uid notification')
.| sinkDBJobs
determineNotificationCandidates :: Notification -> ConduitT () (Entity User) DB ()
determineNotificationCandidates NotificationSubmissionRated{..}
= 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.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.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.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.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.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{..}
= selectSource [UserId ==. nUser] []
determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet}
= 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 <- lift $ selectList [UserId ==. nUser] []
-- send to same-school admins only if there was an update
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 <- 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
yieldMany . nub $ affectedUser <> affectedAdmins
determineNotificationCandidates NotificationUserAuthModeUpdate{..}
= selectSource [UserId ==. nUser] []
determineNotificationCandidates NotificationExamRegistrationActive{..} =
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
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.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
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.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 <- 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{..} <- 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
determineNotificationCandidates :: ConduitT Notification (Notification, Entity User) DB ()
determineNotificationCandidates = awaitForever $ \notif -> do
let withNotif :: ConduitT () (Entity User) DB () -> ConduitT Notification (Notification, Entity User) DB ()
withNotif c = toProducer c .| C.map (notif, )
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)
-- | Assumes that conduit produces output sorted by `UserId`
separateTargets :: Ord target
=> (Set target -> Notification)
-> ConduitT () (Entity User, E.Value target) DB ()
-> ConduitT Notification (Notification, Entity User) DB ()
separateTargets mkNotif' c = toProducer c .| go Nothing Set.empty
where go Nothing _ = do
next <- await
case next of
Nothing -> return ()
Just (uent, E.Value t) -> go (Just uent) $ Set.singleton t
go (Just uent) ts = do
next <- await
case next of
Nothing -> yield (mkNotif' ts, uent)
Just next'@(uent', E.Value t)
| ((==) `on` entityKey) uent uent' -> go (Just uent) $ Set.insert t ts
| otherwise -> yield (mkNotif' ts, uent) >> leftover next' >> go Nothing Set.empty
case notif of
NotificationSubmissionRated{..}
-> withNotif . 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
NotificationSheetActive{..}
-> withNotif . 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
NotificationSheetHint{..}
-> withNotif . 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
NotificationSheetSolution{..}
-> withNotif . 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
NotificationSheetSoonInactive{..}
-> withNotif . 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
NotificationSheetInactive{..}
-> withNotif . 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
NotificationCorrectionsAssigned{..}
-> withNotif $ selectSource [UserId ==. nUser] []
NotificationCorrectionsNotDistributed{nSheet}
-> withNotif . 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
NotificationUserRightsUpdate{..}
-> do
-- always send to affected user
affectedUser <- lift $ selectList [UserId ==. nUser] []
-- send to same-school admins only if there was an update
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 <- 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
withNotif . yieldMany . nub $ affectedUser <> affectedAdmins
NotificationUserAuthModeUpdate{..}
-> withNotif $ selectSource [UserId ==. nUser] []
NotificationExamRegistrationActive{..}
-> withNotif . 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
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
NotificationExamRegistrationSoonInactive{..}
-> withNotif . 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
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
NotificationExamDeregistrationSoonInactive{..}
-> withNotif . 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
NotificationExamResult{..}
-> do
lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
withNotif . 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
NotificationAllocationStaffRegister{..}
-> separateTargets NotificationAllocationStaffRegister . E.selectSource . E.from $ \(user `E.InnerJoin` userFunction `E.InnerJoin` allocation) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocation E.^. AllocationId] $ do
E.on $ userFunction E.^. UserFunctionSchool E.==. allocation E.^. AllocationSchool
E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
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
E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer
E.&&. allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)
return user
determineNotificationCandidates NotificationAllocationAllocation{..} =
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
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ . E.exists . E.from $ \userSchool ->
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. 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.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)
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.==. allocation E.^. AllocationId
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, allocation E.^. AllocationId)
NotificationAllocationRegister{..}
-> separateTargets NotificationAllocationRegister . E.selectSource . E.from $ \(user `E.InnerJoin` allocation) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocation E.^. AllocationId] $ do
E.on E.true
return user
determineNotificationCandidates NotificationAllocationUnratedApplications{..} =
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
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)
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)
E.where_ . E.exists . E.from $ \userSchool ->
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. AllocationSchool
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
return user
determineNotificationCandidates NotificationAllocationRegister{..} = 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
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
E.where_ . E.not_ . E.exists . E.from $ \application ->
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
E.&&. application E.^. CourseApplicationUser 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.^. CourseApplicationUser E.==. user E.^. UserId
return (user, allocation E.^. AllocationId)
NotificationAllocationAllocation{..}
-> separateTargets NotificationAllocationAllocation . E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocationCourse E.^. AllocationCourseAllocation] $ do
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
return user
determineNotificationCandidates NotificationAllocationOutdatedRatings{..} =
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
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)
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)
E.where_ . E.not_ . E.exists . E.from $ \application ->
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)
return user
determineNotificationCandidates NotificationExamOfficeExamResults{..} =
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.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.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 <- 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
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
E.where_ . E.exists . E.from $ \application ->
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationUser 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, allocationCourse E.^. AllocationCourseAllocation)
NotificationAllocationUnratedApplications{..}
-> separateTargets NotificationAllocationUnratedApplications . E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocationCourse E.^. AllocationCourseAllocation] $ do
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
return user
determineNotificationCandidates NotificationCourseRegistered{..} =
yieldMMany $ getEntity nUser
determineNotificationCandidates NotificationSubmissionEdited{..} =
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{..} =
yieldMMany $ getEntity nUser
determineNotificationCandidates NotificationSubmissionUserDeleted{..} =
yieldMMany $ getEntity nUser
E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)
E.where_ . E.exists . E.from $ \application ->
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
return (user, allocationCourse E.^. AllocationCourseAllocation)
NotificationExamOfficeExamResults{..}
-> withNotif . 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
NotificationExamOfficeExamResultsChanged{..}
-> withNotif . 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
NotificationExamOfficeExternalExamResults{..}
-> withNotif . 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
NotificationAllocationResults{..}
-> do
lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
withNotif . 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
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
NotificationCourseRegistered{..}
-> withNotif . yieldMMany $ getEntity nUser
NotificationSubmissionEdited{..}
-> withNotif . 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
NotificationSubmissionUserCreated{..}
-> withNotif . yieldMMany $ getEntity nUser
NotificationSubmissionUserDeleted{..}
-> withNotif . yieldMMany $ getEntity nUser
classifyNotification :: Notification -> DB NotificationTrigger
@ -283,7 +303,6 @@ classifyNotification NotificationExamResult{} = return NTExa
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

194
src/Jobs/Handler/SendNotification/Allocation.hs
View File

@ -5,7 +5,6 @@ module Jobs.Handler.SendNotification.Allocation
, dispatchNotificationAllocationRegister
, dispatchNotificationAllocationAllocation
, dispatchNotificationAllocationUnratedApplications
, dispatchNotificationAllocationOutdatedRatings
, dispatchNotificationAllocationResults
) where
@ -20,137 +19,122 @@ import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
dispatchNotificationAllocationStaffRegister :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationStaffRegister nAllocation jRecipient = userMailT jRecipient $ do
Allocation{..} <- liftHandler . runDB $ getJust nAllocation
dispatchNotificationAllocationStaffRegister :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationStaffRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationName
case allocs of
[Allocation{..}] ->
setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationSchool allocationName
_other ->
setSubjectI . MsgMailSubjectAllocationStaffRegisterMultiple $ length allocs
editNotifications <- mkEditNotifications jRecipient
registerDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
deadlines <- forM allocs $ \alloc@Allocation{..} -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
let doRegisterDeadlines = any (is _Just . allocationStaffRegisterTo) allocs
singleRegisterDeadline = maybe True (flip all (allocs ^.. folded . _allocationStaffRegisterTo) . (==)) $ allocs ^? _head . _allocationStaffRegisterTo
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")
dispatchNotificationAllocationRegister :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecipient $ do
Allocation{..} <- liftHandler . runDB $ getJust nAllocation
dispatchNotificationAllocationRegister :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectAllocationRegister allocationName
case allocs of
[Allocation{..}] ->
setSubjectI $ MsgMailSubjectAllocationRegister allocationSchool allocationName
_other ->
setSubjectI . MsgMailSubjectAllocationRegisterMultiple $ length allocs
editNotifications <- mkEditNotifications jRecipient
registerDeadline <- traverse (formatTime SelFormatDateTime) allocationRegisterTo
deadlines <- forM allocs $ \alloc@Allocation{..} -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationRegisterTo
let doRegisterDeadlines = any (is _Just . allocationRegisterTo) allocs
singleRegisterDeadline = maybe True (flip all (allocs ^.. folded . _allocationRegisterTo) . (==)) $ allocs ^? _head . _allocationRegisterTo
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationRegister.hamlet")
dispatchNotificationAllocationAllocation :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationAllocation nAllocation jRecipient = do
(Allocation{..}, courses) <- runDB $ do
allocation <- getJust nAllocation
courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
return ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
, course E.^. CourseName
)
let courses' = courses
& over (traverse . _1) E.unValue
& over (traverse . _2) E.unValue
& over (traverse . _3) E.unValue
& over (traverse . _4) E.unValue
return (allocation, courses')
dispatchNotificationAllocationAllocation :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient = do
courses <- fmap (nubOn $ views _2 entityKey) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations
E.orderBy [ E.asc $ allocation E.^. AllocationSchool
, E.asc $ allocation E.^. AllocationName
, E.asc $ course E.^. CourseTerm
, E.asc $ course E.^. CourseSchool
, E.asc $ course E.^. CourseName
]
return (allocation, course)
let allocations = nubOn entityKey $ courses ^.. folded . _1
unless (null courses) . userMailT jRecipient $ do
now <- liftIO getCurrentTime
let doRegisterDeadlines = any (> NTop (Just now)) $ map (NTop . allocationRegisterTo . entityVal) allocations
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectAllocationAllocation allocationName
case allocations of
[Entity _ Allocation{..}]
-> setSubjectI $ MsgMailSubjectAllocationAllocation allocationSchool allocationName
_other
-> setSubjectI . MsgMailSubjectAllocationAllocationMultiple $ length allocations
editNotifications <- mkEditNotifications jRecipient
allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
registerDeadline <- traverse (formatTime SelFormatDateTime) $ assertM (> now) allocationRegisterTo
deadlines <- forM allocations $ \(Entity _ alloc@Allocation{..}) -> (alloc,,) <$> traverse (formatTime SelFormatDateTime) (guardOnM doRegisterDeadlines allocationRegisterTo) <*> traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
let doDeadlines = doRegisterDeadlines || any (has $ _entityVal . _allocationStaffAllocationTo . _Just) allocations
sameDeadlines = maybe True (flip all (allocations ^.. folded . _entityVal) . ((==) `on` bool ((, Nothing) . allocationStaffAllocationTo) ((,) <$> allocationStaffAllocationTo <*> allocationRegisterTo) doRegisterDeadlines)) $ allocations ^? _head . _entityVal
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationAllocation.hamlet")
dispatchNotificationAllocationUnratedApplications :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do
(Allocation{..}, courses) <- runDB $ do
allocation <- getJust nAllocation
courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
dispatchNotificationAllocationUnratedApplications :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRecipient = do
courses <- fmap (nubOn (views _2 entityKey) . over (traverse . _3) E.unValue) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
let
unratedAppCount :: E.SqlExpr (E.Value Natural)
unratedAppCount = E.subSelectCount . E.from $ \application ->
E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations
return ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
, course E.^. CourseName
, unratedAppCount
)
let courses' = courses
& over (traverse . _1) E.unValue
& over (traverse . _2) E.unValue
& over (traverse . _3) E.unValue
& over (traverse . _4) E.unValue
& over (traverse . _5) E.unValue
& filter ((> 0) . view _5)
return (allocation, courses')
let
unratedAppCount :: E.SqlExpr (E.Value Natural)
unratedAppCount = E.subSelectCount . E.from $ \application ->
E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
E.&&. E.maybe E.true (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
E.where_ $ unratedAppCount E.>. E.val 0
E.orderBy [ E.asc $ allocation E.^. AllocationSchool
, E.asc $ allocation E.^. AllocationName
, E.asc $ course E.^. CourseTerm
, E.asc $ course E.^. CourseSchool
, E.asc $ course E.^. CourseName
]
return (allocation, course, unratedAppCount)
let allocations = nubOn entityKey $ courses ^.. folded . _1
unless (null courses) . userMailT jRecipient $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationName
case allocations of
[Entity _ Allocation{..}]
-> setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationSchool allocationName
_other
-> setSubjectI . MsgMailSubjectAllocationUnratedApplicationsMultiple $ length allocations
editNotifications <- mkEditNotifications jRecipient
allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
deadlines <- forM allocations $ \(Entity _ alloc@Allocation{..}) -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
let doDeadlines = any (has $ _entityVal . _allocationStaffAllocationTo . _Just) allocations
sameDeadlines = maybe True (flip all (allocations ^.. folded . _entityVal) . ((==) `on` allocationStaffAllocationTo)) $ allocations ^? _head . _entityVal
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet")
dispatchNotificationAllocationOutdatedRatings :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do
(Allocation{..}, courses) <- runDB $ do
allocation <- getJust nAllocation
courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
let
outdatedRatingsAppCount :: E.SqlExpr (E.Value Natural)
outdatedRatingsAppCount = E.subSelectCount . E.from $ \application ->
E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
return ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
, course E.^. CourseName
, outdatedRatingsAppCount
)
let courses' = courses
& over (traverse . _1) E.unValue
& over (traverse . _2) E.unValue
& over (traverse . _3) E.unValue
& over (traverse . _4) E.unValue
& over (traverse . _5) E.unValue
& filter ((> 0) . view _5)
return (allocation, courses')
unless (null courses) . userMailT jRecipient $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectAllocationOutdatedRatings allocationName
editNotifications <- mkEditNotifications jRecipient
allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet")
dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
(Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do

9
src/Jobs/Types.hs
View File

@ -101,11 +101,10 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
| NotificationExamRegistrationSoonInactive { nExam :: ExamId }
| NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
| NotificationExamResult { nExam :: ExamId }
| NotificationAllocationStaffRegister { nAllocation :: AllocationId }
| NotificationAllocationRegister { nAllocation :: AllocationId }
| NotificationAllocationAllocation { nAllocation :: AllocationId }
| NotificationAllocationUnratedApplications { nAllocation :: AllocationId }
| NotificationAllocationOutdatedRatings { nAllocation :: AllocationId }
| NotificationAllocationStaffRegister { nAllocations :: Set AllocationId }
| NotificationAllocationRegister { nAllocations :: Set AllocationId }
| NotificationAllocationAllocation { nAllocations :: Set AllocationId }
| NotificationAllocationUnratedApplications { nAllocations :: Set AllocationId }
| NotificationExamOfficeExamResults { nExam :: ExamId }
| NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
| NotificationExamOfficeExternalExamResults { nExternalExam :: ExternalExamId }

56
templates/mail/allocationAllocation.hamlet
View File

@ -9,24 +9,58 @@ $newline never
font-variant: small-caps;
font-weight: normal;
}
.bold {
font-weight: bold;
}
<body>
<h1>
_{SomeMessage $ MsgMailSubjectAllocationAllocation allocationName}
$case allocations
$of [Entity _ Allocation{allocationSchool, allocationName}]
_{SomeMessage $ MsgMailSubjectAllocationAllocation allocationSchool allocationName}
$of _
_{SomeMessage $ MsgMailAllocationAllocationIntroMultiple (length allocations)}
<p>
_{SomeMessage MsgMailAllocationAllocation}
_{SomeMessage $ MsgMailAllocationAllocation (length allocations)}
<ul>
$forall (tid, ssh, csh, cName) <- courses
$forall (Entity _ Allocation{allocationSchool, allocationName}, Entity _ Course{courseTerm, courseSchool, courseShorthand, courseName}) <- courses
<li>
<a href=@{CourseR tid ssh csh CApplicationsR}>
#{cName}
<a href=@{CourseR courseTerm courseSchool courseShorthand CApplicationsR}>
#{courseName} (_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName})
$maybe until <- registerDeadline
<p>
_{SomeMessage $ MsgMailAllocationApplicationsMayChange until}
$if doDeadlines
$if sameDeadlines
$maybe (_, registerDeadline, allocationDeadline) <- preview _head deadlines
$maybe until <- guardOnM doRegisterDeadlines registerDeadline
<p>
_{SomeMessage $ MsgMailAllocationApplicationsMayChange until}
$maybe until <- allocationDeadline
<p>
_{SomeMessage $ MsgMailAllocationAllocationDeadline until}
$maybe until <- allocationDeadline
<p>
_{SomeMessage $ MsgMailAllocationAllocationDeadline until}
$else
$if doRegisterDeadlines
<p>
_{SomeMessage MsgMailAllocationApplicationsMayChangeMultiple}
<p>
_{SomeMessage MsgMailAllocationAllocationDeadlineMultiple}
<ul>
$forall (Allocation{allocationSchool, allocationName}, registerDeadline, allocationDeadline) <- deadlines
<li>
<p .bold>
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
$if doRegisterDeadlines
<p>
$maybe until <- registerDeadline
_{SomeMessage $ MsgMailAllocationApplicationsRegisterDeadline until}
$nothing
_{SomeMessage MsgMailAllocationApplicationsRegisterDeadlineNothing}
<p>
$maybe until <- allocationDeadline
_{SomeMessage $ MsgMailAllocationApplicationsAllocationDeadline until}
$nothing
_{SomeMessage MsgMailAllocationApplicationsAllocationDeadlineNothing}
^{ihamletSomeMessage editNotifications}

48
templates/mail/allocationRegister.hamlet
View File

@ -9,18 +9,50 @@ $newline never
font-variant: small-caps;
font-weight: normal;
}
.bold {
font-weight: bold;
}
<body>
<h1>
_{SomeMessage $ MsgMailSubjectAllocationRegister allocationName}
$case allocs
$of [Allocation{allocationSchool, allocationName}]
_{SomeMessage $ MsgMailSubjectAllocationRegister allocationSchool allocationName}
$of _
_{SomeMessage $ MsgMailAllocationRegisterIntroMultiple (length allocs)}
<p>
_{SomeMessage MsgMailAllocationRegister}
<br>
<a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
#{allocationName}
_{SomeMessage $ MsgMailAllocationRegister (length allocs)}
$case allocs
$of [Allocation{allocationTerm, allocationSchool, allocationShorthand, allocationName}]
<a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
$of _
<ul>
$forall Allocation{allocationTerm, allocationSchool, allocationShorthand, allocationName} <- allocs
<li>
<a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
$maybe until <- registerDeadline
<p>
_{SomeMessage $ MsgMailAllocationRegisterDeadline until}
$if doRegisterDeadlines
$if singleRegisterDeadline
$maybe (_, registerDeadline) <- preview _head deadlines
$maybe until <- registerDeadline
<p>
_{SomeMessage $ MsgMailAllocationRegisterDeadline until}
$else
<p>
_{SomeMessage $ MsgMailAllocationRegisterDeadlineMultiple}
<ul>
$forall (Allocation{allocationSchool, allocationName}, registerDeadline) <- deadlines
<li>
<p .bold>
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
<p>
$maybe until <- registerDeadline
_{SomeMessage $ MsgMailAllocationRegisterDeadlineSingle until}
$nothing
_{SomeMessage MsgMailAllocationRegisterDeadlineSingleNothing}
^{ihamletSomeMessage editNotifications}

41
templates/mail/allocationStaffRegister.hamlet
View File

@ -9,9 +9,22 @@ $newline never
font-variant: small-caps;
font-weight: normal;
}
.bold {
font-weight: bold;
}
<body>
<h1>
_{SomeMessage $ MsgMailSubjectAllocationStaffRegister allocationName}
$case allocs
$of [Allocation{allocationSchool, allocationName}]
<h1>
_{SomeMessage $ MsgMailSubjectAllocationStaffRegister allocationSchool allocationName}
$of _
<h1>
_{SomeMessage $ MsgMailAllocationStaffRegisterIntroMultiple (length allocs)}
<ul>
$forall Allocation{allocationName, allocationSchool} <- allocs
<li>
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
<p>
_{SomeMessage MsgMailAllocationStaffRegisterNewCourse}
@ -19,8 +32,26 @@ $newline never
<a href=@{CourseNewR}>
_{SomeMessage MsgMenuCourseNew}
$maybe until <- registerDeadline
<p>
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadline until}
$if doRegisterDeadlines
$if singleRegisterDeadline
$maybe (_, registerDeadline) <- preview _head deadlines
$maybe until <- registerDeadline
<p>
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadline (length allocs) until}
$else
<p>
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadlineMultiple}
<ul>
$forall (Allocation{allocationSchool, allocationName}, staffRegisterDeadline) <- deadlines
<li>
<p .bold>
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
<p>
$maybe until <- staffRegisterDeadline
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadlineSingle until}
$nothing
_{SomeMessage MsgMailAllocationStaffRegisterDeadlineSingleNothing}
^{ihamletSomeMessage editNotifications}

46
templates/mail/allocationUnratedApplications.hamlet
View File

@ -9,21 +9,49 @@ $newline never
font-variant: small-caps;
font-weight: normal;
}
.bold {
font-weight: bold;
}
<body>
<h1>
_{SomeMessage $ MsgMailSubjectAllocationUnratedApplications allocationName}
$case allocations
$of [Entity _ Allocation{allocationSchool, allocationName}]
_{SomeMessage $ MsgMailSubjectAllocationUnratedApplications allocationSchool allocationName}
$of _
_{SomeMessage $ MsgMailAllocationUnratedApplicationsIntroMultiple (length allocations)}
<p>
_{SomeMessage MsgMailAllocationUnratedApplications}
_{SomeMessage $ MsgMailAllocationUnratedApplications (length allocations)}
<ul>
$forall (tid, ssh, csh, cName, numUnrated) <- courses
$forall (Entity _ Allocation{allocationSchool, allocationName}, Entity _ Course{courseTerm, courseSchool, courseShorthand, courseName}, unrated) <- courses
<li>
<a href=@{CourseR tid ssh csh CApplicationsR}>
#{cName}
\ (#{tshow numUnrated})
<a href=@{CourseR courseTerm courseSchool courseShorthand CApplicationsR}>
#{courseName} #
(
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}, #
_{SomeMessage $ MsgMailAllocationUnratedApplicationsCount unrated}
)
$maybe until <- allocationDeadline
<p>
_{SomeMessage $ MsgMailAllocationAllocationDeadline until}
$if doDeadlines
$if sameDeadlines
$maybe (_, allocationDeadline) <- preview _head deadlines
$maybe until <- allocationDeadline
<p>
_{SomeMessage $ MsgMailAllocationAllocationDeadline until}
$else
<p>
_{SomeMessage MsgMailAllocationAllocationDeadlineMultiple}
<ul>
$forall (Allocation{allocationSchool, allocationName}, allocationDeadline) <- deadlines
<li>
<p .bold>
_{SomeMessage $ MsgMailAllocationSchoolAndName allocationSchool allocationName}
<p>
$maybe until <- allocationDeadline
_{SomeMessage $ MsgMailAllocationApplicationsAllocationDeadline until}
$nothing
_{SomeMessage MsgMailAllocationApplicationsAllocationDeadlineNothing}
^{ihamletSomeMessage editNotifications}

26
test/Database/Fill.hs
View File

@ -371,6 +371,10 @@ fillDb = do
void . insert' $ UserFunction jost ifi SchoolLecturer
void . insert' $ UserFunction svaupel ifi SchoolLecturer
void . insert' $ UserFunction gkleen ifi SchoolAllocation
for_ [gkleen, fhamann, jost, maxMuster, svaupel] $ \uid ->
void . insert' $ UserSchool uid ifi False
for_ [gkleen, tinaTester] $ \uid ->
void . insert' $ UserSchool uid mi False
let
sdBsc = StudyDegreeKey' 82
sdMst = StudyDegreeKey' 88
@ -1014,11 +1018,11 @@ fillDb = do
, allocationDescription = Nothing
, allocationStaffDescription = Nothing
, allocationStaffRegisterFrom = Just now
, allocationStaffRegisterTo = Nothing
, allocationStaffAllocationFrom = Nothing
, allocationStaffAllocationTo = Nothing
, allocationRegisterFrom = Nothing
, allocationRegisterTo = Nothing
, allocationStaffRegisterTo = Just $ 300 `addUTCTime` now
, allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now
, allocationStaffAllocationTo = Just $ 900 `addUTCTime` now
, allocationRegisterFrom = Just $ 300 `addUTCTime` now
, allocationRegisterTo = Just $ 600 `addUTCTime` now
, allocationRegisterByStaffFrom = Nothing
, allocationRegisterByStaffTo = Nothing
, allocationRegisterByCourse = Nothing
@ -1147,12 +1151,12 @@ fillDb = do
, allocationSchool = ifi
, allocationDescription = Nothing
, allocationStaffDescription = Nothing
, allocationStaffRegisterFrom = Nothing
, allocationStaffRegisterTo = Nothing
, allocationStaffAllocationFrom = Nothing
, allocationStaffAllocationTo = Nothing
, allocationRegisterFrom = Nothing
, allocationRegisterTo = Just now
, allocationStaffRegisterFrom = Just now
, allocationStaffRegisterTo = Just $ 300 `addUTCTime` now
, allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now
, allocationStaffAllocationTo = Just $ 900 `addUTCTime` now
, allocationRegisterFrom = Just $ 300 `addUTCTime` now
, allocationRegisterTo = Just $ 600 `addUTCTime` now
, allocationRegisterByStaffFrom = Nothing
, allocationRegisterByStaffTo = Nothing
, allocationRegisterByCourse = Nothing