fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(files): migration to content-addressable storage

Browse Source
This commit is contained in:
Gregor Kleen 2020-06-29 13:18:07 +02:00
parent 14be8f61b4
commit 353b7704dc
2 changed files with 43 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Material.hs
View File

@ -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

73
src/Model/Migration.hs
View File

@ -663,14 +663,11 @@ customMigrations = Map.fromListWith (>>)
tableDropEmpty "session_file"
)
, ( AppliedMigrationKey [migrationVersion|37.0.0|] [version|38.0.0|]
, do
unlessM (tableExists "file_content") $
[executeQQ|
CREATE TABLE "file_content" ( PRIMARY KEY ("hash")
, "hash" BYTEA NOT NULL
, "content" BYTEA NOT NULL
);
|]
, whenM (tableExists "file") $ do
[executeQQ|
ALTER TABLE "file" ADD COLUMN "hash" BYTEA;
UPDATE "file" SET "hash" = digest("content", 'sha3-512');
|]
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};
|]
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";
SELECT "file".title, "file".modified, "file".hash FROM "file" WHERE "id" = #{fId};
|]
forM_ fileDat $ \case
(fromPersistValue . unSingle -> Right (fileReferenceTitle' :: FilePath), fromPersistValue . unSingle -> Right (fileReferenceModified :: UTCTime)) -> do
let fileReferenceContent = listToMaybe $ mapMaybe (preview _Right . fromPersistValue . unSingle) insertedContent
fileRef fileReferenceTitle = _FileReference # (FileReference{..}, residual)
(fromPersistValue . unSingle -> Right (fileReferenceTitle' :: FilePath), fromPersistValue . unSingle -> Right fileReferenceModified, fromPersistValue . unSingle -> Right fileReferenceContent) -> do
let 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;
|]
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|
UPDATE "allocation_matching" SET "log_ref" = (SELECT "hash" FROM "file" WHERE "file".id = "log");
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";
|]
)
]