fixup 2021-07-07b: move *.deb.debug to bin/*.deb, update build_artifact and build (main_binary)

bin/migrations/builder_migrations.ml

@@ -95,6 +95,11 @@ let f20210707a =
   Cmdliner.Term.(const do_database_action $ const M20210707a.fixup $ setup_log $ datadir),
   Cmdliner.Term.info ~doc "fixup-2021-07-07a"
 
+let f20210707b =
+  let doc = "Move *.deb.debug to bin/*.deb and remove the earlier bin/*.deb. Adjust main_binary of build." in
+  Cmdliner.Term.(const do_database_action $ const M20210707b.fixup $ setup_log $ datadir),
+  Cmdliner.Term.info ~doc "fixup-2021-07-07b"
+
 let help_cmd =
   let topic =
     let doc = "Migration to get help on" in
@@ -130,5 +135,6 @@ let () =
         actions (module M20210701);
         actions (module M20210706);
         [ f20210707a ];
+        [ f20210707b ];
       ])
   |> Cmdliner.Term.exit

bin/migrations/m20210707b.ml

@@ -0,0 +1,51 @@
+let deb_debug_left_in_builds =
+  Caqti_request.collect ~oneshot:true
+    Caqti_type.unit
+    (Caqti_type.tup4 (Builder_db.Rep.id `build_artifact) (Builder_db.Rep.id `build) Builder_db.Rep.fpath Builder_db.Rep.fpath)
+    {| SELECT id, build, localpath, filepath FROM build_artifact
+       WHERE filepath LIKE '%.deb.debug'
+    |}
+
+let get_main_binary =
+  Caqti_request.find_opt
+    (Builder_db.Rep.id `build)
+    (Builder_db.Rep.id `build_artifact)
+    "SELECT main_binary FROM build WHERE id = ?"
+
+let get_localpath =
+  Caqti_request.find
+    (Builder_db.Rep.id `build_artifact)
+    Builder_db.Rep.fpath
+    "SELECT localpath FROM build_artifact WHERE id = ?"
+
+let update_paths =
+  Caqti_request.exec
+    (Caqti_type.tup3 (Builder_db.Rep.id `build_artifact) Builder_db.Rep.fpath Builder_db.Rep.fpath)
+    "UPDATE build_artifact SET localpath = ?2, filepath = ?3 WHERE id = ?1"
+
+let fixup datadir (module Db : Caqti_blocking.CONNECTION) =
+  let open Rresult.R.Infix in
+  Grej.check_version ~user_version:12L (module Db) >>= fun () ->
+  Db.rev_collect_list deb_debug_left_in_builds () >>= fun leftover_debug ->
+  Grej.list_iter_result
+    (fun (id, build_id, path, fpath) ->
+       (Db.find_opt get_main_binary build_id >>= function
+        | None -> Ok (fun () -> Ok ())
+        | Some main_id ->
+          Db.find get_localpath main_id >>= fun lpath ->
+          Logs.info (fun m -> m "deleting %a" Fpath.pp lpath);
+          Bos.OS.File.delete (Fpath.append datadir lpath) >>= fun () ->
+          Ok (fun () -> Db.exec Builder_db.Build_artifact.remove main_id)) >>= fun later ->
+       Db.exec Builder_db.Build.set_main_binary (build_id, id) >>= fun () ->
+       let new_path p =
+         let fname = Fpath.(filename (rem_ext p)) in
+         let dir = Fpath.(parent p) in
+         Fpath.(dir / "bin" / fname)
+       in
+       Db.exec update_paths (id, new_path path, new_path fpath) >>= fun () ->
+       let o = Fpath.append datadir path and n = Fpath.append datadir (new_path path) in
+       Logs.info (fun m -> m "renaming %a to %a" Fpath.pp o Fpath.pp n);
+       Rresult.R.error_to_msg ~pp_error:Bos.OS.U.pp_error
+         (Bos.OS.U.rename o n) >>= fun () ->
+       later ())
+    leftover_debug