From 83ec6d4a9030dd0cbf9f27019e9fab90e358195d Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Mon, 20 Mar 2023 15:03:59 +0000
Subject: [PATCH] chore(lms): regular renewal for lms success only

---
 src/Jobs/Handler/LMS.hs | 35 +++++++++++------------------------
 1 file changed, 11 insertions(+), 24 deletions(-)

diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs
index a860c8d6a..cc5b17ff2 100644
--- a/src/Jobs/Handler/LMS.hs
+++ b/src/Jobs/Handler/LMS.hs
@@ -180,10 +180,6 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
   where
     -- act :: YesodJobDB UniWorX ()
     act = hoist lift $ do
-      quali <- getJust qid
-      whenIsJust (qualificationValidDuration quali) $ \renewalMonths -> do
-        -- otherwise there is nothing to do: we cannot renew s qualification  without a specified validDuration
-        -- result :: [(Entity QualificationUser, Entity LmsUser, Entity LmsResult)]
         results <- E.select $ do
           (quser :& luser :& lresult) <- E.from $
               E.table @QualificationUser  -- table not needed if renewal from lms completion day is used TODO: decide!
@@ -202,33 +198,24 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
           return (quser, luser, lresult)
         now <- liftIO getCurrentTime
         let locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now
-        forM_ results $ \(Entity quid QualificationUser{..}, Entity luid LmsUser{..}, Entity lrid LmsResult{..}) -> do
+        forM_ results $ \(Entity _quid QualificationUser{..}, Entity luid LmsUser{..}, Entity lrid LmsResult{..}) -> do
           -- three separate DB operations per result is not so nice. All within one transaction though.
           let lmsUserStartedDay = localDay $ TZ.utcToLocalTimeTZ appTZ lmsUserStarted
               saneDate    = lmsResultSuccess `inBetween` (lmsUserStartedDay, min qualificationUserValidUntil locDay)
                             && qualificationUserLastRefresh <= utctDay lmsUserStarted
               newStatus   = LmsSuccess lmsResultSuccess
-              newValidTo  = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil -- renew from old validUntil onwards
+              -- newValidTo  = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil -- renew from old validUntil onwards
           note <- if saneDate && isLmsSuccess newStatus
             then do
-              -- TODO: refactor using functions from Handler.Utils.Qualification to ensure nothing is forgotten!
-              qUsr <- updateGet quid 
-                          [ QualificationUserValidUntil  =. newValidTo
-                          , QualificationUserLastRefresh =. lmsResultSuccess
-                          ]
-              -- WORKAROUND LMS-Bug: sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
-              when (Just (qualificationBlockedReasonText QualificationBlockFailedELearning) == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
-                update quid [ QualificationUserBlockedDue =. Nothing ]              
-              update luid [ LmsUserStatus   =. Just newStatus
-                          , LmsUserReceived =. Just lmsResultTimestamp
-                          ]                          
-              audit TransactionQualificationUserEdit
-                { transactionQualificationUser            = quid
-                , transactionQualification                = qualificationUserQualification
-                , transactionUser                         = qualificationUserUser
-                , transactionQualificationValidUntil      = newValidTo
-                , transactionQualificationScheduleRenewal = Nothing
-                }
+              _ok <- renewValidQualificationUsers qid [qualificationUserUser] -- blocked is unaffected
+              -- when (ok==1) $ update luid -- we end lms regardless of wether a regular renewal was successful, since BPol users may simultaneoysly have on-premise renewal courses and E-Learnings
+              update luid 
+                [ LmsUserStatus   =. Just newStatus
+                , LmsUserReceived =. Just lmsResultTimestamp
+                ]                          
+              -- WORKAROUND LMS-Bug [supposedly fixed now]: sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
+              -- when (Just (qualificationBlockedReasonText QualificationBlockFailedELearning) == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
+              --  update quid [ QualificationUserBlockedDue =. Nothing ]              
               return Nothing
             else do
               let errmsg = [st|LMS success with insane date #{tshow lmsResultSuccess} received for #{tshow lmsUserIdent}|]