Update to caqti 1.8.0

bin/builder_db_app.ml

@@ -1,3 +1,5 @@
+open Caqti_request.Infix
+
 let ( let* ) = Result.bind
 let ( let+ ) x f = Result.map f x
 
@@ -10,19 +12,12 @@ let or_die exit_code = function
     Format.eprintf "Database error: %a\n" Caqti_error.pp e;
     exit exit_code
 
-let foreign_keys =
-  Caqti_request.exec
-    Caqti_type.unit
-    "PRAGMA foreign_keys = ON"
-
 let defer_foreign_keys =
-  Caqti_request.exec
-    Caqti_type.unit
-    "PRAGMA defer_foreign_keys = ON"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "PRAGMA defer_foreign_keys = ON"
 
 let connect uri =
-  let* (module Db : Caqti_blocking.CONNECTION) = Caqti_blocking.connect uri in
-  let* () = Db.exec foreign_keys () in
+  let* (module Db : Caqti_blocking.CONNECTION) = Caqti_blocking.connect ~tweaks_version:(1,8) uri in
   let* () = Db.exec defer_foreign_keys () in
   Ok (module Db : Caqti_blocking.CONNECTION)
 
@@ -179,19 +174,16 @@ let job_remove () datadir jobname =
   or_die 1 r
 
 let input_ids =
-   Caqti_request.collect
-     Caqti_type.unit
-     Builder_db.Rep.cstruct
-     "SELECT DISTINCT input_id FROM build WHERE input_id IS NOT NULL"
+  Caqti_type.unit ->* Builder_db.Rep.cstruct @@
+  "SELECT DISTINCT input_id FROM build WHERE input_id IS NOT NULL"
 
 let main_artifact_hash =
-   Caqti_request.collect
-     Builder_db.Rep.cstruct
-     (Caqti_type.tup3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string)
-     {|
-       SELECT a.sha256, b.uuid, j.name FROM build_artifact a, build b, job j
-       WHERE b.input_id = ? AND a.id = b.main_binary AND b.job = j.id
-     |}
+  Builder_db.Rep.cstruct ->*
+  Caqti_type.tup3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@
+  {|
+    SELECT a.sha256, b.uuid, j.name FROM build_artifact a, build b, job j
+    WHERE b.input_id = ? AND a.id = b.main_binary AND b.job = j.id
+  |}
 
 let verify_input_id () dbpath =
   let r =
@@ -219,26 +211,25 @@ let verify_input_id () dbpath =
   or_die 1 r
 
 let num_build_artifacts =
-  Caqti_request.find
-    Caqti_type.unit
-    Caqti_type.int
-    "SELECT count(*) FROM build_artifact"
+  Caqti_type.unit ->! Caqti_type.int @@
+  "SELECT count(*) FROM build_artifact"
 
 let build_artifacts : (unit, string * Uuidm.t * (Fpath.t * Fpath.t * Cstruct.t * int64), [ `One | `Zero | `Many ]) Caqti_request.t =
-  Caqti_request.collect
-    Caqti_type.unit
-    Caqti_type.(tup3 string Builder_db.Rep.uuid (tup4 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct int64))
-    {| SELECT job.name, b.uuid, a.filepath, a.localpath, a.sha256, a.size
-       FROM build_artifact a, build b, job
-       WHERE a.build = b.id AND b.job = job.id |}
+  Caqti_type.unit ->*
+  Caqti_type.(tup3 string Builder_db.Rep.uuid
+                (tup4 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct int64))
+  @@
+  {| SELECT job.name, b.uuid, a.filepath, a.localpath, a.sha256, a.size
+     FROM build_artifact a, build b, job
+     WHERE a.build = b.id AND b.job = job.id |}
 
 let script_and_console : (unit, _, [`One | `Zero | `Many ]) Caqti_request.t =
-  Caqti_request.collect
-    Caqti_type.unit
-    Caqti_type.(tup4 string Builder_db.Rep.uuid Builder_db.Rep.fpath Builder_db.Rep.fpath)
-    {| SELECT job.name, b.uuid, b.console, b.script
-       FROM build b, job
-       WHERE job.id = b.job |}
+  Caqti_type.unit ->*
+  Caqti_type.(tup4 string Builder_db.Rep.uuid Builder_db.Rep.fpath Builder_db.Rep.fpath)
+  @@
+  {| SELECT job.name, b.uuid, b.console, b.script
+     FROM build b, job
+     WHERE job.id = b.job |}
 
 module FpathSet = Set.Make(Fpath)
 

bin/migrations/grej.ml

@@ -1,20 +1,29 @@
 (* Grej is utilities *)
 module Syntax = struct
+  open Caqti_request.Infix
   let ( let* ) = Result.bind
   let ( let+ ) x f = Result.map f x
+  let ( ->. ) = ( ->. ) ~oneshot:true
+  let ( ->! ) = ( ->! ) ~oneshot:true
+  let ( ->? ) = ( ->? ) ~oneshot:true
+  let ( ->* ) = ( ->* ) ~oneshot:true
 end
 
 module Infix = struct
+  open Caqti_request.Infix
   let ( >>= ) = Result.bind
   let ( >>| ) x f = Result.map f x
+  let ( ->. ) = ( ->. ) ~oneshot:true
+  let ( ->! ) = ( ->! ) ~oneshot:true
+  let ( ->? ) = ( ->? ) ~oneshot:true
+  let ( ->* ) = ( ->* ) ~oneshot:true
 end
 
 open Syntax
 
 let set_version version =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    (Printf.sprintf "PRAGMA user_version = %Ld" version)
+  Caqti_type.unit ->. Caqti_type.unit @@
+  Printf.sprintf "PRAGMA user_version = %Ld" version
 
 let check_version
     ?application_id:(desired_application_id=Builder_db.application_id)
