From 6f1a4020ba5f2b947569b5dec29dde4d5ef67eb8 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 7 Nov 2022 17:52:33 +0100 Subject: [PATCH] chore(mail): supervisor info messages (WIP) --- .../uniworx/categories/print/de-de-formal.msg | 3 +- messages/uniworx/categories/print/en-eu.msg | 3 +- .../send/send_notifications/de-de-formal.msg | 8 ++ .../send/send_notifications/en-eu.msg | 8 ++ src/Handler/LMS.hs | 7 +- src/Handler/PrintCenter.hs | 78 +++++++++---------- src/Handler/Utils/Mail.hs | 74 ++++++++++-------- src/Handler/Utils/Widgets.hs | 3 + src/Jobs/Handler/SendNotification.hs | 21 +---- .../Handler/SendNotification/Qualification.hs | 8 +- src/Jobs/Handler/SendTestEmail.hs | 38 +++------ 11 files changed, 124 insertions(+), 127 deletions(-) diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index 7a865802b..29361a2cf 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -19,4 +19,5 @@ PrintCourse: Kurse PrintQualification: Qualifikation PrintPDF !ident-ok: PDF PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden -PrintLmsUser: E-Learning Benachrichtigung? \ No newline at end of file +PrintLmsUser: E-Learning Id +PrintJobs: Druckaufräge \ No newline at end of file diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index 4b2aa442d..7f07a8f52 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -19,4 +19,5 @@ PrintCourse: Course PrintQualification: Qualification PrintPDF: PDF PrintManualRenewal: Manual sending of an apron driver's licence renewal letter -PrintLmsUser: E-learning notification? \ No newline at end of file +PrintLmsUser: E-learning id +PrintJobs: Print jobs \ No newline at end of file diff --git a/messages/uniworx/categories/send/send_notifications/de-de-formal.msg b/messages/uniworx/categories/send/send_notifications/de-de-formal.msg index 189bed625..50a25af92 100644 --- a/messages/uniworx/categories/send/send_notifications/de-de-formal.msg +++ b/messages/uniworx/categories/send/send_notifications/de-de-formal.msg @@ -148,3 +148,11 @@ MailUserSystemFunctionsNoFunctions: Keine #utils.hs + templates MailEditNotifications: Benachrichtigungen ein-/ausschalten + +#supervisor +MailSupervisorNote: Hinweis für Ansprechpartner +MailSupervisorBody undername@Text supername@Text: Sie erhalten diese Nachricht, da #{supername} als Ansprechpartner für #{undername} eingetragen ist in +MailSupervisorCopy undermail@Text: Diese Nachricht ist eine Kopie einer Nachricht, welche an #{undermail} gesendet wurde. +MailSupervisorNoCopy: Warnung: Diese Nachricht wurde nicht an den eingentlichen Empfänger versandt! Für die Weiterleitung sind alle für diesen Empfänger in FRADrive eingetragenen Ansprechpartner verantwortlich! +MailSupervisedNote: Hinweis +MailSupervisedBody: Eine Kopie dieser Nachricht wurde auch an folgende in FRADrive eingetragene Ansprechpartner gesendet: \ No newline at end of file diff --git a/messages/uniworx/categories/send/send_notifications/en-eu.msg b/messages/uniworx/categories/send/send_notifications/en-eu.msg index d6af818f2..8684f7085 100644 --- a/messages/uniworx/categories/send/send_notifications/en-eu.msg +++ b/messages/uniworx/categories/send/send_notifications/en-eu.msg @@ -148,3 +148,11 @@ MailUserSystemFunctionsNoFunctions: None #utils.hs + templates MailEditNotifications: Enable/Disable notifications + +#supervisor +MailSupervisorNote: Note to supervisor +MailSupervisorBody undername supername: You receive this message, since #{supername} is registered as supervisor for #{undername} in +MailSupervisorCopy undermail: This is a copy of a message originally sent to #{undermail}. +MailSupervisorNoCopy: Warning: This message was not sent to the original recipient! The FRADrive registered supervisor, i.e. you, is responsible for forwarding this message to the recipient! +MailSupervisedNote: Please Note +MailSupervisedBody: A copy of this message has been sent to all supervisors registered for you in FRADrive, namely: \ No newline at end of file diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index aeb72c4e7..858a26e9a 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -519,6 +519,7 @@ postLmsR sid qsh = do cDate = if | not letterSent -> foldMap dateTimeCell notifyDate | Just d <- lastLetterDate -> dateTimeCell d | otherwise -> i18nCell MsgPrintJobUnacknowledged + lprLink :: Maybe (Route UniWorX) = lmsident <&> (\lid -> urlRoute (PrintCenterR, [("print-job-lmsid", toPathPiece lid)])) cAckDates = case letterDates of Just ackDates@(_:_:_) -> spacerCell <> modalCell [whamlet|

