diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 65cd221b8..bedf81517 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -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 diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 9cdc5ad36..f6f869fe3 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -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 diff --git a/models/lms.model b/models/lms.model index ee46b2037..9a78d2560 100644 --- a/models/lms.model +++ b/models/lms.model @@ -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 diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index a1d2f405d..6b4836105 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -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 diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index db5eebb30..0f9ccc9d3 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -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) diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index a67a35c21..2e15d90ee 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -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) diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index 269747570..3fa9faa9c 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/src/Handler/Utils/Qualification.hs @@ -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 diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index 63e6d454b..d38d37111 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -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 diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 4b84175f0..b94204ad7 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -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!" - \ No newline at end of file diff --git a/templates/qualification.hamlet b/templates/qualification.hamlet index 1459ebdfb..84d1547d2 100644 --- a/templates/qualification.hamlet +++ b/templates/qualification.hamlet @@ -49,6 +49,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

#{icon IconNotificationError} _{MsgLmsErrorNoRefreshElearning} + +

_{MsgQualificationElearningRenew} +
#{boolSymbol (qualificationElearningRenews quali)} + $if (qualificationElearningRenews quali) && isNothing (qualificationValidDuration quali) +

+ #{icon IconNotificationError} + _{MsgLmsErrorNoRefreshElearning}

^{qualificationTable} diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 25e7baf98..8613a76b3 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -753,9 +753,9 @@ fillDb = do let r_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|] let l_descr = Just $ htmlToStoredMarkup [shamlet|

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)