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

chore(lms): workaround for simultaneous success and failure lms status

Browse Source
This commit is contained in:
Steffen Jost 2023-02-28 17:19:13 +01:00
parent f226a2518a
commit a97c8168da
1 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -31,6 +31,9 @@ import Handler.Utils.LMS (randomLMSIdentBut, randomLMSpw, maxLmsUserIdentRetries
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
blockedByElearning :: Text
blockedByElearning = "E-Learning durchgefallen"
dispatchJobLmsQualificationsEnqueue :: JobHandler UniWorX dispatchJobLmsQualificationsEnqueue :: JobHandler UniWorX
dispatchJobLmsQualificationsEnqueue = JobHandlerAtomic $ fetchRefreshQualifications JobLmsEnqueue dispatchJobLmsQualificationsEnqueue = JobHandlerAtomic $ fetchRefreshQualifications JobLmsEnqueue
@ -195,7 +198,7 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
E.&&. luser E.^. LmsUserQualification E.==. lresult E.^. LmsResultQualification) E.&&. luser E.^. LmsUserQualification E.==. lresult E.^. LmsResultQualification)
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
E.&&. luser E.^. LmsUserQualification E.==. E.val qid E.&&. luser E.^. LmsUserQualification E.==. E.val qid
E.&&. E.isNothing (luser E.^. LmsUserStatus) -- do not process learners already having a result -- E.&&. E.isNothing (luser E.^. LmsUserStatus) -- do not process learners already having a result WORKAROUND LMS-Bug: LMS may send blocked & success simultanesouly or within a few hours; in this case, success is the correct meaning
E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners
return (quser, luser, lresult) return (quser, luser, lresult)
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
@ -210,12 +213,16 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
note <- if saneDate && isLmsSuccess newStatus note <- if saneDate && isLmsSuccess newStatus
then do then do
-- TODO: refactor using functions from Handler.Utils.Qualification to ensure nothing is forgotten! -- TODO: refactor using functions from Handler.Utils.Qualification to ensure nothing is forgotten!
update quid [ QualificationUserValidUntil =. newValidTo qUsr <- updateGet quid
[ QualificationUserValidUntil =. newValidTo
, QualificationUserLastRefresh =. lmsResultSuccess , QualificationUserLastRefresh =. lmsResultSuccess
] ]
-- WORKAROUND LMS-Bug: sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
when (Just blockedByElearning == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
update quid [ QualificationUserBlockedDue =. Nothing ]
update luid [ LmsUserStatus =. Just newStatus update luid [ LmsUserStatus =. Just newStatus
, LmsUserReceived =. Just lmsResultTimestamp , LmsUserReceived =. Just lmsResultTimestamp
] ]
audit TransactionQualificationUserEdit audit TransactionQualificationUserEdit
{ transactionQualificationUser = quid { transactionQualificationUser = quid
, transactionQualification = qualificationUserQualification , transactionQualification = qualificationUserQualification
@ -289,7 +296,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
update luid [LmsUserStatus =. (oldStatus <> Just newStatus)] update luid [LmsUserStatus =. (oldStatus <> Just newStatus)]
updateBy (UniqueQualificationUser qid (lmsUserUser luser)) updateBy (UniqueQualificationUser qid (lmsUserUser luser))
[QualificationUserBlockedDue =. Just (QualificationBlocked { qualificationBlockedDay = blockedDay [QualificationUserBlockedDue =. Just (QualificationBlocked { qualificationBlockedDay = blockedDay
, qualificationBlockedReason = "E-Learning durchgefallen" } )] , qualificationBlockedReason = blockedByElearning } )]
queueDBJob JobSendNotification queueDBJob JobSendNotification
{ jRecipient = lmsUserUser luser { jRecipient = lmsUserUser luser
, jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = blockedDay } , jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = blockedDay }