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

chore(log): log lms background tasks running

Browse Source
This commit is contained in:
Steffen Jost 2023-12-09 10:40:16 +00:00
parent 30fae33ded
commit 5ea0289eb7
2 changed files with 5 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Admin.hs
View File

@ -40,7 +40,7 @@ getAdminProblemsR :: Handler Html
getAdminProblemsR = do getAdminProblemsR = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let nowaday = utctDay now let nowaday = utctDay now
cutOffOldDays = 7 cutOffOldDays = 1
cutOffOldTime = toMidnight $ addDays (-cutOffOldDays) nowaday cutOffOldTime = toMidnight $ addDays (-cutOffOldDays) nowaday
-- we abuse messageTooltip for colored icons here -- we abuse messageTooltip for colored icons here

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

@ -117,6 +117,7 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
NotificationQualificationExpiry { nQualification = qid, nExpiry = uex } NotificationQualificationExpiry { nQualification = qid, nExpiry = uex }
} }
forM_ renewalUsers (queueDBJob . usr_job) forM_ renewalUsers (queueDBJob . usr_job)
logInterface "LMS" (qshort <> "-enq") (Just $ length renewalUsers) ""
dispatchJobLmsEnqueueUser :: QualificationId -> UserId -> JobHandler UniWorX dispatchJobLmsEnqueueUser :: QualificationId -> UserId -> JobHandler UniWorX
dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
@ -211,7 +212,8 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
E.where_ $ E.isNothing (luser E.^. LmsUserStatus) E.where_ $ E.isNothing (luser E.^. LmsUserStatus)
E.&&. luser E.^. LmsUserQualification E.==. E.val qid E.&&. luser E.^. LmsUserQualification E.==. E.val qid
E.&&. (luser E.^. LmsUserId) `E.in_` E.valList expiredLearners E.&&. (luser E.^. LmsUserId) `E.in_` E.valList expiredLearners
$logInfoS "LMS" $ "Expired qualification holders " <> tshow nrBlocked <> " and expired lms users " <> tshow nrExpired <> " for qualification " <> qshort let dequeueInfo = "Blocked qualification holders " <> tshow nrBlocked <> " out of expired lms users " <> tshow nrExpired <> " for qualification " <> qshort
$logInfoS "LMS" dequeueInfo
when (quali ^. _qualificationExpiryNotification) $ do -- notifies expired and previously lms-failed drivers when (quali ^. _qualificationExpiryNotification) $ do -- notifies expired and previously lms-failed drivers
notifyInvalidDrivers <- E.select $ do notifyInvalidDrivers <- E.select $ do
@ -257,6 +259,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
deleteWhere [LmsUserQualification ==. qid, LmsUserIdent <-. delusers] deleteWhere [LmsUserQualification ==. qid, LmsUserIdent <-. delusers]
-- deleteWhere [LmsAuditQualification ==. qid, LmsAuditIdent <-. delusers] -- deleteWhere [LmsAuditQualification ==. qid, LmsAuditIdent <-. delusers]
deleteWhere [LmsReportLogQualification ==. qid, LmsReportLogTimestamp <. auditCutoff ] deleteWhere [LmsReportLogQualification ==. qid, LmsReportLogTimestamp <. auditCutoff ]
logInterface "LMS" (qshort <> "-deq") (Just nrBlocked) (tshow nrExpired <> " expired")
dispatchJobLmsReports :: QualificationId -> JobHandler UniWorX dispatchJobLmsReports :: QualificationId -> JobHandler UniWorX