fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(notifications): sheet-hint & sheet-solution

Browse Source
This commit is contained in:
Gregor Kleen 2020-05-25 16:07:49 +02:00
parent 6711173687
commit f11b215773
11 changed files with 146 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
messages/uniworx/de-de-formal.msg
View File

@ -909,6 +909,12 @@ MailSubmissionUserDeletedOtherIntro displayName@UserDisplayName coursen@CourseNa
MailSubjectSheetActive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} wurde herausgegeben
MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie können nun #{sheetName} im Kurs #{courseName} (#{termDesc}) herunterladen.
MailSubjectSheetHint csh@CourseShorthand sheetName@SheetName: Hinweise für #{sheetName} in #{csh} wurden herausgegeben
MailSheetHintIntro courseName@Text termDesc@Text sheetName@SheetName: Sie können nun die Hinweise für #{sheetName} im Kurs #{courseName} (#{termDesc}) herunterladen.
MailSubjectSheetSolution csh@CourseShorthand sheetName@SheetName: Lösungen für #{sheetName} in #{csh} wurden herausgegeben
MailSheetSolutionIntro courseName@Text termDesc@Text sheetName@SheetName: Sie können nun die Lösungen für #{sheetName} im Kurs #{courseName} (#{termDesc}) herunterladen.
MailSubjectCourseRegistered csh@CourseShorthand: Sie wurden zu #{csh} angemeldet
MailSubjectCourseRegisteredOther displayName@Text csh@CourseShorthand: #{displayName} wurde zu #{csh} angemeldet
MailCourseRegisteredIntro courseName@Text termDesc@Text: Sie wurden im Kurs #{courseName} (#{termDesc}) angemeldet.
@ -1035,6 +1041,8 @@ SheetTypeArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName r
NotificationTriggerSubmissionRatedGraded: Meine Abgabe in einem gewerteten Übungsblatt wurde korrigiert
NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert
NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen
NotificationTriggerSheetHint: Ich kann die Hinweise für ein Übungsblatt herunterladen
NotificationTriggerSheetSolution: Ich kann die Lösung für ein Übungsblatt herunterladen
NotificationTriggerSheetSoonInactive: Ich kann ein Übungsblatt bald nicht mehr abgeben
NotificationTriggerSheetInactive: Abgabezeitraum eines meiner Übungsblätter ist abgelaufen
NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugeteilt

8
messages/uniworx/en-eu.msg
View File

@ -909,6 +909,12 @@ MailSubmissionUserDeletedOtherIntro displayName coursen shn termDesc: #{displayN
MailSubjectSheetActive csh sheetName: #{sheetName} in #{csh} was released
MailSheetActiveIntro courseName termDesc sheetName: You may now download #{sheetName} for #{courseName} (#{termDesc}).
MailSubjectSheetHint csh sheetName: Hints for #{sheetName} in #{csh} have been released
MailSheetHintIntro courseName termDesc sheetName: You may now download the hints for #{sheetName} in #{courseName} (#{termDesc}).
MailSubjectSheetSolution csh sheetName: Solutions for #{sheetName} in #{csh} have been released
MailSheetSolutionIntro courseName termDesc sheetName: You may now download the solutions for #{sheetName} in #{courseName} (#{termDesc}).
MailSubjectCourseRegistered csh: You were enrolled for #{csh}
MailSubjectCourseRegisteredOther displayName csh: #{displayName} was enrolled for #{csh}
MailCourseRegisteredIntro courseName termDesc: You were enrolled for the course “#{courseName}” (#{termDesc})
@ -1036,6 +1042,8 @@ SheetTypeArchiveName tid ssh csh shn renderedSft: #{foldCase (termToText (unTerm
NotificationTriggerSubmissionRatedGraded: My submission for an exercise sheet was marked (not purely informational)
NotificationTriggerSubmissionRated: My submission for an exercise sheet was marked
NotificationTriggerSheetActive: I can now download a new exercise sheet
NotificationTriggerSheetHint: I can now download the hints for an exercise sheet
NotificationTriggerSheetSolution: I can now download the solutions for an exercise sheet
NotificationTriggerSheetSoonInactive: I will soon no longer be able to submit for an exercise sheet
NotificationTriggerSheetInactive: The submission period for one of my exercise sheets is over
NotificationTriggerCorrectionsAssigned: I was assigned corrections

