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

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

Browse Source
This commit is contained in:
Steffen Jost 2022-04-26 13:23:41 +02:00
parent 05423d4515
commit 3ef4587bcc
2 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Handler/Utils/DateTime.hs
View File

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

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

@ -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.PostgreSQL as E -- for insertSelect variant
import qualified Database.Esqueleto.Utils as E 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) import Handler.Utils.LMS (randomLMSIdent, randomLMSpw, maxLmsUserIdentRetries)
@ -45,11 +45,12 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
act = do act = do
$logInfoS "lms" $ "Start e-learning users for qualification " <> tshow qid <> "." $logInfoS "lms" $ "Start e-learning users for qualification " <> tshow qid <> "."
quali <- getJust qid -- may throw an error, aborting the job quali <- getJust qid -- may throw an error, aborting the job
now <- liftIO getCurrentTime
case qualificationRefreshWithin quali of case qualificationRefreshWithin quali of
Nothing -> return () -- no automatic scheduling for this qid Nothing -> return () -- no automatic scheduling for this qid
(Just renewalPeriod) -> do (Just renewalPeriod) -> do
nowaday <- utctDay <$> liftIO getCurrentTime let nowaday = utctDay now
let renewalDate = addGregorianDurationClip renewalPeriod nowaday 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
@ -71,7 +72,11 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
NotificationQualificationExpiry { nQualification = qid, nExpiry = uex } NotificationQualificationExpiry { nQualification = qid, nExpiry = uex }
} }
forM_ renewalUsers (queueDBJob . usr_job) 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 :: QualificationId -> UserId -> JobHandler UniWorX
dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act