@@ -34,6 +43,5 @@ let list_iter_result f xs =
 
 let foreign_keys on =
   let on = if on then "ON" else "OFF" in
-  Caqti_request.exec
-    Caqti_type.unit
-    (Printf.sprintf "PRAGMA foreign_keys = %s" on)
+  Caqti_type.unit ->. Caqti_type.unit @@
+  Printf.sprintf "PRAGMA foreign_keys = %s" on

bin/migrations/m20210126.ml

@@ -3,32 +3,27 @@ let identifier = "2021-01-26"
 let migrate_doc = "add column main_binary to build"
 let rollback_doc = "remove column main_binary from build"
 
+open Grej.Infix
+
 let set_application_id =
-  Caqti_request.exec
-    Caqti_type.unit
-    (Printf.sprintf "PRAGMA application_id = %ld" Builder_db.application_id)
+  Caqti_type.unit ->. Caqti_type.unit @@
+  Printf.sprintf "PRAGMA application_id = %ld" Builder_db.application_id
 
 let alter_build =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "ALTER TABLE build ADD COLUMN main_binary TEXT"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "ALTER TABLE build ADD COLUMN main_binary TEXT"
 
 let all_builds =
-  Caqti_request.collect ~oneshot:true
-    Caqti_type.unit
-    Caqti_type.int64
-    "SELECT id FROM build"
+  Caqti_type.unit ->* Caqti_type.int64 @@
+  "SELECT id FROM build"
 
 let bin_artifact =
-  Caqti_request.collect ~oneshot:true
-    Caqti_type.int64
-    Caqti_type.(tup2 int64 string)
-    "SELECT id, filepath FROM build_artifact WHERE build = ? AND filepath LIKE 'bin/%'"
+  Caqti_type.int64 ->* Caqti_type.(tup2 int64 string) @@
+  "SELECT id, filepath FROM build_artifact WHERE build = ? AND filepath LIKE 'bin/%'"
 
 let set_main_binary =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.(tup2 int64 (option string))
-    "UPDATE build SET main_binary = $2 WHERE id = $1"
+  Caqti_type.(tup2 int64 (option string)) ->. Caqti_type.unit @@
+  "UPDATE build SET main_binary = $2 WHERE id = $1"
 
 let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
   let open Grej.Infix in
@@ -52,39 +47,36 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
   Db.exec (Grej.set_version new_version) ()
 
 let rename_build =
-  Caqti_request.exec
-    Caqti_type.unit
-    "ALTER TABLE build RENAME TO __tmp_build"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "ALTER TABLE build RENAME TO __tmp_build"
 
 let create_build =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE build (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         uuid VARCHAR(36) NOT NULL UNIQUE,
-         start_d INTEGER NOT NULL,
-         start_ps INTEGER NOT NULL,
-         finish_d INTEGER NOT NULL,
-         finish_ps INTEGER NOT NULL,
-         result_kind TINYINT NOT NULL,
-         result_code INTEGER,
-         result_msg TEXT,
-         console BLOB NOT NULL,
-         script TEXT NOT NULL,
-         job INTEGER NOT NULL,
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE build (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       uuid VARCHAR(36) NOT NULL UNIQUE,
+       start_d INTEGER NOT NULL,
+       start_ps INTEGER NOT NULL,
+       finish_d INTEGER NOT NULL,
+       finish_ps INTEGER NOT NULL,
+       result_kind TINYINT NOT NULL,
+       result_code INTEGER,
+       result_msg TEXT,
+       console BLOB NOT NULL,
+       script TEXT NOT NULL,
+       job INTEGER NOT NULL,
 
-         FOREIGN KEY(job) REFERENCES job(id)
-       )
-       |}
+       FOREIGN KEY(job) REFERENCES job(id)
+     )
+  |}
 
 let rollback_data =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| INSERT INTO build
-       SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
-         result_kind, result_code, result_msg, console, script, job
-       FROM __tmp_build
-    |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| INSERT INTO build
+     SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
+       result_kind, result_code, result_msg, console, script, job
+     FROM __tmp_build
+  |}
 
 let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
   let open Grej.Infix in

bin/migrations/m20210202.ml

@@ -7,18 +7,16 @@ open Grej.Infix
 
 let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
   let job_build_idx =
-    Caqti_request.exec ~oneshot:true
-      Caqti_type.unit
-      "CREATE INDEX job_build_idx ON build(job)";
+    Caqti_type.unit ->. Caqti_type.unit @@
+    "CREATE INDEX job_build_idx ON build(job)";
   in
   Grej.check_version ~user_version:1L (module Db) >>= fun () ->
   Db.exec job_build_idx ()
 
 let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
   let q =
-    Caqti_request.exec ~oneshot:true
-      Caqti_type.unit
-      "DROP INDEX IF EXISTS job_build_idx"
+    Caqti_type.unit ->. Caqti_type.unit @@
+    "DROP INDEX IF EXISTS job_build_idx"
   in
   Grej.check_version ~user_version:1L (module Db) >>= fun () ->
   Db.exec q ()

bin/migrations/m20210216.ml

@@ -4,46 +4,43 @@ let identifier = "2021-02-16"
 let migrate_doc = "change to scrypt hashed passwords (NB: destructive!!)"
 let rollback_doc = "rollback scrypt hashed passwords (NB: destructive!!)"
 
