From 3a90c88b359f3e0cb0ed03df6e81b1532509ea48 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 8 Dec 2020 18:04:39 +0100 Subject: [PATCH] fix(files): better configuration for file batch jobs --- config/settings.yml | 1 + src/Application.hs | 17 ++++++++++++----- src/Jobs/Crontab.hs | 18 ++++++++++-------- src/Settings.hs | 2 ++ 4 files changed, 25 insertions(+), 13 deletions(-) diff --git a/config/settings.yml b/config/settings.yml index 99f30309e..1e3a2a7de 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -167,6 +167,7 @@ upload-cache-bucket: "uni2work-uploads" inject-files: 601 rechunk-files: 1201 +check-missing-files: 7207 file-upload-db-chunksize: 4194304 # 4MiB file-chunking-target-exponent: 21 # 2MiB diff --git a/src/Application.hs b/src/Application.hs index 9e559e6a0..44f16add8 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -142,7 +142,7 @@ mkYesodDispatch "UniWorX" resourcesUniWorX -- the place to put your migrate statements to have automatic database -- migrations handled by Yesod. makeFoundation :: (MonadResource m, MonadUnliftIO m, MonadCatch m) => AppSettings -> m UniWorX -makeFoundation appSettings'@AppSettings{..} = do +makeFoundation appSettings''@AppSettings{..} = do registerGHCMetrics -- Some basic initializations: HTTP connection manager, logger, and static @@ -184,11 +184,12 @@ makeFoundation appSettings'@AppSettings{..} = do -- logging function. To get out of this loop, we initially create a -- temporary foundation without a real connection pool, get a log function -- from there, and then create the real foundation. - let mkFoundation appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appUploadCache appVerpSecret appAuthKey = UniWorX {..} + let mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appUploadCache appVerpSecret appAuthKey = UniWorX {..} -- The UniWorX {..} syntax is an example of record wild cards. For more -- information, see: -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html tempFoundation = mkFoundation + (error "appSettings' forced in tempFoundation") (error "connPool forced in tempFoundation") (error "smtpPool forced in tempFoundation") (error "ldapPool forced in tempFoundation") @@ -205,7 +206,7 @@ makeFoundation appSettings'@AppSettings{..} = do runAppLoggingT tempFoundation $ do $logInfoS "InstanceID" $ UUID.toText appInstanceID - $logDebugS "Configuration" $ tshow appSettings' + $logDebugS "Configuration" $ tshow appSettings'' $logDebugS "RTSFlags" . tshow =<< liftIO getRTSFlags smtpPool <- for appSmtpConf $ \c -> do @@ -248,13 +249,17 @@ makeFoundation appSettings'@AppSettings{..} = do appVerpSecret <- clusterSetting (Proxy :: Proxy 'ClusterVerpSecret) `runSqlPool` sqlPool appAuthKey <- clusterSetting (Proxy :: Proxy 'ClusterAuthKey) `runSqlPool` sqlPool + needsRechunk <- exists [FileContentChunkContentBased !=. True] `runSqlPool` sqlPool + let appSettings' = appSettings'' + & _appRechunkFiles %~ guardOnM needsRechunk + appMemcached <- for appMemcachedConf $ \memcachedConf -> do $logDebugS "setup" "Memcached" memcachedKey <- clusterSetting (Proxy :: Proxy 'ClusterMemcachedKey) `runSqlPool` sqlPool memcached <- createMemcached memcachedConf return (memcachedKey, memcached) - appSessionStore <- mkSessionStore appSettings' sqlPool `runSqlPool` sqlPool + appSessionStore <- mkSessionStore appSettings'' sqlPool `runSqlPool` sqlPool appUploadCache <- for appUploadCacheConf $ \minioConf -> liftIO $ do conn <- Minio.connect minioConf @@ -264,7 +269,9 @@ makeFoundation appSettings'@AppSettings{..} = do handleIf isBucketExists (const $ return ()) $ Minio.makeBucket appUploadCacheBucket Nothing return conn - let foundation = mkFoundation sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appUploadCache appVerpSecret appAuthKey + $logDebugS "Runtime configuration" $ tshow appSettings' + + let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appUploadCache appVerpSecret appAuthKey -- Return the foundation $logDebugS "setup" "Done" diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index b59095d3d..e24cba39b 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -98,6 +98,7 @@ determineCrontab = execWriterT $ do , cronRateLimit = iInterval , cronNotAfter = Right CronNotScheduled } + whenIsJust appRechunkFiles $ \rInterval -> tell $ HashMap.singleton (JobCtlQueue JobRechunkFiles) @@ -108,14 +109,15 @@ determineCrontab = execWriterT $ do , cronNotAfter = Right CronNotScheduled } - tell $ HashMap.singleton - (JobCtlQueue JobDetectMissingFiles) - Cron - { cronInitial = CronAsap - , cronRepeat = CronRepeatScheduled CronAsap - , cronRateLimit = 7200 - , cronNotAfter = Right CronNotScheduled - } + whenIsJust appCheckMissingFiles $ \rInterval -> + tell $ HashMap.singleton + (JobCtlQueue JobDetectMissingFiles) + Cron + { cronInitial = CronAsap + , cronRepeat = CronRepeatScheduled CronAsap + , cronRateLimit = rInterval + , cronNotAfter = Right CronNotScheduled + } tell . flip foldMap universeF $ \kind -> case appHealthCheckInterval kind of diff --git a/src/Settings.hs b/src/Settings.hs index 0c48504f9..ec893b793 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -183,6 +183,7 @@ data AppSettings = AppSettings , appUploadCacheBucket :: Minio.Bucket , appInjectFiles :: Maybe NominalDiffTime , appRechunkFiles :: Maybe NominalDiffTime + , appCheckMissingFiles :: Maybe NominalDiffTime , appFileUploadDBChunksize :: Int , appFileChunkingParams :: FastCDCParameters @@ -514,6 +515,7 @@ instance FromJSON AppSettings where appKeepUnreferencedFiles <- o .:? "keep-unreferenced-files" .!= 0 appInjectFiles <- o .:? "inject-files" appRechunkFiles <- o .:? "rechunk-files" + appCheckMissingFiles <- o .:? "check-missing-files" appFileUploadDBChunksize <- o .: "file-upload-db-chunksize" appFileChunkingTargetExponent <- o .: "file-chunking-target-exponent"