From 6d7209b3da4ee295b5c7a0f0defcb1bbeef1c81f Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 6 Sep 2022 17:46:01 +0200 Subject: [PATCH] refactor(pdf): more useful filenames generated --- src/Handler/Utils/Users.hs | 20 ++++++++++++++++++- .../Handler/SendNotification/Qualification.hs | 12 ++++++----- src/Utils/Print.hs | 6 ++++-- 3 files changed, 30 insertions(+), 8 deletions(-) diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 7304904dc..5a50fcd79 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -9,6 +9,7 @@ module Handler.Utils.Users , UserAssimilateException(..), UserAssimilateExceptionReason(..) , assimilateUser , userPrefersEmail, userPrefersLetter + , abbrvName ) where import Import @@ -41,8 +42,25 @@ import qualified Data.Text as Text import Jobs.Types(Job, JobChildren) +abbrvName :: User -> Text +abbrvName User{userDisplayName, userFirstName, userSurname} = + if | (lastDisplayName : tsrif) <- reverse nameParts + -> assemble $ reverse $ lastDisplayName : abbreviate tsrif + | otherwise + -> assemble $ abbreviate (Text.words userFirstName) <> [userSurname] + where + nameParts = Text.words userDisplayName + abbreviate = fmap (Text.take 1) + assemble = Text.intercalate "." + + userPrefersLetter :: User -> Bool -userPrefersLetter User{..} = (userPrefersPostal || Text.null (CI.original userEmail)) && isJust userPostAddress +userPrefersLetter User{..} + = isJust userPostAddress && + ( userPrefersPostal || + isNothing userPinPassword || + Text.null (CI.original userEmail) + ) userPrefersEmail :: User -> Bool userPrefersEmail = not . userPrefersLetter diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index db2025152..8642f3b06 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -62,7 +62,8 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do letterDate <- formatTimeUser SelFormatDate now $ Just entRecipient expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient - let prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address + let printJobName = "RenewalPin" + prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address pdfMeta = mkMeta [ toMeta "date" letterDate , toMeta "lang" (selectDeEn userLanguages) -- select either German or English only, see Utils.Lang @@ -80,8 +81,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do error $ unpack msg Right pdf | userPrefersLetter recipient -> do - let printJobName = "Renewal" - printSender = Nothing + let printSender = Nothing runDB (sendLetter printJobName pdf printSender (Just jRecipient) Nothing (Just nQualification)) >>= \case Left err -> do let msg = "Notify " <> tshow jRecipient <> " PDF printing to send letter failed with error: " <> err @@ -98,13 +98,15 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do replaceMailHeader "Auto-Submitted" $ Just "auto-generated" setSubjectI $ MsgMailSubjectQualificationRenewal qname + let fileName = printJobName <> "_" <> abbrvName recipient <> ".pdf" + encryptPDF (fromMaybe "tomatenmarmelade" userPinPassword) pdf >>= \case -- TODO Left err -> do - let msg = "Notify " <> tshow jRecipient <> " PDF encryption failed with error: " <> err + let msg = "Notify " <> tshow jRecipient <> " PDF encryption failed with error: " <> err $logErrorS "LMS" msg Right pdffile -> do - addPart (File { fileTitle = "RenewalPinLetter.pdf" -- TODO: better file title! + addPart (File { fileTitle = Text.unpack fileName , fileModified = now , fileContent = Just $ yield $ LBS.toStrict pdffile } :: PureFile) diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 6e54d84ee..0d33de782 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -30,6 +30,8 @@ import qualified Text.Pandoc.Builder as P import System.Exit import System.Process.Typed -- for calling pdftk for pdf encryption +import Handler.Utils.Users (abbrvName) + -- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly? {- Recall: @@ -267,8 +269,8 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin sender <- join <$> mapM get printJobSender course <- join <$> mapM get printJobCourse quali <- join <$> mapM get printJobQualification - let nameRecipient = userDisplayName <$> recipient - nameSender = userDisplayName <$> sender + let nameRecipient = abbrvName <$> recipient + nameSender = abbrvName <$> sender nameCourse = CI.original . courseShorthand <$> course nameQuali = CI.original . qualificationShorthand <$> quali let printJobAcknowledged = Nothing