+open Grej.Infix
+
 let drop_user =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "DROP TABLE user"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DROP TABLE user"
 
 let new_user =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    {| CREATE TABLE user (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         username VARCHAR(255) NOT NULL UNIQUE,
-         password_hash BLOB NOT NULL,
-         password_salt BLOB NOT NULL,
-         scrypt_n INTEGER NOT NULL,
-         scrypt_r INTEGER NOT NULL,
-         scrypt_p INTEGER NOT NULL
-       )
-      |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE user (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       username VARCHAR(255) NOT NULL UNIQUE,
+       password_hash BLOB NOT NULL,
+       password_salt BLOB NOT NULL,
+       scrypt_n INTEGER NOT NULL,
+       scrypt_r INTEGER NOT NULL,
+       scrypt_p INTEGER NOT NULL
+     )
+  |}
 
 let old_user =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE user (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         username VARCHAR(255) NOT NULL UNIQUE,
-         password_hash BLOB NOT NULL,
-         password_salt BLOB NOT NULL,
-         password_iter INTEGER NOT NULL
-       )
-    |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE user (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       username VARCHAR(255) NOT NULL UNIQUE,
+       password_hash BLOB NOT NULL,
+       password_salt BLOB NOT NULL,
+       password_iter INTEGER NOT NULL
+     )
+  |}
 
 let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
   Db.exec drop_user () >>= fun () ->
   Db.exec new_user () >>= fun () ->
   Db.exec (Grej.set_version new_version) ()
 
 let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
   Db.exec drop_user () >>= fun () ->
   Db.exec old_user () >>= fun () ->

bin/migrations/m20210218.ml

@@ -4,86 +4,75 @@ let identifier = "2021-02-18"
 let migrate_doc = "add column size to build_file and build_artifact"
 let rollback_doc = "remove column size to build_file and build_artifact"
 
+open Grej.Infix
+
 let new_build_artifact =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    {| CREATE TABLE new_build_artifact (
-           id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-           filepath TEXT NOT NULL, -- the path as in the build
-           localpath TEXT NOT NULL, -- local path to the file on disk
-           sha256 BLOB NOT NULL,
-           size INTEGER NOT NULL,
-           build INTEGER NOT NULL,
-
-           FOREIGN KEY(build) REFERENCES build(id),
-           UNIQUE(build, filepath)
-         )
-      |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_build_artifact (
+         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+         filepath TEXT NOT NULL, -- the path as in the build
+         localpath TEXT NOT NULL, -- local path to the file on disk
+         sha256 BLOB NOT NULL,
+         size INTEGER NOT NULL,
+         build INTEGER NOT NULL,
+
+         FOREIGN KEY(build) REFERENCES build(id),
+         UNIQUE(build, filepath)
+       )
+  |}
 
 let new_build_file =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    {| CREATE TABLE new_build_file (
-           id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-           filepath TEXT NOT NULL, -- the path as in the build
-           localpath TEXT NOT NULL, -- local path to the file on disk
-           sha256 BLOB NOT NULL,
-           size INTEGER NOT NULL,
-           build INTEGER NOT NULL,
-
-           FOREIGN KEY(build) REFERENCES build(id),
-           UNIQUE(build, filepath)
-         )
-      |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_build_file (
+         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+         filepath TEXT NOT NULL, -- the path as in the build
+         localpath TEXT NOT NULL, -- local path to the file on disk
+         sha256 BLOB NOT NULL,
+         size INTEGER NOT NULL,
+         build INTEGER NOT NULL,
+
+         FOREIGN KEY(build) REFERENCES build(id),
+         UNIQUE(build, filepath)
+       )
+  |}
 
 let collect_build_artifact =
-  Caqti_request.collect ~oneshot:true
-    Caqti_type.unit
-    Caqti_type.(tup3 int64 (tup3 string string octets) int64)
-    "SELECT id, filepath, localpath, sha256, build FROM build_artifact"
+  Caqti_type.unit ->* Caqti_type.(tup3 int64 (tup3 string string octets) int64) @@
+  "SELECT id, filepath, localpath, sha256, build FROM build_artifact"
 
 let collect_build_file =
-  Caqti_request.collect ~oneshot:true
-    Caqti_type.unit
-    Caqti_type.(tup3 int64 (tup3 string string octets) int64)
-    "SELECT id, filepath, localpath, sha256, build FROM build_file"
+  Caqti_type.unit ->* Caqti_type.(tup3 int64 (tup3 string string octets) int64) @@
+  "SELECT id, filepath, localpath, sha256, build FROM build_file"
 
 let insert_new_build_artifact =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.(tup3 int64 (tup4 string string octets int64) int64)
-    {| INSERT INTO new_build_artifact (id, filepath, localpath, sha256, size, build)
-       VALUES (?, ?, ?, ?, ?, ?)
-    |}
+  Caqti_type.(tup3 int64 (tup4 string string octets int64) int64) ->. Caqti_type.unit @@
+  {| INSERT INTO new_build_artifact (id, filepath, localpath, sha256, size, build)
+     VALUES (?, ?, ?, ?, ?, ?)
+  |}
 
 let insert_new_build_file =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.(tup3 int64 (tup4 string string octets int64) int64)
-    {| INSERT INTO new_build_file (id, filepath, localpath, sha256, size, build)
-       VALUES (?, ?, ?, ?, ?, ?)
-    |}
+  Caqti_type.(tup3 int64 (tup4 string string octets int64) int64) ->. Caqti_type.unit @@
+  {| INSERT INTO new_build_file (id, filepath, localpath, sha256, size, build)
+     VALUES (?, ?, ?, ?, ?, ?)
+  |}
 
 let drop_build_artifact =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "DROP TABLE build_artifact"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DROP TABLE build_artifact"
 
 let drop_build_file =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "DROP TABLE build_file"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DROP TABLE build_file"
 
 let rename_build_artifact =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "ALTER TABLE new_build_artifact RENAME TO build_artifact"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "ALTER TABLE new_build_artifact RENAME TO build_artifact"
 
 let rename_build_file =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "ALTER TABLE new_build_file RENAME TO build_file"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "ALTER TABLE new_build_file RENAME TO build_file"
 
 let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
   Db.exec new_build_artifact () >>= fun () ->
   Db.rev_collect_list collect_build_artifact () >>= fun build_artifacts ->
