fraport/fradrive
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

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

@ -62,38 +62,37 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
let qshort = CI.original $ qualificationShorthand quali
$logInfoS "LMS" $ "Notifying about expiring qualification " <> qshort
now <- liftIO getCurrentTime
case qualificationRefreshWithin quali of
Nothing -> return () -- TODO: no renewal period, no reminders currently
(Just renewalPeriod) -> do
let nowaday = utctDay now
renewalDate = addGregorianDurationClip renewalPeriod nowaday
sendReminders remindPeriod = do
let remindDate = addGregorianDurationClip remindPeriod nowaday
reminders <- E.select $ do -- TODO: refactor to remove some redundancies with later query
(luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser
`E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification
E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
)
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
E.&&. quser E.^. QualificationUserScheduleRenewal
E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val remindDate
E.&&. validQualification now quser
E.&&. E.isNothing (luser E.^. LmsUserEnded)
E.&&. E.isNothing (luser E.^. LmsUserStatus)
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
return (luser, quser E.^. QualificationUserValidUntil)
forM_ reminders $ \case
(Entity _ LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}, E.Value quValidUntil)
| addGregorianDurationClip remindPeriod (utctDay lnotified) < quValidUntil ->
queueDBJob JobUserNotification
{ jRecipient = luser
, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True }
}
_ -> return ()
-- send second reminders first, before enqueing even more
ifNothingM (qualificationRefreshReminder quali) () sendReminders
let nowaday = utctDay now
-- send second reminders first, before enqueing even more, but only for users with currently open LMS and still valid Qualificiations
ifNothingM (qualificationRefreshReminder quali) () $ \remindPeriod -> do
let remindDate = addGregorianDurationClip remindPeriod nowaday
reminders <- E.select $ do
(luser :& quser) <- E.from $ E.table @LmsUser `E.innerJoin` E.table @QualificationUser
`E.on` (\(luser :& quser) -> luser E.^. LmsUserQualification E.==. quser E.^. QualificationUserQualification
E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
)
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
E.&&. quser E.^. QualificationUserScheduleRenewal
E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val remindDate
E.&&. validQualification now quser
E.&&. E.isNothing (luser E.^. LmsUserEnded)
E.&&. E.isNothing (luser E.^. LmsUserStatus)
E.&&. E.isJust (luser E.^. LmsUserNotified)
-- 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)
forM_ reminders $ \case
(Entity _ LmsUser{lmsUserUser=luser, lmsUserNotified=Just lnotified}, E.Value quValidUntil)
| addGregorianDurationClip remindPeriod (utctDay lnotified) < quValidUntil ->
queueDBJob JobUserNotification
{ jRecipient = luser
, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = True }
}
_ -> return ()
case qualificationRefreshWithin quali of
Nothing -> return () -- no renewal period, no
(Just renewalPeriod) -> do
let renewalDate = addGregorianDurationClip renewalPeriod nowaday
renewalUsers <- E.select $ do
quser <- E.from $ E.table @QualificationUser
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid