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

fix(qualification): prevent qualification mixups

Browse Source
This commit is contained in:
Steffen Jost 2023-06-02 09:57:02 +00:00
parent 798a4bdf0a
commit 88d43560ae
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -93,16 +93,16 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
dispatchJobLmsEnqueueUser :: QualificationId -> UserId -> JobHandler UniWorX
dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
where
where
act :: YesodJobDB UniWorX ()
act = do
identsInUseVs <- E.select $ do
lui <- E.from $
do { u <- E.from (E.table @LmsUserlist); E.where_ (u E.^. LmsUserlistQualification E.==. E.val qid); pure (u E.^. LmsUserlistIdent) }
( (E.^. LmsUserlistIdent) <$> E.from (E.table @LmsUserlist) ) -- no filter by Qid, since LmsIdents must be unique across all
`E.union_`
do { u <- E.from (E.table @LmsResult ); E.where_ (u E.^. LmsResultQualification E.==. E.val qid); pure (u E.^. LmsResultIdent) }
( (E.^. LmsResultIdent) <$> E.from (E.table @LmsResult ) )
`E.union_`
do { u <- E.from (E.table @LmsUser ); E.where_ (u E.^. LmsUserQualification E.==. E.val qid); pure (u E.^. LmsUserIdent) }
( (E.^. LmsUserIdent) <$> E.from (E.table @LmsUser ) )
E.orderBy [E.asc lui]
pure lui
now <- liftIO getCurrentTime
@ -150,22 +150,26 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
`E.on` (\(quser :& luser) ->
luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
E.&&. luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification)
E.where_ $ E.isNothing (luser E.^. LmsUserStatus)
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
E.&&. luser E.^. LmsUserQualification E.==. E.val qid
E.&&. E.isNothing (luser E.^. LmsUserStatus)
E.&&. E.isNothing (luser E.^. LmsUserEnded)
E.&&. E.not_ (validQualification nowaday quser)
pure (luser E.^. LmsUserId)
nrExpired <- E.updateCount $ \luser -> do
E.set luser [LmsUserStatus E.=. E.justVal (LmsExpired nowaday)]
E.where_ $ (luser E.^. LmsUserId) `E.in_` E.valList (E.unValue <$> expiredLearners)
E.&&. luser E.^. LmsUserQualification E.==. E.val qid
$logInfoS "LMS" $ "Expired lms users " <> tshow nrExpired <> " for qualification " <> qshort
notifyInvalidDrivers <- E.select $ do
quser <- E.from $ E.table @QualificationUser
E.where_ $ E.not_ (validQualification nowaday quser)
E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue)
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
E.&&. E.not_ (validQualification nowaday quser)
E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue)
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
) E.||. (
E.isJust (quser E.^. QualificationUserBlockedDue)
E.isJust (quser E.^. QualificationUserBlockedDue)
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
))
pure (quser E.^. QualificationUserUser)