module Rep = Representation open Rep let application_id = 1234839235l (* Please update this when making changes! *) let current_version = 12L type 'a id = 'a Rep.id type file = Rep.file = { filepath : Fpath.t; localpath : Fpath.t; sha256 : Cstruct.t; size : int; } let last_insert_rowid = Rep.last_insert_rowid let get_application_id = Caqti_request.find Caqti_type.unit Caqti_type.int32 "PRAGMA application_id" let get_version = Caqti_request.find Caqti_type.unit Caqti_type.int64 "PRAGMA user_version" let set_application_id = Caqti_request.exec Caqti_type.unit (Printf.sprintf "PRAGMA application_id = %ld" application_id) let set_current_version = Caqti_request.exec Caqti_type.unit (Printf.sprintf "PRAGMA user_version = %Ld" current_version) module Job = struct let migrate = Caqti_request.exec Caqti_type.unit {| CREATE TABLE job ( id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, name VARCHAR(255) NOT NULL UNIQUE ) |} let rollback = Caqti_request.exec Caqti_type.unit {| DROP TABLE IF EXISTS job |} let get = Caqti_request.find (id `job) Caqti_type.string "SELECT name FROM job WHERE id = ?" let get_id_by_name = Caqti_request.find_opt Caqti_type.string (id `job) "SELECT id FROM job WHERE name = ?" let get_all = Caqti_request.collect Caqti_type.unit Caqti_type.(tup2 (id `job) string) "SELECT id, name FROM job ORDER BY name ASC" let get_all_with_section_synopsis = Caqti_request.collect Caqti_type.unit Caqti_type.(tup4 (id `job) string (option string) (option string)) {| SELECT j.id, j.name, section.value, synopsis.value FROM job j, tag section_tag, tag synopsis_tag LEFT JOIN job_tag section ON section.job = j.id AND section.tag = section_tag.id LEFT JOIN job_tag synopsis ON synopsis.job = j.id AND synopsis.tag = synopsis_tag.id WHERE section_tag.tag = 'section' AND synopsis_tag.tag = 'synopsis' ORDER BY section.value, j.name ASC |} let try_add = Caqti_request.exec Caqti_type.string "INSERT OR IGNORE INTO job (name) VALUES (?)" let remove = Caqti_request.exec (id `job) "DELETE FROM job WHERE id = ?" end module Tag = struct let migrate = Caqti_request.exec Caqti_type.unit {| CREATE TABLE tag ( id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, tag VARCHAR(255) NOT NULL UNIQUE ) |} let rollback = Caqti_request.exec Caqti_type.unit "DROP TABLE IF EXISTS tag" let get = Caqti_request.find (id `tag) Caqti_type.string "SELECT tag FROM tag WHERE id = ?" let get_id_by_name = Caqti_request.find Caqti_type.string (id `tag) "SELECT id FROM tag WHERE tag = ?" let try_add = Caqti_request.exec Caqti_type.string "INSERT OR IGNORE INTO tag (tag) VALUES (?)" end module Job_tag = struct let migrate = 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, FOREIGN KEY(job) REFERENCES job(id), FOREIGN KEY(tag) REFERENCES tag(id), UNIQUE(tag, job) ) |} let rollback = Caqti_request.exec Caqti_type.unit "DROP TABLE IF EXISTS job_tag" let add = Caqti_request.exec Caqti_type.(tup3 (id `tag) string (id `job)) "INSERT INTO job_tag (tag, value, job) VALUES (?1, ?2, ?3)" let update = Caqti_request.exec Caqti_type.(tup3 (id `tag) string (id `job)) "UPDATE job_tag SET value = ?2 WHERE tag = ?1 AND job = ?3" let get_value = Caqti_request.find_opt Caqti_type.(tup2 (id `tag) (id `job)) Caqti_type.string "SELECT value FROM job_tag WHERE tag = ? AND job = ?" end module Build_artifact = struct let migrate = Caqti_request.exec Caqti_type.unit {| CREATE TABLE 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 rollback = Caqti_request.exec Caqti_type.unit "DROP TABLE IF EXISTS build_artifact" let get_by_build = Caqti_request.find (Caqti_type.tup2 (id `build) fpath) (Caqti_type.tup2 (id `build_artifact) file) {| SELECT id, filepath, localpath, sha256, size FROM build_artifact WHERE build = ? AND filepath = ? |} let get_by_build_uuid = Caqti_request.find_opt (Caqti_type.tup2 uuid fpath) (Caqti_type.tup2 (id `build_artifact) file) {| SELECT build_artifact.id, build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size FROM build_artifact INNER JOIN build ON build.id = build_artifact.build WHERE build.uuid = ? AND build_artifact.filepath = ? |} let get_all_by_build = Caqti_request.collect (id `build) Caqti_type.(tup2 (id `build_artifact) file) "SELECT id, filepath, localpath, sha256, size FROM build_artifact WHERE build = ?" let add = Caqti_request.exec Caqti_type.(tup2 file (id `build)) "INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)" let remove_by_build = Caqti_request.exec (id `build) "DELETE FROM build_artifact WHERE build = ?" let remove = Caqti_request.exec (id `build_artifact) "DELETE FROM build_artifact WHERE id = ?" end module Build = struct type t = { uuid : Uuidm.t; start : Ptime.t; finish : Ptime.t; result : Builder.execution_result; console : (int * string) list; script : string; main_binary : [`build_artifact] id option; user_id : [`user] id; job_id : [`job] id; } let t = let rep = Caqti_type.(tup3 (tup4 uuid (tup2 Rep.ptime Rep.ptime) (tup2 execution_result console) (tup2 string (option (Rep.id `build_artifact)))) (id `user) (id `job)) in let encode { uuid; start; finish; result; console; script; main_binary; user_id; job_id } = Ok ((uuid, (start, finish), (result, console), (script, main_binary)), user_id, job_id) in let decode ((uuid, (start, finish), (result, console), (script, main_binary)), user_id, job_id) = Ok { uuid; start; finish; result; console; script; main_binary; user_id; job_id } in Caqti_type.custom ~encode ~decode rep module Meta = struct type t = { uuid : Uuidm.t; start : Ptime.t; finish : Ptime.t; result : Builder.execution_result; main_binary : [`build_artifact] id option; user_id : [`user] id; job_id : [`job] id; } let t = let rep = Caqti_type.(tup3 (tup4 uuid (tup2 Rep.ptime Rep.ptime) execution_result (option (Rep.id `build_artifact))) (id `user) (id `job)) in let encode { uuid; start; finish; result; main_binary; user_id; job_id } = Ok ((uuid, (start, finish), result, main_binary), user_id, job_id) in let decode ((uuid, (start, finish), result, main_binary), user_id, job_id) = Ok { uuid; start; finish; result; main_binary; user_id; job_id } in Caqti_type.custom ~encode ~decode rep end let migrate = 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, main_binary INTEGER, user INTEGER NOT NULL, job INTEGER NOT NULL, input_id BLOB, -- sha256 (sha256 || sha256 || sha256) FOREIGN KEY(main_binary) REFERENCES build_artifact(id) DEFERRABLE INITIALLY DEFERRED, FOREIGN KEY(user) REFERENCES user(id), FOREIGN KEY(job) REFERENCES job(id) ) |} let rollback = Caqti_request.exec Caqti_type.unit {| DROP TABLE IF EXISTS build |} let get_opt = Caqti_request.find_opt (id `build) t {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, user, job FROM build WHERE id = ? |} let get_by_uuid = Caqti_request.find_opt Rep.uuid (Caqti_type.tup2 (id `build) t) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, user, job FROM build WHERE uuid = ? |} let get_all = Caqti_request.collect (id `job) (Caqti_type.tup2 (id `build) t) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, user, job FROM build WHERE job = ? ORDER BY start_d DESC, start_ps DESC |} let get_all_meta = Caqti_request.collect (id `job) (Caqti_type.tup3 (id `build) Meta.t file_opt) {| SELECT build.id, build.uuid, build.start_d, build.start_ps, build.finish_d, build.finish_ps, build.result_kind, build.result_code, build.result_msg, build.main_binary, build.user, build.job, build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size FROM build, job LEFT JOIN build_artifact ON build.main_binary = build_artifact.id WHERE job.id = ? AND build.job = job.id ORDER BY start_d DESC, start_ps DESC |} let get_latest = Caqti_request.find_opt (id `job) Caqti_type.(tup3 (id `build) Meta.t file_opt) {| SELECT b.id, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_kind, b.result_code, b.result_msg, b.main_binary, b.user, b.job, a.filepath, a.localpath, a.sha256, a.size FROM build b LEFT JOIN build_artifact a ON b.main_binary = a.id WHERE b.job = ? ORDER BY start_d DESC, start_ps DESC LIMIT 1 |} let get_latest_uuid = Caqti_request.find_opt (id `job) Caqti_type.(tup2 (id `build) Rep.uuid) {| SELECT b.id, b.uuid FROM build b WHERE b.job = ? ORDER BY start_d DESC, start_ps DESC LIMIT 1 |} let get_latest_successful_uuid = Caqti_request.find_opt (id `job) Rep.uuid {| SELECT b.uuid FROM build b WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0 ORDER BY start_d DESC, start_ps DESC LIMIT 1 |} let get_previous_successful = Caqti_request.find_opt (id `build) Caqti_type.(tup2 (id `build) Meta.t) {| SELECT b.id, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_kind, b.result_code, b.result_msg, b.main_binary, b.user, b.job FROM build b, build b0 WHERE b0.id = ? AND b0.job = b.job AND b.result_kind = 0 AND b.result_code = 0 AND (b0.start_d > b.start_d OR b0.start_d = b.start_d AND b0.start_ps > b.start_ps) ORDER BY b.start_d DESC, b.start_ps DESC LIMIT 1 |} let get_other_builds_with_same_output = Caqti_request.collect (id `build) Meta.t {| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_kind, b.result_code, b.result_msg, b.main_binary, b.user, b.job FROM build b0, build_artifact a0, build b, build_artifact a WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 = a.sha256 AND b.main_binary = a.id AND b.id <> b0.id ORDER BY b.start_d DESC, b.start_ps DESC |} let add = Caqti_request.exec (Caqti_type.tup2 t (Caqti_type.option cstruct)) {| INSERT INTO build (uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, main_binary, user, job, input_id) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |} let get_by_hash = Caqti_request.find_opt Rep.cstruct (Caqti_type.tup2 Caqti_type.string t) {| SELECT job.name, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_kind, b.result_code, b.result_msg, b.console, b.script, b.main_binary, b.user, b.job FROM build_artifact a INNER JOIN build b ON b.id = a.build INNER JOIN job ON job.id = b.job WHERE a.sha256 = ? ORDER BY b.start_d DESC, b.start_ps DESC LIMIT 1 |} let set_main_binary = Caqti_request.exec (Caqti_type.tup2 (id `build) (id `build_artifact)) "UPDATE build SET main_binary = ?2 WHERE id = ?1" let remove = Caqti_request.exec (id `build) "DELETE FROM build WHERE id = ?" end module User = struct let migrate = 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, scrypt_n INTEGER NOT NULL, scrypt_r INTEGER NOT NULL, scrypt_p INTEGER NOT NULL, restricted BOOLEAN NOT NULL ) |} let rollback = Caqti_request.exec Caqti_type.unit "DROP TABLE IF EXISTS user" let get_user = Caqti_request.find_opt Caqti_type.string (Caqti_type.tup2 (id `user) user_info) {| SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted FROM user WHERE username = ? |} let get_all = Caqti_request.collect Caqti_type.unit Caqti_type.string "SELECT username FROM user" let add = Caqti_request.exec user_info {| INSERT INTO user (username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) VALUES (?, ?, ?, ?, ?, ?, ?) |} let remove = Caqti_request.exec (id `user) "DELETE FROM user WHERE id = ?" let remove_user = Caqti_request.exec Caqti_type.string "DELETE FROM user WHERE username = ?" let update_user = Caqti_request.exec user_info {| UPDATE user SET password_hash = ?2, password_salt = ?3, scrypt_n = ?4, scrypt_r = ?5, scrypt_p = ?6, restricted = ?7 WHERE username = ?1 |} end module Access_list = struct let migrate = 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, FOREIGN KEY(user) REFERENCES user(id), FOREIGN KEY(job) REFERENCES job(id), UNIQUE(user, job) ) |} let rollback = Caqti_request.exec Caqti_type.unit "DROP TABLE IF EXISTS access_list" let get = Caqti_request.find Caqti_type.(tup2 (id `user) (id `job)) (id `access_list) "SELECT id FROM access_list WHERE user = ? AND job = ?" let add = Caqti_request.exec Caqti_type.(tup2 (id `user) (id `job)) "INSERT INTO access_list (user, job) VALUES (?, ?)" let remove = Caqti_request.exec Caqti_type.(tup2 (id `user) (id `job)) "DELETE FROM access_list WHERE user = ? AND job = ?" let remove_all_by_username = Caqti_request.exec Caqti_type.string "DELETE FROM access_list, user WHERE access_list.user = user.id AND user.username = ?" end let migrate = [ Job.migrate; Build.migrate; Build_artifact.migrate; User.migrate; Access_list.migrate; Tag.migrate; Job_tag.migrate; Caqti_request.exec Caqti_type.unit "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"; set_current_version; set_application_id; ] let rollback = [ Job_tag.rollback; Tag.rollback; Access_list.rollback; User.rollback; Build_artifact.rollback; Build.rollback; Job.rollback; Caqti_request.exec Caqti_type.unit "DROP INDEX IF EXISTS idx_build_job_start"; Caqti_request.exec Caqti_type.unit "PRAGMA user_version = 0"; Caqti_request.exec Caqti_type.unit "PRAGMA application_id = 0"; ]