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

Migration code, model aware of main binary

Browse source 
Sqlite3 application_id and user_version are now set to identify the
database is a builder-web database, and the user_version represents the
schema version.

The 'build' table is extended with a 'main_binary' column. This
represents the main binary artifact from the build. This is decided by
there being exactly one file in bin/.

A migration tool is written that does both migrations and rollbacks, and
migration and rollback is implemented for the above mentioned change.
This commit is contained in:
Reynir Björnsson 2021-01-27 21:25:51 +01:00
parent a936915b74
commit 56737ec71b
8 changed files with 328 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

87
bin/migrations/builder_migrations.ml Normal file
View file

@ -0,0 +1,87 @@
open Rresult.R.Infix
let pp_error ppf = function
| #Caqti_error.load_or_connect | #Caqti_error.call_or_retrieve as e ->
Caqti_error.pp ppf e
| `Wrong_version (application_id, user_version) ->
Format.fprintf ppf "wrong version { application_id: %ld, user_version: %Ld }"
application_id user_version
let or_die exit_code = function
| Ok r -> r
| Error e ->
Format.eprintf "Database error: %a" pp_error e;
exit exit_code
let do_database_action action () dbpath =
Logs.debug (fun m -> m "Connecting to database...");
let ((module Db : Caqti_blocking.CONNECTION) as conn) =
Caqti_blocking.connect
(Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
|> or_die 1
in
Logs.debug (fun m -> m "Connected!");
let r =
Db.start () >>= fun () ->
Logs.debug (fun m -> m "Started database transaction");
match action conn with
| Ok () ->
Logs.debug (fun m -> m "Committing database transaction");
Db.commit ()
| Error _ as e ->
Logs.debug (fun m -> m "Rolling back database transaction");
Db.rollback () >>= fun () ->
e
in
or_die 2 r
let help man_format migrations = function
| None -> `Help (man_format, None)
| Some migration ->
if List.mem migration migrations
then `Help (man_format, Some migration)
else `Error (true, "Unknown migration: " ^ migration)
let dbpath =
let doc = "sqlite3 database path" in
Cmdliner.Arg.(value &
opt non_dir_file "/var/db/builder-web/builder.sqlite3" &
info ~doc ["dbpath"])
let setup_log =
let setup_log level =
Logs.set_level level;
Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ());
in
Cmdliner.Term.(const setup_log $ Logs_cli.level ())
let m20210126 =
let doc = "Adds a column 'main_binary' in 'build' (2021-01-26)" in
Cmdliner.Term.(const do_database_action $ const M20210126.migrate $ setup_log $ dbpath),
Cmdliner.Term.info ~doc "migrate-2021-01-26"
let r20210126 =
let doc = "Rollback 'main_binary' in 'build' (2021-01-26)" in
Cmdliner.Term.(const do_database_action $ const M20210126.rollback $ setup_log $ dbpath),
Cmdliner.Term.info ~doc "rollback-2021-01-26"
let help_cmd =
let topic =
let doc = "Migration to get help on" in
Cmdliner.Arg.(value & pos 0 (some string) None & info ~doc ~docv:"MIGRATION" [])
in
let doc = "Builder migration help" in
Cmdliner.Term.(ret (const help $ man_format $ choice_names $ topic)),
Cmdliner.Term.info ~doc "help"
let default_cmd =
let doc = "Builder migration command" in
Cmdliner.Term.(ret (const help $ man_format $ choice_names $ const None)),
Cmdliner.Term.info ~doc "builder-migrations"
let () =
Cmdliner.Term.eval_choice
default_cmd
[help_cmd;
m20210126; r20210126]
|> Cmdliner.Term.exit

4
bin/migrations/dune Normal file
View file

@ -0,0 +1,4 @@
(executable
(public_name builder-migrations)
(name builder_migrations)
(libraries builder_db caqti caqti-driver-sqlite3 caqti.blocking cmdliner logs logs.cli logs.fmt ))

110
bin/migrations/m20210126.ml Normal file
View file

