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

123
src/Utils/Print.hs
View File

@ -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
| otherwise -> do
$logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
return True
Right pdf -> do -- send email
let pdfPass = case encryptPDFfor letter of
NoPassword -> Nothing
PasswordSupervisor -> rcvrUsr ^. _userPinPassword
PasswordUnderling -> underling ^. _userPinPassword
attachment <- case pdfPass of
Nothing -> return pdf
Just passwd -> encryptPDF passwd pdf >>= \case
Right encPdf -> return encPdf
Left err -> do Left err -> do
let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err let msg = "Notification failed for " <> tshow encRecipient <> ". PDF printing failed. The print job could not be sent: " <> cropText err
$logWarnS "LETTER" msg $logErrorS "LETTER" msg
return pdf return False
formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale Right (msg,_)
let isSupervised = recipient /= svr | null msg -> return True
supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr | otherwise -> do
mailBody <- getMailBody letter formatter $logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg
userMailTdirect svr $ do return True
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI mailSubject (False, _) | attachPDFLetter letter -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, with pdf attached
editNotifications <- mkEditNotifications svr Left err -> do -- pdf generation failed
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet") let msg = "Notification failed for " <> tshow encRecipient <> ". PDF attachment generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
addPart (File { fileTitle = fName $logErrorS "LETTER" msg
, fileModified = now return False
, fileContent = Just $ yield $ LBS.toStrict attachment Right pdf -> do -- pdf generated, send as email attachment now
} :: PureFile) let pdfPass = case encryptPDFfor letter of
return True NoPassword -> Nothing
PasswordSupervisor -> rcvrUsr ^. _userPinPassword
PasswordUnderling -> underling ^. _userPinPassword
attachment <- case pdfPass of
Nothing -> return pdf
Just passwd -> encryptPDF passwd pdf >>= \case
Right encPdf -> return encPdf
Left err -> do
let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
$logWarnS "LETTER" msg
return pdf
formatter <- getDateTimeFormatterUser' rcvrUsr -- not too expensive, only calls getTimeLocale
let isSupervised = recipient /= svr
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