feat(allocations): merge notifications

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

View File

@ -2234,25 +2234,45 @@ SynchroniseLdapUserQueued n@Int: LDAP-Synchronisation von #{n} #{pluralDE n "Ben
SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzern angestoßen SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzern angestoßen
UserHijack: Sitzung übernehmen UserHijack: Sitzung übernehmen
MailSubjectAllocationStaffRegister allocation@AllocationName: Sie können nun Kurse für die Zentralameldung „#{allocation}“ registrieren MailAllocationSchoolAndName allocationSchool@SchoolId allocation@AllocationName: #{allocationSchool}: „#{allocation}“
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.
MailSubjectAllocationRegister allocation@AllocationName: Sie können sich nun für Kurse der Zentralameldung „#{allocation}“ bewerben MailSubjectAllocationStaffRegister allocationSchool@SchoolId allocation@AllocationName: Sie können nun Kurse für die Zentralameldung #{allocationSchool}: „#{allocation}“ registrieren
MailAllocationRegister: Sie können sich, auf der unten aufgeführten Seite, für alle Kurse der Zentralanmeldung jeweils einzeln bewerben. 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. 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. 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. 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 MailSubjectAllocationUnratedApplications allocationSchool@SchoolId allocation@AllocationName: Es stehen noch Bewertungen zu Bewerbungen für ihre Kurse in der Zentralanmeldung #{allocationSchool}: „#{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. 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:
MailSubjectAllocationOutdatedRatings allocation@AllocationName: Bereits bewertete Bewerbungen für ihre Kurse in der Zentralanmeldung „#{allocation}“ haben sich geändert 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.
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. MailAllocationUnratedApplicationsCount i@Natural: #{i} #{pluralDE i "Bewerbung" "Bewerbungen"}
MailAllocationOutdatedRatingsWarning: Bewerbungen deren Bewertung veraltet ist (d.h. die Bewerbung wurde nach der Bewertung verändert) zählen als nicht bewertet.
ExamOfficeSubscribedUsers: Benutzer ExamOfficeSubscribedUsers: Benutzer
ExamOfficeSubscribedUsersTip: Sie können mehrere Matrikelnummern mit Komma separieren ExamOfficeSubscribedUsersTip: Sie können mehrere Matrikelnummern mit Komma separieren

View File

@ -2234,25 +2234,45 @@ SynchroniseLdapUserQueued n: Triggered LDAP synchronisation of #{n} #{pluralEN n
SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users
UserHijack: Hijack session UserHijack: Hijack session
MailSubjectAllocationStaffRegister allocation: You may now register courses for the central allocation “#{allocation}” MailAllocationSchoolAndName allocationSchool allocation: #{allocationSchool}: “#{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.
MailSubjectAllocationRegister allocation: You may now apply for the central allocation “#{allocation}” MailSubjectAllocationStaffRegister allocationSchool allocation: You can now register courses for the central allocation #{allocationSchool}: “#{allocation}”
MailAllocationRegister: You may now apply for each individual course particpating in the central allocation on the page linked below. MailSubjectAllocationStaffRegisterMultiple n: You can now register courses for #{n} central allocations
MailAllocationRegisterDeadline deadline: Please consider that all applications have to be made until #{deadline}. 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}” MailSubjectAllocationRegister allocationSchool allocation: Applications can now be made for courses of the central allocation #{allocationSchool}: “#{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. MailSubjectAllocationRegisterMultiple n: Applications can now be made for courses of #{n} central allocations
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. MailAllocationRegisterIntroMultiple n: Applications can now be made for courses of the following #{n} central allocations:
MailAllocationAllocationDeadline deadline: Please consider that grading of applications is only possible until #{deadline}. 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 MailSubjectAllocationAllocation allocationSchool allocation: You can now rate applications for your courses that participate in the central allocation #{allocationSchool}: “#{allocation}”
MailAllocationOutdatedRatings: Applications have been made to the courses list below for the central allocation, which have changed since they were last graded. MailSubjectAllocationAllocationMultiple n: You can now rate applications for your courses that participate in #{n} central allocations
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. 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 ExamOfficeSubscribedUsers: Users
ExamOfficeSubscribedUsersTip: You may specify multiple matriculations; comma-separated ExamOfficeSubscribedUsersTip: You may specify multiple matriculations; comma-separated

View File

