diff --git a/src/Handler/Utils/ExamOffice/Exam.hs b/src/Handler/Utils/ExamOffice/Exam.hs index 586d9b7cb..e9f903471 100644 --- a/src/Handler/Utils/ExamOffice/Exam.hs +++ b/src/Handler/Utils/ExamOffice/Exam.hs @@ -42,7 +42,7 @@ examOfficeExamResultAuth authId examResult = authByUser E.||. authByField E.||. E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField E.where_ . E.maybe E.false id . E.subSelectMaybe . E.from $ \course -> do E.where_ $ course E.^. CourseId E.==. cId - return . E.just $ isCourseStudyFeatureCached course studyFeatures + return . E.just $ isCourseStudyFeature course studyFeatures E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. examResult E.^. ExamResultUser E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs index 252121b17..4f41734fc 100644 --- a/src/Handler/Utils/StudyFeatures.hs +++ b/src/Handler/Utils/StudyFeatures.hs @@ -4,9 +4,9 @@ module Handler.Utils.StudyFeatures , _userTableField, _userTableDegree, _userTableSemester, _userTableFieldType , UserTableStudyFeatures(..) , _UserTableStudyFeatures - , isRelevantStudyFeature, isRelevantStudyFeatureCached, isRelevantStudyFeatureCached' + , isRelevantStudyFeature, isRelevantStudyFeatureCached , cacheStudyFeatureRelevance - , isCourseStudyFeature, isCourseStudyFeatureCached, courseUserStudyFeatures + , isCourseStudyFeature, courseUserStudyFeatures , isExternalExamStudyFeature, externalExamUserStudyFeatures , isTermStudyFeature , isAllocationStudyFeature, allocationUserStudyFeatures @@ -114,22 +114,11 @@ isRelevantStudyFeature termField record studyFeatures E.&&. overlap studyFeatures' E.>. overlap studyFeatures isRelevantStudyFeatureCached :: PersistEntity record - => EntityField record TermId - -> E.SqlExpr (Entity record) - -> E.SqlExpr (Entity StudyFeatures) - -> E.SqlExpr (E.Value Bool) -isRelevantStudyFeatureCached termField record studyFeatures - = E.bool calcNow useCache $ studyFeatures E.^. StudyFeaturesRelevanceCached - where - useCache = isRelevantStudyFeatureCached' termField record studyFeatures - calcNow = isRelevantStudyFeature termField record studyFeatures - -isRelevantStudyFeatureCached' :: PersistEntity record => EntityField record TermId -> E.SqlExpr (Entity record) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool) -isRelevantStudyFeatureCached' termField record studyFeatures +isRelevantStudyFeatureCached termField record studyFeatures = E.exists . E.from $ \relevantStudyFeatures -> E.where_ $ relevantStudyFeatures E.^. RelevantStudyFeaturesTerm E.==. record E.^. termField E.&&. relevantStudyFeatures E.^. RelevantStudyFeaturesStudyFeatures E.==. studyFeatures E.^. StudyFeaturesId @@ -153,9 +142,6 @@ cacheStudyFeatureRelevance fFilter = do isCourseStudyFeature :: E.SqlExpr (Entity Course) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool) isCourseStudyFeature = isRelevantStudyFeatureCached CourseTerm -isCourseStudyFeatureCached :: E.SqlExpr (Entity Course) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool) -isCourseStudyFeatureCached = isRelevantStudyFeatureCached' CourseTerm - courseUserStudyFeatures :: MonadIO m => CourseId -> UserId -> SqlPersistT m UserTableStudyFeatures courseUserStudyFeatures cId uid = do feats <- E.select . E.from $ \(course `E.InnerJoin` studyFeatures `E.InnerJoin` terms `E.InnerJoin` degree) -> do diff --git a/src/Jobs.hs b/src/Jobs.hs index bb06b659c..e3ab2c09c 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -64,6 +64,7 @@ import Jobs.Handler.ChangeUserDisplayEmail import Jobs.Handler.Files import Jobs.Handler.PersonalisedSheetFiles import Jobs.Handler.PruneOldSentMails +import Jobs.Handler.StudyFeatures import Jobs.HealthReport diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index a7b87a1d3..991128ffe 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -483,3 +483,13 @@ determineCrontab = execWriterT $ do , cronRateLimit = appNotificationRateLimit , cronNotAfter = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffAllocationTo . to NTop . filtered (> NTop (Just registerTo))) allocs } + + hasRelevanceUncached <- lift $ exists [StudyFeaturesRelevanceCached !=. True] + when hasRelevanceUncached . tell $ HashMap.singleton + (JobCtlQueue JobStudyFeaturesCacheRelevance) + Cron + { cronInitial = CronAsap + , cronRepeat = CronRepeatOnChange + , cronRateLimit = nominalDay + , cronNotAfter = Right CronNotScheduled + } diff --git a/src/Jobs/Handler/StudyFeatures.hs b/src/Jobs/Handler/StudyFeatures.hs new file mode 100644 index 000000000..7a70089c2 --- /dev/null +++ b/src/Jobs/Handler/StudyFeatures.hs @@ -0,0 +1,14 @@ +module Jobs.Handler.StudyFeatures + ( dispatchJobStudyFeaturesCacheRelevance + ) where + +import Import + +import Handler.Utils.StudyFeatures + +import qualified Database.Esqueleto as E + + +dispatchJobStudyFeaturesCacheRelevance :: JobHandler UniWorX +dispatchJobStudyFeaturesCacheRelevance = JobHandlerAtomic $ + cacheStudyFeatureRelevance $ \studyFeatures -> studyFeatures E.^. StudyFeaturesRelevanceCached E.!=. E.val True diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 487c0ed6d..3e1d06671 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -97,6 +97,7 @@ data Job | JobRechunkFiles | JobDetectMissingFiles | JobPruneOldSentMails + | JobStudyFeaturesCacheRelevance deriving (Eq, Ord, Show, Read, Generic, Typeable) data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs index baad2c3ec..3bad6c163 100644 --- a/src/Model/Migration/Definitions.hs +++ b/src/Model/Migration/Definitions.hs @@ -138,6 +138,7 @@ migrateManual = do , ("file_content_entry_chunk_hash", "CREATE INDEX file_content_entry_chunk_hash ON \"file_content_entry\" (chunk_hash)" ) , ("sent_mail_bounce_secret", "CREATE INDEX sent_mail_bounce_secret ON \"sent_mail\" (bounce_secret) WHERE bounce_secret IS NOT NULL") , ("sent_mail_recipient", "CREATE INDEX sent_mail_recipient ON \"sent_mail\" (recipient) WHERE recipient IS NOT NULL") + , ("study_features_relevance_cached", "CREATE INDEX study_features_relevance_cached ON \"study_features\" (relevance_cached) WHERE (relevance_cached <> true)") ] where addIndex :: Text -> Sql -> Migration