From a97c8168da9d79becfd05bd128c19a64a7246d7e Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 28 Feb 2023 17:19:13 +0100
Subject: [PATCH] chore(lms): workaround for simultaneous success and failure
 lms status

---
 src/Jobs/Handler/LMS.hs | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs
index dd0d27d80..08557753b 100644
--- a/src/Jobs/Handler/LMS.hs
+++ b/src/Jobs/Handler/LMS.hs
@@ -31,6 +31,9 @@ import Handler.Utils.LMS (randomLMSIdentBut, randomLMSpw, maxLmsUserIdentRetries
 import qualified Data.CaseInsensitive as CI
 
 
+blockedByElearning :: Text 
+blockedByElearning = "E-Learning durchgefallen"
+
 dispatchJobLmsQualificationsEnqueue :: JobHandler UniWorX
 dispatchJobLmsQualificationsEnqueue = JobHandlerAtomic $ fetchRefreshQualifications JobLmsEnqueue
 
@@ -195,7 +198,7 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
                         E.&&. luser E.^. LmsUserQualification  E.==. lresult E.^. LmsResultQualification)
           E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
             E.&&.    luser E.^. LmsUserQualification           E.==. E.val qid
-            E.&&. E.isNothing (luser E.^. LmsUserStatus)  -- do not process learners already having a result
+            -- E.&&. E.isNothing (luser E.^. LmsUserStatus)  -- do not process learners already having a result WORKAROUND LMS-Bug: LMS may send blocked & success simultanesouly or within a few hours; in this case, success is the correct meaning
             E.&&. E.isNothing (luser E.^. LmsUserEnded)   -- do not process closed learners
           return (quser, luser, lresult)
         now <- liftIO getCurrentTime
@@ -210,12 +213,16 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
           note <- if saneDate && isLmsSuccess newStatus
             then do
               -- TODO: refactor using functions from Handler.Utils.Qualification to ensure nothing is forgotten!
-              update quid [ QualificationUserValidUntil  =. newValidTo
+              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 blockedByElearning == qUsr ^? _qualificationUserBlockedDue . _Just . _qualificationBlockedReason) $
+                update quid [ QualificationUserBlockedDue =. Nothing ]              
               update luid [ LmsUserStatus   =. Just newStatus
                           , LmsUserReceived =. Just lmsResultTimestamp
-                          ]
+                          ]                          
               audit TransactionQualificationUserEdit
                 { transactionQualificationUser            = quid
                 , transactionQualification                = qualificationUserQualification
@@ -289,7 +296,7 @@ dispatchJobLmsUserlist  qid = JobHandlerAtomic act
             update luid [LmsUserStatus =. (oldStatus <> Just newStatus)]
             updateBy (UniqueQualificationUser qid (lmsUserUser luser)) 
               [QualificationUserBlockedDue =. Just (QualificationBlocked { qualificationBlockedDay = blockedDay
-                                                                         , qualificationBlockedReason = "E-Learning durchgefallen" } )]
+                                                                         , qualificationBlockedReason = blockedByElearning } )]
             queueDBJob JobSendNotification
               { jRecipient    = lmsUserUser luser
               , jNotification = NotificationQualificationExpired { nQualification = qid, nExpiry = blockedDay }