@@ -110,47 +99,42 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
   Db.exec (Grej.set_version new_version) ()
 
 let old_build_artifact =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    {| CREATE TABLE new_build_artifact (
-           id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-           filepath TEXT NOT NULL, -- the path as in the build
-           localpath TEXT NOT NULL, -- local path to the file on disk
-           sha256 BLOB NOT NULL,
-           build INTEGER NOT NULL,
-
-           FOREIGN KEY(build) REFERENCES build(id),
-           UNIQUE(build, filepath)
-         )
-      |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_build_artifact (
+         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+         filepath TEXT NOT NULL, -- the path as in the build
+         localpath TEXT NOT NULL, -- local path to the file on disk
+         sha256 BLOB NOT NULL,
+         build INTEGER NOT NULL,
+
+         FOREIGN KEY(build) REFERENCES build(id),
+         UNIQUE(build, filepath)
+       )
+  |}
 
 let old_build_file =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    {| CREATE TABLE new_build_file (
-           id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-           filepath TEXT NOT NULL, -- the path as in the build
-           localpath TEXT NOT NULL, -- local path to the file on disk
-           sha256 BLOB NOT NULL,
-           build INTEGER NOT NULL,
-
-           FOREIGN KEY(build) REFERENCES build(id),
-           UNIQUE(build, filepath)
-         )
-      |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_build_file (
+         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+         filepath TEXT NOT NULL, -- the path as in the build
+         localpath TEXT NOT NULL, -- local path to the file on disk
+         sha256 BLOB NOT NULL,
+         build INTEGER NOT NULL,
+
+         FOREIGN KEY(build) REFERENCES build(id),
+         UNIQUE(build, filepath)
+       )
+  |}
 
 let copy_build_artifact =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "INSERT INTO new_build_artifact SELECT id, filepath, localpath, sha256, build FROM build_artifact"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "INSERT INTO new_build_artifact SELECT id, filepath, localpath, sha256, build FROM build_artifact"
 
 let copy_build_file =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "INSERT INTO new_build_file SELECT id, filepath, localpath, sha256, build FROM build_file"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "INSERT INTO new_build_file SELECT id, filepath, localpath, sha256, build FROM build_file"
 
 let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
   Db.exec old_build_artifact () >>= fun () ->
   Db.exec copy_build_artifact () >>= fun () ->

bin/migrations/m20210308.ml

@@ -1,17 +1,16 @@
 module Rep = Builder_db.Rep
 
+open Grej.Infix
+
 let broken_builds =
