Notification Corrections assigned added

config/settings.yml

@@ -24,6 +24,7 @@ job-flush-interval: "_env:JOB_FLUSH:30"
 job-cron-interval:  "_env:CRON_INTERVAL:60"
 job-stale-threshold: 300
 notification-rate-limit: 3600
+notification-collate-delay: 300
 
 log-settings:
   log-detailed:      "_env:DETAILED_LOGGING:false"

messages/uniworx/de.msg

@@ -16,7 +16,7 @@ WinterTerm year@Integer: Wintersemester #{display year}/#{display $ succ year}
 SummerTermShort year@Integer: SoSe #{display year}
 WinterTermShort year@Integer: WiSe #{display year}/#{display $ mod (succ year) 100}
 PSLimitNonPositive: “pagesize” muss größer als null sein
-Page n@Int64: #{display n}
+Page num@Int64: #{display num}
 
 TermsHeading: Semesterübersicht
 TermCurrent: Aktuelles Semester
@@ -131,7 +131,7 @@ SubmissionWrongSheet: Abgabenummer gehört nicht zum angegebenen Übungsblatt.
 SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt.
 SubmissionEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh} #{sheetName}: Abgabe editieren/anlegen
 CorrectionHead     tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName cid@CryptoFileNameSubmission: #{display tid}-#{display ssh}-#{csh} #{sheetName}: Korrektur
-SubmissionMember g@Int: Mitabgebende(r) ##{display g}
+SubmissionMember n@Int: Mitabgebende(r) ##{display n}
 SubmissionArchive: Zip-Archiv der Abgabedatei(en)
 SubmissionFile: Datei zur Abgabe
 SubmissionFiles: Abgegebene Dateien
@@ -203,7 +203,7 @@ ImpressumHeading: Impressum
 SystemMessageHeading: Uni2Work Statusmeldung
 SystemMessageListHeading: Uni2Work Statusmeldungen
 
-NumCourses n@Int64: #{display n} Kurse
+NumCourses num@Int64: #{display num} Kurse
 CloseAlert: Schliessen
 
 Name: Name
@@ -346,7 +346,9 @@ MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie kön
 MailSubjectSheetSoonInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden
 MailSheetSoonInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze.
 MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfristt für #{sheetName} in #{csh} abgelaufen
-MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Dia Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet.
+MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Die Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet.
+MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n@Int: #{display n} Abgaben wurden Ihnen zur Korrektur für #{sheetName} im Kurs #{courseName} (#{termDesc}) zugeteilt.
+
 MailSubjectSupport: Supportanfrage
 
 SheetTypeBonus: Bonus
@@ -374,6 +376,7 @@ NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert
 NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen
 NotificationTriggerSheetSoonInactive: Ich kann ein Übungsblatt bald nicht mehr abgeben
 NotificationTriggerSheetInactive: Abgabefrist eines meiner Übungsblätter ist abgelaufen
+NotificationCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugeteilt
 
 CorrCreate: Abgaben erstellen
 UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"

src/Foundation.hs

@@ -257,6 +257,7 @@ instance RenderMessage UniWorX NotificationTrigger where
     NTSheetActive -> MsgNotificationTriggerSheetActive
     NTSheetSoonInactive -> MsgNotificationTriggerSheetSoonInactive
     NTSheetInactive -> MsgNotificationTriggerSheetInactive 
+    NTCorrectionsAssigned -> MsgNotificationCorrectionsAssigned
 
 instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
   renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route)

src/Jobs/Crontab.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE NoImplicitPrelude
            , RecordWildCards
            , FlexibleContexts
+           , MultiWayIf
+           , NamedFieldPuns
+           , TypeFamilies
   #-}
 
 module Jobs.Crontab
@@ -12,6 +15,10 @@ import Import
 import qualified Data.HashMap.Strict as HashMap
 import Jobs.Types
 
+import Data.Maybe (fromJust)
+import qualified Data.Map as Map
+import Data.Semigroup (Max(..))
+
 import Data.Time
 import Data.Time.Zones
 
@@ -66,5 +73,28 @@ determineCrontab = execWriterT $ do
           { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
           , cronRepeat = CronRepeatOnChange
           , cronRateLimit = appNotificationRateLimit
-          }                      
+          }             
+      
+      sheetSubmissions <- lift $ collateSubmissions <$> 
+          selectList [SubmissionRatingBy !=. Nothing, SubmissionSheet ==. nSheet] []      
+      tell $ flip Map.foldMapWithKey sheetSubmissions $
+        \nUser (Max mbTime) -> if
+          |  Just time <- mbTime -> HashMap.singleton 
+              (JobCtlQueue $ JobQueueNotification NotificationCorrectionsAssigned { nUser, nSheet } )
+              Cron 
+                { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay time
+                , cronRepeat    = CronRepeatNever
+                , cronRateLimit = appNotificationRateLimit
+                }
+          | otherwise -> mempty
+
   runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs
+
+-- | Partial function: Submission must not have Nothing at ratingBy
+collateSubmissions :: [Entity Submission] -> Map UserId (Max (Maybe UTCTime))
+collateSubmissions = Map.fromListWith (<>) . fmap procCorrector
+    where 
+      procCorrector :: Entity Submission -> (UserId , (Max (Maybe UTCTime)))
+      procCorrector = (,) <$> fromJust . submissionRatingBy . entityVal 
+                          <*> Max . submissionRatingAssigned . entityVal
+      

