From 4879bb840482b6b81b0dee58a01f3f33c5c1c725 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 21 Feb 2020 18:09:15 +0100 Subject: [PATCH] feat: use pandoc to convert html emails to markdown (plaintext) --- src/Handler/Utils/Mail.hs | 47 +++++++++++++++++++ src/Handler/Utils/Pandoc.hs | 16 ++++--- src/Jobs/Handler/ChangeUserDisplayEmail.hs | 3 +- src/Jobs/Handler/HelpRequest.hs | 2 +- src/Jobs/Handler/Invitation.hs | 2 +- src/Jobs/Handler/SendCourseCommunication.hs | 4 +- .../Handler/SendNotification/Allocation.hs | 18 +++---- .../SendNotification/CorrectionsAssigned.hs | 3 +- .../CorrectionsNotDistributed.hs | 3 +- .../SendNotification/CourseRegistered.hs | 3 +- .../Handler/SendNotification/ExamActive.hs | 9 ++-- .../Handler/SendNotification/ExamOffice.hs | 9 ++-- .../Handler/SendNotification/ExamResult.hs | 3 +- .../Handler/SendNotification/SheetActive.hs | 3 +- .../Handler/SendNotification/SheetInactive.hs | 6 +-- .../SendNotification/SubmissionEdited.hs | 9 ++-- .../SendNotification/SubmissionRated.hs | 26 +--------- .../SendNotification/UserAuthModeUpdate.hs | 3 +- .../SendNotification/UserRightsUpdate.hs | 3 +- src/Jobs/Handler/SendPasswordReset.hs | 3 +- src/Jobs/Handler/SendTestEmail.hs | 20 ++++---- templates/mail/courseCommunication.hamlet | 7 +++ 22 files changed, 107 insertions(+), 95 deletions(-) create mode 100644 templates/mail/courseCommunication.hamlet diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index bccbd0ce8..d40782758 100644 --- a/src/Handler/Utils/Mail.hs +++ b/src/Handler/Utils/Mail.hs @@ -3,9 +3,11 @@ module Handler.Utils.Mail , userAddress, userAddressFrom , userMailT , addFileDB + , addHtmlMarkdownAlternatives ) where import Import +import Handler.Utils.Pandoc import qualified Data.CaseInsensitive as CI @@ -17,6 +19,11 @@ import System.FilePath (takeBaseName) import Control.Monad.Trans.State (StateT) +import qualified Text.Pandoc as P + +import qualified Text.Hamlet as Hamlet (Translate) +import qualified Text.Shakespeare as Shakespeare (RenderUrl) + addRecipientsDB :: ( MonadMail m , HandlerSite m ~ UniWorX @@ -75,3 +82,43 @@ addFileDB fId = runMaybeT $ do _partFilename .= Just fileName _partContent .= LBS.fromStrict fileContent setMailObjectIdCrypto fId :: StateT Part (HandlerFor UniWorX) MailObjectId + + +class YesodMail site => ToMailHtml site a where + toMailHtml :: (MonadMail m, HandlerSite m ~ site) => a -> m Html + +instance YesodMail site => ToMailHtml site Html where + toMailHtml = return + +instance (ToMailHtml site a, RenderMessage site msg) => ToMailHtml site (Hamlet.Translate msg -> a) where + toMailHtml act = do + mr <- getMailMessageRender + toMailHtml $ act (toHtml . mr) + +instance (ToMailHtml site a, site ~ site') => ToMailHtml site (MsgRendererS site' -> a) where + toMailHtml act = do + mr <- getMailMsgRenderer + toMailHtml $ act mr + +instance ToMailHtml site a => ToMailHtml site (Shakespeare.RenderUrl (Route site) -> a) where + toMailHtml act = do + ur <- getUrlRenderParams + toMailHtml $ act ur + + +addHtmlMarkdownAlternatives :: ( MonadMail m + , ToMailPart (HandlerSite m) Html + , ToMailHtml (HandlerSite m) a + ) + => a -> m () +addHtmlMarkdownAlternatives html' = do + html <- toMailHtml html' + markdown <- runMaybeT $ renderMarkdownWith htmlReaderOptions writerOptions html + + addAlternatives $ do + providePreferredAlternative html + whenIsJust markdown provideAlternative + where + writerOptions = markdownWriterOptions + { P.writerReferenceLinks = True + } diff --git a/src/Handler/Utils/Pandoc.hs b/src/Handler/Utils/Pandoc.hs index 041bd6b6d..8ee7e2cab 100644 --- a/src/Handler/Utils/Pandoc.hs +++ b/src/Handler/Utils/Pandoc.hs @@ -1,5 +1,6 @@ module Handler.Utils.Pandoc ( htmlField, htmlFieldSmall + , renderMarkdownWith, parseMarkdownWith , htmlReaderOptions, markdownReaderOptions , markdownWriterOptions, htmlWriterOptions ) where @@ -42,17 +43,20 @@ htmlField' fieldKind = Field{..} let markdownExplanation = $(i18nWidgetFile "markdown-explanation") $(widgetFile "widgets/html-field") -parseMarkdown :: Text -> Either (SomeMessage site) Html -parseMarkdown text = + parseMarkdown = parseMarkdownWith markdownReaderOptions htmlWriterOptions + renderMarkdown = renderMarkdownWith htmlReaderOptions markdownWriterOptions + +parseMarkdownWith :: P.ReaderOptions -> P.WriterOptions -> Text -> Either (SomeMessage site) Html +parseMarkdownWith readerOptions writerOptions text = bimap pandocError (preEscapedText . sanitizeBalance) . P.runPure $ - P.writeHtml5String htmlWriterOptions =<< P.readMarkdown markdownReaderOptions text + P.writeHtml5String writerOptions =<< P.readMarkdown readerOptions text where pandocError = SomeMessage . tshow -renderMarkdown :: (MonadLogger m, MonadPlus m) => Html -> m Text -renderMarkdown html = +renderMarkdownWith :: (MonadLogger m, MonadPlus m) => P.ReaderOptions -> P.WriterOptions -> Html -> m Text +renderMarkdownWith readerOptions writerOptions html = either (\e -> logPandocError e >> mzero) return . P.runPure $ - P.writeMarkdown markdownWriterOptions =<< P.readHtml htmlReaderOptions (toStrict $ renderHtml html) + P.writeMarkdown writerOptions =<< P.readHtml readerOptions (toStrict $ renderHtml html) where logPandocError = $logErrorS "renderMarkdown" . tshow diff --git a/src/Jobs/Handler/ChangeUserDisplayEmail.hs b/src/Jobs/Handler/ChangeUserDisplayEmail.hs index bbf62d0c1..1e2627b84 100644 --- a/src/Jobs/Handler/ChangeUserDisplayEmail.hs +++ b/src/Jobs/Handler/ChangeUserDisplayEmail.hs @@ -25,5 +25,4 @@ dispatchJobChangeUserDisplayEmail jUser jDisplayEmail = do _mailTo .= pure (userAddress user & _addressEmail .~ CI.original jDisplayEmail) replaceMailHeader "Auto-Submitted" $ Just "auto-generated" setSubjectI MsgMailSubjectChangeUserDisplayEmail - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/changeUserDisplayEmail.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/changeUserDisplayEmail.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/HelpRequest.hs b/src/Jobs/Handler/HelpRequest.hs index 746111453..0ef10167a 100644 --- a/src/Jobs/Handler/HelpRequest.hs +++ b/src/Jobs/Handler/HelpRequest.hs @@ -32,4 +32,4 @@ dispatchJobHelpRequest jSender jRequestTime jHelpSubject jHelpRequest jReferer = setSubjectI $ maybe MsgMailSubjectSupport MsgMailSubjectSupportCustom jHelpSubject setDate jRequestTime rtime <- formatTimeMail SelFormatDateTime jRequestTime - addPart ($(ihamletFile "templates/mail/support.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/support.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/Invitation.hs b/src/Jobs/Handler/Invitation.hs index 87bab06cf..01339cffd 100644 --- a/src/Jobs/Handler/Invitation.hs +++ b/src/Jobs/Handler/Invitation.hs @@ -23,4 +23,4 @@ dispatchJobInvitation jInviter jInvitee jInvitationUrl jInvitationSubject jInvit replaceMailHeader "Reply-To" . Just . renderAddress $ userAddressFrom jInviter' replaceMailHeader "Auto-Submitted" $ Just "auto-generated" replaceMailHeader "Subject" $ Just jInvitationSubject - addPart ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/invitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendCourseCommunication.hs b/src/Jobs/Handler/SendCourseCommunication.hs index e3ad496b2..1cb5ea554 100644 --- a/src/Jobs/Handler/SendCourseCommunication.hs +++ b/src/Jobs/Handler/SendCourseCommunication.hs @@ -4,6 +4,8 @@ module Jobs.Handler.SendCourseCommunication import Import +import Text.Hamlet + import Handler.Utils import qualified Data.CaseInsensitive as CI @@ -30,7 +32,7 @@ dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCours addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|] addMailHeader "Auto-Submitted" "no" setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage jSubject - void $ addPart jMailContent + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseCommunication.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) when (jRecipientEmail == Right jSender) $ addPart' $ do partIsAttachmentCsv $ mr MsgCommAllRecipients diff --git a/src/Jobs/Handler/SendNotification/Allocation.hs b/src/Jobs/Handler/SendNotification/Allocation.hs index 20e816c26..c96ee4bb9 100644 --- a/src/Jobs/Handler/SendNotification/Allocation.hs +++ b/src/Jobs/Handler/SendNotification/Allocation.hs @@ -28,8 +28,7 @@ dispatchNotificationAllocationStaffRegister nAllocation jRecipient = userMailT j setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationName editNotifications <- mkEditNotifications jRecipient registerDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/allocationStaffRegister.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationStaffRegister.hamlet") dispatchNotificationAllocationRegister :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecipient $ do @@ -39,8 +38,7 @@ dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecip setSubjectI $ MsgMailSubjectAllocationRegister allocationName editNotifications <- mkEditNotifications jRecipient registerDeadline <- traverse (formatTime SelFormatDateTime) allocationRegisterTo - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/allocationRegister.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationRegister.hamlet") dispatchNotificationAllocationAllocation :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationAllocation nAllocation jRecipient = do @@ -71,8 +69,7 @@ dispatchNotificationAllocationAllocation nAllocation jRecipient = do editNotifications <- mkEditNotifications jRecipient allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo registerDeadline <- traverse (formatTime SelFormatDateTime) $ assertM (> now) allocationRegisterTo - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/allocationAllocation.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationAllocation.hamlet") dispatchNotificationAllocationUnratedApplications :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do @@ -112,8 +109,7 @@ dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationName editNotifications <- mkEditNotifications jRecipient allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet") dispatchNotificationAllocationOutdatedRatings :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do @@ -153,8 +149,7 @@ dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do setSubjectI $ MsgMailSubjectAllocationOutdatedRatings allocationName editNotifications <- mkEditNotifications jRecipient allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet") dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler () dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do @@ -200,5 +195,4 @@ dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipi setSubjectI $ MsgMailSubjectAllocationResults allocationName editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/allocationResults.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationResults.hamlet") diff --git a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs index bf141f483..720d5850c 100644 --- a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs +++ b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs @@ -31,5 +31,4 @@ dispatchNotificationCorrectionsAssigned nUser nSheet jRecipient = do editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/correctionsAssigned.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/correctionsAssigned.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs b/src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs index cc2456b8e..53282040e 100644 --- a/src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs +++ b/src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs @@ -28,5 +28,4 @@ dispatchNotificationCorrectionsNotDistributed nSheet jRecipient = do csh = courseShorthand shn = sheetName - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/correctionsUndistributed.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/correctionsUndistributed.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/CourseRegistered.hs b/src/Jobs/Handler/SendNotification/CourseRegistered.hs index 1c2659368..946fa5752 100644 --- a/src/Jobs/Handler/SendNotification/CourseRegistered.hs +++ b/src/Jobs/Handler/SendNotification/CourseRegistered.hs @@ -31,5 +31,4 @@ dispatchNotificationCourseRegistered nUser nCourse jRecipient = userMailT jRecip editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/courseRegistered.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseRegistered.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/ExamActive.hs b/src/Jobs/Handler/SendNotification/ExamActive.hs index 6ccccc5ac..90f4aa64f 100644 --- a/src/Jobs/Handler/SendNotification/ExamActive.hs +++ b/src/Jobs/Handler/SendNotification/ExamActive.hs @@ -32,8 +32,7 @@ dispatchNotificationExamRegistrationActive nExam jRecipient = userMailT jRecipie editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) dispatchNotificationExamRegistrationSoonInactive :: ExamId -> UserId -> Handler () dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do @@ -53,8 +52,7 @@ dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jR editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) dispatchNotificationExamDeregistrationSoonInactive :: ExamId -> UserId -> Handler () dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do @@ -74,5 +72,4 @@ dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/examDeregistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examDeregistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/ExamOffice.hs b/src/Jobs/Handler/SendNotification/ExamOffice.hs index fe7d766e1..fe3d8df8b 100644 --- a/src/Jobs/Handler/SendNotification/ExamOffice.hs +++ b/src/Jobs/Handler/SendNotification/ExamOffice.hs @@ -35,8 +35,7 @@ dispatchNotificationExamOfficeExamResults nExam jRecipient = userMailT jRecipien editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/examOffice/examResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examOffice/examResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) dispatchNotificationExamOfficeExamResultsChanged :: Set ExamResultId -> UserId -> Handler () dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient = do @@ -60,8 +59,7 @@ dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient = do editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/examOffice/examResultsChanged.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examOffice/examResultsChanged.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) dispatchNotificationExamOfficeExternalExamResults :: ExternalExamId -> UserId -> Handler () @@ -79,5 +77,4 @@ dispatchNotificationExamOfficeExternalExamResults nExternalExam jRecipient = use editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/examOffice/externalExamResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examOffice/externalExamResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/ExamResult.hs b/src/Jobs/Handler/SendNotification/ExamResult.hs index 949c38bba..a509e8b8f 100644 --- a/src/Jobs/Handler/SendNotification/ExamResult.hs +++ b/src/Jobs/Handler/SendNotification/ExamResult.hs @@ -30,5 +30,4 @@ dispatchNotificationExamResult nExam jRecipient = userMailT jRecipient $ do editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/examResult.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/examResult.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/SheetActive.hs b/src/Jobs/Handler/SendNotification/SheetActive.hs index 3dd597a8d..86a75c8cd 100644 --- a/src/Jobs/Handler/SendNotification/SheetActive.hs +++ b/src/Jobs/Handler/SendNotification/SheetActive.hs @@ -30,5 +30,4 @@ dispatchNotificationSheetActive nSheet jRecipient = userMailT jRecipient $ do editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/sheetActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/SheetInactive.hs b/src/Jobs/Handler/SendNotification/SheetInactive.hs index 562df4546..d00ea2fba 100644 --- a/src/Jobs/Handler/SendNotification/SheetInactive.hs +++ b/src/Jobs/Handler/SendNotification/SheetInactive.hs @@ -33,8 +33,7 @@ dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $ editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/sheetSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) dispatchNotificationSheetInactive :: SheetId -> UserId -> Handler () dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do @@ -60,6 +59,5 @@ dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/SubmissionEdited.hs b/src/Jobs/Handler/SendNotification/SubmissionEdited.hs index 1364b460b..6fc6c1ec3 100644 --- a/src/Jobs/Handler/SendNotification/SubmissionEdited.hs +++ b/src/Jobs/Handler/SendNotification/SubmissionEdited.hs @@ -51,8 +51,7 @@ dispatchNotificationSubmissionEdited nInitiator nSubmission jRecipient = userMai editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/submissionEdited.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionEdited.hamlet") dispatchNotificationSubmissionUserCreated :: UserId -> SubmissionId -> UserId -> Handler () dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMailT jRecipient $ do @@ -91,8 +90,7 @@ dispatchNotificationSubmissionUserCreated nUser nSubmission jRecipient = userMai editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/submissionUserCreated.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionUserCreated.hamlet") dispatchNotificationSubmissionUserDeleted :: UserId -> SheetId -> SubmissionId -> UserId -> Handler () @@ -134,5 +132,4 @@ dispatchNotificationSubmissionUserDeleted nUser nSheet nSubmission jRecipient = editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative $(ihamletFile "templates/mail/submissionUserDeleted.hamlet") + addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/submissionUserDeleted.hamlet") diff --git a/src/Jobs/Handler/SendNotification/SubmissionRated.hs b/src/Jobs/Handler/SendNotification/SubmissionRated.hs index 466a9586f..7770c33ad 100644 --- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs +++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs @@ -10,7 +10,6 @@ import Handler.Utils import Jobs.Handler.SendNotification.Utils import Text.Hamlet -import qualified Data.Aeson as Aeson import qualified Data.CaseInsensitive as CI dispatchNotificationSubmissionRated :: SubmissionId -> UserId -> Handler () @@ -39,27 +38,4 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien editNotifications <- mkEditNotifications jRecipient - -- TODO: provide convienience template-haskell for `addAlternatives` - addAlternatives $ do - provideAlternative $ Aeson.object - [ "submission" Aeson..= ciphertext csid - , "submission-rating-points" Aeson..= (guard (sheetType /= NotGraded) *> submissionRatingPoints) - , "submission-rating-comment" Aeson..= submissionRatingComment - , "submission-rating-time" Aeson..= submissionRatingTime - , (Aeson..=) "submission-rating-by" $ do - corrector' <- corrector - return $ Aeson.object - [ "display-name" Aeson..= userDisplayName corrector' - , "surname" Aeson..= userSurname corrector' - , "email" Aeson..= userEmail corrector' - ] - , "submission-rating-passed" Aeson..= join (gradingPassed <$> sheetType ^? _grading <*> submissionRatingPoints) - , "sheet-name" Aeson..= sheetName - , "sheet-type" Aeson..= sheetType - , "course-name" Aeson..= courseName - , "course-shorthand" Aeson..= courseShorthand - , "course-term" Aeson..= courseTerm - , "course-school" Aeson..= courseSchool - ] - -- provideAlternative $ \(MsgRenderer mr) -> ($(textFile "templates/mail/submissionRated.txt") :: TextUrl (Route UniWorX)) -- textFile does not support control statements - providePreferredAlternative ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs b/src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs index b6b6bbd48..2c9064fad 100644 --- a/src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs +++ b/src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs @@ -22,6 +22,5 @@ dispatchNotificationUserAuthModeUpdate nUser _nOriginalAuthMode jRecipient = us editNotifications <- ihamletSomeMessage <$> mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/userAuthModeUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/userAuthModeUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) diff --git a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs index 2d8341857..aec3f2a42 100644 --- a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs +++ b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs @@ -25,6 +25,5 @@ dispatchNotificationUserRightsUpdate nUser _originalRights jRecipient = userMai setSubjectI $ MsgMailSubjectUserRightsUpdate userDisplayName -- MsgRenderer mr <- getMailMsgRenderer editNotifications <- mkEditNotifications jRecipient - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)) diff --git a/src/Jobs/Handler/SendPasswordReset.hs b/src/Jobs/Handler/SendPasswordReset.hs index c589c3896..ed1f10a6b 100644 --- a/src/Jobs/Handler/SendPasswordReset.hs +++ b/src/Jobs/Handler/SendPasswordReset.hs @@ -36,5 +36,4 @@ dispatchJobSendPasswordReset jRecipient = userMailT jRecipient $ do resetUrl <- toTextUrl (UserPasswordR cID, [(toPathPiece GetBearer, toPathPiece encodedToken)]) - addAlternatives $ - providePreferredAlternative ($(ihamletFile "templates/mail/passwordReset.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/passwordReset.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) diff --git a/src/Jobs/Handler/SendTestEmail.hs b/src/Jobs/Handler/SendTestEmail.hs index 3f6119697..b37264906 100644 --- a/src/Jobs/Handler/SendTestEmail.hs +++ b/src/Jobs/Handler/SendTestEmail.hs @@ -4,10 +4,9 @@ module Jobs.Handler.SendTestEmail import Import +import Handler.Utils.Mail import Handler.Utils.DateTime -import Text.Shakespeare.Text - dispatchJobSendTestEmail :: Email -> MailContext -> Handler () dispatchJobSendTestEmail jEmail jMailContext = mailT jMailContext $ do _mailTo .= [Address Nothing jEmail] @@ -17,11 +16,14 @@ dispatchJobSendTestEmail jEmail jMailContext = mailT jMailContext $ do nDT <- formatTimeMail SelFormatDateTime now nD <- formatTimeMail SelFormatDate now nT <- formatTimeMail SelFormatTime now - addPart $ \(MsgRenderer mr) -> [text| - #{mr MsgMailTestContent} + addHtmlMarkdownAlternatives $ \(MsgRenderer mr) -> [shamlet| +

+ #{mr MsgMailTestContent} - #{mr MsgMailTestDateTime} - * #{nDT} - * #{nD} - * #{nT} - |] :: TextUrl (Route UniWorX) +

+ #{mr MsgMailTestDateTime} +