-  Caqti_request.collect ~oneshot:true
-    Caqti_type.unit
-    (Caqti_type.tup3 (Rep.id `build) Rep.uuid Caqti_type.string)
-    {| SELECT b.id, b.uuid, job.name FROM build b, job
-       WHERE result_kind = 0 AND result_code = 0 AND main_binary IS NOT NULL AND job.id = b.job AND
-         (SELECT COUNT( * ) FROM build_artifact a
-          WHERE a.build = b.id and a.filepath = b.main_binary) = 0
-    |}
+  Caqti_type.unit ->* Caqti_type.tup3 (Rep.id `build) Rep.uuid Caqti_type.string @@
+  {| SELECT b.id, b.uuid, job.name FROM build b, job
+     WHERE result_kind = 0 AND result_code = 0 AND main_binary IS NOT NULL AND job.id = b.job AND
+       (SELECT COUNT( * ) FROM build_artifact a
+        WHERE a.build = b.id and a.filepath = b.main_binary) = 0
+  |}
 
 let fixup datadir (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:3L (module Db) >>= fun () ->
   Db.rev_collect_list broken_builds () >>= fun broken_builds ->
   Grej.list_iter_result

bin/migrations/m20210427.ml

@@ -7,14 +7,12 @@ open Grej.Infix
 
 let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
   let idx_build_job_start =
-    Caqti_request.exec ~oneshot:true
-      Caqti_type.unit
-      "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
+    Caqti_type.unit ->. Caqti_type.unit @@
+    "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
   in
   let rm_job_build_idx =
-    Caqti_request.exec ~oneshot:true
-      Caqti_type.unit
-      "DROP INDEX IF EXISTS job_build_idx"
+    Caqti_type.unit ->. Caqti_type.unit @@
+    "DROP INDEX IF EXISTS job_build_idx"
   in
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
   Db.exec rm_job_build_idx () >>= fun () ->
@@ -22,14 +20,12 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
 
 let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
   let job_build_idx =
-    Caqti_request.exec ~oneshot:true
-      Caqti_type.unit
-      "CREATE INDEX job_build_idx ON build(job)"
+    Caqti_type.unit ->. Caqti_type.unit @@
+    "CREATE INDEX job_build_idx ON build(job)"
   in
   let rm_idx_build_job_start =
-    Caqti_request.exec ~oneshot:true
-      Caqti_type.unit
-      "DROP INDEX IF EXISTS idx_build_job_start"
+    Caqti_type.unit ->. Caqti_type.unit @@
+    "DROP INDEX IF EXISTS idx_build_job_start"
   in
   Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
   Db.exec rm_idx_build_job_start () >>= fun () ->

bin/migrations/m20210531.ml

@@ -4,21 +4,19 @@ let identifier = "2021-05-31"
 let migrate_doc = "remove datadir prefix from build_artifact.localpath"
 let rollback_doc = "add datadir prefix to build_artifact.localpath"
 
+open Grej.Infix
+
 let build_artifacts =
-  Caqti_request.collect ~oneshot:true
-    Caqti_type.unit
-    Caqti_type.(tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath)
-    "SELECT id, localpath FROM build_artifact"
+  Caqti_type.unit ->* Caqti_type.tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath @@
+  "SELECT id, localpath FROM build_artifact"
 
 let build_artifact_update_localpath =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.(tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath)
+  Caqti_type.tup2 Builder_db.Rep.untyped_id Builder_db.Rep.fpath ->. Caqti_type.unit @@
     "UPDATE build_artifact SET localpath = $2 WHERE id = $1"
 
 (* We are not migrating build_file because it is unused *)
 
 let migrate datadir (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
   Db.collect_list build_artifacts () >>= fun artifacts ->
   Grej.list_iter_result (fun (id, localpath) ->
@@ -29,7 +27,6 @@ let migrate datadir (module Db : Caqti_blocking.CONNECTION) =
   Db.exec (Grej.set_version new_version) ()
 
 let rollback datadir (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
    Db.collect_list build_artifacts () >>= fun artifacts ->
   Grej.list_iter_result (fun (id, localpath) ->

bin/migrations/m20210602.ml

@@ -3,117 +3,114 @@ let identifier = "2021-06-02"
 let migrate_doc = "build.main_binary foreign key"
 let rollback_doc = "build.main_binary filepath"
 
+open Grej.Infix
+
 let idx_build_job_start =
-  Caqti_request.exec Caqti_type.unit
-    "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
 
 let new_build =
-    Caqti_request.exec
-      Caqti_type.unit
-      {| CREATE TABLE new_build (
-           id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-           uuid VARCHAR(36) NOT NULL UNIQUE,
-           start_d INTEGER NOT NULL,
-           start_ps INTEGER NOT NULL,
-           finish_d INTEGER NOT NULL,
-           finish_ps INTEGER NOT NULL,
-           result_kind TINYINT NOT NULL,
-           result_code INTEGER,
-           result_msg TEXT,
-           console BLOB NOT NULL,
-           script TEXT NOT NULL,
-           main_binary INTEGER,
-           job INTEGER NOT NULL,
-
-           FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
-           FOREIGN KEY(job) REFERENCES job(id)
-         )
-      |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_build (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       uuid VARCHAR(36) NOT NULL UNIQUE,
+       start_d INTEGER NOT NULL,
+       start_ps INTEGER NOT NULL,
+       finish_d INTEGER NOT NULL,
+       finish_ps INTEGER NOT NULL,
+       result_kind TINYINT NOT NULL,
+       result_code INTEGER,
+       result_msg TEXT,
+       console BLOB NOT NULL,
+       script TEXT NOT NULL,
+       main_binary INTEGER,
+       job INTEGER NOT NULL,
+
+       FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
+       FOREIGN KEY(job) REFERENCES job(id)
+     )
+  |}
 
 let old_build =
-    Caqti_request.exec
-      Caqti_type.unit
-      {| CREATE TABLE new_build (
-           id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-           uuid VARCHAR(36) NOT NULL UNIQUE,
-           start_d INTEGER NOT NULL,
-           start_ps INTEGER NOT NULL,
-           finish_d INTEGER NOT NULL,
-           finish_ps INTEGER NOT NULL,
-           result_kind TINYINT NOT NULL,
-           result_code INTEGER,
-           result_msg TEXT,
-           console BLOB NOT NULL,
-           script TEXT NOT NULL,
-           main_binary TEXT,
-           job INTEGER NOT NULL,
-
-           FOREIGN KEY(job) REFERENCES job(id)
-         )
-      |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_build (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       uuid VARCHAR(36) NOT NULL UNIQUE,
+       start_d INTEGER NOT NULL,
+       start_ps INTEGER NOT NULL,
+       finish_d INTEGER NOT NULL,
+       finish_ps INTEGER NOT NULL,
+       result_kind TINYINT NOT NULL,
+       result_code INTEGER,
+       result_msg TEXT,
+       console BLOB NOT NULL,
+       script TEXT NOT NULL,
+       main_binary TEXT,
+       job INTEGER NOT NULL,
+
+       FOREIGN KEY(job) REFERENCES job(id)
+     )
+  |}
 
 let collect_old_build =
-  Caqti_request.collect ~oneshot:true
-    Caqti_type.unit
-    Caqti_type.(tup3 Builder_db.Rep.untyped_id
-      (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option string)))
-      Builder_db.Rep.untyped_id)
-    {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
-              console, script, main_binary, job
-       FROM build |}
+  Caqti_type.unit ->*
+  Caqti_type.(tup3 Builder_db.Rep.untyped_id
+                (tup3 (tup4 string int64 int64 int64)
+                   (tup4 int64 int (option int) (option string))
+                   (tup3 octets string (option string)))
+                Builder_db.Rep.untyped_id) @@
+  {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
+            console, script, main_binary, job
+     FROM build |}
 
 let insert_new_build =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.(tup3 Builder_db.Rep.untyped_id
-      (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.untyped_id)))
-      Builder_db.Rep.untyped_id)
-    {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
-                              result_code, result_msg, console, script, main_binary, job)
-       VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
+  Caqti_type.(tup3 Builder_db.Rep.untyped_id
+                (tup3 (tup4 string int64 int64 int64)
+                   (tup4 int64 int (option int) (option string))
+                   (tup3 octets string (option Builder_db.Rep.untyped_id)))
+                Builder_db.Rep.untyped_id) ->. Caqti_type.unit @@
+  {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
+                            result_code, result_msg, console, script, main_binary, job)
+     VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
 
 let drop_build =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
+  Caqti_type.unit ->. Caqti_type.unit @@
     "DROP TABLE build"
 
 let rename_build =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
+  Caqti_type.unit ->. Caqti_type.unit @@
     "ALTER TABLE new_build RENAME TO build"
 
 let find_main_artifact_id =
-  Caqti_request.find ~oneshot:true
-    Caqti_type.(tup2 Builder_db.Rep.untyped_id string)
-    Builder_db.Rep.untyped_id
-    "SELECT id FROM build_artifact WHERE build = $1 AND filepath = $2"
+  Caqti_type.(tup2 Builder_db.Rep.untyped_id string) ->!  Builder_db.Rep.untyped_id @@
+  "SELECT id FROM build_artifact WHERE build = $1 AND filepath = $2"
 
 let find_main_artifact_filepath =
-  Caqti_request.find ~oneshot:true
-    Builder_db.Rep.untyped_id
-    Caqti_type.string
+  Builder_db.Rep.untyped_id ->! Caqti_type.string @@
     "SELECT filepath FROM build_artifact WHERE id = ?"
 
 let collect_new_build =
-  Caqti_request.collect ~oneshot:true
-    Caqti_type.unit
-    Caqti_type.(tup3 Builder_db.Rep.untyped_id
-      (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.untyped_id)))
-      Builder_db.Rep.untyped_id)
-    {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
-              console, script, main_binary, job
-       FROM build |}
+  Caqti_type.unit ->*
+  Caqti_type.(tup3 Builder_db.Rep.untyped_id
+                (tup3 (tup4 string int64 int64 int64)
+                   (tup4 int64 int (option int) (option string))
+                   (tup3 octets string (option Builder_db.Rep.untyped_id)))
+                Builder_db.Rep.untyped_id) @@
+  {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
+            console, script, main_binary, job
+     FROM build |}
 
 let insert_old_build =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.(tup3 Builder_db.Rep.untyped_id
-      (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option string)))
-      Builder_db.Rep.untyped_id)
-    {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
-                              result_code, result_msg, console, script, main_binary, job)
-       VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
+  Caqti_type.(tup3 Builder_db.Rep.untyped_id
+                (tup3 (tup4 string int64 int64 int64)
+                   (tup4 int64 int (option int) (option string))
+                   (tup3 octets string (option string)))
+                Builder_db.Rep.untyped_id) ->. Caqti_type.unit @@
+  {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
+                            result_code, result_msg, console, script, main_binary, job)
+     VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
 
 let migrate _ (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
   Db.exec new_build () >>= fun () ->
   Db.rev_collect_list collect_old_build () >>= fun builds ->
@@ -133,7 +130,6 @@ let migrate _ (module Db : Caqti_blocking.CONNECTION) =
 
 
 let rollback _ (module Db : Caqti_blocking.CONNECTION) =
-  let open Grej.Infix in
   Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
   Db.exec old_build () >>= fun () ->
   Db.rev_collect_list collect_new_build () >>= fun builds ->

bin/migrations/m20210608.ml

@@ -3,87 +3,79 @@ let identifier = "2021-06-08"
 let migrate_doc = "add access list"
 let rollback_doc = "remove access list"
 
+open Grej.Infix
+
 let new_user =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE new_user (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         username VARCHAR(255) NOT NULL UNIQUE,
-         password_hash BLOB NOT NULL,
-         password_salt BLOB NOT NULL,
-         scrypt_n INTEGER NOT NULL,
-         scrypt_r INTEGER NOT NULL,
-         scrypt_p INTEGER NOT NULL,
-         restricted BOOLEAN NOT NULL
-       )
-    |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_user (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       username VARCHAR(255) NOT NULL UNIQUE,
+       password_hash BLOB NOT NULL,
+       password_salt BLOB NOT NULL,
+       scrypt_n INTEGER NOT NULL,
+       scrypt_r INTEGER NOT NULL,
+       scrypt_p INTEGER NOT NULL,
+       restricted BOOLEAN NOT NULL
+     )
+  |}
 
 let old_user =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE new_user (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         username VARCHAR(255) NOT NULL UNIQUE,
-         password_hash BLOB NOT NULL,
-         password_salt BLOB NOT NULL,
-         scrypt_n INTEGER NOT NULL,
-         scrypt_r INTEGER NOT NULL,
-         scrypt_p INTEGER NOT NULL
-       )
-    |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_user (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       username VARCHAR(255) NOT NULL UNIQUE,
+       password_hash BLOB NOT NULL,
+       password_salt BLOB NOT NULL,
+       scrypt_n INTEGER NOT NULL,
+       scrypt_r INTEGER NOT NULL,
+       scrypt_p INTEGER NOT NULL
+     )
+  |}
 
 let collect_old_user =
