chore(lms): towards #169 option to prevent qualifications to renew automatically upon e-learning
This commit is contained in:
parent
0ac75e0d59
commit
0725a9a908
@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatis
|
||||
QualificationRefreshReminder: 2. Erinnerung
|
||||
QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde.
|
||||
QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
|
||||
QualificationElearningRenew: Verlängert ein erfolgreiches E‑Learning die Qualifikation automatisch um die reguläre Gültigkeitsdauer?
|
||||
QualificationExpiryNotification: Ungültigkeitsbenachrichtigung?
|
||||
QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Qualifikation ungültig wird, sofern der jeweilige Nutzer in seinen Benutzereinstellungen diese Art Benachrichtigung aktiviert hat.
|
||||
TableQualificationCountActive: Aktive
|
||||
@ -47,11 +48,12 @@ QualificationExpired: Ungültig seit
|
||||
LmsUser: Inhaber
|
||||
LmsURL: Link E‑Learning
|
||||
TableLmsEmail: E‑Mail
|
||||
TableLmsIdent: E-Learning Benutzer
|
||||
TableLmsIdent: E‑Learning Benutzer
|
||||
TableLmsElearning: E‑Learning
|
||||
TableLmsElearningRenews: Automatische Verlängerung
|
||||
TableLmsPin: E‑Learning Passwort
|
||||
TableLmsResetPin: E-Learning Passwort zurücksetzen?
|
||||
TableLmsDatePin: E-Learning Passwort erstellt
|
||||
TableLmsResetPin: E‑Learning Passwort zurücksetzen?
|
||||
TableLmsDatePin: E‑Learning Passwort erstellt
|
||||
TableLmsDate: Datum
|
||||
TableLmsDelete: Löschen?
|
||||
TableLmsStaff: Interner Mitarbeiter?
|
||||
@ -89,7 +91,8 @@ LmsReportInsert: Neues LMS Ereignis
|
||||
LmsReportUpdate: LMS Ereignis Aktualisierung
|
||||
LmsReportCsvExceptionDuplicatedKey: CSV-Import LmsReport fand uneindeutigen Schlüssel
|
||||
LmsDirectUpload: Direkter Upload für automatisierte Systeme
|
||||
LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
|
||||
LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde!
|
||||
LmsErrorNoRenewElearning: Fehler: Erfoglreiches E‑Learning verlängert die Qualifikation nicht automatisch, da die Gültigkeitsdauer nicht festgelegt wurde!
|
||||
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
|
||||
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
|
||||
MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig
|
||||
|
||||
@ -14,6 +14,7 @@ QualificationRefreshWithinTooltip: Optional period before expiry to start e‑le
|
||||
QualificationRefreshReminder: 2. Reminder
|
||||
QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry.
|
||||
QualificationElearningStart: Is e‑learning automatically started?
|
||||
QualificationElearningRenew: Does successful e‑learning automatically extend a qualification by the default validity period?
|
||||
QualificationExpiryNotification: Invalidity notification?
|
||||
QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings.
|
||||
TableQualificationCountActive: Active
|
||||
@ -50,6 +51,7 @@ TableLmsEmail: Email
|
||||
TableLmsIdent: E‑learning user
|
||||
TableLmsPin: E‑learning password
|
||||
TableLmsElearning: E‑learning
|
||||
TableLmsElearningRenews: Automatic renewal
|
||||
TableLmsResetPin: Reset E‑learning password?
|
||||
TableLmsDatePin: E‑learning password created
|
||||
TableLmsDate: Date
|
||||
@ -89,7 +91,8 @@ LmsReportInsert: New LMS event
|
||||
LmsReportUpdate: Update of LMS event
|
||||
LmsReportCsvExceptionDuplicatedKey: CSV Import LmsReport 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.
|
||||
LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set!
|
||||
LmsErrorNoRenewElearning: Error: E‑learning will not automatically extend validity due to validity duration not being set!
|
||||
MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
|
||||
MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
|
||||
MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
|
||||
|
||||
@ -13,7 +13,7 @@ Qualification
|
||||
refreshWithin CalendarDiffDays Maybe -- notify users about renewal within this number of month/days before expiry; to be used with addGregorianDurationClip
|
||||
refreshReminder CalendarDiffDays Maybe -- send a second notification about renewal within this number of month/days before expiry
|
||||
elearningStart Bool -- automatically schedule e-refresher
|
||||
-- elearningOnly Bool -- successful E-learing automatically increases validity. NO!
|
||||
elearningRenews Bool default=true -- successful E-learing automatically increases validity automatically by validDuration
|
||||
expiryNotification Bool default=true -- should expiryNotification be generated for this qualification?
|
||||
avsLicence AvsLicence Maybe -- if set, valid QualificationUsers are synchronized to AVS as a driving licence
|
||||
sapId Text Maybe -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id
|
||||
|
||||
@ -229,7 +229,7 @@ postAdminTestR = do
|
||||
let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
|
||||
siteLayout locallyDefinedPageHeading $ do
|
||||
-- defaultLayout $ do
|
||||
setTitle "Uni2work Admin Testpage"
|
||||
setTitle "Uni2work Admin Testpage"
|
||||
|
||||
$(i18nWidgetFile "admin-test")
|
||||
|
||||
@ -332,7 +332,7 @@ postAdminTestR = do
|
||||
|
||||
getAdminTestPdfR :: Handler TypedContent
|
||||
getAdminTestPdfR = do
|
||||
usr <- requireAuth -- to determine language and recipient for test
|
||||
usr <- requireAuth -- to determine language and recipient for test
|
||||
qual <- fromMaybeM
|
||||
(addMessage Error "Keine Qualifikation in der Datenbank zur Erzeugung eines Test-PDFs gefunden." >> redirect AdminTestR)
|
||||
(runDB $ selectFirst [] [Asc QualificationAvsLicence, Asc QualificationShorthand])
|
||||
@ -351,8 +351,9 @@ getAdminTestPdfR = do
|
||||
, qualShort = qual ^. _qualificationShorthand . _CI
|
||||
, qualSchool = qual ^. _qualificationSchool
|
||||
, qualDuration = qual ^. _qualificationValidDuration
|
||||
, qualRenewAuto = qual ^. _qualificationElearningRenews
|
||||
, isReminder = False
|
||||
}
|
||||
}
|
||||
apcIdent <- letterApcIdent letter encRecipient now
|
||||
renderLetterPDF usr letter apcIdent Nothing >>= \case
|
||||
Left err -> sendResponseStatus internalServerError500 $ "PDF generation failed: \n" <> err
|
||||
@ -360,6 +361,6 @@ getAdminTestPdfR = do
|
||||
liftIO $ LBS.writeFile "/tmp/generated.pdf" pdf
|
||||
encryptPDF "tomatenmarmelade" pdf >>= \case
|
||||
Left err -> sendResponseStatus internalServerError500 $ "PDFtk error: \n" <> err
|
||||
Right encPdf -> do
|
||||
Right encPdf -> do
|
||||
liftIO $ LBS.writeFile "/tmp/crypted.pdf" encPdf
|
||||
sendByteStringAsFile "demoPDF.pdf" (LBS.toStrict pdf) now
|
||||
|
||||
@ -94,6 +94,7 @@ lrqf2letter LRQF{..}
|
||||
, qualShort = lrqfQuali ^. _qualificationShorthand . _CI
|
||||
, qualSchool = lrqfQuali ^. _qualificationSchool
|
||||
, qualDuration = lrqfQuali ^. _qualificationValidDuration
|
||||
, qualRenewAuto = lrqfQuali ^. _qualificationElearningRenews
|
||||
, isReminder = lrqfReminder
|
||||
}
|
||||
return (fromMaybe usr rcvr, SomeLetter letter)
|
||||
|
||||
@ -102,6 +102,8 @@ mkQualificationAllTable isAdmin = do
|
||||
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder)
|
||||
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
|
||||
, sortable (Just "qelearrenew") (i18nCell MsgTableLmsElearningRenews & cellTooltip MsgQualificationElearningRenew)
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationElearningRenews)
|
||||
, sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip)
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
|
||||
, sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip)
|
||||
|
||||
@ -189,6 +189,8 @@ renewValidQualificationUsers qid reason renewalTime uids =
|
||||
-- E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid )
|
||||
-- E.&&. (qu E.^. QualificationUserUser `E.in_` E.valList uids)
|
||||
get qid >>= \case
|
||||
Just Qualification{qualificationElearningRenews=False}
|
||||
| Just (Right (QualificationRenewELearningBy _)) <- reason -> return 0
|
||||
Just Qualification{qualificationValidDuration=Just renewalMonths} -> do
|
||||
cutoff <- maybe (liftIO getCurrentTime) return renewalTime
|
||||
quEntsAll <- selectValidQualifications qid uids cutoff
|
||||
@ -227,7 +229,7 @@ qualificationUserBlocking ::
|
||||
, Num n
|
||||
) => QualificationId -> [UserId] -> Bool -> Maybe UTCTime -> QualificationChangeReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
|
||||
qualificationUserBlocking qid uids unblock mbBlockTime (qualificationChangeReasonText -> reason) notify = do
|
||||
$logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow uids, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify]
|
||||
$logInfoS "BLOCK" $ Text.intercalate " - " [tshow qid, tshow unblock, tshow mbBlockTime, tshow reason, tshow notify, "#Users:" <> tshow (length uids), tshow uids] -- this message can get very long on test systems
|
||||
authUsr <- liftHandler maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
let blockTime = fromMaybe now mbBlockTime
|
||||
|
||||
@ -336,7 +336,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
|
||||
-- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log
|
||||
-- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|])
|
||||
-- END LMS WORKAROUND 2
|
||||
ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log
|
||||
ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser] -- only valid qualifications are truly renewed and only if validDuration is set and elearningRenews is true; transcribes to audit log
|
||||
update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay]
|
||||
return $ Sum ok_renew
|
||||
in lrepQry lrFltrSuccess
|
||||
|
||||
@ -25,7 +25,7 @@ dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> H
|
||||
dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = userMailT jRecipient $ do
|
||||
(recipient@User{..}, Qualification{..}) <- liftHandler . runDB $ (,)
|
||||
<$> getJust jRecipient
|
||||
<*> getJust nQualification
|
||||
<*> getJust nQualification
|
||||
|
||||
encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
|
||||
let entRecipient = Entity jRecipient recipient
|
||||
@ -43,19 +43,19 @@ dispatchNotificationQualificationExpiry nQualification dExpiry jRecipient = user
|
||||
|
||||
|
||||
dispatchNotificationQualificationExpired :: QualificationId -> UserId -> Handler ()
|
||||
dispatchNotificationQualificationExpired nQualification jRecipient = do
|
||||
dispatchNotificationQualificationExpired nQualification jRecipient = do
|
||||
encRecipient :: CryptoUUIDUser <- encrypt jRecipient
|
||||
encRecShort <- encrypt jRecipient
|
||||
dbRes <- runDB $ (,,)
|
||||
<$> get jRecipient
|
||||
<*> get nQualification
|
||||
<*> getBy (UniqueQualificationUser nQualification jRecipient)
|
||||
<*> getBy (UniqueQualificationUser nQualification jRecipient)
|
||||
|
||||
case dbRes of
|
||||
case dbRes of
|
||||
( Just User{..}, Just Qualification{..}, Just (Entity quId QualificationUser{..})) -> do
|
||||
now <- liftIO getCurrentTime
|
||||
qub_entry <- entityVal <<$>> runDB (selectRelevantBlock now quId)
|
||||
let block = filterMaybe (not . qualificationUserBlockUnblock) qub_entry
|
||||
let block = filterMaybe (not . qualificationUserBlockUnblock) qub_entry
|
||||
urender <- getUrlRender
|
||||
let expDay = maybe qualificationUserValidUntil (min qualificationUserValidUntil . utctDay . qualificationUserBlockFrom) block
|
||||
qname = CI.original qualificationName
|
||||
@ -94,30 +94,30 @@ dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = d
|
||||
<*> get nQualification
|
||||
<*> getBy (UniqueQualificationUser nQualification jRecipient)
|
||||
<*> getBy (UniqueLmsQualificationUser nQualification jRecipient)
|
||||
case query of
|
||||
case query of
|
||||
(Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
|
||||
let qname = CI.original qualificationName
|
||||
letter = LetterRenewQualification
|
||||
{ lmsLogin = lmsUserIdent
|
||||
, lmsPin = lmsUserPin
|
||||
, qualHolderID = jRecipient
|
||||
, qualHolderDN = userDisplayName
|
||||
, qualHolderSN = userSurname
|
||||
, qualExpiry = qualificationUserValidUntil
|
||||
, qualId = nQualification
|
||||
, qualName = qname
|
||||
, qualShort = CI.original qualificationShorthand
|
||||
, qualSchool = qualificationSchool
|
||||
, qualDuration = qualificationValidDuration
|
||||
, isReminder = nReminder
|
||||
{ lmsLogin = lmsUserIdent
|
||||
, lmsPin = lmsUserPin
|
||||
, qualHolderID = jRecipient
|
||||
, qualHolderDN = userDisplayName
|
||||
, qualHolderSN = userSurname
|
||||
, qualExpiry = qualificationUserValidUntil
|
||||
, qualId = nQualification
|
||||
, qualName = qname
|
||||
, qualShort = CI.original qualificationShorthand
|
||||
, qualSchool = qualificationSchool
|
||||
, qualDuration = qualificationValidDuration
|
||||
, qualRenewAuto = qualificationElearningRenews
|
||||
, isReminder = nReminder
|
||||
}
|
||||
$logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname
|
||||
notifyOk <- sendEmailOrLetter jRecipient letter
|
||||
when notifyOk $ do
|
||||
when notifyOk $ do
|
||||
now <- liftIO getCurrentTime
|
||||
runDB $ update luid [ LmsUserNotified =. Just now]
|
||||
(_, Nothing, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: Qualification " <> tshow nQualification <> " does not exist!"
|
||||
(Nothing, _, _, _) -> $logErrorS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal failed: User does not exist!"
|
||||
(_, _, 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!"
|
||||
|
||||
@ -49,6 +49,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<p>
|
||||
#{icon IconNotificationError}
|
||||
_{MsgLmsErrorNoRefreshElearning}
|
||||
|
||||
<dt .deflist__dt>_{MsgQualificationElearningRenew}
|
||||
<dd .deflist__dd>#{boolSymbol (qualificationElearningRenews quali)}
|
||||
$if (qualificationElearningRenews quali) && isNothing (qualificationValidDuration quali)
|
||||
<p>
|
||||
#{icon IconNotificationError}
|
||||
_{MsgLmsErrorNoRefreshElearning}
|
||||
|
||||
<section>
|
||||
^{qualificationTable}
|
||||
|
||||
@ -753,9 +753,9 @@ fillDb = do
|
||||
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
|
||||
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
|
||||
|
||||
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True (Just AvsLicenceVorfeld) $ Just "F4466"
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False (Just AvsLicenceRollfeld) $ Just "R2801"
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing False True Nothing Nothing
|
||||
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True True (Just AvsLicenceVorfeld) $ Just "F4466"
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False False (Just AvsLicenceRollfeld) $ Just "R2801"
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing True False True Nothing Nothing
|
||||
qfjost <- insert' $ QualificationUser jost qid_f (n_day 11) (n_day $ -1) (n_day $ -22) True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert $ QualificationUserBlock qfjost False (n_day' $ -6) "First block" (Just svaupel)
|
||||
void . insert $ QualificationUserBlock qfjost True (n_day' $ -5) "Second unblock" (Just gkleen)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user