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

chore(lms): regular renewal for lms success only

Browse Source
This commit is contained in:
Steffen Jost 2023-03-20 15:03:59 +00:00
parent 41810dbd75
commit 83ec6d4a90
1 changed files with 11 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -180,10 +180,6 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
where where
-- act :: YesodJobDB UniWorX () -- act :: YesodJobDB UniWorX ()
act = hoist lift $ do act = hoist lift $ do
quali <- getJust qid
whenIsJust (qualificationValidDuration quali) $ \renewalMonths -> do
-- otherwise there is nothing to do: we cannot renew s qualification without a specified validDuration
-- result :: [(Entity QualificationUser, Entity LmsUser, Entity LmsResult)]
results <- E.select $ do results <- E.select $ do
(quser :& luser :& lresult) <- E.from $ (quser :& luser :& lresult) <- E.from $
E.table @QualificationUser -- table not needed if renewal from lms completion day is used TODO: decide! E.table @QualificationUser -- table not needed if renewal from lms completion day is used TODO: decide!
@ -202,33 +198,24 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
return (quser, luser, lresult) return (quser, luser, lresult)
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now let locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now
forM_ results $ \(Entity quid QualificationUser{..}, Entity luid LmsUser{..}, Entity lrid LmsResult{..}) -> do forM_ results $ \(Entity _quid QualificationUser{..}, Entity luid LmsUser{..}, Entity lrid LmsResult{..}) -> do
-- three separate DB operations per result is not so nice. All within one transaction though. -- three separate DB operations per result is not so nice. All within one transaction though.
let lmsUserStartedDay = localDay $ TZ.utcToLocalTimeTZ appTZ lmsUserStarted let lmsUserStartedDay = localDay $ TZ.utcToLocalTimeTZ appTZ lmsUserStarted
saneDate = lmsResultSuccess `inBetween` (lmsUserStartedDay, min qualificationUserValidUntil locDay) saneDate = lmsResultSuccess `inBetween` (lmsUserStartedDay, min qualificationUserValidUntil locDay)
&& qualificationUserLastRefresh <= utctDay lmsUserStarted && qualificationUserLastRefresh <= utctDay lmsUserStarted
newStatus = LmsSuccess lmsResultSuccess newStatus = LmsSuccess lmsResultSuccess
newValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil -- renew from old validUntil onwards -- newValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil -- renew from old validUntil onwards
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! _ok <- renewValidQualificationUsers qid [qualificationUserUser] -- blocked is unaffected
qUsr <- updateGet quid -- when (ok==1) $ update luid -- we end lms regardless of wether a regular renewal was successful, since BPol users may simultaneoysly have on-premise renewal courses and E-Learnings
[ QualificationUserValidUntil =. newValidTo update luid
, QualificationUserLastRefresh =. lmsResultSuccess [ LmsUserStatus =. Just newStatus
] , LmsUserReceived =. Just lmsResultTimestamp
-- 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 (qualificationBlockedReasonText QualificationBlockFailedELearning) == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $ -- WORKAROUND LMS-Bug [supposedly fixed now]: sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
update quid [ QualificationUserBlockedDue =. Nothing ] -- when (Just (qualificationBlockedReasonText QualificationBlockFailedELearning) == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
update luid [ LmsUserStatus =. Just newStatus -- update quid [ QualificationUserBlockedDue =. Nothing ]
, LmsUserReceived =. Just lmsResultTimestamp
]
audit TransactionQualificationUserEdit
{ transactionQualificationUser = quid
, transactionQualification = qualificationUserQualification
, transactionUser = qualificationUserUser
, transactionQualificationValidUntil = newValidTo
, transactionQualificationScheduleRenewal = Nothing
}
return Nothing return Nothing
else do else do
let errmsg = [st|LMS success with insane date #{tshow lmsResultSuccess} received for #{tshow lmsUserIdent}|] let errmsg = [st|LMS success with insane date #{tshow lmsResultSuccess} received for #{tshow lmsUserIdent}|]