fraport/fradrive-old
Archived
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 :: QualificationId -> UserId -> JobHandler UniWorX
dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
where where
act :: YesodJobDB UniWorX () act :: YesodJobDB UniWorX ()
act = do act = do
identsInUseVs <- E.select $ do identsInUseVs <- E.select $ do
lui <- E.from $ 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_` `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_` `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] E.orderBy [E.asc lui]
pure lui pure lui
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
@ -150,22 +150,26 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
`E.on` (\(quser :& luser) -> `E.on` (\(quser :& luser) ->
luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
E.&&. luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification) 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.isNothing (luser E.^. LmsUserEnded)
E.&&. E.not_ (validQualification nowaday quser) E.&&. E.not_ (validQualification nowaday quser)
pure (luser E.^. LmsUserId) pure (luser E.^. LmsUserId)
nrExpired <- E.updateCount $ \luser -> do nrExpired <- E.updateCount $ \luser -> do
E.set luser [LmsUserStatus E.=. E.justVal (LmsExpired nowaday)] E.set luser [LmsUserStatus E.=. E.justVal (LmsExpired nowaday)]
E.where_ $ (luser E.^. LmsUserId) `E.in_` E.valList (E.unValue <$> expiredLearners) 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 $logInfoS "LMS" $ "Expired lms users " <> tshow nrExpired <> " for qualification " <> qshort
notifyInvalidDrivers <- E.select $ do notifyInvalidDrivers <- E.select $ do
quser <- E.from $ E.table @QualificationUser quser <- E.from $ E.table @QualificationUser
E.where_ $ E.not_ (validQualification nowaday quser) E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue) E.&&. E.not_ (validQualification nowaday quser)
E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue)
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil) E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
) E.||. ( ) 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")) E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
)) ))
pure (quser E.^. QualificationUserUser) pure (quser E.^. QualificationUserUser)