@ -0,0 +1,110 @@
let new_user_version =
1L
let set_application_id =
Caqti_request.exec
Caqti_type.unit
(Printf.sprintf "PRAGMA application_id = %ld" Builder_db.application_id)
let set_version version =
Caqti_request.exec ~oneshot:true
Caqti_type.unit
(Printf.sprintf "PRAGMA user_version = %Ld" version)
let alter_build =
Caqti_request.exec ~oneshot:true
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"
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/%'"
let set_main_binary =
Caqti_request.exec ~oneshot:true
Caqti_type.(tup2 int64 (option string))
"UPDATE build SET main_binary = ?2 WHERE id = ?1"
let migrate (module Db : Caqti_blocking.CONNECTION) =
let open Rresult.R.Infix in
Db.find Builder_db.get_application_id () >>= fun application_id ->
Db.find Builder_db.get_version () >>= fun user_version ->
if application_id <> 0l || user_version <> 0L
then
Error (`Wrong_version (application_id, user_version))
else
Db.exec alter_build () >>= fun () ->
Db.collect_list all_builds () >>= fun builds ->
List.fold_left (fun r build ->
r >>= fun () ->
Db.collect_list bin_artifact build >>= function
| [_id, main_binary] ->
Db.exec set_main_binary (build, Some main_binary)
| [] ->
Logs.debug (fun m -> m "No binaries for build id %Ld" build);
Ok ()
| binaries ->
Logs.warn (fun m -> m "More than one binary for build id %Ld" build);
Logs.debug (fun m -> m "binaries: [%a]" Fmt.(list ~sep:(any ";") string)
(List.map snd binaries));
Ok ())
(Ok ())
builds >>= fun () ->
Db.exec Builder_db.set_application_id () >>= fun () ->
Db.exec (set_version new_user_version) ()
let rename_build =
Caqti_request.exec
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,
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
|}
let rollback (module Db : Caqti_blocking.CONNECTION) =
let open Rresult.R.Infix in
Db.find Builder_db.get_application_id () >>= fun application_id ->
Db.find Builder_db.get_version () >>= fun user_version ->
if application_id <> Builder_db.application_id || user_version <> new_user_version
then
Error (`Wrong_version (application_id, user_version))
else
Db.exec rename_build () >>= fun () ->
Db.exec create_build () >>= fun () ->
Db.exec rollback_data () >>= fun () ->
Db.exec (set_version 0L) ()

90
db/builder_db.ml
View file

