upgrade guardian for caqti version 2.0.1

uzh · Nov 17, 2023 · 9f68a2a · 9f68a2a
1 parent f144f2c
commit 9f68a2a
Show file tree

Hide file tree

Showing 7 changed files with 51 additions and 44 deletions.
diff --git a/backend/database_pools.ml b/backend/database_pools.ml
@@ -53,13 +53,15 @@ end
 
 module Make (Config : ConfigSig) = struct
   let main_pool_ref
-    : (Caqti_lwt.connection, Caqti_error.t) Caqti_lwt.Pool.t option ref
+    : (Caqti_lwt.connection, Caqti_error.t) Caqti_lwt_unix.Pool.t option ref
     =
     ref None
   ;;
 
   let pools
-    : (string, (Caqti_lwt.connection, Caqti_error.t) Caqti_lwt.Pool.t) Hashtbl.t
+    : ( string
+        , (Caqti_lwt.connection, Caqti_error.t) Caqti_lwt_unix.Pool.t )
+        Hashtbl.t
     =
     let spare_for_pools = 5 in
     Hashtbl.create
@@ -69,7 +71,7 @@ module Make (Config : ConfigSig) = struct
   ;;
 
   let print_pool_usage ?tags pool =
-    let n_connections = Caqti_lwt.Pool.size pool in
+    let n_connections = Caqti_lwt_unix.Pool.size pool in
     let max_connections = Config.database_pool_size in
     Logs.debug ~src (fun m ->
       m ?tags "Pool usage: %i/%i" n_connections max_connections)
@@ -82,7 +84,8 @@ module Make (Config : ConfigSig) = struct
     =
     database_url
     |> Uri.of_string
-    |> Caqti_lwt.connect_pool ~max_size:pool_size
+    |> Caqti_lwt_unix.connect_pool
+         ~pool_config:(Caqti_pool_config.create ~max_size:pool_size ())
     |> map_or_raise ~msg_prefix:"Failed to connect to DB pool" ok_fun
   ;;
 
@@ -118,7 +121,7 @@ module Make (Config : ConfigSig) = struct
       Lwt.return_unit
     | MultiPools _, Some connection ->
       let () = Hashtbl.remove pools name in
-      let%lwt () = Caqti_lwt.Pool.drain connection in
+      let%lwt () = Caqti_lwt_unix.Pool.drain connection in
       Lwt.return_unit
   ;;
 
@@ -156,7 +159,7 @@ module Make (Config : ConfigSig) = struct
     let open Lwt.Infix in
     let pool = fetch_pool ?ctx () in
     print_pool_usage pool;
-    Caqti_lwt.Pool.use
+    Caqti_lwt_unix.Pool.use
       (fun connection ->
         Logs.debug ~src (fun m ->
           m ?tags:(LogTag.ctx_opt ?ctx ()) "Fetched connection from pool");
@@ -214,7 +217,9 @@ module Make (Config : ConfigSig) = struct
     let open Lwt.Infix in
     let pool = fetch_pool ?ctx () in
     print_pool_usage pool;
-    Caqti_lwt.Pool.use (fun connection -> f connection >|= CCResult.return) pool
+    Caqti_lwt_unix.Pool.use
+      (fun connection -> f connection >|= CCResult.return)
+      pool
     >|= get_or_raise ?ctx ()
   ;;
 

diff --git a/backend/database_pools_sig.ml b/backend/database_pools_sig.ml
@@ -4,7 +4,7 @@ module type Sig = sig
   val fetch_pool
     :  ?ctx:(string * string) list
     -> unit
-    -> (Caqti_lwt.connection, Caqti_error.t) Caqti_lwt.Pool.t
+    -> (Caqti_lwt.connection, Caqti_error.t) Caqti_lwt_unix.Pool.t
 
   val add_pool : ?pool_size:int -> string -> string -> unit
   val drop_pool : string -> unit Lwt.t

diff --git a/backend/dune b/backend/dune
@@ -5,6 +5,7 @@
   caqti
   caqti-driver-mariadb
   caqti-lwt
+  caqti-lwt.unix
   containers
   containers-data
   guardian

diff --git a/backend/mariadb_backend.ml b/backend/mariadb_backend.ml
@@ -105,7 +105,7 @@ struct
           Ok { actor_uuid; role; target_uuid = Some target_uuid }
         in
         Caqti_type.(
-          custom ~encode ~decode (tup3 Uuid.Actor.t Role.t Uuid.Target.t))
+          custom ~encode ~decode (t3 Uuid.Actor.t Role.t Uuid.Target.t))
       ;;
 
       let role =
@@ -119,7 +119,7 @@ struct
         let decode (actor_uuid, role) =
           Ok { actor_uuid; role; target_uuid = None }
         in
