fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(LMS): fix #2235 by notifying LMS user upon reset

Browse Source
This commit is contained in:
Steffen Jost 2024-11-08 13:47:16 +01:00
parent 3b0029ba04
commit 0b70036a02
2 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Handler/LMS.hs
View File

@ -728,8 +728,9 @@ postLmsR sid qsh = do
forM_ shortUsers $ upsertQualificationUser qid now cutoff Nothing "E-Learning Reset"
fromIntegral <$> (if isReset
then updateWhereCount ([LmsUserQualification ==. qid, LmsUserUser <-. usersList, LmsUserResetTries ==. False, LmsUserEnded ==. Nothing] -- , LmsUserLocked ==. True] -- needs to be locked for reset, but this is counter-intuitive for users; should be harmles, but delays reset until lock is effective
++ ([LmsUserStatus ==. Just LmsBlocked] ||. [LmsUserStatus ==. Just LmsExpired])) [LmsUserResetTries =. True]
then updateWhereCount ([LmsUserQualification ==. qid, LmsUserUser <-. usersList, LmsUserResetTries ==. False, LmsUserEnded ==. Nothing] -- , LmsUserLocked ==. True] -- needs to be locked for reset, but this is counter-intuitive for users; should be harmless, but delays reset until lock is effective
++ ([LmsUserStatus ==. Just LmsBlocked] ||. [LmsUserStatus ==. Just LmsExpired]))
(bcons actRestartNotify (LmsUserNotified =. Nothing) [LmsUserResetTries =. True])
else deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. usersList]
)

15
src/Jobs/Handler/LMS.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-24 Steffen Jost <s.jost@fraport.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
-- SPDX-FileCopyrightText: 2022-24 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -320,10 +320,13 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
E.&&. lreport E.^. LmsReportLock E.==. E.true
)
-- B) notify all newly reported users that lms is available
let luserFltrNew luser = E.isNothing (luser E.^. LmsUserReceived) -- not seen before, just starting
E.||. E.isNothing (luser E.^. LmsUserNotified) -- a previous notification has failed
let luserFltrNew luser = E.isNothing (luser E.^. LmsUserReceived) -- not seen before, just starting OR (
E.||. E.isNothing (luser E.^. LmsUserNotified) -- a previous notification has failed AND
-- E.&&. E.not__ (luser E.^. LmsUserLocked) -- user is not to be locked)
repFltr _ lreport = lreport E.^. LmsReportResult E.==. E.val LmsOpen -- LMS is open now
E.&&. E.not__ (lreport E.^. LmsReportLock) -- never notify currently locked users
notifyNewLearner (E.Value uid) = queueDBJob JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = False } }
in luserQry luserFltrNew (const $ const E.true) >>= mapM_ notifyNewLearner
in luserQry luserFltrNew repFltr >>= mapM_ notifyNewLearner
-- C) block qualifications for failed learners by calling qualificationUserBlocking [uids] (includes audit), notified during expiry
let lrFltrBlock luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsFailed
procBlock (Entity luid luser, Entity _ lreport) = do
@ -400,9 +403,9 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
E.orderBy [E.desc $ lrl E.^. LmsReportLogTimestamp]
return $ lreport E.^. LmsReportResult E.==. lrl E.^. LmsReportLogResult
E.&&. lreport E.^. LmsReportLock E.==. lrl E.^. LmsReportLogLock
E.&&. E.not_ (lrl E.^. LmsReportLogMissing)
E.&&. E.not__ (lrl E.^. LmsReportLogMissing)
E.where_ $ lreport E.^. LmsReportQualification E.==. E.val qid
E.&&. E.not_ (E.isTrue samelog)
E.&&. E.not__ (E.isTrue samelog)
return (LmsReportLog
E.<# (lreport E.^. LmsReportQualification)
E.<&> (lreport E.^. LmsReportIdent )