84 lines
3 KiB
OCaml
84 lines
3 KiB
OCaml
open Lwt_result.Infix
|
|
|
|
let src = Logs.Src.create "builder-web.model" ~doc:"Builder_web model"
|
|
module Log = (val Logs.src_log src : Logs.LOG)
|
|
|
|
module type CONN = Caqti_lwt.CONNECTION
|
|
|
|
type error = [ Caqti_error.call_or_retrieve | `Not_found | `File_error of Fpath.t ]
|
|
|
|
let pp_error ppf = function
|
|
| `Not_found -> Format.fprintf ppf "value not found in database"
|
|
| `File_error path -> Format.fprintf ppf "error reading file %a" Fpath.pp path
|
|
| #Caqti_error.call_or_retrieve as e ->
|
|
Caqti_error.pp ppf e
|
|
|
|
let not_found = function
|
|
| None -> Lwt.return (Error `Not_found :> (_, [> error ]) result)
|
|
| Some v -> Lwt_result.return v
|
|
|
|
let read_file filepath =
|
|
Lwt.try_bind
|
|
(fun () -> Lwt_io.open_file ~mode:Lwt_io.Input (Fpath.to_string filepath))
|
|
(fun ic -> Lwt_result.ok (Lwt_io.read ic))
|
|
(function
|
|
| Unix.Unix_error (e, _, _) ->
|
|
Logs.warn (fun m -> m "Error reading local file %a: %s"
|
|
Fpath.pp filepath (Unix.error_message e));
|
|
Lwt.return_error (`File_error filepath)
|
|
| e -> Lwt.fail e)
|
|
|
|
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
|
|
| None ->
|
|
Lwt.return_error `Not_found
|
|
|
|
let build_artifacts build (module Db : CONN) =
|
|
Db.collect_list Builder_db.Build_artifact.get_all_by_build build >|=
|
|
List.map snd
|
|
|
|
let build uuid (module Db : CONN) =
|
|
Db.find_opt Builder_db.Build.get_by_uuid uuid >>=
|
|
not_found
|
|
|
|
let job job (module Db : CONN) =
|
|
Db.collect_list Builder_db.Build.get_all_meta_by_name job
|
|
|
|
let jobs (module Db : CONN) =
|
|
Db.collect_list Builder_db.Job.get_all () >|=
|
|
List.map snd
|
|
|
|
let user username (module Db : CONN) =
|
|
Db.find_opt Builder_db.User.get_user username >|=
|
|
Option.map snd
|
|
|
|
let dummy_save base (filepath, data) =
|
|
let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
|
|
let localpath = Fpath.append base filepath in
|
|
{ Builder_db.filepath; localpath; sha256 }
|
|
|
|
let add_build (job, uuid, console, start, finish, result, artifacts) (module Db : CONN) =
|
|
let open Builder_db in
|
|
let job_name = job.Builder.name in
|
|
let output_dir = Fmt.strf "/var/db/builder/%s/%a/output" job_name Uuidm.pp uuid in
|
|
let input_dir = Fmt.strf "/var/db/builder/%s/%a/input" job_name Uuidm.pp uuid 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 () ->
|
|
Db.find last_insert_rowid () >>= fun id ->
|
|
List.fold_left
|
|
(fun r file ->
|
|
r >>= fun () ->
|
|
Db.exec Build_artifact.add (file, id))
|
|
(Lwt_result.return ())
|
|
(List.map (dummy_save (Fpath.v output_dir)) artifacts) >>= fun () ->
|
|
List.fold_left
|
|
(fun r file ->
|
|
r >>= fun () ->
|
|
Db.exec Build_file.add (file, id))
|
|
(Lwt_result.return ())
|
|
(List.map (dummy_save (Fpath.v input_dir)) job.Builder.files)
|