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

fix(lms): send second reminder indepentently from renewal period

Browse Source
This commit is contained in:
Steffen Jost 2024-07-08 14:21:25 +02:00
parent 468af9de9d
commit a97c3a5c9d
1 changed files with 30 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -62,14 +62,11 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
let qshort = CI.original $ qualificationShorthand quali let qshort = CI.original $ qualificationShorthand quali
$logInfoS "LMS" $ "Notifying about expiring qualification " <> qshort $logInfoS "LMS" $ "Notifying about expiring qualification " <> qshort
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
case qualificationRefreshWithin quali of
Nothing -> return () -- TODO: no renewal period, no reminders currently
(Just renewalPeriod) -> do
let nowaday = utctDay now let nowaday = utctDay now
renewalDate = addGregorianDurationClip renewalPeriod nowaday -- send second reminders first, before enqueing even more, but only for users with currently open LMS and still valid Qualificiations
sendReminders remindPeriod = do ifNothingM (qualificationRefreshReminder quali) () $ \remindPeriod -> do
let remindDate = addGregorianDurationClip remindPeriod nowaday let remindDate = addGregorianDurationClip remindPeriod nowaday
reminders <- E.select $ do -- TODO: refactor to remove some redundancies with later query reminders <- E.select $ do
(luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser (luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser
`E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification `E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification
E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
@ -81,7 +78,7 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
E.&&. E.isNothing (luser E.^. LmsUserEnded) E.&&. E.isNothing (luser E.^. LmsUserEnded)
E.&&. E.isNothing (luser E.^. LmsUserStatus) E.&&. E.isNothing (luser E.^. LmsUserStatus)
E.&&. E.isJust (luser E.^. LmsUserNotified) E.&&. E.isJust (luser E.^. LmsUserNotified)
-- E.&&. ((day_ (luser E.^. LmsUserNotified) E.+. E.interval remindPeriod) E.<. quser E.^. QualificationUserValidUntil) -- not sure whether may throw runtime errors, so we check in Haskell-Land instead -- E.&&. ((day_ (luser E.^. LmsUserNotified) E.+. E.interval remindPeriod) E.<. quser E.^. QualificationUserValidUntil) -- not sure whether this may throw runtime errors, so we check in Haskell-Land instead
return (luser, quser E.^. QualificationUserValidUntil) return (luser, quser E.^. QualificationUserValidUntil)
forM_ reminders $ \case forM_ reminders $ \case
(Entity _ LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}, E.Value quValidUntil) (Entity _ LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}, E.Value quValidUntil)
@ -91,9 +88,11 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True } , jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True }
} }
_ -> return () _ -> return ()
-- send second reminders first, before enqueing even more
ifNothingM (qualificationRefreshReminder quali) () sendReminders
case qualificationRefreshWithin quali of
Nothing -> return () -- no renewal period, no
(Just renewalPeriod) -> do
let renewalDate = addGregorianDurationClip renewalPeriod nowaday
renewalUsers <- E.select $ do renewalUsers <- E.select $ do
quser <- E.from $ E.table @QualificationUser quser <- E.from $ E.table @QualificationUser
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid