-- SPDX-FileCopyrightText: 2022-24 Steffen Jost <s.jost@fraport.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- 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 exipiring 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") True (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") True (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
                            E.||. E.isNothing (luser E.^. LmsUserNotified)  -- a previous notification has failed
            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}.|]
