From 9e0b43a60d26a05f6e1b9d4dae2b2f75dd52fff1 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 28 Sep 2020 11:20:26 +0200 Subject: [PATCH] fix(allocations): notify for new course upon registration --- messages/uniworx/de-de-formal.msg | 2 +- messages/uniworx/en-eu.msg | 2 +- src/Handler/Allocation/Show.hs | 17 +++++------------ src/Handler/Utils/Allocation.hs | 21 ++++++++++++++++++++- src/Jobs/Handler/QueueNotification.hs | 15 +++++---------- 5 files changed, 32 insertions(+), 25 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index cda88415c..afcbdb1f9 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1141,7 +1141,7 @@ NotificationTriggerCourseRegistered: Ein Kursverwalter hat mich zu einem Kurs an NotificationTriggerSubmissionUserCreated: Ich wurde als Mitabgebender zu einer Übungsblatt-Abgabe hinzugefügt NotificationTriggerSubmissionEdited: Eine meiner Übungsblatt-Abgaben wurde verändert NotificationTriggerSubmissionUserDeleted: Ich wurde als Mitabgebender von einer Übungsblatt-Abgabe entfernt -NotificationTriggerAllocationNewCourse: Es wurde ein neuer Kurs eingetragen zu einer Zentralanmeldungen, für die ich mich beworben habe +NotificationTriggerAllocationNewCourse: Es wurde ein neuer Kurs eingetragen zu einer Zentralanmeldungen, zu der ich meine Teilnahme registriert habe NotificationTriggerAllocationNewCourseTip: Kann pro Zentralanmeldung überschrieben werden NotificationTriggerKindAll: Für alle Benutzer diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 38b6f384f..4a7c5e608 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -1142,7 +1142,7 @@ NotificationTriggerCourseRegistered: A course administrator has enrolled me in a NotificationTriggerSubmissionUserCreated: I was added to an exercise sheet submission NotificationTriggerSubmissionEdited: One of my exercise sheet submissions was changed NotificationTriggerSubmissionUserDeleted: I was removed from one of my exercise sheet submissions -NotificationTriggerAllocationNewCourse: A new course was added to a central allocation for which I have already made applications +NotificationTriggerAllocationNewCourse: A new course was added to a central allocation for which I have registered my participation NotificationTriggerAllocationNewCourseTip: Can be overridden per central allocation NotificationTriggerKindAll: For all users diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs index 061e8aed8..1280a4a64 100644 --- a/src/Handler/Allocation/Show.hs +++ b/src/Handler/Allocation/Show.hs @@ -7,6 +7,7 @@ import Import import Utils.Course import Handler.Utils +import Handler.Utils.Allocation (allocationNotifyNewCourses) import Handler.Allocation.Register import Handler.Allocation.Application @@ -43,8 +44,7 @@ instance Button UniWorX NotifyNewCourseButton where getAShowR, postAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html getAShowR = postAShowR postAShowR tid ssh ash = do - mAuth <- maybeAuth - let muid = entityKey <$> mAuth + muid <- maybeAuthId now <- liftIO getCurrentTime ata <- getSessionActiveAuthTags @@ -60,7 +60,7 @@ postAShowR tid ssh ash = do resultCourseVisible :: Simple Field5 a (E.Value Bool) => Lens' a Bool resultCourseVisible = _5 . _Value - (Entity aId Allocation{..}, School{..}, isAnyLecturer, courses, registration, notificationSetting) <- runDB $ do + (Entity aId Allocation{..}, School{..}, isAnyLecturer, courses, registration, wouldNotifyNewCourse) <- runDB $ do alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash school <- getJust allocationSchool @@ -85,9 +85,9 @@ postAShowR tid ssh ash = do isAnyLecturer <- hasWriteAccessTo CourseNewR - notificationSetting <- fmap join . for muid $ getBy . flip UniqueAllocationNotificationSetting aId + wouldNotifyNewCourse <- fmap (maybe False E.unValue . join) . for muid $ E.selectMaybe . pure . allocationNotifyNewCourses (E.val aId) . E.val - return (alloc, school, isAnyLecturer, nubOn (view $ resultCourse . _entityKey) courses, registration, notificationSetting) + return (alloc, school, isAnyLecturer, nubOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse) MsgRenderer mr <- getMsgRenderer let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName @@ -108,13 +108,6 @@ postAShowR tid ssh ash = do , formAnchor = Nothing :: Maybe Text } - let wouldNotifyNewCourse = case (mAuth, notificationSetting) of - (_, Just (Entity _ AllocationNotificationSetting{..})) - -> not allocationNotificationSettingIsOptOut - (Just (Entity _ User{..}), _) - -> any (has $ _2 . _Just) courses && notificationAllowed userNotificationSettings NTAllocationNewCourse - _other - -> False ((notificationResult, notificationForm), notificationEnctype) <- runFormPost . identifyForm FIDAllocationNotification . buttonForm' $ if | wouldNotifyNewCourse -> [BtnNotifyNewCourseForceOff] diff --git a/src/Handler/Utils/Allocation.hs b/src/Handler/Utils/Allocation.hs index db512e25a..cefdf7c1a 100644 --- a/src/Handler/Utils/Allocation.hs +++ b/src/Handler/Utils/Allocation.hs @@ -1,5 +1,5 @@ module Handler.Utils.Allocation - ( allocationStarted + ( allocationStarted, allocationNotifyNewCourses , ordinalPriorities , sinkAllocationPriorities , MatchingLogRun(..) @@ -70,6 +70,25 @@ allocationStarted allocId = fmap (E.unValue <=< listToMaybe) . E.select . E.from E.where_ $ allocationMatching E.^. AllocationMatchingAllocation E.==. E.val allocId return . E.min_ $ allocationMatching E.^. AllocationMatchingTime +allocationNotifyNewCourses :: E.SqlExpr (E.Value AllocationId) + -> E.SqlExpr (E.Value UserId) + -> E.SqlExpr (E.Value Bool) +allocationNotifyNewCourses allocId uid = ( hasOverride True E.||. hasApplication E.||. isParticipant ) + E.&&. E.not_ (hasOverride False) + where + hasOverride overrideVal = E.exists . E.from $ \allocationNotificationSetting -> + E.where_ $ allocationNotificationSetting E.^. AllocationNotificationSettingUser E.==. uid + E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingAllocation E.==. allocId + E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingIsOptOut E.==. E.val (not overrideVal) + + hasApplication = E.exists . E.from $ \application -> + E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just allocId + E.&&. application E.^. CourseApplicationUser E.==. uid + + isParticipant = E.exists . E.from $ \allocationUser -> + E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. allocId + E.&&. allocationUser E.^. AllocationUserUser E.==. uid + ordinalPriorities :: Monad m => ConduitT UserMatriculation (Map UserMatriculation AllocationPriority) m () ordinalPriorities = evalStateC 0 . C.mapM $ \matr -> singletonMap matr <$> (AllocationPriorityOrdinal <$> State.get <* State.modify' succ) diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index d653faf3e..f671b0c71 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -14,6 +14,7 @@ import qualified Data.Set as Set import Handler.Utils.ExamOffice.Exam import Handler.Utils.ExamOffice.ExternalExam +import Handler.Utils.Allocation (allocationNotifyNewCourses) import qualified Data.Conduit.Combinators as C @@ -286,25 +287,19 @@ determineNotificationCandidates = awaitForever $ \notif -> do -> withNotif . yieldMMany $ getEntity nUser NotificationAllocationNewCourse{..} -> withNotifOverride . E.selectSource . E.from $ \user -> do - let hasOverride overrideVal = E.exists . E.from $ \allocationNotificationSetting -> + let hasOverride = E.exists . E.from $ \allocationNotificationSetting -> E.where_ $ allocationNotificationSetting E.^. AllocationNotificationSettingUser E.==. user E.^. UserId E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingAllocation E.==. E.val nAllocation - E.&&. allocationNotificationSetting E.^. AllocationNotificationSettingIsOptOut E.==. E.val (not overrideVal) + E.&&. E.not_ (allocationNotificationSetting E.^. AllocationNotificationSettingIsOptOut) - hasApplication = E.exists . E.from $ \application -> - E.where_ $ application E.^. CourseApplicationAllocation E.==. E.justVal nAllocation - E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId - - E.where_ $ hasOverride True E.||. hasApplication - - E.where_ . E.not_ $ hasOverride False + E.where_ . allocationNotifyNewCourses (E.val nAllocation) $ user E.^. UserId E.where_ . E.not_ . E.exists . E.from $ \application -> E.where_ $ application E.^. CourseApplicationAllocation E.==. E.justVal nAllocation E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId E.&&. application E.^. CourseApplicationCourse E.==. E.val nCourse - return (hasOverride True, user) + return (hasOverride, user) classifyNotification :: Notification -> DB NotificationTrigger