@ -1,6 +1,11 @@
module Rep = Representation
open Rep
let application_id = 1234839235l
(* Please update this when making changes! *)
let current_version = 1L
type id = Rep.id
type file = {
@ -22,6 +27,29 @@ let last_insert_rowid =
id
"SELECT 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
@ -87,11 +115,21 @@ module Build_artifact = struct
Caqti_type.unit
"DROP TABLE IF EXISTS build_artifact"
let get_by_build =
Caqti_request.find
(Caqti_type.tup2 id fpath)
(Caqti_type.tup2 id file)
{| SELECT id, filepath, localpath, sha256
FROM build_artifact
WHERE build = ? AND filepath = ?
|}
let get_by_build_uuid =
Caqti_request.find_opt
(Caqti_type.tup2 uuid fpath)
(Caqti_type.tup2 fpath cstruct)
{| SELECT build_artifact.localpath, build_artifact.sha256
(Caqti_type.tup2 id file)
{| SELECT build_artifact.id, build_artifact.filepath,
build_artifact.localpath, build_artifact.sha256
FROM build_artifact
INNER JOIN build ON build.id = build_artifact.build
WHERE build.uuid = ? AND build_artifact.filepath = ?
@ -176,6 +214,7 @@ module Build = struct
result : Builder.execution_result;
console : (int * string) list;
script : string;
main_binary : Fpath.t option;
job_id : id;
}
@ -190,14 +229,16 @@ module Build = struct
(tup2
execution_result
console)
string)
(tup2
string
(option Rep.fpath)))
id)
in
let encode { uuid; start; finish; result; console; script; job_id } =
Ok ((uuid, (start, finish), (result, console), script), job_id)
let encode { uuid; start; finish; result; console; script; main_binary; job_id } =
Ok ((uuid, (start, finish), (result, console), (script, main_binary)), job_id)
in
let decode ((uuid, (start, finish), (result, console), script), job_id) =
Ok { uuid; start; finish; result; console; script; job_id }
let decode ((uuid, (start, finish), (result, console), (script, main_binary)), job_id) =
Ok { uuid; start; finish; result; console; script; main_binary; job_id }
in
Caqti_type.custom ~encode ~decode rep
@ -207,6 +248,7 @@ module Build = struct
start : Ptime.t;
finish : Ptime.t;
result : Builder.execution_result;
main_binary : Fpath.t option;
job_id : id;
}
@ -215,16 +257,18 @@ module Build = struct
Caqti_type.(tup2
(tup4
uuid
(tup2
Rep.ptime
Rep.ptime
execution_result)
Rep.ptime)
execution_result
(option Rep.fpath))
id)
in
let encode { uuid; start; finish; result; job_id } =
Ok ((uuid, start, finish, result), job_id)
let encode { uuid; start; finish; result; main_binary; job_id } =
Ok ((uuid, (start, finish), result, main_binary), job_id)
in
let decode ((uuid, start, finish, result), job_id) =
Ok { uuid; start; finish; result; job_id }
let decode ((uuid, (start, finish), result, main_binary), job_id) =
Ok { uuid; start; finish; result; main_binary; job_id }
in
Caqti_type.custom ~encode ~decode rep
end
@ -244,6 +288,7 @@ module Build = struct
result_msg TEXT,
console BLOB NOT NULL,
script TEXT NOT NULL,
main_binary TEXT,
job INTEGER NOT NULL,
FOREIGN KEY(job) REFERENCES job(id)
@ -261,7 +306,7 @@ module Build = struct
t
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg,
console, script, job
console, script, main_binary, job
FROM build
WHERE id = ?
|}
@ -272,7 +317,7 @@ module Build = struct
(Caqti_type.tup2 id t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg,
console, script, job
console, script, main_binary, job
FROM build
WHERE uuid = ?
|}
@ -283,7 +328,7 @@ module Build = struct
(Caqti_type.tup2 id t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console,
script, job
script, main_binary, job
FROM build
WHERE job = ?
ORDER BY start_d DESC, start_ps DESC
@ -295,7 +340,7 @@ module Build = struct
(Caqti_type.tup2
id Meta.t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, job
result_kind, result_code, result_msg, main_binary, job
FROM build
WHERE job = ?
ORDER BY start_d DESC, start_ps DESC
@ -308,7 +353,8 @@ module Build = struct
id Meta.t)
{| 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.job
build.result_kind, build.result_code, build.result_msg,
build.main_binary, build.job
FROM build, job
WHERE job.name = ? AND build.job = job.id
ORDER BY start_d DESC, start_ps DESC
@ -320,7 +366,7 @@ module Build = struct
t
{| INSERT INTO build
(uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console, script, job)
result_kind, result_code, result_msg, console, script, main_binary, job)
VALUES
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
|}
@ -394,6 +440,8 @@ let migrate = [
Build_artifact.migrate;
Build_file.migrate;
User.migrate;
set_current_version;
set_application_id;
]
let rollback = [
@ -402,4 +450,8 @@ let rollback = [
Build_artifact.rollback;
Build.rollback;
Job.rollback;
Caqti_request.exec Caqti_type.unit
"PRAGMA user_version = 0";
Caqti_request.exec Caqti_type.unit
"PRAGMA application_id = 0";
]

24
db/builder_db.mli
View file

@ -7,6 +7,22 @@ type file = {
}
val file : file Caqti_type.t
val application_id : int32
val current_version : int64
val get_application_id :
(unit, int32, [< `Many | `One | `Zero > `One ]) Caqti_request.t
val set_application_id :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_version :
(unit, int64, [< `Many | `One | `Zero > `One ]) Caqti_request.t
val set_current_version :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val last_insert_rowid :
(unit, id, [< `Many | `One | `Zero > `One ]) Caqti_request.t
@ -35,8 +51,12 @@ module Build_artifact : sig
val rollback :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_by_build :
(id * Fpath.t, id * file,
[< `Many | `One | `Zero > `One ]) Caqti_request.t
val get_by_build_uuid :
(Uuidm.t * Fpath.t, Fpath.t * Cstruct.t,
(Uuidm.t * Fpath.t, id * file,
[< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t
val get_all_by_build :
@ -74,6 +94,7 @@ sig
result : Builder.execution_result;
console : (int * string) list;
script : string;
main_binary : Fpath.t option;
job_id : id;
}
module Meta :
@ -83,6 +104,7 @@ sig
start : Ptime.t;
finish : Ptime.t;
result : Builder.execution_result;
main_binary : Fpath.t option;
job_id : id;
}
end

31
lib/model.ml
View file

@ -32,8 +32,8 @@ let read_file filepath =
let build_artifact build filepath (module Db : CONN) =
Db.find_opt Builder_db.Build_artifact.get_by_build_uuid (build, filepath)
>>= function
| Some (localpath, sha256) ->
read_file localpath >|= fun data -> data, sha256
| Some (_id, file) ->
read_file file.Builder_db.localpath >|= fun data -> data, file.Builder_db.sha256
| None ->
Lwt.return_error `Not_found
@ -49,6 +49,13 @@ let build_exists uuid (module Db : CONN) =
Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
Option.is_some
let main_binary id { Builder_db.Build.main_binary; _ } (module Db : CONN) =
match main_binary with
| None -> Lwt_result.return None
| Some main_binary ->
Db.find Builder_db.Build_artifact.get_by_build (id, main_binary) >|= fun (_id, file) ->
Some file
let job job (module Db : CONN) =
Db.collect_list Builder_db.Build.get_all_meta_by_name job
@ -115,10 +122,28 @@ let add_build
let open Builder_db in
let job_name = job.Builder.name in
save_all basedir exec >>= fun (artifacts, input_files) ->
let main_binary =
match List.find_all
(fun file ->
Fpath.is_prefix
(Fpath.v "bin/")
file.Builder_db.filepath)
artifacts with
| [ main_binary ] -> Some main_binary.localpath
| [] ->
Log.debug (fun m -> m "Zero binaries for build %a" Uuidm.pp uuid);
None
| binaries ->
Log.debug (fun m -> m "Multiple binaries for build %a: %a" Uuidm.pp uuid
Fmt.(list ~sep:(any ",") Fpath.pp)
(List.map (fun f -> f.filepath) binaries));
None
in
Db.exec Job.try_add job_name >>= fun () ->
Db.find Job.get_id_by_name job_name >>= fun job_id ->
Db.exec Build.add { Build.uuid; start; finish; result;
console; script = job.Builder.script; job_id } >>= fun () ->
console; script = job.Builder.script;
main_binary; job_id } >>= fun () ->
Db.find last_insert_rowid () >>= fun id ->
List.fold_left
(fun r file ->

3
lib/model.mli
View file

@ -14,6 +14,9 @@ val build : Uuidm.t -> Caqti_lwt.connection ->
val build_exists : Uuidm.t -> Caqti_lwt.connection ->
(bool, [> error ]) result Lwt.t
val main_binary : Builder_db.id -> Builder_db.Build.t -> Caqti_lwt.connection ->
(Builder_db.file option, [> error ]) result Lwt.t
val job : string -> Caqti_lwt.connection ->
((Builder_db.id * Builder_db.Build.Meta.t) list, [> error ]) result Lwt.t

2
lib/views.ml
View file

@ -116,7 +116,7 @@ let job name builds =
let job_build
name
{ Builder_db.Build.uuid = _; start; finish; result; console; script; job_id = _ }
{ Builder_db.Build.uuid = _; start; finish; result; console; script; main_binary = _; job_id = _ }
artifacts
=
let ptime_pp = Ptime.pp_human () in