diff --git a/config/settings.yml b/config/settings.yml
index 96e378b69..e8516a171 100644
--- a/config/settings.yml
+++ b/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"
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index a3cb7f570..89d0338fe 100644
--- a/messages/uniworx/de.msg
+++ b/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}"
diff --git a/src/Foundation.hs b/src/Foundation.hs
index d0a98d10c..56f319f81 100644
--- a/src/Foundation.hs
+++ b/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)
diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs
index 0610e459b..361c6005b 100644
--- a/src/Jobs/Crontab.hs
+++ b/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
+
diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs
index e37859e70..024d57682 100644
--- a/src/Jobs/Handler/QueueNotification.hs
+++ b/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
diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs
index 39598368b..a554bcfa8 100644
--- a/src/Jobs/Handler/SendNotification.hs
+++ b/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 ()
diff --git a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs
new file mode 100644
index 000000000..324b26695
--- /dev/null
+++ b/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))
diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs
index c80ee9ecf..63b947a69 100644
--- a/src/Jobs/Types.hs
+++ b/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
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 9ba9a8e43..b4d3a41c5 100644
--- a/src/Model/Types.hs
+++ b/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
diff --git a/src/Settings.hs b/src/Settings.hs
index 9ba5e40ca..492bc0429 100644
--- a/src/Settings.hs
+++ b/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
diff --git a/templates/mail/correctionsAssigned.hamlet b/templates/mail/correctionsAssigned.hamlet
new file mode 100644
index 000000000..1fda94c92
--- /dev/null
+++ b/templates/mail/correctionsAssigned.hamlet
@@ -0,0 +1,17 @@
+$newline never
+\
+
+
+
+