chore(supervisor): reroute most notifications (WIP)
This commit is contained in:
Steffen Jost
parent
e9eaa8263f
commit
e01fd96bb5
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
-}
|
||||
$(dispatchTH ''Notification) jNotification jRecipient (Just svr)
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ->
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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] []
|
||||
|
||||
Loading…
Reference in New Issue
Block a user