2
src/Handler/Profile.hs
View File

@ -196,6 +196,8 @@ notificationForm template = wFormToAForm $ do
NTSubmissionUserDeleted -> Just NTKSubmissionUser
NTSubmissionEdited -> Just NTKSubmissionUser
NTSheetActive -> Just NTKCourseParticipant
NTSheetHint -> Just NTKCourseParticipant
NTSheetSolution -> Just NTKCourseParticipant
NTSheetSoonInactive -> Just NTKCourseParticipant
NTSheetInactive -> Just NTKCourseLecturer
NTCorrectionsAssigned -> Just NTKCorrector

24
src/Jobs/Crontab.hs
View File

@ -157,7 +157,7 @@ determineCrontab = execWriterT $ do
, cronNotAfter = Left syncWithin
}
| otherwise
-> return ()
-> return ()
let
@ -171,6 +171,28 @@ determineCrontab = execWriterT $ do
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = Right $ maybe CronNotScheduled (CronTimestamp . utcToLocalTimeTZ appTZ) sheetActiveTo
}
for_ sheetHintFrom $ \hFrom -> maybeT (return ()) $ do
guard $ maybe True (\aFrom -> abs (diffUTCTime aFrom hFrom) > 300) sheetActiveFrom
guardM . lift . lift $ exists [SheetFileType ==. SheetHint, SheetFileSheet ==. nSheet]
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationSheetHint{..})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ hFrom
, cronRepeat = CronRepeatNever
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = Right CronNotScheduled
}
for_ sheetSolutionFrom $ \hFrom -> maybeT (return ()) $ do
guard $ maybe True (\aFrom -> abs (diffUTCTime aFrom hFrom) > 300) sheetActiveFrom
guardM . lift . lift $ exists [SheetFileType ==. SheetSolution, SheetFileSheet ==. nSheet]
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationSheetSolution{..})
Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ hFrom
, cronRepeat = CronRepeatNever
, cronRateLimit = appNotificationRateLimit
, cronNotAfter = Right CronNotScheduled
}
for_ sheetActiveTo $ \aTo -> do
tell $ HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..})

16
src/Jobs/Handler/QueueNotification.hs
View File

@ -39,6 +39,20 @@ determineNotificationCandidates NotificationSheetActive{..}
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
return user
determineNotificationCandidates NotificationSheetHint{..}
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
return user
determineNotificationCandidates NotificationSheetSolution{..}
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
return user
determineNotificationCandidates NotificationSheetSoonInactive{..}
= E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
@ -254,6 +268,8 @@ classifyNotification NotificationSubmissionRated{..} = do
NotGraded -> NTSubmissionRated
_other -> NTSubmissionRatedGraded
classifyNotification NotificationSheetActive{} = return NTSheetActive
classifyNotification NotificationSheetHint{} = return NTSheetHint
classifyNotification NotificationSheetSolution{} = return NTSheetSolution
classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive
classifyNotification NotificationSheetInactive{} = return NTSheetInactive
classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned

40
src/Jobs/Handler/SendNotification/SheetActive.hs
View File

