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

chore(lms): correct job handler ulist to deal with repeated uploads

Browse Source
This commit is contained in:
Steffen Jost 2022-03-28 15:19:38 +02:00
parent c7f734cfca
commit 5f2f353007
2 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
models/lms.model
View File

@ -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

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

@ -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|]