{-# 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 nextIntervalTime
                , cronRepeat    = CronRepeatNever
                , cronRateLimit = appSynchroniseLdapUsersInterval
                , cronNotAfter  = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appSynchroniseLdapUsersInterval 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 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 nextIntervalTime
            , cronRepeat    = CronRepeatNever
            , cronRateLimit = appStudyFeaturesRecacheRelevanceInterval
            , cronNotAfter  = Right . CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appStudyFeaturesRecacheRelevanceInterval nextIntervalTime
            }

    whenIsJust appQualificationCheckHour $ \hour -> tell $ HashMap.singleton
      (JobCtlQueue JobLmsQualificationsEnqueue)
      Cron
        { cronInitial   = CronAsap  -- time after scheduling 
        , 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
        (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

    submissionRatedNotificationsSince <- lift $ getMigrationTime Migration20210318CrontabSubmissionRatedNotification 
    whenIsJust submissionRatedNotificationsSince $ \notifySince
      -> 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 notifySince
               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
                   }
          in 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


    allocations <- lift $ selectList [] []

    let
      allocationTimes :: EntityField Allocation (Maybe UTCTime) -> MergeHashMap UTCTime [Entity Allocation]
      allocationTimes aField = flip foldMap allocations $ \allocEnt -> case allocEnt ^. fieldLens aField of
        Nothing -> mempty
        Just t  -> _MergeHashMap # HashMap.singleton t (pure allocEnt)

    forM_ allocations $ \(Entity nAllocation _) -> do
      doneSince <- lift $ fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \participant -> do
        E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
        return . E.max_ $ participant E.^. CourseParticipantRegistration

      whenIsJust doneSince $ \doneSince' ->
        tell $ HashMap.singleton
          (JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..})
          Cron
            { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay doneSince'
            , cronRepeat    = CronRepeatOnChange
            , cronRateLimit = appNotificationRateLimit
            , cronNotAfter  = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationCollateDelay $ addUTCTime appNotificationExpiration doneSince'
            }

    iforM_ (allocationTimes AllocationStaffRegisterFrom) $ \staffRegisterFrom allocs ->
      tell $ HashMap.singleton
        (JobCtlQueue $ JobQueueNotification NotificationAllocationStaffRegister{ nAllocations = setOf (folded . _entityKey) allocs })
        Cron
          { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ staffRegisterFrom
          , cronRepeat    = CronRepeatOnChange
          , cronRateLimit = appNotificationRateLimit
          , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffRegisterTo . to NTop . filtered (> NTop (Just staffRegisterFrom))) allocs
          }
    iforM_ (allocationTimes AllocationRegisterFrom) $ \registerFrom allocs ->
      tell $ HashMap.singleton
        (JobCtlQueue $ JobQueueNotification NotificationAllocationRegister{ nAllocations = setOf (folded . _entityKey) allocs })
        Cron
          { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ registerFrom
          , cronRepeat    = CronRepeatOnChange
          , cronRateLimit = appNotificationRateLimit
          , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationRegisterTo . to NTop . filtered (> NTop (Just registerFrom))) allocs
          }
    -- iforM_ (allocationTimes AllocationStaffAllocationFrom) $ \staffAllocationFrom allocs ->
    --   tell $ HashMap.singleton
    --     (JobCtlQueue $ JobQueueNotification NotificationAllocationAllocation{ nAllocations = setOf (folded . _entityKey) allocs })
    --     Cron
    --       { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ staffAllocationFrom
    --       , cronRepeat    = CronRepeatOnChange
    --       , cronRateLimit = appNotificationRateLimit
    --       , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) $ nBot =<< minimumOf (folded . _entityVal . _allocationStaffAllocationTo . to NTop . filtered (> NTop (Just staffAllocationFrom))) allocs
    --       }
    iforM_ (allocationTimes AllocationRegisterTo) $ \registerTo allocs' -> do
      let allocs = flip filter allocs' $ \(Entity _ Allocation{..}) -> maybe True (> registerTo) allocationStaffAllocationTo
      tell $ HashMap.singleton
        (JobCtlQueue $ JobQueueNotification NotificationAllocationUnratedApplications{ nAllocations = setOf (folded . _entityKey) allocs })
        Cron
          { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
          , cronRepeat    = CronRepeatOnChange
          , 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 ==. 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
