-- SPDX-FileCopyrightText: 2022-23 Steffen Jost ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later {-# LANGUAGE TypeApplications #-} module Jobs.Handler.LMS ( dispatchJobLmsQualificationsEnqueue , dispatchJobLmsQualificationsDequeue , dispatchJobLmsEnqueue, dispatchJobLmsEnqueueUser , dispatchJobLmsDequeue , dispatchJobLmsReports ) where import Import import Jobs.Queue -- import Jobs.Handler.Intervals.Utils import Database.Persist.Sql -- (deleteWhereCount, updateWhereCount) import Database.Esqueleto.Experimental ((:&)(..)) import qualified Database.Esqueleto.Experimental as E --import qualified Database.Esqueleto.Legacy as E -- import qualified Database.Esqueleto.PostgreSQL as E -- for insertSelect variant import qualified Database.Esqueleto.Utils as E import qualified Data.Set as Set -- import qualified Data.Map as Map -- import qualified Data.Time.Zones as TZ import Handler.Utils.DateTime import Handler.Utils.LMS (randomLMSIdentBut, randomLMSpw, maxLmsUserIdentRetries) import Handler.Utils.Qualification import qualified Data.CaseInsensitive as CI import qualified Data.Text as Text dispatchJobLmsQualificationsEnqueue :: JobHandler UniWorX dispatchJobLmsQualificationsEnqueue = JobHandlerAtomic $ fetchRefreshQualifications JobLmsEnqueue dispatchJobLmsQualificationsDequeue :: JobHandler UniWorX dispatchJobLmsQualificationsDequeue = JobHandlerAtomic $ fetchRefreshQualifications JobLmsDequeue -- execute given job for all qualifications that allow refreshs fetchRefreshQualifications :: (QualificationId -> Job) -> YesodJobDB UniWorX () fetchRefreshQualifications qidJob = do qids <- E.select $ do q <- E.from $ E.table @Qualification E.where_ $ E.isJust (q E.^. QualificationRefreshWithin) pure $ q E.^. QualificationId forM_ qids $ \(E.unValue -> qid) -> queueDBJob $ qidJob qid -- | enlist expiring qualification holders to e-learning -- NOTE: getting rid of QualificationId parameter and using a DB-join fails, since addGregorianDurationClip cannot be performed within DB dispatchJobLmsEnqueue :: QualificationId -> JobHandler UniWorX dispatchJobLmsEnqueue qid = JobHandlerAtomic act where -- act :: YesodJobDB UniWorX () act = do quali <- getJust qid -- may throw an error, aborting the job let qshort = CI.original $ qualificationShorthand quali $logInfoS "LMS" $ "Notifying about expiring qualification " <> qshort now <- liftIO getCurrentTime case qualificationRefreshWithin quali of Nothing -> return () -- TODO: no renewal period, no reminders currently (Just renewalPeriod) -> do let nowaday = utctDay now renewalDate = addGregorianDurationClip renewalPeriod nowaday sendReminders remindPeriod = do let remindDate = addGregorianDurationClip remindPeriod nowaday reminders <- E.select $ do -- TODO: refactor to remove some redundancies with later query (luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser `E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser ) E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid E.&&. quser E.^. QualificationUserScheduleRenewal E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val remindDate E.&&. validQualification now quser E.&&. E.isNothing (luser E.^. LmsUserEnded) E.&&. E.isNothing (luser E.^. LmsUserStatus) E.&&. E.isJust (luser E.^. LmsUserNotified) -- E.&&. ((day_ (luser E.^. LmsUserNotified) E.+. E.interval remindPeriod) E.<. quser E.^. QualificationUserValidUntil) -- not sure whether may throw runtime errors, so we check in Haskell-Land instead return (luser, quser E.^. QualificationUserValidUntil) forM_ reminders $ \case (Entity _ LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}, E.Value quValidUntil) | addGregorianDurationClip remindPeriod (utctDay lnotified) < quValidUntil -> queueDBJob JobUserNotification { jRecipient = luser , jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True } } _ -> return () -- send second reminders first, before enqueing even more ifMaybeM (qualificationRefreshReminder quali) () sendReminders renewalUsers <- E.select $ do quser <- E.from $ E.table @QualificationUser E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid E.&&. quser E.^. QualificationUserScheduleRenewal E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val renewalDate E.&&. (quser `qualificationValid` now) E.&&. E.notExists (do luser <- E.from $ E.table @LmsUser E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser E.&&. E.isNothing (luser E.^. LmsUserEnded) ) pure quser let usr_job :: Entity QualificationUser -> Job usr_job quser = let uid = quser ^. _entityVal . _qualificationUserUser uex = quser ^. _entityVal . _qualificationUserValidUntil in if qualificationElearningStart quali then JobLmsEnqueueUser { jQualification = qid, jUser = uid } else JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationExpiry { nQualification = qid, nExpiry = uex } } forM_ renewalUsers (queueDBJob . usr_job) logInterface "LMS" (qshort <> "-enq") (Just $ length renewalUsers) "" dispatchJobLmsEnqueueUser :: QualificationId -> UserId -> JobHandler UniWorX dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act where act :: YesodJobDB UniWorX () act = do quali <- getJust qid -- may throw an error, aborting the job let qshort = CI.original $ qualificationShorthand quali qprefix = fst <$> Text.uncons (Text.toLower qshort) identsInUseVs <- E.select $ do lui <- E.from $ ( (E.^. LmsUserIdent) <$> E.from (E.table @LmsUser ) ) -- no filter by Qid, since LmsIdents must be unique across all `E.union_` ( (E.^. LmsReportIdent) <$> E.from (E.table @LmsReport ) ) -- V2 E.orderBy [E.asc lui] pure lui now <- liftIO getCurrentTime let identsInUse = Set.fromList (E.unValue <$> identsInUseVs) uniqLmsUse = UniqueLmsQualificationUser qid uid mkLmsUser lpin lid = LmsUser { lmsUserQualification = qid , lmsUserUser = uid , lmsUserIdent = lid , lmsUserPin = lpin , lmsUserResetPin = False , lmsUserDatePin = now , lmsUserStatus = Nothing , lmsUserStatusDay = Nothing , lmsUserStarted = now , lmsUserReceived = Nothing , lmsUserNotified = Nothing , lmsUserEnded = Nothing , lmsUserResetTries = False , lmsUserLocked = True -- initially display locked, since it is not yet available until the first feedback } -- startLmsUser :: YesodJobDB UniWorX (Maybe (Entity LmsUser)) startLmsUser = do lpw <- randomLMSpw maybeM (pure Nothing) (E.insertUniqueEntity . mkLmsUser lpw) (randomLMSIdentBut qprefix identsInUse) -- runMaybeT $ do -- lid <- MaybeT $ randomLMSIdentBu qprefix identsInUse -- MaybeT $ E.insertUniqueEntity $ mkLmsUser lpw lid getBy uniqLmsUse >>= \case Just Entity{entityVal=LmsUser{..}} | isNothing lmsUserEnded, isNothing lmsUserStatus || lmsUserStatus == Just LmsSuccess -> do uuid :: CryptoUUIDUser <- encrypt uid $logErrorS "LMS" $ "Generating fresh LmsIdent failed for uuid " <> tshow uuid <> " and qid " <> tshow qid <> " due to LMS still existing!" other -> do when (isJust other) $ deleteBy uniqLmsUse untilJustMaxM maxLmsUserIdentRetries startLmsUser >>= \case Nothing -> do uuid :: CryptoUUIDUser <- encrypt uid $logErrorS "LMS" $ "Generating and inserting fresh LmsIdent failed for uuid " <> tshow uuid <> " and qid " <> tshow qid <> " for unknown reason!" (Just Entity{entityKey=lkey, entityVal=LmsUser{lmsUserIdent=lid, lmsUserUser=luid, lmsUserQualification=lqid}}) -> -- lmsUser started, but not yet notified audit $ TransactionLmsStart { transactionQualification = lqid , transactionLmsIdent = lid , transactionLmsUser = luid , transactionLmsUserKey = lkey } -- purge LmsIdent after QualificationAuditDuration expired dispatchJobLmsDequeue :: QualificationId -> JobHandler UniWorX dispatchJobLmsDequeue qid = JobHandlerAtomic act where act = do quali <- getJust qid -- may throw an error, aborting the job let qshort = CI.original $ qualificationShorthand quali $logInfoS "LMS" $ "Processing e-learning results for qualification " <> qshort now <- liftIO getCurrentTime -- end users that expired by doing nothing expiredUsers <- E.select $ do (quser :& luser) <- E.from $ E.table @QualificationUser `E.leftJoin` E.table @LmsUser `E.on` (\(quser :& luser) -> luser E.?. LmsUserUser E.?=. quser E.^. QualificationUserUser E.&&. luser E.?. LmsUserQualification E.?=. quser E.^. QualificationUserQualification) E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid -- E.&&. luser E.?. LmsUserQualification E.?=. E.val qid -- E.&&. E.isNothing (luser E.^. LmsUserStatus) -- E.&&. E.isNothing (luser E.^. LmsUserEnded) E.&&. E.not_ (validQualification now quser) pure (luser E.?. LmsUserId, quser E.^. QualificationUserUser) nrBlocked <- qualificationUserBlocking qid (E.unValue . snd <$> expiredUsers) False (Just now) (Right QualificationBlockExpired) True -- essential that blocks occur only once let expiredLearners = [ luid | (E.Value (Just luid), _) <- expiredUsers ] -- let expiredLearners = catMaybes (E.unValue . fst <$> expiredUsers) nrExpired <- E.updateCount $ \luser -> do E.set luser [LmsUserStatus E.=. E.justVal LmsExpired, LmsUserStatusDay E.=. E.justVal now] E.where_ $ E.isNothing (luser E.^. LmsUserStatus) E.&&. luser E.^. LmsUserQualification E.==. E.val qid E.&&. (luser E.^. LmsUserId) `E.in_` E.valList expiredLearners 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 notifyInvalidDrivers <- E.select $ do (quser :& qblock) <- E.from $ E.table @QualificationUser `E.leftJoin` E.table @QualificationUserBlock `E.on` (\(quser :& qblock) -> qblock E.?. QualificationUserBlockQualificationUser E.?=. quser E.^. QualificationUserId E.&&. qblock `isLatestBlockBefore` E.val now ) E.where_ $ -- E.not_ (validQualification now quser) -- currently invalid quser E.^. QualificationUserQualification E.==. E.val qid -- correct qualification E.&&. quserToNotify now quser qblock -- recently became invalid or blocked pure (quser E.^. QualificationUserUser) forM_ notifyInvalidDrivers $ \(E.Value uid) -> queueDBJob JobUserNotification { jRecipient = uid , jNotification = NotificationQualificationExpired { nQualification = qid } } -- purge outdated LmsUsers case qualificationAuditDuration quali of Nothing -> return () -- no automatic removal (Just auditDuration) -> do let auditCutoff = addDiffDaysRollOver (fromMonths $ negate auditDuration) now $logInfoS "LMS" $ "Audit Cuttoff at " <> tshow auditCutoff <> " for Audit Duration " <> tshow auditDuration <> " for qualification " <> qshort delusersVals <- E.select $ do luser <- E.from $ E.table @LmsUser E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid E.&&. luser E.^. LmsUserEnded E.<. E.justVal auditCutoff E.&&. E.isJust (luser E.^. LmsUserEnded) -- E.&&. E.notExists (do -- laudit <- E.from $ E.table @LmsAudit -- E.where_ $ laudit E.^. LmsAuditQualification E.==. E.val qid -- E.&&. laudit E.^. LmsAuditIdent E.==. luser E.^. LmsUserIdent -- E.&&. laudit E.^. LmsAuditProcessed E.>=. E.val auditCutoff -- ) pure (luser E.^. LmsUserIdent) let delusers = E.unValue <$> delusersVals numdel = length delusers when (numdel > 0) $ do $logInfoS "LMS" $ "Deleting " <> tshow numdel <> " LmsIdents due to audit duration expiry for qualification " <> qshort deleteWhere [LmsUserQualification ==. qid, LmsUserIdent <-. delusers] -- deleteWhere [LmsAuditQualification ==. qid, LmsAuditIdent <-. delusers] deleteWhere [LmsReportLogQualification ==. qid, LmsReportLogTimestamp <. auditCutoff ] logInterface "LMS" (qshort <> "-deq") (Just nrBlocked) (tshow nrExpired <> " expired") dispatchJobLmsReports :: QualificationId -> JobHandler UniWorX dispatchJobLmsReports qid = JobHandlerAtomic act where -- act :: YesodJobDB UniWorX () act = whenM (exists [LmsReportQualification ==. qid]) $ do -- executing twice must be prohibited due to assertion that ALL learners are always sent (D fails otherwise) now <- liftIO getCurrentTime -- DEBUG 2rows; remove later totalrows <- count [LmsReportQualification ==. qid] $logInfoS "LMS" $ "Report processing " <> tshow totalrows <> " rows for qualification " <> tshow qid when (totalrows > 0) $ do let -- locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now -- no longer necessary, since LMS reports dates only -- DB query for LmsUserUser, provided a matching LmsReport exists luserQry luFltr repFltr = E.select $ do luser <- E.from $ E.table @LmsUser E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification E.&&. E.isNothing (luser E.^. LmsUserEnded) -- ignore all closed learners E.&&. luFltr luser E.&&. E.exists (do lreport <- E.from $ E.table @LmsReport E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent E.&&. lreport E.^. LmsReportQualification E.==. E.val qid E.&&. repFltr luser lreport ) return $ luser E.^. LmsUserUser -- DB query for LmsUser innerJoin LmsReport lrepQry lrFltr = E.select $ do (luser :& lreport) <- E.from $ E.table @LmsUser`E.innerJoin` E.table @LmsReport `E.on` (\(luser :& lreport) -> luser E.^. LmsUserIdent E.==. lreport E.^. LmsReportIdent E.&&. luser E.^. LmsUserQualification E.==. lreport E.^. LmsReportQualification) E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid E.&&. lreport E.^. LmsReportQualification E.==. E.val qid E.&&. E.isNothing (luser E.^. LmsUserEnded) -- ignore all closed learners E.&&. lrFltr luser lreport return (luser, lreport) -- A) reset status for learners that had their tries just resetted as indicated by LmsOpen E.update $ \luser -> do E.set luser [ LmsUserStatus E.=. E.nothing , LmsUserStatusDay E.=. E.nothing , LmsUserResetTries E.=. E.false ] E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification E.&&. E.isNothing (luser E.^. LmsUserEnded ) -- must still exist at server E.&&. E.isJust (luser E.^. LmsUserReceived) -- seen before, for otherwise it might not have been started yet E.&&. luser E.^. LmsUserResetTries E.&&. E.exists (do lreport <- E.from $ E.table @LmsReport E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent E.&&. lreport E.^. LmsReportQualification E.==. E.val qid E.&&. lreport E.^. LmsReportResult E.==. E.val LmsOpen E.&&. lreport E.^. LmsReportLock E.==. E.true ) -- B) notify all newly reported users that lms is available let luserFltrNew luser = E.isNothing $ luser E.^. LmsUserReceived -- not seen before, just starting notifyNewLearner (E.Value uid) = queueDBJob JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = False } } in luserQry luserFltrNew (const $ const E.true) >>= mapM_ notifyNewLearner -- C) block qualifications for failed learners by calling qualificationUserBlocking [uids] (includes audit), notified during expiry let lrFltrBlock luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsFailed procBlock (Entity luid luser, Entity _ lreport) = do let repDay = lmsReportDate lreport <|> Just now ok_block <- qualificationUserBlocking qid [lmsUserUser luser] False (lmsReportDate lreport) (Right $ QualificationBlockFailedELearningBy $ lmsUserIdent luser) True -- only valid qualifications are blocked; transcribes to audit log update luid [LmsUserStatus =. Just LmsBlocked, LmsUserStatusDay =. repDay] return $ Sum ok_block in lrepQry lrFltrBlock >>= foldMapM procBlock >>= \s -> $logInfoS "LMS" $ "Report processing: " <> tshow (getSum s) <> " status set to blocked for qualification " <> tshow qid -- debug, remove later -- D) renew qualifications for all successfull learners let lrFltrSuccess luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsPassed procRenew (Entity luid luser, Entity _ lreport) = do let repDay = lmsReportDate lreport <|> Just now reason = Just $ Right $ QualificationRenewELearningBy $ lmsUserIdent luser -- LMS WORKAROUND 2: [supposedly fixed now] sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning -- let reason_undo = Left $ "LMS Workaround undoing: " <> qualificationBlockedReasonText QualificationBlockFailedELearning -- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log -- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|]) -- END LMS WORKAROUND 2 ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay] return $ Sum ok_renew in lrepQry lrFltrSuccess >>= foldMapM procRenew >>= \s -> $logInfoS "LMS" $ "Report processing: " <> tshow (getSum s) <> " renewed and status set to success for qualification " <> tshow qid -- debug, remove later -- E) mark all previuosly reported, but now unreported users as ended (LMS deleted them as expected) E.update $ \luser -> do E.set luser [ LmsUserEnded E.=. E.justVal now ] E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification E.&&. E.isNothing (luser E.^. LmsUserEnded ) E.&&. E.isJust (luser E.^. LmsUserStatus ) -- status is decided E.&&. E.isJust (luser E.^. LmsUserReceived) -- seen before, for otherwise it might not have been started yet E.&&. E.notExists (do lreport <- E.from $ E.table @LmsReport E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent E.&&. lreport E.^. LmsReportQualification E.==. E.val qid ) -- F) lock expired learners: happens during JobLmsDequeue only -- G) update lock and received let updateReceivedLocked lockstatus = E.updateCount $ \luser -> do -- due to the absence of UPDATE..FROM in esqueleto, we call update twice E.set luser [ LmsUserReceived E.=. E.justVal now , LmsUserLocked E.=. E.val lockstatus ] E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification -- E.&&. E.isNothing (luser E.^. LmsUserEnded) -- should always be true, but maybe there is a bug? E.&&. E.exists (do lreport <- E.from $ E.table @LmsReport E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent E.&&. lreport E.^. LmsReportQualification E.==. E.val qid E.&&. lreport E.^. LmsReportLock E.==. E.val lockstatus -- Maybe more efficient, but less readable: bool E.not_ id lockstatus (lreport E.^. LmsReport Lock) ) -- NOTE: this code leads to a runtime errror; apparently from-clauses are not allowed in updates yet -- let updateReceivedLocked lockstatus = E.update $ \luser -> do -- attempt to use 'from'-clause in update as per PostgreSQL -- E.set luser [ LmsUserReceived E.=. E.justVal now -- , LmsUserLocked E.=. E.val lockstatus ] -- lreport <- E.from $ E.table @LmsReport -- E.where_ $ E.isNothing (luser E.^. LmsUserEnded) -- E.&&. luser E.^. LmsUserQualification E.==. E.val qid -- E.&&. lreport E.^. LmsReportQualification E.==. E.val qid -- E.&&. lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent -- E.&&. lreport E.^. LmsReportLock E.==. E.val lockstatus -- Maybe more efficient, but less readable: bool E.not_ id lockstatus (lreport E.^. LmsReport Lock) updateReceivedLocked False >>= \nr -> $logInfoS "LMS" $ "Report processing marked " <> tshow nr <> " rows as unlocked and received for qualification " <> tshow qid -- debug, remove later updateReceivedLocked True >>= \nr -> $logInfoS "LMS" $ "Report processing marked " <> tshow nr <> " rows as locked and received for qualification " <> tshow qid -- debug, remove later -- G) Truncate LmsReport for qid, after updating log E.insertSelect $ do lreport <- E.from $ E.table @LmsReport let samelog = E.subSelect $ do lrl <- E.from $ E.table @LmsReportLog E.where_ $ lrl E.^. LmsReportLogQualification E.==. E.val qid E.&&. lrl E.^. LmsReportLogIdent E.==. lreport E.^. LmsReportIdent E.orderBy [E.desc $ lrl E.^. LmsReportLogTimestamp] return $ lreport E.^. LmsReportResult E.==. lrl E.^. LmsReportLogResult E.&&. lreport E.^. LmsReportLock E.==. lrl E.^. LmsReportLogLock E.&&. E.not_ (lrl E.^. LmsReportLogMissing) E.where_ $ lreport E.^. LmsReportQualification E.==. E.val qid E.&&. E.not_ (E.isTrue samelog) return (LmsReportLog E.<# (lreport E.^. LmsReportQualification) E.<&> (lreport E.^. LmsReportIdent ) E.<&> (lreport E.^. LmsReportDate ) E.<&> (lreport E.^. LmsReportResult ) E.<&> (lreport E.^. LmsReportLock ) E.<&> (lreport E.^. LmsReportTimestamp ) E.<&> E.false) E.insertSelect $ do lrl <- E.from $ E.table @LmsReportLog E.where_ $ E.not_ (lrl E.^. LmsReportLogMissing) E.&&. lrl E.^. LmsReportLogQualification E.==. E.val qid E.&&. E.notExists (do lreport <- E.from $ E.table @LmsReport E.where_ $ lreport E.^. LmsReportQualification E.==. E.val qid E.&&. lreport E.^. LmsReportIdent E.==. lrl E.^. LmsReportLogIdent ) E.&&. E.notExists (do lrl_old <- E.from $ E.table @LmsReportLog E.where_ $ lrl_old E.^. LmsReportLogQualification E.==. E.val qid E.&&. lrl_old E.^. LmsReportLogIdent E.==. lrl E.^. LmsReportLogIdent E.&&. lrl_old E.^. LmsReportLogTimestamp E.>. lrl E.^. LmsReportLogTimestamp ) return (LmsReportLog E.<# (lrl E.^. LmsReportLogQualification) E.<&> (lrl E.^. LmsReportLogIdent ) E.<&> E.nothing E.<&> (lrl E.^. LmsReportLogResult ) E.<&> (lrl E.^. LmsReportLogLock ) E.<&> E.val now E.<&> E.true) repProc <- deleteWhereCount [LmsReportQualification ==. qid] $logInfoS "LMS" [st|Processed #{tshow repProc} e-learning status reports for qualification #{tshow qid}.|]