fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: use pandoc to convert html emails to markdown (plaintext)

Browse Source
This commit is contained in:
Gregor Kleen 2020-02-21 18:09:15 +01:00
parent c5848b24e8
commit 4879bb8404
22 changed files with 107 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/Handler/Utils/Mail.hs
View File

@ -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
}

16
src/Handler/Utils/Pandoc.hs
View File

@ -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

3
src/Jobs/Handler/ChangeUserDisplayEmail.hs
View File

@ -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))

2
src/Jobs/Handler/HelpRequest.hs
View File

@ -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))

2
src/Jobs/Handler/Invitation.hs
View File

@ -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))

4
src/Jobs/Handler/SendCourseCommunication.hs
View File

@ -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

18
src/Jobs/Handler/SendNotification/Allocation.hs
View File

@ -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")

3
src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs
View File

@ -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))

3
src/Jobs/Handler/SendNotification/CorrectionsNotDistributed.hs
View File

@ -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))

3
src/Jobs/Handler/SendNotification/CourseRegistered.hs
View File

@ -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))

9
src/Jobs/Handler/SendNotification/ExamActive.hs
View File

@ -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))

9
src/Jobs/Handler/SendNotification/ExamOffice.hs
View File

@ -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))

3
src/Jobs/Handler/SendNotification/ExamResult.hs
View File

@ -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))

3
src/Jobs/Handler/SendNotification/SheetActive.hs
View File

@ -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))

6
src/Jobs/Handler/SendNotification/SheetInactive.hs
View File

@ -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))

9
src/Jobs/Handler/SendNotification/SubmissionEdited.hs
View File

@ -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")

26
src/Jobs/Handler/SendNotification/SubmissionRated.hs
View File

@ -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))

3
src/Jobs/Handler/SendNotification/UserAuthModeUpdate.hs
View File

@ -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))

3
src/Jobs/Handler/SendNotification/UserRightsUpdate.hs
View File

@ -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))

3
src/Jobs/Handler/SendPasswordReset.hs
View File

@ -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))

20
src/Jobs/Handler/SendTestEmail.hs
View File

@ -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|
<p>
#{mr MsgMailTestContent}
#{mr MsgMailTestDateTime}
* #{nDT}
* #{nD}
* #{nT}
|] :: TextUrl (Route UniWorX)
<p>
#{mr MsgMailTestDateTime}
<ul>
<li>#{nDT}
<li>#{nD}
<li>#{nT}
|]

7
templates/mail/courseCommunication.hamlet Normal file
View File

@ -0,0 +1,7 @@
$newline never
\<!doctype html>
<html>
<head>
<meta charset="UTF-8">
<body>
#{jMailContent}