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

in /job/:job/build/:build output links to:

Browse source 
- builds that reproduced the binary with the same inputs
- builds that reproduced the binary with different inputs (only one for each input_id)
- builds with same input that produced a different output

/job/:job group by hash
This commit is contained in:
Robur 2021-07-08 11:33:27 +00:00
parent e8f918230f
commit aa4db9b6a8
7 changed files with 216 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

145
db/builder_db.ml
View file

@ -242,6 +242,7 @@ module Build = struct
console : (int * string) list; console : (int * string) list;
script : string; script : string;
main_binary : [`build_artifact] id option; main_binary : [`build_artifact] id option;
input_id : Cstruct.t option;
user_id : [`user] id; user_id : [`user] id;
job_id : [`job] id; job_id : [`job] id;
} }
@ -257,17 +258,18 @@ module Build = struct
(tup2 (tup2
execution_result execution_result
console) console)
(tup2 (tup3
string string
(option (Rep.id `build_artifact)))) (option (Rep.id `build_artifact))
(option Rep.cstruct)))
(id `user) (id `user)
(id `job)) (id `job))
in in
let encode { uuid; start; finish; result; console; script; main_binary; user_id; job_id } = let encode { uuid; start; finish; result; console; script; main_binary; input_id; user_id; job_id } =
Ok ((uuid, (start, finish), (result, console), (script, main_binary)), user_id, job_id) Ok ((uuid, (start, finish), (result, console), (script, main_binary, input_id)), user_id, job_id)
in in
let decode ((uuid, (start, finish), (result, console), (script, main_binary)), user_id, job_id) = let decode ((uuid, (start, finish), (result, console), (script, main_binary, input_id)), user_id, job_id) =
Ok { uuid; start; finish; result; console; script; main_binary; user_id; job_id } Ok { uuid; start; finish; result; console; script; main_binary; input_id; user_id; job_id }
in in
Caqti_type.custom ~encode ~decode rep Caqti_type.custom ~encode ~decode rep
@ -278,6 +280,7 @@ module Build = struct
finish : Ptime.t; finish : Ptime.t;
result : Builder.execution_result; result : Builder.execution_result;
main_binary : [`build_artifact] id option; main_binary : [`build_artifact] id option;
input_id : Cstruct.t option;
user_id : [`user] id; user_id : [`user] id;
job_id : [`job] id; job_id : [`job] id;
} }
@ -291,15 +294,17 @@ module Build = struct
Rep.ptime Rep.ptime
Rep.ptime) Rep.ptime)
execution_result execution_result
(option (Rep.id `build_artifact))) (tup2
(option (Rep.id `build_artifact))
(option Rep.cstruct)))
(id `user) (id `user)
(id `job)) (id `job))
in in
let encode { uuid; start; finish; result; main_binary; user_id; job_id } = let encode { uuid; start; finish; result; main_binary; input_id; user_id; job_id } =
Ok ((uuid, (start, finish), result, main_binary), user_id, job_id) Ok ((uuid, (start, finish), result, (main_binary, input_id)), user_id, job_id)
in in
let decode ((uuid, (start, finish), result, main_binary), user_id, job_id) = let decode ((uuid, (start, finish), result, (main_binary, input_id)), user_id, job_id) =
Ok { uuid; start; finish; result; main_binary; user_id; job_id } Ok { uuid; start; finish; result; main_binary; input_id; user_id; job_id }
in in
Caqti_type.custom ~encode ~decode rep Caqti_type.custom ~encode ~decode rep
end end
@ -341,7 +346,7 @@ module Build = struct
t t
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps, {| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, result_kind, result_code, result_msg,
console, script, main_binary, user, job console, script, main_binary, input_id, user, job
FROM build FROM build
WHERE id = ? WHERE id = ?
|} |}
@ -352,7 +357,7 @@ module Build = struct
(Caqti_type.tup2 (id `build) t) (Caqti_type.tup2 (id `build) t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, result_kind, result_code, result_msg,
console, script, main_binary, user, job console, script, main_binary, input_id, user, job
FROM build FROM build
WHERE uuid = ? WHERE uuid = ?
|} |}
@ -363,7 +368,7 @@ module Build = struct
(Caqti_type.tup2 (id `build) t) (Caqti_type.tup2 (id `build) t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console, result_kind, result_code, result_msg, console,
script, main_binary, user, job script, main_binary, input_id, user, job
FROM build FROM build
WHERE job = ? WHERE job = ?
ORDER BY start_d DESC, start_ps DESC ORDER BY start_d DESC, start_ps DESC
@ -377,13 +382,36 @@ module Build = struct
{| SELECT build.id, build.uuid, {| SELECT build.id, build.uuid,
build.start_d, build.start_ps, build.finish_d, build.finish_ps, build.start_d, build.start_ps, build.finish_d, build.finish_ps,
build.result_kind, build.result_code, build.result_msg, build.result_kind, build.result_code, build.result_msg,
build.main_binary, build.user, build.job, build.main_binary, build.input_id, build.user, build.job,
build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size
FROM build, job FROM build, job
LEFT JOIN build_artifact ON LEFT JOIN build_artifact ON
build.main_binary = build_artifact.id build.main_binary = build_artifact.id
WHERE job.id = ? AND build.job = job.id WHERE job.id = ? AND build.job = job.id
ORDER BY build.start_d DESC, build.start_ps DESC
|}
let get_all_artifact_sha =
Caqti_request.collect
(id `job)
Rep.cstruct
{| SELECT DISTINCT a.sha256
FROM build_artifact a, build b
WHERE b.job = ? AND b.main_binary = a.id
ORDER BY b.start_d DESC, b.start_ps DESC
|}
let get_latest_failed =
Caqti_request.find_opt
(id `job)
Meta.t
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg,
main_binary, input_id, user, job
FROM build
WHERE job = ? AND result_kind <> 0 OR result_code <> 0
ORDER BY start_d DESC, start_ps DESC ORDER BY start_d DESC, start_ps DESC
LIMIT 1
|} |}
let get_latest = let get_latest =
@ -396,13 +424,13 @@ module Build = struct
{| SELECT b.id, {| SELECT b.id,
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_kind, b.result_code, b.result_msg, b.result_kind, b.result_code, b.result_msg,
b.main_binary, b.user, b.job, b.main_binary, b.input_id, b.user, b.job,
a.filepath, a.localpath, a.sha256, a.size a.filepath, a.localpath, a.sha256, a.size
FROM build b FROM build b
LEFT JOIN build_artifact a ON LEFT JOIN build_artifact a ON
b.main_binary = a.id b.main_binary = a.id
WHERE b.job = ? WHERE b.job = ?
ORDER BY start_d DESC, start_ps DESC ORDER BY b.start_d DESC, b.start_ps DESC
LIMIT 1 LIMIT 1
|} |}
@ -413,7 +441,7 @@ module Build = struct
{| SELECT b.id, b.uuid {| SELECT b.id, b.uuid
FROM build b FROM build b
WHERE b.job = ? WHERE b.job = ?
ORDER BY start_d DESC, start_ps DESC ORDER BY b.start_d DESC, b.start_ps DESC
LIMIT 1 LIMIT 1
|} |}
@ -424,7 +452,7 @@ module Build = struct
{| SELECT b.uuid {| SELECT b.uuid
FROM build b FROM build b
WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0 WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0
ORDER BY start_d DESC, start_ps DESC ORDER BY b.start_d DESC, b.start_ps DESC
LIMIT 1 LIMIT 1
|} |}
@ -435,7 +463,7 @@ module Build = struct
{| SELECT b.id, {| SELECT b.id,
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_kind, b.result_code, b.result_msg, b.result_kind, b.result_code, b.result_msg,
b.main_binary, b.user, b.job b.main_binary, b.input_id, b.user, b.job
FROM build b, build b0 FROM build b, build b0
WHERE b0.id = ? AND b0.job = b.job AND WHERE b0.id = ? AND b0.job = b.job AND
b.result_kind = 0 AND b.result_code = 0 AND b.result_kind = 0 AND b.result_code = 0 AND
@ -444,28 +472,93 @@ module Build = struct
LIMIT 1 LIMIT 1
|} |}
let get_other_builds_with_same_output = let get_same_input_same_output_builds =
Caqti_request.collect Caqti_request.collect
(id `build) (id `build)
Meta.t Meta.t
{| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, {| 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.result_kind, b.result_code, b.result_msg,
b.main_binary, b.user, b.job b.main_binary, b.input_id, b.user, b.job
FROM build b0, build_artifact a0, build b, build_artifact a 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 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 AND b0.input_id = b.input_id
ORDER BY b.start_d DESC, b.start_ps DESC ORDER BY b.start_d DESC, b.start_ps DESC
|} |}
let get_same_input_different_output_hashes =
Caqti_request.collect
(id `build)
Rep.cstruct
{| SELECT DISTINCT a.sha256
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 AND b0.input_id = b.input_id
ORDER BY b.start_d DESC, b.start_ps DESC
|}
let get_different_input_same_output_input_ids =
Caqti_request.collect
(id `build)
Rep.cstruct
{| SELECT DISTINCT b.input_id
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 b0.input_id <> b.input_id
|}
let get_one_by_input_id =
Caqti_request.find
Rep.cstruct
Meta.t
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg,
main_binary, input_id, user, job
FROM build
WHERE input_id = ?
ORDER BY start_d DESC, start_ps DESC
LIMIT 1
|}
let add = let add =
Caqti_request.exec Caqti_request.exec
(Caqti_type.tup2 t (Caqti_type.option cstruct)) t
{| INSERT INTO build {| INSERT INTO build
(uuid, start_d, start_ps, finish_d, finish_ps, (uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, console, script, main_binary, user, job, input_id) result_kind, result_code, result_msg, console, script, main_binary, input_id, user, job)
VALUES VALUES
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
|} |}
let get_meta_by_hash =
Caqti_request.find
Rep.cstruct
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.input_id, b.user, b.job
FROM build_artifact a
INNER JOIN build b ON b.id = a.build
WHERE a.sha256 = ?
ORDER BY b.start_d DESC, b.start_ps DESC
LIMIT 1
|}
let get_meta_and_artifact_by_hash =
Caqti_request.find
Rep.cstruct
(Caqti_type.tup2 Meta.t file_opt)
{| 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.input_id, b.user, b.job,
a.filepath, a.localpath, a.sha256, a.size
FROM build_artifact a
INNER JOIN build b ON b.id = a.build
WHERE a.sha256 = ?
ORDER BY b.start_d DESC, b.start_ps DESC
LIMIT 1
|}
let get_by_hash = let get_by_hash =
Caqti_request.find_opt Caqti_request.find_opt
Rep.cstruct Rep.cstruct
@ -475,7 +568,7 @@ module Build = struct
{| SELECT job.name, {| SELECT job.name,
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_kind, b.result_code, b.result_msg, b.result_kind, b.result_code, b.result_msg,
b.console, b.script, b.main_binary, b.user, b.job b.console, b.script, b.main_binary, b.input_id, b.user, b.job
FROM build_artifact a FROM build_artifact a
INNER JOIN build b ON b.id = a.build INNER JOIN build b ON b.id = a.build
INNER JOIN job ON job.id = b.job INNER JOIN job ON job.id = b.job

20
db/builder_db.mli
View file

@ -127,6 +127,7 @@ sig
console : (int * string) list; console : (int * string) list;
script : string; script : string;
main_binary : [`build_artifact] id option; main_binary : [`build_artifact] id option;
input_id : Cstruct.t option;
user_id : [`user] id; user_id : [`user] id;
job_id : [`job] id; job_id : [`job] id;
} }
@ -138,6 +139,7 @@ sig
finish : Ptime.t; finish : Ptime.t;
result : Builder.execution_result; result : Builder.execution_result;
main_binary : [`build_artifact] id option; main_binary : [`build_artifact] id option;
input_id : Cstruct.t option;
user_id : [`user] id; user_id : [`user] id;
job_id : [`job] id; job_id : [`job] id;
} }
@ -157,9 +159,13 @@ sig
([`job] id, [`build] id * t, [ `Many | `One | `Zero ]) Caqti_request.t ([`job] id, [`build] id * t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_meta : val get_all_meta :
([`job] id, [`build] id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t ([`job] id, [`build] id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_artifact_sha :
([`job] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_latest : val get_latest :
([`job] id, [`build] id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ]) ([`job] id, [`build] id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t Caqti_request.t
val get_latest_failed :
([`job] id, Meta.t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t
val get_latest_uuid : val get_latest_uuid :
([`job] id, [`build] id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) ([`job] id, [`build] id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t Caqti_request.t
@ -169,9 +175,19 @@ sig
val get_previous_successful : val get_previous_successful :
([`build] id, [`build] id * Meta.t, [< `Many | `One | `Zero > `One `Zero ]) ([`build] id, [`build] id * Meta.t, [< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t Caqti_request.t
val get_other_builds_with_same_output : val get_same_input_same_output_builds :
([`build] id, Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t ([`build] id, Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
val add : (t * Cstruct.t option, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_same_input_different_output_hashes :
([`build] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_different_input_same_output_input_ids :
([`build] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_one_by_input_id :
(Cstruct.t, Meta.t, [< `Many | `One | `Zero > `One ]) Caqti_request.t
val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_meta_by_hash :
(Cstruct.t, Meta.t, [< `Many | `One | `Zero > `One]) Caqti_request.t
val get_meta_and_artifact_by_hash :
(Cstruct.t, Meta.t * file option, [< `Many | `One | `Zero > `One]) Caqti_request.t
val get_by_hash : val get_by_hash :
(Cstruct.t, string * t, [< `Many | `One | `Zero > `One `Zero]) Caqti_request.t (Cstruct.t, string * t, [< `Many | `One | `Zero > `One `Zero]) Caqti_request.t
val set_main_binary : ([`build] id * [`build_artifact] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val set_main_binary : ([`build] id * [`build_artifact] id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t

13
lib/builder_web.ml
View file

@ -137,14 +137,15 @@ let add_routes datadir =
(Dream.sql req (Model.readme job_name) >>= fun readme -> (Dream.sql req (Model.readme job_name) >>= fun readme ->
Dream.sql req (Model.build uuid) >>= fun (build_id, build) -> Dream.sql req (Model.build uuid) >>= fun (build_id, build) ->
Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts -> Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts ->
Dream.sql req (Model.builds_with_same_main_binary build_id) >>= fun other_builds -> Dream.sql req (Model.builds_with_same_input_and_same_main_binary build_id) >>= fun same_input_same_output ->
Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid -> Dream.sql req (Model.builds_with_different_input_and_same_main_binary build_id) >>= fun different_input_same_output ->
Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build -> Dream.sql req (Model.builds_with_same_input_and_different_main_binary build_id) >>= fun same_input_different_output ->
(readme, build, artifacts, other_builds, latest_uuid, previous_build)) Dream.sql req (Model.latest_successful_build_uuid build.job_id) >|= fun latest_uuid ->
(readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid))
|> if_error "Error getting job build" |> if_error "Error getting job build"
~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e)) ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
>>= fun (readme, build, artifacts, other_builds, latest_uuid, previous_build) -> >>= fun (readme, build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest_uuid) ->
Views.job_build job_name readme build artifacts other_builds latest_uuid previous_build Views.job_build job_name readme build artifacts same_input_same_output different_input_same_output same_input_different_output latest_uuid
|> string_of_html |> Dream.html |> Lwt_result.ok |> string_of_html |> Dream.html |> Lwt_result.ok
in in

44
lib/model.ml
View file

@ -70,8 +70,29 @@ let previous_successful_build id (module Db : CONN) =
Db.find_opt Builder_db.Build.get_previous_successful id >|= Db.find_opt Builder_db.Build.get_previous_successful id >|=
Option.map (fun (_id, meta) -> meta) Option.map (fun (_id, meta) -> meta)
let builds_with_same_main_binary id (module Db : CONN) = let builds_with_different_input_and_same_main_binary id (module Db : CONN) =
Db.collect_list Builder_db.Build.get_other_builds_with_same_output id Db.collect_list Builder_db.Build.get_different_input_same_output_input_ids id >>= fun ids ->
Lwt_list.fold_left_s (fun acc input_id ->
match acc with
| Error _ as e -> Lwt.return e
| Ok metas ->
Db.find Builder_db.Build.get_one_by_input_id input_id >>= fun build ->
Lwt.return (Ok (build :: metas)))
(Ok []) ids
let builds_with_same_input_and_same_main_binary id (module Db : CONN) =
Db.collect_list Builder_db.Build.get_same_input_same_output_builds id
let builds_with_same_input_and_different_main_binary id (module Db : CONN) =
Db.collect_list Builder_db.Build.get_same_input_different_output_hashes id >>= fun hashes ->
Lwt_list.fold_left_s (fun acc hash ->
match acc with
| Error _ as e -> Lwt.return e
| Ok metas ->
Db.find Builder_db.Build.get_meta_by_hash hash >>= fun build ->
Lwt.return (Ok (build :: metas)))
(Ok []) hashes
let job_id job_name (module Db : CONN) = let job_id job_name (module Db : CONN) =
Db.find_opt Builder_db.Job.get_id_by_name job_name Db.find_opt Builder_db.Job.get_id_by_name job_name
@ -85,8 +106,19 @@ let job_and_readme job (module Db : CONN) =
job_id job (module Db) >>= not_found >>= fun job_id -> job_id job (module Db) >>= not_found >>= fun job_id ->
Db.find Builder_db.Tag.get_id_by_name "readme.md" >>= fun readme_id -> Db.find Builder_db.Tag.get_id_by_name "readme.md" >>= fun readme_id ->
Db.find_opt Builder_db.Job_tag.get_value (readme_id, job_id) >>= fun readme -> Db.find_opt Builder_db.Job_tag.get_value (readme_id, job_id) >>= fun readme ->
Db.collect_list Builder_db.Build.get_all_meta job_id >|= fun builds -> Db.find_opt Builder_db.Build.get_latest_failed job_id >>= fun failed ->
readme, List.map (fun (_id, meta, main_binary) -> (meta, main_binary)) builds Db.collect_list Builder_db.Build.get_all_artifact_sha job_id >>= fun sha ->
Lwt_list.fold_left_s (fun acc hash ->
match acc with
| Error _ as e -> Lwt.return e
| Ok (fail, metas) ->
Db.find Builder_db.Build.get_meta_and_artifact_by_hash hash >|= fun (meta, file) ->
match fail with
| Some f when Ptime.is_later ~than:meta.Builder_db.Build.Meta.start f.Builder_db.Build.Meta.start -> None, (meta, file) :: (f, None) :: metas
| x -> x, (meta, file) :: metas)
(Ok (failed, [])) sha >|= fun (x, builds) ->
let builds = match x with None -> builds | Some f -> (f, None) :: builds in
readme, List.rev builds
let jobs (module Db : CONN) = let jobs (module Db : CONN) =
Db.collect_list Builder_db.Job.get_all () Db.collect_list Builder_db.Job.get_all ()
@ -286,9 +318,9 @@ let add_build
Db.exec Tag.try_add readme_tag >>= fun () -> Db.exec Tag.try_add readme_tag >>= fun () ->
Db.find Tag.get_id_by_name readme_tag >>= fun readme_id -> Db.find Tag.get_id_by_name readme_tag >>= fun readme_id ->
let input_id = compute_input_id artifacts in let input_id = compute_input_id artifacts in
Db.exec Build.add ({ Build.uuid; start; finish; result; Db.exec Build.add { Build.uuid; start; finish; result;
console; script = job.Builder.script; console; script = job.Builder.script;
main_binary = None; user_id; job_id }, input_id) >>= fun () -> main_binary = None; input_id; user_id; job_id } >>= fun () ->
Db.find last_insert_rowid () >>= fun id -> Db.find last_insert_rowid () >>= fun id ->
let sec_syn = infer_section_and_synopsis raw_artifacts in let sec_syn = infer_section_and_synopsis raw_artifacts in
let add_or_update tag_id tag_value = let add_or_update tag_id tag_value =

8
lib/model.mli
View file

@ -39,7 +39,13 @@ val latest_successful_build_uuid : [`job] Builder_db.id -> Caqti_lwt.connection
val previous_successful_build : [`build] Builder_db.id -> Caqti_lwt.connection -> val previous_successful_build : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Builder_db.Build.Meta.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t (Builder_db.Build.Meta.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val builds_with_same_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection -> val builds_with_different_input_and_same_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Builder_db.Build.Meta.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val builds_with_same_input_and_same_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Builder_db.Build.Meta.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val builds_with_same_input_and_different_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Builder_db.Build.Meta.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t (Builder_db.Build.Meta.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val readme : string -> Caqti_lwt.connection -> val readme : string -> Caqti_lwt.connection ->

35
lib/views.ml
View file

@ -194,9 +194,8 @@ let job_build
readme readme
{ Builder_db.Build.uuid; start; finish; result; console; script; _ } { Builder_db.Build.uuid; start; finish; result; console; script; _ }
artifacts artifacts
other_builds same_input_same_output different_input_same_output same_input_different_output
latest_uuid latest_uuid
previous_build
= =
let delta = Ptime.diff finish start in let delta = Ptime.diff finish start in
let successful_build = match result with Builder.Exited 0 -> true | _ -> false in let successful_build = match result with Builder.Exited 0 -> true | _ -> false in
@ -214,8 +213,15 @@ let job_build
h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime start]; h2 ~a:[a_id "build"] [txtf "Build %a" pp_ptime start];
a ~a:[a_href "#readme"] [txt "Back to readme"]; a ~a:[a_href "#readme"] [txt "Back to readme"];
p [txtf "Build took %a." Ptime.Span.pp delta ]; p [txtf "Build took %a." Ptime.Span.pp delta ];
p [txtf "Execution result: %a." Builder.pp_execution_result result]; p [txtf "Execution result: %a." Builder.pp_execution_result result]; ] @
h3 [txt "Compare with other builds"]; (match same_input_same_output with [] -> [] | xs -> [
h3 [ txt "Reproduced by builds"] ;
p (List.concat_map (fun { Builder_db.Build.Meta.start ; uuid ; _ } ->
[ a ~a:[Fmt.kstr a_href "/job/%s/build/%a" name Uuidm.pp uuid]
[txtf "%a" pp_ptime start] ;
txt ", " ])
xs) ] ) @ [
h3 [txt "Comparisons with other builds"];
p p
((match latest_uuid with ((match latest_uuid with
| Some latest_uuid when successful_build && not (Uuidm.equal latest_uuid uuid) -> | Some latest_uuid when successful_build && not (Uuidm.equal latest_uuid uuid) ->
@ -223,18 +229,19 @@ let job_build
Uuidm.pp uuid Uuidm.pp latest_uuid] Uuidm.pp uuid Uuidm.pp latest_uuid]
[txt "With latest build"] ; br () ] [txt "With latest build"] ; br () ]
| _ -> []) @ | _ -> []) @
(match previous_build with List.concat_map (fun { Builder_db.Build.Meta.start = other_start ; uuid = other_uuid ; _ } ->
| Some previous_build when successful_build -> let fst, snd = if Ptime.is_later ~than:start other_start then uuid, other_uuid else other_uuid, uuid in
[ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch" [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
Uuidm.pp previous_build.Builder_db.Build.Meta.uuid Uuidm.pp uuid] Uuidm.pp fst Uuidm.pp snd]
[txt "With previous build"] ; br () ] [txtf "With build %a (output is identical binary)" pp_ptime other_start] ; br () ])
| _ -> []) @ different_input_same_output @
List.concat_map (fun { Builder_db.Build.Meta.start ; uuid = other_uuid ; _ } -> List.concat_map (fun { Builder_db.Build.Meta.start = other_start ; uuid = other_uuid ; _ } ->
let fst, snd = if Ptime.is_later ~than:start other_start then uuid, other_uuid else other_uuid, uuid in
[ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch" [ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
Uuidm.pp other_uuid Uuidm.pp uuid] Uuidm.pp fst Uuidm.pp snd]
[txtf "With build %a (output is identical binary)" pp_ptime start] ; br () ]) [txtf "With build %a (same input, different output)" pp_ptime other_start] ; br () ])
other_builds); same_input_different_output);
h3 [txt "Digests of build artifacts"]; h3 [txt "Build artifacts"];
dl (List.concat_map dl (List.concat_map
(fun { Builder_db.filepath; localpath=_; sha256; size } -> (fun { Builder_db.filepath; localpath=_; sha256; size } ->
let (`Hex sha256_hex) = Hex.of_cstruct sha256 in let (`Hex sha256_hex) = Hex.of_cstruct sha256 in

8
test/builder_db.ml
View file

@ -160,8 +160,8 @@ let add_test_build user_id (module Db : CONN) =
Db.start () >>= fun () -> Db.start () >>= fun () ->
Db.exec Job.try_add job_name >>= fun () -> Db.exec Job.try_add job_name >>= fun () ->
Db.find_opt Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id -> Db.find_opt Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.exec Build.add ({ Build.uuid; start; finish; result; console; script; Db.exec Build.add { Build.uuid; start; finish; result; console; script;
main_binary = None; user_id; job_id }, None) >>= fun () -> main_binary = None; input_id = None; user_id; job_id } >>= fun () ->
Db.find last_insert_rowid () >>= fun id -> Db.find last_insert_rowid () >>= fun id ->
Db.exec Build_artifact.add (main_binary, id) >>= fun () -> Db.exec Build_artifact.add (main_binary, id) >>= fun () ->
Db.find last_insert_rowid () >>= fun main_binary_id -> Db.find last_insert_rowid () >>= fun main_binary_id ->
@ -228,8 +228,8 @@ let add_second_build (module Db : CONN) =
Db.find_opt User.get_user username >>= fail_if_none >>= fun (user_id, _) -> Db.find_opt User.get_user username >>= fail_if_none >>= fun (user_id, _) ->
Db.start () >>= fun () -> Db.start () >>= fun () ->
Db.find_opt Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id -> Db.find_opt Job.get_id_by_name job_name >>= fail_if_none >>= fun job_id ->
Db.exec Build.add ({ Build.uuid; start; finish; result; console; script; Db.exec Build.add { Build.uuid; start; finish; result; console; script;
main_binary = None; user_id; job_id; }, None) >>= fun () -> main_binary = None; input_id = None; user_id; job_id; } >>= fun () ->
Db.find last_insert_rowid () >>= fun id -> Db.find last_insert_rowid () >>= fun id ->
Db.exec Build_artifact.add (main_binary, id) >>= fun () -> Db.exec Build_artifact.add (main_binary, id) >>= fun () ->
Db.find last_insert_rowid () >>= fun main_binary_id -> Db.find last_insert_rowid () >>= fun main_binary_id ->