fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Steffen Jost 2023-11-15 12:42:04 +01:00
parent a360101d44
commit 6761767c6c
1 changed files with 21 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/Jobs/Handler/LMS.hs
View File

@ -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