fraport/fradrive
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
-- act :: YesodJobDB UniWorX ()
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
(quser :& luser :& lresult) <- E.from $
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)
now <- liftIO getCurrentTime
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.
let lmsUserStartedDay = localDay $ TZ.utcToLocalTimeTZ appTZ lmsUserStarted
saneDate = lmsResultSuccess `inBetween` (lmsUserStartedDay, min qualificationUserValidUntil locDay)
&& qualificationUserLastRefresh <= utctDay lmsUserStarted
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
then do
-- TODO: refactor using functions from Handler.Utils.Qualification to ensure nothing is forgotten!
qUsr <- updateGet quid
[ QualificationUserValidUntil =. newValidTo
, 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 (qualificationBlockedReasonText QualificationBlockFailedELearning) == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
update quid [ QualificationUserBlockedDue =. Nothing ]
update luid [ LmsUserStatus =. Just newStatus
, LmsUserReceived =. Just lmsResultTimestamp
]
audit TransactionQualificationUserEdit
{ transactionQualificationUser = quid
, transactionQualification = qualificationUserQualification
, transactionUser = qualificationUserUser
, transactionQualificationValidUntil = newValidTo
, transactionQualificationScheduleRenewal = Nothing
}
_ok <- renewValidQualificationUsers qid [qualificationUserUser] -- blocked is unaffected
-- 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
update luid
[ LmsUserStatus =. Just newStatus
, LmsUserReceived =. Just lmsResultTimestamp
]
-- 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
-- when (Just (qualificationBlockedReasonText QualificationBlockFailedELearning) == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
-- update quid [ QualificationUserBlockedDue =. Nothing ]
return Nothing
else do
let errmsg = [st|LMS success with insane date #{tshow lmsResultSuccess} received for #{tshow lmsUserIdent}|]