-  Caqti_request.collect
-    Caqti_type.unit
-    Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64))
-    "SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p FROM user"
+  Caqti_type.unit ->*
+  Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64)) @@
+  "SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p FROM user"
 
 let collect_new_user =
-  Caqti_request.collect
-    Caqti_type.unit
-    Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool))
-    "SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted FROM user"
+  Caqti_type.unit ->*
+  Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool)) @@
+  "SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted FROM user"
 
 let insert_new_user =
-  Caqti_request.exec
-    Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool))
-    "INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) VALUES (?, ?, ?, ?, ?, ?, ?, ?)"
+  Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool)) ->.
+  Caqti_type.unit @@
+  "INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) VALUES (?, ?, ?, ?, ?, ?, ?, ?)"
 
 let insert_old_user =
-  Caqti_request.exec
-    Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64))
-    "INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p) VALUES (?, ?, ?, ?, ?, ?, ?)"
+  Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64)) ->.
+  Caqti_type.unit @@
+  "INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p) VALUES (?, ?, ?, ?, ?, ?, ?)"
 
 let drop_user =
-  Caqti_request.exec
-    Caqti_type.unit
+  Caqti_type.unit ->. Caqti_type.unit @@
     "DROP TABLE user"
 
 let rename_new_user =
-  Caqti_request.exec
-    Caqti_type.unit
+  Caqti_type.unit ->. Caqti_type.unit @@
     "ALTER TABLE new_user RENAME TO user"
 
 let access_list =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE access_list (
-           id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-           user INTEGER NOT NULL,
-           job INTEGER NOT NULL,
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE access_list (
+         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+         user INTEGER NOT NULL,
+         job INTEGER NOT NULL,
 
-           FOREIGN KEY(user) REFERENCES user(id),
-           FOREIGN KEY(job) REFERENCES job(id),
-           UNIQUE(user, job)
-         )
-    |}
+         FOREIGN KEY(user) REFERENCES user(id),
+         FOREIGN KEY(job) REFERENCES job(id),
+         UNIQUE(user, job)
+       )
+  |}
 
 let rollback_access_list =
