feat(allocations): notification about finished allocation

messages/uniworx/de.msg

@@ -900,6 +900,7 @@ NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldung-Bewerbungen f
 NotificationTriggerAllocationRegister: Ich kann mich bei einer neuen Zentralanmeldung bewerben
 NotificationTriggerAllocationOutdatedRatings: Zentralanmeldung-Bewerbungen für einen meiner Kurse wurden verändert, nachdem sie bewertet wurden
 NotificationTriggerAllocationUnratedApplications: Bewertungen zu Zentralanmeldung-Bewerbungen für einen meiner Kurse stehen aus
+NotificationTriggerAllocationResults: Plätze wurden für eine meiner Zentralanmeldungen verteilt
 NotificationTriggerExamOfficeExamResults: Ich kann neue Prüfungsergebnisse einsehen
 NotificationTriggerExamOfficeExamResultsChanged: Prüfungsergebnisse wurden verändert
 
@@ -911,7 +912,8 @@ NotificationTriggerKindLecturer: Für Dozenten
 NotificationTriggerKindAdmin: Für Administratoren
 NotificationTriggerKindExamOffice: Für das Prüfungsamt
 NotificationTriggerKindEvaluation: Für Vorlesungsumfragen
-NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen
+NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen (Dozenten)
+NotificationTriggerKindAllocationParticipant: Für Zentralanmeldungen
 
 CorrCreate: Abgaben erstellen
 UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"
@@ -1865,3 +1867,10 @@ CourseDeregistrationAllocationReason: Grund
 CourseDeregistrationAllocationReasonTip: Der angegebene Grund wird permanent im System hinterlegt und ist i.A. einziger Anhaltspunkt zur Schlichtung etwaiger Konflikte
 CourseDeregistrationAllocationShouldLog: Selbstverschuldet
 CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
+
+MailSubjectAllocationResults allocation@AllocationName: Plätze für Zentralanmeldung „#{allocation}“ wurden verteilt
+AllocationResultsLecturer: Es wurden Plätze zugewiesen, wie folgt:
+AllocationResultLecturer csh@CourseShorthand count@Int64: #{count} Teilnehmer für #{csh}
+AllocationResultsStudent: Sie haben Plätze erhalten in:
+AllocationNoResultsStudent: Sie haben leider keine Plätze erhalten.
+AllocationResultStudent csh@CourseShorthand: Sie haben einen Platz in #{csh} erhalten.

src/Handler/Profile.hs

@@ -49,6 +49,7 @@ data NotificationTriggerKind
   | NTKExamParticipant
   | NTKCorrector
   | NTKAllocationStaff
+  | NTKAllocationParticipant
   | NTKFunctionary SchoolFunction
   deriving (Eq, Ord, Generic, Typeable)
 deriveFinite ''NotificationTriggerKind
@@ -60,6 +61,7 @@ instance RenderMessage UniWorX NotificationTriggerKind where
     NTKExamParticipant -> mr MsgNotificationTriggerKindExamParticipant
     NTKCorrector -> mr MsgNotificationTriggerKindCorrector
     NTKAllocationStaff -> mr MsgNotificationTriggerKindAllocationStaff
+    NTKAllocationParticipant -> mr MsgNotificationTriggerKindAllocationParticipant
     NTKFunctionary SchoolAdmin -> mr MsgNotificationTriggerKindAdmin
     NTKFunctionary SchoolLecturer -> mr MsgNotificationTriggerKindLecturer
     NTKFunctionary SchoolExamOffice -> mr MsgNotificationTriggerKindExamOffice
@@ -185,6 +187,7 @@ notificationForm template = wFormToAForm $ do
       NTAllocationRegister             -> Just NTKAll
       NTAllocationOutdatedRatings      -> Just NTKAllocationStaff
       NTAllocationUnratedApplications  -> Just NTKAllocationStaff
+      NTAllocationResults              -> Just NTKAllocationParticipant
       NTExamOfficeExamResults          -> Just $ NTKFunctionary SchoolExamOffice
       NTExamOfficeExamResultsChanged   -> Just $ NTKFunctionary SchoolExamOffice
       -- _other                        -> Nothing

src/Jobs/Crontab.hs

@@ -336,5 +336,17 @@ determineCrontab = execWriterT $ do
                   }
         _other
           -> return ()
+      lastResult <- fmap (E.unValue <=< listToMaybe) . lift . E.select . E.from $ \participant -> do
+        E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
+        return . E.max_ $ participant E.^. CourseParticipantRegistration
+      whenIsJust lastResult $ \lastResult' ->
+        tell $ HashMap.singleton
+          (JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..})
+          Cron
+            { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay lastResult'
+            , cronRepeat    = CronRepeatNever
+            , cronRateLimit = appNotificationRateLimit
+            , cronNotAfter  = Left appNotificationExpiration
+            }
 
   runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ allocationJobs