-        Caqti_type.(custom ~encode ~decode (tup2 Uuid.Actor.t Role.t))
+        Caqti_type.(custom ~encode ~decode (t2 Uuid.Actor.t Role.t))
       ;;
 
       let t =
@@ -128,10 +128,7 @@ struct
           Ok { actor_uuid; role; target_uuid }
         in
         Caqti_type.(
-          custom
-            ~encode
-            ~decode
-            (tup3 Uuid.Actor.t Role.t (option Uuid.Target.t)))
+          custom ~encode ~decode (t3 Uuid.Actor.t Role.t (option Uuid.Target.t)))
       ;;
     end
 
@@ -141,7 +138,7 @@ struct
       let t =
         let encode m = Ok (m.uuid, m.model) in
         let decode (uuid, model) = Ok { uuid; model } in
-        Caqti_type.(custom ~encode ~decode (tup2 Uuid.Actor.t ActorModel.t))
+        Caqti_type.(custom ~encode ~decode (t2 Uuid.Actor.t ActorModel.t))
       ;;
     end
 
@@ -151,7 +148,7 @@ struct
       let t =
         let encode m = Ok (m.uuid, m.model) in
         let decode (uuid, model) = Ok { uuid; model } in
-        Caqti_type.(custom ~encode ~decode (tup2 Uuid.Target.t TargetModel.t))
+        Caqti_type.(custom ~encode ~decode (t2 Uuid.Target.t TargetModel.t))
       ;;
     end
 
@@ -181,7 +178,7 @@ struct
           custom
             ~encode
             ~decode
-            (tup2 (option TargetModel.t) (option Uuid.Target.t)))
+            (t2 (option TargetModel.t) (option Uuid.Target.t)))
       ;;
     end
 
@@ -192,7 +189,7 @@ struct
         let encode m = Ok (m.role, m.permission, m.model) in
         let decode (role, permission, model) = Ok { role; permission; model } in
         Caqti_type.(
-          custom ~encode ~decode (tup3 Role.t Permission.t TargetModel.t))
+          custom ~encode ~decode (t3 Role.t Permission.t TargetModel.t))
       ;;
     end
 
@@ -205,7 +202,7 @@ struct
           Ok { actor_uuid; permission; target }
         in
         Caqti_type.(
-          custom ~encode ~decode (tup3 Uuid.Actor.t Permission.t TargetEntity.t))
+          custom ~encode ~decode (t3 Uuid.Actor.t Permission.t TargetEntity.t))
       ;;
     end
 
@@ -221,7 +218,7 @@ struct
           custom
             ~encode
             ~decode
-            (tup3 Permission.t TargetModel.t (option Uuid.Target.t)))
+            (t3 Permission.t TargetModel.t (option Uuid.Target.t)))
       ;;
     end
   end
@@ -388,7 +385,7 @@ struct
               WHERE roles.role = $1
                 AND roles.mark_as_deleted IS NULL
             |sql}
-            |> Entity.(Caqti_type.tup2 Role.t Uuid.Target.t ->* ActorRole.t)
+            |> Entity.(Caqti_type.t2 Role.t Uuid.Target.t ->* ActorRole.t)
           ;;
 
           let find_by_target ?ctx = Database.collect ?ctx find_by_target_request
@@ -567,7 +564,7 @@ struct
               WHERE actor_uuid = guardianEncodeUuid($1)
                 AND role = $2
             |sql}
-            |> Caqti_type.(tup2 Uuid.Actor.t Entity.Role.t ->. unit)
+            |> Caqti_type.(t2 Uuid.Actor.t Entity.Role.t ->. unit)
           ;;
 
           let delete ?ctx role =
@@ -885,7 +882,7 @@ struct
               SET model = $2, mark_as_deleted = NULL
               WHERE uuid = guardianEncodeUuid($1)
             |sql}
-            |> Caqti_type.(tup2 Uuid.Target.t TargetModel.t ->. unit)
+            |> Caqti_type.(t2 Uuid.Target.t TargetModel.t ->. unit)
           ;;
 
           let promote ?ctx = CCFun.curry (Database.exec ?ctx promote_request)
@@ -918,7 +915,7 @@ struct
               )
             |sql}
             |> Caqti_type.(
-                 tup3 Uuid.Actor.t Permission.t TargetModel.t ->? option bool)
+                 t3 Uuid.Actor.t Permission.t TargetModel.t ->? option bool)
           in
           Database.find_opt ?ctx validate_request (actor_uuid, permission, model)
           >|= CCOption.(flatten %> value ~default:false)
@@ -982,9 +979,9 @@ struct
               )
             |sql}
             |> Caqti_type.(
-                 tup2
+                 t2
                    Uuid.Actor.t
-                   (tup2 Permission.t (tup2 TargetModel.t Uuid.Target.t))
+                   (t2 Permission.t (t2 TargetModel.t Uuid.Target.t))
                  ->? option bool)
           in
           Database.find_opt
