452 lines
21 KiB
Haskell
452 lines
21 KiB
Haskell
{-# 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.Time.Zones
|
|
import Data.Time.Clock.POSIX
|
|
|
|
import Handler.Utils.DateTime
|
|
|
|
import Control.Monad.Writer.Class (MonadWriter(..))
|
|
|
|
import qualified Data.Conduit.List as C
|
|
|
|
import qualified Database.Esqueleto as E
|
|
|
|
|
|
determineCrontab :: DB (Crontab JobCtl)
|
|
-- ^ Extract all future jobs from the database (sheet deadlines, ...)
|
|
determineCrontab = execWriterT $ do
|
|
UniWorX{ appSettings' = AppSettings{..} } <- getYesod
|
|
|
|
case appJobFlushInterval of
|
|
Just interval -> tell $ HashMap.singleton
|
|
JobCtlFlush
|
|
Cron
|
|
{ cronInitial = CronAsap
|
|
, cronRepeat = CronRepeatScheduled CronAsap
|
|
, cronRateLimit = interval
|
|
, cronNotAfter = Right CronNotScheduled
|
|
}
|
|
Nothing -> return ()
|
|
|
|
whenIsJust appJobCronInterval $ \interval ->
|
|
tell $ HashMap.singleton
|
|
JobCtlDetermineCrontab
|
|
Cron
|
|
{ cronInitial = CronAsap
|
|
, cronRepeat = CronRepeatScheduled CronAsap
|
|
, cronRateLimit = interval
|
|
, cronNotAfter = Right CronNotScheduled
|
|
}
|
|
|
|
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
|
|
}
|
|
|
|
|
|
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
|
|
}
|
|
|
|
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 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 = 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 = Left syncWithin
|
|
}
|
|
| 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 = Left within
|
|
}
|
|
|
|
let
|
|
sheetJobs (Entity nSheet Sheet{..}) = do
|
|
for_ (max <$> sheetVisibleFrom <*> sheetActiveFrom) $ \aFrom ->
|
|
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 -> maybeT (return ()) $ 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 -> maybeT (return ()) $ 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
|
|
}
|
|
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
|
|
|
|
let
|
|
correctorNotifications :: Map (UserId, SheetId) (Max UTCTime) -> WriterT (Crontab JobCtl) DB ()
|
|
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
|
|
examJobs (Entity nExam Exam{..}) = 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
|
|
}
|
|
|
|
case examClosed of
|
|
Just close -> do
|
|
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 ()
|
|
|
|
runConduit $ transPipe lift (selectSource [] []) .| 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
|
|
}
|