fix(lms): LMS restart failing due to old LmsUser entry

This commit is contained in:
Steffen Jost 2023-11-15 12:42:04 +01:00
parent a360101d44
commit 6761767c6c

View File

@ -142,6 +142,7 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
pure lui pure lui
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let identsInUse = Set.fromList (E.unValue <$> identsInUseVs) let identsInUse = Set.fromList (E.unValue <$> identsInUseVs)
uniqLmsUse = UniqueLmsQualificationUser qid uid
mkLmsUser lpin lid = LmsUser mkLmsUser lpin lid = LmsUser
{ lmsUserQualification = qid { lmsUserQualification = qid
, lmsUserUser = uid , lmsUserUser = uid
@ -165,11 +166,17 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
-- runMaybeT $ do -- runMaybeT $ do
-- lid <- MaybeT $ randomLMSIdentBu qprefix identsInUse -- lid <- MaybeT $ randomLMSIdentBu qprefix identsInUse
-- MaybeT $ E.insertUniqueEntity $ mkLmsUser lpw lid -- MaybeT $ E.insertUniqueEntity $ mkLmsUser lpw lid
inserted <- untilJustMaxM maxLmsUserIdentRetries startLmsUser getBy uniqLmsUse >>= \case
case inserted of 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 Nothing -> do
uuid :: CryptoUUIDUser <- encrypt uid uuid :: CryptoUUIDUser <- encrypt uid
$logErrorS "LMS" $ "Generating and inserting fresh LmsIdent failed for uuid " <> tshow uuid <> " and qid " <> tshow qid <> "!" $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 (Just Entity{entityKey=lkey, entityVal=LmsUser{lmsUserIdent=lid, lmsUserUser=luid, lmsUserQualification=lqid}}) -> -- lmsUser started, but not yet notified
audit $ TransactionLmsStart audit $ TransactionLmsStart
{ transactionQualification = lqid { transactionQualification = lqid