Refactor migrations

bin/migrations/grej.ml

@@ -0,0 +1,19 @@
+(* Grej is utilities *)
+open Rresult.R.Infix
+
+let set_version version =
+  Caqti_request.exec ~oneshot:true
+    Caqti_type.unit
+    (Printf.sprintf "PRAGMA user_version = %Ld" version)
+
+let check_version
+    ?application_id:(desired_application_id=Builder_db.application_id)
+    ~user_version:desired_user_version
+    (module Db : Caqti_blocking.CONNECTION) =
+  Db.find Builder_db.get_application_id () >>= fun application_id ->
+  Db.find Builder_db.get_version () >>= fun user_version ->
+  if application_id <> desired_application_id || user_version <> desired_user_version
+  then Error (`Wrong_version (application_id, user_version))
+  else Ok ()
+
+

bin/migrations/m20210126.ml

@@ -6,11 +6,6 @@ let set_application_id =
     Caqti_type.unit
     (Printf.sprintf "PRAGMA application_id = %ld" Builder_db.application_id)
 
-let set_version version =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    (Printf.sprintf "PRAGMA user_version = %Ld" version)
-
 let alter_build =
   Caqti_request.exec ~oneshot:true
     Caqti_type.unit
@@ -35,31 +30,26 @@ let set_main_binary =
 
 let migrate (module Db : Caqti_blocking.CONNECTION) =
   let open Rresult.R.Infix in
-  Db.find Builder_db.get_application_id () >>= fun application_id ->
-  Db.find Builder_db.get_version () >>= fun user_version ->
-  if application_id <> 0l || user_version <> 0L
-  then
-    Error (`Wrong_version (application_id, user_version))
-  else
-    Db.exec alter_build () >>= fun () ->
-    Db.collect_list all_builds () >>= fun builds ->
-    List.fold_left (fun r build ->
-        r >>= fun () ->
-        Db.collect_list bin_artifact build >>= function
-        | [_id, main_binary] ->
-          Db.exec set_main_binary (build, Some main_binary)
-        | [] ->
-          Logs.debug (fun m -> m "No binaries for build id %Ld" build);
-          Ok ()
-        | binaries ->
-          Logs.warn (fun m -> m "More than one binary for build id %Ld" build);
-          Logs.debug (fun m -> m "binaries: [%a]" Fmt.(list ~sep:(any ";") string)
-                         (List.map snd binaries));
-          Ok ())
-      (Ok ())
-      builds >>= fun () ->
-    Db.exec Builder_db.set_application_id () >>= fun () ->
-    Db.exec (set_version new_user_version) ()
+  Grej.check_version ~application_id:0l ~user_version:0L (module Db) >>= fun () ->
+  Db.exec alter_build () >>= fun () ->
+  Db.collect_list all_builds () >>= fun builds ->
+  List.fold_left (fun r build ->
+      r >>= fun () ->
+      Db.collect_list bin_artifact build >>= function
+      | [_id, main_binary] ->
+        Db.exec set_main_binary (build, Some main_binary)
+      | [] ->
+        Logs.debug (fun m -> m "No binaries for build id %Ld" build);
+        Ok ()
+      | binaries ->
+        Logs.warn (fun m -> m "More than one binary for build id %Ld" build);
+        Logs.debug (fun m -> m "binaries: [%a]" Fmt.(list ~sep:(any ";") string)
+                       (List.map snd binaries));
+        Ok ())
+    (Ok ())
+    builds >>= fun () ->
+  Db.exec Builder_db.set_application_id () >>= fun () ->
+  Db.exec (Grej.set_version new_user_version) ()
 
 let rename_build =
   Caqti_request.exec
@@ -98,13 +88,8 @@ let rollback_data =
 
 let rollback (module Db : Caqti_blocking.CONNECTION) =
   let open Rresult.R.Infix in
