lms(notify): complete notifications and fix various bugs

This commit is contained in:
Steffen Jost 2022-09-02 18:53:34 +02:00
parent bdfb38d8dc
commit 20e33bbe13
12 changed files with 130 additions and 96 deletions

View File

@ -9,10 +9,10 @@ QualificationElearningStart: E-Lernen automatisch starten
TableQualificationCountActive: Aktive TableQualificationCountActive: Aktive
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
TableQualificationCountTotal: Gesamt TableQualificationCountTotal: Gesamt
TableQualificationValidUntil: Gültig bis LmsQualificationValidUntil: Gültig bis
TableQualificationLastRefresh: Zuletzt erneuert TableQualificationLastRefresh: Zuletzt erneuert
TableQualificationFirstHeld: Erstmalig TableQualificationFirstHeld: Erstmalig
TableLmsUser: Ermächtigter LmsUser: Inhaber
TableLmsEmail: E-Mail TableLmsEmail: E-Mail
TableLmsIdent: Identifikation TableLmsIdent: Identifikation
TableLmsElearning: E-Lernen TableLmsElearning: E-Lernen
@ -44,9 +44,12 @@ LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsDirectUpload: Direkter Upload für automatisierte Systeme LmsDirectUpload: Direkter Upload für automatisierte Systeme
LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde. LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
MailSubjectQualificationRenewal qname@Text: Ihre Qualifikation #{qname} muss demnächst erneuert werden MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
MailSubjectQualificationExpiry qname@Text: Ihre Qualifikation #{qname} läuft demnächst ab MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
MailLmsRenewalBody: Sie müssen diese Qualifikaton demnächst durch einen E-Lernen Kurs erneuern. MailBodyQualificationRenewal: Sie müssen diese Qualifikaton demnächst durch einen E-Lernen Kurs erneuern.
MailBodyQualificationExpiry: Diese Qualifikaton läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden!
LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PIN-Passwort verschlüsselt. Falls kein PIN-Passwort hinterlegt wurde, ist das Passwort ihre Fraport Ausweisnummer, inklusive Punkt und der Ziffer danach.
LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Lernen verlängert werden.
LmsActNotify: Benachrichtigung E-Lernen erneut per Post oder E-Mail versenden LmsActNotify: Benachrichtigung E-Lernen erneut per Post oder E-Mail versenden
LmsActRenewPin: Neue zufällige E-Lernen PIN zuweisen LmsActRenewPin: Neue zufällige E-Lernen PIN zuweisen
LmsActRenewNotify: Neue zufällige E-Lernen PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden LmsActRenewNotify: Neue zufällige E-Lernen PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden

View File

@ -9,10 +9,10 @@ QualificationElearningStart: Start e-learning automatically
TableQualificationCountActive: Active TableQualificationCountActive: Active
TableQualificationCountActiveTooltip: Number of currently valid qualification holders TableQualificationCountActiveTooltip: Number of currently valid qualification holders
TableQualificationCountTotal: Total TableQualificationCountTotal: Total
TableQualificationValidUntil: Valid until LmsQualificationValidUntil: Valid until
TableQualificationLastRefresh: Last renewed TableQualificationLastRefresh: Last renewed
TableQualificationFirstHeld: First held TableQualificationFirstHeld: First held
TableLmsUser: Licensee LmsUser: Licensee
TableLmsEmail: Email TableLmsEmail: Email
TableLmsIdent: Identifier TableLmsIdent: Identifier
TableLmsPin: E-learning pin TableLmsPin: E-learning pin
@ -29,7 +29,7 @@ TableLmsSuccess: Completed
TableLmsFailed: Blocked TableLmsFailed: Blocked
FilterLmsValid: Currently valid FilterLmsValid: Currently valid
FilterLmsRenewal: Renewal due FilterLmsRenewal: Renewal due
CsvColumnLmsIdent: E-learning identifier, unique for each qualfication and user CsvColumnLmsIdent: E-learning identifier, unique for each qualification and user
CsvColumnLmsPin: PIN for e-learning access CsvColumnLmsPin: PIN for e-learning access
CsvColumnLmsResetPin: Will the e-learning PIN be reset upon next synchronisation? CsvColumnLmsResetPin: Will the e-learning PIN be reset upon next synchronisation?
CsvColumnLmsDelete: Will the identifier be deleted from the E-learning platfrom upon next synchronisation? CsvColumnLmsDelete: Will the identifier be deleted from the E-learning platfrom upon next synchronisation?
@ -44,9 +44,12 @@ 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: Your qualification #{qname} must be renewed shortly MailSubjectQualificationRenewal qname@Text: Qualification #{qname} must be renewed shortly
MailSubjectQualificationExpiry qname@Text: Your qualification #{qname} expires soon MailSubjectQualificationExpiry qname@Text: Qualification #{qname} expires soon
MailLmsRenewalBody: You will soon need to renew this qualficiation by completing an e-learning course. MailBodyQualificationRenewal: You will soon need to renew this qualficiation by completing an e-learning course.
MailBodyQualificationExpiry: This qualificaton expires soon. You may then no longer execute any duties that require this qualification as a precondition!
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 PIN-Password. If you have not yet chosen a PIN-Password yet, then the password is your Fraport id card number, inkluding the punctuation mark and the Digit thereafter.
LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only.
LmsActNotify: Resend e-learning notification by post or email LmsActNotify: Resend e-learning notification by post or email
LmsActRenewPin: Randomly replace e-learning PIN LmsActRenewPin: Randomly replace e-learning PIN
LmsActRenewNotify: Randomly replace e-learning PIN and re-send notification by post or email LmsActRenewNotify: Randomly replace e-learning PIN and re-send notification by post or email

