robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update to caqti 1.8.0

Browse source
This commit is contained in:
Reynir Björnsson 2022-04-04 17:30:21 +01:00
parent c72ff72e0d
commit 6e75a653bc
30 changed files with 1361 additions and 1595 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
bin/builder_db_app.ml
View file

@ -1,3 +1,5 @@
open Caqti_request.Infix
let ( let* ) = Result.bind
let ( let+ ) x f = Result.map f x
@ -10,19 +12,12 @@ let or_die exit_code = function
Format.eprintf "Database error: %a\n" Caqti_error.pp e;
exit exit_code
let foreign_keys =
Caqti_request.exec
Caqti_type.unit
"PRAGMA foreign_keys = ON"
let defer_foreign_keys =
Caqti_request.exec
Caqti_type.unit
"PRAGMA defer_foreign_keys = ON"
Caqti_type.unit ->. Caqti_type.unit @@
"PRAGMA defer_foreign_keys = ON"
let connect uri =
let* (module Db : Caqti_blocking.CONNECTION) = Caqti_blocking.connect uri in
let* () = Db.exec foreign_keys () in
let* (module Db : Caqti_blocking.CONNECTION) = Caqti_blocking.connect ~tweaks_version:(1,8) uri in
let* () = Db.exec defer_foreign_keys () in
Ok (module Db : Caqti_blocking.CONNECTION)
@ -179,19 +174,16 @@ let job_remove () datadir jobname =
or_die 1 r
let input_ids =
Caqti_request.collect
Caqti_type.unit
Builder_db.Rep.cstruct
"SELECT DISTINCT input_id FROM build WHERE input_id IS NOT NULL"
Caqti_type.unit ->* Builder_db.Rep.cstruct @@
"SELECT DISTINCT input_id FROM build WHERE input_id IS NOT NULL"
let main_artifact_hash =
Caqti_request.collect
Builder_db.Rep.cstruct
(Caqti_type.tup3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string)
{|
SELECT a.sha256, b.uuid, j.name FROM build_artifact a, build b, job j
WHERE b.input_id = ? AND a.id = b.main_binary AND b.job = j.id
|}
Builder_db.Rep.cstruct ->*
Caqti_type.tup3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@
{|
SELECT a.sha256, b.uuid, j.name FROM build_artifact a, build b, job j
WHERE b.input_id = ? AND a.id = b.main_binary AND b.job = j.id
|}
let verify_input_id () dbpath =
let r =
@ -219,26 +211,25 @@ let verify_input_id () dbpath =
or_die 1 r
let num_build_artifacts =
Caqti_request.find
Caqti_type.unit
Caqti_type.int
"SELECT count(*) FROM build_artifact"
Caqti_type.unit ->! Caqti_type.int @@
"SELECT count(*) FROM build_artifact"
let build_artifacts : (unit, string * Uuidm.t * (Fpath.t * Fpath.t * Cstruct.t * int64), [ `One | `Zero | `Many ]) Caqti_request.t =
Caqti_request.collect
Caqti_type.unit
Caqti_type.(tup3 string Builder_db.Rep.uuid (tup4 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct int64))
{| SELECT job.name, b.uuid, a.filepath, a.localpath, a.sha256, a.size
FROM build_artifact a, build b, job
WHERE a.build = b.id AND b.job = job.id |}
Caqti_type.unit ->*
Caqti_type.(tup3 string Builder_db.Rep.uuid
(tup4 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct int64))
@@
{| SELECT job.name, b.uuid, a.filepath, a.localpath, a.sha256, a.size
FROM build_artifact a, build b, job
WHERE a.build = b.id AND b.job = job.id |}
let script_and_console : (unit, _, [`One | `Zero | `Many ]) Caqti_request.t =
Caqti_request.collect
Caqti_type.unit
Caqti_type.(tup4 string Builder_db.Rep.uuid Builder_db.Rep.fpath Builder_db.Rep.fpath)
{| SELECT job.name, b.uuid, b.console, b.script
FROM build b, job
WHERE job.id = b.job |}
Caqti_type.unit ->*
Caqti_type.(tup4 string Builder_db.Rep.uuid Builder_db.Rep.fpath Builder_db.Rep.fpath)
@@
{| SELECT job.name, b.uuid, b.console, b.script
FROM build b, job
WHERE job.id = b.job |}
module FpathSet = Set.Make(Fpath)

