From 22fee4024bc0676314c52b498582dfd01f30d24a Mon Sep 17 00:00:00 2001 From: Gusted Date: Fri, 10 Jan 2025 06:33:31 +0100 Subject: [PATCH 1/2] Add post_connect to sql_pool Allow for a custom post_connect to run for new SQL connection, for example registering user functions for SQLite connections. --- docs/web/postprocess/index.ml | 3 ++- src/dream.mli | 10 ++++++++-- src/sql/sql.ml | 13 ++++++++++--- 3 files changed, 20 insertions(+), 6 deletions(-) diff --git a/docs/web/postprocess/index.ml b/docs/web/postprocess/index.ml index 08d0cd20..35e901e4 100644 --- a/docs/web/postprocess/index.ml +++ b/docs/web/postprocess/index.ml @@ -1951,7 +1951,8 @@ let graphiql_expected = {|
|} let sql_pool_expected = {|
- val sql_pool : ?size:int -> string -> middleware + val sql_pool : ?size:int -> +?post_connect:((module Caqti_lwt.CONNECTION) -> (unit, Caqti_error.t) Stdlib.result promise) -> string -> middleware
|} diff --git a/src/dream.mli b/src/dream.mli index d5b98d97..0fd459ee 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1752,11 +1752,17 @@ val graphiql : ?default_query:string -> string -> handler {{:https://cheatsheetseries.owasp.org/cheatsheets/Database_Security_Cheat_Sheet.html} OWASP {i Database Security Cheat Sheet}}. *) -val sql_pool : ?size:int -> string -> middleware +val sql_pool : + ?size:int -> + ?post_connect: + ((module Caqti_lwt.CONNECTION) -> (unit, Caqti_error.t) result promise) -> + string -> + middleware (** Makes an SQL connection pool available to its inner handler. [?size] is the maximum number of concurrent connections that the pool will support. The default value is picked by the driver. Note that for SQLite, [?size] is - capped to [1]. *) + capped to [1]. [post_connect] is an optional callback, which is called for + every new connection that is opened to the database. *) val sql : request -> (Caqti_lwt.connection -> 'a promise) -> 'a promise (** Runs the callback with a connection from the SQL pool. See example diff --git a/src/sql/sql.ml b/src/sql/sql.ml index 4336e5ce..0698bb93 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -25,12 +25,12 @@ let foreign_keys_on = (Caqti_type.unit ->. Caqti_type.unit) "PRAGMA foreign_keys = ON" [@ocaml.warning "-3"] -let post_connect (module Db : Caqti_lwt.CONNECTION) = +let standard_post_connect (module Db : Caqti_lwt.CONNECTION) = match Caqti_driver_info.dialect_tag Db.driver_info with | `Sqlite -> Db.exec foreign_keys_on () | _ -> Lwt.return (Ok ()) -let sql_pool ?size uri = +let sql_pool ?size ?post_connect uri = let pool_cell = ref None in fun inner_handler request -> @@ -49,7 +49,14 @@ let sql_pool ?size uri = 'sqlite' is not a valid scheme; did you mean 'sqlite3'?"); let pool = let pool_config = Caqti_pool_config.create ?max_size:size () in - Caqti_lwt_unix.connect_pool ~pool_config ~post_connect parsed_uri in + Caqti_lwt_unix.connect_pool ~pool_config ~post_connect:(fun db -> + Lwt_result.bind (standard_post_connect db) (fun () -> + match post_connect with + | Some f -> f db + | None -> Lwt_result.return ()) + ) + parsed_uri + in match pool with | Ok pool -> pool_cell := Some pool; From 37012fbda7719083a85d71e20a51e9d755d7cba0 Mon Sep 17 00:00:00 2001 From: Pietro Cerutti Date: Mon, 11 May 2026 14:58:44 +0000 Subject: [PATCH 2/2] Adjust signature, skip standard_post_connect --- src/dream.mli | 3 +-- src/sql/sql.ml | 13 ++++++------- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/src/dream.mli b/src/dream.mli index 0fd459ee..a0383921 100644 --- a/src/dream.mli +++ b/src/dream.mli @@ -1754,8 +1754,7 @@ val graphiql : ?default_query:string -> string -> handler val sql_pool : ?size:int -> - ?post_connect: - ((module Caqti_lwt.CONNECTION) -> (unit, Caqti_error.t) result promise) -> + ?post_connect: (Caqti_lwt.connection -> unit promise) -> string -> middleware (** Makes an SQL connection pool available to its inner handler. [?size] is the diff --git a/src/sql/sql.ml b/src/sql/sql.ml index 0698bb93..d92dfd45 100644 --- a/src/sql/sql.ml +++ b/src/sql/sql.ml @@ -47,15 +47,14 @@ let sql_pool ?size ?post_connect uri = log.warning (fun log -> log ~request "Dream.sql_pool: \ 'sqlite' is not a valid scheme; did you mean 'sqlite3'?"); + let post_connect = + match post_connect with + | None -> standard_post_connect + | Some f -> (fun db -> Lwt.map Result.ok (f db)) + in let pool = let pool_config = Caqti_pool_config.create ?max_size:size () in - Caqti_lwt_unix.connect_pool ~pool_config ~post_connect:(fun db -> - Lwt_result.bind (standard_post_connect db) (fun () -> - match post_connect with - | Some f -> f db - | None -> Lwt_result.return ()) - ) - parsed_uri + Caqti_lwt_unix.connect_pool ~pool_config ~post_connect parsed_uri in match pool with | Ok pool ->