-  Db.find Builder_db.get_application_id () >>= fun application_id ->
-  Db.find Builder_db.get_version () >>= fun user_version ->
-  if application_id <> Builder_db.application_id || user_version <> new_user_version
-  then
-    Error (`Wrong_version (application_id, user_version))
-  else
-    Db.exec rename_build () >>= fun () ->
-    Db.exec create_build () >>= fun () ->
-    Db.exec rollback_data () >>= fun () ->
-    Db.exec (set_version 0L) ()
+  Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
+  Db.exec rename_build () >>= fun () ->
+  Db.exec create_build () >>= fun () ->
+  Db.exec rollback_data () >>= fun () ->
+  Db.exec (Grej.set_version 0L) ()

bin/migrations/m20210202.ml

@@ -6,11 +6,8 @@ let migrate (module Db : Caqti_blocking.CONNECTION) =
       Caqti_type.unit
       "CREATE INDEX job_build_idx ON build(job)";
   in
-  Db.find Builder_db.get_application_id () >>= fun application_id ->
-  Db.find Builder_db.get_version () >>= fun user_version ->
-  if application_id <> Builder_db.application_id || user_version <> 1L
-  then Error (`Wrong_version (application_id, user_version))
-  else Db.exec job_build_idx ()
+  Grej.check_version ~user_version:1L (module Db) >>= fun () ->
+  Db.exec job_build_idx ()
 
 let rollback (module Db : Caqti_blocking.CONNECTION) =
   let q =
@@ -18,9 +15,5 @@ let rollback (module Db : Caqti_blocking.CONNECTION) =
       Caqti_type.unit
       "DROP INDEX IF EXISTS job_build_idx"
   in
-  Db.find Builder_db.get_application_id () >>= fun application_id ->
-  Db.find Builder_db.get_version () >>= fun user_version ->
-  if application_id <> Builder_db.application_id || user_version <> 1L
-  then Error (`Wrong_version (application_id, user_version))
-  else
-    Db.exec q ()
+  Grej.check_version ~user_version:1L (module Db) >>= fun () ->
+  Db.exec q ()

bin/migrations/m20210216.ml

@@ -1,11 +1,6 @@
 let old_user_version = 1L
 let new_user_version = 2L
 
-let set_version version =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    (Printf.sprintf "PRAGMA user_version = %Ld" version)
-
 let drop_user =
   Caqti_request.exec ~oneshot:true
     Caqti_type.unit
@@ -39,22 +34,14 @@ let old_user =
 
 let migrate (module Db : Caqti_blocking.CONNECTION) =
   let open Rresult.R.Infix in
-  Db.find Builder_db.get_application_id () >>= fun application_id ->
-  Db.find Builder_db.get_version () >>= fun user_version ->
-  if application_id <> Builder_db.application_id || user_version <> old_user_version
-  then Error (`Wrong_version (application_id, user_version))
-  else
-    Db.exec drop_user () >>= fun () ->
-    Db.exec new_user () >>= fun () ->
-    Db.exec (set_version new_user_version) ()
+  Grej.check_version ~user_version:old_user_version (module Db) >>= fun () ->
+  Db.exec drop_user () >>= fun () ->
+  Db.exec new_user () >>= fun () ->
+  Db.exec (Grej.set_version new_user_version) ()
 
 let rollback (module Db : Caqti_blocking.CONNECTION) =
   let open Rresult.R.Infix in
-  Db.find Builder_db.get_application_id () >>= fun application_id ->
-  Db.find Builder_db.get_version () >>= fun user_version ->
-  if application_id <> Builder_db.application_id || user_version <> new_user_version
-  then Error (`Wrong_version (application_id, user_version))
-  else
-    Db.exec drop_user () >>= fun () ->
-    Db.exec old_user () >>= fun () ->
-    Db.exec (set_version old_user_version) ()
+  Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
+  Db.exec drop_user () >>= fun () ->
+  Db.exec old_user () >>= fun () ->
+  Db.exec (Grej.set_version old_user_version) ()

bin/migrations/m20210218.ml

@@ -1,11 +1,6 @@
 let old_user_version = 2L
 let new_user_version = 3L
 
-let set_version version =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    (Printf.sprintf "PRAGMA user_version = %Ld" version)
-
 let new_build_artifact =
   Caqti_request.exec ~oneshot:true
     Caqti_type.unit
@@ -86,38 +81,34 @@ let rename_build_file =
 
 let migrate (module Db : Caqti_blocking.CONNECTION) =
   let open Rresult.R.Infix in
-  Db.find Builder_db.get_application_id () >>= fun application_id ->
-  Db.find Builder_db.get_version () >>= fun user_version ->
-  if application_id <> Builder_db.application_id || user_version <> old_user_version
-  then Error (`Wrong_version (application_id, user_version))
-  else
-    Db.exec new_build_artifact () >>= fun () ->
-    Db.rev_collect_list collect_build_artifact () >>= fun build_artifacts ->
-    List.fold_left
-      (fun r (id, (filepath, localpath, sha256), build) ->
-         r >>= fun () ->
-         let stats = Unix.stat localpath in
-         Db.exec insert_new_build_artifact
-           (id, (filepath, localpath, sha256, Int64.of_int stats.st_size), build))
-      (Ok ())
-      build_artifacts >>= fun () ->
-    Db.exec drop_build_artifact () >>= fun () ->
-    Db.exec rename_build_artifact () >>= fun () ->
+  Grej.check_version ~user_version:old_user_version (module Db) >>= fun () ->
+  Db.exec new_build_artifact () >>= fun () ->
+  Db.rev_collect_list collect_build_artifact () >>= fun build_artifacts ->
+  List.fold_left
+    (fun r (id, (filepath, localpath, sha256), build) ->
+       r >>= fun () ->
+       let stats = Unix.stat localpath in
+       Db.exec insert_new_build_artifact
+         (id, (filepath, localpath, sha256, Int64.of_int stats.st_size), build))
+    (Ok ())
+    build_artifacts >>= fun () ->
+  Db.exec drop_build_artifact () >>= fun () ->
+  Db.exec rename_build_artifact () >>= fun () ->
 