20
bin/migrations/grej.ml
View file

@ -1,20 +1,29 @@
(* Grej is utilities *)
module Syntax = struct
open Caqti_request.Infix
let ( let* ) = Result.bind
let ( let+ ) x f = Result.map f x
let ( ->. ) = ( ->. ) ~oneshot:true
let ( ->! ) = ( ->! ) ~oneshot:true
let ( ->? ) = ( ->? ) ~oneshot:true
let ( ->* ) = ( ->* ) ~oneshot:true
end
module Infix = struct
open Caqti_request.Infix
let ( >>= ) = Result.bind
let ( >>| ) x f = Result.map f x
let ( ->. ) = ( ->. ) ~oneshot:true
let ( ->! ) = ( ->! ) ~oneshot:true
let ( ->? ) = ( ->? ) ~oneshot:true
let ( ->* ) = ( ->* ) ~oneshot:true
end
open Syntax
let set_version version =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
(Printf.sprintf "PRAGMA user_version = %Ld" version)
Caqti_type.unit ->. Caqti_type.unit @@
Printf.sprintf "PRAGMA user_version = %Ld" version
let check_version
?application_id:(desired_application_id=Builder_db.application_id)
@ -34,6 +43,5 @@ let list_iter_result f xs =
let foreign_keys on =
let on = if on then "ON" else "OFF" in
Caqti_request.exec
Caqti_type.unit
(Printf.sprintf "PRAGMA foreign_keys = %s" on)
Caqti_type.unit ->. Caqti_type.unit @@
Printf.sprintf "PRAGMA foreign_keys = %s" on

82
bin/migrations/m20210126.ml
View file

@ -3,32 +3,27 @@ let identifier = "2021-01-26"
let migrate_doc = "add column main_binary to build"
let rollback_doc = "remove column main_binary from build"
open Grej.Infix
let set_application_id =
Caqti_request.exec
Caqti_type.unit
(Printf.sprintf "PRAGMA application_id = %ld" Builder_db.application_id)
Caqti_type.unit ->. Caqti_type.unit @@
Printf.sprintf "PRAGMA application_id = %ld" Builder_db.application_id
let alter_build =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"ALTER TABLE build ADD COLUMN main_binary TEXT"
Caqti_type.unit ->. Caqti_type.unit @@
"ALTER TABLE build ADD COLUMN main_binary TEXT"
let all_builds =
Caqti_request.collect ~oneshot:true
Caqti_type.unit
Caqti_type.int64
"SELECT id FROM build"
Caqti_type.unit ->* Caqti_type.int64 @@
"SELECT id FROM build"
let bin_artifact =
Caqti_request.collect ~oneshot:true
Caqti_type.int64
Caqti_type.(tup2 int64 string)
"SELECT id, filepath FROM build_artifact WHERE build = ? AND filepath LIKE 'bin/%'"
Caqti_type.int64 ->* Caqti_type.(tup2 int64 string) @@
"SELECT id, filepath FROM build_artifact WHERE build = ? AND filepath LIKE 'bin/%'"
let set_main_binary =
Caqti_request.exec ~oneshot:true
Caqti_type.(tup2 int64 (option string))
"UPDATE build SET main_binary = $2 WHERE id = $1"
Caqti_type.(tup2 int64 (option string)) ->. Caqti_type.unit @@
"UPDATE build SET main_binary = $2 WHERE id = $1"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
@ -52,39 +47,36 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Db.exec (Grej.set_version new_version) ()
let rename_build =
Caqti_request.exec
Caqti_type.unit
"ALTER TABLE build RENAME TO __tmp_build"
Caqti_type.unit ->. Caqti_type.unit @@
"ALTER TABLE build RENAME TO __tmp_build"
let create_build =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
job INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
job INTEGER NOT NULL,
FOREIGN KEY(job) REFERENCES job(id)
)
|}
FOREIGN KEY(job) REFERENCES job(id)
)
|}
let rollback_data =
Caqti_request.exec
Caqti_type.unit
{| INSERT INTO build
SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console, script, job
FROM __tmp_build
|}
Caqti_type.unit ->. Caqti_type.unit @@
{| INSERT INTO build
SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console, script, job
FROM __tmp_build
|}
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in

