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
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
TableQualificationCountTotal: Gesamt
TableQualificationValidUntil: Gültig bis
LmsQualificationValidUntil: Gültig bis
TableQualificationLastRefresh: Zuletzt erneuert
TableQualificationFirstHeld: Erstmalig
TableLmsUser: Ermächtigter
LmsUser: Inhaber
TableLmsEmail: E-Mail
TableLmsIdent: Identifikation
TableLmsElearning: E-Lernen
@ -44,9 +44,12 @@ LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
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.
MailSubjectQualificationRenewal qname@Text: Ihre Qualifikation #{qname} muss demnächst erneuert werden
MailSubjectQualificationExpiry qname@Text: Ihre Qualifikation #{qname} läuft demnächst ab
MailLmsRenewalBody: Sie müssen diese Qualifikaton demnächst durch einen E-Lernen Kurs erneuern.
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
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
LmsActRenewPin: Neue zufällige E-Lernen PIN zuweisen
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
TableQualificationCountActiveTooltip: Number of currently valid qualification holders
TableQualificationCountTotal: Total
TableQualificationValidUntil: Valid until
LmsQualificationValidUntil: Valid until
TableQualificationLastRefresh: Last renewed
TableQualificationFirstHeld: First held
TableLmsUser: Licensee
LmsUser: Licensee
TableLmsEmail: Email
TableLmsIdent: Identifier
TableLmsPin: E-learning pin
@ -29,7 +29,7 @@ TableLmsSuccess: Completed
TableLmsFailed: Blocked
FilterLmsValid: Currently valid
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
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?
@ -44,9 +44,12 @@ LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsDirectUpload: Direct upload for automated Systems
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
MailSubjectQualificationExpiry qname@Text: Your qualification #{qname} expires soon
MailLmsRenewalBody: You will soon need to renew this qualficiation by completing an e-learning course.
MailSubjectQualificationRenewal qname@Text: Qualification #{qname} must be renewed shortly
MailSubjectQualificationExpiry qname@Text: Qualification #{qname} expires soon
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
LmsActRenewPin: Randomly replace e-learning PIN
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
csvColumnsExplanations = genericCsvColumnsExplanations ltcOptions $ Map.fromList
[ ('ltcDisplayName, MsgTableLmsUser)
[ ('ltcDisplayName, MsgLmsUser)
, ('ltcEmail , MsgTableLmsEmail)
, ('ltcValidUntil , MsgTableQualificationValidUntil)
, ('ltcValidUntil , MsgLmsQualificationValidUntil)
, ('ltcLastRefresh, MsgTableQualificationLastRefresh)
, ('ltcFirstHeld , MsgTableQualificationFirstHeld)
, ('ltcLmsIdent , MsgTableLmsIdent)
@ -358,7 +358,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
)
]
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-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)
@ -436,9 +436,9 @@ postLmsR sid qsh = do
]
colChoices = mconcat
[ dbSelectIf (applying _2) id (return . view (resultUser . _entityKey)) (\r -> isJust $ r ^? resultLmsUser) -- TODO: refactor using function "is"
, colUserNameLinkHdr MsgTableLmsUser AdminUserR
, colUserNameLinkHdr MsgLmsUser AdminUserR
, 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 "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

View File

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

View File

@ -178,9 +178,9 @@ mkLmsTable (Entity qid quali) = do
dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtColonnade = dbColonnade $ mconcat
[ colUserNameLinkHdr MsgTableLmsUser AdminUserR
[ colUserNameLinkHdr MsgLmsUser AdminUserR
, 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 "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
@ -219,7 +219,7 @@ mkLmsTable (Entity qid quali) = do
)
]
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-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)

View File

@ -150,7 +150,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
pure (quser, luser)
let usr_job (quser, luser) =
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
lmsstatus = luser ^. _entityVal . _lmsUserStatus
in case lmsstatus of

View File

@ -26,13 +26,17 @@ import Text.Hamlet
dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler ()
dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = userMailT jRecipient $ do
(User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
(recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
<$> getJust jRecipient
<*> getJust nQualification
<*> 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
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectQualificationExpiry qname
@ -55,49 +59,29 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
$logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualification " <> qname
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
pdfMeta = mkMeta
[ toMeta "date" letterDate
, toMeta "lang" (selectDeEn userLanguages) -- select either German or English only, see Utils.Lang
, toMeta "login" (lmsUserIdent & getLmsIdent)
, toMeta "pin" lmsUserPin
, toMeta "recipient" userDisplayName
, mbMeta "address" (prepAddress <$> userPostAddress)
[ toMeta "date" letterDate
, toMeta "lang" (selectDeEn userLanguages) -- select either German or English only, see Utils.Lang
, toMeta "login" (lmsUserIdent & getLmsIdent)
, toMeta "pin" lmsUserPin
, toMeta "recipient" userDisplayName
, mbMeta "address" (prepAddress <$> userPostAddress)
, toMeta "expiry" expiryDate
, mbMeta "validduration" (show <$> qualificationValidDuration)
]
pdfRenewal pdfMeta >>= \case
Left err -> do
let msg = "Notify " <> tshow jRecipient <> " PDF generation failed with error: " <> err
$logErrorS "LMS" 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"
setSubjectI $ MsgMailSubjectQualificationRenewal qname
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
Right pdf | userPrefersLetter recipient -> do
let printJobName = "Renewal"
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
@ -105,4 +89,27 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
error $ unpack msg
Right (msg,_)
| 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
nameQuali = CI.original . qualificationShorthand <$> quali
let printJobAcknowledged = Nothing
jobFullName = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
printJobFilename = jobFullName <> ".pdf"
jobFullName = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
printJobFilename = jobFullName <> ".pdf"
-- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code
printJobFile = LBS.toStrict pdf
lprPDF jobFullName pdf >>= \case

View File

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

View File

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

View File

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

View File

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