From 520e649fc8bbf5f4c1bef6cf372bb1a8900d3ac4 Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Wed, 20 Sep 2023 09:51:43 +0000
Subject: [PATCH] chore(lms): minor refactoring for selectValidQualifications

---
 src/Handler/Utils/Qualification.hs | 26 +++++++++++++-------------
 src/Jobs/Handler/LMS.hs            |  2 +-
 2 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs
index 3a92e28d5..3f43d53d0 100644
--- a/src/Handler/Utils/Qualification.hs
+++ b/src/Handler/Utils/Qualification.hs
@@ -120,21 +120,21 @@ validQualification' cutoff qualUser =
                                           ,qualUser E.?. QualificationUserValidUntil))   -- currently valid
            E.&&. quserBlock' False cutoff qualUser
 
--- selectValidQualifications :: QualificationId -> Maybe [UserId] -> UTCTime -> DB [Entity QualificationUser]
+-- selectValidQualifications :: QualificationId -> [UserId] -> UTCTime -> DB [Entity QualificationUser]
 selectValidQualifications :: 
   ( MonadIO m
   , BackendCompatible SqlBackend backend
   , PersistQueryRead backend
   , PersistUniqueRead backend
-  ) => QualificationId -> Maybe [UserId] -> UTCTime -> ReaderT backend m [Entity QualificationUser]
-selectValidQualifications qid mbUids cutoff = 
+  ) => QualificationId -> [UserId] -> UTCTime -> ReaderT backend m [Entity QualificationUser]
+selectValidQualifications qid uids cutoff = 
   -- cutoff <- utctDay <$> liftIO getCurrentTime
   E.select $ do 
     qUser <- E.from $ E.table @QualificationUser
     E.where_ $  (qUser E.^. QualificationUserQualification E.==. E.val qid)
-          E.&&. validQualification cutoff qUser
-    --      E.&&. maybe E.true (\uids -> qUser E.^. QualificationUserUser `E.in_` E.valList uids) mbUids
-    whenIsJust mbUids (\uids -> E.where_ $ qUser E.^. QualificationUserUser `E.in_` E.valList uids)
+          E.&&.  qUser E.^. QualificationUserUser `E.in_` E.valList uids
+          E.&&.  validQualification cutoff qUser
+    -- whenIsJust mbUids (\uids -> E.where_ $ qUser E.^. QualificationUserUser `E.in_` E.valList uids)
     pure qUser
 
 selectRelevantBlock :: UTCTime -> QualificationUserId -> DB (Maybe (Entity QualificationUserBlock))
@@ -194,15 +194,15 @@ renewValidQualificationUsers qid renewalTime uids =
   --       E.&&.  (qu E.^. QualificationUserUser `E.in_` E.valList uids)
   get qid >>= \case     
     Just Qualification{qualificationValidDuration=Just renewalMonths} -> do
-      now <- maybe (liftIO getCurrentTime) return renewalTime
-      quEntsAll <- selectValidQualifications qid (Just uids) now
-      let nowaday     = utctDay now
-          maxValidTo  = addGregorianMonthsRollOver (toInteger renewalMonths) nowaday
+      cutoff <- maybe (liftIO getCurrentTime) return renewalTime
+      quEntsAll <- selectValidQualifications qid uids cutoff
+      let cutoffday     = utctDay cutoff
+          maxValidTo  = addGregorianMonthsRollOver (toInteger renewalMonths) cutoffday
           quEnts      = filter (\q -> maxValidTo >= (q ^. _entityVal . _qualificationUserValidUntil)) quEntsAll
       forM_ quEnts $ \(Entity quId QualificationUser{..}) -> do 
         let newValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil        
         update quId [ QualificationUserValidUntil   =. newValidTo
-                    , QualificationUserLastRefresh  =. nowaday
+                    , QualificationUserLastRefresh  =. cutoffday
                     ]
         audit TransactionQualificationUserEdit
           { transactionQualificationUser            = quId
@@ -282,11 +282,11 @@ qualificationUserUnblockByReason ::
   , Num n
   ) => QualificationId -> [UserId] -> Maybe UTCTime -> QualificationBlockReason -> QualificationBlockReason -> Bool -> ReaderT (YesodPersistBackend (HandlerSite m)) m n
 qualificationUserUnblockByReason qid uids mbUnblockTime (qualificationBlockReasonText -> reason) undo_reason notify = do
-  now <- maybe (liftIO getCurrentTime) return mbUnblockTime 
+  cutoff <- maybe (liftIO getCurrentTime) return mbUnblockTime 
   toUnblock <- E.select $ do
     quser <- E.from $ E.table @QualificationUser
     E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
         E.&&.  quser E.^. QualificationUserUser `E.in_` E.valList uids
-        E.&&.  quserBlockAux True (E.val now) (E.==. (quser E.^. QualificationUserId)) (Just (\qblock -> (qblock E.^. QualificationUserBlockReason) E.==. E.val reason))
+        E.&&.  quserBlockAux True (E.val cutoff) (E.==. (quser E.^. QualificationUserId)) (Just (\qblock -> (qblock E.^. QualificationUserBlockReason) E.==. E.val reason))
     return $ quser E.^. QualificationUserUser
   qualificationUserBlocking qid (E.unValue <$> toUnblock) True mbUnblockTime undo_reason notify 
diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs
index d309cce6a..7ab8cfa27 100644
--- a/src/Jobs/Handler/LMS.hs
+++ b/src/Jobs/Handler/LMS.hs
@@ -318,7 +318,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
               -- 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 (lmsReportDate lreport) [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log
+              ok_renew <- renewValidQualificationUsers qid 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