chore(files): migration to content-addressable storage

src/Handler/Material.hs

@@ -287,7 +287,7 @@ handleMaterialEdit tid ssh csh cid template dbMaterial = do
         case mbmid of
           Nothing -> False <$ addMessageI Error (MsgMaterialNameDup tid ssh csh mfName)
           (Just mid) -> do -- save files in DB
-            whenIsJust mfFiles $ insertMaterialFile' mid
+            insertMaterialFile' mid $ fromMaybe (return ()) mfFiles
             addMessageI Success $ MsgMaterialSaveOk tid ssh csh mfName
             -- more info/warnings could go here
             return True

src/Model/Migration.hs

@@ -663,14 +663,11 @@ customMigrations = Map.fromListWith (>>)
         tableDropEmpty "session_file"
     )
   , ( AppliedMigrationKey [migrationVersion|37.0.0|] [version|38.0.0|]
-    , do
+    , whenM (tableExists "file") $ do
-        unlessM (tableExists "file_content") $
+        [executeQQ|
-          [executeQQ|
+          ALTER TABLE "file" ADD COLUMN "hash" BYTEA;
-            CREATE TABLE "file_content" ( PRIMARY KEY ("hash")
+          UPDATE "file" SET "hash" = digest("content", 'sha3-512');
-                                        , "hash" BYTEA NOT NULL
+        |]
-                                        , "content" BYTEA NOT NULL
-                                        );
-          |]
 
         let
           migrateFromFile :: forall fRef.
@@ -684,15 +681,11 @@ customMigrations = Map.fromListWith (>>)
           migrateFromFile toResidual doUpdate ((fromPersistValue -> Right (fId :: Int64)):rest) = do
             let (fRefKey, residual) = toResidual rest
             fileDat <- [sqlQQ|
-              SELECT "file".title, "file".modified FROM "file" WHERE "id" = #{fId};
+              SELECT "file".title, "file".modified, "file".hash FROM "file" WHERE "id" = #{fId};
-            |]
-            insertedContent <- [sqlQQ|
-              INSERT INTO "file_content" (SELECT digest("content", 'sha3-512') as "hash", "content" FROM "file" WHERE id = #{fId} AND NOT ("content" IS NULL)) ON CONFLICT("hash") DO UPDATE SET "hash" = EXCLUDED."hash" RETURNING "hash";
             |]
             forM_ fileDat $ \case
-              (fromPersistValue . unSingle -> Right (fileReferenceTitle' :: FilePath), fromPersistValue . unSingle -> Right (fileReferenceModified :: UTCTime)) -> do
+              (fromPersistValue . unSingle -> Right (fileReferenceTitle' :: FilePath), fromPersistValue . unSingle -> Right fileReferenceModified, fromPersistValue . unSingle -> Right fileReferenceContent) -> do
-                let fileReferenceContent = listToMaybe $ mapMaybe (preview _Right . fromPersistValue . unSingle) insertedContent
+                let fileRef fileReferenceTitle = _FileReference # (FileReference{..}, residual)
-                    fileRef fileReferenceTitle = _FileReference # (FileReference{..}, residual)
                     candidateTitles = fileReferenceTitle' : [ fName <.> ("old-" <> show n) <.> ext | n <- [1..1000] ]
                       where (fName, ext) = splitExtension fileReferenceTitle' 
                 validTitles <- dropWhileM (fmap (is _Just) . checkUnique . fileRef) candidateTitles
@@ -822,30 +815,48 @@ customMigrations = Map.fromListWith (>>)
         whenM (tableExists "allocation_matching") $ do
           [executeQQ|
             ALTER TABLE "allocation_matching" ADD COLUMN "log_ref" BYTEA;
-          |]
+            UPDATE "allocation_matching" SET "log_ref" = (SELECT "hash" FROM "file" WHERE "file".id = "log");
-          let getAllocationMatchingFiles = [queryQQ|SELECT "log", "allocation_matching"."id" FROM "allocation_matching";|]
-              moveMatchingFile [ fromPersistValue -> Right (fId :: Int64), fromPersistValue -> Right (amId :: AllocationMatchingId) ] = do
-                insertedContent <- [sqlQQ|
-                  INSERT INTO "file_content" (SELECT digest("content", 'sha3-512') as "hash", "content" FROM "file" WHERE id = #{fId} AND NOT ("content" IS NULL)) ON CONFLICT("hash") DO UPDATE SET "hash" = EXCLUDED."hash" RETURNING "hash";
-                |]
-                let refContent :: Maybe FileContentReference
-                    refContent = listToMaybe $ mapMaybe (preview _Right . fromPersistValue . unSingle) insertedContent
-                case refContent of
-                  Nothing -> error "AllocationMatching had no fileContent"
-                  Just h -> [executeQQ|UPDATE "allocation_matching" SET "log_ref" = #{h} WHERE "id" = #{amId};|]
-              moveMatchingFile _ = return ()
-          runConduit $ getAllocationMatchingFiles .| C.mapM_ moveMatchingFile
-          [executeQQ|
             ALTER TABLE "allocation_matching" DROP COLUMN "log";
             ALTER TABLE "allocation_matching" RENAME COLUMN "log_ref" TO "log";
           |]
 
         whenM (tableExists "session_file") $
           [executeQQ|
-            TRUNCATE TABLE "session_file";
+            ALTER TABLE "session_file" ADD COLUMN "content" BYTEA;
+            UPDATE "session_file" SET "content" = (SELECT "hash" FROM "file" WHERE "file".id = "session_file"."file");
             ALTER TABLE "session_file" DROP COLUMN "file";
-            ALTER TABLE "session_file" ADD COLUMN "content" BYTEA NULL;
           |]
+
+        [executeQQ|
+          ALTER TABLE "file" RENAME TO "file_content";
+          DELETE FROM "file_content" WHERE "content" IS NULL OR "hash" IS NULL;
+        |]
+        [executeQQ|
+          CREATE INDEX "file_content_hash_idx" ON "file_content" ("hash") INCLUDE ("id");
+        |]
+        [executeQQ|
+          DELETE FROM "file_content"
+          WHERE "id" IN (
+              SELECT
+                  "id"
+              FROM (
+                  SELECT
+                      "id",
+                      ROW_NUMBER() OVER w AS rnum
+                  FROM "file_content"
+                  WINDOW w AS (
+                      PARTITION BY "hash"
+                      ORDER BY "id"
+                  )
+              ) as t
+          WHERE t.rnum > 1);
+        |]
+        [executeQQ|
+          DROP INDEX "file_content_hash_idx";
+          ALTER TABLE "file_content" DROP COLUMN "title";
+          ALTER TABLE "file_content" DROP COLUMN "modified";
+          ALTER TABLE "file_content" DROP COLUMN "id";
+        |]
     )
   ]