chore(mail): modify subject for supervisor

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

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

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|
+      <h1>
+        Testheader
+      <p>
+        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|
+    <h2>
+      #{mr MsgMailTestContent}
+
+    <p>
+      #{mr MsgMailTestDateTime}
+      <ul>
+        <li>#{nDT}
+        <li>#{nD}
+        <li>#{nT}
+    |]
+  addHtmlMarkdownAlternatives $ \(MsgRenderer mr) -> [shamlet|
+    <h2>Repetition just for Testing
     <p>
       #{mr MsgMailTestContent}
 

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