From 785b97df76b08665771ae91a1eb01c3e2a05e40e Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 8 May 2023 17:58:37 +0000 Subject: [PATCH] chore(letter): enable direct letter mails --- src/Utils/Print.hs | 129 +++++++++++++++++++++++++-------------------- 1 file changed, 73 insertions(+), 56 deletions(-) diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index c2a8d198d..f1d3054de 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -288,7 +288,7 @@ printLetter'' _ = do -} 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 now <- liftIO getCurrentTime 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 undername = underling ^. _userDisplayName -- nameHtml' underling undermail = CI.original $ underling ^. _userEmail + mr <- getMessageRender + let mailSupervisorSubject = SomeMessage $ "[SUPERVISOR] " <> mr mailSubject oks <- forM receivers $ \rcvrEnt@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do encRecipient :: CryptoUUIDUser <- encrypt svr apcIdent <- letterApcIdent letter encRecipient now - -- case getPostalPreferenceAndAddress rcvrUsr of - -- (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 + case getPostalPreferenceAndAddress rcvrUsr of + (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 - Left err -> do -- pdf generation failed - let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid - $logErrorS "LETTER" msg - return False - 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 + + (True , Just _postal) -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send printed letter + Left err -> do -- pdf generation failed + let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid $logErrorS "LETTER" msg - return False - Right (msg,_) - | 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 - 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 + return False + Right pdf -> 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 + return False + Right (msg,_) + | null msg -> return True + | otherwise -> do + $logWarnS "LETTER" $ "PDF printing to send letter with lpr returned ExitSuccess and the following message: " <> msg + return True + + (False, _) | attachPDFLetter letter -> renderLetterPDF rcvrEnt letter apcIdent >>= \case -- send Email, with pdf attached + Left err -> do -- pdf generation failed + let msg = "Notification failed for " <> tshow encRecipient <> ". PDF attachment generation failed: "<> cropText err <> "For Notification: " <> tshow pjid + $logErrorS "LETTER" msg + return False + Right pdf -> do -- pdf generated, send as email attachment now + 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 + 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