Compare commits

..

No commits in common. "b22f571a922d262264745240b3cefc0f9f70439b" and "9bd42944a974737a06e66383548ca670b9783916" have entirely different histories.

8 changed files with 30 additions and 185 deletions

2
.gitignore vendored
View file

@ -1,4 +1,4 @@
_build
*~
*#
_opam

View file

@ -58,9 +58,3 @@ see `builder-db user-add --help`):
```ocaml
curl --data-binary @<build-hash>.full http://<user>:<passwd>@localhost:<builder-web-port>/upload
```
## JSON Responses
Some endpoints return JSON when the headers contain `Accept: application/json`.
- `/compare/:build_left/:build_right`
- `/job/:job/build/latest/**`
- `/job/:job/build/latest`

View file

@ -50,10 +50,10 @@ depends: [
"decompress" {>= "1.5.0"}
"digestif" {>= "1.2.0"}
"uuidm" {>= "0.9.9"}
"yojson"
"alcotest" {>= "1.2.0" & with-test}
"ppx_deriving" {with-test}
"ppx_deriving_yojson" {with-test}
"yojson" {with-test}
]
synopsis: "Web interface for builder"

View file

@ -70,22 +70,11 @@ let mime_lookup path =
let string_of_html =
Format.asprintf "%a" (Tyxml.Html.pp ())
let is_accept_json req =
match Dream.header req "Accept" with
| Some accept when String.starts_with ~prefix:"application/json" accept ->
true
| _ -> false
let or_error_response req r =
let or_error_response r =
let* r = r in
match r with
| Ok response -> Lwt.return response
| Error (text, status) ->
if is_accept_json req then
let json_response = Yojson.Basic.to_string (`Assoc [ "error", `String text ]) in
Dream.json ~status json_response
else
Dream.respond ~status text
| Error (text, status) -> Dream.respond ~status text
let default_log_warn ~status e =
Log.warn (fun m -> m "%s: %a" (Dream.status_to_string status) pp_error e)
@ -408,19 +397,6 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
>>= fun (build, main_binary, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) ->
let solo5_manifest = Option.bind main_binary (Model.solo5_manifest datadir) in
if is_accept_json req then
let json_response =
`Assoc [
"job_name", `String job_name;
"uuid", `String (Uuidm.to_string build.uuid);
"platform", `String build.platform;
"start_time", `String (Ptime.to_rfc3339 build.start);
"finish_time", `String (Ptime.to_rfc3339 build.finish);
"main_binary", (match build.main_binary with Some _ -> `Bool true | None -> `Bool false)
] |> Yojson.Basic.to_string
in
Dream.json ~status:`OK json_response |> Lwt_result.ok
else
Views.Job_build.make
~job_name
~build
@ -561,17 +537,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
|> Lwt_result.ok
in
let resolve_artifact_size id_opt conn =
match id_opt with
| None -> Lwt.return_ok None
| Some id ->
Model.build_artifact_by_id id conn >|= fun file ->
Some file.size
in
let process_comparison req =
let compare_builds req =
let build_left = Dream.param req "build_left" in
let build_right = Dream.param req "build_right" in
get_uuid build_left >>= fun build_left ->
@ -591,16 +557,14 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
Model.build_artifact_data datadir >>= fun build_env_right ->
Model.build_artifact build_right.Builder_db.Build.uuid (Fpath.v "system-packages") conn >>=
Model.build_artifact_data datadir >>= fun system_packages_right ->
resolve_artifact_size build_left.Builder_db.Build.main_binary conn >>= fun build_left_file_size ->
resolve_artifact_size build_right.Builder_db.Build.main_binary conn >>= fun build_right_file_size ->
Model.job_name build_left.job_id conn >>= fun job_left ->
Model.job_name build_right.job_id conn >|= fun job_right ->
(job_left, job_right, build_left, build_right, build_left_file_size,
build_right_file_size, switch_left, build_env_left, system_packages_left,
(job_left, job_right, build_left, build_right,
switch_left, build_env_left, system_packages_left,
switch_right, build_env_right, system_packages_right))
|> if_error "Internal server error"
>>= fun (job_left, job_right, build_left, build_right, build_left_file_size,
build_right_file_size, switch_left, build_env_left, system_packages_left,
>>= fun (job_left, job_right, build_left, build_right,
switch_left, build_env_left, system_packages_left,
switch_right, build_env_right, system_packages_right) ->
let env_diff = Utils.compare_env build_env_left build_env_right
and pkg_diff = Utils.compare_pkgs system_packages_left system_packages_right
@ -608,43 +572,6 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
let switch_left = OpamFile.SwitchExport.read_from_string switch_left
and switch_right = OpamFile.SwitchExport.read_from_string switch_right in
let opam_diff = Opamdiff.compare switch_left switch_right in
(job_left, job_right, build_left, build_right, build_left_file_size, build_right_file_size, env_diff, pkg_diff, opam_diff)
|> Lwt.return_ok
in
let compare_builds req =
process_comparison req >>= fun
(job_left, job_right, build_left, build_right, build_left_file_size, build_right_file_size, env_diff, pkg_diff, opam_diff) ->
if is_accept_json req then
let file_size_json = Option.fold ~none:`Null ~some:(fun size -> `Int size) in
let json_response =
`Assoc [
"left", `Assoc [
"job_name", `String job_left;
"uuid", `String (Uuidm.to_string build_left.uuid);
"platform", `String build_left.platform;
"start_time", `String (Ptime.to_rfc3339 build_left.start);
"finish_time", `String (Ptime.to_rfc3339 build_left.finish);
"main_binary", `Bool (Option.is_some build_left_file_size);
"main_binary_size", file_size_json build_left_file_size;
];
"right", `Assoc [
"job_name", `String job_right;
"build", `String (Uuidm.to_string build_right.uuid);
"platform", `String build_right.platform;
"start_time", `String (Ptime.to_rfc3339 build_right.start);
"finish_time", `String (Ptime.to_rfc3339 build_right.finish);
"main_binary", `Bool (Option.is_some build_right_file_size);
"main_binary_size", file_size_json build_right_file_size;
];
"env_diff", Utils.diff_map_to_json env_diff;
"package_diff", Utils.diff_map_to_json pkg_diff;
"opam_diff", Opamdiff.compare_to_json opam_diff
] |> Yojson.Basic.to_string
in
Dream.json ~status:`OK json_response |> Lwt_result.ok
else
Views.compare_builds
~job_left ~job_right
~build_left ~build_right
@ -692,7 +619,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
>>= fun () -> Dream.respond "" |> Lwt_result.ok
in
let w f req = or_error_response req (f req) in
let w f req = or_error_response (f req) in
[
`Get, "/", (w (builds ~all:false ~filter_builds_later_than:expired_jobs));

View file

@ -6,27 +6,6 @@ module String_map = struct
update key (function None -> Some [ v ] | Some xs -> Some (v :: xs)) t
end
let diff_map_to_json (left, right, different_versions) =
let convert_list lst =
`List (List.map (fun (name, version) ->
`Assoc [("name", `String name); ("version", `String version)]
) lst)
in
let convert_diff_versions lst =
`List (List.map (fun (name, version1, version2) ->
`Assoc [
("name", `String name);
("version_in_left", `String version1);
("version_in_right", `String version2)
]
) lst)
in
`Assoc [
("left_packages", convert_list left);
("right_packages", convert_list right);
("different_versions", convert_diff_versions different_versions)
]
let diff_map a b =
let diff a b =
String_map.fold (fun k v acc ->

View file

@ -1,3 +1,3 @@
(library
(name opamdiff)
(libraries opam-core opam-format yojson))
(libraries opam-core opam-format))

View file

@ -275,55 +275,3 @@ let compare left right =
| Error _ as e, _ | _, (Error _ as e) -> e
in
(opam_diff, version_diff, left_pkgs, right_pkgs, duniverse_ret)
let compare_to_json
(opam_diff, version_diff, left_pkgs, right_pkgs, duniverse_diff) : Yojson.Basic.t =
let version_diff_to_json lst =
`List (List.map (fun { name; version_left; version_right } ->
`Assoc [
("name", `String (OpamPackage.Name.to_string name));
("version_left", `String (OpamPackage.Version.to_string version_left));
("version_right", `String (OpamPackage.Version.to_string version_right))
]
) lst)
in
let package_set_to_json set =
`List (Set.fold (fun p acc ->
let json = `Assoc [
("name", `String (OpamPackage.Name.to_string p.OpamPackage.name));
("version", `String (OpamPackage.Version.to_string p.OpamPackage.version))
] in
json :: acc
) set [])
in
let opam_diff_to_json opam_diff =
`List (List.map (fun (diff : opam_diff) ->
`Assoc [
("package_version", `String (OpamPackage.to_string diff.pkg));
("otherwise_equal", `Bool diff.otherwise_equal)
]
) opam_diff)
in
let duniverse_to_json = function
| Ok (left, right, detailed_diff) ->
`Assoc [
("left", `List (List.map (fun (k, v) -> `Assoc [("name", `String k); ("value", `String v)]) left));
("right", `List (List.map (fun (k, v) -> `Assoc [("name", `String k); ("value", `String v)]) right));
("detailed_diff",`List (List.map (fun (diff : duniverse_diff) ->
`Assoc [
("name", `String diff.name);
]) detailed_diff))
]
| Error (`Msg msg) ->
`String msg
in
`Assoc [
("opam_diff", opam_diff_to_json opam_diff);
("version_diff", version_diff_to_json version_diff);
("only_in_left", package_set_to_json left_pkgs);
("only_in_right", package_set_to_json right_pkgs);
("duniverse_diff", duniverse_to_json duniverse_diff)
]

View file

@ -33,10 +33,7 @@ val commands_to_strings : OpamTypes.command list * OpamTypes.command list -> str
val opt_url_to_string : OpamFile.URL.t option * OpamFile.URL.t option -> string * string
val compare : OpamFile.SwitchExport.t ->
val compare: OpamFile.SwitchExport.t ->
OpamFile.SwitchExport.t ->
opam_diff list * version_diff list * OpamPackage.Set.t * OpamPackage.Set.t * ((string * string) list * (string * string) list * duniverse_diff list, [> `Msg of string ]) result
val compare_to_json : opam_diff list * version_diff list * OpamPackage.Set.t * OpamPackage.Set.t *
((string * string) list * (string * string) list * duniverse_diff list, [< `Msg of string ]) result -> Yojson.Basic.t