Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX
This commit is contained in:
commit
c24370b7cc
6
.vscode/tasks.json
vendored
6
.vscode/tasks.json
vendored
@ -6,7 +6,11 @@
|
||||
{
|
||||
"label": "echo",
|
||||
"type": "shell",
|
||||
"command": "echo Hello"
|
||||
"command": "echo Hello",
|
||||
"group": {
|
||||
"kind": "build",
|
||||
"isDefault": true
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
@ -83,6 +83,10 @@ The following Description applies to Ubuntu or similar.
|
||||
ldap: https://wiki.ubuntuusers.de/OpenLDAP_ab_Precise/
|
||||
|
||||
|
||||
Instead of run.sh, use:
|
||||
stack build --flag uniworx:dev --flag uniworx:library-only
|
||||
|
||||
|
||||
***
|
||||
|
||||
# PostgreSQL
|
||||
|
||||
@ -24,6 +24,8 @@ 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
|
||||
notification-expiration: 259201
|
||||
|
||||
log-settings:
|
||||
log-detailed: "_env:DETAILED_LOGGING:false"
|
||||
|
||||
@ -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
|
||||
@ -343,8 +343,11 @@ MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{co
|
||||
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.
|
||||
|
||||
MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden
|
||||
MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Dia Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze.
|
||||
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: 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
|
||||
|
||||
@ -371,7 +374,9 @@ SheetFiles: Übungsblatt-Dateien
|
||||
NotificationTriggerSubmissionRatedGraded: Meine Abgabe in einem gewerteten Übungsblatt wurde korrigiert
|
||||
NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert
|
||||
NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen
|
||||
NotificationTriggerSheetInactive: Ich kann ein Übungsblatt bald nicht mehr abgeben
|
||||
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}"
|
||||
@ -399,6 +404,7 @@ HelpEMail: E-Mail
|
||||
HelpRequest: Supportanfrage / Verbesserungsvorschlag
|
||||
HelpProblemPage: Problematische Seite
|
||||
HelpIntroduction: Wenn Ihnen die Benutzung dieser Webseite Schwierigkeiten bereitet oder Sie einen verbesserbaren Umstand entdecken bitten wir Sie uns das zu melden, auch wenn Sie Ihr Problem bereits selbst lösen konnten. Wir passen die Seite ständig an und versuchen sie auch für zukünftige Benutzer so einsichtig wie möglich zu halten.
|
||||
HelpSent: Ihre Supportanfrage wurde weitergeleitet.
|
||||
|
||||
SystemMessageFrom: Sichtbar ab
|
||||
SystemMessageTo: Sichtbar bis
|
||||
|
||||
@ -255,8 +255,9 @@ instance RenderMessage UniWorX NotificationTrigger where
|
||||
NTSubmissionRatedGraded -> MsgNotificationTriggerSubmissionRatedGraded
|
||||
NTSubmissionRated -> MsgNotificationTriggerSubmissionRated
|
||||
NTSheetActive -> MsgNotificationTriggerSheetActive
|
||||
NTSheetInactive -> MsgNotificationTriggerSheetInactive
|
||||
|
||||
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)
|
||||
|
||||
@ -297,7 +297,9 @@ postHelpR = do
|
||||
, jHelpRequest = hfRequest
|
||||
, jRequestTime = now
|
||||
, jReferer = hfReferer }
|
||||
redirect $ HelpR
|
||||
-- redirect $ HelpR
|
||||
addMessageI Success MsgHelpSent
|
||||
return ()
|
||||
{-selectRep $ do
|
||||
provideJson ()
|
||||
provideRep (redirect $ HelpR :: Handler Html) -}
|
||||
|
||||
@ -85,8 +85,7 @@ data SheetForm = SheetForm
|
||||
{ sfName :: SheetName
|
||||
, sfDescription :: Maybe Html
|
||||
, sfType :: SheetType
|
||||
, sfGrouping :: SheetGroup
|
||||
, sfMarkingText :: Maybe Html
|
||||
, sfGrouping :: SheetGroup
|
||||
, sfVisibleFrom :: Maybe UTCTime
|
||||
, sfActiveFrom :: UTCTime
|
||||
, sfActiveTo :: UTCTime
|
||||
@ -98,6 +97,7 @@ data SheetForm = SheetForm
|
||||
, sfSolutionFrom :: Maybe UTCTime
|
||||
, sfSolutionF :: Maybe (Source Handler (Either FileId File))
|
||||
, sfMarkingF :: Maybe (Source Handler (Either FileId File))
|
||||
, sfMarkingText :: Maybe Html
|
||||
-- Keine SheetId im Formular!
|
||||
}
|
||||
|
||||
@ -120,8 +120,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
|
||||
<$> areq ciField (fslI MsgSheetName) (sfName <$> template)
|
||||
<*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template)
|
||||
<*> sheetTypeAFormReq (fslI MsgSheetType) (sfType <$> template)
|
||||
<*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template)
|
||||
<*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template)
|
||||
<*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgSheetVisibleFrom
|
||||
& setTooltip MsgSheetVisibleFromTip)
|
||||
((sfVisibleFrom <$> template) <|> pure (Just ctime))
|
||||
@ -141,6 +140,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
|
||||
<*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
|
||||
<*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarking
|
||||
& setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template)
|
||||
<*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template)
|
||||
<* submitButton
|
||||
return $ case result of
|
||||
FormSuccess sheetResult
|
||||
@ -159,7 +159,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
|
||||
] ]
|
||||
|
||||
getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getSheetListR tid ssh csh = do
|
||||
getSheetListR tid ssh csh = do
|
||||
muid <- maybeAuthId
|
||||
Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
let
|
||||
@ -419,8 +419,7 @@ getSheetNewR tid ssh csh = do
|
||||
{ sfName = stepTextCounterCI sheetName
|
||||
, sfDescription = sheetDescription
|
||||
, sfType = sheetType
|
||||
, sfGrouping = sheetGrouping
|
||||
, sfMarkingText = sheetMarkingText
|
||||
, sfGrouping = sheetGrouping
|
||||
, sfVisibleFrom = addOneWeek <$> sheetVisibleFrom
|
||||
, sfActiveFrom = addOneWeek sheetActiveFrom
|
||||
, sfActiveTo = addOneWeek sheetActiveTo
|
||||
@ -432,6 +431,7 @@ getSheetNewR tid ssh csh = do
|
||||
, sfSolutionFrom = addOneWeek <$> sheetSolutionFrom
|
||||
, sfSolutionF = Nothing
|
||||
, sfMarkingF = Nothing
|
||||
, sfMarkingText = sheetMarkingText
|
||||
}
|
||||
_other -> Nothing
|
||||
let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
|
||||
@ -454,8 +454,7 @@ getSEditR tid ssh csh shn = do
|
||||
{ sfName = sheetName
|
||||
, sfDescription = sheetDescription
|
||||
, sfType = sheetType
|
||||
, sfGrouping = sheetGrouping
|
||||
, sfMarkingText = sheetMarkingText
|
||||
, sfGrouping = sheetGrouping
|
||||
, sfVisibleFrom = sheetVisibleFrom
|
||||
, sfActiveFrom = sheetActiveFrom
|
||||
, sfActiveTo = sheetActiveTo
|
||||
@ -467,6 +466,7 @@ getSEditR tid ssh csh shn = do
|
||||
, sfSolutionFrom = sheetSolutionFrom
|
||||
, sfSolutionF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetSolution
|
||||
, sfMarkingF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetMarking
|
||||
, sfMarkingText = sheetMarkingText
|
||||
}
|
||||
let action newSheet = do
|
||||
replaceRes <- myReplaceUnique sid $ newSheet
|
||||
|
||||
@ -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
|
||||
|
||||
@ -57,11 +64,43 @@ determineCrontab = execWriterT $ do
|
||||
, cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
|
||||
}
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max sheetActiveFrom $ addUTCTime (-nominalDay) sheetActiveTo
|
||||
, cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
|
||||
}
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
}
|
||||
|
||||
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
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
}
|
||||
| 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
|
||||
|
||||
|
||||
@ -36,12 +36,18 @@ determineNotificationCandidates NotificationSheetActive{..} = E.select . E.from
|
||||
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
||||
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
||||
return user
|
||||
determineNotificationCandidates NotificationSheetInactive{..} = E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> do
|
||||
determineNotificationCandidates NotificationSheetSoonInactive{..} = E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> do
|
||||
E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
|
||||
E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
|
||||
E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
|
||||
return user
|
||||
|
||||
determineNotificationCandidates NotificationSheetInactive{..} = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do
|
||||
E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
|
||||
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
|
||||
Sheet{sheetType} <- belongsToJust submissionSheet =<< getJust nSubmission
|
||||
@ -49,6 +55,8 @@ classifyNotification NotificationSubmissionRated{..} = do
|
||||
NotGraded -> NTSubmissionRated
|
||||
_other -> NTSubmissionRatedGraded
|
||||
classifyNotification NotificationSheetActive{} = return NTSheetActive
|
||||
classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive
|
||||
classifyNotification NotificationSheetInactive{} = return NTSheetInactive
|
||||
classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned
|
||||
|
||||
|
||||
|
||||
@ -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 ()
|
||||
|
||||
41
src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs
Normal file
41
src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs
Normal file
@ -0,0 +1,41 @@
|
||||
{-# 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 = 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)
|
||||
when (nbrSubs > 0) . userMailT jRecipient $ do
|
||||
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))
|
||||
@ -6,7 +6,8 @@
|
||||
#-}
|
||||
|
||||
module Jobs.Handler.SendNotification.SheetInactive
|
||||
( dispatchNotificationSheetInactive
|
||||
( dispatchNotificationSheetSoonInactive
|
||||
, dispatchNotificationSheetInactive
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -17,6 +18,24 @@ import Handler.Utils.Mail
|
||||
import Text.Hamlet
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
dispatchNotificationSheetSoonInactive :: SheetId -> UserId -> Handler ()
|
||||
dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $ do
|
||||
(Course{..}, Sheet{..}) <- liftHandlerT . runDB $ do
|
||||
sheet <- getJust nSheet
|
||||
course <- belongsToJust sheetCourse sheet
|
||||
return (course, sheet)
|
||||
setSubjectI $ MsgMailSubjectSheetSoonInactive 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/sheetSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
|
||||
dispatchNotificationSheetInactive :: SheetId -> UserId -> Handler ()
|
||||
dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do
|
||||
(Course{..}, Sheet{..}) <- liftHandlerT . runDB $ do
|
||||
@ -34,3 +53,4 @@ dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do
|
||||
|
||||
addAlternatives $ do
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
|
||||
@ -24,11 +24,13 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
|
||||
| JobHelpRequest { jSender :: Either (Maybe Email) UserId
|
||||
, jRequestTime :: UTCTime
|
||||
, jHelpRequest :: Text, jReferer :: Maybe Text }
|
||||
| JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings }
|
||||
| JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings }
|
||||
deriving (Eq, Ord, Show, Read, Generic, Typeable)
|
||||
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
|
||||
|
||||
@ -487,7 +487,9 @@ derivePersistFieldJSON ''Value
|
||||
data NotificationTrigger = NTSubmissionRatedGraded
|
||||
| NTSubmissionRated
|
||||
| NTSheetActive
|
||||
| NTSheetSoonInactive
|
||||
| NTSheetInactive
|
||||
| NTCorrectionsAssigned
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
|
||||
instance Universe NotificationTrigger
|
||||
@ -515,7 +517,9 @@ instance Default NotificationSettings where
|
||||
NTSubmissionRatedGraded -> True
|
||||
NTSubmissionRated -> False
|
||||
NTSheetActive -> True
|
||||
NTSheetInactive -> False
|
||||
NTSheetSoonInactive -> False
|
||||
NTSheetInactive -> True
|
||||
NTCorrectionsAssigned -> True
|
||||
|
||||
instance ToJSON NotificationSettings where
|
||||
toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF
|
||||
|
||||
@ -89,6 +89,8 @@ data AppSettings = AppSettings
|
||||
, appJobCronInterval :: NominalDiffTime
|
||||
, appJobStaleThreshold :: NominalDiffTime
|
||||
, appNotificationRateLimit :: NominalDiffTime
|
||||
, appNotificationCollateDelay :: NominalDiffTime
|
||||
, appNotificationExpiration :: NominalDiffTime
|
||||
|
||||
, appInitialLogSettings :: LogSettings
|
||||
|
||||
@ -293,6 +295,8 @@ instance FromJSON AppSettings where
|
||||
appJobCronInterval <- o .: "job-cron-interval"
|
||||
appJobStaleThreshold <- o .: "job-stale-threshold"
|
||||
appNotificationRateLimit <- o .: "notification-rate-limit"
|
||||
appNotificationCollateDelay <- o .: "notification-collate-delay"
|
||||
appNotificationExpiration <- o .: "notification-expiration"
|
||||
|
||||
appReloadTemplates <- o .:? "reload-templates" .!= defaultDev
|
||||
appMutableStatic <- o .:? "mutable-static" .!= defaultDev
|
||||
|
||||
17
templates/mail/correctionsAssigned.hamlet
Normal file
17
templates/mail/correctionsAssigned.hamlet
Normal file
@ -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}
|
||||
17
templates/mail/sheetSoonInactive.hamlet
Normal file
17
templates/mail/sheetSoonInactive.hamlet
Normal file
@ -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>
|
||||
_{MsgMailSheetSoonInactiveIntro (CI.original courseName) termDesc sheetName}
|
||||
<p>
|
||||
<a href=@{CSheetR tid ssh csh shn SShowR}>
|
||||
#{sheetName}
|
||||
@ -5,12 +5,6 @@ $maybe descr <- sheetDescription sheet
|
||||
<p>
|
||||
#{descr}
|
||||
|
||||
$maybe marking <- sheetMarkingText sheet
|
||||
<section>
|
||||
<h2>_{MsgSheetMarking}
|
||||
<p>
|
||||
#{marking}
|
||||
|
||||
<section>
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>_{MsgSheetActiveFrom}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user