fix(files): better configuration for file batch jobs

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

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"

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

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"