@ -2,6 +2,8 @@
module Jobs.Handler.SendNotification.SheetActive
( dispatchNotificationSheetActive
, dispatchNotificationSheetHint
, dispatchNotificationSheetSolution
) where
import Import
@ -12,7 +14,7 @@ import Jobs.Handler.SendNotification.Utils
import Text.Hamlet
import qualified Data.CaseInsensitive as CI
dispatchNotificationSheetActive :: SheetId -> UserId -> Handler ()
dispatchNotificationSheetActive, dispatchNotificationSheetHint, dispatchNotificationSheetSolution :: SheetId -> UserId -> Handler ()
dispatchNotificationSheetActive nSheet jRecipient = userMailT jRecipient $ do
(Course{..}, Sheet{..}) <- liftHandler . runDB $ do
sheet <- getJust nSheet
@ -31,3 +33,39 @@ dispatchNotificationSheetActive nSheet jRecipient = userMailT jRecipient $ do
editNotifications <- mkEditNotifications jRecipient
addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
dispatchNotificationSheetHint nSheet jRecipient = userMailT jRecipient $ do
(Course{..}, Sheet{..}) <- liftHandler . runDB $ do
sheet <- getJust nSheet
course <- belongsToJust sheetCourse sheet
return (course, sheet)
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectSheetHint courseShorthand sheetName
MsgRenderer mr <- getMailMsgRenderer
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
tid = courseTerm
ssh = courseSchool
csh = courseShorthand
shn = sheetName
editNotifications <- mkEditNotifications jRecipient
addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetHint.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
dispatchNotificationSheetSolution nSheet jRecipient = userMailT jRecipient $ do
(Course{..}, Sheet{..}) <- liftHandler . runDB $ do
sheet <- getJust nSheet
course <- belongsToJust sheetCourse sheet
return (course, sheet)
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectSheetSolution courseShorthand sheetName
MsgRenderer mr <- getMailMsgRenderer
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
tid = courseTerm
ssh = courseSchool
csh = courseShorthand
shn = sheetName
editNotifications <- mkEditNotifications jRecipient
addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetSolution.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))

2
src/Jobs/Types.hs
View File

@ -85,6 +85,8 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
| NotificationSheetActive { nSheet :: SheetId }
| NotificationSheetSoonInactive { nSheet :: SheetId }
| NotificationSheetInactive { nSheet :: SheetId }
| NotificationSheetHint { nSheet :: SheetId }
| NotificationSheetSolution { nSheet :: SheetId }
| NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId }
| NotificationCorrectionsNotDistributed { nSheet :: SheetId }
| NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) }

2
src/Model/Types/Mail.hs
View File

@ -28,6 +28,8 @@ data NotificationTrigger
| NTSubmissionUserCreated
| NTSubmissionUserDeleted
| NTSheetActive
| NTSheetHint
| NTSheetSolution
| NTSheetSoonInactive
| NTSheetInactive
| NTCorrectionsAssigned

5
templates/mail/sheetActive.hamlet
View File

@ -15,4 +15,7 @@ $newline never
<p>
<a href=@{CSheetR tid ssh csh shn SShowR}>
#{sheetName}
^{editNotifications}
<p>
<a href=@{CSheetR tid ssh csh shn (SZipR SheetExercise)}>
_{MsgSheetExercise}
^{editNotifications}

21
templates/mail/sheetHint.hamlet Normal file
View File

@ -0,0 +1,21 @@
$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>
_{MsgMailSheetSolutionIntro (CI.original courseName) termDesc sheetName}
<p>
<a href=@{CSheetR tid ssh csh shn SShowR}>
#{sheetName}
<p>
<a href=@{CSheetR tid ssh csh shn (SZipR SheetSolution)}>
_{MsgSheetSolution}
^{editNotifications}

21
templates/mail/sheetSolution.hamlet Normal file
View File

@ -0,0 +1,21 @@
$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>
_{MsgMailSheetHintIntro (CI.original courseName) termDesc sheetName}
<p>
<a href=@{CSheetR tid ssh csh shn SShowR}>
#{sheetName}
<p>
<a href=@{CSheetR tid ssh csh shn (SZipR SheetHint)}>
_{MsgSheetHint}
^{editNotifications}