fraport/fradrive-old
Archived
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-within: 172800
study-features-recache-relevance-interval: 293 study-features-recache-relevance-interval: 293
qualification-check: 3 # Enqueue at specified hour, dequeue 30min later
qualification-check-hour: 3
log-settings: log-settings:
detailed: "_env:DETAILED_LOGGING:false" detailed: "_env:DETAILED_LOGGING:false"

2
models/lms.model
View File

@ -5,7 +5,7 @@ Qualification
name (CI Text) name (CI Text)
description StoredMarkup Maybe -- user-defined large Html, ought to contain full description 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 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 refreshWithin CalendarDiffDays Maybe -- notify users about renewal within this number of month/days before expiry
elearningStart Bool -- automatically schedule e-refresher elearningStart Bool -- automatically schedule e-refresher
-- elearningOnly Bool -- successful E-learing automatically increases validity. NO! -- 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 , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appStudyFeaturesRecacheRelevanceInterval nextIntervalTime
} }
whenIsJust appQualificationCheck $ \_ -> tell $ HashMap.singleton whenIsJust appQualificationCheckHour $ \hour -> tell $ HashMap.singleton
(JobCtlQueue JobLmsQualifications) (JobCtlQueue JobLmsQualificationsEnqueue)
Cron Cron
{ cronInitial = CronAsap -- time after scheduling { cronInitial = CronAsap -- time after scheduling
, cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronHour = cronMatchOne 3 -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] ) , cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronHour = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] )
, cronMinute = cronMatchOne 1 , cronMinute = cronMatchOne 3
, cronSecond = cronMatchOne 0 , cronSecond = cronMatchOne 2
} }
, cronRateLimit = nominalDay / 2 -- minimal time between two executions, before the second job is skipped , 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 , 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 let
correctorNotifications :: Map (UserId, SheetId) (Max UTCTime) -> WriterT (Crontab JobCtl) (ReaderT SqlReadBackend (HandlerFor UniWorX)) () correctorNotifications :: Map (UserId, SheetId) (Max UTCTime) -> WriterT (Crontab JobCtl) (ReaderT SqlReadBackend (HandlerFor UniWorX)) ()
correctorNotifications = (tell .) . Map.foldMapWithKey $ \(nUser, nSheet) (Max time) -> HashMap.singleton correctorNotifications = (tell .) . Map.foldMapWithKey $ \(nUser, nSheet) (Max time) -> HashMap.singleton

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

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

3
src/Jobs/Types.hs
View File

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

4
src/Settings.hs
View File

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