@@ -531,10 +532,10 @@ postLmsR sid qsh = do ^{formatTimeW SelFormatDateTime ackdate} $nothing _{MsgPrintJobUnacknowledged} - $maybe _lu <- lmsident + $maybe lu <- lprLink

- - Link to PrintJob + + _{MsgPrintJobs} |] -- (PrintCenterR, [("pj-lmsid", toPathPiece lu)]) _ -> mempty diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 8d3ecd0e4..9c5b407ab 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -197,53 +197,53 @@ mkPJTable = do dbtProj = dbtProjFilteredPostId dbtColonnade = mconcat [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged) - , sortable (Just "pj-created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t - , sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t - , sortable (Just "pj-filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey - t = r ^. resultPrintJob . _entityVal . _printJobFilename - in anchorCellM (PrintDownloadR <$> encrypt k) (toWgt t) - , sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n - , sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR - , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR - , sortable (Just "pj-course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell - , sortable (Just "pj-qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell - , sortable (Just "pj-lmsid") (i18nCell MsgPrintLmsUser) $ \( view $ resultPrintJob . _entityVal . _printJobLmsUser -> l) -> foldMap textCell (getLmsIdent <$> l) + , sortable (Just "created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t + , sortable (Just "acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t + , sortable (Just "filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey + t = r ^. resultPrintJob . _entityVal . _printJobFilename + in anchorCellM (PrintDownloadR <$> encrypt k) (toWgt t) + , sortable (Just "name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n + , sortable (Just "recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR + , sortable (Just "sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR + , sortable (Just "course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell + , sortable (Just "qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell + , sortable (Just "lmsid") (i18nCell MsgPrintLmsUser) $ \( view $ resultPrintJob . _entityVal . _printJobLmsUser -> l) -> foldMap textCell (getLmsIdent <$> l) ] dbtSorting = mconcat - [ single ("pj-name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName)) - , single ("pj-filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename)) - , single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated)) - , single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged)) - , single ("pj-recipient" , sortUserNameBareM queryRecipient) - , single ("pj-sender" , sortUserNameBareM querySender ) - , single ("pj-course" , SortColumn $ queryCourse >>> (E.?. CourseName)) - , single ("pj-qualification", SortColumn $ queryQualification >>> (E.?. QualificationName)) - , single ("pj-lmsid" , SortColumn $ queryPrintJob >>> (E.^. PrintJobLmsUser)) + [ single ("name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName)) + , single ("filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename)) + , single ("created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated)) + , single ("acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged)) + , single ("recipient" , sortUserNameBareM queryRecipient) + , single ("sender" , sortUserNameBareM querySender ) + , single ("course" , SortColumn $ queryCourse >>> (E.?. CourseName)) + , single ("qualification", SortColumn $ queryQualification >>> (E.?. QualificationName)) + , single ("lmsid" , SortColumn $ queryPrintJob >>> (E.^. PrintJobLmsUser)) ] dbtFilter = mconcat - [ single ("pj-name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName)) - , single ("pj-filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename)) - , single ("pj-created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) - --, single ("pj-created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) - , single ("pj-recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName)) - , single ("pj-sender" , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender) (E.?. UserDisplayName)) - , single ("pj-course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName)) - , single ("pj-qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName)) - , single ("pj-lmsid" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob) (E.^. PrintJobLmsUser)) + [ single ("name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName)) + , single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename)) + , single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) + --, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) + , single ("recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName)) + , single ("sender" , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender) (E.?. UserDisplayName)) + , single ("course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName)) + , single ("qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName)) + , single ("lmsid" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob) (E.^. PrintJobLmsUser)) , single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged))) ] dbtFilterUI mPrev = mconcat - [ prismAForm (singletonFilter "pj-name" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobName) - , prismAForm (singletonFilter "pj-filename" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobFilename) - , prismAForm (singletonFilter "pj-created" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift dayField) (fslI MsgPrintJobCreated) - --, prismAForm (singletonFilter "pj-created" . maybePrism _PathPiece) mPrev ((,) <$> aopt (hoistField lift dayField) (fslI MsgPrintJobCreated) + [ prismAForm (singletonFilter "name" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobName) + , prismAForm (singletonFilter "filename" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobFilename) + , prismAForm (singletonFilter "created" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift dayField) (fslI MsgPrintJobCreated) + --, prismAForm (singletonFilter "created" . maybePrism _PathPiece) mPrev ((,) <$> aopt (hoistField lift dayField) (fslI MsgPrintJobCreated) -- <*> aopt (hoistField lift dayField) (fslI MsgPrintJobCreated) -- ) - , prismAForm (singletonFilter "pj-recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient) - , prismAForm (singletonFilter "pj-sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender) - , prismAForm (singletonFilter "pj-course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse) - , prismAForm (singletonFilter "pj-qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification) - , prismAForm (singletonFilter "pj-lmsid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintLmsUser) + , prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient) + , prismAForm (singletonFilter "sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender) + , prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse) + , prismAForm (singletonFilter "qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification) + , prismAForm (singletonFilter "lmsid" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintLmsUser) , prismAForm (singletonFilter "acknowledged" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgPrintJobAcknowledged) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout} @@ -275,7 +275,7 @@ mkPJTable = do (First (Just act), jobMap) <- inp let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap return (act, jobSet) - psValidator = def & defaultSorting [SortAscBy "pj-created"] + psValidator = def & defaultSorting [SortAscBy "created"] & defaultFilter (singletonMap "acknowledged" [toPathPiece False]) over _1 postprocess <$> dbTable psValidator DBTable{..} diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index eb6e9f8ca..d48ecdfa0 100644 --- a/src/Handler/Utils/Mail.hs +++ b/src/Handler/Utils/Mail.hs @@ -9,12 +9,12 @@ module Handler.Utils.Mail , addFileDB , addHtmlMarkdownAlternatives , addHtmlMarkdownAlternatives' - , addHtmlMarkdownAlternatives'' ) where import Import import Handler.Utils.Pandoc import Handler.Utils.Files +import Handler.Utils.Widgets (nameHtml') import qualified Data.CaseInsensitive as CI @@ -24,6 +24,7 @@ import qualified Text.Pandoc as P import qualified Text.Hamlet as Hamlet (Translate) import qualified Text.Shakespeare as Shakespeare (RenderUrl) +import qualified Text.CI as CI addRecipientsDB :: ( MonadMail m @@ -56,12 +57,24 @@ userMailT :: ( MonadHandler m ) => UserId -> MailT m () -> m () userMailT uid mAct = do -- now <- liftIO getCurrentTime + underling <- liftHandler . runDB $ getJust uid superVs <- liftHandler . runDB $ selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] [] let receivers = if null superVs then [uid] else userSupervisorSupervisor . entityVal <$> superVs - -- underling <- liftHandler . runDB $ getJust uid - forM_ receivers $ \svr -> do + undercopy = uid `elem` receivers + undername = underling ^. _userDisplayName -- nameHtml' underling + undermail = CI.original $ underling ^. _userEmail + infoSupervised = \(MsgRenderer mr) -> [shamlet| +

#{mr MsgMailSupervisedNote} +

+ #{mr MsgMailSupervisedBody} +