diff --git a/models/lms.model b/models/lms.model index 437de5179..e6923fa17 100644 --- a/models/lms.model +++ b/models/lms.model @@ -66,24 +66,21 @@ QualificationUser -- - delete-flag: isJust LmsUserStatus -- Note: REST means that LmsUserResetPin and LmsUserDelete remain unchanged by this GET request! -- - -- 3. REST POST Userlist.csv: - -- -- save as is to LmsUserlist - -- -- change LmsUserEnded from Nothing to Just now, if not included in received list + -- 3. REST POST Userlist.csv: just save as is to LmsUserlist -- -- 4. REST POST Ergebnisse.csv: just save as is to LmsResult -- -- 5. Daily Job LmsUserlist: -- Note: containment needs at-once processing -- - For all LmsUser: - -- + if contained, set LmsUserReceived to Just now() - -- + otherwise, set LmsUserEnded to Just now() - -- - if LmsUserlistFailed: - -- + set LmsUserStatus to Just Day - -- + set LmsUserDelete to True + -- + if contained: + -- set LmsUserReceived to Just now() + -- if LmsUserlistFailed: set LmsUserStatus to Just Day + -- + not contianed, by LmsUserReceived is set: set LmsUserEnded to Just now() -- - move row to LmsAudit -- -- 6. Daily Job LmsResult: -- - set LmsUserReceived to Just now() - -- - set LmsUserStatus to Just Day + -- - set LmsUserStatus to Just Day -- always -- - move row to LmsAudit diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index d27fa4c0f..6f5cd11fa 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -56,7 +56,8 @@ dispatchJobLmsResults qid = JobHandlerAtomic act forM_ results $ \(Entity luid luser, Entity lrid lresult) -> do -- three separate DB operations per result is not so nice. All within one transaction though. let lreceived = lmsResultTimestamp lresult - lstatus = lmsResultSuccess lresult & LmsSuccess + lstatus = lmsResultSuccess lresult & LmsSuccess + -- always log success, since this is only transmitted once update luid [ LmsUserStatus =. Just lstatus , LmsUserReceived =. Just lreceived ] @@ -80,16 +81,21 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners return (luser, lulist) forM_ results $ \case - (Entity luid _luser, Nothing) -> - update luid [LmsUserEnded =. Just now] + (Entity luid luser, Nothing) + | isJust $ lmsUserReceived luser + , isNothing $ lmsUserEnded luser -> + update luid [LmsUserEnded =. Just now] + | otherwise -> return () -- likely not yet started (Entity luid luser, Just (Entity lulid lulist)) -> do - let lreceived = lmsUserlistTimestamp lulist - lblocked = lmsUserlistFailed lulist - lstatus = LmsBlocked $ utctDay lreceived - update luid $ [ LmsUserStatus =. Just lstatus | lblocked ] - <> [ LmsUserReceived =. Just lreceived ] - when lblocked . insert_ $ LmsAudit qid (lmsUserIdent luser) lstatus lreceived now + let usrNoStat = isNothing $ lmsUserStatus luser + lBlocked = lmsUserlistFailed lulist + updStatus = lBlocked && usrNoStat -- only update empty status to blocked + lReceived = lmsUserlistTimestamp lulist + lStatus = LmsBlocked $ utctDay lReceived + update luid $ [ LmsUserStatus =. Just lStatus | updStatus ] + <> [ LmsUserReceived =. Just lReceived ] + when lBlocked . insert_ $ LmsAudit qid (lmsUserIdent luser) lStatus lReceived now -- always log blocked delete lulid $logInfoS "LmsUserlist" [st|Processed LMS Userlist with ${tshow (length results)} entries|]