chore(lms): add removal of closed lms users after audit duration expiry

src/Handler/Utils/DateTime.hs

@@ -12,7 +12,7 @@ module Handler.Utils.DateTime
   , getTimeLocale, getDateTimeFormat
   , getDateTimeFormatter
   , validDateTimeFormats, dateTimeFormatOptions
-  , addLocalDays, addDiffDays
+  , addLocalDays, addDiffDays, addMonths
   , addOneWeek, addWeeks
   , fromMonths
   , weeksToAdd
@@ -263,6 +263,8 @@ fromMonths m = scaleCalendarDiffDays (toInteger m) calendarMonth
 addDiffDays :: CalendarDiffDays -> UTCTime -> UTCTime
 addDiffDays = over _utctDay . addGregorianDurationClip
 
+addMonths :: Word -> UTCTime -> UTCTime
+addMonths = addDiffDays . fromMonths
 
 weeksToAdd :: UTCTime -> UTCTime -> Integer
 -- ^ Number of weeks needed to add so that first

src/Jobs/Handler/LMS.hs

@@ -18,7 +18,7 @@ import qualified Database.Esqueleto.Experimental as E
 -- import qualified Database.Esqueleto.PostgreSQL as E -- for insertSelect variant
 import qualified Database.Esqueleto.Utils as E
 
-import Handler.Utils.DateTime (fromMonths)
+import Handler.Utils.DateTime (fromMonths, addMonths)
 import Handler.Utils.LMS (randomLMSIdent, randomLMSpw, maxLmsUserIdentRetries)
 
 
@@ -45,11 +45,12 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
     act = do
       $logInfoS "lms" $ "Start e-learning users for qualification " <> tshow qid <> "."        
       quali <- getJust qid -- may throw an error, aborting the job
+      now <- liftIO getCurrentTime      
       case qualificationRefreshWithin quali of 
         Nothing -> return () -- no automatic scheduling for this qid 
         (Just renewalPeriod) -> do
-          nowaday <- utctDay <$> liftIO getCurrentTime
-          let renewalDate = addGregorianDurationClip renewalPeriod nowaday
+          let nowaday     = utctDay now
+              renewalDate = addGregorianDurationClip renewalPeriod nowaday
           renewalUsers <- E.select $ do
             quser <- E.from $ E.table @QualificationUser 
             E.where_ $  quser E.^. QualificationUserQualification E.==. E.val qid 
@@ -71,7 +72,11 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
                               NotificationQualificationExpiry { nQualification = qid, nExpiry = uex }
                          }
           forM_ renewalUsers (queueDBJob . usr_job)
-
+      case qualificationAuditDuration quali of 
+        Nothing -> return () -- no automatic removal
+        (Just auditDuration) -> 
+          let deleteDate = addMonths auditDuration now
+          in  deleteWhere [LmsUserQualification ==. qid, LmsUserEnded !=. Nothing, LmsUserEnded >. Just deleteDate]
 
 dispatchJobLmsEnqueueUser :: QualificationId -> UserId -> JobHandler UniWorX
 dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act