Do sqlite dance

This commit is contained in:
Reynir Björnsson 2021-02-24 09:37:07 +01:00
parent 535d2ac0b9
commit 9d4a77abd4

View file

@ -6,37 +6,83 @@ let set_version version =
Caqti_type.unit Caqti_type.unit
(Printf.sprintf "PRAGMA user_version = %Ld" version) (Printf.sprintf "PRAGMA user_version = %Ld" version)
let alter_build_artifact = let new_build_artifact =
Caqti_request.exec ~oneshot:true Caqti_request.exec ~oneshot:true
Caqti_type.unit Caqti_type.unit
"ALTER TABLE build_artifact ADD COLUMN size INTEGER NOT NULL" {| CREATE TABLE new_build_artifact (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
filepath TEXT NOT NULL, -- the path as in the build
localpath TEXT NOT NULL, -- local path to the file on disk
sha256 BLOB NOT NULL,
size INTEGER NOT NULL,
build INTEGER NOT NULL,
let alter_build_file = FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let new_build_file =
Caqti_request.exec ~oneshot:true Caqti_request.exec ~oneshot:true
Caqti_type.unit Caqti_type.unit
"ALTER TABLE build_file ADD COLUMN size INTEGER NOT NULL" {| CREATE TABLE new_build_file (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
filepath TEXT NOT NULL, -- the path as in the build
localpath TEXT NOT NULL, -- local path to the file on disk
sha256 BLOB NOT NULL,
size INTEGER NOT NULL,
build INTEGER NOT NULL,
let collect_build_artifact_localpath = FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let collect_build_artifact =
Caqti_request.collect ~oneshot:true Caqti_request.collect ~oneshot:true
Caqti_type.unit Caqti_type.unit
Caqti_type.(tup2 int64 string) Caqti_type.(tup3 int64 (tup3 string string octets) int64)
"SELECT id, localpath FROM build_artifact" "SELECT id, filepath, localpath, sha256, build FROM build_artifact"
let collect_build_file_localpath = let collect_build_file =
Caqti_request.collect ~oneshot:true Caqti_request.collect ~oneshot:true
Caqti_type.unit Caqti_type.unit
Caqti_type.(tup2 int64 string) Caqti_type.(tup3 int64 (tup3 string string octets) int64)
"SELECT id, localpath FROM build_file" "SELECT id, filepath, localpath, sha256, build FROM build_file"
let set_build_artifact_size = let insert_new_build_artifact =
Caqti_request.exec ~oneshot:true Caqti_request.exec ~oneshot:true
Caqti_type.(tup2 int64 int64) Caqti_type.(tup3 int64 (tup4 string string octets int64) int64)
"UPDATE build_artifact SET size = ?2 WHERE id = ?1" {| INSERT INTO new_build_artifact (id, filepath, localpath, sha256, size, build)
VALUES (?, ?, ?, ?, ?, ?)
|}
let set_build_file_size = let insert_new_build_file =
Caqti_request.exec ~oneshot:true Caqti_request.exec ~oneshot:true
Caqti_type.(tup2 int64 int64) Caqti_type.(tup3 int64 (tup4 string string octets int64) int64)
"UPDATE build_file SET size = ?2 WHERE id = ?1" {| INSERT INTO new_build_file (id, filepath, localpath, sha256, size, build)
VALUES (?, ?, ?, ?, ?, ?)
|}
let drop_build_artifact =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"DROP TABLE build_artifact"
let drop_build_file =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"DROP TABLE build_file"
let rename_build_artifact =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"ALTER TABLE new_build_artifact RENAME TO build_artifact"
let rename_build_file =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"ALTER TABLE new_build_file RENAME TO build_file"
let migrate (module Db : Caqti_blocking.CONNECTION) = let migrate (module Db : Caqti_blocking.CONNECTION) =
let open Rresult.R.Infix in let open Rresult.R.Infix in
@ -45,18 +91,32 @@ let migrate (module Db : Caqti_blocking.CONNECTION) =
if application_id <> Builder_db.application_id || user_version <> old_user_version if application_id <> Builder_db.application_id || user_version <> old_user_version
then Error (`Wrong_version (application_id, user_version)) then Error (`Wrong_version (application_id, user_version))
else else
Db.exec alter_build_artifact () >>= fun () -> Db.exec new_build_artifact () >>= fun () ->
Db.iter_s collect_build_artifact_localpath Db.rev_collect_list collect_build_artifact () >>= fun build_artifacts ->
(fun (id, localpath) -> List.fold_left
(fun r (id, (filepath, localpath, sha256), build) ->
r >>= fun () ->
let stats = Unix.stat localpath in let stats = Unix.stat localpath in
Db.exec set_build_artifact_size (id, Int64.of_int stats.st_size)) Db.exec insert_new_build_artifact
() (id, (filepath, localpath, sha256, Int64.of_int stats.st_size), build))
>>= fun () -> (Ok ())
Db.exec alter_build_file () >>= fun () -> build_artifacts >>= fun () ->
Db.iter_s collect_build_file_localpath Db.exec drop_build_artifact () >>= fun () ->
(fun (id, localpath) -> Db.exec rename_build_artifact () >>= fun () ->
Db.exec new_build_file () >>= fun () ->
Db.rev_collect_list collect_build_file () >>= fun build_files ->
List.fold_left
(fun r (id, (filepath, localpath, sha256), build) ->
r >>= fun () ->
let stats = Unix.stat localpath in let stats = Unix.stat localpath in
Db.exec set_build_file_size (id, Int64.of_int stats.st_size)) Db.exec insert_new_build_file
() (id, (filepath, localpath, sha256, Int64.of_int stats.st_size), build))
(Ok ())
build_files >>= fun () ->
Db.exec drop_build_file () >>= fun () ->
Db.exec rename_build_file () >>= fun () ->
Db.exec (set_version new_user_version) ()
(* FIXME: rollback. Requires copying data and creating new table without size column. *) (* FIXME: rollback. Requires copying data and creating new table without size column. *)