diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 4b02450..1196881 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -50,14 +50,14 @@ let routes (t : Model.t) = let+ job_run = Lwt_result.lift (safe_seg job) >>= fun job -> Lwt_result.lift (safe_seg run) >>= fun run -> - Model.read_full t job run in + Model.read_full_with_digests t job run in match job_run with | Error (`Msg e) -> Log.warn (fun m -> m "Error getting job run: %s" e); Response.of_plain_text ~status:`Internal_server_error "Error getting job run" - | Ok job_run -> - Views.job_run job_run |> Response.of_html + | Ok (job_run, digests) -> + Views.job_run job_run digests |> Response.of_html in [ diff --git a/lib/model.ml b/lib/model.ml index 9594b63..c422c28 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -24,12 +24,18 @@ type job_run_info = { data : (Fpath.t * string) list } -type t = { - dir : Fpath.t; - mutable cache : job_run_meta RunMap.t +type digest = { + sha256 : string; + sha512 : string; } -let init dir = { dir; cache = RunMap.empty; } +type t = { + dir : Fpath.t; + mutable meta_cache : job_run_meta RunMap.t; + mutable digest_cache : (Fpath.t * digest) list RunMap.t +} + +let init dir = { dir; meta_cache = RunMap.empty; digest_cache = RunMap.empty; } type job = { path : Fpath.t; @@ -46,17 +52,34 @@ let read_full t path run = Builder.Asn.exec_of_cs (Cstruct.of_string s) >>| fun (job_info, uuid, out, start, finish, result, data) -> let meta = { job_info; uuid; start; finish; result } in - t.cache <- RunMap.add (path, run) meta t.cache; + t.meta_cache <- RunMap.add (path, run) meta t.meta_cache; { meta; out; data } +let digest (path, data) = + let module H = Mirage_crypto.Hash in + let data = Cstruct.of_string data in + (path, { + sha256 = H.SHA256.digest data |> Cstruct.to_string; + sha512 = H.SHA512.digest data |> Cstruct.to_string; + }) + +let read_full_with_digests t path run = + read_full t path run >|= fun ({ data; _ } as full) -> + match RunMap.find_opt (path, run) t.digest_cache with + | Some digests -> full, digests + | None -> + let digests = List.map digest data in + t.digest_cache <- RunMap.add (path, run) digests t.digest_cache; + full, digests + let read_full_meta t path run = - match RunMap.find_opt (path, run) t.cache with + match RunMap.find_opt (path, run) t.meta_cache with | Some meta -> Lwt_result.lift (Bos.OS.File.exists Fpath.(t.dir // path // run / "full")) >>= fun exists -> if exists then Lwt_result.return meta else - (t.cache <- RunMap.remove (path, run) t.cache; + (t.meta_cache <- RunMap.remove (path, run) t.meta_cache; Lwt_result.fail (`Msg "no such file")) | None -> read_full t path run >|= fun { meta; out = _; data = _ } -> diff --git a/lib/model.mli b/lib/model.mli index 638e005..8058aa5 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -8,6 +8,11 @@ type job_run_meta = { result : Builder.execution_result; } +type digest = { + sha256 : string; + sha512 : string; +} + type job_run_info = { meta : job_run_meta; out : (int * string) list; @@ -25,5 +30,8 @@ val job_name : job -> string val read_full : t -> Fpath.t -> Fpath.t -> (job_run_info, [> `Msg of string ]) result Lwt.t +val read_full_with_digests : t -> Fpath.t -> Fpath.t -> + (job_run_info * (Fpath.t * digest) list, [> `Msg of string ]) result Lwt.t + val job : t -> Fpath.t -> (job, [> `Msg of string]) result Lwt.t val jobs : t -> (Fpath.t list, [> `Msg of string ]) result Lwt.t diff --git a/lib/views.ml b/lib/views.ml index b784c6d..505fd3e 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -84,6 +84,7 @@ let job_run Model.job_info = { Builder.name; _ }; start; finish; uuid = _; result }; out; data = _ } + digests = let ptime_pp = Ptime.pp_human () in let delta = Ptime.diff finish start in @@ -91,6 +92,18 @@ let job_run [ h1 [txtf "Job build %s %a" name ptime_pp start]; p [txtf "Build took %a." Ptime.Span.pp delta ]; p [txtf "Execution result: %a." Builder.pp_execution_result result]; + h3 [txt "Digests of build artifacts"]; + dl (List.concat_map + (fun (path, { Model.sha256; sha512 }) -> [ + dt [code [txtf "%a" Fpath.pp path]; + txt "(SHA256)"]; + dd [code [txtf "%s" (Base64.encode_string sha256)]]; + dt [code [txtf "%a" Fpath.pp path]; + txt "(SHA512)"]; + dd [code [txtf "%s" (Base64.encode_string sha512)]]; + ]) + digests); + h3 [txt "Build log"]; table (List.mapi (fun idx (ts, line) -> let ts_id = "L" ^ string_of_int idx in