10
bin/migrations/m20210202.ml
View file

@ -7,18 +7,16 @@ open Grej.Infix
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
let job_build_idx =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"CREATE INDEX job_build_idx ON build(job)";
Caqti_type.unit ->. Caqti_type.unit @@
"CREATE INDEX job_build_idx ON build(job)";
in
Grej.check_version ~user_version:1L (module Db) >>= fun () ->
Db.exec job_build_idx ()
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
let q =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"DROP INDEX IF EXISTS job_build_idx"
Caqti_type.unit ->. Caqti_type.unit @@
"DROP INDEX IF EXISTS job_build_idx"
in
Grej.check_version ~user_version:1L (module Db) >>= fun () ->
Db.exec q ()

51
bin/migrations/m20210216.ml
View file

@ -4,46 +4,43 @@ let identifier = "2021-02-16"
let migrate_doc = "change to scrypt hashed passwords (NB: destructive!!)"
let rollback_doc = "rollback scrypt hashed passwords (NB: destructive!!)"
open Grej.Infix
let drop_user =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"DROP TABLE user"
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE user"
let new_user =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
{| CREATE TABLE user (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL,
password_salt BLOB NOT NULL,
scrypt_n INTEGER NOT NULL,
scrypt_r INTEGER NOT NULL,
scrypt_p INTEGER NOT NULL
)
|}
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE user (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL,
password_salt BLOB NOT NULL,
scrypt_n INTEGER NOT NULL,
scrypt_r INTEGER NOT NULL,
scrypt_p INTEGER NOT NULL
)
|}
let old_user =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE user (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL,
password_salt BLOB NOT NULL,
password_iter INTEGER NOT NULL
)
|}
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE user (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL,
password_salt BLOB NOT NULL,
password_iter INTEGER NOT NULL
)
|}
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec drop_user () >>= fun () ->
Db.exec new_user () >>= fun () ->
Db.exec (Grej.set_version new_version) ()
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec drop_user () >>= fun () ->
Db.exec old_user () >>= fun () ->

162
bin/migrations/m20210218.ml
View file

