Prepare staging dir before writing

The preparation of the staging dir when saving a build was handled in
Model.save_all, but we expect it to be created in Model.save_console_and_script.

This commit refactors the staging dir preparation into a function for better
clarity.
This commit is contained in:
Robur 2021-08-31 12:15:18 +00:00
parent e7daf0366b
commit 7c04469825

View file

@ -203,10 +203,6 @@ let save_all staging_dir (job : Builder.script_job) uuid artifacts =
let build_dir = Fpath.(v job.Builder.name / Uuidm.to_string uuid) in let build_dir = Fpath.(v job.Builder.name / Uuidm.to_string uuid) in
let output_dir = Fpath.(build_dir / "output") let output_dir = Fpath.(build_dir / "output")
and staging_output_dir = Fpath.(staging_dir / "output") in and staging_output_dir = Fpath.(staging_dir / "output") in
Lwt.return (Bos.OS.Dir.create staging_dir) >>= (fun created ->
if not created
then Lwt_result.fail (`Msg "build directory already exists")
else Lwt_result.return ()) >>= fun () ->
Lwt.return (Bos.OS.Dir.create staging_output_dir) >>= fun _ -> Lwt.return (Bos.OS.Dir.create staging_output_dir) >>= fun _ ->
save_files output_dir staging_output_dir artifacts >>= fun artifacts -> save_files output_dir staging_output_dir artifacts >>= fun artifacts ->
Lwt_result.return artifacts Lwt_result.return artifacts
@ -291,6 +287,12 @@ let save_console_and_script staging_dir datadir job_name uuid console script =
save (out_staging "console") (console_to_string console) >|= fun () -> save (out_staging "console") (console_to_string console) >|= fun () ->
(out "script", out "console") (out "script", out "console")
let prepare_staging staging_dir =
Lwt.return (Bos.OS.Dir.create staging_dir) >>= fun created ->
if not created
then Lwt_result.fail (`Msg "build directory already exists")
else Lwt_result.return ()
let add_build let add_build
datadir datadir
user_id user_id
@ -315,6 +317,7 @@ let add_build
in in
List.filter (fun (p, _) -> not (not_interesting p)) raw_artifacts List.filter (fun (p, _) -> not (not_interesting p)) raw_artifacts
in in
or_cleanup (prepare_staging staging_dir) >>= fun () ->
or_cleanup (save_console_and_script staging_dir datadir job_name uuid console job.Builder.script) or_cleanup (save_console_and_script staging_dir datadir job_name uuid console job.Builder.script)
>>= fun (console, script) -> >>= fun (console, script) ->
or_cleanup (save_all staging_dir job uuid artifacts_to_preserve) >>= fun artifacts -> or_cleanup (save_all staging_dir job uuid artifacts_to_preserve) >>= fun artifacts ->