chore(letter): enable direct letter mails
This commit is contained in:
parent
4c5ce11b09
commit
785b97df76
@ -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
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user