@ -4,86 +4,75 @@ let identifier = "2021-02-18"
let migrate_doc = "add column size to build_file and build_artifact"
let rollback_doc = "remove column size to build_file and build_artifact"
let new_build_artifact =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
{| 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,
open Grej.Infix
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let new_build_artifact =
Caqti_type.unit ->. Caqti_type.unit @@
{| 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,
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let new_build_file =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
{| 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,
Caqti_type.unit ->. Caqti_type.unit @@
{| 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,
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let collect_build_artifact =
Caqti_request.collect ~oneshot:true
Caqti_type.unit
Caqti_type.(tup3 int64 (tup3 string string octets) int64)
"SELECT id, filepath, localpath, sha256, build FROM build_artifact"
Caqti_type.unit ->* Caqti_type.(tup3 int64 (tup3 string string octets) int64) @@
"SELECT id, filepath, localpath, sha256, build FROM build_artifact"
let collect_build_file =
Caqti_request.collect ~oneshot:true
Caqti_type.unit
Caqti_type.(tup3 int64 (tup3 string string octets) int64)
"SELECT id, filepath, localpath, sha256, build FROM build_file"
Caqti_type.unit ->* Caqti_type.(tup3 int64 (tup3 string string octets) int64) @@
"SELECT id, filepath, localpath, sha256, build FROM build_file"
let insert_new_build_artifact =
Caqti_request.exec ~oneshot:true
Caqti_type.(tup3 int64 (tup4 string string octets int64) int64)
{| INSERT INTO new_build_artifact (id, filepath, localpath, sha256, size, build)
VALUES (?, ?, ?, ?, ?, ?)
|}
Caqti_type.(tup3 int64 (tup4 string string octets int64) int64) ->. Caqti_type.unit @@
{| INSERT INTO new_build_artifact (id, filepath, localpath, sha256, size, build)
VALUES (?, ?, ?, ?, ?, ?)
|}
let insert_new_build_file =
Caqti_request.exec ~oneshot:true
Caqti_type.(tup3 int64 (tup4 string string octets int64) int64)
{| INSERT INTO new_build_file (id, filepath, localpath, sha256, size, build)
VALUES (?, ?, ?, ?, ?, ?)
|}
Caqti_type.(tup3 int64 (tup4 string string octets int64) int64) ->. Caqti_type.unit @@
{| 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"
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE build_artifact"
let drop_build_file =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"DROP TABLE build_file"
Caqti_type.unit ->. 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"
Caqti_type.unit ->. 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"
Caqti_type.unit ->. Caqti_type.unit @@
"ALTER TABLE new_build_file RENAME TO build_file"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec new_build_artifact () >>= fun () ->
Db.rev_collect_list collect_build_artifact () >>= fun build_artifacts ->
@ -110,47 +99,42 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Db.exec (Grej.set_version new_version) ()
let old_build_artifact =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
{| 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,
build INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| 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,
build INTEGER NOT NULL,
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let old_build_file =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
{| 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,
build INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| 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,
build INTEGER NOT NULL,
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let copy_build_artifact =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"INSERT INTO new_build_artifact SELECT id, filepath, localpath, sha256, build FROM build_artifact"
Caqti_type.unit ->. Caqti_type.unit @@
"INSERT INTO new_build_artifact SELECT id, filepath, localpath, sha256, build FROM build_artifact"
let copy_build_file =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"INSERT INTO new_build_file SELECT id, filepath, localpath, sha256, build FROM build_file"
Caqti_type.unit ->. Caqti_type.unit @@
"INSERT INTO new_build_file SELECT id, filepath, localpath, sha256, build FROM build_file"
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec old_build_artifact () >>= fun () ->
Db.exec copy_build_artifact () >>= fun () ->

17
bin/migrations/m20210308.ml
View file

@ -1,17 +1,16 @@
module Rep = Builder_db.Rep
open Grej.Infix
let broken_builds =
Caqti_request.collect ~oneshot:true
Caqti_type.unit
(Caqti_type.tup3 (Rep.id `build) Rep.uuid Caqti_type.string)
{| SELECT b.id, b.uuid, job.name FROM build b, job
WHERE result_kind = 0 AND result_code = 0 AND main_binary IS NOT NULL AND job.id = b.job AND
(SELECT COUNT( * ) FROM build_artifact a
WHERE a.build = b.id and a.filepath = b.main_binary) = 0
|}
Caqti_type.unit ->* Caqti_type.tup3 (Rep.id `build) Rep.uuid Caqti_type.string @@
{| SELECT b.id, b.uuid, job.name FROM build b, job
WHERE result_kind = 0 AND result_code = 0 AND main_binary IS NOT NULL AND job.id = b.job AND
(SELECT COUNT( * ) FROM build_artifact a
WHERE a.build = b.id and a.filepath = b.main_binary) = 0
|}
let fixup datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:3L (module Db) >>= fun () ->
Db.rev_collect_list broken_builds () >>= fun broken_builds ->
Grej.list_iter_result

20
bin/migrations/m20210427.ml
View file

@ -7,14 +7,12 @@ open Grej.Infix
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
let idx_build_job_start =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
Caqti_type.unit ->. Caqti_type.unit @@
"CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
in
let rm_job_build_idx =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"DROP INDEX IF EXISTS job_build_idx"
Caqti_type.unit ->. Caqti_type.unit @@
"DROP INDEX IF EXISTS job_build_idx"
in
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec rm_job_build_idx () >>= fun () ->
@ -22,14 +20,12 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
let job_build_idx =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"CREATE INDEX job_build_idx ON build(job)"
Caqti_type.unit ->. Caqti_type.unit @@
"CREATE INDEX job_build_idx ON build(job)"
in
let rm_idx_build_job_start =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"DROP INDEX IF EXISTS idx_build_job_start"
Caqti_type.unit ->. Caqti_type.unit @@
"DROP INDEX IF EXISTS idx_build_job_start"
in
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec rm_idx_build_job_start () >>= fun () ->

13
bin/migrations/m20210531.ml
View file

@ -4,21 +4,19 @@ let identifier = "2021-05-31"
let migrate_doc = "remove datadir prefix from build_artifact.localpath"
let rollback_doc = "add datadir prefix to build_artifact.localpath"
open Grej.Infix
let build_artifacts =
Caqti_request.collect ~oneshot:true
Caqti_type.unit
Caqti_type.(tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath)
"SELECT id, localpath FROM build_artifact"
Caqti_type.unit ->* Caqti_type.tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath @@
"SELECT id, localpath FROM build_artifact"
let build_artifact_update_localpath =
Caqti_request.exec ~oneshot:true
Caqti_type.(tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath)
Caqti_type.tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath ->. Caqti_type.unit @@
"UPDATE build_artifact SET localpath = $2 WHERE id = $1"
(* We are not migrating build_file because it is unused *)
let migrate datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.collect_list build_artifacts () >>= fun artifacts ->
Grej.list_iter_result (fun (id, localpath) ->
@ -29,7 +27,6 @@ let migrate datadir (module Db : Caqti_blocking.CONNECTION) =
Db.exec (Grej.set_version new_version) ()
let rollback datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.collect_list build_artifacts () >>= fun artifacts ->
Grej.list_iter_result (fun (id, localpath) ->

164
bin/migrations/m20210602.ml
View file

@ -3,117 +3,114 @@ let identifier = "2021-06-02"
let migrate_doc = "build.main_binary foreign key"
let rollback_doc = "build.main_binary filepath"
open Grej.Infix
let idx_build_job_start =
Caqti_request.exec Caqti_type.unit
"CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
Caqti_type.unit ->. Caqti_type.unit @@
"CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
let new_build =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE new_build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary INTEGER,
job INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE new_build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary INTEGER,
job INTEGER NOT NULL,
FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
FOREIGN KEY(job) REFERENCES job(id)
)
|}
FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
FOREIGN KEY(job) REFERENCES job(id)
)
|}
let old_build =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE new_build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary TEXT,
job INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE new_build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary TEXT,
job INTEGER NOT NULL,
FOREIGN KEY(job) REFERENCES job(id)
)
|}
FOREIGN KEY(job) REFERENCES job(id)
)
|}
let collect_old_build =
Caqti_request.collect ~oneshot:true
Caqti_type.unit
Caqti_type.(tup3 Builder_db.Rep.untyped_id
(tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option string)))
Builder_db.Rep.untyped_id)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
console, script, main_binary, job
FROM build |}
Caqti_type.unit ->*
Caqti_type.(tup3 Builder_db.Rep.untyped_id
(tup3 (tup4 string int64 int64 int64)
(tup4 int64 int (option int) (option string))
(tup3 octets string (option string)))
Builder_db.Rep.untyped_id) @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
console, script, main_binary, job
FROM build |}
let insert_new_build =
Caqti_request.exec ~oneshot:true
Caqti_type.(tup3 Builder_db.Rep.untyped_id
(tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.untyped_id)))
Builder_db.Rep.untyped_id)
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
Caqti_type.(tup3 Builder_db.Rep.untyped_id
(tup3 (tup4 string int64 int64 int64)
(tup4 int64 int (option int) (option string))
(tup3 octets string (option Builder_db.Rep.untyped_id)))
Builder_db.Rep.untyped_id) ->. Caqti_type.unit @@
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
let drop_build =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE build"
let rename_build =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
Caqti_type.unit ->. Caqti_type.unit @@
"ALTER TABLE new_build RENAME TO build"
let find_main_artifact_id =
Caqti_request.find ~oneshot:true
Caqti_type.(tup2 Builder_db.Rep.untyped_id string)
Builder_db.Rep.untyped_id
"SELECT id FROM build_artifact WHERE build = $1 AND filepath = $2"
Caqti_type.(tup2 Builder_db.Rep.untyped_id string) ->! Builder_db.Rep.untyped_id @@
"SELECT id FROM build_artifact WHERE build = $1 AND filepath = $2"
let find_main_artifact_filepath =
Caqti_request.find ~oneshot:true
Builder_db.Rep.untyped_id
Caqti_type.string
Builder_db.Rep.untyped_id ->! Caqti_type.string @@
"SELECT filepath FROM build_artifact WHERE id = ?"
let collect_new_build =
Caqti_request.collect ~oneshot:true
Caqti_type.unit
Caqti_type.(tup3 Builder_db.Rep.untyped_id
(tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.untyped_id)))
Builder_db.Rep.untyped_id)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
console, script, main_binary, job
FROM build |}
Caqti_type.unit ->*
Caqti_type.(tup3 Builder_db.Rep.untyped_id
(tup3 (tup4 string int64 int64 int64)
(tup4 int64 int (option int) (option string))
(tup3 octets string (option Builder_db.Rep.untyped_id)))
Builder_db.Rep.untyped_id) @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
console, script, main_binary, job
FROM build |}
let insert_old_build =
Caqti_request.exec ~oneshot:true
Caqti_type.(tup3 Builder_db.Rep.untyped_id
(tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option string)))
Builder_db.Rep.untyped_id)
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
Caqti_type.(tup3 Builder_db.Rep.untyped_id
(tup3 (tup4 string int64 int64 int64)
(tup4 int64 int (option int) (option string))
(tup3 octets string (option string)))
Builder_db.Rep.untyped_id) ->. Caqti_type.unit @@
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
let migrate _ (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec new_build () >>= fun () ->
Db.rev_collect_list collect_old_build () >>= fun builds ->
@ -133,7 +130,6 @@ let migrate _ (module Db : Caqti_blocking.CONNECTION) =
let rollback _ (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec old_build () >>= fun () ->
Db.rev_collect_list collect_new_build () >>= fun builds ->

110
bin/migrations/m20210608.ml
View file

@ -3,87 +3,79 @@ let identifier = "2021-06-08"
let migrate_doc = "add access list"
let rollback_doc = "remove access list"
open Grej.Infix
let new_user =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE new_user (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL,
password_salt BLOB NOT NULL,
scrypt_n INTEGER NOT NULL,
scrypt_r INTEGER NOT NULL,
scrypt_p INTEGER NOT NULL,
restricted BOOLEAN NOT NULL
)
|}
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE new_user (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL,
password_salt BLOB NOT NULL,
scrypt_n INTEGER NOT NULL,
scrypt_r INTEGER NOT NULL,
scrypt_p INTEGER NOT NULL,
restricted BOOLEAN NOT NULL
)
|}
let old_user =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE new_user (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL,
password_salt BLOB NOT NULL,
scrypt_n INTEGER NOT NULL,
scrypt_r INTEGER NOT NULL,
scrypt_p INTEGER NOT NULL
)
|}
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE new_user (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL,
password_salt BLOB NOT NULL,
scrypt_n INTEGER NOT NULL,
scrypt_r INTEGER NOT NULL,
scrypt_p INTEGER NOT NULL
)
|}
let collect_old_user =
Caqti_request.collect
Caqti_type.unit
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64))
"SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p FROM user"
Caqti_type.unit ->*
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64)) @@
"SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p FROM user"
let collect_new_user =
Caqti_request.collect
Caqti_type.unit
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool))
"SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted FROM user"
Caqti_type.unit ->*
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool)) @@
"SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted FROM user"
let insert_new_user =
Caqti_request.exec
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool))
"INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) VALUES (?, ?, ?, ?, ?, ?, ?, ?)"
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool)) ->.
Caqti_type.unit @@
"INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) VALUES (?, ?, ?, ?, ?, ?, ?, ?)"
let insert_old_user =
Caqti_request.exec
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64))
"INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p) VALUES (?, ?, ?, ?, ?, ?, ?)"
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64)) ->.
Caqti_type.unit @@
"INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p) VALUES (?, ?, ?, ?, ?, ?, ?)"
let drop_user =
Caqti_request.exec
Caqti_type.unit
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE user"
let rename_new_user =
Caqti_request.exec
Caqti_type.unit
Caqti_type.unit ->. Caqti_type.unit @@
"ALTER TABLE new_user RENAME TO user"
let access_list =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE access_list (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
user INTEGER NOT NULL,
job INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE access_list (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
user INTEGER NOT NULL,
job INTEGER NOT NULL,
FOREIGN KEY(user) REFERENCES user(id),
FOREIGN KEY(job) REFERENCES job(id),
UNIQUE(user, job)
)
|}
FOREIGN KEY(user) REFERENCES user(id),
FOREIGN KEY(job) REFERENCES job(id),
UNIQUE(user, job)
)
|}
let rollback_access_list =
Caqti_request.exec
Caqti_type.unit
"DROP TABLE IF EXISTS access_list"
open Grej.Infix
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE IF EXISTS access_list"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->