src/Jobs/Handler/QueueNotification.hs

@@ -198,6 +198,18 @@ determineNotificationCandidates NotificationExamOfficeExamResultsChanged{..} =
       E.where_ $ examResult E.^. ExamResultId `E.in_` E.valList (Set.toList nExamResults)
       E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
     return user
+determineNotificationCandidates NotificationAllocationResults{..} =
+  E.select . E.from $ \user -> do
+    let isStudent = E.exists . E.from $ \application ->
+          E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)
+               E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
+        isLecturer = E.exists . E.from $ \(lecturer `E.InnerJoin` allocationCourse) ->
+          E.on $ lecturer E.^. LecturerCourse E.==. allocationCourse E.^. AllocationCourseCourse
+           E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+           E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId
+    E.where_ $ isStudent E.||. isLecturer
+
+    return user
 
 
 classifyNotification :: Notification -> DB NotificationTrigger
@@ -224,3 +236,4 @@ classifyNotification NotificationAllocationOutdatedRatings{}      = return NTAll
 classifyNotification NotificationAllocationUnratedApplications{}  = return NTAllocationUnratedApplications
 classifyNotification NotificationExamOfficeExamResults{}          = return NTExamOfficeExamResults
 classifyNotification NotificationExamOfficeExamResultsChanged{}   = return NTExamOfficeExamResultsChanged
+classifyNotification NotificationAllocationResults{}              = return NTAllocationResults

src/Jobs/Handler/SendNotification/Allocation.hs

@@ -6,6 +6,7 @@ module Jobs.Handler.SendNotification.Allocation
   , dispatchNotificationAllocationAllocation
   , dispatchNotificationAllocationUnratedApplications
   , dispatchNotificationAllocationOutdatedRatings
+  , dispatchNotificationAllocationResults
   ) where
 
 import Import
@@ -157,3 +158,41 @@ dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do
     addAlternatives $
       providePreferredAlternative $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet")
 
+dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler ()
+dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
+  (Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do
+    allocation <- getJust nAllocation
+
+    lecturerResults' <- E.select . E.from $ \(lecturer `E.InnerJoin` course) -> do
+      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
+      E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
+           E.&&. E.exists (E.from $ \allocationCourse ->
+                              E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+                                   E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
+                          )
+      let participantCount = E.sub_select . E.from $ \participant -> do
+            E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
+                 E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
+            return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int64))
+      return (course, participantCount)
+    let lecturerResults = flip map lecturerResults' $ \(Entity _ Course{..}, E.Value partCount) -> SomeMessage $ MsgAllocationResultLecturer courseShorthand partCount
+
+    doParticipantResults <- E.selectExists . E.from $ \application ->
+      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)
+    participantResults' <- E.select . E.from $ \(participant `E.InnerJoin` course) -> do
+      E.on $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+      E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
+      return course
+    let participantResults = case participantResults' of
+          [] | doParticipantResults -> Just []
+             | otherwise            -> Nothing
+          cs -> Just $ map (courseShorthand . entityVal) cs
+  
+    return (allocation, lecturerResults, participantResults)
+
+  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
+  setSubjectI $ MsgMailSubjectAllocationResults allocationName
+  editNotifications <- mkEditNotifications jRecipient
+  
+  addAlternatives $
+    providePreferredAlternative $(ihamletFile "templates/mail/allocationResults.hamlet")

src/Jobs/Types.hs

@@ -87,6 +87,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                   | NotificationAllocationOutdatedRatings { nAllocation :: AllocationId }
                   | NotificationExamOfficeExamResults { nExam :: ExamId }
                   | NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
+                  | NotificationAllocationResults { nAllocation :: AllocationId }
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 
 instance Hashable Job

src/Model/Types/Mail.hs

@@ -40,6 +40,7 @@ data NotificationTrigger
   | NTAllocationRegister
   | NTAllocationOutdatedRatings
   | NTAllocationUnratedApplications
+  | NTAllocationResults
   | NTExamOfficeExamResults
   | NTExamOfficeExamResultsChanged
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)

templates/mail/allocationResults.hamlet

@@ -0,0 +1,36 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{SomeMessage $ MsgMailSubjectAllocationResults allocationName}
+
+    $if not (null lecturerResults)
+      <p>
+        _{SomeMessage MsgAllocationResultsLecturer}
+      <ul>
+        $forall msg <- lecturerResults
+          <li>_{msg}
+
+    $maybe pResults <- participantResults
+      $case pResults 
+        $of []
+          <p>_{SomeMessage MsgAllocationNoResultsStudent}
+        $of [csh]
+          <p>_{SomeMessage $ MsgAllocationResultStudent csh}
+        $of cshs
+          <p>
+            _{SomeMessage MsgAllocationResultsStudent}
+          <ul>
+            $forall csh <- cshs
+              <li>#{csh}
+
+    ^{ihamletSomeMessage editNotifications}