-- SPDX-FileCopyrightText: 2022-2023 Sarah Vaupel , David Mosbach , Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later {-# OPTIONS_GHC -fno-warn-incomplete-record-updates #-} module Jobs.Crontab ( determineCrontab ) where import Import import qualified Data.HashMap.Strict as HashMap import Jobs.Types import qualified Data.Set as Set import qualified Data.Map as Map import Data.Ratio ((%)) import Data.Time.Zones import Data.Time.Clock.POSIX import Handler.Utils.DateTime import qualified Data.Conduit.List as C import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E import Jobs.Handler.Intervals.Utils import System.IO.Unsafe import Crypto.Hash (hashDigestSize, digestFromByteString) import Data.List (iterate) {-# NOINLINE prewarmCacheIntervalsCache #-} prewarmCacheIntervalsCache :: TVar (Map Natural [(Maybe FileContentChunkReference, Maybe FileContentChunkReference)]) prewarmCacheIntervalsCache = unsafePerformIO $ newTVarIO Map.empty determineCrontab :: ReaderT SqlReadBackend (HandlerFor UniWorX) (Crontab JobCtl) -- ^ Extract all future jobs from the database (sheet deadlines, ...) determineCrontab = execWriterT $ do UniWorX{ appSettings' = AppSettings{..} } <- getYesod whenIsJust appJobCronInterval $ \interval -> tell $ HashMap.singleton JobCtlDetermineCrontab Cron { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = interval , cronNotAfter = Right CronNotScheduled } tell . flip foldMap universeF $ \kind -> case appHealthCheckInterval kind of Just int -> HashMap.singleton (JobCtlGenerateHealthReport kind) Cron { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = int , cronNotAfter = Right CronNotScheduled } Nothing -> mempty let tellPrewarmJobs :: JobCtlPrewarmSource -> UTCTime -> WriterT (Crontab JobCtl) (ReaderT SqlReadBackend (HandlerFor UniWorX)) () tellPrewarmJobs jcPrewarmSource jcTargetTime = maybeT_ $ do PrewarmCacheConf{..} <- hoistMaybe appFileSourcePrewarmConf let chunkHashBytes :: forall h. ( Unwrapped FileContentChunkReference ~ Digest h ) => Integer chunkHashBytes = fromIntegral (hashDigestSize (error "hashDigestSize inspected argument" :: h)) intervals <- mkIntervalsCached prewarmCacheIntervalsCache chunkHashBytes (fmap (review _Wrapped) . digestFromByteString) precSteps let step = realToFrac $ toRational (precStart - precEnd) / toRational precSteps step' = realToFrac $ toRational step / precMaxSpeedup mapM_ tell [ HashMap.singleton JobCtlPrewarmCache{..} Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ ts , cronRepeat = CronRepeatOnChange , cronRateLimit = step' , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ ts' } | jcChunkInterval <- intervals | ts <- iterate (addUTCTime step) $ addUTCTime (-precStart) jcTargetTime | ts' <- iterate (addUTCTime step') $ addUTCTime (subtract precStart . realToFrac $ toRational (precStart - precEnd) * (1 - recip precMaxSpeedup)) jcTargetTime ] lift . maybeT_ $ do injectInterval <- fmap abs . MaybeT . getsYesod $ view _appInjectFiles tell $ HashMap.singleton JobCtlInhibitInject{..} Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime (negate $ precStart + injectInterval + 10) jcTargetTime , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = injectInterval / 2 , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime (precInhibit - precStart) jcTargetTime } let sheetJobs (Entity nSheet Sheet{..}) = do for_ (max <$> sheetVisibleFrom <*> sheetActiveFrom) $ \aFrom -> do tellPrewarmJobs (JobCtlPrewarmSheetFile nSheet SheetExercise) aFrom when (isn't _JobsOffload appJobMode) $ do tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationSheetActive{..}) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ aFrom , cronRepeat = CronRepeatNever , cronRateLimit = appNotificationRateLimit , cronNotAfter = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) sheetActiveTo } for_ (max <$> sheetVisibleFrom <*> sheetHintFrom) $ \hFrom -> do tellPrewarmJobs (JobCtlPrewarmSheetFile nSheet SheetHint) hFrom when (isn't _JobsOffload appJobMode) . maybeT_ $ do guard $ maybe True (\aFrom -> abs (diffUTCTime aFrom hFrom) > 300) sheetActiveFrom guardM $ or2M (return $ maybe True (\sFrom -> abs (diffUTCTime sFrom hFrom) > 300) sheetSolutionFrom) (fmap not . lift . lift $ exists [SheetFileType ==. SheetSolution, SheetFileSheet ==. nSheet]) guardM . lift . lift $ exists [SheetFileType ==. SheetHint, SheetFileSheet ==. nSheet] tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationSheetHint{..}) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ hFrom , cronRepeat = CronRepeatNever , cronRateLimit = appNotificationRateLimit , cronNotAfter = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) sheetActiveTo } for_ (max <$> sheetVisibleFrom <*> sheetSolutionFrom) $ \sFrom -> do tellPrewarmJobs (JobCtlPrewarmSheetFile nSheet SheetSolution) sFrom when (isn't _JobsOffload appJobMode) . maybeT_ $ do guard $ maybe True (\aFrom -> abs (diffUTCTime aFrom sFrom) > 300) sheetActiveFrom guardM . lift . lift $ exists [SheetFileType ==. SheetSolution, SheetFileSheet ==. nSheet] tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationSheetSolution{..}) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sFrom , cronRepeat = CronRepeatNever , cronRateLimit = appNotificationRateLimit , cronNotAfter = Left nominalDay } when (isn't _JobsOffload appJobMode) $ do for_ sheetActiveTo $ \aTo -> do whenIsJust (max aTo <$> sheetVisibleFrom) $ \aTo' -> do tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..}) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . maybe id max sheetActiveFrom $ addUTCTime (-nominalDay) aTo' , cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour , cronRateLimit = appNotificationRateLimit , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ aTo } tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..}) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ aTo , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit , cronNotAfter = Left appNotificationExpiration } when sheetAutoDistribute $ tell $ HashMap.singleton (JobCtlQueue $ JobDistributeCorrections nSheet) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ aTo , cronRepeat = CronRepeatNever , cronRateLimit = 3600 -- Irrelevant due to `cronRepeat` , cronNotAfter = Left nominalDay } runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs when (isn't _JobsOffload appJobMode) $ do case appJobFlushInterval of Just interval | maybe True (> 0) appJobMaxFlush -> tell $ HashMap.singleton JobCtlFlush Cron { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = interval , cronNotAfter = Right CronNotScheduled } _other -> return () oldestInvitationMUTC <- lift $ preview (_head . _entityVal . _invitationExpiresAt . _Just) <$> selectList [InvitationExpiresAt !=. Nothing] [Asc InvitationExpiresAt, LimitTo 1] whenIsJust oldestInvitationMUTC $ \oldestInvUTC -> tell $ HashMap.singleton (JobCtlQueue JobPruneInvitations) Cron { cronInitial = CronTimestamp $ utcToLocalTime oldestInvUTC , cronRepeat = CronRepeatOnChange , cronRateLimit = nominalDay , cronNotAfter = Right CronNotScheduled } oldestSessionFile <- lift $ preview (_head . _entityVal . _sessionFileTouched) <$> selectList [] [Asc SessionFileTouched, LimitTo 1] whenIsJust oldestSessionFile $ \oldest -> tell $ HashMap.singleton (JobCtlQueue JobPruneSessionFiles) Cron { cronInitial = CronTimestamp . utcToLocalTime $ addUTCTime appSessionFilesExpire oldest , cronRepeat = CronRepeatOnChange , cronRateLimit = appSessionFilesExpire / 2 , cronNotAfter = Right CronNotScheduled } oldestFallbackPersonalisedSheetFilesKey <- lift $ preview (_head . _entityVal . _fallbackPersonalisedSheetFilesKeyGenerated) <$> selectList [] [Asc FallbackPersonalisedSheetFilesKeyGenerated, LimitTo 1] whenIsJust oldestFallbackPersonalisedSheetFilesKey $ \oldest -> tell $ HashMap.singleton (JobCtlQueue JobPruneFallbackPersonalisedSheetFilesKeys) Cron { cronInitial = CronTimestamp . utcToLocalTime $ addUTCTime appFallbackPersonalisedSheetFilesKeysExpire oldest , cronRepeat = CronRepeatOnChange , cronRateLimit = appFallbackPersonalisedSheetFilesKeysExpire / 2 , cronNotAfter = Right CronNotScheduled } oldestSentMail <- lift $ preview (_head . _entityVal . _sentMailSentAt) <$> selectList [] [Asc SentMailSentAt, LimitTo 1] whenIsJust ((,) <$> appMailRetainSent <*> oldestSentMail) $ \(retain, oldest) -> tell $ HashMap.singleton (JobCtlQueue JobPruneOldSentMails) Cron { cronInitial = CronTimestamp . utcToLocalTime $ addUTCTime retain oldest , cronRepeat = CronRepeatOnChange , cronRateLimit = retain / 2 , cronNotAfter = Right CronNotScheduled } whenIsJust (appInjectFiles <* appUploadCacheConf) $ \iInterval -> tell $ HashMap.singleton (JobCtlQueue JobInjectFiles) Cron { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = iInterval , cronNotAfter = Right CronNotScheduled } whenIsJust appRechunkFiles $ \rInterval -> tell $ HashMap.singleton (JobCtlQueue JobRechunkFiles) Cron { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = rInterval , cronNotAfter = Right CronNotScheduled } whenIsJust appCheckMissingFiles $ \rInterval -> tell $ HashMap.singleton (JobCtlQueue JobDetectMissingFiles) Cron { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = rInterval , cronNotAfter = Right CronNotScheduled } let newyear = cronCalendarAny { cronDayOfYear = cronMatchOne 1 } in tell $ HashMap.singleton (JobCtlQueue JobTruncateTransactionLog) Cron { cronInitial = newyear , cronRepeat = CronRepeatScheduled newyear , cronRateLimit = minNominalYear , cronNotAfter = Right CronNotScheduled } oldestLogEntry <- fmap listToMaybe . lift . E.select . E.from $ \transactionLog -> do E.where_ . E.not_ . E.isNothing $ transactionLog E.^. TransactionLogRemote E.orderBy [E.asc $ transactionLog E.^. TransactionLogTime] E.limit 1 return $ transactionLog E.^. TransactionLogTime for_ oldestLogEntry $ \(E.Value oldestEntry) -> tell $ HashMap.singleton (JobCtlQueue JobDeleteTransactionLogIPs) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appTransactionLogIPRetentionTime oldestEntry , cronRepeat = CronRepeatOnChange , cronRateLimit = nominalDay , cronNotAfter = Right CronNotScheduled } let getNextIntervals within interval cInterval = do now <- liftIO getPOSIXTime return $ do let epochInterval = within / 2 (currEpoch, epochNow) = now `divMod'` epochInterval currInterval = epochNow `div'` interval numIntervals = max 1 . floor $ epochInterval / interval n = ceiling $ 4 * cInterval / interval i <- [ negate (ceiling $ n % 2) .. ceiling $ n % 2 ] let ((+ currEpoch) -> nextEpoch, nextInterval) = (currInterval + i) `divMod` numIntervals nextIntervalTime = posixSecondsToUTCTime $ fromInteger nextEpoch * epochInterval + fromInteger nextInterval * interval return (nextEpoch, nextInterval, nextIntervalTime, numIntervals) if | is _Just appLdapConf , Just syncWithin <- appSynchroniseLdapUsersWithin , Just cInterval <- appJobCronInterval -> do nextIntervals <- getNextIntervals syncWithin appSynchroniseLdapUsersInterval cInterval forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do tell $ HashMap.singleton (JobCtlQueue JobSynchroniseLdap { jEpoch = fromInteger nextEpoch , jNumIterations = fromInteger numIntervals , jIteration = fromInteger nextInterval }) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ $ toTimeOfDay 23 30 0 $ utctDay nextIntervalTime , cronRepeat = CronRepeatNever , cronRateLimit = appSynchroniseLdapUsersInterval , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appSynchroniseLdapUsersInterval nextIntervalTime } | otherwise -> return () if | is _Just appAvsConf , Just syncWithin <- appSynchroniseAvsUsersWithin , Just cInterval <- appJobCronInterval -> do now <- liftIO getCurrentTime let nowaday = utctDay now nextIntervals <- getNextIntervals syncWithin appSynchroniseAvsUsersInterval cInterval forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do tell $ HashMap.singleton (JobCtlQueue JobSynchroniseAvs { jEpoch = fromInteger nextEpoch , jNumIterations = fromInteger numIntervals , jIteration = fromInteger nextInterval , jSynchAfter = Just $ addDays (-7) nowaday -- at most once per week }) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ $ toTimeOfDay 22 0 0 $ utctDay nextIntervalTime , cronRepeat = CronRepeatNever , cronRateLimit = appSynchroniseAvsUsersInterval , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appSynchroniseAvsUsersInterval nextIntervalTime } | otherwise -> return () whenIsJust ((,) <$> appPruneUnreferencedFilesWithin <*> appJobCronInterval) $ \(within, cInterval) -> do nextIntervals <- getNextIntervals within appPruneUnreferencedFilesInterval cInterval forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do tell $ HashMap.singleton (JobCtlQueue JobPruneUnreferencedFiles { jEpoch = fromInteger nextEpoch , jNumIterations = fromInteger numIntervals , jIteration = fromInteger nextInterval } ) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ $ toTimeOfDay 22 0 0 $ utctDay nextIntervalTime , cronRepeat = CronRepeatNever , cronRateLimit = appPruneUnreferencedFilesInterval , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appPruneUnreferencedFilesInterval nextIntervalTime } -- whenIsJust ((,) <$> appStudyFeaturesRecacheRelevanceWithin <*> appJobCronInterval) $ \(within, cInterval) -> do -- nextIntervals <- getNextIntervals within appStudyFeaturesRecacheRelevanceInterval cInterval -- forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime, numIntervals) -> do -- tell $ HashMap.singleton -- (JobCtlQueue JobStudyFeaturesRecacheRelevance -- { jEpoch = fromInteger nextEpoch -- , jNumIterations = fromInteger numIntervals -- , jIteration = fromInteger nextInterval -- } -- ) -- Cron -- { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ toTimeOfDay 22 0 0 $ utctDay nextIntervalTime -- , cronRepeat = CronRepeatNever -- , cronRateLimit = appStudyFeaturesRecacheRelevanceInterval -- , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appStudyFeaturesRecacheRelevanceInterval nextIntervalTime -- } whenIsJust appJobLmsQualificationsEnqueueHour $ \hour -> tell $ HashMap.singleton (JobCtlQueue JobLmsQualificationsEnqueue) Cron { cronInitial = CronAsap -- time after scheduling , cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronDayOfWeek = CronMatchSome . impureNonNull . Set.fromList $ [1..5] , cronHour = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] ) , cronMinute = cronMatchOne 2 , cronSecond = cronMatchOne 27 } , cronRateLimit = 600 -- minimal time between two executions, before the second job is skipped , cronNotAfter = Right CronNotScheduled -- maximal delay of an execution, before it is skipped entirely } whenIsJust appJobLmsQualificationsDequeueHour $ \hour -> tell $ HashMap.singleton (JobCtlQueue JobLmsQualificationsDequeue) Cron { cronInitial = CronAsap -- time after scheduling , cronRepeat = CronRepeatScheduled $ cronCalendarAny { cronDayOfWeek = CronMatchSome . impureNonNull . Set.fromList $ [1..5] , cronHour = cronMatchOne hour -- cronHour = CronMatchSome (impureNonNull $ Set.fromList [3,15] ) , cronMinute = cronMatchOne 7 , cronSecond = cronMatchOne 27 } , cronRateLimit = 600 -- minimal time between two executions, before the second job is skipped , cronNotAfter = Right CronNotScheduled -- 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 (JobCtlQueue $ JobQueueNotification NotificationCorrectionsAssigned { nUser, nSheet } ) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay time , cronRepeat = CronRepeatNever , cronRateLimit = appNotificationRateLimit , cronNotAfter = Left appNotificationExpiration } submissionsByCorrector :: Entity Submission -> Map (UserId, SheetId) (Max UTCTime) submissionsByCorrector (Entity _ sub) | Just ratingBy <- submissionRatingBy sub , Just assigned <- submissionRatingAssigned sub , not $ submissionRatingDone sub = Map.singleton (ratingBy, submissionSheet sub) $ Max assigned | otherwise = Map.empty collateSubmissionsByCorrector acc entity = Map.unionWith (<>) acc $ submissionsByCorrector entity correctorNotifications <=< runConduit $ transPipe lift ( selectSource [ SubmissionRatingBy !=. Nothing, SubmissionRatingAssigned !=. Nothing ] [] ) .| C.fold collateSubmissionsByCorrector Map.empty let submissionsSelect = E.selectSource . E.from $ \(submission `E.InnerJoin` sheet) -> do E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId E.where_ $ sqlSubmissionRatingDone submission E.&&. submission E.^. SubmissionRatingTime E.>=. E.justVal (toMidnight $ fromGregorian 2024 1 1) -- no submissions used in FRADrive as of this date, previously cut off by an old legacy migration return (submission, sheet E.^. SheetType) submissionJobs (Entity subId Submission{..}, E.Value sType) = maybeT_ $ do examFinishedTime <- hoist lift . for (sType ^? _examPart . from _SqlKey) $ \epId -> do ExamPart{examPartExam} <- MaybeT . $cachedHereBinary epId $ get epId Exam{..} <- MaybeT . $cachedHereBinary examPartExam $ get examPartExam return examFinished notifyTime <- hoistMaybe . nBot $ maybe NTop (max `on` NTop) examFinishedTime submissionRatingTime tell $ HashMap.singleton (JobCtlQueue . JobQueueNotification $ NotificationSubmissionRated subId) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ notifyTime , cronRepeat = CronRepeatNever , cronRateLimit = appNotificationRateLimit , cronNotAfter = Left appNotificationExpiration } runConduit $ transPipe lift submissionsSelect .| C.mapM_ submissionJobs let examSelect = E.selectSource . E.from $ \(exam `E.InnerJoin` course `E.InnerJoin` school) -> do E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse return (exam, course, school) examJobs (Entity nExam Exam{..}, _, Entity _ School{..}) = do newestResult <- lift . E.select . E.from $ \examResult -> do E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam return . E.max_ $ examResult E.^. ExamResultLastChanged whenIsJust examVisibleFrom $ \visibleFrom -> do case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of [E.Value (NTop (Just ts))] -> tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationExamResult{..}) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom ts , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationExpiration $ max visibleFrom ts } _other -> return () whenIsJust examRegisterFrom $ \registerFrom -> tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationActive{..}) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom registerFrom , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit , cronNotAfter = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) examRegisterTo } whenIsJust ((,) <$> examRegisterFrom <*> examRegisterTo) $ \(registerFrom, registerTo) -> tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationSoonInactive{..}) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) registerTo , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ registerTo } whenIsJust ((,) <$> examRegisterFrom <*> examDeregisterUntil) $ \(registerFrom, deregisterUntil) -> tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationExamDeregistrationSoonInactive{..}) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) deregisterUntil , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ deregisterUntil } let closeTime = case (examClosed, examFinished) of (mClose, Just finish) | isn't _ExamCloseSeparate schoolExamCloseMode -> Just $ maybe id min mClose finish (Just close, _) | is _ExamCloseSeparate schoolExamCloseMode -> Just close _other -> Nothing case closeTime of Just close -> do -- If an exam that was previously under `ExamCloseSeparate` rules transitions to `ExamCloseOnFinish`, it might suddenly have been closed an arbitrary time ago -- If `cronNotAfter` was only `appNotificationExpiration` in that case, no notification might ever be sent -- That's probably fine. changedResults <- lift . E.select . E.from $ \examResult -> do E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam E.&&. examResult E.^. ExamResultLastChanged E.>. E.val close return $ examResult E.^. ExamResultId case newestResult of [E.Value (Just lastChange)] | not $ null changedResults -> tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationExamOfficeExamResultsChanged{ nExamResults = Set.fromList $ map E.unValue changedResults }) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay lastChange , cronRepeat = CronRepeatNever , cronRateLimit = appNotificationRateLimit , cronNotAfter = Left appNotificationExpiration } _other -> return () tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationExamOfficeExamResults{..}) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ close , cronRepeat = CronRepeatNever , cronRateLimit = appNotificationRateLimit , cronNotAfter = Left appNotificationExpiration } Nothing -> return () in runConduit $ transPipe lift examSelect .| C.mapM_ examJobs let externalExamJobs nExternalExam = do newestResult <- lift . E.select . E.from $ \externalExamResult -> do E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val nExternalExam return . E.max_ $ externalExamResult E.^. ExternalExamResultLastChanged case newestResult of [E.Value (Just lastChange)] -> tell $ HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationExamOfficeExternalExamResults{..}) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay lastChange , cronRepeat = CronRepeatOnChange , cronRateLimit = nominalDay , cronNotAfter = Left appNotificationExpiration } _other -> return () runConduit $ transPipe lift (selectKeys [] []) .| C.mapM_ externalExamJobs hasRelevanceUncached <- lift $ exists [StudyFeaturesRelevanceCached ==. Nothing] when hasRelevanceUncached . tell $ HashMap.singleton (JobCtlQueue JobStudyFeaturesCacheRelevance) Cron { cronInitial = CronAsap , cronRepeat = CronRepeatOnChange , cronRateLimit = nominalDay , cronNotAfter = Right CronNotScheduled } let externalApiJobs (Entity jExternalApi ExternalApi{..}) = tell $ HashMap.singleton (JobCtlQueue JobExternalApiExpire{..}) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appExternalApisExpiry externalApiLastAlive , cronRepeat = CronRepeatOnChange , cronRateLimit = appExternalApisExpiry , cronNotAfter = Right CronNotScheduled } runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ externalApiJobs