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|
-
- 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 MsgMailSupervisedBody}
+
+ _{MsgMailSupervisorBody undername supername} #
+
+ FRADrive
+ .
+ $if undercopy
+ _{MsgMailSupervisorCopy undermail}
+ $else
+ _{MsgMailSupervisorNoCopy}
+ |]
mailT ctx $ do
_mailTo .= pure (userAddress supervisor)
mAct
- unless (uid==svr) $ -- do
- mapSubject ("[SUPERVISOR]"<>) -- changing subject is easy
- --addPart explanationSupervisor -- adding an attachment is also easy
+ if uid==svr
+ then when (2 <= length receivers) $ addHtmlMarkdownAlternatives' "InfoSupervised" infoSupervised -- notify about supervisors
+ else do
+ mapSubject ("[SUPERVISOR]" <>)
+ addHtmlMarkdownAlternatives' "InfoSupervisor" infoSupervisor -- adding explanation why the supervisor received this email
+
_userMailTdirect :: ( MonadHandler m
@@ -152,7 +176,7 @@ instance ToMailHtml site a => ToMailHtml site (Shakespeare.RenderUrl (Route site
ur <- getUrlRenderParams
toMailHtml $ act ur
-
+-- | Adds another Text part as Html AND Markdown (receiver's choice) to an email. Subsequently added parts create attachments named "Att#####.html" and "Att#####.txt"
addHtmlMarkdownAlternatives :: ( MonadMail m
, ToMailPart (HandlerSite m) Html
, ToMailHtml (HandlerSite m) a
@@ -170,36 +194,18 @@ addHtmlMarkdownAlternatives html' = do
{ P.writerReferenceLinks = True
}
--- | provide a name for the part
+-- | Like @addHtmlMarkdownAlternatives, but adds subseqeunt parts with "content-disposition: inline" and the provided filename, if inline display is not permitted (receiver's choice)
addHtmlMarkdownAlternatives' :: ( MonadMail m
, ToMailPart (HandlerSite m) (NamedMailPart Html)
, ToMailHtml (HandlerSite m) a
) => Text -> a -> m ()
-addHtmlMarkdownAlternatives' fn html' = do
+addHtmlMarkdownAlternatives' fn html' = do
html <- toMailHtml html'
markdown <- runMaybeT $ renderMarkdownWith htmlReaderOptions writerOptions html
addAlternatives $ do
- providePreferredAlternative $ NamedMailPart { namedPart = html, disposition = AttachmentDisposition fn }
- whenIsJust markdown $ provideAlternative . NamedMailPart (AttachmentDisposition (fn <> ".txt"))
- where
- writerOptions = markdownWriterOptions
- { P.writerReferenceLinks = True
- }
-
-
--- | provide a name for the part
-addHtmlMarkdownAlternatives'' :: ( MonadMail m
- , ToMailPart (HandlerSite m) (NamedMailPart Html)
- , ToMailHtml (HandlerSite m) a
- ) => Text -> a -> m ()
-addHtmlMarkdownAlternatives'' fn html' = do
- html <- toMailHtml html'
- markdown <- runMaybeT $ renderMarkdownWith htmlReaderOptions writerOptions html
-
- addAlternatives $ do
- providePreferredAlternative $ NamedMailPart { disposition = InlineDisposition fn, namedPart = html }
- whenIsJust markdown $ provideAlternative . NamedMailPart (AttachmentDisposition (fn <> ".txt"))
+ providePreferredAlternative $ NamedMailPart { disposition = InlineDisposition $ fn <> ".html", namedPart = html }
+ whenIsJust markdown $ provideAlternative . NamedMailPart (InlineDisposition (fn <> ".txt"))
where
writerOptions = markdownWriterOptions
{ P.writerReferenceLinks = True
diff --git a/src/Handler/Utils/Widgets.hs b/src/Handler/Utils/Widgets.hs
index 6dc073bb9..9e375da20 100644
--- a/src/Handler/Utils/Widgets.hs
+++ b/src/Handler/Utils/Widgets.hs
@@ -89,6 +89,9 @@ nameHtml displayName surname
|]
[] -> error "Data.Text.splitOn returned empty list in violation of specification."
+nameHtml' :: HasUser u => u -> Html
+nameHtml' u = nameHtml (u ^. _userDisplayName) (u ^. _userSurname)
+
-- | Like nameHtml just show a users displayname with hightlighted surname,
-- but also wrap the name with a mailto-link
nameEmailHtml :: UserEmail -> Text -> Text -> Html
diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs
index da5e6074f..9d0825eeb 100644
--- a/src/Jobs/Handler/SendNotification.hs
+++ b/src/Jobs/Handler/SendNotification.hs
@@ -24,25 +24,8 @@ import Jobs.Handler.SendNotification.Allocation
import Jobs.Handler.SendNotification.ExamOffice
import Jobs.Handler.SendNotification.CourseRegistered
import Jobs.Handler.SendNotification.SubmissionEdited
-import Jobs.Handler.SendNotification.Qualification
+import Jobs.Handler.SendNotification.Qualification
dispatchJobSendNotification :: UserId -> Notification -> JobHandler UniWorX
-dispatchJobSendNotification jRecipient jNotification = JobHandlerException $
+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
-
-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
- else forM_ superVs $ \Entity { entityVal = UserSupervisor { userSupervisorSupervisor = svr } } ->
- $(dispatchTH ''Notification) jNotification svr
--}
\ No newline at end of file
diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs
index 9b16abc79..ef98d59b2 100644
--- a/src/Jobs/Handler/SendNotification/Qualification.hs
+++ b/src/Jobs/Handler/SendNotification/Qualification.hs
@@ -88,7 +88,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient
let printJobName = "RenewalPin"
- fileName = printJobName <> "_" <> abbrvName recipient <> ".pdf"
+ fileName = printJobName <> "_" <> (text2asciiAlphaNum . abbrvName) recipient <> ".pdf"
lmsIdent = lmsUserIdent & getLmsIdent
lmsUrl = "https://drive.fraport.de"
lmsLogin = lmsUrl <> "/?login=" <> lmsIdent
@@ -113,14 +113,14 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
| otherwise = do
userMailT jRecipient $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
- setSubjectI $ MsgMailSubjectQualificationRenewal qname
+ setSubjectI $ MsgMailSubjectQualificationRenewal qname
+ editNotifications <- mkEditNotifications jRecipient
+ addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
whenIsJust attachment $ \afile ->
addPart (File { fileTitle = Text.unpack fileName
, fileModified = now
, fileContent = Just $ yield $ LBS.toStrict afile
} :: PureFile)
- editNotifications <- mkEditNotifications jRecipient
- addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
return True
notifyOk <- pdfRenewal pdfMeta >>= \case
diff --git a/src/Jobs/Handler/SendTestEmail.hs b/src/Jobs/Handler/SendTestEmail.hs
index d416f8000..07205c1cb 100644
--- a/src/Jobs/Handler/SendTestEmail.hs
+++ b/src/Jobs/Handler/SendTestEmail.hs
@@ -10,25 +10,19 @@ import Import
import Handler.Utils.Mail
import Handler.Utils.DateTime
+import Text.Hamlet
-- import Handler.Utils.I18n
dispatchJobSendTestEmail :: Email -> MailContext -> JobHandler UniWorX
dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMailContext $ do
_mailTo .= [Address Nothing jEmail]
- -- TODO: remove me after the test!
- addHtmlMarkdownAlternatives $ \(MsgRenderer _mr) -> [shamlet|
-
- Dieser Abschnitt ist ein Test, ob mehrfache Mailparts ankommen.
- |]
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI MsgMailTestSubject
now <- liftIO getCurrentTime
nDT <- formatTimeMail SelFormatDateTime now
nD <- formatTimeMail SelFormatDate now
nT <- formatTimeMail SelFormatTime now
- addHtmlMarkdownAlternatives $ \(MsgRenderer mr) -> [shamlet|
+ addHtmlMarkdownAlternatives' "part1" $ \(MsgRenderer mr) -> [shamlet|
- #{mr MsgMailTestContent}
-
+ Please ignore this part of the message send by
+
+ FRADrive
+ |]
+ let trdmsg :: HtmlUrlI18n UniWorXJobsHandlerMessage (Route UniWorX) = [ihamlet|
+
- #{mr MsgMailTestDateTime}
-
- #{mr MsgMailTestContent}
-
-
- #{mr MsgMailTestDateTime}
+ _{MsgMailTestDateTime}
#{mr MsgMailSupervisedNote}
+
+ $forall svr <- superVs
+
_{MsgMailSupervisorNote}
+
- Testheader
-
#{mr MsgMailTestContent}
@@ -39,31 +33,23 @@ dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMail
Repetition just for Testing
+ addHtmlMarkdownAlternatives' "part2" $ \(MsgRenderer _mr) -> [shamlet|
+
Second part, just for testing
Third part, again only for tests
-
Repetition just for Testing
-