diff --git a/models/users.model b/models/users.model index db8618863..fe2560974 100644 --- a/models/users.model +++ b/models/users.model @@ -86,7 +86,7 @@ UserGroupMember UserSupervisor supervisor UserId -- multiple supervisor per trainee possible user UserId - rerouteNotifications Bool + rerouteNotifications Bool -- User can be his own supervisor to receive notifications as well UniqueUserSupervisor supervisor user deriving Generic \ No newline at end of file diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 5439fd45f..3086f65c7 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -321,7 +321,7 @@ lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Enti , E.SqlExpr (Entity User) , E.SqlExpr (Maybe (Entity LmsUser)) , E.SqlExpr (Maybe (Entity PrintJob)) - , E.SqlExpr (E.Value (Maybe [Maybe UTCTime])) + , E.SqlExpr (E.Value (Maybe [Maybe UTCTime])) -- Nutzbar zum sortieren und filtern! ) lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` printJob) = do -- E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting; @@ -334,9 +334,11 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.Left E.&&. ((printJob E.?. PrintJobCreated) E.<. E.just (otherpj E.^. PrintJobCreated)) ) E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser - E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause + E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause, which does not work E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification + -- TODO: decide whether to use subSelect or LeftOuterJoin and delete the other! + -- Letztes Datum anzeigen, wenn mehrere, dann diese in klickbaren Tooltip verstecken! let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do E.where_ $ E.isJust (pj E.^. PrintJobLmsUser) E.&&. ((lmsUser E.?. LmsUserIdent) E.==. (pj E.^. PrintJobLmsUser)) diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index 82ded9c15..f4b1ac754 100644 --- a/src/Handler/Utils/Mail.hs +++ b/src/Handler/Utils/Mail.hs @@ -5,7 +5,7 @@ module Handler.Utils.Mail ( addRecipientsDB , userAddress, userAddressFrom - , userMailT + , userMailT, superMailT , addFileDB , addHtmlMarkdownAlternatives , addHtmlMarkdownAlternatives' @@ -73,6 +73,15 @@ userMailT uid mAct = do _mailTo .= pure (userAddress user) mAct + +superMailT :: ( MonadHandler m + , HandlerSite m ~ UniWorX + , MonadThrow m + , MonadUnliftIO m + ) => Maybe UserId -> UserId -> MailT m a -> m a +superMailT svr uid = userMailT $ fromMaybe uid svr + + addFileDB :: ( MonadMail m , HandlerSite m ~ UniWorX ) => FileReference -> m (Maybe MailObjectId) diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs index da5e6074f..e77b3c6cc 100644 --- a/src/Jobs/Handler/SendNotification.hs +++ b/src/Jobs/Handler/SendNotification.hs @@ -26,23 +26,22 @@ import Jobs.Handler.SendNotification.CourseRegistered import Jobs.Handler.SendNotification.SubmissionEdited import Jobs.Handler.SendNotification.Qualification -dispatchJobSendNotification :: UserId -> Notification -> JobHandler UniWorX -dispatchJobSendNotification jRecipient jNotification = JobHandlerException $ - $(dispatchTH ''Notification) jNotification jRecipient - {- -IDEAS: - 1) change type of dispatchNotificationfunctions to take another argument in addition to - jRecipient jNotificiation - 2) change mailT and sendPrintJob to account for supervisors + Notfications receive three arguments: + 1) addressee, the person for whom the message truly is + 2) type of notification to be send + 3) maybe supervisor, the person actually receiving the message + + + +-} + +- - TODO: check that we caught all calls to userMailT!!! dispatchJobSendNotification :: UserId -> Notification -> JobHandler UniWorX dispatchJobSendNotification jRecipient jNotification = JobHandlerException $ do - -- TODO: this is a bad idea, since all notifications use jRecipient to generate the message body, - -- thus supervisors would receive all notifications with their own name inside! superVs <- runDB $ selectList [UserSupervisorUser ==. jRecipient, UserSupervisorRerouteNotifications ==. True] [] if null superVs - then $(dispatchTH ''Notification) jNotification jRecipient + then $(dispatchTH ''Notification) jNotification jRecipient Nothing else forM_ superVs $ \Entity { entityVal = UserSupervisor { userSupervisorSupervisor = svr } } -> - $(dispatchTH ''Notification) jNotification svr --} \ No newline at end of file + $(dispatchTH ''Notification) jNotification jRecipient (Just svr) \ No newline at end of file diff --git a/src/Jobs/Handler/SendNotification/Allocation.hs b/src/Jobs/Handler/SendNotification/Allocation.hs index 747d05e4a..96551ec7f 100644 --- a/src/Jobs/Handler/SendNotification/Allocation.hs +++ b/src/Jobs/Handler/SendNotification/Allocation.hs @@ -26,8 +26,8 @@ import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E -dispatchNotificationAllocationStaffRegister :: Set AllocationId -> UserId -> Handler () -dispatchNotificationAllocationStaffRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do +dispatchNotificationAllocationStaffRegister :: Set AllocationId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationAllocationStaffRegister (otoList -> nAllocations) jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations replaceMailHeader "Auto-Submitted" $ Just "auto-generated" @@ -42,8 +42,8 @@ dispatchNotificationAllocationStaffRegister (otoList -> nAllocations) jRecipient singleRegisterDeadline = maybe True (flip all (allocs ^.. folded . _allocationStaffRegisterTo) . (==)) $ allocs ^? _head . _allocationStaffRegisterTo addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationStaffRegister.hamlet") -dispatchNotificationAllocationRegister :: Set AllocationId -> UserId -> Handler () -dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do +dispatchNotificationAllocationRegister :: Set AllocationId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations replaceMailHeader "Auto-Submitted" $ Just "auto-generated" @@ -58,7 +58,7 @@ dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient = us singleRegisterDeadline = maybe True (flip all (allocs ^.. folded . _allocationRegisterTo) . (==)) $ allocs ^? _head . _allocationRegisterTo addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationRegister.hamlet") -dispatchNotificationAllocationAllocation :: Set AllocationId -> UserId -> Handler () +dispatchNotificationAllocationAllocation :: Set AllocationId -> UserId -> Maybe UserId -> Handler () dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient = do courses <- fmap (nubOrdOn $ views _2 entityKey) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId @@ -97,7 +97,7 @@ dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient = addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationAllocation.hamlet") -dispatchNotificationAllocationUnratedApplications :: Set AllocationId -> UserId -> Handler () +dispatchNotificationAllocationUnratedApplications :: Set AllocationId -> UserId -> Maybe UserId -> Handler () dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRecipient = do courses <- fmap (nubOrdOn (views _2 entityKey) . over (traverse . _3) (fromIntegral . E.unValue)) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId @@ -142,8 +142,8 @@ dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRec addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet") -dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler () -dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do +dispatchNotificationAllocationResults :: AllocationId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationAllocationResults nAllocation jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Allocation{..}, lecturerResults, warnSubstituteCourses, participantResults) <- liftHandler . runDB $ do allocation <- getJust nAllocation @@ -194,8 +194,8 @@ dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipi where studentFaqItems' = [FAQAllocationNoPlaces] -dispatchNotificationAllocationNewCourse :: AllocationId -> CourseId -> UserId -> Handler () -dispatchNotificationAllocationNewCourse nAllocation nCourse jRecipient = userMailT jRecipient $ do +dispatchNotificationAllocationNewCourse :: AllocationId -> CourseId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationAllocationNewCourse nAllocation nCourse jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Allocation{..}, Course{..}, hasApplied) <- liftHandler . runDB $ (,,) <$> getJust nAllocation <*> getJust nCourse diff --git a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs index 125310edf..148f33d7a 100644 --- a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs +++ b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs @@ -16,7 +16,7 @@ import Handler.Utils.Mail import Text.Hamlet import qualified Data.CaseInsensitive as CI -dispatchNotificationCorrectionsAssigned :: UserId -> SheetId -> UserId -> Handler () +dispatchNotificationCorrectionsAssigned :: UserId -> SheetId -> UserId -> Maybe UserId -> Handler () dispatchNotificationCorrectionsAssigned nUser nSheet jRecipient = do (Course{..}, Sheet{..}, nbrSubs) <- runDB $ do sheet <- getJust nSheet diff --git a/src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs b/src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs index 74ee13c04..e3302ce8d 100644 --- a/src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs +++ b/src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs @@ -13,7 +13,7 @@ import Handler.Utils.Mail import Text.Hamlet import qualified Data.CaseInsensitive as CI -dispatchNotificationCorrectionsNotDistributed :: SheetId -> UserId -> Handler () +dispatchNotificationCorrectionsNotDistributed :: SheetId -> UserId -> Maybe UserId -> Handler () dispatchNotificationCorrectionsNotDistributed nSheet jRecipient = do (Course{..}, Sheet{..}, nbrSubs) <- runDB $ do sheet <- getJust nSheet diff --git a/src/Jobs/Handler/SendNotification/CourseRegistered.hs b/src/Jobs/Handler/SendNotification/CourseRegistered.hs index bb519e978..0472fe279 100644 --- a/src/Jobs/Handler/SendNotification/CourseRegistered.hs +++ b/src/Jobs/Handler/SendNotification/CourseRegistered.hs @@ -16,8 +16,8 @@ import Jobs.Handler.SendNotification.Utils import Text.Hamlet import qualified Data.CaseInsensitive as CI -dispatchNotificationCourseRegistered :: UserId -> CourseId -> UserId -> Handler () -dispatchNotificationCourseRegistered nUser nCourse jRecipient = userMailT jRecipient $ do +dispatchNotificationCourseRegistered :: UserId -> CourseId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationCourseRegistered nUser nCourse jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (User{..}, Course{..}) <- liftHandler . runDB $ (,) <$> getJust nUser <*> getJust nCourse let isSelf = nUser == jRecipient diff --git a/src/Jobs/Handler/SendNotification/ExamActive.hs b/src/Jobs/Handler/SendNotification/ExamActive.hs index 18161e7e4..a1b80b5d1 100644 --- a/src/Jobs/Handler/SendNotification/ExamActive.hs +++ b/src/Jobs/Handler/SendNotification/ExamActive.hs @@ -18,8 +18,8 @@ import Jobs.Handler.SendNotification.Utils import Text.Hamlet import qualified Data.CaseInsensitive as CI -dispatchNotificationExamRegistrationActive :: ExamId -> UserId -> Handler () -dispatchNotificationExamRegistrationActive nExam jRecipient = userMailT jRecipient $ do +dispatchNotificationExamRegistrationActive :: ExamId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationExamRegistrationActive nExam jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Exam{..}) <- liftHandler . runDB $ do exam <- getJust nExam course <- belongsToJust examCourse exam @@ -38,8 +38,8 @@ dispatchNotificationExamRegistrationActive nExam jRecipient = userMailT jRecipie addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -dispatchNotificationExamRegistrationSoonInactive :: ExamId -> UserId -> Handler () -dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do +dispatchNotificationExamRegistrationSoonInactive :: ExamId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationExamRegistrationSoonInactive nExam jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Exam{..}) <- liftHandler . runDB $ do exam <- getJust nExam course <- belongsToJust examCourse exam @@ -58,8 +58,8 @@ dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jR addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -dispatchNotificationExamDeregistrationSoonInactive :: ExamId -> UserId -> Handler () -dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do +dispatchNotificationExamDeregistrationSoonInactive :: ExamId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Exam{..}) <- liftHandler . runDB $ do exam <- getJust nExam course <- belongsToJust examCourse exam diff --git a/src/Jobs/Handler/SendNotification/ExamOffice.hs b/src/Jobs/Handler/SendNotification/ExamOffice.hs index 65b1f4b3e..aafa6950c 100644 --- a/src/Jobs/Handler/SendNotification/ExamOffice.hs +++ b/src/Jobs/Handler/SendNotification/ExamOffice.hs @@ -21,8 +21,8 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Set as Set -dispatchNotificationExamOfficeExamResults :: ExamId -> UserId -> Handler () -dispatchNotificationExamOfficeExamResults nExam jRecipient = userMailT jRecipient $ do +dispatchNotificationExamOfficeExamResults :: ExamId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationExamOfficeExamResults nExam jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Exam{..}) <- liftHandler . runDB $ do exam <- getJust nExam course <- belongsToJust examCourse exam @@ -41,12 +41,12 @@ dispatchNotificationExamOfficeExamResults nExam jRecipient = userMailT jRecipien addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examOffice/examResults.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -dispatchNotificationExamOfficeExamResultsChanged :: Set ExamResultId -> UserId -> Handler () -dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient = do +dispatchNotificationExamOfficeExamResultsChanged :: Set ExamResultId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient jSupervisor = do entitiesExamResults <- runDB $ selectList [ ExamResultId <-. Set.toList nExamResults ] [] let exams = Set.fromList $ map (examResultExam . entityVal) entitiesExamResults - forM_ exams $ \nExam -> userMailT jRecipient $ do + forM_ exams $ \nExam -> superMailT jSupervisor jRecipient $ do (Course{..}, Exam{..}) <- liftHandler . runDB $ do exam <- getJust nExam course <- belongsToJust examCourse exam @@ -66,8 +66,8 @@ dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient = do addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examOffice/examResultsChanged.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -dispatchNotificationExamOfficeExternalExamResults :: ExternalExamId -> UserId -> Handler () -dispatchNotificationExamOfficeExternalExamResults nExternalExam jRecipient = userMailT jRecipient $ do +dispatchNotificationExamOfficeExternalExamResults :: ExternalExamId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationExamOfficeExternalExamResults nExternalExam jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do ExternalExam{..} <- liftHandler . runDB $ getJust nExternalExam replaceMailHeader "Auto-Submitted" $ Just "auto-generated" setSubjectI $ MsgMailSubjectExamOfficeExternalExamResults externalExamCourseName externalExamExamName diff --git a/src/Jobs/Handler/SendNotification/ExamResult.hs b/src/Jobs/Handler/SendNotification/ExamResult.hs index 7d598bf36..539ff089f 100644 --- a/src/Jobs/Handler/SendNotification/ExamResult.hs +++ b/src/Jobs/Handler/SendNotification/ExamResult.hs @@ -16,8 +16,8 @@ import Jobs.Handler.SendNotification.Utils import Text.Hamlet import qualified Data.CaseInsensitive as CI -dispatchNotificationExamResult :: ExamId -> UserId -> Handler () -dispatchNotificationExamResult nExam jRecipient = userMailT jRecipient $ do +dispatchNotificationExamResult :: ExamId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationExamResult nExam jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Exam{..}) <- liftHandler . runDB $ do exam <- getJust nExam course <- belongsToJust examCourse exam diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 9b16abc79..45bc4d855 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -26,8 +26,8 @@ import qualified Data.CaseInsensitive as CI import Text.Hamlet -dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler () -dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = userMailT jRecipient $ do +dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Maybe UserId -> Handler () +dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,) <$> getJust jRecipient <*> getJust nQualification @@ -44,11 +44,14 @@ dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = user editNotifications <- mkEditNotifications jRecipient - addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet") + -- if supervisor: + let inner = $(ihamletFile "templates/mail/qualificationExpiry.hamlet") + --addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/supervisor.hamlet") -- uses ^{inner} + addHtmlMarkdownAlternatives inner -dispatchNotificationQualificationExpired :: QualificationId -> Day -> UserId -> Handler () -dispatchNotificationQualificationExpired nQualification dExpired jRecipient = userMailT jRecipient $ do +dispatchNotificationQualificationExpired :: QualificationId -> Day -> UserId -> Maybe UserId -> Handler () +dispatchNotificationQualificationExpired nQualification dExpired jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,) <$> getJust jRecipient <*> getJust nQualification @@ -69,8 +72,8 @@ dispatchNotificationQualificationExpired nQualification dExpired jRecipient = us -- NOTE: qualificationRenewal expects that LmsUser already exists for recipient -dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler () -dispatchNotificationQualificationRenewal nQualification jRecipient = do +dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationQualificationRenewal nQualification jRecipient jSupervisor = do (recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}, Entity luid LmsUser{..}) <- runDB $ (,,,) <$> getJust jRecipient <*> getJust nQualification @@ -111,7 +114,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do $logErrorS "LMS" msg return False | otherwise = do - userMailT jRecipient $ do + superMailT jSupervisor jRecipient $ do replaceMailHeader "Auto-Submitted" $ Just "auto-generated" setSubjectI $ MsgMailSubjectQualificationRenewal qname whenIsJust attachment $ \afile -> diff --git a/src/Jobs/Handler/SendNotification/SheetActive.hs b/src/Jobs/Handler/SendNotification/SheetActive.hs index 7948fb988..2b2c69abf 100644 --- a/src/Jobs/Handler/SendNotification/SheetActive.hs +++ b/src/Jobs/Handler/SendNotification/SheetActive.hs @@ -18,8 +18,8 @@ import Jobs.Handler.SendNotification.Utils import Text.Hamlet import qualified Data.CaseInsensitive as CI -dispatchNotificationSheetActive, dispatchNotificationSheetHint, dispatchNotificationSheetSolution :: SheetId -> UserId -> Handler () -dispatchNotificationSheetActive nSheet jRecipient = userMailT jRecipient $ do +dispatchNotificationSheetActive, dispatchNotificationSheetHint, dispatchNotificationSheetSolution :: SheetId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationSheetActive nSheet jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Sheet{..}) <- liftHandler . runDB $ do sheet <- getJust nSheet course <- belongsToJust sheetCourse sheet @@ -37,7 +37,7 @@ dispatchNotificationSheetActive nSheet jRecipient = userMailT jRecipient $ do editNotifications <- mkEditNotifications jRecipient addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetActive.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -dispatchNotificationSheetHint nSheet jRecipient = userMailT jRecipient $ do +dispatchNotificationSheetHint nSheet jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Sheet{..}) <- liftHandler . runDB $ do sheet <- getJust nSheet course <- belongsToJust sheetCourse sheet @@ -55,7 +55,7 @@ dispatchNotificationSheetHint nSheet jRecipient = userMailT jRecipient $ do editNotifications <- mkEditNotifications jRecipient addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetHint.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -dispatchNotificationSheetSolution nSheet jRecipient = userMailT jRecipient $ do +dispatchNotificationSheetSolution nSheet jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Sheet{..}) <- liftHandler . runDB $ do sheet <- getJust nSheet course <- belongsToJust sheetCourse sheet diff --git a/src/Jobs/Handler/SendNotification/SheetInactive.hs b/src/Jobs/Handler/SendNotification/SheetInactive.hs index 6e26ad7c3..8db7f8833 100644 --- a/src/Jobs/Handler/SendNotification/SheetInactive.hs +++ b/src/Jobs/Handler/SendNotification/SheetInactive.hs @@ -19,8 +19,8 @@ import qualified Data.CaseInsensitive as CI import qualified Database.Esqueleto.Legacy as E -dispatchNotificationSheetSoonInactive :: SheetId -> UserId -> Handler () -dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $ do +dispatchNotificationSheetSoonInactive :: SheetId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationSheetSoonInactive nSheet jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Sheet{..}) <- liftHandler . runDB $ do sheet <- getJust nSheet course <- belongsToJust sheetCourse sheet @@ -39,8 +39,8 @@ dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $ addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetSoonInactive.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -dispatchNotificationSheetInactive :: SheetId -> UserId -> Handler () -dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do +dispatchNotificationSheetInactive :: SheetId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationSheetInactive nSheet jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Sheet{..}, nrSubs, nrSubmitters, nrPseudonyms, nrParticipants) <- liftHandler . runDB $ do sheet <- getJust nSheet course <- belongsToJust sheetCourse sheet diff --git a/src/Jobs/Handler/SendNotification/SubmissionEdited.hs b/src/Jobs/Handler/SendNotification/SubmissionEdited.hs index 94679e01a..c2b0b2183 100644 --- a/src/Jobs/Handler/SendNotification/SubmissionEdited.hs +++ b/src/Jobs/Handler/SendNotification/SubmissionEdited.hs @@ -22,8 +22,8 @@ import qualified Database.Esqueleto.Legacy as E import qualified Data.Text as Text -dispatchNotificationSubmissionEdited :: UserId -> SubmissionId -> UserId -> Handler () -dispatchNotificationSubmissionEdited nInitiator nSubmission jRecipient = userMailT jRecipient $ do +dispatchNotificationSubmissionEdited :: UserId -> SubmissionId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationSubmissionEdited nInitiator nSubmission jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (Course{..}, Sheet{..}, Submission{}, initiator, coSubmittors) <- liftHandler . runDB $ do submission <- getJust nSubmission sheet <- belongsToJust submissionSheet submission @@ -57,8 +57,8 @@ dispatchNotificationSubmissionEdited nInitiator nSubmission jRecipient = userMai addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionEdited.hamlet") -dispatchNotificationSubmissionUserCreated :: UserId -> SubmissionId -> UserId -> Handler () -dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMailT jRecipient $ do +dispatchNotificationSubmissionUserCreated :: UserId -> SubmissionId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (User{..}, Course{..}, Sheet{..}, Submission{}, coSubmittors) <- liftHandler . runDB $ do submission <- getJust nSubmission sheet <- belongsToJust submissionSheet submission @@ -97,8 +97,8 @@ dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMai addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionUserCreated.hamlet") -dispatchNotificationSubmissionUserDeleted :: UserId -> SheetId -> SubmissionId -> UserId -> Handler () -dispatchNotificationSubmissionUserDeleted nUser nSheet nSubmission jRecipient = userMailT jRecipient $ do +dispatchNotificationSubmissionUserDeleted :: UserId -> SheetId -> SubmissionId -> UserId -> Maybe UserId -> Handler () +dispatchNotificationSubmissionUserDeleted nUser nSheet nSubmission jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (User{..}, Course{..}, Sheet{..}, mSubmission, coSubmittors) <- liftHandler . runDB $ do submission <- get nSubmission diff --git a/src/Jobs/Handler/SendNotification/SubmissionRated.hs b/src/Jobs/Handler/SendNotification/SubmissionRated.hs index efbb0a5fc..23f5c2758 100644 --- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs +++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs @@ -17,7 +17,7 @@ import Text.Hamlet import qualified Data.CaseInsensitive as CI -dispatchNotificationSubmissionRated :: SubmissionId -> UserId -> Handler () +dispatchNotificationSubmissionRated :: SubmissionId -> UserId -> Maybe UserId -> Handler () dispatchNotificationSubmissionRated nSubmission jRecipient = maybeT_ $ do (Course{..}, Sheet{..}, Submission{..}, corrector, sheetTypeDesc, hasAccess, csid) <- lift . runDB $ do submission@Submission{submissionRatingBy} <- getJust nSubmission diff --git a/src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs b/src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs index 5296dd84e..ffb12c8d4 100644 --- a/src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs +++ b/src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs @@ -19,8 +19,8 @@ import Jobs.Handler.SendNotification.Utils import Text.Hamlet -- import qualified Data.CaseInsensitive as CI -dispatchNotificationUserAuthModeUpdate :: UserId -> AuthenticationMode -> UserId -> Handler () -dispatchNotificationUserAuthModeUpdate nUser _nOriginalAuthMode jRecipient = userMailT jRecipient $ do +dispatchNotificationUserAuthModeUpdate :: UserId -> AuthenticationMode -> UserId -> Maybe UserId -> Handler () +dispatchNotificationUserAuthModeUpdate nUser _nOriginalAuthMode jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do User{..} <- liftHandler . runDB $ getJust nUser replaceMailHeader "Auto-Submitted" $ Just "auto-generated" setSubjectI MsgMailSubjectUserAuthModeUpdate diff --git a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs index ab1033eee..7af06499a 100644 --- a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs +++ b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs @@ -20,8 +20,8 @@ import qualified Data.Set as Set import Text.Hamlet -- import qualified Data.CaseInsensitive as CI -dispatchNotificationUserRightsUpdate :: UserId -> Set (SchoolFunction, SchoolShorthand) -> UserId -> Handler () -dispatchNotificationUserRightsUpdate nUser _originalRights jRecipient = userMailT jRecipient $ do +dispatchNotificationUserRightsUpdate :: UserId -> Set (SchoolFunction, SchoolShorthand) -> UserId -> Maybe UserId -> Handler () +dispatchNotificationUserRightsUpdate nUser _originalRights jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (User{..}, functions) <- liftHandler . runDB $ do user <- getJust nUser functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. nUser] [] @@ -33,8 +33,8 @@ dispatchNotificationUserRightsUpdate nUser _originalRights jRecipient = userMai addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) -dispatchNotificationUserSystemFunctionsUpdate :: UserId -> Set SystemFunction -> UserId -> Handler () -dispatchNotificationUserSystemFunctionsUpdate nUser _originalSystemFunctions jRecipient = userMailT jRecipient $ do +dispatchNotificationUserSystemFunctionsUpdate :: UserId -> Set SystemFunction -> UserId -> Maybe UserId -> Handler () +dispatchNotificationUserSystemFunctionsUpdate nUser _originalSystemFunctions jRecipient jSupervisor = superMailT jSupervisor jRecipient $ do (User{..}, functions) <- liftHandler . runDB $ do user <- getJust nUser functions <- map (userSystemFunctionFunction . entityVal) <$> selectList [UserSystemFunctionUser ==. nUser] []