- Caqti_request.exec
-   Caqti_type.unit
-   "DROP TABLE IF EXISTS access_list"
-
-open Grej.Infix
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DROP TABLE IF EXISTS access_list"
 
 let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->

bin/migrations/m20210609.ml

@@ -3,100 +3,92 @@ let identifier = "2021-06-09"
 let migrate_doc = "add user column to build"
 let rollback_doc = "remove user column from build"
 
+open Grej.Infix
+
 let idx_build_job_start =
-  Caqti_request.exec Caqti_type.unit
-    "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
 
 let nologin_user =
-  Caqti_request.exec
-    Caqti_type.unit
-    "INSERT INTO user (username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) \
-     VALUES ('nologin', x'', x'', 16384, 8, 1, true)"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "INSERT INTO user (username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) \
+   VALUES ('nologin', x'', x'', 16384, 8, 1, true)"
 
 let remove_nologin_user =
-  Caqti_request.exec
-    Caqti_type.unit
-    "DELETE FROM user WHERE username = 'nologin'"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DELETE FROM user WHERE username = 'nologin'"
 
 let new_build =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE new_build (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         uuid VARCHAR(36) NOT NULL UNIQUE,
-         start_d INTEGER NOT NULL,
-         start_ps INTEGER NOT NULL,
-         finish_d INTEGER NOT NULL,
-         finish_ps INTEGER NOT NULL,
-         result_kind TINYINT NOT NULL,
-         result_code INTEGER,
-         result_msg TEXT,
-         console BLOB NOT NULL,
-         script TEXT NOT NULL,
-         main_binary INTEGER,
-         user INTEGER NOT NULL,
-         job INTEGER NOT NULL,
-
-         FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
-         FOREIGN KEY(job) REFERENCES job(id),
-         FOREIGN KEY(user) REFERENCES user(id)
-       )
-    |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_build (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       uuid VARCHAR(36) NOT NULL UNIQUE,
+       start_d INTEGER NOT NULL,
+       start_ps INTEGER NOT NULL,
+       finish_d INTEGER NOT NULL,
+       finish_ps INTEGER NOT NULL,
+       result_kind TINYINT NOT NULL,
+       result_code INTEGER,
+       result_msg TEXT,
+       console BLOB NOT NULL,
+       script TEXT NOT NULL,
+       main_binary INTEGER,
+       user INTEGER NOT NULL,
+       job INTEGER NOT NULL,
+
+       FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
+       FOREIGN KEY(job) REFERENCES job(id),
+       FOREIGN KEY(user) REFERENCES user(id)
+     )
+  |}
 
 let old_build =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE new_build (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         uuid VARCHAR(36) NOT NULL UNIQUE,
-         start_d INTEGER NOT NULL,
-         start_ps INTEGER NOT NULL,
-         finish_d INTEGER NOT NULL,
-         finish_ps INTEGER NOT NULL,
-         result_kind TINYINT NOT NULL,
-         result_code INTEGER,
-         result_msg TEXT,
-         console BLOB NOT NULL,
-         script TEXT NOT NULL,
-         main_binary INTEGER,
-         job INTEGER NOT NULL,
-
-         FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
-         FOREIGN KEY(job) REFERENCES job(id)
-       )
-    |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE new_build (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       uuid VARCHAR(36) NOT NULL UNIQUE,
+       start_d INTEGER NOT NULL,
+       start_ps INTEGER NOT NULL,
+       finish_d INTEGER NOT NULL,
+       finish_ps INTEGER NOT NULL,
+       result_kind TINYINT NOT NULL,
+       result_code INTEGER,
+       result_msg TEXT,
+       console BLOB NOT NULL,
+       script TEXT NOT NULL,
+       main_binary INTEGER,
+       job INTEGER NOT NULL,
+
+       FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
+       FOREIGN KEY(job) REFERENCES job(id)
+     )
+  |}
 
 let insert_from_old_build =
-  Caqti_request.exec ~oneshot:true
-    (Builder_db.Rep.id (`user : [`user]))
-    {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
-                              result_kind, result_code, result_msg, console,
-                              script, main_binary, job, user)
-       SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
-         result_code, result_msg, console, script, main_binary, job, ?
-       FROM build |}
+  Builder_db.Rep.id (`user : [`user]) ->. Caqti_type.unit @@
+  {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
+                            result_kind, result_code, result_msg, console,
+                            script, main_binary, job, user)
+     SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
+       result_code, result_msg, console, script, main_binary, job, ?
+     FROM build |}
 
 let insert_from_new_build =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
-                              result_kind, result_code, result_msg, console,
-                              script, main_binary, job)
-       SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
-         result_code, result_msg, console, script, main_binary, job
-       FROM build |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps,
+                            result_kind, result_code, result_msg, console,
+                            script, main_binary, job)
+     SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
+       result_code, result_msg, console, script, main_binary, job
+     FROM build |}
 
 let drop_build =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "DROP TABLE build"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DROP TABLE build"
 
 let rename_build =
-  Caqti_request.exec ~oneshot:true
-    Caqti_type.unit
-    "ALTER TABLE new_build RENAME TO build"
-
-open Grej.Infix
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "ALTER TABLE new_build RENAME TO build"
 
 let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->

bin/migrations/m20210625.ml

@@ -3,28 +3,26 @@ let identifier = "2021-06-25"
 let migrate_doc = "drop build_file table"
 let rollback_doc = "recreate build_file table"
 