@ -373,69 +373,64 @@ determineCrontab = execWriterT $ do
runConduit $ transPipe lift (selectKeys [] []) .| C.mapM_ externalExamJobs runConduit $ transPipe lift (selectKeys [] []) .| C.mapM_ externalExamJobs
allocations <- lift $ selectList [] []
let let
allocationJobs (Entity nAllocation Allocation{..}) = do allocationTimes :: EntityField Allocation (Maybe UTCTime) -> MergeHashMap UTCTime [Entity Allocation]
whenIsJust allocationStaffRegisterFrom $ \staffRegisterFrom -> allocationTimes aField = flip foldMap allocations $ \allocEnt -> case allocEnt ^. fieldLens aField of
tell $ HashMap.singleton Nothing -> mempty
(JobCtlQueue $ JobQueueNotification NotificationAllocationStaffRegister{..}) Just t -> _MergeHashMap # HashMap.singleton t (pure allocEnt)
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
whenIsJust doneSince $ \doneSince' -> forM_ allocations $ \(Entity nAllocation _) -> do
tell $ HashMap.singleton doneSince <- lift $ fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \participant -> do
(JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..}) E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
Cron return . E.max_ $ participant E.^. CourseParticipantRegistration
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay doneSince'
, cronRepeat = CronRepeatOnChange
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationCollateDelay $ addUTCTime appNotificationExpiration doneSince'
}
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
}

View File

@ -19,246 +19,266 @@ import qualified Data.Conduit.Combinators as C
dispatchJobQueueNotification :: Notification -> JobHandler UniWorX dispatchJobQueueNotification :: Notification -> JobHandler UniWorX
dispatchJobQueueNotification jNotification = JobHandlerAtomic $ do dispatchJobQueueNotification jNotification = JobHandlerAtomic $
nClass <- hoist lift $ classifyNotification jNotification runConduit $ yield jNotification
runConduit $ transPipe (hoist lift) (determineNotificationCandidates jNotification) .| transPipe (hoist lift) determineNotificationCandidates
.| C.filter (\(Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings nClass) .| C.filterM (\(notification', Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings <$> hoist lift (classifyNotification notification'))
.| C.map (flip JobSendNotification jNotification . entityKey) .| sinkDBJobs .| C.map (\(notification', Entity uid _) -> JobSendNotification uid notification')
.| sinkDBJobs
determineNotificationCandidates :: Notification -> ConduitT () (Entity User) DB () determineNotificationCandidates :: ConduitT Notification (Notification, Entity User) DB ()
determineNotificationCandidates NotificationSubmissionRated{..} determineNotificationCandidates = awaitForever $ \notif -> do
= E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do let withNotif :: ConduitT () (Entity User) DB () -> ConduitT Notification (Notification, Entity User) DB ()
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser withNotif c = toProducer c .| C.map (notif, )
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
E.where_ . E.exists . E.from $ \userSchool -> -- | Assumes that conduit produces output sorted by `UserId`
E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId separateTargets :: Ord target
E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool => (Set target -> Notification)
E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut) -> 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
E.where_ . E.not_ . E.exists . E.from $ \(course `E.InnerJoin` lecturer) -> do case notif of
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId NotificationSubmissionRated{..}
E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId -> withNotif . E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.where_ . E.exists . E.from $ \allocationCourse -> E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation 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
return user E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer
determineNotificationCandidates NotificationAllocationAllocation{..} = E.&&. allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)
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.not_ . E.exists . E.from $ \application -> E.where_ . E.exists . E.from $ \userSchool ->
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation) E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. AllocationSchool
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)
E.where_ . E.exists . E.from $ \application -> E.where_ . E.not_ . E.exists . E.from $ \(course `E.InnerJoin` lecturer) -> do
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation) E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId
E.&&. application E.^. CourseApplicationUser 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
return user return (user, allocation E.^. AllocationId)
determineNotificationCandidates NotificationAllocationUnratedApplications{..} = NotificationAllocationRegister{..}
E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do -> 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 $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId E.on E.true
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ . E.exists . E.from $ \application -> E.where_ $ allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
return user E.where_ . E.exists . E.from $ \userSchool ->
determineNotificationCandidates NotificationAllocationRegister{..} = do E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
Allocation{..} <- lift $ getJust nAllocation E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. AllocationSchool
E.selectSource . E.from $ \user -> do E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
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_ . E.not_ . E.exists . E.from $ \application ->
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation) E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
return user return (user, allocation E.^. AllocationId)
determineNotificationCandidates NotificationAllocationOutdatedRatings{..} = NotificationAllocationAllocation{..}
E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do -> 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 $ 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 $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ . E.exists . E.from $ \application -> E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)
E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
return user E.where_ . E.not_ . E.exists . E.from $ \application ->
determineNotificationCandidates NotificationExamOfficeExamResults{..} = E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
E.selectSource . E.from $ \user -> do E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.where_ . E.exists . E.from $ \examResult -> do E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)
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
wasAllocated t = E.exists . E.from $ \participant -> E.where_ . E.exists . E.from $ \application ->
E.where_ $ participant E.^. CourseParticipantUser E.==. user E.^. UserId E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation) E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
E.&&. participant E.^. CourseParticipantRegistration E.>. E.val t E.&&. application E.^. CourseApplicationUser E.!=. user E.^. UserId
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 return (user, allocationCourse E.^. AllocationCourseAllocation)
determineNotificationCandidates NotificationCourseRegistered{..} = NotificationAllocationUnratedApplications{..}
yieldMMany $ getEntity nUser -> 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
determineNotificationCandidates NotificationSubmissionEdited{..} = E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.selectSource . E.from $ \(user `E.InnerJoin` submissionUser) -> do E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
E.&&. user E.^. UserId E.!=. E.val nInitiator E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)
return user
determineNotificationCandidates NotificationSubmissionUserCreated{..} = E.where_ . E.exists . E.from $ \application ->
yieldMMany $ getEntity nUser E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
determineNotificationCandidates NotificationSubmissionUserDeleted{..} = E.&&. application E.^. CourseApplicationCourse E.==. course E.^. CourseId
yieldMMany $ getEntity nUser 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 classifyNotification :: Notification -> DB NotificationTrigger
@ -283,7 +303,6 @@ classifyNotification NotificationExamResult{} = return NTExa
classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged

View File

@ -5,7 +5,6 @@ module Jobs.Handler.SendNotification.Allocation
, dispatchNotificationAllocationRegister , dispatchNotificationAllocationRegister
, dispatchNotificationAllocationAllocation , dispatchNotificationAllocationAllocation
, dispatchNotificationAllocationUnratedApplications , dispatchNotificationAllocationUnratedApplications
, dispatchNotificationAllocationOutdatedRatings
, dispatchNotificationAllocationResults , dispatchNotificationAllocationResults
) where ) where
@ -20,137 +19,122 @@ import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E import qualified Database.Esqueleto.Utils as E
dispatchNotificationAllocationStaffRegister :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationStaffRegister :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationStaffRegister nAllocation jRecipient = userMailT jRecipient $ do dispatchNotificationAllocationStaffRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
Allocation{..} <- liftHandler . runDB $ getJust nAllocation allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" 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 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") addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")
dispatchNotificationAllocationRegister :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationRegister :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecipient $ do dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
Allocation{..} <- liftHandler . runDB $ getJust nAllocation allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" 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 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") addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationRegister.hamlet")
dispatchNotificationAllocationAllocation :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationAllocation :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationAllocation nAllocation jRecipient = do dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient = do
(Allocation{..}, courses) <- runDB $ do courses <- fmap (nubOn $ views _2 entityKey) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
allocation <- getJust nAllocation E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations
return ( course E.^. CourseTerm
, course E.^. CourseSchool E.orderBy [ E.asc $ allocation E.^. AllocationSchool
, course E.^. CourseShorthand , E.asc $ allocation E.^. AllocationName
, course E.^. CourseName , E.asc $ course E.^. CourseTerm
) , E.asc $ course E.^. CourseSchool
let courses' = courses , E.asc $ course E.^. CourseName
& over (traverse . _1) E.unValue ]
& over (traverse . _2) E.unValue
& over (traverse . _3) E.unValue return (allocation, course)
& over (traverse . _4) E.unValue
return (allocation, courses') let allocations = nubOn entityKey $ courses ^.. folded . _1
unless (null courses) . userMailT jRecipient $ do unless (null courses) . userMailT jRecipient $ do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let doRegisterDeadlines = any (> NTop (Just now)) $ map (NTop . allocationRegisterTo . entityVal) allocations
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" 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 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") addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationAllocation.hamlet")
dispatchNotificationAllocationUnratedApplications :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationUnratedApplications :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRecipient = do
(Allocation{..}, courses) <- runDB $ 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
allocation <- getJust nAllocation E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId E.on $ allocationCourse E.^. AllocationCourseCourse 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 E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
unratedAppCount :: E.SqlExpr (E.Value Natural) E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations
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)
return ( course E.^. CourseTerm let
, course E.^. CourseSchool unratedAppCount :: E.SqlExpr (E.Value Natural)
, course E.^. CourseShorthand unratedAppCount = E.subSelectCount . E.from $ \application ->
, course E.^. CourseName E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
, unratedAppCount E.&&. application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
) E.&&. E.maybe E.true (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
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')
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 unless (null courses) . userMailT jRecipient $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" 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 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") 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 :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
(Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do (Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do

View File

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

View File

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

View File

@ -9,18 +9,50 @@ $newline never
font-variant: small-caps; font-variant: small-caps;
font-weight: normal; font-weight: normal;
} }
.bold {
font-weight: bold;
}
<body> <body>
<h1> <h1>
_{SomeMessage $ MsgMailSubjectAllocationRegister allocationName} $case allocs
$of [Allocation{allocationSchool, allocationName}]
_{SomeMessage $ MsgMailSubjectAllocationRegister allocationSchool allocationName}
$of _
_{SomeMessage $ MsgMailAllocationRegisterIntroMultiple (length allocs)}
<p> <p>
_{SomeMessage MsgMailAllocationRegister} _{SomeMessage $ MsgMailAllocationRegister (length allocs)}
<br>
<a href=@{AllocationR allocationTerm allocationSchool allocationShorthand AShowR}>
#{allocationName}
$maybe until <- registerDeadline $case allocs
<p> $of [Allocation{allocationTerm, allocationSchool, allocationShorthand, allocationName}]
_{SomeMessage $ MsgMailAllocationRegisterDeadline until} <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}
$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} ^{ihamletSomeMessage editNotifications}

