From 6761767c6ca8cab62a22aa6f755e6231e07ab411 Mon Sep 17 00:00:00 2001
From: Steffen Jost <s.jost@fraport.de>
Date: Wed, 15 Nov 2023 12:42:04 +0100
Subject: [PATCH] fix(lms): LMS restart failing due to old LmsUser entry

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

diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs
index 06451d5a6..bb1e1c1ce 100644
--- a/src/Jobs/Handler/LMS.hs
+++ b/src/Jobs/Handler/LMS.hs
@@ -142,6 +142,7 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
         pure lui
       now <- liftIO getCurrentTime
       let identsInUse = Set.fromList (E.unValue <$> identsInUseVs)
+          uniqLmsUse  = UniqueLmsQualificationUser qid uid
           mkLmsUser lpin lid = LmsUser
             { lmsUserQualification = qid
             , lmsUserUser          = uid
@@ -157,26 +158,32 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
             , 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
+            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
-      inserted <- untilJustMaxM maxLmsUserIdentRetries startLmsUser
-      case inserted of
-        Nothing  -> do
-          uuid :: CryptoUUIDUser <- encrypt uid
-          $logErrorS "LMS" $ "Generating and inserting fresh LmsIdent failed for uuid " <> tshow uuid <> " and qid " <> tshow qid <> "!"
-        (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
-            }
+      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