chore(letter): generic supervisor letter working

This commit is contained in:
Steffen Jost 2022-11-10 13:10:37 +01:00
parent a7949aba9c
commit 7528c6ec0b
9 changed files with 159 additions and 125 deletions

View File

@ -55,7 +55,7 @@ LmsErrorNoRefreshElearning: Fehler: E-Learning wird nicht automatisch gestartet,
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig
MailBodyQualificationRenewal: Sie müssen diese Qualifikaton demnächst durch einen E-Learning Kurs erneuern. MailBodyQualificationRenewal qname@Text: Sie müssen Qualifikaton #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang.
MailBodyQualificationExpiry: Diese Qualifikaton läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden! MailBodyQualificationExpiry: Diese Qualifikaton läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden!
MailBodyQualificationExpired: Diese Qualifikaton is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E-Learning. MailBodyQualificationExpired: Diese Qualifikaton is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E-Learning.
LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort hinterlegt wurde, ist das PDF-Passwort Ihre Fraport Ausweisnummer, inklusive Punkt und der Ziffer danach. LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort hinterlegt wurde, ist das PDF-Passwort Ihre Fraport Ausweisnummer, inklusive Punkt und der Ziffer danach.

View File

@ -52,10 +52,10 @@ LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsDirectUpload: Direct upload for automated Systems LmsDirectUpload: Direct upload for automated Systems
LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically due to refresh-within time period not being set. LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically due to refresh-within time period not being set.
MailSubjectQualificationRenewal qname@Text: Qualification #{qname} must be renewed shortly MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
MailSubjectQualificationExpiry qname@Text: Qualification #{qname} expires soon MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
MailSubjectQualificationExpired qname@Text: Qualification #{qname} is no longer valid MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
MailBodyQualificationRenewal: You will soon need to renew this qualficiation by completing an e-learning course. MailBodyQualificationRenewal qname: You will soon need to renew qualficiation #{qname} by completing an e-learning course. For details see attachment.
MailBodyQualificationExpiry: This qualificaton expires soon. You may then no longer execute any duties that require this qualification as a precondition! MailBodyQualificationExpiry: This qualificaton expires soon. You may then no longer execute any duties that require this qualification as a precondition!
MailBodyQualificationExpired: This qualificaton is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e-learning. MailBodyQualificationExpired: This qualificaton is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e-learning.
LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with your chosen FRADrive PDF-Password. If you have not yet chosen a PDF-Password yet, then the password is your Fraport id card number, inkluding the punctuation mark and the Digit thereafter. LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with your chosen FRADrive PDF-Password. If you have not yet chosen a PDF-Password yet, then the password is your Fraport id card number, inkluding the punctuation mark and the Digit thereafter.

View File