View File

@ -9,9 +9,22 @@ $newline never
font-variant: small-caps; font-variant: small-caps;
font-weight: normal; font-weight: normal;
} }
.bold {
font-weight: bold;
}
<body> <body>
<h1> $case allocs
_{SomeMessage $ MsgMailSubjectAllocationStaffRegister allocationName} $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> <p>
_{SomeMessage MsgMailAllocationStaffRegisterNewCourse} _{SomeMessage MsgMailAllocationStaffRegisterNewCourse}
@ -19,8 +32,26 @@ $newline never
<a href=@{CourseNewR}> <a href=@{CourseNewR}>
_{SomeMessage MsgMenuCourseNew} _{SomeMessage MsgMenuCourseNew}
$maybe until <- registerDeadline $if doRegisterDeadlines
<p> $if singleRegisterDeadline
_{SomeMessage $ MsgMailAllocationStaffRegisterDeadline until} $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} ^{ihamletSomeMessage editNotifications}

View File

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

View File

@ -371,6 +371,10 @@ fillDb = do
void . insert' $ UserFunction jost ifi SchoolLecturer void . insert' $ UserFunction jost ifi SchoolLecturer
void . insert' $ UserFunction svaupel ifi SchoolLecturer void . insert' $ UserFunction svaupel ifi SchoolLecturer
void . insert' $ UserFunction gkleen ifi SchoolAllocation 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 let
sdBsc = StudyDegreeKey' 82 sdBsc = StudyDegreeKey' 82
sdMst = StudyDegreeKey' 88 sdMst = StudyDegreeKey' 88
@ -1014,11 +1018,11 @@ fillDb = do
, allocationDescription = Nothing , allocationDescription = Nothing
, allocationStaffDescription = Nothing , allocationStaffDescription = Nothing
, allocationStaffRegisterFrom = Just now , allocationStaffRegisterFrom = Just now
, allocationStaffRegisterTo = Nothing , allocationStaffRegisterTo = Just $ 300 `addUTCTime` now
, allocationStaffAllocationFrom = Nothing , allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now
, allocationStaffAllocationTo = Nothing , allocationStaffAllocationTo = Just $ 900 `addUTCTime` now
, allocationRegisterFrom = Nothing , allocationRegisterFrom = Just $ 300 `addUTCTime` now
, allocationRegisterTo = Nothing , allocationRegisterTo = Just $ 600 `addUTCTime` now
, allocationRegisterByStaffFrom = Nothing , allocationRegisterByStaffFrom = Nothing
, allocationRegisterByStaffTo = Nothing , allocationRegisterByStaffTo = Nothing
, allocationRegisterByCourse = Nothing , allocationRegisterByCourse = Nothing
@ -1147,12 +1151,12 @@ fillDb = do
, allocationSchool = ifi , allocationSchool = ifi
, allocationDescription = Nothing , allocationDescription = Nothing
, allocationStaffDescription = Nothing , allocationStaffDescription = Nothing
, allocationStaffRegisterFrom = Nothing , allocationStaffRegisterFrom = Just now
, allocationStaffRegisterTo = Nothing , allocationStaffRegisterTo = Just $ 300 `addUTCTime` now
, allocationStaffAllocationFrom = Nothing , allocationStaffAllocationFrom = Just $ 300 `addUTCTime` now
, allocationStaffAllocationTo = Nothing , allocationStaffAllocationTo = Just $ 900 `addUTCTime` now
, allocationRegisterFrom = Nothing , allocationRegisterFrom = Just $ 300 `addUTCTime` now
, allocationRegisterTo = Just now , allocationRegisterTo = Just $ 600 `addUTCTime` now
, allocationRegisterByStaffFrom = Nothing , allocationRegisterByStaffFrom = Nothing
, allocationRegisterByStaffTo = Nothing , allocationRegisterByStaffTo = Nothing
, allocationRegisterByCourse = Nothing , allocationRegisterByCourse = Nothing