unikernel/duniverse/ocaml-caqti/caqti-lwt/lib-unix/caqti_lwt_unix.ml

@@ -0,0 +1,38 @@
+(* Copyright (C) 2014--2024  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+open Caqti_platform
+
+module System = System
+module Pool = System.Pool
+
+module Loader = Caqti_platform_unix.Driver_loader.Make (System) (System_unix)
+
+include Connector.Make (System) (Pool) (Loader)
+
+let connect
+      ?subst ?env ?config ?tweaks_version ?(sw = Caqti_lwt.Switch.eternal) uri =
+  connect ?subst ?env ?config ?tweaks_version ~sw ~stdenv:() uri
+
+let with_connection = with_connection ~stdenv:()
+
+let connect_pool
+      ?pool_config ?post_connect ?subst ?env ?config ?tweaks_version
+      ?(sw = Caqti_lwt.Switch.eternal) uri =
+  connect_pool
+    ?pool_config ?post_connect ?subst ?env ?config ?tweaks_version
+    ~sw ~stdenv:() uri

unikernel/duniverse/ocaml-caqti/caqti-lwt/lib-unix/caqti_lwt_unix.mli

@@ -0,0 +1,37 @@
+(* Copyright (C) 2014--2023  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+(** Connecting on Unix-like platforms using Lwt
+
+    This module contains functions for connecting to databases using the
+    lwt.unix library, providing support for all drivers.
+
+    See also {!Caqti_lwt} for basic Lwt support. *)
+
+(**/**) (* for test_pool_lwt.ml *)
+module System = System
+(**/**)
+
+module Pool : Caqti_pool_sig.S with type 'a fiber := 'a Lwt.t
+
+include Caqti_connect_sig.S
+  with type 'a fiber := 'a Lwt.t
+   and type ('a, 'e) stream := ('a, 'e) Caqti_lwt.Stream.t
+   and type ('a, 'e) pool := ('a, 'e) Pool.t
+   and type connection := Caqti_lwt.connection
+   and type 'a with_switch := ?sw: Caqti_lwt.Switch.t -> 'a
+   and type 'a with_stdenv := 'a

unikernel/duniverse/ocaml-caqti/caqti-lwt/lib-unix/dune

@@ -0,0 +1,8 @@
+(library
+  (name caqti_lwt_unix)
+  (public_name caqti-lwt.unix)
+  (libraries
+    caqti caqti-lwt caqti.platform caqti.platform.unix
+    domain-name ipaddr
+    logs logs.lwt lwt lwt.unix
+    mtime mtime.clock.os))

unikernel/duniverse/ocaml-caqti/caqti-lwt/lib-unix/system.ml

@@ -0,0 +1,148 @@
+(* Copyright (C) 2023--2024  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+open Lwt.Infix
+
+type Caqti_error.msg += Msg_unix of Unix.error * string * string
+
+let () =
+  let pp ppf = function
+   | Msg_unix (err, func, arg) ->
+      Format.fprintf ppf "%s in %s(%S)" (Unix.error_message err) func arg
+   | _ -> assert false
+  in
+  Caqti_error.define_msg ~pp [%extension_constructor Msg_unix]
+
+module System_core = struct
+  include Caqti_lwt.System_core
+  type stdenv = unit
+end
+include System_core
+
+module Alarm = struct
+
+  type t = {cancel: unit -> unit}
+
+  let schedule ~sw:_ ~stdenv:() t f =
+    let t_now = Mtime_clock.now () in
+    let delay =
+      if Mtime.is_later t ~than:t_now then
+        Lwt.pause ()
+      else
+        Lwt_unix.sleep (Mtime.Span.to_float_ns (Mtime.span t t_now) *. 1e-9)
+    in
+    let task = delay >|= f in
+    {cancel = (fun () -> Lwt.cancel task)}
+
+  let unschedule alarm = alarm.cancel ()
+end
+
+module Stream = Caqti_lwt.Stream
+module Pool = Caqti_platform.Pool.Make (System_core) (Alarm)
+
+module Net = struct
+
+  module type SOCKET_OPS = Caqti_platform.System_sig.SOCKET_OPS
+    with type 'a fiber := 'a Lwt.t
+     and type t = Lwt_io.input_channel * Lwt_io.output_channel
+
+  module Sockaddr = struct
+    type t = Unix.sockaddr
+    let unix s = Unix.ADDR_UNIX s
+    let tcp (addr, port) =
+      Unix.ADDR_INET (Unix.inet_addr_of_string (Ipaddr.to_string addr), port)
+  end
+
+  let getaddrinfo ~stdenv:() host port =
+    Lwt.catch
+      (fun () ->
+        let opts = Unix.[AI_SOCKTYPE SOCK_STREAM] in
+        Lwt_unix.getaddrinfo
+          (Domain_name.to_string host) (string_of_int port) opts
+          >|= List.map (fun ai -> ai.Unix.ai_addr) >|= Result.ok)
+      (function
+       | Not_found -> Lwt.return_ok []
+       | Unix.Unix_error (code, _, _) ->
+          Lwt.return_error
+            (`Msg ("Cannot resolve host name: " ^ Unix.error_message code))
+       | exn -> Lwt.fail exn)
+
+  let convert_io_exception = function
+   | Unix.Unix_error (err, fn, arg) -> Some (Msg_unix (err, fn, arg))
+   | _ -> None
+
+  type socket = {
+    fd: Lwt_unix.file_descr option;
+    ic: Lwt_io.input_channel;
+    oc: Lwt_io.output_channel;
+  }
+
+  module Socket = struct
+    type t = socket
+    let output_char {oc; _} data = Lwt_io.write_char oc data
+    let output_string {oc; _} data = Lwt_io.write oc data
+    let flush {oc; _} = Lwt_io.flush oc
+    let input_char {ic; _} = Lwt_io.read_char ic
+    let really_input {ic; _} data offset length =
+      Lwt_io.read_into_exactly ic data offset length
+    let close {oc; _} = Lwt_io.close oc (* CHECKME *)
+  end
+
+  type tcp_flow = Lwt_unix.file_descr
+  type tls_flow = Lwt_io.input_channel * Lwt_io.output_channel
+
+  let connect_tcp ~sw:_ ~stdenv:() sockaddr =
+    let domain = Unix.domain_of_sockaddr sockaddr in
+    let fd = Lwt_unix.socket domain Unix.SOCK_STREAM 0 in
+    Lwt.catch
+      (fun () ->
+        (try Lwt_unix.set_close_on_exec fd with _ -> ());
+        Lwt_unix.connect fd sockaddr >|= fun () ->
+        let ic = Lwt_io.(of_fd ~mode:input) fd in
+        let oc = Lwt_io.(of_fd ~mode:output) fd in
+        Ok {fd = Some fd; ic; oc})
+      (function
+       | Unix.Unix_error (err, fn, arg) ->
+          Lwt_unix.close fd >|= fun () ->
+          Error (Msg_unix (err, fn, arg))
+       | exn ->
+          Lwt_unix.close fd >>= fun () ->
+          Lwt.fail exn)
+
+  let tcp_flow_of_socket {fd; _} = fd
+
+  let socket_of_tls_flow ~sw:_ (ic, oc) = {fd = None; ic; oc}
+
+  module type TLS_PROVIDER = Caqti_platform.System_sig.TLS_PROVIDER
+    with type 'a fiber := 'a Lwt.t
+     and type tcp_flow := tcp_flow
+     and type tls_flow := tls_flow
+
+  let tls_providers_r : (module TLS_PROVIDER) list ref = ref []
+
+  let tls_providers config =
+    if Caqti_connect_config.mem_name "tls" config then
+      (match Caqti_platform.Connector.load_library "caqti-tls-lwt.unix" with
+       | Ok () -> ()
+       | Error msg ->
+          Logs.warn ~src:Caqti_platform.Logging.default_log_src (fun p ->
+            p "TLS configured, but missing caqti-tls-lwt.unix: %s" msg));
+    !tls_providers_r
+
+  let register_tls_provider p = tls_providers_r := p :: !tls_providers_r
+
+end

unikernel/duniverse/ocaml-caqti/caqti-lwt/lib-unix/system.mli

@@ -0,0 +1,35 @@
+(* Copyright (C) 2023  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+(**/**)
+
+include Caqti_platform.System_sig.S
+  with type 'a Fiber.t = 'a Lwt.t
+   and type stdenv = unit
+   and module Stream = Caqti_lwt.Stream
+   and type Switch.t = Caqti_lwt.Switch.t
+   and type Net.tcp_flow = Lwt_unix.file_descr
+   and type Net.tls_flow = Lwt_io.input_channel * Lwt_io.output_channel
+
+module Alarm : Caqti_platform.Pool.ALARM
+  with type switch := Switch.t
+   and type stdenv := unit
+
+module Pool : Caqti_platform.Pool.S
+  with type 'a fiber := 'a Lwt.t
+   and type switch := Switch.t
+   and type stdenv := unit

unikernel/duniverse/ocaml-caqti/caqti-lwt/lib-unix/system_unix.ml

@@ -0,0 +1,44 @@
+(* Copyright (C) 2023  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+open Lwt.Infix
+
+module Preemptive = Lwt_preemptive
+
+module Unix = struct
+  type file_descr = Lwt_unix.file_descr
+
+  let wrap_fd f fd = f (Lwt_unix.of_unix_file_descr fd)
+
+  let poll ~stdenv:() ?(read = false) ?(write = false) ?timeout fd =
+    let choices = []
+      |> (fun acc -> if read then Lwt_unix.wait_read fd :: acc else acc)
+      |> (fun acc -> if write then Lwt_unix.wait_write fd :: acc else acc)
+      |> Option.fold
+          ~none:Fun.id ~some:(fun t acc -> Lwt_unix.timeout t :: acc) timeout
+    in
+    if choices = [] then
+      Lwt.fail_invalid_arg "Caqti_lwt.Unix.poll: No operation specified."
+    else
+    Lwt.catch
+      (fun () -> Lwt.choose choices >|= fun _ -> false)
+      (function
+       | Lwt_unix.Timeout -> Lwt.return_true
+       | exn -> Lwt.fail exn)
+      >|= fun timed_out ->
+    (Lwt_unix.readable fd, Lwt_unix.writable fd, timed_out)
+end

unikernel/duniverse/ocaml-caqti/caqti-lwt/lib/caqti_lwt.ml

@@ -0,0 +1,78 @@
+(* Copyright (C) 2022--2025  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+open Caqti_platform
+
+module Fiber = struct
+  type 'a t = 'a Lwt.t
+
+  module Infix = struct
+    let (>>=) = Lwt.Infix.(>>=)
+    let (>|=) = Lwt.Infix.(>|=)
+  end
+  open Infix
+
+  let return = Lwt.return
+  let catch = Lwt.catch
+  let finally = Lwt.finalize
+  let cleanup f g = Lwt.catch f (fun exn -> g () >>= fun () -> Lwt.fail exn)
+end
+
+module Stream = Caqti_platform.Stream.Make (Fiber)
+module Switch = Caqti_platform.Switch.Make (Fiber)
+
+module System_core = struct
+  module Fiber = Fiber
+  module Stream = Stream
+  module Switch = Switch
+
+  let async ~sw:_ = Lwt.async
+
+  module Mutex = Lwt_mutex
+
+  module Condition = struct
+    type t = unit Lwt_condition.t
+    let create = Lwt_condition.create
+    let wait c mutex = Lwt_condition.wait ~mutex c
+    let signal c = Lwt_condition.signal c ()
+  end
+
+  module Log = struct
+    type 'a log = 'a Logs_lwt.log
+    let err ?(src = Logging.default_log_src) = Logs_lwt.err ~src
+    let warn ?(src = Logging.default_log_src) = Logs_lwt.warn ~src
+    let info ?(src = Logging.default_log_src) = Logs_lwt.info ~src
+    let debug ?(src = Logging.default_log_src) = Logs_lwt.debug ~src
+  end
+
+  (* Cf. pgx_lwt. *)
+  module Sequencer = struct
+    type 'a t = 'a * Lwt_mutex.t
+    let create m = (m, Lwt_mutex.create ())
+    let enqueue (m, mutex) f = Lwt_mutex.with_lock mutex (fun () -> f m)
+  end
+end
+
+module type CONNECTION = Caqti_connection_sig.S
+  with type 'a fiber := 'a Lwt.t
+   and type ('a, 'e) stream := ('a, 'e) Stream.t
+
+type connection = (module CONNECTION)
+
+let or_fail = function
+ | Ok x -> Lwt.return x
+ | Error (#Caqti_error.t as err) -> Lwt.fail (Caqti_error.Exn err)

unikernel/duniverse/ocaml-caqti/caqti-lwt/lib/caqti_lwt.mli

@@ -0,0 +1,52 @@
+(* Copyright (C) 2022--2023  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+(** Prerequisities for connecting to databases using Lwt
+
+    This module contains most of the prerequisite types and modules.  Functions
+    to establish database connections are provided by the [caqti-lwt.unix] and
+    [caqti-mirage] libraries.  Pool instances are also found there due to
+    additional OS dependencies. *)
+
+(* A custom stream implementation instantiated for Lwt.  This is similar to
+ * {!Lwt_seq}, except with error handling. *)
+module Stream : Caqti_stream_sig.S with type 'a fiber := 'a Lwt.t
+
+(* This should ideally be {!Lwt_switch}, but we need a way to cancel cleanup
+ * jobs in order to avoid a memory leaks for long-lived pools. *)
+module Switch : Caqti_switch_sig.S with type 'a fiber := 'a Lwt.t
+
+(**/**)
+(* For private use by caqti-lwt.unix and caqti-mirage. *)
+module System_core : sig
+  include Caqti_platform.System_sig.CORE
+    with type 'a Fiber.t = 'a Lwt.t
+     and module Stream = Stream
+     and type Switch.t = Switch.t
+     and type stdenv := unit
+end
+(**/**)
+
+module type CONNECTION = Caqti_connection_sig.S
+  with type 'a fiber := 'a Lwt.t
+   and type ('a, 'e) stream := ('a, 'e) Stream.t
+
+type connection = (module CONNECTION)
+
+val or_fail : ('a, [< Caqti_error.t]) result -> 'a Lwt.t
+(** Converts an error to an Lwt future failed with a {!Caqti_error.Exn}
+    exception holding the error. *)

unikernel/duniverse/ocaml-caqti/caqti-lwt/lib/dune

@@ -0,0 +1,4 @@
+(library
+ (name caqti_lwt)
+ (public_name caqti-lwt)
+ (libraries logs.lwt lwt caqti.platform))

unikernel/duniverse/ocaml-caqti/caqti-lwt/test-unix/dune

@@ -0,0 +1,4 @@
+(test
+ (name main)
+ (package caqti-lwt)
+ (libraries alcotest alcotest-lwt caqti caqti-lwt caqti-lwt.unix testlib))

unikernel/duniverse/ocaml-caqti/caqti-lwt/test-unix/main.ml

@@ -0,0 +1,22 @@
+(* Copyright (C) 2021--2023  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+let () = Lwt_main.run begin
+  Alcotest_lwt.V1.run "caqti-lwt" [
+    "pool-lwt", Test_pool_lwt.test_cases;
+  ]
+end

unikernel/duniverse/ocaml-caqti/caqti-lwt/test-unix/test_pool_lwt.ml

@@ -0,0 +1,163 @@
+(* Copyright (C) 2014--2025  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+open Lwt.Infix
+open Lwt.Syntax
+
+module Pool = Caqti_lwt_unix.System.Pool
+
+module Resource = struct
+  type t = {
+    id: int;
+    mutable use_count: int;
+  }
+
+  let alive = Hashtbl.create 17
+
+  let latest_id = ref 0
+
+  let create () =
+    incr latest_id;
+    Hashtbl.add alive !latest_id ();
+    Lwt.return_ok {id = !latest_id; use_count = 0}
+
+  let create_or_fail () =
+    if Random.int 4 = 0 then Lwt.return_error () else
+    create ()
+
+  let free resource =
+    assert (Hashtbl.mem alive resource.id);
+    Hashtbl.remove alive resource.id;
+    Lwt.return_unit
+end
+
+let test_n n =
+  Caqti_lwt.Switch.run @@ fun sw ->
+  let max_idle_size = Random.int 11 in
+  let max_size = max 1 (max_idle_size + Random.int 5) in
+  let max_use_count =
+    (match Random.bool () with
+     | false -> None
+     | true -> Some (1 + Random.int 8))
+  in
+  let pool =
+    let config =
+      Caqti_pool_config.create ~max_idle_size ~max_size ~max_use_count ()
+    in
+    Pool.create ~config ~sw ~stdenv:()
+      Resource.create_or_fail Resource.free
+  in
+  let wakers = Array.make n None in
+  let wait_count = ref 0 in
+  let wait_count_cond = Lwt_condition.create () in
+  let wake j u = Lwt.wakeup u (); wakers.(j) <- None in
+  for _ = 0 to 3 * n - 1 do
+    let j = Random.int n in
+    assert (Pool.size pool = Hashtbl.length Resource.alive);
+    (match wakers.(j) with
+     | None ->
+        let waiter, waker = Lwt.wait () in
+        incr wait_count;
+        let task (resource : Resource.t) =
+          (match max_use_count with
+           | None -> ()
+           | Some n -> assert (resource.use_count < n));
+          resource.use_count <- resource.use_count + 1;
+          waiter >|= fun () ->
+          decr wait_count;
+          Lwt_condition.signal wait_count_cond ();
+          Ok ()
+        in
+        Lwt.async begin fun () ->
+          Pool.use task pool >>=
+          (function
+           | Ok () -> Lwt.return_unit
+           | Error () ->
+              waiter >|= fun () ->
+              decr wait_count;
+              Lwt_condition.signal wait_count_cond ())
+        end;
+        wakers.(j) <- Some waker
+     | Some u -> wake j u)
+  done;
+  for j = 0 to n - 1 do
+    (match wakers.(j) with
+     | None -> ()
+     | Some u -> wake j u)
+  done;
+  let rec wait_for_all () =
+    if !wait_count = 0 then Lwt.return_unit else
+    Lwt_condition.wait wait_count_cond >>= wait_for_all
+  in
+  Lwt_unix.with_timeout 2.0 wait_for_all >>= fun () ->
+  assert (Pool.size pool <= max_idle_size);
+  Alcotest.(check int) "still waiting" 0 !wait_count;
+  Pool.drain pool >|= fun () ->
+  Alcotest.(check int) "pool size after drain" 0 (Pool.size pool);
+  Alcotest.(check int) "alive after drain" 0 (Hashtbl.length Resource.alive)
+
+let test _ () =
+  test_n 0 >>= fun () ->
+  test_n 1 >>= fun () ->
+  let rec loop n_it =
+    if n_it = 0 then Lwt.return_unit else
+    test_n (Random.int (1 lsl Random.int 12)) >>= fun () ->
+    loop (n_it - 1)
+  in
+  loop 500
+
+let create_gathering n =
+  let count = ref n in
+  let wait, disband = Lwt.task () in
+  fun () ->
+    decr count;
+    if !count > 0 then wait else
+    (Lwt.wakeup_later disband (); Lwt.return_unit)
+
+let test_age _ () =
+  Caqti_lwt.Switch.run @@ fun sw ->
+  let max_size = 8 in
+  let max_idle_size = 4 in
+  let max_idle_age = Some Mtime.Span.(100 * ms) in
+  let pool =
+    let config =
+      Caqti_pool_config.create ~max_size ~max_idle_size ~max_idle_age ()
+    in
+    Pool.create ~config ~sw ~stdenv:() Resource.create Resource.free
+  in
+  let user_count = 8 in
+  let join_gathering = create_gathering user_count in
+  let* () =
+    let f _i _resource = join_gathering () >|= Result.ok in
+    List.init user_count f
+      |> List.map (fun f -> Pool.use f pool >|= Result.get_ok)
+      |> Lwt.join
+  in
+  Alcotest.(check int) "pool size before sleep" 4 (Pool.size pool);
+  let+ () =
+    let rec wait_while_draining timeout =
+      if Pool.size pool = 0 then Lwt.return_unit else
+      Lwt_unix.sleep 0.1 >>= fun () -> wait_while_draining (timeout -. 0.1)
+    in
+    wait_while_draining 5.0
+  in
+  Alcotest.(check int) "pool size after sleep" 0 (Pool.size pool)
+
+let test_cases = [
+  Alcotest_lwt.V1.test_case "basic usage" `Quick test;
+  Alcotest_lwt.V1.test_case "timed cleanup" `Quick test_age;
+]

unikernel/duniverse/ocaml-caqti/caqti-lwt/testlib-unix/dune

@@ -0,0 +1,9 @@
+(library
+ (name testlib_lwt_unix)
+ (libraries
+    alcotest
+    caqti
+    caqti_lwt
+    caqti_lwt_unix
+    lwt
+    testlib))

unikernel/duniverse/ocaml-caqti/caqti-lwt/testlib-unix/testlib_lwt_unix.ml

@@ -0,0 +1,44 @@
+(* Copyright (C) 2021--2023  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+module Fiber = struct
+  type 'a t = 'a Lwt.t
+
+  let return = Lwt.return
+  let catch = Lwt.catch
+  let fail = Lwt.fail
+
+  module Infix = struct
+    let (>>=) = Lwt.Infix.(>>=)
+    let (>|=) = Lwt.Infix.(>|=)
+    let (>>=?) = Lwt_result.Infix.(>>=)
+    let (>|=?) = Lwt_result.Infix.(>|=)
+  end
+end
+
+open Fiber.Infix
+
+include Caqti_lwt
+include Caqti_lwt_unix
+
+module Alcotest_cli = Testlib.Make_alcotest_cli (Alcotest.Unix_platform) (Lwt)
+
+module List_result_fiber = struct
+  let rec iter_s f = function
+   | [] -> Fiber.return (Ok ())
+   | x :: xs -> f x >>=? fun () -> iter_s f xs
+end

unikernel/duniverse/ocaml-caqti/caqti-lwt/testlib-unix/testlib_lwt_unix.mli

@@ -0,0 +1,21 @@
+(* Copyright (C) 2021--2023  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+include Testlib.Sig.Ground
+  with type 'a Fiber.t = 'a Lwt.t
+   and module Stream = Caqti_lwt.Stream
+   and module Pool = Caqti_lwt_unix.Pool