+open Grej.Infix
+
 let build_file =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE build_file (
-           id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-           filepath TEXT NOT NULL, -- the path as in the build
-           localpath TEXT NOT NULL, -- local path to the file on disk
-           sha256 BLOB NOT NULL,
-           size INTEGER NOT NULL,
-           build INTEGER NOT NULL,
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE build_file (
+         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+         filepath TEXT NOT NULL, -- the path as in the build
+         localpath TEXT NOT NULL, -- local path to the file on disk
+         sha256 BLOB NOT NULL,
+         size INTEGER NOT NULL,
+         build INTEGER NOT NULL,
 
-           FOREIGN KEY(build) REFERENCES build(id),
-           UNIQUE(build, filepath)
-         )
-      |}
+         FOREIGN KEY(build) REFERENCES build(id),
+         UNIQUE(build, filepath)
+       )
+  |}
 
 let drop_build_file =
-  Caqti_request.exec
-    Caqti_type.unit
-    "DROP TABLE build_file"
-
-open Grej.Infix
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DROP TABLE build_file"
 
 let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->

bin/migrations/m20210629.ml

@@ -3,55 +3,50 @@ let identifier = "2021-06-29"
 let migrate_doc = "add tag and job_tag table"
 let rollback_doc = "remove tag and job tag table"
 
+open Grej.Infix
+
 let tag =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE tag (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         tag VARCHAR(255) NOT NULL UNIQUE
-       )
-    |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE tag (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       tag VARCHAR(255) NOT NULL UNIQUE
+     )
+  |}
 
 let job_tag =
-  Caqti_request.exec
-    Caqti_type.unit
-    {| CREATE TABLE job_tag (
-         id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
-         tag INTEGER NOT NULL,
-         value TEXT NOT NULL,
-         job INTEGER NOT NULL,
-
-         FOREIGN KEY(job) REFERENCES job(id),
-         FOREIGN KEY(tag) REFERENCES tag(id),
-         UNIQUE(tag, job)
-       )
-     |}
+  Caqti_type.unit ->. Caqti_type.unit @@
+  {| CREATE TABLE job_tag (
+       id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
+       tag INTEGER NOT NULL,
+       value TEXT NOT NULL,
+       job INTEGER NOT NULL,
+
+       FOREIGN KEY(job) REFERENCES job(id),
+       FOREIGN KEY(tag) REFERENCES tag(id),
+       UNIQUE(tag, job)
+     )
+  |}
 
 let jobs =
-  Caqti_request.collect
-    Caqti_type.unit
-    Builder_db.Rep.untyped_id
-    "SELECT id FROM job"
+  Caqti_type.unit ->* Builder_db.Rep.untyped_id @@
+  "SELECT id FROM job"
 
 let latest_successful_build =
-  Caqti_request.find_opt
-    Builder_db.Rep.untyped_id
-    Builder_db.Rep.untyped_id
-    {| SELECT b.id
-       FROM build b
-       WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0
-       ORDER BY b.start_d DESC, b.start_ps DESC
-       LIMIT 1
-    |}
+  Builder_db.Rep.untyped_id ->? Builder_db.Rep.untyped_id @@
+  {| SELECT b.id
+     FROM build b
+     WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0
+     ORDER BY b.start_d DESC, b.start_ps DESC
+     LIMIT 1
+  |}
 
 let build_artifacts =
-  Caqti_request.collect
-    Builder_db.Rep.untyped_id
-    Caqti_type.(tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath)
-    {| SELECT a.filepath, a.localpath
-       FROM build_artifact a
-       WHERE a.build = ?
-    |}
+  Builder_db.Rep.untyped_id ->*
+  Caqti_type.tup2 Builder_db.Rep.fpath Builder_db.Rep.fpath @@
+  {| SELECT a.filepath, a.localpath
+     FROM build_artifact a
+     WHERE a.build = ?
+  |}
 
 
 let infer_section_and_synopsis artifacts =
@@ -99,32 +94,25 @@ let infer_section_and_synopsis artifacts =
     Some section, infer_synopsis_and_descr opam_switch
 
 let remove_tag =
-  Caqti_request.exec
-    Caqti_type.unit
-    "DROP TABLE tag"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DROP TABLE tag"
 
 let remove_job_tag =
-  Caqti_request.exec
-    Caqti_type.unit
-    "DROP TABLE job_tag"
+  Caqti_type.unit ->. Caqti_type.unit @@
+  "DROP TABLE job_tag"
 
 let insert_tag =
-   Caqti_request.exec
-     Caqti_type.string
-     "INSERT INTO tag (tag) VALUES (?)"
+  Caqti_type.string ->. Caqti_type.unit @@
+  "INSERT INTO tag (tag) VALUES (?)"
 
 let insert_job_tag =
-   Caqti_request.exec
-     Caqti_type.(tup3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id)
-     "INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"
+  Caqti_type.(tup3 Builder_db.Rep.untyped_id string Builder_db.Rep.untyped_id) ->.
+  Caqti_type.unit @@
+  "INSERT INTO job_tag (tag, value, job) VALUES (?, ?, ?)"
 
 let find_tag =
-   Caqti_request.find
-     Caqti_type.string
-     Builder_db.Rep.untyped_id
-     "SELECT id FROM tag where tag = ?"
-
-open Grej.Infix
+  Caqti_type.string ->! Builder_db.Rep.untyped_id @@
+  "SELECT id FROM tag where tag = ?"
 
 let migrate datadir (module Db : Caqti_blocking.CONNECTION) =
   Grej.check_version ~user_version:old_version (module Db) >>= fun () ->

bin/migrations/m20210630.ml

@@ -3,59 +3,49 @@ let identifier = "2021-06-30"
 let migrate_doc = "add readme.md tag"
 let rollback_doc = "remove readme.md tag"
 
+open Grej.Infix
+
 let jobs =
-  Caqti_request.collect
-    Caqti_type.unit