diff --git a/messages/uniworx/categories/send/send_notifications/en-eu.msg b/messages/uniworx/categories/send/send_notifications/en-eu.msg index 3a3d18ddf..d6af818f2 100644 --- a/messages/uniworx/categories/send/send_notifications/en-eu.msg +++ b/messages/uniworx/categories/send/send_notifications/en-eu.msg @@ -135,7 +135,7 @@ UserAuthModeLDAPChangedToPWHash: You can now log in using your FRADrive-internal AuthPWHashTip: You now need to use the login form labeled "FRADrive login". Please ensure that you have already set a password when you try to log in. PasswordResetEmailIncoming: For security reasons you will receive a link to the page on which you can set and later change your password in a separate email. MailFradrive: FRADrive -MailBodyFradrive: is the apron driving licence management app of Fraport AG. +MailBodyFradrive: is the apron driver's licence management app of Fraport AG. #userRightsUpdate.hs + templates MailSubjectUserRightsUpdate name: Permissions for #{name} changed diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index 576fbc495..217e916ba 100644 --- a/src/Handler/Utils/Mail.hs +++ b/src/Handler/Utils/Mail.hs @@ -54,6 +54,7 @@ userMailT :: ( MonadHandler m , MonadUnliftIO m ) => UserId -> MailT m () -> m () userMailT uid mAct = do + -- now <- liftIO getCurrentTime superVs <- liftHandler . runDB $ selectList [UserSupervisorUser ==. uid, UserSupervisorRerouteNotifications ==. True] [] let receivers = if null superVs then [uid] @@ -75,10 +76,16 @@ userMailT uid mAct = do SelFormatTime -> userTimeFormat , mcCsvOptions = userCsvOptions } + --bsExplainSupervisor = $(ihamletFile "templates/mail/supervisorPrefix.hamlet") -- TODO + --explanationSupervisor = File { fileTitle = "SupervisorInfo.txt" + -- , fileModified = no + -- , fileContent = Just $ yield bsExplainSupervisor + -- } mailT ctx $ do _mailTo .= pure (userAddress supervisor) - -- unless (uid == svr) $ addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/supervisorPrefix.hamlet") -- TODO mAct + mapSubject ("[SUPERVISOR]"<>) -- changing subject is easy + --addPart explanationSupervisor -- adding an attachment is also easy _userMailTdirect :: ( MonadHandler m diff --git a/src/Jobs/Handler/SendTestEmail.hs b/src/Jobs/Handler/SendTestEmail.hs index c6aa205f4..2b4fe3e32 100644 --- a/src/Jobs/Handler/SendTestEmail.hs +++ b/src/Jobs/Handler/SendTestEmail.hs @@ -14,6 +14,13 @@ import Handler.Utils.DateTime 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 @@ -21,6 +28,18 @@ dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMail nD <- formatTimeMail SelFormatDate now nT <- formatTimeMail SelFormatTime now addHtmlMarkdownAlternatives $ \(MsgRenderer mr) -> [shamlet| +
+ #{mr MsgMailTestDateTime} +
#{mr MsgMailTestContent} diff --git a/src/Mail.hs b/src/Mail.hs index 269803f97..0090d549f 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -28,9 +28,9 @@ module Mail , MonadHeader(..) , MailHeader , MailObjectId - , replaceMailHeader, addMailHeader, removeMailHeader, getMailHeaders, lookupMailHeader + , replaceMailHeader, addMailHeader, removeMailHeader, getMailHeaders, lookupMailHeader, mapMailHeader , replaceMailHeaderI, addMailHeaderI - , setSubjectI + , setSubjectI, mapSubject , setMailObjectUUID, setMailObjectIdRandom, setMailObjectIdCrypto, setMailObjectIdPseudorandom , getMailObjectId , setDate, setDateCurrent @@ -77,7 +77,7 @@ import qualified Data.Text.Lazy.Builder as LTB import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as BS -import Utils (MsgRendererS(..), MonadSecretBox(..), YamlValue, maybeMonoid, insertAssoc, maybeT, guardM) +import Utils (MsgRendererS(..), MonadSecretBox(..), YamlValue, maybeMonoid, insertAssoc, maybeT, guardM, adjustAssoc) import Utils.Lens.TH import Control.Lens hiding (from) @@ -518,6 +518,8 @@ getMailHeaders header = stateHeaders $ \hdrs -> (, hdrs) . map (view _2) $ filte lookupMailHeader :: MonadHeader m => MailHeader -> m (Maybe Text) lookupMailHeader = fmap listToMaybe . getMailHeaders +mapMailHeader :: MonadHeader m => MailHeader -> (Text -> Text) -> m () +mapMailHeader header f = modifyHeaders $ adjustAssoc f header replaceMailHeaderI :: ( RenderMessage site msg , MonadMail m @@ -537,6 +539,9 @@ addMailHeaderI header msg = addMailHeader header =<< (getMailMessageRender <*> p setSubjectI :: (RenderMessage site msg, MonadHandler m, HandlerSite m ~ site) => msg -> MailT m () setSubjectI = replaceMailHeaderI "Subject" +mapSubject :: MonadHeader m => (Text -> Text) -> m () +mapSubject = mapMailHeader "Subject" + setMailObjectUUID :: ( MonadHeader m , YesodMail (HandlerSite m) ) => UUID -> m MailObjectId