@@ -1007,7 +1004,7 @@ struct
           let to_req =
             let open Entity in
             Caqti_type.(
-              tup3 Uuid.Actor.t Permission.t TargetModel.t ->? option bool)
+              t3 Uuid.Actor.t Permission.t TargetModel.t ->? option bool)
           in
           let find_bool request =
             Database.find_opt ?ctx request (actor_uuid, permission, model)

diff --git a/dune-project b/dune-project
@@ -30,11 +30,9 @@
   "Defined actors can access targets according to specified rules (allowed actions: CRUD).")
  (depends
   (caqti-driver-mariadb
-   (>= 1.9.0))
+   (>= 2.0.1))
   (caqti-lwt
-   (and
-    (>= 1.9.0)
-    (< 2.0.0)))
+   (>= 2.0.1))
   (containers
    (>= 3.6))
   (containers-data

diff --git a/guardian.opam b/guardian.opam
@@ -14,8 +14,8 @@ doc: "https://uzh.github.io/guardian"
 bug-reports: "https://github.com/uzh/guardian/issues"
 depends: [
   "dune" {>= "2.9"}
-  "caqti-driver-mariadb" {>= "1.9.0"}
-  "caqti-lwt" {>= "1.9.0" & < "2.0.0"}
+  "caqti-driver-mariadb" {>= "2.0.1"}
+  "caqti-lwt" {>= "2.0.1"}
   "containers" {>= "3.6"}
   "containers-data" {>= "3.6"}
   "logs" {>= "0.7.0"}

diff --git a/guardian.opam.locked b/guardian.opam.locked
@@ -13,15 +13,15 @@ doc: "https://uzh.github.io/guardian"
 bug-reports: "https://github.com/uzh/guardian/issues"
 depends: [
   "angstrom" {= "0.15.0"}
-  "base" {= "v0.14.3"}
+  "base" {= "v0.16.3"}
   "base-bytes" {= "base"}
   "base-threads" {= "base"}
   "base-unix" {= "base"}
   "bigarray-compat" {= "1.1.0"}
   "bigstringaf" {= "0.9.1"}
-  "caqti" {= "1.9.0"}
-  "caqti-driver-mariadb" {= "1.9.0"}
-  "caqti-lwt" {= "1.9.0"}
+  "caqti" {= "2.0.1"}
+  "caqti-driver-mariadb" {= "2.0.1"}
+  "caqti-lwt" {= "2.0.1"}
   "cmdliner" {= "1.2.0"}
   "conf-gcc" {= "1.0"}
   "conf-mariadb" {= "2"}
@@ -31,15 +31,20 @@ depends: [
   "cppo" {= "1.6.9"}
   "csexp" {= "1.5.2"}
   "ctypes" {= "0.20.2"}
-  "dune" {= "3.11.0"}
-  "dune-configurator" {= "3.11.0"}
+  "domain-name" {= "0.4.0"}
+  "dune" {= "3.11.1"}
+  "dune-configurator" {= "3.11.1"}
   "either" {= "1.0.0"}
   "fmt" {= "0.9.0"}
   "integers" {= "0.7.0"}
+  "ipaddr" {= "5.5.0"}
   "logs" {= "0.7.0"}
   "lwt" {= "5.7.0"}
+  "lwt-dllist" {= "1.0.1"}
   "lwt_ppx" {= "2.1.0"}
+  "macaddr" {= "5.5.0"}
   "mariadb" {= "1.1.6"}
+  "mtime" {= "2.0.0"}
   "ocaml" {= "4.14.1"}
   "ocaml-compiler-libs" {= "v0.12.4"}
   "ocaml-syntax-shims" {= "1.0.0"}
@@ -48,18 +53,19 @@ depends: [
   "ocplib-endian" {= "1.2"}
   "ppx_derivers" {= "1.2.1"}
   "ppx_deriving" {= "5.2.1"}
-  "ppx_deriving_yojson" {= "3.6.1"}
-  "ppx_sexp_conv" {= "v0.14.3"}
-  "ppxlib" {= "0.25.1"}
+  "ppx_deriving_yojson" {= "3.7.0"}
+  "ppx_sexp_conv" {= "v0.16.0"}
+  "ppxlib" {= "0.31.0"}
   "ptime" {= "1.1.0"}
   "result" {= "1.5"}
   "seq" {= "base"}
-  "sexplib0" {= "v0.14.0"}
+  "sexplib0" {= "v0.16.0"}
   "stdlib-shims" {= "0.3.0"}
   "stringext" {= "1.6.0"}
   "topkg" {= "1.0.7"}
   "uri" {= "4.4.0"}
-  "yojson" {= "2.1.0"}
+  "uuidm" {= "0.9.8"}
+  "yojson" {= "2.1.1"}
 ]
 build: [
   ["dune" "subst"] {dev}