142
bin/migrations/m20210609.ml
View file

@ -3,100 +3,92 @@ let identifier = "2021-06-09"
let migrate_doc = "add user column to build"
let rollback_doc = "remove user column from build"
open Grej.Infix
let idx_build_job_start =
Caqti_request.exec Caqti_type.unit
"CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
Caqti_type.unit ->. Caqti_type.unit @@
"CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
let nologin_user =
Caqti_request.exec
Caqti_type.unit
"INSERT INTO user (username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) \
VALUES ('nologin', x'', x'', 16384, 8, 1, true)"
Caqti_type.unit ->. Caqti_type.unit @@
"INSERT INTO user (username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) \
VALUES ('nologin', x'', x'', 16384, 8, 1, true)"
let remove_nologin_user =
Caqti_request.exec
Caqti_type.unit
"DELETE FROM user WHERE username = 'nologin'"
Caqti_type.unit ->. Caqti_type.unit @@
"DELETE FROM user WHERE username = 'nologin'"
let new_build =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE new_build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary INTEGER,
user INTEGER NOT NULL,
job INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE new_build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary INTEGER,
user INTEGER NOT NULL,
job INTEGER NOT NULL,
FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
FOREIGN KEY(job) REFERENCES job(id),
FOREIGN KEY(user) REFERENCES user(id)
)
|}
FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
FOREIGN KEY(job) REFERENCES job(id),
FOREIGN KEY(user) REFERENCES user(id)
)
|}
let old_build =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE new_build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary INTEGER,
job INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE new_build (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
uuid VARCHAR(36) NOT NULL UNIQUE,
start_d INTEGER NOT NULL,
start_ps INTEGER NOT NULL,
finish_d INTEGER NOT NULL,
finish_ps INTEGER NOT NULL,
result_kind TINYINT NOT NULL,
result_code INTEGER,
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary INTEGER,
job INTEGER NOT NULL,
FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
FOREIGN KEY(job) REFERENCES job(id)
)
|}
FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
FOREIGN KEY(job) REFERENCES job(id)
)
|}
let insert_from_old_build =
Caqti_request.exec ~oneshot:true
(Builder_db.Rep.id (`user : [`user]))
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console,
script, main_binary, job, user)
SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job, ?
FROM build |}
Builder_db.Rep.id (`user : [`user]) ->. Caqti_type.unit @@
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console,
script, main_binary, job, user)
SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job, ?
FROM build |}
let insert_from_new_build =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console,
script, main_binary, job)
SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job
FROM build |}
Caqti_type.unit ->. Caqti_type.unit @@
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console,
script, main_binary, job)
SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job
FROM build |}
let drop_build =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"DROP TABLE build"
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE build"
let rename_build =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
"ALTER TABLE new_build RENAME TO build"
open Grej.Infix
Caqti_type.unit ->. Caqti_type.unit @@
"ALTER TABLE new_build RENAME TO build"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->

