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

chore(letter): enable direct letter mails

Browse Source
This commit is contained in:
Steffen Jost 2023-05-08 17:58:37 +00:00
parent 4c5ce11b09
commit 785b97df76
1 changed files with 73 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

129
src/Utils/Print.hs
View File

@ -288,7 +288,7 @@ printLetter'' _ = do
-} -}
sendEmailOrLetter :: (MDLetter l, MDMail l) => UserId -> l -> Handler Bool sendEmailOrLetter :: (MDLetter l, MDMail l) => UserId -> l -> Handler Bool
sendEmailOrLetter recipient letter = do sendEmailOrLetter recipient letter = do
(underling, receivers, undercopy) <- updateReceivers recipient -- TODO: check to avoid this almost circular dependency (underling, receivers, undercopy) <- updateReceivers recipient -- TODO: check to avoid this almost circular dependency
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let pjid = getPJId letter let pjid = getPJId letter
@ -296,68 +296,85 @@ sendEmailOrLetter recipient letter = do
mailSubject = getMailSubject letter -- these are only needed if sent by email, but we're lazy anyway mailSubject = getMailSubject letter -- these are only needed if sent by email, but we're lazy anyway
undername = underling ^. _userDisplayName -- nameHtml' underling undername = underling ^. _userDisplayName -- nameHtml' underling
undermail = CI.original $ underling ^. _userEmail undermail = CI.original $ underling ^. _userEmail
mr <- getMessageRender
let mailSupervisorSubject = SomeMessage $ "[SUPERVISOR] " <> mr mailSubject
oks <- forM receivers $ \rcvrEnt@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do oks <- forM receivers $ \rcvrEnt@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
encRecipient :: CryptoUUIDUser <- encrypt svr encRecipient :: CryptoUUIDUser <- encrypt svr
apcIdent <- letterApcIdent letter encRecipient now apcIdent <- letterApcIdent letter encRecipient now
-- case getPostalPreferenceAndAddress rcvrUsr of case getPostalPreferenceAndAddress rcvrUsr of
-- (True, Nothing) -> do -- neither email nor postal is known (True, Nothing) -> do -- neither email nor postal is known
-- let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid
-- $logErrorS "LETTER" msg
-- return False
--
-- (False, _) | attachPDFLetter letter -> do -- send Email, with pdf attached
-- (False, _) -> -- send Email, render letter directly to html
-- (True , postal) -> -- send printed letter
--
let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr
-- mailBody <- getMailBody letter formatter
renderLetterPDF rcvrEnt letter apcIdent >>= \case
_ | preferPost, isNothing postal -> do -- neither email nor postal is known
let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notification: " <> tshow pjid
$logErrorS "LETTER" msg $logErrorS "LETTER" msg
return False return False
Left err -> do -- pdf generation failed
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid (True , Just _postal) -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send printed letter
$logErrorS "LETTER" msg Left err -> do -- pdf generation failed
return False let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
Right pdf | preferPost -> -- send printed letter
runDB (printLetter' pjid{pjiRecipient = Just svr, pjiApcAcknowledge = apcIdent} pdf) >>= \case
Left err -> do
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
$logErrorS "LETTER" msg $logErrorS "LETTER" msg
return False return False
Right (msg,_) Right pdf -> runDB (printLetter' pjid{pjiRecipient = Just svr, pjiApcAcknowledge = apcIdent} pdf) >>= \case
| null msg -> return True Left err -> do
| otherwise -> do let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
$logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg $logErrorS "LETTER" msg
return True return False
Right pdf -> do -- send email Right (msg,_)
let pdfPass = case encryptPDFfor letter of | null msg -> return True
NoPassword -> Nothing | otherwise -> do
PasswordSupervisor -> rcvrUsr ^. _userPinPassword $logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
PasswordUnderling -> underling ^. _userPinPassword return True
attachment <- case pdfPass of
Nothing -> return pdf (False, _) | attachPDFLetter letter -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, with pdf attached
Just passwd -> encryptPDF passwd pdf >>= \case Left err -> do -- pdf generation failed
Right encPdf -> return encPdf let msg = "Notification failed for " <> tshow encRecipient <> ". PDF attachment generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
Left err -> do $logErrorS "LETTER" msg
let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err return False
$logWarnS "LETTER" msg Right pdf -> do -- pdf generated, send as email attachment now
return pdf let pdfPass = case encryptPDFfor letter of
formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale NoPassword -> Nothing
let isSupervised = recipient /= svr PasswordSupervisor -> rcvrUsr ^. _userPinPassword
supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr PasswordUnderling -> underling ^. _userPinPassword
mailBody <- getMailBody letter formatter attachment <- case pdfPass of
userMailTdirect svr $ do Nothing -> return pdf
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" Just passwd -> encryptPDF passwd pdf >>= \case
setSubjectI mailSubject Right encPdf -> return encPdf
editNotifications <- mkEditNotifications svr Left err -> do
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet") let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
addPart (File { fileTitle = fName $logWarnS "LETTER" msg
, fileModified = now return pdf
, fileContent = Just $ yield $ LBS.toStrict attachment formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
} :: PureFile) let isSupervised = recipient /= svr
return True supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
mailBody <- getMailBody letter formatter
userMailTdirect svr $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI mailSubject
editNotifications <- mkEditNotifications svr
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
addPart (File { fileTitle = fName
, fileModified = now
, fileContent = Just $ yield $ LBS.toStrict attachment
} :: PureFile)
return True
(False, _) -> renderLetterHtml rcvrEnt letter apcIdent >>= \case -- send Email, render letter directly to html
Left err -> do -- html generation failed
let msg = "Notification failed for " <> tshow encRecipient <> ". HTML generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
$logErrorS "LETTER" msg
return False
Right html -> do -- html generated, send directly now
let isSupervised = recipient /= svr
-- subject = if isSupervised
-- then "[SUPERVISOR] " <> mailSubject
-- else mailSubject
subject = if isSupervised
then mailSupervisorSubject
else mailSubject
userMailTdirect svr $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI subject
-- when isSupervised $ mapSubject ("[SUPERVISOR] " <>)
addHtmlMarkdownAlternatives html
return True
return $ or oks return $ or oks