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

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

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