fix(allocations): notify for new course upon registration

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

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

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
+  muid <- maybeAuthId
-  let muid = entityKey <$> mAuth
   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]

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)

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_ . allocationNotifyNewCourses (E.val nAllocation) $ user E.^. UserId
-                 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_ . 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