36
bin/migrations/m20210625.ml
View file

@ -3,28 +3,26 @@ let identifier = "2021-06-25"
let migrate_doc = "drop build_file table"
let rollback_doc = "recreate build_file table"
let build_file =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE 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,
open Grej.Infix
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let build_file =
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE 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,
FOREIGN KEY(build) REFERENCES build(id),
UNIQUE(build, filepath)
)
|}
let drop_build_file =
Caqti_request.exec
Caqti_type.unit
"DROP TABLE build_file"
open Grej.Infix
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE build_file"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->

102
bin/migrations/m20210629.ml
View file

@ -3,55 +3,50 @@ let identifier = "2021-06-29"
let migrate_doc = "add tag and job_tag table"
let rollback_doc = "remove tag and job tag table"
open Grej.Infix
let tag =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE tag (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
tag VARCHAR(255) NOT NULL UNIQUE
)
|}
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE tag (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
tag VARCHAR(255) NOT NULL UNIQUE
)
|}
let job_tag =
Caqti_request.exec
Caqti_type.unit
{| CREATE TABLE job_tag (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
tag INTEGER NOT NULL,
value TEXT NOT NULL,
job INTEGER NOT NULL,
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE job_tag (
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
tag INTEGER NOT NULL,
value TEXT NOT NULL,
job INTEGER NOT NULL,
FOREIGN KEY(job) REFERENCES job(id),
FOREIGN KEY(tag) REFERENCES tag(id),
UNIQUE(tag, job)
)
|}
FOREIGN KEY(job) REFERENCES job(id),
FOREIGN KEY(tag) REFERENCES tag(id),
UNIQUE(tag, job)
)
|}
let jobs =
Caqti_request.collect
Caqti_type.unit
Builder_db.Rep.untyped_id
"SELECT id FROM job"
Caqti_type.unit ->* Builder_db.Rep.untyped_id @@
"SELECT id FROM job"
let latest_successful_build =
Caqti_request.find_opt
Builder_db.Rep.untyped_id
Builder_db.Rep.untyped_id
{| SELECT b.id
FROM build b
WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0
ORDER BY b.start_d DESC, b.start_ps DESC
LIMIT 1
|}
Builder_db.Rep.untyped_id ->? Builder_db.Rep.untyped_id @@
{| SELECT b.id
FROM build b
WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0
ORDER BY b.start_d DESC, b.start_ps DESC
LIMIT 1
|}
let build_artifacts =
Caqti_request.collect
Builder_db.Rep.untyped_id
Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath)
{| SELECT a.filepath, a.localpath
FROM build_artifact a
WHERE a.build = ?
|}
Builder_db.Rep.untyped_id ->*
Caqti_type.tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath @@
{| SELECT a.filepath, a.localpath
FROM build_artifact a
WHERE a.build = ?
|}
let infer_section_and_synopsis artifacts =
@ -99,32 +94,25 @@ let infer_section_and_synopsis artifacts =
Some section, infer_synopsis_and_descr opam_switch
let remove_tag =
Caqti_request.exec
Caqti_type.unit
"DROP TABLE tag"
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE tag"
let remove_job_tag =
Caqti_request.exec
Caqti_type.unit
"DROP TABLE job_tag"
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE job_tag"
let insert_tag =
Caqti_request.exec
Caqti_type.string
"INSERT INTO tag (tag) VALUES (?)"
Caqti_type.string ->. Caqti_type.unit @@
"INSERT INTO tag (tag) VALUES (?)"
let insert_job_tag =