src/Jobs/Handler/QueueNotification.hs

@@ -46,6 +46,7 @@ determineNotificationCandidates NotificationSheetInactive{..} = E.select . E.fro
   E.on $ lecturer E.^. LecturerUser   E.==. user E.^. UserId
   E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
   return user
+determineNotificationCandidates NotificationCorrectionsAssigned{..} = selectList [UserId ==. nUser] [] 
   
 classifyNotification :: Notification -> DB NotificationTrigger
 classifyNotification NotificationSubmissionRated{..} = do
@@ -56,6 +57,6 @@ classifyNotification NotificationSubmissionRated{..} = do
 classifyNotification NotificationSheetActive{} = return NTSheetActive
 classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive
 classifyNotification NotificationSheetInactive{} = return NTSheetInactive
-
+classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned
 
 

src/Jobs/Handler/SendNotification.hs

@@ -15,6 +15,7 @@ import Jobs.Types
 import Jobs.Handler.SendNotification.SubmissionRated
 import Jobs.Handler.SendNotification.SheetActive
 import Jobs.Handler.SendNotification.SheetInactive
+import Jobs.Handler.SendNotification.CorrectionsAssigned
 
 
 dispatchJobSendNotification :: UserId -> Notification -> Handler ()

src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE NoImplicitPrelude
+           , RecordWildCards
+           , NamedFieldPuns
+           , TemplateHaskell
+           , OverloadedStrings
+  #-}
+
+module Jobs.Handler.SendNotification.CorrectionsAssigned
+  ( dispatchNotificationCorrectionsAssigned
+  ) where
+
+import Import
+
+import Utils.Lens
+import Handler.Utils.Mail
+
+import Text.Hamlet
+import qualified Data.CaseInsensitive as CI
+
+dispatchNotificationCorrectionsAssigned :: UserId -> SheetId -> UserId -> Handler ()
+dispatchNotificationCorrectionsAssigned  nUser nSheet jRecipient = userMailT jRecipient $ do
+  (Course{..}, Sheet{..}, nbrSubs) <- liftHandlerT . runDB $ do
+    sheet <- getJust nSheet
+    course <- belongsToJust sheetCourse sheet
+    nbrSubs <- count [ SubmissionSheet ==. nSheet
+                     , SubmissionRatingBy ==. Just nUser
+                     , SubmissionRatingTime ==. Nothing
+                     ]
+    return (course, sheet, nbrSubs)
+  setSubjectI $ MsgMailSubjectSheetActive courseShorthand sheetName
+
+  MsgRenderer mr <- getMailMsgRenderer
+  let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
+      tid = courseTerm
+      ssh = courseSchool
+      csh = courseShorthand
+      shn = sheetName
+
+  addAlternatives $ do
+    providePreferredAlternative ($(ihamletFile "templates/mail/correctionsAssigned.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

src/Jobs/Types.hs

@@ -30,6 +30,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                   | NotificationSheetActive { nSheet :: SheetId }
                   | NotificationSheetSoonInactive { nSheet :: SheetId }
                   | NotificationSheetInactive { nSheet :: SheetId }
+                  | NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId }
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 
 instance Hashable Job

src/Model/Types.hs

@@ -489,6 +489,7 @@ data NotificationTrigger = NTSubmissionRatedGraded
                          | NTSheetActive
                          | NTSheetSoonInactive
                          | NTSheetInactive
+                         | NTCorrectionsAssigned
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 
 instance Universe NotificationTrigger
@@ -518,6 +519,7 @@ instance Default NotificationSettings where
     NTSheetActive -> True
     NTSheetSoonInactive -> False
     NTSheetInactive -> True
+    NTCorrectionsAssigned -> True
 
 instance ToJSON NotificationSettings where
   toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF

src/Settings.hs

@@ -89,6 +89,7 @@ data AppSettings = AppSettings
     , appJobCronInterval        :: NominalDiffTime
     , appJobStaleThreshold      :: NominalDiffTime
     , appNotificationRateLimit  :: NominalDiffTime
+    , appNotificationCollateDelay :: NominalDiffTime
 
     , appInitialLogSettings     :: LogSettings
 
@@ -293,6 +294,7 @@ instance FromJSON AppSettings where
         appJobCronInterval        <- o .:  "job-cron-interval"
         appJobStaleThreshold      <- o .:  "job-stale-threshold"
         appNotificationRateLimit  <- o .:  "notification-rate-limit"
+        appNotificationCollateDelay <- o .: "notification-collate-delay"
 
         appReloadTemplates        <- o .:? "reload-templates" .!= defaultDev
         appMutableStatic          <- o .:? "mutable-static"   .!= defaultDev

templates/mail/correctionsAssigned.hamlet

@@ -0,0 +1,17 @@
+$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>
+      _{MsgMailCorrectionsAssignedIntro (CI.original courseName) termDesc sheetName nbrSubs}
+    <p>
+      <a href=@{CorrectionsR}>
+        _{MsgCorrectionsTitle}