@ -68,10 +68,20 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u
PWHashConf{..} <- getsYesod $ view _appAuthPWHash PWHashConf{..} <- getsYesod $ view _appAuthPWHash
pwHash <- liftIO $ PWStore.makePasswordWith pwHashAlgorithm pw pwHashStrength pwHash <- liftIO $ PWStore.makePasswordWith pwHashAlgorithm pw pwHashStrength
return $ AuthPWHash $ TEnc.decodeUtf8 pwHash return $ AuthPWHash $ TEnc.decodeUtf8 pwHash
let expiryOffsets = concatMap (replicate usersPerDay) [0..(diffDays dto dfrom)] theSupervisor <- selectKeysList [UserSurname ==. "Jost", UserFirstName ==. "Steffen"] [Asc UserCreated, LimitTo 1]
let addSupervisor = case theSupervisor of
[s] -> \suid k -> case k of
1 -> void $ insertBy $ UserSupervisor s suid True
2 -> do
void $ insertBy $ UserSupervisor s suid True
void $ insertBy $ UserSupervisor suid suid True
3 -> void $ insertBy $ UserSupervisor s suid True
_ -> return ()
_ -> \_ _ -> return ()
expiryOffsets = concatMap (replicate usersPerDay) [0..(diffDays dto dfrom)]
expiryNotifyDay = addGregorianDurationClip (fromMaybe calendarDay qualificationRefreshWithin) dfrom expiryNotifyDay = addGregorianDurationClip (fromMaybe calendarDay qualificationRefreshWithin) dfrom
fakeUser :: ([Text], UserSurname, (Maybe Languages, DateTimeFormat, DateTimeFormat, DateTimeFormat), Bool) -> User fakeUser :: ([Text], UserSurname, (Maybe Languages, DateTimeFormat, DateTimeFormat, DateTimeFormat), Bool, Int) -> User
fakeUser (firstNames, userSurname, (userLanguages, userDateTimeFormat, userDateFormat, userTimeFormat), userPrefersPostal) = fakeUser (firstNames, userSurname, (userLanguages, userDateTimeFormat, userDateFormat, userTimeFormat), userPrefersPostal, _isSupervised) =
let userIdent = CI.mk $ Text.intercalate "." (take 1 firstNames ++ (Text.take 1 <$> drop 1 firstNames) ++ [userSurname]) <> "@example.com" let userIdent = CI.mk $ Text.intercalate "." (take 1 firstNames ++ (Text.take 1 <$> drop 1 firstNames) ++ [userSurname]) <> "@example.com"
userEmail = userIdent userEmail = userIdent
userDisplayEmail = userIdent userDisplayEmail = userIdent
@ -122,6 +132,7 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u
[ QualificationUserValidUntil =. qualificationUserValidUntil [ QualificationUserValidUntil =. qualificationUserValidUntil
, QualificationUserLastRefresh =. qualificationUserLastRefresh , QualificationUserLastRefresh =. qualificationUserLastRefresh
] ]
addSupervisor uid (user ^. _5)
return $ either (const 0) (const 1) euid return $ either (const 0) (const 1) euid
-- ok <- insertUnique QualificationUser{..} -- We do not overwrite any existing qualifications, just to be on the save side: -- ok <- insertUnique QualificationUser{..} -- We do not overwrite any existing qualifications, just to be on the save side:
-- return $ maybe 0 (const 1) ok -- return $ maybe 0 (const 1) ok
@ -154,11 +165,13 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u
, (Just $ Languages ["fr"] , DateTimeFormat "%d-%m-%Y %R" , DateTimeFormat "%d-%m-%Y" , DateTimeFormat "%R") , (Just $ Languages ["fr"] , DateTimeFormat "%d-%m-%Y %R" , DateTimeFormat "%d-%m-%Y" , DateTimeFormat "%R")
, (Just $ Languages ["fr","en"] , DateTimeFormat "%B %d %Y %R" , DateTimeFormat "%B %d %y" , DateTimeFormat "%I:%M:%S %p") , (Just $ Languages ["fr","en"] , DateTimeFormat "%B %d %Y %R" , DateTimeFormat "%B %d %y" , DateTimeFormat "%I:%M:%S %p")
] ]
postal = [False, True, False] postal = [False, True, False]
supervised = [0,1,2,3]
names = getZipList $ (\f m s l p -> (f : concat m, s, l, p)) names = getZipList $ (\f m s l p v -> (f : concat m, s, l, p, v))
<$> ZipList (cycle givenNames) <$> ZipList (cycle givenNames)
<*> ZipList (cycle middlenames) <*> ZipList (cycle middlenames)
<*> ZipList (cycle surnames) <*> ZipList (cycle surnames)
<*> ZipList (cycle someLangs) <*> ZipList (cycle someLangs)
<*> ZipList (cycle postal) <*> ZipList (cycle postal)
<*> ZipList (cycle supervised)

View File

@ -153,6 +153,7 @@ getLmsUsersR sid qsh = do
getLmsUsersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent getLmsUsersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
getLmsUsersDirectR sid qsh = do getLmsUsersDirectR sid qsh = do
$logInfoS "LMS" $ "Direct Download Users for " <> tshow qsh <> " at " <> tshow sid
lms_users <- runDB $ do lms_users <- runDB $ do
qid <- getKeyBy404 $ SchoolQualificationShort sid qsh qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
selectList [LmsUserQualification ==. qid, LmsUserEnded ==. Nothing] [Asc LmsUserStarted, Asc LmsUserIdent] selectList [LmsUserQualification ==. qid, LmsUserEnded ==. Nothing] [Asc LmsUserStarted, Asc LmsUserIdent]

