Show build main binary and hash in job view

pull/22/head
Reynir Björnsson 2 years ago
parent 56737ec71b
commit 96a3da36cd
  1. 24
      db/builder_db.ml
  2. 3
      db/builder_db.mli
  3. 32
      db/representation.ml
  4. 6
      lib/builder_web.ml
  5. 5
      lib/model.ml
  6. 4
      lib/model.mli
  7. 29
      lib/views.ml

@ -8,19 +8,12 @@ let current_version = 1L
type id = Rep.id
type file = {
type file = Rep.file = {
filepath : Fpath.t;
localpath : Fpath.t;
sha256 : Cstruct.t;
}
let file =
let encode { filepath; localpath; sha256 } =
Ok (filepath, localpath, sha256) in
let decode (filepath, localpath, sha256) =
Ok { filepath; localpath; sha256 } in
Caqti_type.custom ~encode ~decode Caqti_type.(tup3 fpath fpath cstruct)
let last_insert_rowid =
Caqti_request.find
Caqti_type.unit
@ -349,13 +342,18 @@ module Build = struct
let get_all_meta_by_name =
Caqti_request.collect
Caqti_type.string
(Caqti_type.tup2
id Meta.t)
(Caqti_type.tup3
id
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.job
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.job,
build_artifact.filepath, build_artifact.localpath, build_artifact.sha256
FROM build, job
LEFT JOIN build_artifact ON
build_artifact.build = build.id AND build.main_binary = build_artifact.filepath
WHERE job.name = ? AND build.job = job.id
ORDER BY start_d DESC, start_ps DESC
|}

@ -5,7 +5,6 @@ type file = {
localpath : Fpath.t;
sha256 : Cstruct.t;
}
val file : file Caqti_type.t
val application_id : int32
@ -124,7 +123,7 @@ sig
val get_all_meta :
(id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_meta_by_name :
(string, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
(string, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t
val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
end

@ -23,6 +23,12 @@ end
type id = int64
let id = Caqti_type.int64
type file = {
filepath : Fpath.t;
localpath : Fpath.t;
sha256 : Cstruct.t;
}
let uuid =
let encode uuid = Ok (Uuidm.to_bytes uuid) in
let decode s =
@ -50,6 +56,32 @@ let cstruct =
let decode s = Ok (Cstruct.of_string s) in
Caqti_type.custom ~encode ~decode Caqti_type.octets
let file =
let encode { filepath; localpath; sha256 } =
Ok (filepath, localpath, sha256) in
let decode (filepath, localpath, sha256) =
Ok { filepath; localpath; sha256 } in
Caqti_type.custom ~encode ~decode Caqti_type.(tup3 fpath fpath cstruct)
let file_opt =
let rep = Caqti_type.(tup3 (option fpath) (option fpath) (option cstruct)) in
let encode = function
| Some { filepath; localpath; sha256 } ->
Ok (Some filepath, Some localpath, Some sha256)
| None ->
Ok (None, None, None)
in
let decode = function
| (Some filepath, Some localpath, Some sha256) ->
Ok (Some { filepath; localpath; sha256 })
| (None, None, None) ->
Ok None
| _ ->
(* This should not happen if the database is well-formed *)
Error "Some but not all fields NULL"
in
Caqti_type.custom ~encode ~decode rep
let execution_result =
let encode = function
| Builder.Exited v -> Ok (0, Some v, None)

@ -86,14 +86,16 @@ let routes t =
let job req =
let job_name = Router.param req "job" in
let+ job = Caqti_lwt.Pool.use (Model.job job_name) t.pool in
let+ job =
Caqti_lwt.Pool.use (Model.job job_name) t.pool
in
match job with
| Error e ->
Log.warn (fun m -> m "Error getting job: %a" pp_error e);
Response.of_plain_text ~status:`Internal_server_error
"Error getting job"
| Ok builds ->
Views.job job_name (List.map snd builds) |> Response.of_html
Views.job job_name builds |> Response.of_html
in
let job_build req =

@ -49,7 +49,7 @@ 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) =
let main_binary id main_binary (module Db : CONN) =
match main_binary with
| None -> Lwt_result.return None
| Some main_binary ->
@ -57,7 +57,8 @@ let main_binary id { Builder_db.Build.main_binary; _ } (module Db : CONN) =
Some file
let job job (module Db : CONN) =
Db.collect_list Builder_db.Build.get_all_meta_by_name job
Db.collect_list Builder_db.Build.get_all_meta_by_name job >|=
List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
let jobs (module Db : CONN) =
Db.collect_list Builder_db.Job.get_all () >|=

@ -14,11 +14,11 @@ 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 ->
val main_binary : Builder_db.id -> Fpath.t option -> 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
((Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
val jobs : Caqti_lwt.connection ->
(string list, [> error ]) result Lwt.t

@ -101,15 +101,28 @@ let job name builds =
txtf "Currently %d builds."
(List.length builds)
];
ul (List.map (fun build ->
li [
a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.Meta.uuid) ^ "/")]
ul (List.map (fun (build, main_binary) ->
li ([
a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.Meta.uuid / ""))]
[
txtf "%a" (Ptime.pp_human ()) build.Builder_db.Build.Meta.start;
];
txt " ";
check_icon build.result;
br ();
] @ match main_binary with
| Some main_binary ->
[
txtf "%a" (Ptime.pp_human ()) build.Builder_db.Build.Meta.start;
];
txt " ";
check_icon build.result;
])
a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.Meta.uuid
/ "f" // main_binary.Builder_db.filepath))]
[txtf "%s" (Fpath.basename main_binary.Builder_db.filepath)];
txt " ";
code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct main_binary.Builder_db.sha256)];
]
| None ->
[
txtf "Build failed";
]))
builds);
]

Loading…
Cancel
Save