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

chore(lms): add dequeueing to crontab and change setting to hour

Browse Source
This commit is contained in:
Steffen Jost 2022-04-26 16:09:59 +02:00
parent 3ef4587bcc
commit 5a23df606c
6 changed files with 30 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
config/settings.yml
View File

@ -68,7 +68,8 @@ synchronise-ldap-users-interval: "_env:SYNCHRONISE_LDAP_INTERVAL:3600"
study-features-recache-relevance-within: 172800
study-features-recache-relevance-interval: 293
qualification-check: 3
# Enqueue at specified hour, dequeue 30min later
qualification-check-hour: 3
log-settings:
detailed: "_env:DETAILED_LOGGING:false"

2
models/lms.model
View File

@ -5,7 +5,7 @@ Qualification
name (CI Text)
description StoredMarkup Maybe -- user-defined large Html, ought to contain full description
validDuration Word Maybe -- qualification is valid indefinitely or for a specified time period
auditDuration Word Maybe -- number of month to keep audit log
auditDuration Word Maybe -- number of month to keep audit log; or indefinitely
refreshWithin CalendarDiffDays Maybe -- notify users about renewal within this number of month/days before expiry
elearningStart Bool -- automatically schedule e-refresher
-- elearningOnly Bool -- successful E-learing automatically increases validity. NO!

22
src/Jobs/Crontab.hs
View File

@ -361,18 +361,30 @@ determineCrontab = execWriterT $ do
, cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appStudyFeaturesRecacheRelevanceInterval nextIntervalTime
}
whenIsJust appQualificationCheck $ \_ -> tell $ HashMap.singleton
(JobCtlQueue JobLmsQualifications)
whenIsJust appQualificationCheckHour $ \hour -> tell $ HashMap.singleton
(JobCtlQueue JobLmsQualificationsEnqueue)
Cron
{ cronInitial = CronAsap -- time after scheduling
, cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronHour = cronMatchOne 3 -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] )
, cronMinute = cronMatchOne 1
, cronSecond = cronMatchOne 0
, cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronHour = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] )
, cronMinute = cronMatchOne 3
, cronSecond = cronMatchOne 2
}
, cronRateLimit = nominalDay / 2 -- minimal time between two executions, before the second job is skipped
, cronNotAfter = Left nominalDay -- maximal delay of an execution, before it is skipped entirely
}
whenIsJust appQualificationCheckHour $ \hour -> tell $ HashMap.singleton
(JobCtlQueue JobLmsQualificationsDequeue)
Cron
{ cronInitial = CronAsap -- time after scheduling
, cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronHour = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] )
, cronMinute = cronMatchOne 33
, cronSecond = cronMatchOne 2
}
, cronRateLimit = nominalDay / 2 -- minimal time between two executions, before the second job is skipped
, cronNotAfter = Left nominalDay -- maximal delay of an execution, before it is skipped entirely
}
let
correctorNotifications :: Map (UserId, SheetId) (Max UTCTime) -> WriterT (Crontab JobCtl) (ReaderT SqlReadBackend (HandlerFor UniWorX)) ()
correctorNotifications = (tell .) . Map.foldMapWithKey $ \(nUser, nSheet) (Max time) -> HashMap.singleton

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

@ -1,8 +1,8 @@
{-# LANGUAGE TypeApplications #-}
module Jobs.Handler.LMS
( dispatchJobLmsQualifications
, dispatchJobQualificationsDequeue
( dispatchJobLmsQualificationsEnqueue
, dispatchJobLmsQualificationsDequeue
, dispatchJobLmsEnqueue, dispatchJobLmsEnqueueUser
, dispatchJobLmsDequeue
, dispatchJobLmsResults
@ -22,8 +22,8 @@ import Handler.Utils.DateTime (fromMonths, addMonths)
import Handler.Utils.LMS (randomLMSIdent, randomLMSpw, maxLmsUserIdentRetries)
dispatchJobLmsQualifications :: JobHandler UniWorX
dispatchJobLmsQualifications = JobHandlerAtomic act
dispatchJobLmsQualificationsEnqueue :: JobHandler UniWorX
dispatchJobLmsQualificationsEnqueue = JobHandlerAtomic act
where
act :: YesodJobDB UniWorX ()
act = do
@ -105,8 +105,8 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
}
dispatchJobQualificationsDequeue :: JobHandler UniWorX
dispatchJobQualificationsDequeue = JobHandlerAtomic act
dispatchJobLmsQualificationsDequeue :: JobHandler UniWorX
dispatchJobLmsQualificationsDequeue = JobHandlerAtomic act
where
act :: YesodJobDB UniWorX ()
act = do

3
src/Jobs/Types.hs
View File

@ -105,9 +105,10 @@ data Job
, jEpoch
, jIteration :: Natural
}
| JobLmsQualifications
| JobLmsQualificationsEnqueue
| JobLmsEnqueue { jQualification :: QualificationId }
| JobLmsEnqueueUser { jQualification :: QualificationId, jUser :: UserId }
| JobLmsQualificationsDequeue
| JobLmsDequeue { jQualification :: QualificationId }
| JobLmsUserlist { jQualification :: QualificationId }
| JobLmsResults { jQualification :: QualificationId }

4
src/Settings.hs
View File

@ -219,7 +219,7 @@ data AppSettings = AppSettings
, appStudyFeaturesRecacheRelevanceWithin :: Maybe NominalDiffTime
, appStudyFeaturesRecacheRelevanceInterval :: NominalDiffTime
, appQualificationCheck :: Maybe NominalDiffTime
, appQualificationCheckHour :: Maybe Natural
, appFileSourceARCConf :: Maybe (ARCConf Int)
, appFileSourcePrewarmConf :: Maybe PrewarmCacheConf
@ -683,7 +683,7 @@ instance FromJSON AppSettings where
appStudyFeaturesRecacheRelevanceWithin <- o .:? "study-features-recache-relevance-within"
appStudyFeaturesRecacheRelevanceInterval <- o .: "study-features-recache-relevance-interval"
appQualificationCheck <- o .:? "qualification-check"
appQualificationCheckHour <- o .:? "qualification-check-hour"
appFileSourceARCConf <- assertM isValidARCConf <$> o .:? "file-source-arc"