From a97c3a5c9d3cb9dddf90f561712f0845400893bd Mon Sep 17 00:00:00 2001
From: Steffen <s.jost@fraport.de>
Date: Mon, 8 Jul 2024 14:21:25 +0200
Subject: [PATCH] fix(lms): send second reminder indepentently from renewal
 period

---
 src/Jobs/Handler/LMS.hs | 61 ++++++++++++++++++++---------------------
 1 file changed, 30 insertions(+), 31 deletions(-)

diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs
index 895b4b448..060e553d8 100644
--- a/src/Jobs/Handler/LMS.hs
+++ b/src/Jobs/Handler/LMS.hs
@@ -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