diff --git a/bin/migrations/builder_migrations.ml b/bin/migrations/builder_migrations.ml index c1381e5..19761a7 100644 --- a/bin/migrations/builder_migrations.ml +++ b/bin/migrations/builder_migrations.ml @@ -115,6 +115,11 @@ let f20210712b = Cmdliner.Term.(const do_database_action $ const M20210712b.fixup $ setup_log $ datadir), Cmdliner.Term.info ~doc "fixup-2021-07-12b" +let f20210910 = + let doc = "Undo builds with script and console mixed up." in + Cmdliner.Term.(const do_database_action $ const M20210910.fixup $ setup_log $ datadir), + Cmdliner.Term.info ~doc "fixup-2021-09-10" + let help_cmd = let topic = let doc = "Migration to get help on" in @@ -156,5 +161,6 @@ let () = actions (module M20210712a); [ f20210712b ]; actions (module M20210712c); + [ f20210910 ]; ]) |> Cmdliner.Term.exit diff --git a/bin/migrations/m20210910.ml b/bin/migrations/m20210910.ml new file mode 100644 index 0000000..18c5177 --- /dev/null +++ b/bin/migrations/m20210910.ml @@ -0,0 +1,18 @@ +let mixups = + Caqti_request.collect ~oneshot:true + Caqti_type.unit + (Caqti_type.tup3 (Builder_db.Rep.id (`build : [`build])) Builder_db.Rep.fpath Builder_db.Rep.fpath) +"SELECT id, console, script FROM build WHERE console LIKE '%/script.txt' AND script LIKE '%/console.txt'" + +let fixup = + Caqti_request.exec ~oneshot:true + (Caqti_type.tup3 (Builder_db.Rep.id (`build : [`build])) Builder_db.Rep.fpath Builder_db.Rep.fpath) + "UPDATE build SET console = ?2, script = ?3 WHERE id = ?1" + +let fixup _datadir (module Db : Caqti_blocking.CONNECTION) = + let open Rresult.R.Infix in + Grej.check_version ~user_version:14L (module Db) >>= fun () -> + Db.collect_list mixups () >>= fun mixups -> + Grej.list_iter_result (fun (id, console, script) -> + Db.exec fixup (id, script, console)) + mixups diff --git a/lib/model.ml b/lib/model.ml index 0adb421..9cc8303 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -296,7 +296,7 @@ let save_console_and_script staging_dir job_name uuid console script = in save (out_staging "script") script >>= fun () -> save (out_staging "console") (console_to_string console) >|= fun () -> - (out "script", out "console") + (out "console", out "script") let prepare_staging staging_dir = Lwt.return (Bos.OS.Dir.create staging_dir) >>= fun created ->