-    Db.exec new_build_file () >>= fun () ->
-    Db.rev_collect_list collect_build_file () >>= fun build_files ->
-    List.fold_left
-      (fun r (id, (filepath, localpath, sha256), build) ->
-         r >>= fun () ->
-         let stats = Unix.stat localpath in
-         Db.exec insert_new_build_file
-           (id, (filepath, localpath, sha256, Int64.of_int stats.st_size), build))
-      (Ok ())
-      build_files >>= fun () ->
-    Db.exec drop_build_file () >>= fun () ->
-    Db.exec rename_build_file () >>= fun () ->
+  Db.exec new_build_file () >>= fun () ->
+  Db.rev_collect_list collect_build_file () >>= fun build_files ->
+  List.fold_left
+    (fun r (id, (filepath, localpath, sha256), build) ->
+       r >>= fun () ->
+       let stats = Unix.stat localpath in
+       Db.exec insert_new_build_file
+         (id, (filepath, localpath, sha256, Int64.of_int stats.st_size), build))
+    (Ok ())
+    build_files >>= fun () ->
+  Db.exec drop_build_file () >>= fun () ->
+  Db.exec rename_build_file () >>= fun () ->
 
-    Db.exec (set_version new_user_version) ()
+  Db.exec (Grej.set_version new_user_version) ()
 
 let old_build_artifact =
   Caqti_request.exec ~oneshot:true
@@ -161,19 +152,15 @@ let copy_build_file =
 
 let rollback (module Db : Caqti_blocking.CONNECTION) =
   let open Rresult.R.Infix in
-  Db.find Builder_db.get_application_id () >>= fun application_id ->
-  Db.find Builder_db.get_version () >>= fun user_version ->
-  if application_id <> Builder_db.application_id || user_version <> new_user_version
-  then Error (`Wrong_version (application_id, user_version))
-  else
-    Db.exec old_build_artifact () >>= fun () ->
-    Db.exec copy_build_artifact () >>= fun () ->
-    Db.exec drop_build_artifact () >>= fun () ->
-    Db.exec rename_build_artifact () >>= fun () ->
+  Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
+  Db.exec old_build_artifact () >>= fun () ->
+  Db.exec copy_build_artifact () >>= fun () ->
+  Db.exec drop_build_artifact () >>= fun () ->
+  Db.exec rename_build_artifact () >>= fun () ->
 
-    Db.exec old_build_file () >>= fun () ->
-    Db.exec copy_build_file () >>= fun () ->
-    Db.exec drop_build_file () >>= fun () ->
-    Db.exec rename_build_file () >>= fun () ->
+  Db.exec old_build_file () >>= fun () ->
+  Db.exec copy_build_file () >>= fun () ->
+  Db.exec drop_build_file () >>= fun () ->
+  Db.exec rename_build_file () >>= fun () ->
 
-    Db.exec (set_version old_user_version) ()
+  Db.exec (Grej.set_version old_user_version) ()

bin/migrations/m20210308.ml

@@ -12,6 +12,7 @@ let broken_builds =
 
 let fixup (module Db : Caqti_blocking.CONNECTION) =
   let open Rresult.R.Infix in
+  Grej.check_version ~user_version:3L (module Db) >>= fun () ->
   Db.rev_collect_list broken_builds () >>= fun broken_builds ->
   List.fold_left
     (fun r ((build, uuid, job_name) : Rep.id * Uuidm.t * string) ->