View File

@ -225,9 +225,9 @@ instance Csv.DefaultOrdered LmsTableCsv where
instance CsvColumnsExplained LmsTableCsv where instance CsvColumnsExplained LmsTableCsv where
csvColumnsExplanations = genericCsvColumnsExplanations ltcOptions $ Map.fromList csvColumnsExplanations = genericCsvColumnsExplanations ltcOptions $ Map.fromList
[ ('ltcDisplayName, MsgTableLmsUser) [ ('ltcDisplayName, MsgLmsUser)
, ('ltcEmail , MsgTableLmsEmail) , ('ltcEmail , MsgTableLmsEmail)
, ('ltcValidUntil , MsgTableQualificationValidUntil) , ('ltcValidUntil , MsgLmsQualificationValidUntil)
, ('ltcLastRefresh, MsgTableQualificationLastRefresh) , ('ltcLastRefresh, MsgTableQualificationLastRefresh)
, ('ltcFirstHeld , MsgTableQualificationFirstHeld) , ('ltcFirstHeld , MsgTableQualificationFirstHeld)
, ('ltcLmsIdent , MsgTableLmsIdent) , ('ltcLmsIdent , MsgTableLmsIdent)
@ -358,7 +358,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
) )
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgTableLmsUser mPrev [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
, prismAForm (singletonFilter "lms-ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent) , prismAForm (singletonFilter "lms-ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
-- , prismAForm (singletonFilter "lms-status" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return (optionsPairs [(MsgTableLmsSuccess,"success"::Text),(MsgTableLmsFailed,"blocked")])) (fslI MsgTableLmsStatus) -- , prismAForm (singletonFilter "lms-status" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return (optionsPairs [(MsgTableLmsSuccess,"success"::Text),(MsgTableLmsFailed,"blocked")])) (fslI MsgTableLmsStatus)
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid) , prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
@ -436,9 +436,9 @@ postLmsR sid qsh = do
] ]
colChoices = mconcat colChoices = mconcat
[ dbSelectIf (applying _2) id (return . view (resultUser . _entityKey)) (\r -> isJust $ r ^? resultLmsUser) -- TODO: refactor using function "is" [ dbSelectIf (applying _2) id (return . view (resultUser . _entityKey)) (\r -> isJust $ r ^? resultLmsUser) -- TODO: refactor using function "is"
, colUserNameLinkHdr MsgTableLmsUser AdminUserR , colUserNameLinkHdr MsgLmsUser AdminUserR
, colUserEmail , colUserEmail
, sortable (Just "valid-until") (i18nCell MsgTableQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
, sortable (Just "lms-ident") (i18nLms MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid , sortable (Just "lms-ident") (i18nLms MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid

View File

@ -41,8 +41,8 @@ postLmsFakeR sid qsh = do
<h2>Hinweise: <h2>Hinweise:
<ul> <ul>
<li> Emails der generierten Teilnehmer enden auf <tt>@example.com<\tt> <li> Emails der generierten Teilnehmer enden auf <tt>@example.com</tt>
und die Matrikelnummer lautet <tt>TESTUSER<\tt>. und die Matrikelnummer lautet <tt>TESTUSER</tt>.
<li> Bereits vorhandene Teilnehmer mit gleicher Ident werden nicht neu generiert. <li> Bereits vorhandene Teilnehmer mit gleicher Ident werden nicht neu generiert.
<li> Vorhandene Qualifikationen solcher Teilnehmer werden einfach überschrieben. <li> Vorhandene Qualifikationen solcher Teilnehmer werden einfach überschrieben.
|] |]

View File

@ -178,9 +178,9 @@ mkLmsTable (Entity qid quali) = do
dbtRowKey = queryUser >>> (E.^. UserId) dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtColonnade = dbColonnade $ mconcat dbtColonnade = dbColonnade $ mconcat
[ colUserNameLinkHdr MsgTableLmsUser AdminUserR [ colUserNameLinkHdr MsgLmsUser AdminUserR
, colUserEmail , colUserEmail
, sortable (Just "valid-until") (i18nCell MsgTableQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
, sortable (Just "lms-ident") (i18nLms MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid , sortable (Just "lms-ident") (i18nLms MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid
@ -219,7 +219,7 @@ mkLmsTable (Entity qid quali) = do
) )
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailHdrUI MsgTableLmsUser mPrev [ fltrUserNameEmailHdrUI MsgLmsUser mPrev
, prismAForm (singletonFilter "lms-ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent) , prismAForm (singletonFilter "lms-ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
-- , prismAForm (singletonFilter "lms-status" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return (optionsPairs [(MsgTableLmsSuccess,"success"::Text),(MsgTableLmsFailed,"blocked")])) (fslI MsgTableLmsStatus) -- , prismAForm (singletonFilter "lms-status" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return (optionsPairs [(MsgTableLmsSuccess,"success"::Text),(MsgTableLmsFailed,"blocked")])) (fslI MsgTableLmsStatus)
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid) , prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)

View File

@ -150,7 +150,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
pure (quser, luser) pure (quser, luser)
let usr_job (quser, luser) = let usr_job (quser, luser) =
let vold = quser ^. _entityVal . _qualificationUserValidUntil let vold = quser ^. _entityVal . _qualificationUserValidUntil
pmonth = fromMonths $ fromMaybe 0 $ qualificationValidDuration quali -- TODO: decide how to deal with qualfication that have infinite validity?! pmonth = fromMonths $ fromMaybe 0 $ qualificationValidDuration quali -- TODO: decide how to deal with qualification that have infinite validity?!
vnew = addGregorianDurationClip pmonth vold vnew = addGregorianDurationClip pmonth vold
lmsstatus = luser ^. _entityVal . _lmsUserStatus lmsstatus = luser ^. _entityVal . _lmsUserStatus
in case lmsstatus of in case lmsstatus of

View File

@ -26,13 +26,17 @@ import Text.Hamlet
dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler () dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler ()
dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = userMailT jRecipient $ do dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = userMailT jRecipient $ do
(User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,) (recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
<$> getJust jRecipient <$> getJust jRecipient
<*> getJust nQualification <*> getJust nQualification
<*> getJustBy (UniqueQualificationUser nQualification jRecipient) <*> getJustBy (UniqueQualificationUser nQualification jRecipient)
let qname = CI.original qualificationName let entRecipient = Entity jRecipient recipient
qname = CI.original qualificationName
expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient
$logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " about expiry of qualification " <> qname $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " about expiry of qualification " <> qname
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectQualificationExpiry qname setSubjectI $ MsgMailSubjectQualificationExpiry qname
@ -55,49 +59,29 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
$logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualification " <> qname $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualification " <> qname
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
letterDate <- formatTimeUser SelFormatDate now $ Just entRecipient letterDate <- formatTimeUser SelFormatDate now $ Just entRecipient
expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient
let prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address let prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address
pdfMeta = mkMeta pdfMeta = mkMeta
[ toMeta "date" letterDate [ toMeta "date" letterDate
, toMeta "lang" (selectDeEn userLanguages) -- select either German or English only, see Utils.Lang , toMeta "lang" (selectDeEn userLanguages) -- select either German or English only, see Utils.Lang
, toMeta "login" (lmsUserIdent & getLmsIdent) , toMeta "login" (lmsUserIdent & getLmsIdent)
, toMeta "pin" lmsUserPin , toMeta "pin" lmsUserPin
, toMeta "recipient" userDisplayName , toMeta "recipient" userDisplayName
, mbMeta "address" (prepAddress <$> userPostAddress) , mbMeta "address" (prepAddress <$> userPostAddress)
, toMeta "expiry" expiryDate
, mbMeta "validduration" (show <$> qualificationValidDuration)
] ]
pdfRenewal pdfMeta >>= \case pdfRenewal pdfMeta >>= \case
Left err -> do Left err -> do
let msg = "Notify " <> tshow jRecipient <> " PDF generation failed with error: " <> err let msg = "Notify " <> tshow jRecipient <> " PDF generation failed with error: " <> err
$logErrorS "LMS" msg $logErrorS "LMS" msg
error $ unpack msg error $ unpack msg
Right pdf | userPrefersEmail recipient -> userMailT jRecipient $ do
-- userPrefersEmail is still true if both userEmail and userPostAddress are null
when (Text.null (CI.original userEmail)) $ $logErrorS "LMS" ("Notify " <> tshow jRecipient <> " failed: no email nor address for user known!")
replaceMailHeader "Auto-Submitted" $ Just "auto-generated" Right pdf | userPrefersLetter recipient -> do
setSubjectI $ MsgMailSubjectQualificationRenewal qname let printJobName = "Renewal"
printSender = Nothing
editNotifications <- mkEditNotifications jRecipient -- TODO: add to hamlet file again
-- let msgrenewal = $(i18nHamletFile "qualification/renewal") -- :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
-- addHtmlMarkdownAlternatives' msgrenewal
encryptPDF (fromMaybe "tomatenmarmelade" userPinPassword) pdf >>= \case -- TODO
Left err -> do
let msg = "Notify " <> tshow jRecipient <> " PDF encryption failed with error: " <> err
$logErrorS "LMS" msg
error $ unpack msg
Right pdffile -> do
addPart (File { fileTitle = "RenewalPinLetter.pdf" -- TODO: better file title!
, fileModified = now
, fileContent = Just $ yield $ LBS.toStrict pdffile
} :: PureFile)
-- TODO: this is just a dummy to continue while i18nHamletFile usage is unclear
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
Right pdf | otherwise -> do
let printJobName = mempty --TODO
printSender = Nothing --TODO
runDB (sendLetter printJobName pdf printSender (Just jRecipient) Nothing (Just nQualification)) >>= \case runDB (sendLetter printJobName pdf printSender (Just jRecipient) Nothing (Just nQualification)) >>= \case
Left err -> do Left err -> do
let msg = "Notify " <> tshow jRecipient <> " PDF printing to send letter failed with error: " <> err let msg = "Notify " <> tshow jRecipient <> " PDF printing to send letter failed with error: " <> err
@ -106,3 +90,26 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
Right (msg,_) Right (msg,_)
| null msg -> return () | null msg -> return ()
| otherwise -> $logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg | otherwise -> $logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg
Right pdf -> userMailT jRecipient $ do
-- userPrefersLetter is false if both userEmail and userPostAddress are null
when (Text.null (CI.original userEmail)) $ $logErrorS "LMS" ("Notify " <> tshow jRecipient <> " failed: no email nor address for user known!")
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectQualificationRenewal qname
encryptPDF (fromMaybe "tomatenmarmelade" userPinPassword) pdf >>= \case -- TODO
Left err -> do
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!
, fileModified = now
, fileContent = Just $ yield $ LBS.toStrict pdffile
} :: PureFile)
editNotifications <- mkEditNotifications jRecipient
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")

View File

@ -271,8 +271,8 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
nameCourse = CI.original . courseShorthand <$> course nameCourse = CI.original . courseShorthand <$> course
nameQuali = CI.original . qualificationShorthand <$> quali nameQuali = CI.original . qualificationShorthand <$> quali
let printJobAcknowledged = Nothing let printJobAcknowledged = Nothing
jobFullName = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) jobFullName = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
printJobFilename = jobFullName <> ".pdf" printJobFilename = jobFullName <> ".pdf"
-- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code
printJobFile = LBS.toStrict pdf printJobFile = LBS.toStrict pdf
lprPDF jobFullName pdf >>= \case lprPDF jobFullName pdf >>= \case

View File

@ -23,6 +23,7 @@ hyperrefoptions: hidelinks
### Metadaten, welche automatisch ersetzt werden: ### Metadaten, welche automatisch ersetzt werden:
date: 11.11.1111 date: 11.11.1111
expiry: 00.00.0000
lang: de-de lang: de-de
is-de: true is-de: true
login: 123456 login: 123456
@ -51,9 +52,12 @@ $endfor$
$if(is-de)$ $if(is-de)$
<!-- deutsche Version des Briefes --> <!-- deutsche Version des Briefes -->
die Gültigkeit Ihres Vorfeldführerscheines läuft demnächst ab. die Gültigkeit Ihres Vorfeldführerscheines läuft demnächst ab, am $expiry$.
Durch die erfolgreiche Teilnahme an einem E-Lernen können Sie Durch die erfolgreiche Teilnahme an einem E-Lernen können Sie die Gültigkeit
die Gültigkeit um 2 Jahre verlängern. Verwenden Sie dazu die $if(validduration)$
um $validduration$ Monate
$endif$
verlängern. Verwenden Sie dazu die
Login-Daten aus dem geschützen Sichtfenster weiter unten. Login-Daten aus dem geschützen Sichtfenster weiter unten.
Prüfling Prüfling
@ -75,8 +79,12 @@ $else$
<!-- englische Version des Briefes --> <!-- englische Version des Briefes -->
your apron diving licence is about to expire soon. your apron diving licence is about to expire soon, on $expiry$.
You may renew your apron driving licence by two years through successfully You may renew your apron driving licence
$if(validduration)$
by $validduration$ month
$endif$
through successfully
completing an e-learning course. Please use the login data from the protected area below. completing an e-learning course. Please use the login data from the protected area below.
Examinee Examinee

View File

@ -14,17 +14,21 @@ $newline never
_{SomeMessage $ MsgMailSubjectQualificationExpiry qname} _{SomeMessage $ MsgMailSubjectQualificationExpiry qname}
<p> <p>
_{SomeMessage MsgMailAllocationNewCourseTip} _{SomeMessage MsgMailBodyQualificationExpiry}
<br />
<a href=@{QualificationR qualificationSchool qualificationShorthand}>
#{qualificationName}
#{nameHtml userDisplayName userSurname}
#{show qualificationUserValidUntil}
#{show qualificationUserFirstHeld}
<p> <p>
<h3> <dl>
EXPIRY <dt>_{SomeMessage MsgQualificationName}
TODO: Diese Nachricht muss noch überarbeitet werden. <dd>
<a href=@{QualificationR qualificationSchool qualificationShorthand}>
#{qualificationName}
<dt>_{SomeMessage MsgLmsUser}
<dd>#{nameHtml userDisplayName userSurname}
<dt>_{SomeMessage MsgLmsQualificationValidUntil}
<dd>#{expiryDate}
<p>
_{SomeMessage MsgLmsNoRenewal}
^{ihamletSomeMessage editNotifications} ^{ihamletSomeMessage editNotifications}

View File

@ -14,28 +14,21 @@ $newline never
_{SomeMessage $ MsgMailSubjectQualificationRenewal qname} _{SomeMessage $ MsgMailSubjectQualificationRenewal qname}
<p> <p>
_{SomeMessage MsgMailLmsRenewalBody} _{SomeMessage MsgMailBodyQualificationRenewal}
<br />
<a href=@{QualificationR qualificationSchool qualificationShorthand}>
#{qualificationName}
<p> <p>
Name: <dl>
#{nameHtml userDisplayName userSurname} <dt>_{SomeMessage MsgQualificationName}
<dd>
<a href=@{QualificationR qualificationSchool qualificationShorthand}>
#{qualificationName}
<dt>_{SomeMessage MsgLmsUser}
<dd>#{nameHtml userDisplayName userSurname}
<dt>_{SomeMessage MsgLmsQualificationValidUntil}
<dd>#{expiryDate}
<p> <p>
Qualifikation: _{SomeMessage MsgLmsRenewalInstructions}
#{qname}
<p>
Gültig bis:
#{show qualificationUserValidUntil}
<p>
Zuerst erhalten:
#{show qualificationUserFirstHeld}
<p>
<h3>
RENEWAL
TODO: Diese Nachricht muss noch überarbeitet werden.
^{ihamletSomeMessage editNotifications} ^{ihamletSomeMessage editNotifications}

View File

@ -18,6 +18,15 @@ $newline never
_{MsgTableMatrikelNr} _{MsgTableMatrikelNr}
<dd .deflist__dd> <dd .deflist__dd>
#{matnr} #{matnr}
$maybe addr <- userPostAddress
<dt .deflist__dt>
_{MsgAdminUserPostAddress}
<dd .deflist__dd>
#{addr}
<dt .deflist__dt>
_{MsgAdminUserPrefersPostal}
<dd .deflist__dd>
#{show userPrefersPostal}
<dt .deflist__dt> <dt .deflist__dt>
_{MsgTableEmail} _{MsgTableEmail}
<dd .deflist__dd> <dd .deflist__dd>
@ -27,6 +36,13 @@ $newline never
_{MsgUserDisplayEmail} _{MsgUserDisplayEmail}
<dd .deflist__dd .email> <dd .deflist__dd .email>
#{userDisplayEmail} #{userDisplayEmail}
<dt .deflist__dt>
_{MsgAdminUserPinPassword}
<dd .deflist__dd>
$maybe _pass <- userPinPassword
OK
$nothing
NO
$maybe telephonenr <- userTelephone $maybe telephonenr <- userTelephone
<dt .deflist__dt> <dt .deflist__dt>
_{MsgUserTelephone} _{MsgUserTelephone}