feat(files): avoid initial unnecessary rechunking

src/Application.hs

@@ -227,13 +227,15 @@ makeFoundation appSettings'@AppSettings{..} = do
       forM_ ldapPool $ registerFailoverMetrics "ldap"
 
       -- Perform database migration using our application's logging settings.
-      if
+      flip runReaderT tempFoundation $
-        | appAutoDbMigrate -> do
+        if
-            $logDebugS "setup" "Migration"
+          | appAutoDbMigrate -> do
-            migrateAll `runSqlPool` sqlPool
+              $logDebugS "setup" "Migration"
-        | otherwise -> whenM (requiresMigration `runSqlPool` sqlPool) $ do
+              migrateAll `runSqlPool` sqlPool
-            $logErrorS "setup" "Migration required"
+          | otherwise -> whenM (requiresMigration `runSqlPool` sqlPool) $ do
-            liftIO . exitWith $ ExitFailure 2
+              $logErrorS "setup" "Migration required"
+              liftIO . exitWith $ ExitFailure 2
+
       $logDebugS "setup" "Cluster-Config"
       appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool
       appSecretBoxKey <- clusterSetting (Proxy :: Proxy 'ClusterSecretBoxKey) `runSqlPool` sqlPool

src/Import.hs

@@ -4,6 +4,7 @@ module Import
 
 import Foundation            as Import
 import Import.NoFoundation   as Import
+import Model.Migration       as Import
 
 import Utils.SystemMessage   as Import
 import Utils.Metrics         as Import

src/Import/NoFoundation.hs

@@ -4,7 +4,6 @@ module Import.NoFoundation
 
 import Import.NoModel         as Import
 import Model                  as Import
-import Model.Migration        as Import
 import Model.Rating           as Import
 import Model.Submission       as Import
 import Model.Tokens           as Import

src/Model/Migration.hs

@@ -7,6 +7,8 @@ module Model.Migration
 
 import Import.NoModel hiding (Max(..), Last(..))
 import Model
+import Settings
+import Foundation.Type
 import Jobs.Types
 import Audit.Types
 import Model.Migration.Version
@@ -41,6 +43,8 @@ import qualified Data.Aeson as Aeson
 
 import Web.ServerSession.Backend.Persistent.Memcached (migrateMemcachedSqlStorage)
   
+import Data.Conduit.Algorithms.FastCDC (FastCDCParameters(fastCDCMinBlockSize))
+
 -- Database versions must follow https://pvp.haskell.org:
 --   - Breaking changes are instances where manual migration is necessary (via customMigrations; i.e. changing a columns format)
 --   - Non-breaking changes are instances where the automatic migration done by persistent is sufficient (i.e. adding a column or table)
@@ -80,6 +84,7 @@ migrateAll' = sequence_
 migrateAll :: ( MonadLogger m
               , MonadResource m
               , MonadUnliftIO m
+              , MonadReader UniWorX m
               )
            => ReaderT SqlBackend m ()
 migrateAll = do
@@ -112,7 +117,7 @@ requiresMigration = mapReaderT (exceptT return return) $ do
     $logInfoS "Migration" $ intercalate "; " initial
     throwError True
 
-  customs <- mapReaderT lift $ getMissingMigrations @_ @m
+  customs <- mapReaderT lift $ getMissingMigrations @_ @(ReaderT UniWorX m)
   unless (Map.null customs) $ do
     $logInfoS "Migration" . intercalate ", " . map tshow $ Map.keys customs
     throwError True
@@ -134,6 +139,7 @@ getMissingMigrations :: forall m m'.
                         ( MonadLogger m
                         , MonadIO m
                         , MonadResource m'
+                        , MonadReader UniWorX m'
                         )
                      => ReaderT SqlBackend m (Map (Key AppliedMigration) (ReaderT SqlBackend m' ()))
 getMissingMigrations = do
@@ -180,7 +186,9 @@ migrateManual = do
 -}
 
 customMigrations :: forall m.
-                    MonadResource m
+                    ( MonadResource m
+                    , MonadReader UniWorX m
+                    )
                  => Map (Key AppliedMigration) (ReaderT SqlBackend m ())
 customMigrations = Map.fromListWith (>>)
   [ ( AppliedMigrationKey [migrationVersion|initial|] [version|0.0.0|]
@@ -923,14 +931,20 @@ customMigrations = Map.fromListWith (>>)
         |]
     )
   , ( AppliedMigrationKey [migrationVersion|40.0.0|] [version|41.0.0|]
-    , whenM (tableExists "file_content") $
+    , whenM (tableExists "file_content") $ do
+        chunkingParams <- lift $ view _appFileChunkingParams
+
         [executeQQ|
           ALTER TABLE file_content RENAME TO file_content_chunk;
+          ALTER INDEX file_content_pkey RENAME TO file_content_chunk_pkey;
 
           CREATE TABLE file_content_chunk_unreferenced (id bigserial, hash bytea NOT NULL, since timestamp with time zone NOT NULL);
           INSERT INTO file_content_chunk_unreferenced (since, hash) (SELECT unreferenced_since as since, hash FROM file_content_chunk WHERE NOT (unreferenced_since IS NULL));
           ALTER TABLE file_content_chunk DROP COLUMN unreferenced_since;
 
+          ALTER TABLE file_content_chunk ADD COLUMN content_based boolean NOT NULL DEFAULT false;
+          UPDATE file_content_chunk SET content_based = true WHERE length(content) <= #{fastCDCMinBlockSize chunkingParams};
+          
           CREATE TABLE file_content_entry (hash bytea NOT NULL, ix bigint NOT NULL, chunk_hash bytea NOT NULL);
           INSERT INTO file_content_entry (hash, chunk_hash, ix) (SELECT hash, hash as chunk_hash, 0 as ix FROM file_content_chunk);
         |]