View File

@ -14,13 +14,8 @@ import Import
import Utils.Print import Utils.Print
import Handler.Utils import Handler.Utils
import Handler.Utils.Users
import Jobs.Handler.SendNotification.Utils import Jobs.Handler.SendNotification.Utils
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as Text
-- import Handler.Info (FAQItem(..)) -- import Handler.Info (FAQItem(..))
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import Text.Hamlet import Text.Hamlet
@ -68,89 +63,35 @@ dispatchNotificationQualificationExpired nQualification dExpired jRecipient = us
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpired.hamlet") addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpired.hamlet")
-- NOTE: qualificationRenewal expects that LmsUser already exists for recipient -- NOTE: Renewal expects that LmsUser already exists for recipient
dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler () dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler ()
dispatchNotificationQualificationRenewal nQualification jRecipient = do dispatchNotificationQualificationRenewal nQualification jRecipient = do
(recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}, Entity luid LmsUser{..}) <- runDB $ (,,,)
<$> getJust jRecipient
<*> getJust nQualification
<*> getJustBy (UniqueQualificationUser nQualification jRecipient)
<*> getJustBy (UniqueLmsQualificationUser nQualification jRecipient)
encRecipient :: CryptoUUIDUser <- encrypt jRecipient encRecipient :: CryptoUUIDUser <- encrypt jRecipient
let entRecipient = Entity jRecipient recipient query <- runDB $ (,,,)
qname = CI.original qualificationName <$> get jRecipient
<*> get nQualification
$logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname <*> getBy (UniqueQualificationUser nQualification jRecipient)
<*> getBy (UniqueLmsQualificationUser nQualification jRecipient)
now <- liftIO getCurrentTime case query of
letterDate <- formatTimeUser SelFormatDate now $ Just entRecipient (Just User{userDisplayName}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient let qname = CI.original qualificationName
let letter = LetterRenewQualificationF
let printJobName = "RenewalPin" { lmsLogin = lmsUserIdent
fileName = printJobName <> "_" <> (text2asciiAlphaNum . abbrvName) recipient <> ".pdf" , lmsPin = lmsUserPin
lmsIdent = lmsUserIdent & getLmsIdent , qualHolder = userDisplayName
lmsUrl = "https://drive.fraport.de" , qualExpiry = qualificationUserValidUntil
lmsLogin = lmsUrl <> "/?login=" <> lmsIdent , qualId = nQualification
prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address, once implemented , qualName = qname
pdfMeta = mkMeta , qualShort = CI.original qualificationShorthand
[ toMeta "date" letterDate , qualDuration = qualificationValidDuration
, toMeta "lang" (selectDeEn userLanguages) -- select either German or English only, see Utils.Lang }
, toMeta "login" lmsIdent $logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname
, toMeta "pin" lmsUserPin notifyOk <- sendEmailOrLetter jRecipient letter
, toMeta "examinee" userDisplayName when notifyOk $ do
, mbMeta "address" (prepAddress <$> userPostAddress) -- TODO: this is buggy if there is no address set! now <- liftIO getCurrentTime
, toMeta "expiry" expiryDate runDB $ update luid [ LmsUserNotified =. Just now]
, mbMeta "validduration" (show <$> qualificationValidDuration) (_, Nothing, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: Qualification " <> tshow nQualification <> " does not exist!"
, toMeta "url-text" lmsUrl (Nothing, _, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: User does not exist!"
, toMeta "url" lmsLogin (_, _, Nothing, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: QualificationUser does not exist, i.e. user does not have this qualification!"
] (_, _, _, Nothing) -> $logWarnS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: LmsUser does not exist!"
emailRenewal attachment
| Text.null (CI.original userEmail) = do -- if neither email nor postal address is known, we must abort!
let msg = "Notify " <> tshow encRecipient <> " failed: no email nor address for user known!"
$logErrorS "LMS" msg
return False
| otherwise = do
userMailT jRecipient $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectQualificationRenewal qname
editNotifications <- mkEditNotifications jRecipient
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
whenIsJust attachment $ \afile ->
addPart (File { fileTitle = Text.unpack fileName
, fileModified = now
, fileContent = Just $ yield $ LBS.toStrict afile
} :: PureFile)
return True
notifyOk <- pdfRenewal pdfMeta >>= \case
Right pdf | userPrefersLetter recipient -> -- userPrefersLetter is false if both userEmail and userPostAddress are null
let printSender = Nothing
in runDB (sendLetter' printJobName pdf (Just jRecipient, printSender) Nothing (Just nQualification) (Just lmsUserIdent)) >>= \case
Left err -> do
let msg = "Notify " <> tshow encRecipient <> ": PDF printing to send letter failed with error " <> cropText err
$logErrorS "LMS" msg
return False
Right (msg,_)
| null msg -> return True
| otherwise -> do
$logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg
return True
Right pdf -> do
attch <- case userPinPassword of
Nothing -> return $ Just pdf -- attach unencrypted, since there is no password set
Just passwd -> encryptPDF passwd pdf >>= \case
Right encPdf -> return $ Just encPdf -- attach encrypted
Left err -> do -- send email without attachment, so that the user is at least notified about the expiry
let msg = "Notify " <> tshow encRecipient <> " PDF encryption failed with error: " <> cropText err
$logErrorS "LMS" msg
return Nothing
emailRenewal attch
Left err -> do
let msg = "Notify " <> tshow encRecipient <> " PDF generation failed with error: " <> cropText err
$logErrorS "LMS" msg
emailRenewal Nothing
when notifyOk $ runDB $ update luid [ LmsUserNotified =. Just now]

View File

@ -7,6 +7,7 @@
module Utils.Print module Utils.Print
( pdfRenewal ( pdfRenewal
, sendLetter, sendLetter' , sendLetter, sendLetter'
, sendEmailOrLetter
, encryptPDF , encryptPDF
, sanitizeCmdArg, validCmdArgument , sanitizeCmdArg, validCmdArgument
, templateDIN5008 , templateDIN5008
@ -15,6 +16,7 @@ module Utils.Print
, _Meta, addMeta , _Meta, addMeta
, toMeta, mbMeta -- single values , toMeta, mbMeta -- single values
, mkMeta, appMeta, applyMetas -- multiple values , mkMeta, appMeta, applyMetas -- multiple values
, LetterRenewQualificationF(..)
) where ) where
-- import Import.NoModel -- import Import.NoModel
@ -40,6 +42,7 @@ import System.Process.Typed -- for calling pdftk for pdf encryption
import Handler.Utils.Users import Handler.Utils.Users
import Handler.Utils.DateTime import Handler.Utils.DateTime
import Handler.Utils.Mail import Handler.Utils.Mail
import Handler.Utils.Widgets (nameHtml')
import Jobs.Handler.SendNotification.Utils import Jobs.Handler.SendNotification.Utils
-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly? -- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly?
@ -363,24 +366,28 @@ convertProto f (IsTime t) = P.toMetaValue $ f t
-} -}
class MDLetter l where class MDLetter l where
getTemplate :: Proxy l -> Text getTemplate :: Proxy l -> Text
getSubject :: Proxy l -> SomeMessage UniWorX getMailSubject :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
letterMeta :: l -> Lang -> DateTimeFormatter -> P.Meta getMailBody :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
getPJId :: l -> PrintJobIdentification letterMeta :: l -> Lang -> DateTimeFormatter -> P.Meta
getPJId :: l -> PrintJobIdentification
data LetterRenewQualificationF = LetterRenewQualificationF data LetterRenewQualificationF = LetterRenewQualificationF
{ lmsLogin :: LmsIdent { lmsLogin :: LmsIdent
, lmsPin :: Text , lmsPin :: Text
, qualId :: QualificationId , qualHolder :: UserDisplayName
, qualHolder :: Text
, qualExpiry :: Day , qualExpiry :: Day
, qualId :: QualificationId
, qualName :: Text
, qualShort :: Text
, qualDuration :: Maybe Int , qualDuration :: Maybe Int
} }
deriving (Eq, Show) deriving (Eq, Show)
instance MDLetter LetterRenewQualificationF where instance MDLetter LetterRenewQualificationF where
getTemplate _ = templateRenewal getTemplate _ = templateRenewal
getSubject _ = SomeMessage $ MsgMailSubjectQualificationRenewal "F" getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l
letterMeta LetterRenewQualificationF{..} _lang DateTimeFormatter{ format } = mkMeta letterMeta LetterRenewQualificationF{..} _lang DateTimeFormatter{ format } = mkMeta
[ toMeta "login" lmsIdent [ toMeta "login" lmsIdent
, toMeta "pin" lmsPin , toMeta "pin" lmsPin
@ -404,31 +411,37 @@ instance MDLetter LetterRenewQualificationF where
, pjiLmsUser = Just lmsLogin , pjiLmsUser = Just lmsLogin
} }
sendEmailOrLetter :: (MDLetter l) => UserId -> l -> m Bool sendEmailOrLetter :: (MDLetter l) => UserId -> l -> Handler Bool
sendEmailOrLetter recipient letter = do sendEmailOrLetter recipient letter = do
(underling, receivers, undercopy) <- liftHandler . runDB $ getReceivers recipient (underling, receivers, undercopy) <- liftHandler . runDB $ getReceivers recipient
let tmpl = getTemplate $ pure letter let tmpl = getTemplate $ pure letter
pjid = getPJId letter pjid = getPJId letter
-- Below are only needed if sent by email
mailSubject = getMailSubject letter
mailBody = getMailBody letter
undername = underling ^. _userDisplayName -- nameHtml' underling
undermail = CI.original $ underling ^. _userEmail
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
oks <- forM receivers $ \rcvr@Entity{ entityKey = svr, entityVal = rcvrUsr } -> do oks <- forM receivers $ \Entity{ entityKey = svr, entityVal = rcvrUsr } -> do
formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvrUsr formatter@DateTimeFormatter{ format } <- getDateTimeFormatterUser' rcvrUsr
let (preferPost,postal) = getPostalPreferenceAndAddress rcvrUsr let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr
-- continue here, since post = Nothing might happen here?! isSupervised = recipient /= svr
lang = selectDeEn $ rcvrUsr & userLanguages -- select either German or English only, default de; see Utils.Lang lang = selectDeEn $ rcvrUsr & userLanguages -- select either German or English only, default de; see Utils.Lang
lMeta = letterMeta letter lang formatter <> mkMeta lMeta = letterMeta letter lang formatter <> mkMeta
[ toMeta "lang" lang [ toMeta "lang" lang
, toMeta "date" $ format SelFormatDate now , toMeta "date" $ format SelFormatDate now
, toMeta "address" $ fromMaybe (rcvrUsr & userDisplayName) postal , toMeta "address" $ fromMaybe [rcvrUsr & userDisplayName] postal
, mbMeta "supervisor" $ toMaybe isSupervised (rcvrUsr & userDisplayName)
] ]
pdfLetter tmpl lMeta >>= \case pdfLetter tmpl lMeta >>= \case
_ | preferPost, isNothing postal -> do -- neither email nor postal is known _ | preferPost, isNothing postal -> do -- neither email nor postal is known
encRecipient :: CryptoUUIDUser <- encrypt svr encRecipient :: CryptoUUIDUser <- encrypt svr
let msg = "Notification failed for " <> tshow encRecipient <> ", who has neither a known email nor postal address. Notfication: " <> 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 Left err -> do -- pdf generation failed
encRecipient :: CryptoUUIDUser <- encrypt svr encRecipient :: CryptoUUIDUser <- encrypt svr
let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed. Notfication: " <> tshow pjid let msg = "Notification failed for " <> tshow encRecipient <> ". PDF generation failed: "<> cropText err <> "For Notification: " <> tshow pjid
$logErrorS "LETTER" msg $logErrorS "LETTER" msg
return False return False
Right pdf | preferPost -> -- send letter Right pdf | preferPost -> -- send letter
@ -448,17 +461,17 @@ sendEmailOrLetter recipient letter = do
Nothing -> return pdf Nothing -> return pdf
Just passwd -> encryptPDF passwd pdf >>= \case Just passwd -> encryptPDF passwd pdf >>= \case
Right encPdf -> return encPdf Right encPdf -> return encPdf
Left err -> do Left err -> do
encRecipient :: CryptoUUIDUser <- encrypt svr encRecipient :: CryptoUUIDUser <- encrypt svr
let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err let msg = "Notification for " <> tshow encRecipient <> " has unencrypted attachment. Encrypting PDF failed: " <> cropText err
$logWarnS "LETTER" msg $logWarnS "LETTER" msg
return pdf return pdf
userMailTdirect svr $ do userMailTdirect svr $ do
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ getSubject $ pure letter setSubjectI mailSubject
editNotifications <- mkEditNotifications svr editNotifications <- mkEditNotifications svr
-- TODO: create generic template let supername = rcvrUsr ^. _userDisplayName -- nameHtml' rcvrUsr
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet") addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/genericMailLetter.hamlet")
addPart (File { fileTitle = T.unpack $ pjiName pjid addPart (File { fileTitle = T.unpack $ pjiName pjid
, fileModified = now , fileModified = now
, fileContent = Just $ yield $ LBS.toStrict attachment , fileContent = Just $ yield $ LBS.toStrict attachment

View File

@ -53,13 +53,24 @@ $endfor$
$if(is-de)$ $if(is-de)$
<!-- deutsche Version des Briefes --> <!-- deutsche Version des Briefes -->
die Gültigkeit des Vorfeldführerscheins läuft demnächst ab. die Gültigkeit
$if(supervisor)$
des Vorfeldführerscheins von $examinee$
$else$
Ihres Vorfeldführerscheins
$endif$
läuft bald ab.
Durch die erfolgreiche Teilnahme an einem E-Learning kann die Gültigkeit Durch die erfolgreiche Teilnahme an einem E-Learning kann die Gültigkeit
$if(validduration)$ $if(validduration)$
um $validduration$ Monate um $validduration$ Monate
$endif$ $endif$
verlängert werden. Dazu bitte die Login-Daten verlängert werden.
aus dem geschützen Sichtfenster weiter unten verwenden. $if(supervisor)$
Ansprechpartner werden gebeten, die Login-Daten aus dem geschützen Sichtfenster weiter unten
vertraulich an den Prüfling weiterzuleiten.
$else$
Dazu bitte die Login-Daten aus dem geschützen Sichtfenster weiter unten verwenden.
$endif$
Prüfling Prüfling
@ -84,13 +95,24 @@ $else$
<!-- englische Version des Briefes --> <!-- englische Version des Briefes -->
the apron diving license is about to expire soon. $if(supervisor)$
the apron diving license of $examinee$
$else$
your apron diving license
$endif$
is about to expire soon.
The validity may be extended The validity may be extended
$if(validduration)$ $if(validduration)$
by $validduration$ months by $validduration$ months
$endif$ $endif$
by successfully participating in by successfully participating in
an e-learning. Please use the login data from the protected area below. an e-learning.
$if(supervisor)$
Supervisors are kindly requested to confidentially forward the login data
from the protected area below to the examinee.
$else$
Please use the login data from the protected area below.
$endif$
Examinee Examinee

View File

@ -0,0 +1,44 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
\<!doctype html>
<html>
<head>
<meta charset="UTF-8">
<style>
h1 {
font-size: 1.25em;
font-variant: small-caps;
font-weight: normal;
}
<body>
<h1>
_{mailSubject}
<p>
_{mailBody}
$if isSupervised
<h2>_{SomeMessage MsgMailSupervisorNote}
<p>
_{SomeMessage (MsgMailSupervisorBody undername supername)} #
<a href=@{NewsR}>
FRADrive
.
$if undercopy
_{SomeMessage (MsgMailSupervisorCopy undermail)}
$else
_{SomeMessage MsgMailSupervisorNoCopy}
$else
<h2>_{SomeMessage MsgMailSupervisedNote}
<p>
_{SomeMessage MsgMailSupervisedBody}
<ul>
$forall svr <- receivers
<li>
#{nameHtml' svr}
^{ihamletSomeMessage editNotifications}

View File

@ -19,7 +19,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{SomeMessage $ MsgMailSubjectQualificationRenewal qname} _{SomeMessage $ MsgMailSubjectQualificationRenewal qname}
<p> <p>
_{SomeMessage MsgMailBodyQualificationRenewal} _{SomeMessage MsgMailBodyQualificationRenewal qname}
<p> <p>
<dl> <dl>