├── .circleci └── config.yml ├── .github └── workflows │ └── docs.yml ├── .gitignore ├── CHANGES.md ├── COPYING ├── COPYING.LESSER ├── COPYING.LINKING ├── README.md ├── benchmarks ├── benchmark_all.ml ├── benchmark_fetch_many.ml ├── benchmark_stream.ml ├── common.ml ├── dune ├── main_blocking.ml ├── main_eio_unix.ml ├── main_lwt_unix.ml └── main_miou_unix.ml ├── caqti-async.opam ├── caqti-async ├── lib │ ├── caqti_async.ml │ ├── caqti_async.mli │ └── dune └── testlib │ ├── dune │ ├── testlib_async.ml │ └── testlib_async.mli ├── caqti-driver-mariadb.opam ├── caqti-driver-mariadb ├── lib │ ├── caqti_driver_mariadb.ml │ ├── caqti_driver_mariadb.mli │ └── dune └── test │ ├── dune │ └── test_mariadb.ml ├── caqti-driver-pgx.opam ├── caqti-driver-pgx └── lib │ ├── caqti_driver_pgx.ml │ ├── caqti_driver_pgx.mli │ └── dune ├── caqti-driver-postgresql.opam ├── caqti-driver-postgresql ├── lib │ ├── caqti_driver_postgresql.ml │ ├── caqti_driver_postgresql.mli │ └── dune └── test │ ├── dune │ └── test_postgresql.ml ├── caqti-driver-sqlite3.opam ├── caqti-driver-sqlite3 ├── lib │ ├── caqti_driver_sqlite3.ml │ ├── caqti_driver_sqlite3.mli │ └── dune └── test │ ├── dune │ └── test_sqlite3.ml ├── caqti-dynload.opam ├── caqti-dynload └── lib │ ├── caqti_dynload.ml │ ├── caqti_dynload.mli │ └── dune ├── caqti-eio.opam ├── caqti-eio ├── lib-unix │ ├── caqti_eio_unix.ml │ ├── caqti_eio_unix.mli │ ├── dune │ └── system_unix.ml ├── lib │ ├── caqti_eio.ml │ ├── caqti_eio.mli │ ├── dune │ └── system.ml └── testlib-unix │ ├── dune │ ├── testlib_eio_unix.ml │ └── testlib_eio_unix.mli ├── caqti-lwt.opam ├── caqti-lwt ├── lib-unix │ ├── caqti_lwt_unix.ml │ ├── caqti_lwt_unix.mli │ ├── dune │ ├── system.ml │ ├── system.mli │ └── system_unix.ml ├── lib │ ├── caqti_lwt.ml │ ├── caqti_lwt.mli │ └── dune ├── test-unix │ ├── dune │ ├── main.ml │ └── test_pool_lwt.ml └── testlib-unix │ ├── dune │ ├── testlib_lwt_unix.ml │ └── testlib_lwt_unix.mli ├── caqti-miou.opam ├── caqti-miou ├── lib-unix │ ├── caqti_miou_unix.ml │ ├── caqti_miou_unix.mli │ ├── dune │ ├── system.ml │ └── system_unix.ml ├── lib │ ├── caqti_miou.ml │ ├── caqti_miou.mli │ └── dune ├── test-unix │ ├── dune │ ├── main.ml │ └── test_pool_miou.ml └── testlib-unix │ ├── dune │ ├── testlib_miou_unix.ml │ └── testlib_miou_unix.mli ├── caqti-mirage.opam ├── caqti-mirage ├── dune ├── lib │ ├── caqti_mirage.ml │ ├── caqti_mirage.mli │ └── dune └── unikernel │ ├── README.md │ ├── config.ml │ └── unikernel.ml ├── caqti-tls-async.opam ├── caqti-tls-async └── lib │ ├── caqti_tls_async.ml │ ├── caqti_tls_async.mli │ └── dune ├── caqti-tls-eio.opam ├── caqti-tls-eio └── lib │ ├── caqti_tls_eio.ml │ ├── caqti_tls_eio.mli │ └── dune ├── caqti-tls-lwt.opam ├── caqti-tls-lwt └── lib-unix │ ├── caqti_lwt_tls_unix.ml │ ├── caqti_lwt_tls_unix.mli │ └── dune ├── caqti-tls-miou.opam ├── caqti-tls-miou └── lib │ ├── caqti_tls_miou.ml │ └── dune ├── caqti-tls.opam ├── caqti-tls ├── lib │ ├── config.ml │ ├── config.mli │ └── dune └── testlib │ ├── dune │ ├── testlib_tls.disabled.ml │ ├── testlib_tls.enabled.ml │ └── testlib_tls.mli ├── caqti-type-calendar.opam ├── caqti-type-calendar └── lib │ ├── caqti_type_calendar.ml │ ├── caqti_type_calendar.mli │ └── dune ├── caqti.opam ├── caqti ├── doc │ ├── dune │ ├── index.mld │ ├── query_template.mld │ └── tweaks.mld ├── lib-blocking │ ├── caqti_blocking.ml │ ├── caqti_blocking.mli │ └── dune ├── lib-platform-unix │ ├── driver_loader.ml │ ├── driver_loader.mli │ ├── dune │ └── system_sig.ml ├── lib-platform │ ├── connection_utils.ml │ ├── connection_utils.mli │ ├── connector.ml │ ├── connector.mli │ ├── conv.ml │ ├── conv.mli │ ├── driver_loader.ml │ ├── driver_loader.mli │ ├── dune │ ├── heap.ml │ ├── heap.mli │ ├── list_ext.ml │ ├── list_ext.mli │ ├── logging.ml │ ├── logging.mli │ ├── pool.ml │ ├── pool.mli │ ├── request_cache.ml │ ├── request_cache.mli │ ├── request_utils.ml │ ├── request_utils.mli │ ├── stream.ml │ ├── stream.mli │ ├── switch.ml │ ├── switch.mli │ ├── system_sig.ml │ ├── system_utils.ml │ └── system_utils.mli ├── lib-plugin │ ├── caqti_plugin.ml │ └── dune ├── lib-template │ ├── caqti_template.ml │ ├── caqti_template.mli │ ├── dialect.ml │ ├── dialect.mli │ ├── dune │ ├── field_type.ml │ ├── field_type.mli │ ├── mdx.prelude │ ├── query.ml │ ├── query.mli │ ├── query_fmt.ml │ ├── query_fmt.mli │ ├── request.ml │ ├── request.mli │ ├── request_type.ml │ ├── request_type.mli │ ├── row_mult.ml │ ├── row_mult.mli │ ├── row_type.ml │ ├── row_type.mli │ ├── shims.ml │ ├── shims.mli │ ├── version.ml │ └── version.mli ├── lib │ ├── caqti_connect_config.ml │ ├── caqti_connect_config.mli │ ├── caqti_connect_sig.ml │ ├── caqti_connection_sig.ml │ ├── caqti_driver_info.ml │ ├── caqti_driver_info.mli │ ├── caqti_error.ml │ ├── caqti_error.mli │ ├── caqti_mult.ml │ ├── caqti_pool_config.ml │ ├── caqti_pool_config.mli │ ├── caqti_pool_sig.ml │ ├── caqti_query.ml │ ├── caqti_query.mli │ ├── caqti_query_fmt.ml │ ├── caqti_query_fmt.mli │ ├── caqti_request.ml │ ├── caqti_request.mli │ ├── caqti_response_sig.ml │ ├── caqti_stream_sig.ml │ ├── caqti_switch_sig.ml │ ├── caqti_type.ml │ ├── caqti_type.mli │ ├── caqti_type_sig.ml │ └── dune ├── test │ ├── dune │ ├── main.ml │ ├── test_heap.ml │ ├── test_query.ml │ ├── test_request.ml │ ├── test_request_cache.ml │ ├── test_switch.ml │ └── test_version.ml ├── testlib-blocking │ ├── dune │ ├── testlib_blocking.ml │ └── testlib_blocking.mli └── testlib │ ├── dune │ ├── sig.ml │ ├── testlib.ml │ └── testlib.mli ├── dune ├── dune-project ├── dune-workspace.dev ├── examples ├── README.md ├── bikereg.ml └── dune ├── shared └── postgresql_conv.ml └── testsuite ├── README.md ├── deps_of_uris.ml ├── dune ├── main_async.ml ├── main_blocking.ml ├── main_eio_unix.ml ├── main_lwt_unix.ml ├── main_miou_unix.ml ├── test_connect.ml ├── test_error_cause.ml ├── test_failure.ml ├── test_parallel.ml ├── test_param.ml └── test_sql.ml /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | jobs: 3 | build: 4 | branches: 5 | ignore: 6 | - deploy-doc 7 | - gh-pages 8 | docker: 9 | - image: ocaml/opam:debian-ocaml-5.1 10 | environment: 11 | TERM: xterm 12 | - image: cimg/postgres:14.1 13 | environment: 14 | POSTGRES_USER: test 15 | POSTGRES_DB: test 16 | POSTGRES_PASSWORD: "" 17 | 18 | steps: 19 | - checkout 20 | - run: 21 | name: Pin packages 22 | command: | 23 | version=`egrep '^## v[0-9]' CHANGES.md | head -1 | sed 's/^## v\(.*\) - .*/\1/'` 24 | for f in *.opam; do 25 | # FIXME: Restore when packages becomes available. 26 | if [ "$f" != caqti-driver-mariadb.opam ]; then 27 | echo >>.ci-tmp-packages "${f%.opam}" 28 | opam pin add -yn "${f%.opam}.${version}.dev" . 29 | fi 30 | done 31 | - run: 32 | name: Install system dependencies 33 | command: | 34 | opam depext -y $(cat .ci-tmp-packages) 35 | - run: 36 | name: Install OCaml dependencies 37 | command: opam install --deps-only -ty $(cat .ci-tmp-packages) 38 | - run: 39 | name: Build 40 | command: opam config exec -- dune build @install 41 | - run: 42 | name: Test 43 | command: | 44 | echo " 45 | sqlite3:test.db?busy_timeout=60000 46 | postgresql://test@localhost/test 47 | " > testsuite/uris.conf 48 | opam config exec -- dune runtest 49 | -------------------------------------------------------------------------------- /.github/workflows/docs.yml: -------------------------------------------------------------------------------- 1 | name: Deploy API Documentation 2 | 3 | on: 4 | push: 5 | branches: 6 | - deploy-doc 7 | 8 | jobs: 9 | deploy-doc: 10 | runs-on: ubuntu-latest 11 | steps: 12 | 13 | - name: Checkout code 14 | uses: actions/checkout@v2 15 | 16 | - name: Use OCaml 4.13.x 17 | uses: ocaml/setup-ocaml@v2 18 | with: 19 | ocaml-compiler: 4.13.x 20 | dune-cache: true 21 | opam-pin: false 22 | opam-depext: false 23 | 24 | - name: Pin packages 25 | run: | 26 | version=`egrep '^## v[0-9]' CHANGES.md | head -1 | sed 's/^## v\(.*\) - .*/\1/'` 27 | for f in *.opam; do 28 | opam pin add -yn "${f%.opam}.${version}" . 29 | done 30 | shell: bash 31 | 32 | - name: Install system dependencies 33 | run: | 34 | opam depext -y --with-doc $(ls -1 *.opam | sed -e 's/\.opam$//') 35 | sudo apt-get install -y libmariadb-dev 36 | shell: bash 37 | 38 | - name: Install OCaml dependencies 39 | run: opam install --deps-only -y --with-doc $(ls -1 *.opam | sed -e 's/\.opam$//') 40 | shell: bash 41 | 42 | - name: Deploy odoc to GitHub Pages 43 | uses: ocaml/setup-ocaml/deploy-doc@v2 44 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .merlin 2 | /_build 3 | /_test.db 4 | /caqti.install 5 | /caqti-async.install 6 | /caqti-driver-*.install 7 | /caqti-dynload.install 8 | /caqti-lwt.install 9 | /caqti-mirage/unikernel/Makefile 10 | /caqti-mirage/unikernel/_build 11 | /caqti-mirage/unikernel/dist 12 | /caqti-mirage/unikernel/dune 13 | /caqti-mirage/unikernel/dune-project 14 | /caqti-mirage/unikernel/dune-workspace 15 | /caqti-mirage/unikernel/dune.build 16 | /caqti-mirage/unikernel/dune.config 17 | /caqti-mirage/unikernel/mirage 18 | /caqti-type-*.install 19 | /testsuite/uris.conf 20 | -------------------------------------------------------------------------------- /COPYING.LINKING: -------------------------------------------------------------------------------- 1 | LGPL-3.0 LINKING EXCEPTION 2 | 3 | As a special exception to the GNU Lesser General Public License 4 | version 3 ("LGPL3"), the copyright holders of this Library give you 5 | permission to convey to a third party a Combined Work that links 6 | statically or dynamically to this Library without providing any 7 | Minimal Corresponding Source or Minimal Application Code as set out in 8 | 4d or providing the installation information set out in section 4e, 9 | provided that you comply with the other provisions of LGPL3 and 10 | provided that you meet, for the Application the terms and conditions 11 | of the license(s) which apply to the Application. 12 | 13 | Except as stated in this special exception, the provisions of LGPL3 14 | will continue to comply in full to this Library. If you modify this 15 | Library, you may apply this exception to your version of this Library, 16 | but you are not obliged to do so. If you do not wish to do so, delete 17 | this exception statement from your version. This exception does not 18 | (and cannot) modify any license terms which apply to the Application, 19 | with which you must still comply. 20 | -------------------------------------------------------------------------------- /benchmarks/benchmark_all.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Common 19 | 20 | module Make (Platform : PLATFORM) = struct 21 | module Fetch_many = Benchmark_fetch_many.Make (Platform) 22 | 23 | let cmds = [ 24 | Fetch_many.main_cmd; 25 | ] 26 | 27 | let () = 28 | let open Cmdliner in 29 | exit Cmd.(eval @@ group (info (Filename.basename Sys.argv.(0))) cmds) 30 | end 31 | -------------------------------------------------------------------------------- /benchmarks/common.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module type PLATFORM = sig 19 | type context 20 | module Fiber : sig 21 | type +'a t 22 | module Infix : sig 23 | val (>>=) : 'a t -> ('a -> 'b t) -> 'b t 24 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 25 | end 26 | end 27 | val name : string 28 | val run_fiber : (unit -> 'a Fiber.t) -> 'a 29 | val run_main : (context -> 'a) -> 'a 30 | val or_fail : ('a, [< Caqti_error.t]) result -> 'a Fiber.t 31 | 32 | module Stream : Caqti_stream_sig.S with type 'a fiber := 'a Fiber.t 33 | 34 | module type CONNECTION = Caqti_connection_sig.S 35 | with type 'a fiber := 'a Fiber.t 36 | and type ('a, 'err) stream := ('a, 'err) Stream.t 37 | 38 | type connection = (module CONNECTION) 39 | 40 | val connect : 41 | ?config: Caqti_connect_config.t -> context -> Uri.t -> 42 | (connection, [> Caqti_error.load_or_connect]) result Fiber.t 43 | end 44 | -------------------------------------------------------------------------------- /benchmarks/dune: -------------------------------------------------------------------------------- 1 | ; Singular benchmark 2 | 3 | (executable 4 | (name benchmark_stream) 5 | (modules benchmark_stream) 6 | (libraries benchmark caqti caqti.platform lwt lwt.unix)) 7 | 8 | ; Main benchmark suite with executables for concurrency flavours 9 | 10 | (library 11 | (name benchmark_all) 12 | (flags (:standard -alert -caqti_unstable)) 13 | (modules 14 | common 15 | benchmark_fetch_many 16 | benchmark_all) 17 | (libraries 18 | bechamel 19 | bechamel-notty 20 | caqti 21 | caqti.plugin 22 | notty.unix 23 | testlib)) 24 | 25 | (executable 26 | (name main_blocking) 27 | (modules main_blocking) 28 | (libraries 29 | benchmark_all 30 | caqti.blocking 31 | unix)) 32 | 33 | (executable 34 | (name main_eio_unix) 35 | (modules main_eio_unix) 36 | (enabled_if (>= %{ocaml_version} "5.0")) 37 | (libraries 38 | benchmark_all 39 | caqti-eio.unix 40 | caqti-tls-eio 41 | eio 42 | eio_main 43 | mirage-crypto-rng.unix)) 44 | 45 | (executable 46 | (name main_lwt_unix) 47 | (modules main_lwt_unix) 48 | (libraries 49 | benchmark_all 50 | caqti-lwt 51 | caqti-lwt.unix 52 | caqti-tls-lwt.unix 53 | lwt 54 | lwt.unix)) 55 | 56 | (executable 57 | (name main_miou_unix) 58 | (modules main_miou_unix) 59 | (libraries 60 | benchmark_all 61 | caqti-miou 62 | caqti_miou_unix 63 | caqti-tls-miou 64 | miou 65 | miou.unix 66 | mirage-crypto-rng-miou-unix 67 | threads)) 68 | 69 | ; TODO: Can we run async under a benchamel test? 70 | -------------------------------------------------------------------------------- /benchmarks/main_blocking.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Benchmark_all.Make (struct 19 | let name = "blocking" 20 | module Fiber = struct 21 | type 'a t = 'a 22 | module Infix = struct 23 | let (>>=) x f = f x 24 | let (>|=) x f = f x 25 | end 26 | end 27 | type context = unit 28 | let run_fiber f = f () 29 | let run_main f = f () 30 | include Caqti_blocking 31 | let connect ?config () uri = connect ?config uri 32 | end) 33 | -------------------------------------------------------------------------------- /benchmarks/main_eio_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Eio.Std 19 | 20 | include Benchmark_all.Make (struct 21 | let name = "eio-unix" 22 | 23 | module Fiber = struct 24 | type 'a t = 'a 25 | module Infix = struct 26 | let (>>=) x f = f x 27 | let (>|=) x f = f x 28 | end 29 | end 30 | 31 | type context = Caqti_eio.stdenv * Switch.t 32 | 33 | let run_fiber f = f () 34 | 35 | let run_main f = 36 | Mirage_crypto_rng_unix.use_default (); 37 | Eio_main.run @@ fun stdenv -> 38 | Switch.run @@ fun sw -> 39 | f ((stdenv :> Caqti_eio.stdenv), sw) 40 | 41 | include Caqti_eio 42 | include Caqti_eio_unix 43 | 44 | let connect ?config (stdenv, sw) uri = connect ?config ~sw ~stdenv uri 45 | end) 46 | -------------------------------------------------------------------------------- /benchmarks/main_lwt_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Benchmark_all.Make (struct 19 | let name = "lwt-unix" 20 | module Fiber = Lwt 21 | type context = unit 22 | let run_fiber f = Lwt_main.run (f ()) 23 | let run_main f = f () 24 | include Caqti_lwt 25 | include Caqti_lwt_unix 26 | let connect ?config () uri = connect ?config uri 27 | end) 28 | -------------------------------------------------------------------------------- /benchmarks/main_miou_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Benchmark_all.Make (struct 19 | let name = "miou-unix" 20 | 21 | module Fiber = struct 22 | type 'a t = 'a 23 | module Infix = struct 24 | let (>>=) x f = f x 25 | let (>|=) x f = f x 26 | end 27 | end 28 | 29 | type context = Caqti_miou.switch 30 | 31 | let run_fiber f = f () 32 | 33 | let run_main f = 34 | Miou_unix.run @@ fun () -> 35 | Caqti_miou.Switch.run @@ fun sw -> 36 | let rng = Mirage_crypto_rng_miou_unix.(initialize (module Pfortuna)) in 37 | let finally () = Mirage_crypto_rng_miou_unix.kill rng in 38 | Fun.protect ~finally (fun () -> f sw) 39 | 40 | include Caqti_miou 41 | include Caqti_miou_unix 42 | 43 | let connect ?config sw uri = connect ?config ~sw uri 44 | end) 45 | -------------------------------------------------------------------------------- /caqti-async.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-async" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "async_kernel" {>= "v0.17.0"} 11 | "async_unix" {>= "v0.11.0"} 12 | "caqti" {>= "2.2.3" & < "2.3.0~"} 13 | "core" {>= "v0.16.1"} 14 | "core_unix" 15 | "domain-name" 16 | "dune" {>= "3.9"} 17 | "ipaddr" 18 | "logs" 19 | "ocaml" 20 | "alcotest" {with-test & >= "1.5.0"} 21 | "alcotest-async" {with-test} 22 | "cmdliner" {with-test & >= "1.1.0"} 23 | "caqti-driver-sqlite3" {with-test} 24 | "odoc" {with-doc} 25 | ] 26 | build: [ 27 | ["dune" "build" "-p" name "-j" jobs] 28 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 29 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 30 | ] 31 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 32 | synopsis: "Async support for Caqti" 33 | -------------------------------------------------------------------------------- /caqti-async/lib/caqti_async.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2014--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Connector for Async. *) 19 | 20 | open Async_kernel 21 | 22 | module Stream : Caqti_stream_sig.S with type 'a fiber := 'a Deferred.t 23 | module Pool : Caqti_pool_sig.S with type 'a fiber := 'a Deferred.t 24 | 25 | module type CONNECTION = Caqti_connection_sig.S 26 | with type 'a fiber := 'a Deferred.t 27 | and type ('a, 'e) stream := ('a, 'e) Stream.t 28 | 29 | include Caqti_connect_sig.S 30 | with type 'a fiber := 'a Deferred.t 31 | and type 'a with_switch := 'a 32 | and type 'a with_stdenv := 'a 33 | and type ('a, 'e) stream := ('a, 'e) Stream.t 34 | and type ('a, 'e) pool := ('a, 'e) Pool.t 35 | and type connection = (module CONNECTION) 36 | 37 | (**/**) 38 | module System : Caqti_platform.System_sig.S 39 | with type 'a Fiber.t = 'a Deferred.t 40 | and module Stream = Stream 41 | and type stdenv = unit 42 | and type Net.tcp_flow = Async_unix.Reader.t * Async_unix.Writer.t 43 | and type Net.tls_flow = Async_unix.Reader.t * Async_unix.Writer.t 44 | -------------------------------------------------------------------------------- /caqti-async/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_async) 3 | (public_name caqti-async) 4 | (libraries 5 | async_kernel async_unix 6 | caqti caqti.platform caqti.platform.unix 7 | core core_unix 8 | domain-name ipaddr 9 | logs)) 10 | -------------------------------------------------------------------------------- /caqti-async/testlib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name testlib_async) 3 | (libraries 4 | alcotest 5 | async_kernel 6 | caqti_async 7 | core_kernel 8 | testlib)) 9 | -------------------------------------------------------------------------------- /caqti-async/testlib/testlib_async.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Async_kernel 19 | open Core 20 | 21 | module Fiber = struct 22 | type 'a t = 'a Deferred.t 23 | 24 | let return = return 25 | 26 | let catch f g = 27 | try_with ~extract_exn:true f >>= function 28 | | Ok y -> return y 29 | | Error exn -> g exn 30 | 31 | let fail exn = Error.raise (Error.of_exn exn) 32 | 33 | module Infix = struct 34 | let (>>=) = (>>=) 35 | let (>|=) = (>>|) 36 | let (>>=?) m f = m >>= (function Ok x -> f x | Error _ as r -> return r) 37 | let (>|=?) m f = m >|= (function Ok x -> Ok (f x) | Error _ as r -> r) 38 | end 39 | end 40 | 41 | let or_fail = function 42 | | Ok x -> return x 43 | | Error (#Caqti_error.t as err) -> 44 | Error.raise (Error.of_exn (Caqti_error.Exn err)) 45 | 46 | include Caqti_async 47 | 48 | module Alcotest_cli = 49 | Testlib.Make_alcotest_cli 50 | (Alcotest.Unix_platform) 51 | (struct 52 | include Deferred 53 | let bind m f = bind m ~f 54 | let catch f g = 55 | try_with ~extract_exn:true f >>= function 56 | | Ok y -> return y 57 | | Error exn -> g exn 58 | end) 59 | 60 | module List_result_fiber = struct 61 | let rec iter_s f = function 62 | | [] -> return (Ok ()) 63 | | x :: xs -> f x >>=? fun () -> iter_s f xs 64 | end 65 | -------------------------------------------------------------------------------- /caqti-async/testlib/testlib_async.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Testlib.Sig.Ground 19 | with type 'a Fiber.t = 'a Async_kernel.Deferred.t 20 | and module Stream = Caqti_async.Stream 21 | and module Pool = Caqti_async.Pool 22 | -------------------------------------------------------------------------------- /caqti-driver-mariadb.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-driver-mariadb" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "alcotest" {with-test & >= "1.5.0"} 11 | "ocaml" 12 | "caqti" {>= "2.2.0" & < "2.3.0~"} 13 | "cmdliner" {with-test & >= "1.1.0"} 14 | "dune" {>= "3.9"} 15 | "mariadb" {>= "1.3.0"} 16 | "odoc" {with-doc} 17 | ] 18 | build: [ 19 | ["dune" "build" "-p" name "-j" jobs] 20 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 21 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 22 | ] 23 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 24 | synopsis: "MariaDB driver for Caqti using C bindings" 25 | -------------------------------------------------------------------------------- /caqti-driver-mariadb/lib/caqti_driver_mariadb.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017--2022 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Caqti driver for MariaDB (bindings). 19 | 20 | This driver is implemented in terms of the mariadb OPAM package. 21 | It handles URIs of the form 22 | [mariadb://:@:/?] 23 | with the following query arguments: 24 | 25 | - [socket=] requests a UNIX domain socket connection 26 | - [config-group=] loads additional settings from the section 27 | [] of the default configuration file. Default: ["caqti"]. 28 | 29 | Except for the latter, options are passed to the correspondingly named 30 | arguments to the [connect] function of MariaDB. 31 | All parts of the URL are optional, except that the chosen combination must 32 | suffice to establish a connection. 33 | 34 | The interface provided by this module {e should normally not be used by 35 | applications}, but provides access to some MariaDB specifics in case they 36 | are needed. *) 37 | 38 | (** {1 Error Details} 39 | 40 | The following provides access to diagnostics collected from the MariaDB 41 | connection and statement objects. *) 42 | 43 | type Caqti_error.msg += Error_msg of { 44 | errno: int; 45 | (** The error number returned by [mysql_errno] or [mysql_stmt_errno]. *) 46 | error: string; 47 | (** The error message returned by [mysql_error] or [mysql_stmt_errno]. *) 48 | } 49 | -------------------------------------------------------------------------------- /caqti-driver-mariadb/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_driver_mariadb) 3 | (public_name caqti-driver-mariadb) 4 | (optional) 5 | (flags (:standard -alert -caqti_unstable)) 6 | (library_flags (:standard -linkall)) 7 | (libraries caqti caqti.platform caqti.platform.unix mariadb)) 8 | 9 | (plugin 10 | (package caqti-driver-mariadb) 11 | (name caqti-driver-mariadb) 12 | (optional) 13 | (libraries caqti-driver-mariadb) 14 | (site (caqti plugins))) 15 | -------------------------------------------------------------------------------- /caqti-driver-mariadb/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_mariadb) 3 | (package caqti-driver-mariadb) 4 | (build_if %{lib-available:caqti-driver-mariadb}) 5 | (flags (:standard -alert -caqti_unstable)) 6 | (libraries 7 | alcotest 8 | caqti 9 | caqti.blocking 10 | caqti-driver-mariadb 11 | testlib 12 | testlib_blocking) 13 | (deps ../../testsuite/uris.conf) 14 | (action 15 | (setenv CAQTI_TEST_URIS_FILE ../../testsuite/uris.conf 16 | (run %{test})))) 17 | -------------------------------------------------------------------------------- /caqti-driver-mariadb/test/test_mariadb.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Testlib 19 | open Testlib_blocking 20 | 21 | let bad_select_req = 22 | Caqti_template.Create.(static T.(unit -->! unit) "SELECT not_defined") 23 | 24 | let test_error (module C : Caqti_blocking.CONNECTION) = 25 | (match C.find bad_select_req () with 26 | | Ok () -> Alcotest.fail "unexpected ok from bad_select" 27 | | Error (`Request_failed 28 | {msg = Caqti_driver_mariadb.Error_msg {errno; error = _}; _}) -> 29 | Alcotest.(check int) "errno" 1054 errno 30 | | Error err -> 31 | Alcotest.failf "unexpected error from bad_select: %a" Caqti_error.pp err) 32 | 33 | let test_cases_on_connection = [ 34 | "test_error", `Quick, test_error; 35 | ] 36 | 37 | let mk_test (name, pool) = 38 | let pass_conn (name, speed, f) = 39 | let f' () = 40 | Caqti_blocking.Pool.use (fun c -> Ok (f c)) pool |> function 41 | | Ok () -> () 42 | | Error err -> Alcotest.failf "%a" Caqti_error.pp err 43 | in 44 | (name, speed, f') 45 | in 46 | let test_cases = List.map pass_conn test_cases_on_connection in 47 | (name, test_cases) 48 | 49 | let mk_tests {uris; connect_config = config} = 50 | let connect_pool uri = 51 | let pool_config = Caqti_pool_config.create ~max_size:1 () in 52 | (match Caqti_blocking.connect_pool uri ~pool_config ~config with 53 | | Ok pool -> (test_name_of_uri uri, pool) 54 | | Error err -> raise (Caqti_error.Exn err)) 55 | in 56 | let is_mariadb uri = Uri.scheme uri = Some "mariadb" in 57 | let pools = List.map connect_pool (List.filter is_mariadb uris) in 58 | List.map mk_test pools 59 | 60 | let () = 61 | Alcotest_cli.run_with_args_dependency "test_mariadb" (common_args ()) mk_tests 62 | -------------------------------------------------------------------------------- /caqti-driver-pgx.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-driver-pgx" 3 | maintainer: "Petter A. Urkedal " 4 | authors: [ 5 | "Petter A. Urkedal " 6 | ] 7 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 8 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 9 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 10 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 11 | depends: [ 12 | "ocaml" {>= "4.08"} 13 | "caqti" {>= "2.2.0" & < "2.3.0~"} 14 | "domain-name" 15 | "dune" {>= "3.9"} 16 | "ipaddr" 17 | "pgx" {>= "2.0"} 18 | ] 19 | build: [ 20 | ["dune" "build" "-p" name "-j" jobs] 21 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 22 | ] 23 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 24 | synopsis: "PostgreSQL driver for Caqti based on the pure-OCaml PGX library" 25 | -------------------------------------------------------------------------------- /caqti-driver-pgx/lib/caqti_driver_pgx.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** PostgreSQL driver for Caqti based on pgx 19 | 20 | This driver is implemented in terms of the pgx library. 21 | 22 | It handles URIs of the form 23 | {[ 24 | pgx://:@:/ 25 | ]} 26 | where [] is either a host name, an IP number, or a 27 | directory containing the Unix domain socket of a locally running PostgreSQL 28 | server. In the latter case, the directory must be percent-encoded, e.g. 29 | {[ 30 | pgx://jdoe@%2fvar%2frun%2fpostgresql 31 | ]} 32 | 33 | The interface provided by this module {e should normally not be used by 34 | applications}, but provides access to some pgx specifics in case they are 35 | needed. *) 36 | 37 | (** {1 Error Details} *) 38 | 39 | type Caqti_error.msg += Pgx_msg of string * Pgx.Error_response.t 40 | -------------------------------------------------------------------------------- /caqti-driver-pgx/lib/dune: -------------------------------------------------------------------------------- 1 | (rule (copy# ../../shared/postgresql_conv.ml postgresql_conv.ml)) 2 | 3 | (library 4 | (name caqti_driver_pgx) 5 | (public_name caqti-driver-pgx) 6 | (flags (:standard -alert -caqti_unstable)) 7 | (library_flags (:standard -linkall)) 8 | (libraries caqti caqti.platform domain-name ipaddr pgx)) 9 | 10 | (plugin 11 | (package caqti-driver-pgx) 12 | (name caqti-driver-pgx) 13 | (libraries caqti-driver-pgx) 14 | (site (caqti plugins))) 15 | -------------------------------------------------------------------------------- /caqti-driver-postgresql.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-driver-postgresql" 3 | maintainer: "Petter A. Urkedal " 4 | authors: [ 5 | "Petter A. Urkedal " 6 | "James Owen " 7 | ] 8 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 9 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 10 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 11 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 12 | depends: [ 13 | "alcotest" {with-test & >= "1.5.0"} 14 | "ocaml" 15 | "caqti" {>= "2.2.0" & < "2.3.0~"} 16 | "cmdliner" {with-test & >= "1.1.0"} 17 | "dune" {>= "3.9"} 18 | "odoc" {with-doc} 19 | "postgresql" {>= "5.0.0"} 20 | "uri" {>= "4.0.0"} 21 | ] 22 | build: [ 23 | ["dune" "build" "-p" name "-j" jobs] 24 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 25 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 26 | ] 27 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 28 | synopsis: "PostgreSQL driver for Caqti based on C bindings" 29 | -------------------------------------------------------------------------------- /caqti-driver-postgresql/lib/dune: -------------------------------------------------------------------------------- 1 | (rule (copy# ../../shared/postgresql_conv.ml postgresql_conv.ml)) 2 | 3 | (library 4 | (name caqti_driver_postgresql) 5 | (public_name caqti-driver-postgresql) 6 | (flags (:standard -alert -caqti_unstable)) 7 | (library_flags (:standard -linkall)) 8 | (libraries caqti caqti.platform caqti.platform.unix postgresql)) 9 | 10 | (plugin 11 | (package caqti-driver-postgresql) 12 | (name caqti-driver-postgresql) 13 | (libraries caqti-driver-postgresql) 14 | (site (caqti plugins))) 15 | -------------------------------------------------------------------------------- /caqti-driver-postgresql/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_postgresql) 3 | (package caqti-driver-postgresql) 4 | (flags (:standard -alert -caqti_unstable)) 5 | (libraries 6 | alcotest 7 | caqti 8 | caqti.blocking 9 | caqti-driver-postgresql 10 | testlib 11 | testlib_blocking) 12 | (deps ../../testsuite/uris.conf) 13 | (action 14 | (setenv CAQTI_TEST_URIS_FILE ../../testsuite/uris.conf 15 | (run %{test})))) 16 | -------------------------------------------------------------------------------- /caqti-driver-postgresql/test/test_postgresql.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Testlib 19 | open Testlib_blocking 20 | 21 | let bad_select_req = 22 | Caqti_template.Create.(static T.(unit -->! unit) "SELECT not_defined") 23 | 24 | let test_error (module C : Caqti_blocking.CONNECTION) = 25 | (match C.find bad_select_req () with 26 | | Ok () -> Alcotest.fail "unexpected ok from bad_select" 27 | | Error (`Request_failed 28 | {msg = Caqti_driver_postgresql.Result_error_msg {sqlstate; _}; _}) -> 29 | assert (sqlstate = "42703") 30 | | Error err -> 31 | Alcotest.failf "unexpected error from bad_select: %a" Caqti_error.pp err) 32 | 33 | let test_cases_on_connection = [ 34 | "test_error", `Quick, test_error; 35 | ] 36 | 37 | let mk_test (name, pool) = 38 | let pass_conn (name, speed, f) = 39 | let f' () = 40 | Caqti_blocking.Pool.use (fun c -> Ok (f c)) pool |> function 41 | | Ok () -> () 42 | | Error err -> Alcotest.failf "%a" Caqti_error.pp err 43 | in 44 | (name, speed, f') 45 | in 46 | let test_cases = List.map pass_conn test_cases_on_connection in 47 | (name, test_cases) 48 | 49 | let mk_tests {uris; connect_config = config} = 50 | let connect_pool uri = 51 | let pool_config = Caqti_pool_config.create ~max_size:1 () in 52 | (match Caqti_blocking.connect_pool uri ~pool_config ~config with 53 | | Ok pool -> (test_name_of_uri uri, pool) 54 | | Error err -> raise (Caqti_error.Exn err)) 55 | in 56 | let is_postgresql uri = Uri.scheme uri = Some "postgresql" in 57 | let pools = List.map connect_pool (List.filter is_postgresql uris) in 58 | List.map mk_test pools 59 | 60 | let () = 61 | Alcotest_cli.run_with_args_dependency "test_postgresql" 62 | (common_args ()) mk_tests 63 | -------------------------------------------------------------------------------- /caqti-driver-sqlite3.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-driver-sqlite3" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "alcotest" {with-test & >= "1.5.0"} 11 | "ocaml" 12 | "caqti" {>= "2.2.0" & < "2.3.0~"} 13 | "cmdliner" {with-test & >= "1.1.0"} 14 | "dune" {>= "3.9"} 15 | "odoc" {with-doc} 16 | "sqlite3" {>= "5.2.0"} 17 | ] 18 | build: [ 19 | ["dune" "build" "-p" name "-j" jobs] 20 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 21 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 22 | ] 23 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 24 | synopsis: "Sqlite3 driver for Caqti using C bindings" 25 | -------------------------------------------------------------------------------- /caqti-driver-sqlite3/lib/caqti_driver_sqlite3.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Sqlite3 driver for Caqti (bindings). 19 | 20 | This driver is implemented in terms of the sqlite3 OPAM package, which 21 | provides bindings for libsqlite3. It handles URIs of the form 22 | {[ 23 | sqlite3://?create=&write= 24 | ]} 25 | where [] is passed to {!Sqlite3.db_open} and the query string is used 26 | to determine its [mode] parameter. The [] parameters take the values 27 | [true] and [false], and default to [true]. 28 | 29 | The interface provided by this module {e should normally not be used by 30 | applications}, but provides access to some Sqlite3 specifics in case they 31 | are needed. *) 32 | 33 | (** {1 Error Details} 34 | 35 | The following provides access to diagnostics collected from the Sqlite3 36 | connection. *) 37 | 38 | type Caqti_error.msg += Error_msg of { 39 | errcode: Sqlite3.Rc.t; 40 | (** The OCaml encoding of the error code reported by [sqlite3_errcode]. *) 41 | extended_errcode: int option; 42 | (** The extended result code, if available. *) 43 | errmsg: string option; 44 | (** The error message reportedy by [sqlite3_errmsg]. *) 45 | } 46 | 47 | (** {1 Access to Raw Connection Handle} *) 48 | 49 | type Caqti_connection_sig.driver_connection += Driver_connection of Sqlite3.db 50 | -------------------------------------------------------------------------------- /caqti-driver-sqlite3/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_driver_sqlite3) 3 | (public_name caqti-driver-sqlite3) 4 | (flags (:standard -thread -alert -caqti_unstable)) 5 | (library_flags (:standard -linkall)) 6 | (libraries caqti caqti.platform caqti.platform.unix sqlite3)) 7 | 8 | (plugin 9 | (package caqti-driver-sqlite3) 10 | (name caqti-driver-sqlite3) 11 | (libraries caqti-driver-sqlite3) 12 | (site (caqti plugins))) 13 | -------------------------------------------------------------------------------- /caqti-driver-sqlite3/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_sqlite3) 3 | (package caqti-driver-sqlite3) 4 | (flags (:standard -alert -caqti_unstable)) 5 | (libraries 6 | alcotest 7 | caqti 8 | caqti.blocking 9 | caqti-driver-sqlite3 10 | testlib 11 | testlib_blocking) 12 | (deps ../../testsuite/uris.conf) 13 | (locks /db/testsuite) 14 | (action 15 | (setenv CAQTI_TEST_URIS_FILE ../../testsuite/uris.conf 16 | (run %{test})))) 17 | -------------------------------------------------------------------------------- /caqti-dynload.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-dynload" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "alcotest" {with-test & >= "1.5.0"} 11 | "caqti" {>= "2.0.0" & < "3.0.0~"} 12 | "caqti-driver-sqlite3" {with-test} 13 | "cmdliner" {with-test & >= "1.1.0"} 14 | "dune" {>= "3.9"} 15 | "ocaml" {>= "4.04.0"} 16 | "ocamlfind" 17 | ] 18 | build: [ 19 | ["dune" "build" "-p" name "-j" jobs] 20 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 21 | ] 22 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 23 | synopsis: "Dynamic linking of Caqti drivers using findlib.dynload" 24 | description: """ 25 | This library registers a dynamic linker which will be called when 26 | encoutering an unhandled database URI. It tries to load a findlib package 27 | named "caqti-driver-" where "" is the scheme of the URI, 28 | which is expected register a driver for the scheme. 29 | 30 | This is a separate package to avoid the dependency on the findlib.dynload 31 | for architectures, like MirageOS, where dynamic linking may be unavailable. 32 | The alternative is to link drivers directly into the application. 33 | """ 34 | -------------------------------------------------------------------------------- /caqti-dynload/lib/caqti_dynload.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017--2018 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | let debug = 19 | try bool_of_string (Sys.getenv "CAQTI_DEBUG_DYNLOAD") 20 | with Not_found -> false 21 | 22 | let backend_predicates () = 23 | (match Sys.backend_type with 24 | | Sys.Native -> ["native"] 25 | | Sys.Bytecode -> ["byte"] 26 | | Sys.Other _ -> []) 27 | 28 | let init = lazy begin 29 | let predicates = backend_predicates () in 30 | Findlib.init (); 31 | Findlib.record_package_predicates predicates; 32 | List.iter (Findlib.record_package Record_core) 33 | (Findlib.package_deep_ancestors predicates ["caqti"]); 34 | if debug then 35 | Printf.eprintf "\ 36 | [DEBUG] Caqti_dynload: recorded_predicates = %s\n\ 37 | [DEBUG] Caqti_dynload: recorded_packages.core = %s\n\ 38 | [DEBUG] Caqti_dynload: recorded_packages.load = %s\n%!" 39 | (String.concat " " (Findlib.recorded_predicates ())) 40 | (String.concat " " (Findlib.recorded_packages Record_core)) 41 | (String.concat " " (Findlib.recorded_packages Record_load)) 42 | end 43 | 44 | let () = Caqti_platform.Connector.define_loader @@ fun pkg -> 45 | Lazy.force init; 46 | if debug then 47 | Printf.eprintf "[DEBUG] Caqti_dynload: requested package: %s\n" pkg; 48 | (try Ok (Fl_dynload.load_packages ~debug [pkg]) with 49 | | Dynlink.Error err -> Error (Dynlink.error_message err) 50 | | Findlib.No_such_package (_pkg, info) -> Error info) 51 | 52 | module Weak_ = struct include Weak end (* for caqti-driver-mariadb *) 53 | -------------------------------------------------------------------------------- /caqti-dynload/lib/caqti_dynload.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Dynamic linker for database drivers. 19 | 20 | This module registers a dynamic linker for loading database drivers. *) 21 | -------------------------------------------------------------------------------- /caqti-dynload/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_dynload) 3 | (public_name caqti-dynload) 4 | (library_flags (-linkall)) 5 | (libraries caqti caqti.platform findlib.dynload)) 6 | -------------------------------------------------------------------------------- /caqti-eio.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-eio" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.2.3" & < "2.3.0~"} 11 | "dune" {>= "3.9"} 12 | "eio" {>= "0.12"} 13 | "logs" 14 | "ocaml" {>= "5.0.0~"} 15 | "alcotest" {with-test & >= "1.5.0"} 16 | "caqti-driver-sqlite3" {with-test} 17 | "cmdliner" {with-test & >= "1.1.0"} 18 | "eio_main" {with-test} 19 | "mirage-crypto-rng" {with-test & >= "1.2.0"} 20 | "odoc" {with-doc} 21 | ] 22 | build: [ 23 | ["dune" "build" "-p" name "-j" jobs] 24 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 25 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 26 | ] 27 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 28 | synopsis: "Eio support for Caqti" 29 | -------------------------------------------------------------------------------- /caqti-eio/lib-unix/caqti_eio_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Caqti_platform 19 | open Caqti_platform_unix 20 | 21 | module Loader = Driver_loader.Make (Caqti_eio.System) (System_unix) 22 | 23 | include Connector.Make (Caqti_eio.System) (Caqti_eio.Pool) (Loader) 24 | -------------------------------------------------------------------------------- /caqti-eio/lib-unix/caqti_eio_unix.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Establinging Connections for Eio with Unix 19 | 20 | This module provides database connections for applications using Eio. It 21 | supports all database drivers. 22 | 23 | {b The caqti-eio library should be considered unstable} for now. Eio is in 24 | active development including its API, and the Caqti interface to it may 25 | benefit from further revision before the first major Eio release lands. *) 26 | 27 | include Caqti_connect_sig.S 28 | with type 'a fiber := 'a 29 | and type ('a, 'e) stream := ('a, 'e) Caqti_eio.Stream.t 30 | and type ('a, 'e) pool := ('a, 'e) Caqti_eio.Pool.t 31 | and type connection := Caqti_eio.connection 32 | and type 'a with_switch := sw: Eio.Switch.t -> 'a 33 | and type 'a with_stdenv := stdenv: Caqti_eio.stdenv -> 'a 34 | -------------------------------------------------------------------------------- /caqti-eio/lib-unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_eio_unix) 3 | (public_name caqti-eio.unix) 4 | (enabled_if (>= %{ocaml_version} "5.0")) 5 | (libraries 6 | caqti 7 | caqti.platform 8 | caqti.platform.unix 9 | caqti-eio 10 | eio 11 | eio.unix 12 | logs)) 13 | -------------------------------------------------------------------------------- /caqti-eio/lib-unix/system_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Caqti_eio.System 19 | 20 | module Unix = struct 21 | type file_descr = Unix.file_descr 22 | 23 | let wrap_fd f fd = f fd 24 | 25 | let poll ~stdenv ?(read = false) ?(write = false) ?timeout fd = 26 | let f () = 27 | (match read, write with 28 | | false, false -> 29 | (false, false, false) 30 | | true, true -> 31 | Eio.Fiber.first 32 | (fun () -> Eio_unix.await_readable fd; (true, false, false)) 33 | (fun () -> Eio_unix.await_writable fd; (false, true, false)) 34 | | true, false -> 35 | Eio_unix.await_readable fd; (true, false, false) 36 | | false, true -> 37 | Eio_unix.await_writable fd; (false, true, false)) 38 | in 39 | (match timeout with 40 | | None -> f () 41 | | Some t -> 42 | (match Eio.Time.with_timeout stdenv#clock t (fun () -> Ok (f ())) with 43 | | Ok r -> r 44 | | Error `Timeout -> (false, false, true))) 45 | end 46 | 47 | module Preemptive = struct 48 | let detach f x = Eio_unix.run_in_systhread (fun () -> f x) 49 | let run_in_main f = f () (* FIXME *) 50 | end 51 | -------------------------------------------------------------------------------- /caqti-eio/lib/caqti_eio.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Caqti_platform 19 | 20 | module Stream = System.Stream 21 | module System = System 22 | 23 | type stdenv = System.stdenv 24 | 25 | module Pool = Caqti_platform.Pool.Make (System) (System.Alarm) 26 | 27 | module Loader = Caqti_platform.Driver_loader.Make (System) 28 | 29 | module type CONNECTION = Caqti_connection_sig.S 30 | with type 'a fiber := 'a 31 | and type ('a, 'e) stream := ('a, 'e) Stream.t 32 | 33 | type connection = (module CONNECTION) 34 | 35 | include Connector.Make (System) (Pool) (Loader) 36 | 37 | let or_fail = function 38 | | Ok x -> x 39 | | Error (#Caqti_error.t as err) -> raise (Caqti_error.Exn err) 40 | -------------------------------------------------------------------------------- /caqti-eio/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_eio) 3 | (public_name caqti-eio) 4 | (enabled_if (>= %{ocaml_version} "5.0")) 5 | (libraries 6 | caqti 7 | caqti.platform 8 | eio 9 | logs)) 10 | -------------------------------------------------------------------------------- /caqti-eio/testlib-unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name testlib_eio_unix) 3 | (enabled_if (>= %{ocaml_version} "5.0")) 4 | (libraries 5 | alcotest 6 | caqti 7 | caqti_eio_unix 8 | testlib)) 9 | -------------------------------------------------------------------------------- /caqti-eio/testlib-unix/testlib_eio_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Caqti_eio.System 19 | include Caqti_eio 20 | include Caqti_eio_unix 21 | 22 | module Fiber = struct 23 | include Fiber 24 | 25 | let fail = raise 26 | 27 | module Infix = struct 28 | include Infix 29 | let (>>=?) x f = match x with Ok x -> f x | Error _ as r -> r 30 | let (>|=?) x f = match x with Ok x -> Ok (f x) | Error _ as r -> r 31 | end 32 | end 33 | open Fiber.Infix 34 | 35 | module Alcotest_cli = 36 | Testlib.Make_alcotest_cli 37 | (Alcotest.Unix_platform) 38 | (Alcotest_engine.Monad.Identity) 39 | 40 | module List_result_fiber = struct 41 | let rec iter_s f = function 42 | | [] -> Fiber.return (Ok ()) 43 | | x :: xs -> f x >>=? fun () -> iter_s f xs 44 | end 45 | -------------------------------------------------------------------------------- /caqti-eio/testlib-unix/testlib_eio_unix.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Testlib.Sig.Ground 19 | with type 'a Fiber.t = 'a 20 | and module Stream = Caqti_eio.Stream 21 | and module Pool = Caqti_eio.Pool 22 | -------------------------------------------------------------------------------- /caqti-lwt.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-lwt" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.2.3" & < "2.3.0~"} 11 | "dune" {>= "3.9"} 12 | "domain-name" 13 | "ipaddr" 14 | "logs" 15 | "mtime" {>= "2.0.0"} 16 | "lwt" {>= "5.3.0"} 17 | "ocaml" 18 | "alcotest" {with-test & >= "1.5.0"} 19 | "alcotest-lwt" {with-test & >= "1.5.0"} 20 | "cmdliner" {with-test & >= "1.1.0"} 21 | "caqti-driver-sqlite3" {with-test} 22 | "odoc" {with-doc} 23 | ] 24 | build: [ 25 | ["dune" "build" "-p" name "-j" jobs] 26 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 27 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 28 | ] 29 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 30 | synopsis: "Lwt support for Caqti" 31 | -------------------------------------------------------------------------------- /caqti-lwt/lib-unix/caqti_lwt_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2014--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Caqti_platform 19 | 20 | module System = System 21 | module Pool = System.Pool 22 | 23 | module Loader = Caqti_platform_unix.Driver_loader.Make (System) (System_unix) 24 | 25 | include Connector.Make (System) (Pool) (Loader) 26 | 27 | let connect 28 | ?subst ?env ?config ?tweaks_version ?(sw = Caqti_lwt.Switch.eternal) uri = 29 | connect ?subst ?env ?config ?tweaks_version ~sw ~stdenv:() uri 30 | 31 | let with_connection = with_connection ~stdenv:() 32 | 33 | let connect_pool 34 | ?pool_config ?post_connect ?subst ?env ?config ?tweaks_version 35 | ?(sw = Caqti_lwt.Switch.eternal) uri = 36 | connect_pool 37 | ?pool_config ?post_connect ?subst ?env ?config ?tweaks_version 38 | ~sw ~stdenv:() uri 39 | -------------------------------------------------------------------------------- /caqti-lwt/lib-unix/caqti_lwt_unix.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2014--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Connecting on Unix-like platforms using Lwt 19 | 20 | This module contains functions for connecting to databases using the 21 | lwt.unix library, providing support for all drivers. 22 | 23 | See also {!Caqti_lwt} for basic Lwt support. *) 24 | 25 | (**/**) (* for test_pool_lwt.ml *) 26 | module System = System 27 | (**/**) 28 | 29 | module Pool : Caqti_pool_sig.S with type 'a fiber := 'a Lwt.t 30 | 31 | include Caqti_connect_sig.S 32 | with type 'a fiber := 'a Lwt.t 33 | and type ('a, 'e) stream := ('a, 'e) Caqti_lwt.Stream.t 34 | and type ('a, 'e) pool := ('a, 'e) Pool.t 35 | and type connection := Caqti_lwt.connection 36 | and type 'a with_switch := ?sw: Caqti_lwt.Switch.t -> 'a 37 | and type 'a with_stdenv := 'a 38 | -------------------------------------------------------------------------------- /caqti-lwt/lib-unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_lwt_unix) 3 | (public_name caqti-lwt.unix) 4 | (libraries 5 | caqti caqti-lwt caqti.platform caqti.platform.unix 6 | domain-name ipaddr 7 | logs logs.lwt lwt lwt.unix 8 | mtime mtime.clock.os)) 9 | -------------------------------------------------------------------------------- /caqti-lwt/lib-unix/system.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (**/**) 19 | 20 | include Caqti_platform.System_sig.S 21 | with type 'a Fiber.t = 'a Lwt.t 22 | and type stdenv = unit 23 | and module Stream = Caqti_lwt.Stream 24 | and type Switch.t = Caqti_lwt.Switch.t 25 | and type Net.tcp_flow = Lwt_unix.file_descr 26 | and type Net.tls_flow = Lwt_io.input_channel * Lwt_io.output_channel 27 | 28 | module Alarm : Caqti_platform.Pool.ALARM 29 | with type switch := Switch.t 30 | and type stdenv := unit 31 | 32 | module Pool : Caqti_platform.Pool.S 33 | with type 'a fiber := 'a Lwt.t 34 | and type switch := Switch.t 35 | and type stdenv := unit 36 | -------------------------------------------------------------------------------- /caqti-lwt/lib-unix/system_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Lwt.Infix 19 | 20 | module Preemptive = Lwt_preemptive 21 | 22 | module Unix = struct 23 | type file_descr = Lwt_unix.file_descr 24 | 25 | let wrap_fd f fd = f (Lwt_unix.of_unix_file_descr fd) 26 | 27 | let poll ~stdenv:() ?(read = false) ?(write = false) ?timeout fd = 28 | let choices = [] 29 | |> (fun acc -> if read then Lwt_unix.wait_read fd :: acc else acc) 30 | |> (fun acc -> if write then Lwt_unix.wait_write fd :: acc else acc) 31 | |> Option.fold 32 | ~none:Fun.id ~some:(fun t acc -> Lwt_unix.timeout t :: acc) timeout 33 | in 34 | if choices = [] then 35 | Lwt.fail_invalid_arg "Caqti_lwt.Unix.poll: No operation specified." 36 | else 37 | Lwt.catch 38 | (fun () -> Lwt.choose choices >|= fun _ -> false) 39 | (function 40 | | Lwt_unix.Timeout -> Lwt.return_true 41 | | exn -> Lwt.fail exn) 42 | >|= fun timed_out -> 43 | (Lwt_unix.readable fd, Lwt_unix.writable fd, timed_out) 44 | end 45 | -------------------------------------------------------------------------------- /caqti-lwt/lib/caqti_lwt.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Caqti_platform 19 | 20 | module Fiber = struct 21 | type 'a t = 'a Lwt.t 22 | 23 | module Infix = struct 24 | let (>>=) = Lwt.Infix.(>>=) 25 | let (>|=) = Lwt.Infix.(>|=) 26 | end 27 | open Infix 28 | 29 | let return = Lwt.return 30 | let catch = Lwt.catch 31 | let finally = Lwt.finalize 32 | let cleanup f g = Lwt.catch f (fun exn -> g () >>= fun () -> Lwt.fail exn) 33 | end 34 | 35 | module Stream = Caqti_platform.Stream.Make (Fiber) 36 | module Switch = Caqti_platform.Switch.Make (Fiber) 37 | 38 | module System_core = struct 39 | module Fiber = Fiber 40 | module Stream = Stream 41 | module Switch = Switch 42 | 43 | let async ~sw:_ = Lwt.async 44 | 45 | module Mutex = Lwt_mutex 46 | 47 | module Condition = struct 48 | type t = unit Lwt_condition.t 49 | let create = Lwt_condition.create 50 | let wait c mutex = Lwt_condition.wait ~mutex c 51 | let signal c = Lwt_condition.signal c () 52 | end 53 | 54 | module Log = struct 55 | type 'a log = 'a Logs_lwt.log 56 | let err ?(src = Logging.default_log_src) = Logs_lwt.err ~src 57 | let warn ?(src = Logging.default_log_src) = Logs_lwt.warn ~src 58 | let info ?(src = Logging.default_log_src) = Logs_lwt.info ~src 59 | let debug ?(src = Logging.default_log_src) = Logs_lwt.debug ~src 60 | end 61 | 62 | (* Cf. pgx_lwt. *) 63 | module Sequencer = struct 64 | type 'a t = 'a * Lwt_mutex.t 65 | let create m = (m, Lwt_mutex.create ()) 66 | let enqueue (m, mutex) f = Lwt_mutex.with_lock mutex (fun () -> f m) 67 | end 68 | end 69 | 70 | module type CONNECTION = Caqti_connection_sig.S 71 | with type 'a fiber := 'a Lwt.t 72 | and type ('a, 'e) stream := ('a, 'e) Stream.t 73 | 74 | type connection = (module CONNECTION) 75 | 76 | let or_fail = function 77 | | Ok x -> Lwt.return x 78 | | Error (#Caqti_error.t as err) -> Lwt.fail (Caqti_error.Exn err) 79 | -------------------------------------------------------------------------------- /caqti-lwt/lib/caqti_lwt.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Prerequisities for connecting to databases using Lwt 19 | 20 | This module contains most of the prerequisite types and modules. Functions 21 | to establish database connections are provided by the [caqti-lwt.unix] and 22 | [caqti-mirage] libraries. Pool instances are also found there due to 23 | additional OS dependencies. *) 24 | 25 | (* A custom stream implementation instantiated for Lwt. This is similar to 26 | * {!Lwt_seq}, except with error handling. *) 27 | module Stream : Caqti_stream_sig.S with type 'a fiber := 'a Lwt.t 28 | 29 | (* This should ideally be {!Lwt_switch}, but we need a way to cancel cleanup 30 | * jobs in order to avoid a memory leaks for long-lived pools. *) 31 | module Switch : Caqti_switch_sig.S with type 'a fiber := 'a Lwt.t 32 | 33 | (**/**) 34 | (* For private use by caqti-lwt.unix and caqti-mirage. *) 35 | module System_core : sig 36 | include Caqti_platform.System_sig.CORE 37 | with type 'a Fiber.t = 'a Lwt.t 38 | and module Stream = Stream 39 | and type Switch.t = Switch.t 40 | and type stdenv := unit 41 | end 42 | (**/**) 43 | 44 | module type CONNECTION = Caqti_connection_sig.S 45 | with type 'a fiber := 'a Lwt.t 46 | and type ('a, 'e) stream := ('a, 'e) Stream.t 47 | 48 | type connection = (module CONNECTION) 49 | 50 | val or_fail : ('a, [< Caqti_error.t]) result -> 'a Lwt.t 51 | (** Converts an error to an Lwt future failed with a {!Caqti_error.Exn} 52 | exception holding the error. *) 53 | -------------------------------------------------------------------------------- /caqti-lwt/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_lwt) 3 | (public_name caqti-lwt) 4 | (libraries logs.lwt lwt caqti.platform)) 5 | -------------------------------------------------------------------------------- /caqti-lwt/test-unix/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name main) 3 | (package caqti-lwt) 4 | (libraries alcotest alcotest-lwt caqti caqti-lwt caqti-lwt.unix testlib)) 5 | -------------------------------------------------------------------------------- /caqti-lwt/test-unix/main.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | let () = Lwt_main.run begin 19 | Alcotest_lwt.V1.run "caqti-lwt" [ 20 | "pool-lwt", Test_pool_lwt.test_cases; 21 | ] 22 | end 23 | -------------------------------------------------------------------------------- /caqti-lwt/testlib-unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name testlib_lwt_unix) 3 | (libraries 4 | alcotest 5 | caqti 6 | caqti_lwt 7 | caqti_lwt_unix 8 | lwt 9 | testlib)) 10 | -------------------------------------------------------------------------------- /caqti-lwt/testlib-unix/testlib_lwt_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Fiber = struct 19 | type 'a t = 'a Lwt.t 20 | 21 | let return = Lwt.return 22 | let catch = Lwt.catch 23 | let fail = Lwt.fail 24 | 25 | module Infix = struct 26 | let (>>=) = Lwt.Infix.(>>=) 27 | let (>|=) = Lwt.Infix.(>|=) 28 | let (>>=?) = Lwt_result.Infix.(>>=) 29 | let (>|=?) = Lwt_result.Infix.(>|=) 30 | end 31 | end 32 | 33 | open Fiber.Infix 34 | 35 | include Caqti_lwt 36 | include Caqti_lwt_unix 37 | 38 | module Alcotest_cli = Testlib.Make_alcotest_cli (Alcotest.Unix_platform) (Lwt) 39 | 40 | module List_result_fiber = struct 41 | let rec iter_s f = function 42 | | [] -> Fiber.return (Ok ()) 43 | | x :: xs -> f x >>=? fun () -> iter_s f xs 44 | end 45 | -------------------------------------------------------------------------------- /caqti-lwt/testlib-unix/testlib_lwt_unix.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Testlib.Sig.Ground 19 | with type 'a Fiber.t = 'a Lwt.t 20 | and module Stream = Caqti_lwt.Stream 21 | and module Pool = Caqti_lwt_unix.Pool 22 | -------------------------------------------------------------------------------- /caqti-miou.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-miou" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Romain Calascibetta " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.2.3" & < "2.3.0~"} 11 | "dune" {>= "3.9"} 12 | "miou" {>= "0.3.0"} 13 | "logs" 14 | "ocaml" {>= "5.0.0~"} 15 | "alcotest" {with-test & >= "1.5.0"} 16 | "caqti-driver-sqlite3" {with-test} 17 | "cmdliner" {with-test & >= "1.1.0"} 18 | "mirage-crypto-rng-miou-unix" {with-test} 19 | "odoc" {with-doc} 20 | ] 21 | build: [ 22 | ["dune" "build" "-p" name "-j" jobs] 23 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 24 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 25 | ] 26 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 27 | synopsis: "Miou support for Caqti" 28 | -------------------------------------------------------------------------------- /caqti-miou/lib-unix/caqti_miou_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Caqti_platform 19 | 20 | module System = System 21 | module Pool = System.Pool 22 | module Loader = Caqti_platform_unix.Driver_loader.Make (System) (System_unix) 23 | 24 | include Connector.Make (System) (Pool) (Loader) 25 | 26 | let connect ?subst ?env ?config ?tweaks_version ~sw uri = 27 | connect ?subst ?env ?config ?tweaks_version ~sw ~stdenv:() uri 28 | 29 | let with_connection = with_connection ~stdenv:() 30 | 31 | let connect_pool 32 | ?pool_config ?post_connect ?subst ?env ?config ?tweaks_version ~sw uri = 33 | connect_pool 34 | ?pool_config ?post_connect ?subst ?env ?config ?tweaks_version 35 | ~sw ~stdenv:() uri 36 | -------------------------------------------------------------------------------- /caqti-miou/lib-unix/caqti_miou_unix.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Establishing connections using miou.unix. 19 | 20 | {b This library considered unstable for now,} and may be revised or replaced 21 | as the effect-based libraries evolve. *) 22 | 23 | module System = System 24 | 25 | module Pool : Caqti_pool_sig.S with type 'a fiber := 'a 26 | 27 | include Caqti_connect_sig.S 28 | with type 'a fiber := 'a 29 | and type ('a, 'e) stream := ('a, 'e) Caqti_miou.Stream.t 30 | and type ('a, 'e) pool := ('a, 'e) Pool.t 31 | and type connection := Caqti_miou.connection 32 | and type 'a with_switch := sw: Caqti_miou.Switch.t -> 'a 33 | and type 'a with_stdenv := 'a 34 | -------------------------------------------------------------------------------- /caqti-miou/lib-unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_miou_unix) 3 | (public_name caqti-miou.unix) 4 | (modules caqti_miou_unix system system_unix) 5 | (libraries caqti-miou caqti.platform.unix miou.unix ipaddr.unix)) 6 | -------------------------------------------------------------------------------- /caqti-miou/lib-unix/system_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Unix = struct 19 | type file_descr = Miou_unix.file_descr 20 | 21 | let wrap_fd f fd = f (Miou_unix.of_file_descr ~non_blocking:true fd) 22 | 23 | exception Timeout 24 | let or_raise = function Ok v -> v | Error exn -> raise exn 25 | 26 | let poll ~stdenv:() ?(read= false) ?(write= false) ?timeout fd = 27 | let fn () = match read, write with 28 | | false, false -> (false, false, false) 29 | | true, true -> 30 | let reader = Miou.async @@ fun () -> 31 | Miou_unix.(blocking_read (to_file_descr fd)); 32 | (true, false, false) in 33 | let writer = Miou.async @@ fun () -> 34 | Miou_unix.(blocking_write (to_file_descr fd)); 35 | (false, true, false) in 36 | Miou.await_first [ reader; writer ] |> or_raise 37 | | true, false -> 38 | Miou_unix.(blocking_read (to_file_descr fd)); (true, false, false) 39 | | false, true -> 40 | Miou_unix.(blocking_write (to_file_descr fd)); (false, true, false) in 41 | match timeout with 42 | | None -> fn () 43 | | Some t -> 44 | let sleep = Miou.async @@ fun () -> Miou_unix.sleep t; raise Timeout in 45 | match Miou.await_first [ sleep; Miou.async fn ] with 46 | | Ok v -> v 47 | | Error Timeout -> (false, false, true) 48 | | Error exn -> raise exn 49 | end 50 | 51 | module Preemptive = struct 52 | let detach f x = 53 | let fn () = f x in 54 | let prm = 55 | if Miou.Domain.available () > 0 56 | then Miou.call fn 57 | else Miou.async fn in 58 | Miou.await_exn prm 59 | 60 | let run_in_main fn = fn () 61 | end 62 | -------------------------------------------------------------------------------- /caqti-miou/lib/caqti_miou.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Prerequisites for establishing connections under miou. 19 | 20 | The connection functions can be found in caqti-miou.unix. 21 | 22 | {b This library considered unstable for now,} and may be revised or replaced 23 | as the effect-based libraries evolve. *) 24 | 25 | type switch 26 | 27 | module Stream : Caqti_stream_sig.S with type 'a fiber := 'a 28 | module Switch : Caqti_switch_sig.S 29 | with type 'a fiber := 'a 30 | and type t = switch 31 | 32 | (**/**) 33 | (* For private use by Caqti. *) 34 | module System_core : sig 35 | include Caqti_platform.System_sig.CORE 36 | with type 'a Fiber.t = 'a 37 | and module Stream = Stream 38 | and type Switch.t = Switch.t 39 | and type stdenv := unit 40 | end 41 | (**/**) 42 | 43 | module type CONNECTION = Caqti_connection_sig.S 44 | with type 'a fiber := 'a 45 | and type ('a, 'e) stream := ('a, 'e) Stream.t 46 | 47 | type connection = (module CONNECTION) 48 | 49 | val or_fail : ('a, [< Caqti_error.t ]) result -> 'a 50 | -------------------------------------------------------------------------------- /caqti-miou/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_miou) 3 | (public_name caqti-miou) 4 | (modules caqti_miou) 5 | (libraries logs caqti caqti.platform miou)) 6 | -------------------------------------------------------------------------------- /caqti-miou/test-unix/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name main) 3 | (package caqti-miou) 4 | (libraries logs.threaded alcotest caqti caqti-miou caqti-miou.unix testlib)) 5 | -------------------------------------------------------------------------------- /caqti-miou/test-unix/main.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | let () = Logs_threaded.enable () 19 | 20 | let () = 21 | Alcotest.run "caqti-miou" [ 22 | "pool-miou", Test_pool_miou.test_cases; 23 | ] 24 | -------------------------------------------------------------------------------- /caqti-miou/testlib-unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name testlib_miou_unix) 3 | (libraries alcotest caqti_miou caqti_miou_unix testlib)) 4 | -------------------------------------------------------------------------------- /caqti-miou/testlib-unix/testlib_miou_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Caqti_miou.System_core 19 | include Caqti_miou 20 | include Caqti_miou_unix 21 | 22 | module Fiber = struct 23 | include Fiber 24 | 25 | let fail = raise 26 | 27 | module Infix = struct 28 | include Infix 29 | let (>>=?) = Result.bind 30 | let (>|=?) x f = Result.map f x 31 | end 32 | end 33 | 34 | module Alcotest_cli = 35 | Testlib.Make_alcotest_cli 36 | (Alcotest.Unix_platform) 37 | (Alcotest_engine.Monad.Identity) 38 | 39 | module List_result_fiber = struct 40 | open Fiber.Infix 41 | 42 | let rec iter_s f = function 43 | | [] -> Fiber.return (Ok ()) 44 | | x :: xs -> f x >>=? fun () -> iter_s f xs 45 | end 46 | -------------------------------------------------------------------------------- /caqti-miou/testlib-unix/testlib_miou_unix.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Testlib.Sig.Ground 19 | with type 'a Fiber.t = 'a 20 | and module Stream = Caqti_miou.Stream 21 | and module Pool = Caqti_miou_unix.Pool 22 | -------------------------------------------------------------------------------- /caqti-mirage.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-mirage" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.2.0" & < "2.3.0~"} 11 | "caqti-lwt" {>= "2.1.0" & < "2.3.0~"} 12 | "caqti-tls" {>= "2.1.0" & < "2.3.0~"} 13 | "dns-client" {>= "7.0.0"} 14 | "dns-client-mirage" {>= "7.0.0"} 15 | "domain-name" 16 | "dune" {>= "3.9"} 17 | "ipaddr" 18 | "logs" 19 | "lwt" {>= "5.3.0"} 20 | "mirage-channel" 21 | "mirage-sleep" 22 | "ocaml" 23 | "odoc" {with-doc} 24 | "tls" 25 | "tls-mirage" {>= "1.0.0"} 26 | "tcpip" {>= "8.1.0"} 27 | ] 28 | build: [ 29 | ["dune" "build" "-p" name "-j" jobs] 30 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 31 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 32 | ] 33 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 34 | synopsis: "MirageOS support for Caqti including TLS" 35 | -------------------------------------------------------------------------------- /caqti-mirage/dune: -------------------------------------------------------------------------------- 1 | (dirs :standard \ unikernel) 2 | -------------------------------------------------------------------------------- /caqti-mirage/lib/caqti_mirage.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Functions for connecting to databases from MirageOS unikernels 19 | 20 | This module contains functions for connecting to databases using the 21 | MirageOS platform libraries, providing support for PGX but not drivers based 22 | on bindings. 23 | 24 | See also {!Caqti_lwt} for basic Lwt support. 25 | 26 | {b The caqti-mirage library is experimental at this point.} Feedback from 27 | MirageOS users on the current API is very welcome. *) 28 | 29 | module Make : 30 | functor (STACK : Tcpip.Stack.V4V6) -> 31 | functor (DNS : Dns_client_mirage.S) -> 32 | sig 33 | module Pool : Caqti_pool_sig.S with type 'a fiber := 'a Lwt.t 34 | include Caqti_connect_sig.S 35 | with type 'a fiber := 'a Lwt.t 36 | and type ('a, 'e) stream := ('a, 'e) Caqti_lwt.Stream.t 37 | and type ('a, 'e) pool := ('a, 'e) Pool.t 38 | and type connection := Caqti_lwt.connection 39 | and type 'a with_switch := ?sw: Caqti_lwt.Switch.t -> 'a 40 | and type 'a with_stdenv := STACK.t -> DNS.t -> 'a 41 | end 42 | -------------------------------------------------------------------------------- /caqti-mirage/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_mirage) 3 | (public_name caqti-mirage) 4 | (libraries 5 | caqti 6 | caqti.platform 7 | caqti-lwt 8 | caqti-tls 9 | dns-client 10 | dns-client-mirage 11 | domain-name 12 | ipaddr 13 | logs 14 | logs.lwt 15 | lwt 16 | mirage-channel 17 | mirage-sleep 18 | tcpip 19 | tls-mirage)) 20 | -------------------------------------------------------------------------------- /caqti-mirage/unikernel/README.md: -------------------------------------------------------------------------------- 1 | ## Synopsis 2 | 3 | This directory provides a MirageOS Unikernel which performs a simple query 4 | against a PostgreSQL database using the PGX driver. 5 | 6 | ## Building 7 | 8 | This directory is not integrated in the normal Caqti build. A regular 9 | executable can be built with 10 | ```console 11 | $ opam switch create . 4.14.0 12 | $ export OPAMSWITCH=./mirage 13 | $ eval `opam config env` 14 | $ opam install mirage 15 | $ mirage configure -t unix 16 | $ opam install --deps-only ./mirage 17 | $ mirage build 18 | ``` 19 | See `mirage configure --help` for other targets (`-t`). 20 | 21 | ## Running 22 | 23 | You can start a throw-away PostgreSQL instance in a Docker container with 24 | ```console 25 | $ docker run --rm -it -e POSTGRES_PASSWORD=KWRIsr6TPjBX -p 127.0.0.1:15432:5432 postgres:13 26 | ``` 27 | and in a parallel shell run 28 | ```console 29 | $ _build/default/caqti-test-unikernel --database-uri pgx://postgres:KWRIsr6TPjBX@127.0.0.1:15432 30 | ``` 31 | Other targets may require a hypervisor and direct access to a network 32 | interface. Documentation can be found on the [MirageOS 33 | site](https://mirage.io/). 34 | -------------------------------------------------------------------------------- /caqti-tls-async.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-tls-async" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "async_kernel" {>= "v0.11.0"} 11 | "async_unix" {>= "v0.11.0"} 12 | "caqti" {>= "2.1.0" & < "2.3.0~"} 13 | "caqti-async" {>= "2.1.0" & < "2.3.0~"} 14 | "dune" {>= "3.9"} 15 | "ocaml" 16 | "tls" 17 | "tls-async" 18 | "ppx_jane" 19 | "odoc" {with-doc} 20 | ] 21 | build: [ 22 | ["dune" "build" "-p" name "-j" jobs] 23 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 24 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 25 | ] 26 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 27 | synopsis: "TLS support for caqti-async" 28 | -------------------------------------------------------------------------------- /caqti-tls-async/lib/caqti_tls_async.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** TLS support for caqti-async based on the tls-async library. 19 | 20 | This library has no public entry points, but registers TLS support for 21 | [caqti-async], which can be enabled by setting {!Caqti_tls.Config.client} in 22 | the {{!Caqti_connect_config} configuration}. *) 23 | -------------------------------------------------------------------------------- /caqti-tls-async/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name caqti-tls-async) 3 | (name caqti_tls_async) 4 | (optional) 5 | (preprocess (pps ppx_jane)) 6 | (library_flags (:standard -linkall)) 7 | (libraries 8 | async_kernel 9 | caqti 10 | caqti-async 11 | caqti-tls 12 | tls 13 | tls-async)) 14 | 15 | (plugin 16 | (package caqti-tls-async) 17 | (name caqti-tls-async) 18 | (libraries caqti-tls-async) 19 | (site (caqti plugins))) 20 | -------------------------------------------------------------------------------- /caqti-tls-eio.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-tls-lwt" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.1.0" & < "2.3.0~"} 11 | "caqti-eio" {>= "2.1.0" & < "2.3.0~"} 12 | "dune" {>= "3.9"} 13 | "eio" {>= "0.12"} 14 | "ocaml" 15 | "tls" 16 | "tls-eio" {>= "0.17.4"} 17 | "odoc" {with-doc} 18 | ] 19 | build: [ 20 | ["dune" "build" "-p" name "-j" jobs] 21 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 22 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 23 | ] 24 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 25 | synopsis: "TLS support for caqti-eio" 26 | -------------------------------------------------------------------------------- /caqti-tls-eio/lib/caqti_tls_eio.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Caqti_eio 19 | 20 | module TLS_provider = struct 21 | type tls_config = Tls.Config.client 22 | let tls_config_key = Caqti_tls.Config.client 23 | 24 | let start_tls ~config ?host tcp_flow = 25 | Ok (Tls_eio.client_of_flow config ?host tcp_flow) 26 | end 27 | 28 | let () = System.Net.register_tls_provider (module TLS_provider) 29 | -------------------------------------------------------------------------------- /caqti-tls-eio/lib/caqti_tls_eio.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** TLS provider for caqti-eio based on the tls library. 19 | 20 | This sublibrary has no entry point, but registeres TLS support for 21 | [caqti-eio], which can be enabled by setting {!Caqti_tls.Config.client} in 22 | the {{!Caqti_connect_config} configuration}. *) 23 | -------------------------------------------------------------------------------- /caqti-tls-eio/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_tls_eio) 3 | (public_name caqti-tls-eio) 4 | (optional) 5 | (library_flags (:standard -linkall)) 6 | (libraries 7 | caqti 8 | caqti.platform 9 | caqti-eio 10 | caqti-tls 11 | tls 12 | tls-eio)) 13 | 14 | (plugin 15 | (package caqti-tls-eio) 16 | (name caqti-tls-eio) 17 | (libraries caqti-tls-eio) 18 | (site (caqti plugins))) 19 | -------------------------------------------------------------------------------- /caqti-tls-lwt.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-tls-lwt" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.1.0" & < "2.3.0~"} 11 | "caqti-lwt" {>= "2.1.0" & < "2.3.0~"} 12 | "dune" {>= "3.9"} 13 | "lwt" {>= "5.3.0"} 14 | "ocaml" 15 | "tls" 16 | "tls-lwt" 17 | "odoc" {with-doc} 18 | ] 19 | build: [ 20 | ["dune" "build" "-p" name "-j" jobs] 21 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 22 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 23 | ] 24 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 25 | synopsis: "TLS support for caqti-lwt.unix" 26 | -------------------------------------------------------------------------------- /caqti-tls-lwt/lib-unix/caqti_lwt_tls_unix.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Lwt.Syntax 19 | open Caqti_lwt_unix 20 | 21 | module TLS_provider = struct 22 | type tls_config = Tls.Config.client 23 | let tls_config_key = Caqti_tls.Config.client 24 | 25 | let start_tls ~config ?host fd = 26 | let+ session = Tls_lwt.Unix.client_of_fd config ?host fd in 27 | Ok (Tls_lwt.of_t session) 28 | end 29 | 30 | let () = System.Net.register_tls_provider (module TLS_provider) 31 | -------------------------------------------------------------------------------- /caqti-tls-lwt/lib-unix/caqti_lwt_tls_unix.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** TLS provider for caqti-lwt based on the tls-lwt library. 19 | 20 | This sublibrary has no entry point, but registers TLS support for 21 | [caqti-lwt.unix], which can be enabled by setting {!Caqti_tls.Config.client} 22 | in the {{!Caqti_connect_config} configuration}. *) 23 | -------------------------------------------------------------------------------- /caqti-tls-lwt/lib-unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_tls_lwt_unix) 3 | (public_name caqti-tls-lwt.unix) 4 | (optional) 5 | (library_flags (:standard -linkall)) 6 | (libraries 7 | caqti 8 | caqti.platform 9 | caqti.platform.unix 10 | caqti-lwt 11 | caqti-lwt.unix 12 | caqti-tls 13 | tls 14 | tls-lwt)) 15 | 16 | (plugin 17 | (package caqti-tls-lwt) 18 | (name caqti-tls-lwt-unix) 19 | (libraries caqti-tls-lwt.unix) 20 | (site (caqti plugins))) 21 | -------------------------------------------------------------------------------- /caqti-tls-miou.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-tls-lwt" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Romain Calascibetta " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.2.0" & < "2.3.0~"} 11 | "caqti-miou" {>= "2.2.0" & < "2.3.0~"} 12 | "dune" {>= "3.9"} 13 | "ocaml" 14 | "tls" 15 | "ke" 16 | "tls-miou-unix" {>= "1.0.3"} 17 | "odoc" {with-doc} 18 | ] 19 | build: [ 20 | ["dune" "build" "-p" name "-j" jobs] 21 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 22 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 23 | ] 24 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 25 | synopsis: "TLS support for caqti-eio" 26 | -------------------------------------------------------------------------------- /caqti-tls-miou/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_tls_miou) 3 | (public_name caqti-tls-miou) 4 | (library_flags 5 | (:standard -linkall)) 6 | (libraries caqti caqti.platform caqti-miou.unix caqti-tls tls ke tls-miou-unix)) 7 | 8 | (plugin 9 | (package caqti-tls-miou) 10 | (name caqti-tls-miou) 11 | (libraries caqti-tls-miou) 12 | (site 13 | (caqti plugins))) 14 | -------------------------------------------------------------------------------- /caqti-tls.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-tls" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.1.0" & < "2.3.0~"} 11 | "dune" {>= "3.9"} 12 | "ocaml" 13 | "odoc" {with-doc} 14 | "tls" {>= "1.0.0"} 15 | ] 16 | build: [ 17 | ["dune" "build" "-p" name "-j" jobs] 18 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 19 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 20 | ] 21 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 22 | synopsis: "Caqti TLS support for PGX; config and caqti.unix implementation" 23 | description: """ 24 | This package contains the shared configuration and caqti.unix-specific 25 | implementation of TLS for the Caqti network API. This package only applies 26 | to PGX, since drivers based on bindings use their own TLS implementation 27 | (libpq, mariadb) or have no need for it (sqlite3). 28 | 29 | The implementation for caqti-eio and caqti-lwt can be found in caqti-tls-eio 30 | and caqti-tls-lwt, respectively. 31 | """ 32 | -------------------------------------------------------------------------------- /caqti-tls/lib/config.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | let client : Tls.Config.client option Caqti_connect_config.key = 19 | Caqti_connect_config.create_key "tls" None 20 | -------------------------------------------------------------------------------- /caqti-tls/lib/config.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Configuration parameter for the [tls] library. *) 19 | 20 | val client : Tls.Config.client option Caqti_connect_config.key 21 | -------------------------------------------------------------------------------- /caqti-tls/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_tls) 3 | (public_name caqti-tls) 4 | (optional) 5 | (libraries caqti tls)) 6 | -------------------------------------------------------------------------------- /caqti-tls/testlib/dune: -------------------------------------------------------------------------------- 1 | ; This library registers TLS-related command-line arguments if the tls library 2 | ; is available, otherwise it is an empty library. It would be more instructive 3 | ; to list it as an optional library where used, if possible. 4 | (library 5 | (name testlib_tls) 6 | (library_flags (:standard -linkall)) 7 | (libraries 8 | (select testlib_tls.ml from 9 | (caqti 10 | caqti-tls 11 | cmdliner 12 | ptime.clock.os 13 | testlib 14 | x509 15 | -> testlib_tls.enabled.ml) 16 | (-> testlib_tls.disabled.ml)))) 17 | -------------------------------------------------------------------------------- /caqti-tls/testlib/testlib_tls.disabled.ml: -------------------------------------------------------------------------------- 1 | (* Empty module used when TLS is unavailable. *) 2 | -------------------------------------------------------------------------------- /caqti-tls/testlib/testlib_tls.enabled.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Testlib 19 | 20 | let () = 21 | let open Cmdliner in 22 | let x509_authenticator_conv = 23 | let parse spec = 24 | X509.Authenticator.of_string spec 25 | |> Result.map (fun f -> f (fun () -> Some (Ptime_clock.now ()))) 26 | in 27 | let pp ppf _ = Format.pp_print_string ppf "" in 28 | Arg.conv (parse, pp) 29 | in 30 | let x509_authenticator = 31 | let doc = 32 | "X509 authenticator for validating TLS connections when using the tls \ 33 | library. The input is parsed by X509.Authenticator.of_string" 34 | in 35 | let env = Cmd.Env.info "CAQTI_TEST_X509_AUTHENTICATOR" in 36 | Arg.(value @@ opt (some x509_authenticator_conv) None @@ 37 | info ~doc ~env ["x509-authenticator"]) 38 | in 39 | let process x509_authenticator common_args = 40 | (match x509_authenticator with 41 | | None -> common_args 42 | | Some authenticator -> 43 | let tls_client_config = 44 | Result.get_ok (Tls.Config.client ~authenticator ()) 45 | in 46 | let connect_config = 47 | common_args.connect_config 48 | |> Caqti_connect_config.set Caqti_tls.Config.client 49 | (Some tls_client_config) 50 | in 51 | {common_args with connect_config}) 52 | in 53 | Testlib.register_common_arg Term.(const process $ x509_authenticator) 54 | -------------------------------------------------------------------------------- /caqti-tls/testlib/testlib_tls.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** TLS component for the internal test library 19 | 20 | This library registers the command-line arguments needed to enable and set 21 | up TLS-based encryption and authentication for pure-OCaml drivers. *) 22 | -------------------------------------------------------------------------------- /caqti-type-calendar.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti-type-calendar" 3 | maintainer: "Petter A. Urkedal " 4 | authors: "Petter A. Urkedal " 5 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 6 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 7 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 8 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 9 | depends: [ 10 | "caqti" {>= "2.0.0" & < "3.0.0~"} 11 | "calendar" {>= "2.0"} 12 | "dune" {>= "3.9"} 13 | "ocaml" 14 | "odoc" {with-doc} 15 | ] 16 | build: [ 17 | ["dune" "build" "-p" name "-j" jobs] 18 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 19 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 20 | ] 21 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 22 | synopsis: "Date and time field types using the calendar library" 23 | -------------------------------------------------------------------------------- /caqti-type-calendar/lib/caqti_type_calendar.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open CalendarLib 19 | 20 | let msg_cdate_encode = "Failed to convert CalendarLib.Date.t to Ptime.t" 21 | let msg_cdate_decode = "Failed to convert Ptime.t to CalendarLib.Date.t" 22 | let msg_ctime_encode = "Failed to convert CalendarLib.Calendar.t to Ptime.t" 23 | let msg_ctime_decode = "Failed to convert Ptime.t to CalendarLib.Calendar.t" 24 | 25 | let cdate = 26 | let encode date = 27 | (match Ptime.of_float_s (Date.to_unixfloat date) with 28 | | Some t -> t 29 | | None -> raise (Caqti_type.Reject msg_cdate_encode)) 30 | in 31 | let decode pdate = 32 | (try Date.from_unixfloat (Ptime.to_float_s pdate) with 33 | | Unix.Unix_error _ -> raise (Caqti_type.Reject msg_cdate_decode)) 34 | in 35 | Caqti_type.(product decode @@ proj pdate encode @@ proj_end) 36 | 37 | let ctime = 38 | let encode time = 39 | (match Ptime.of_float_s (Calendar.to_unixfloat time) with 40 | | Some t -> t 41 | | None -> raise (Caqti_type.Reject msg_ctime_encode)) 42 | in 43 | let decode ptime = 44 | (try Calendar.from_unixfloat (Ptime.to_float_s ptime) with 45 | | Unix.Unix_error _ -> raise (Caqti_type.Reject msg_ctime_decode)) 46 | in 47 | Caqti_type.(product decode @@ proj ptime encode @@ proj_end) 48 | -------------------------------------------------------------------------------- /caqti-type-calendar/lib/caqti_type_calendar.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Caqti date and time field type based on the calendar package. *) 19 | 20 | val cdate : CalendarLib.Date.t Caqti_type.t 21 | val ctime : CalendarLib.Calendar.t Caqti_type.t 22 | -------------------------------------------------------------------------------- /caqti-type-calendar/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_type_calendar) 3 | (public_name caqti-type-calendar) 4 | (libraries caqti calendar)) 5 | -------------------------------------------------------------------------------- /caqti.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "caqti" 3 | maintainer: "Petter A. Urkedal " 4 | authors: [ 5 | "Petter A. Urkedal " 6 | "Nathan Rebours " 7 | "Basile Clément" 8 | ] 9 | license: "LGPL-3.0-or-later WITH LGPL-3.0-linking-exception" 10 | homepage: "https://github.com/paurkedal/ocaml-caqti/" 11 | doc: "https://paurkedal.github.io/ocaml-caqti/index.html" 12 | bug-reports: "https://github.com/paurkedal/ocaml-caqti/issues" 13 | depends: [ 14 | "alcotest" {with-test & >= "1.5.0"} 15 | "angstrom" {>= "0.14.0"} 16 | "bigstringaf" 17 | "cmdliner" {with-test & >= "1.1.0"} 18 | "domain-name" {>= "0.2.0"} 19 | "dune" {>= "3.9"} 20 | "dune-site" 21 | "ipaddr" {>= "3.0.0"} 22 | "logs" 23 | "lru" {>= "0.3.1"} 24 | "lwt-dllist" 25 | "mdx" {with-test & >= "2.3.0"} 26 | "mtime" {>= "2.0.0"} 27 | "ocaml" {>= "4.08.0"} 28 | "odoc" {with-doc} 29 | "ptime" 30 | "re" {with-test} 31 | "tls" 32 | "uri" {>= "2.2.0"} 33 | "x509" 34 | ] 35 | conflicts: [ 36 | "result" {< "1.5"} 37 | ] 38 | build: [ 39 | ["dune" "build" "-p" name "-j" jobs "@install"] 40 | ["dune" "install" "-p" name "--create-install-file" name] 41 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 42 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 43 | ] 44 | dev-repo: "git+https://github.com/paurkedal/ocaml-caqti.git" 45 | synopsis: "Unified interface to relational database libraries" 46 | description: """ 47 | Caqti provides a monadic cooperative-threaded OCaml connector API for 48 | relational databases. 49 | 50 | The purpose of Caqti is further to help make applications independent of a 51 | particular database system. This is achieved by defining a common signature, 52 | which is implemented by the database drivers. Connection parameters are 53 | specified as an URI, which is typically provided at run-time. Caqti then 54 | loads a driver which can handle the URI, and provides a first-class module 55 | which implements the driver API and additional convenience functionality. 56 | 57 | Caqti does not make assumptions about the structure of the query language, 58 | and only provides the type information needed at the edges of communication 59 | between the OCaml code and the database; i.e. for encoding parameters and 60 | decoding returned tuples. It is hoped that this agnostic choice makes it a 61 | suitable target for higher level interfaces and code generators.""" 62 | -------------------------------------------------------------------------------- /caqti/doc/dune: -------------------------------------------------------------------------------- 1 | (documentation (package caqti)) 2 | -------------------------------------------------------------------------------- /caqti/doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 caqti index} 2 | 3 | {1 Library caqti} 4 | 5 | This is classic API for Caqti, which mirrors the above libray and provides 6 | signatures, configurations, and a few other things for other Caqti packages. 7 | The plan in to uses wrapped module everywhere and to make some adjustments 8 | to the organization of modules. You may continue to use this for now, as 9 | deprecation is posponed until the complete replacement is available. 10 | 11 | This library exposes the following toplevel modules: 12 | {!modules: 13 | Caqti_connect_sig 14 | Caqti_connection_sig 15 | Caqti_driver_info 16 | Caqti_error 17 | Caqti_mult 18 | Caqti_pool_config 19 | Caqti_pool_sig 20 | Caqti_query 21 | Caqti_query_fmt 22 | Caqti_request 23 | Caqti_response_sig 24 | Caqti_stream_sig 25 | Caqti_switch_sig 26 | Caqti_type 27 | Caqti_type_sig 28 | } 29 | 30 | {1 Preview library caqti.template} 31 | 32 | For now, {b this library is provides as a preview only. The interface will 33 | change in incompatible ways} before it's declared ready for usage in 34 | production code. 35 | 36 | This library provides the interface to create templates for requests to send 37 | to the database. A request template essentially combines a parametrised 38 | query string with a parameter encoder and a row decoder, and can often be 39 | defined statically. Execution of queries are handled by other packages, 40 | depending on your preferred concurrency and OS libraries. 41 | 42 | The entry point of this library is the module: 43 | {!module-Caqti_template} 44 | 45 | {1 Library caqti.blocking} 46 | 47 | This library implements the blocking (non-)concurrency using the unix library. 48 | Real concurrency support is provided by separate packages. 49 | 50 | The entry point of this library is the module: 51 | {!module-Caqti_blocking}. 52 | 53 | {1 Library caqti.plugin} 54 | 55 | This library registers a dynamic linker based on the dune-site.plugin 56 | library, which allows Caqti to automatically load driver libraries inferred 57 | from the URI when connecting to a new kind of database for the first time. 58 | It has entry point; linking aganist it provides all of its functionality. 59 | 60 | This library is an experimental drop-in replacement for the caqti-dynload 61 | package. 62 | 63 | 64 | {1 Platform Libraries for Internal Use} 65 | 66 | The platform libraries are only meant for use in implementing drivers and 67 | concurrency support. {b These APIs are unstable}, i.e. they can change between 68 | minor versions and without prior deprecation notices. 69 | 70 | {2 Library caqti.platform} 71 | 72 | The entry point of this library is the module: 73 | {!module-Caqti_platform}. 74 | 75 | {2 Library caqti.platform.unix} 76 | 77 | The entry point of this library is the module: 78 | {!module-Caqti_platform_unix}. 79 | -------------------------------------------------------------------------------- /caqti/doc/tweaks.mld: -------------------------------------------------------------------------------- 1 | {1:tweaks Database Tweaks} 2 | 3 | {2 TL;DR} 4 | 5 | The [?tweaks_version] parameter tells Caqti drivers to enable all tweaks 6 | introduced up to and including the given major and minor version of Caqti. 7 | 8 | {2 The Tweaks Parameter} 9 | 10 | Occasionally Caqti makes changes to the database session parameters or 11 | otherwise how it interacts with specific database systems. This may be done 12 | to improve consistency across databases, to make it easier to detect 13 | mistakes, to avoid obsolete behaviour, etc. However, this can break 14 | backwards compatibility with applications, sometimes in subtle ways, which 15 | is the motivation for the [?tweaks_version] parameter of the connecting 16 | functions. 17 | 18 | Passing [~tweaks_version:(major_version, minor_verson)] declares that the 19 | application is compatible with all tweaks introduced up to and including 20 | that version of Caqti. The default is to omit all tweaks introduced since 21 | the last major version. On each major release, all tweaks up to that point 22 | becomes permanent and requesting an earlier tweaks version will have no 23 | effect. 24 | 25 | Production code should either omit the parameter or pass the largest major 26 | and minor version pair for which the code has been tested. This offers the 27 | choice of adapting only on major versions or incrementally. 28 | 29 | Code in development can declare a progressive value, like the next major 30 | version, in order to always use the latest set of tweaks. 31 | 32 | {2 Current Tweaks} 33 | 34 | {3 Introduced with [(1, 8)] and later} 35 | 36 | - SQLite3: Checking of foreign key constraints has been enabled by issuing 37 | a [PRAGMA foreign_keys = ON] for the session. 38 | -------------------------------------------------------------------------------- /caqti/lib-blocking/caqti_blocking.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2018--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Blocking API based on the Unix module. 19 | 20 | This module implements a blocking API. It is not designed for preemptive 21 | threading. That is, connections and connection pools must be created and 22 | used within a single thread, and any limitation on multithreading from the 23 | driver or client library applies. 24 | 25 | You can use a connection pool to cache a single DB connection, additional 26 | connections will not be allocated, since usage is serial. *) 27 | 28 | module Stream : Caqti_stream_sig.S with type 'a fiber := 'a 29 | module Pool : Caqti_pool_sig.S with type 'a fiber := 'a 30 | 31 | module type CONNECTION = Caqti_connection_sig.S 32 | with type 'a fiber := 'a 33 | and type ('a, 'e) stream := ('a, 'e) Stream.t 34 | 35 | include Caqti_connect_sig.S 36 | with type 'a fiber := 'a 37 | and type 'a with_switch := 'a 38 | and type 'a with_stdenv := 'a 39 | and type ('a, 'e) stream := ('a, 'e) Stream.t 40 | and type ('a, 'e) pool := ('a, 'e) Pool.t 41 | and type connection = (module CONNECTION) 42 | 43 | val or_fail : ('a, [< Caqti_error.t]) result -> 'a 44 | (** Takes [Ok x] to [x] and raises {!Caqti_error.Exn}[ err] on [Error err]. *) 45 | -------------------------------------------------------------------------------- /caqti/lib-blocking/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_blocking) 3 | (public_name caqti.blocking) 4 | (libraries 5 | caqti caqti.platform caqti.platform.unix 6 | domain-name ipaddr 7 | logs threads unix)) 8 | ; TODO: Can threads dependency be moved to drivers which need it? 9 | -------------------------------------------------------------------------------- /caqti/lib-platform-unix/driver_loader.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module type DRIVER_FUNCTOR = 19 | functor (System : Caqti_platform.System_sig.S) -> 20 | functor (_ : System_sig.S 21 | with type 'a fiber := 'a System.Fiber.t 22 | and type stdenv := System.stdenv) -> 23 | Caqti_platform.Driver_loader.DRIVER 24 | with type 'a fiber := 'a System.Fiber.t 25 | and type ('a, 'err) stream := ('a, 'err) System.Stream.t 26 | and type switch := System.Switch.t 27 | and type stdenv := System.stdenv 28 | 29 | let drivers = Hashtbl.create 5 30 | let register scheme p = Hashtbl.add drivers scheme p 31 | 32 | module Make 33 | (System : Caqti_platform.System_sig.S) 34 | (System_unix : System_sig.S 35 | with type 'a fiber := 'a System.Fiber.t 36 | and type stdenv := System.stdenv) = 37 | struct 38 | module Core_loader = Caqti_platform.Driver_loader.Make (System) 39 | 40 | module type DRIVER = Core_loader.DRIVER 41 | module type CONNECTION = Core_loader.CONNECTION 42 | 43 | let provides_unix = true 44 | 45 | let find_and_apply' scheme = 46 | (match Hashtbl.find_opt drivers scheme with 47 | | None -> None 48 | | Some (module F : DRIVER_FUNCTOR) -> 49 | let module Driver = F (System) (System_unix) in 50 | Some (module Driver : DRIVER)) 51 | 52 | let find_and_apply scheme = 53 | (match Core_loader.find_and_apply scheme with 54 | | Some _ as r -> r 55 | | None -> find_and_apply' scheme) 56 | end 57 | -------------------------------------------------------------------------------- /caqti/lib-platform-unix/driver_loader.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Connection functor and registration for driver using the Unix module. *) 19 | 20 | (** {2 Registration} *) 21 | 22 | module type DRIVER_FUNCTOR = 23 | functor (System : Caqti_platform.System_sig.S) -> 24 | functor (_ : System_sig.S 25 | with type 'a fiber := 'a System.Fiber.t 26 | and type stdenv := System.stdenv) -> 27 | Caqti_platform.Driver_loader.DRIVER 28 | with type 'a fiber := 'a System.Fiber.t 29 | and type ('a, 'err) stream := ('a, 'err) System.Stream.t 30 | and type switch := System.Switch.t 31 | and type stdenv := System.stdenv 32 | (** The functor implemented by drivers dependent on the unix library. *) 33 | 34 | val register : string -> (module DRIVER_FUNCTOR) -> unit 35 | (** [define_unix_driver scheme m] installs [m] as a handler for the URI scheme 36 | [scheme]. This call must be done by a backend installed with findlib name 37 | caqti-driver-{i scheme} as part of its initialization. *) 38 | 39 | (** {2 Usage} *) 40 | 41 | module Make 42 | (System : Caqti_platform.System_sig.S) 43 | (_ : System_sig.S 44 | with type 'a fiber := 'a System.Fiber.t 45 | and type stdenv := System.stdenv) : 46 | Caqti_platform.Driver_loader.S 47 | with type 'a fiber := 'a System.Fiber.t 48 | and type ('a, 'e) stream := ('a, 'e) System.Stream.t 49 | and type switch := System.Switch.t 50 | and type stdenv := System.stdenv 51 | (** Constructs the main module used to connect to a database for the given 52 | concurrency model. *) 53 | -------------------------------------------------------------------------------- /caqti/lib-platform-unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_platform_unix) 3 | (public_name caqti.platform.unix) 4 | (libraries caqti caqti.platform unix)) 5 | -------------------------------------------------------------------------------- /caqti/lib-platform-unix/system_sig.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2022--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module type S = sig 19 | type 'a fiber 20 | type stdenv 21 | 22 | module Unix : sig 23 | type file_descr 24 | val wrap_fd : (file_descr -> 'a fiber) -> Unix.file_descr -> 'a fiber 25 | val poll : 26 | stdenv: stdenv -> 27 | ?read: bool -> ?write: bool -> ?timeout: float -> 28 | file_descr -> (bool * bool * bool) fiber 29 | end 30 | 31 | module Preemptive : sig 32 | val detach : ('a -> 'b) -> 'a -> 'b fiber 33 | val run_in_main : (unit -> 'a fiber) -> 'a 34 | end 35 | 36 | end 37 | -------------------------------------------------------------------------------- /caqti/lib-platform/connection_utils.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2019--2020 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Internal connection-related utilities. *) 19 | 20 | module Make_helpers : functor (Sys : System_sig.S) -> sig 21 | open Sys 22 | 23 | val assert_single_use : 24 | what: string -> bool ref -> (unit -> 'a Fiber.t) -> 'a Fiber.t 25 | end 26 | 27 | module Make_convenience : 28 | functor (Sys : System_sig.S) -> 29 | functor (_ : Caqti_connection_sig.Base 30 | with type 'a fiber := 'a Sys.Fiber.t 31 | and type ('a, 'err) stream := ('a, 'err) Sys.Stream.t) -> 32 | Caqti_connection_sig.Convenience with type 'a fiber := 'a Sys.Fiber.t 33 | 34 | module Make_populate : 35 | functor (Sys : System_sig.S) -> 36 | functor (_ : Caqti_connection_sig.Base 37 | with type 'a fiber := 'a Sys.Fiber.t 38 | and type ('a, 'err) stream := ('a, 'err) Sys.Stream.t) -> 39 | Caqti_connection_sig.Populate 40 | with type 'a fiber := 'a Sys.Fiber.t 41 | and type ('a, 'err) stream := ('a, 'err) Sys.Stream.t 42 | -------------------------------------------------------------------------------- /caqti/lib-platform/connector.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Connection functor and backend registration. *) 19 | 20 | val define_loader : (string -> (unit, string) result) -> unit 21 | (** Defines the function used to dynamically load driver libraries. This is 22 | normally called during initialization by the [caqti-dynload] library, if 23 | linked into the application. *) 24 | 25 | val load_library : string -> (unit, string) result 26 | 27 | module Make : 28 | functor (System : System_sig.S) -> 29 | functor (Pool : Pool.S 30 | with type 'a fiber := 'a System.Fiber.t 31 | and type switch := System.Switch.t 32 | and type stdenv := System.stdenv) -> 33 | functor (Loader : Driver_loader.S 34 | with type 'a fiber := 'a System.Fiber.t 35 | and type switch := System.Switch.t 36 | and type stdenv := System.stdenv 37 | and type ('a, 'e) stream := ('a, 'e) System.Stream.t) -> 38 | Caqti_connect_sig.S 39 | with type 'a fiber := 'a System.Fiber.t 40 | and type ('a, 'e) stream := ('a, 'e) System.Stream.t 41 | and type ('a, 'e) pool := ('a, 'e) Pool.t 42 | and type 'a with_switch := sw: System.Switch.t -> 'a 43 | and type 'a with_stdenv := stdenv: System.stdenv -> 'a 44 | and type connection := (module Loader.CONNECTION) 45 | (** Constructs the main module used to connect to a database for the given 46 | concurrency model. *) 47 | -------------------------------------------------------------------------------- /caqti/lib-platform/conv.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2019--2022 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Printf 19 | 20 | let datetuple_of_iso8601 s = 21 | if String.length s = 10 && s.[4] = '-' && s.[7] = '-' then 22 | try 23 | (int_of_string (String.sub s 0 4), 24 | int_of_string (String.sub s 5 2), 25 | int_of_string (String.sub s 8 2)) 26 | with Failure _ -> 27 | failwith "Caqti_platform.datetuple_of_iso8601" 28 | else 29 | failwith "Caqti_platform.datetuple_of_iso8601" 30 | 31 | let iso8601_of_datetuple (y, m, d) = 32 | sprintf "%04d-%02d-%02d" y m d 33 | 34 | let string_of_rfc3339_error ~input err = 35 | let buf = Buffer.create 64 in 36 | let ppf = Format.formatter_of_buffer buf in 37 | Ptime.pp_rfc3339_error ppf err; 38 | Format.fprintf ppf " in value %S." input; 39 | Format.pp_print_flush ppf (); 40 | Buffer.contents buf 41 | 42 | let ptime_of_rfc3339_utc s = 43 | let n = String.length s in 44 | let s' = 45 | if n < 13 then s else 46 | if s.[n - 1] = 'Z' then s else 47 | if s.[n - 3] = '+' || s.[n - 3] = '-' then s ^ ":00" else 48 | if s.[n - 6] = '+' || s.[n - 6] = '-' then s else 49 | s ^ "Z" 50 | in 51 | (match Ptime.of_rfc3339 s' with 52 | | Ok (t, _, _) -> Ok t 53 | | Error (`RFC3339 (_, err)) -> 54 | Error (string_of_rfc3339_error ~input:s' err)) 55 | 56 | let pdate_of_iso8601 s = 57 | (match Ptime.of_date (datetuple_of_iso8601 s) with 58 | | exception Failure _ -> 59 | Error (sprintf "Cannot parse date %S." s) 60 | | None -> 61 | Error (sprintf "Date %s is out of range." s) 62 | | Some pdate -> Ok pdate) 63 | 64 | let iso8601_of_pdate x = iso8601_of_datetuple (Ptime.to_date x) 65 | -------------------------------------------------------------------------------- /caqti/lib-platform/conv.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2019--2022 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Miscellaneous conversions. *) 19 | 20 | val datetuple_of_iso8601 : string -> int * int * int 21 | val iso8601_of_datetuple : int * int * int -> string 22 | 23 | val ptime_of_rfc3339_utc : string -> (Ptime.t, string) result 24 | 25 | val pdate_of_iso8601 : string -> (Ptime.t, string) result 26 | val iso8601_of_pdate : Ptime.t -> string 27 | -------------------------------------------------------------------------------- /caqti/lib-platform/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_platform) 3 | (public_name caqti.platform) 4 | (flags (:standard -alert -caqti_unstable)) 5 | (libraries caqti domain-name ipaddr lru lwt-dllist mtime.clock.os)) 6 | -------------------------------------------------------------------------------- /caqti/lib-platform/heap.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2014--2016 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module type S = sig 19 | type elt 20 | type t 21 | 22 | val empty : t 23 | val is_empty : t -> bool 24 | val card : t -> int 25 | val push : elt -> t -> t 26 | val merge : t -> t -> t 27 | val pop_e : t -> elt * t 28 | end 29 | 30 | module Make (Elt : Set.OrderedType) = struct 31 | 32 | type elt = Elt.t 33 | type t = O | Y of int * elt * t * t 34 | 35 | let empty = O 36 | 37 | let is_empty h = h = O 38 | 39 | let card = function 40 | | O -> 0 41 | | Y (n, _, _, _) -> n 42 | 43 | let rec push e' = function 44 | | O -> Y (1, e', O, O) 45 | | Y (n, e, hL, hR) -> 46 | let e_min, e_max = if Elt.compare e' e < 0 then e', e else e, e' in 47 | if card hL < card hR then Y (n + 1, e_min, push e_max hL, hR) 48 | else Y (n + 1, e_min, hL, push e_max hR) 49 | 50 | let rec merge hL hR = 51 | match hL, hR with 52 | | O, h | h, O -> h 53 | | Y (nL, eL, hA, hB), Y (nR, eR, hC, hD) -> 54 | if Elt.compare eL eR < 0 then Y (nL + nR, eL, merge hA hB, hR) 55 | else Y (nL + nR, eR, hL, merge hC hD) 56 | 57 | let pop_e = function 58 | | O -> invalid_arg "Caqti_heap.pop_e: Empty heap." 59 | | Y (_, e, hL, hR) -> e, merge hL hR 60 | 61 | end 62 | -------------------------------------------------------------------------------- /caqti/lib-platform/heap.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2014--2018 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Internal min-heap implementation. 19 | 20 | This is a simple min-heap implementation deemed sufficient for the {!Pool} 21 | module. There are algorithms better suited for larger heaps. *) 22 | 23 | module type S = sig 24 | type t 25 | type elt 26 | 27 | val empty : t 28 | val is_empty : t -> bool 29 | val card : t -> int 30 | val push : elt -> t -> t 31 | val merge : t -> t -> t 32 | val pop_e : t -> elt * t 33 | end 34 | 35 | module Make (Elt : Set.OrderedType) : S with type elt = Elt.t 36 | -------------------------------------------------------------------------------- /caqti/lib-platform/list_ext.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2019--2022 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | let rec fold f = function 19 | | [] -> Fun.id 20 | | x :: xs -> fun acc -> acc |> f x |> fold f xs 21 | 22 | let iteri_r f xs = 23 | let rec loop i = function 24 | | [] -> Ok () 25 | | x :: xs -> 26 | (match f i x with Ok () -> loop (i + 1) xs | Error _ as r -> r) 27 | in 28 | loop 0 xs 29 | -------------------------------------------------------------------------------- /caqti/lib-platform/list_ext.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2019--2022 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Additions to the {!List} module. *) 19 | 20 | val fold : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b 21 | val iteri_r : (int -> 'a -> (unit, 'e) result) -> 'a list -> (unit, 'e) result 22 | -------------------------------------------------------------------------------- /caqti/lib-platform/logging.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2019--2021 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | let default_log_src = Logs.Src.create "caqti" 19 | 20 | let request_log_src = Logs.Src.create "caqti.request" 21 | -------------------------------------------------------------------------------- /caqti/lib-platform/logging.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2019--2021 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Internals related to logging. *) 19 | 20 | val default_log_src : Logs.Src.t 21 | val request_log_src : Logs.Src.t 22 | -------------------------------------------------------------------------------- /caqti/lib-platform/stream.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2018--2019 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** A stream with monadic concurrency and error handling. *) 19 | 20 | module type FIBER = sig 21 | type +'a t 22 | 23 | module Infix : sig 24 | val (>>=) : 'a t -> ('a -> 'b t) -> 'b t 25 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 26 | end 27 | 28 | val return : 'a -> 'a t 29 | end 30 | 31 | module Make (Fiber : FIBER) : 32 | Caqti_stream_sig.S with type 'a fiber := 'a Fiber.t 33 | (** Constructs a stream for the provided concurrency monad. *) 34 | -------------------------------------------------------------------------------- /caqti/lib-platform/switch.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module type FIBER = sig 19 | type 'a t 20 | 21 | val return : 'a -> 'a t 22 | module Infix : sig 23 | val (>>=) : 'a t -> ('a -> 'b t) -> 'b t 24 | end 25 | val finally : (unit -> 'a t) -> (unit -> unit t) -> 'a t 26 | end 27 | 28 | module type S = Caqti_switch_sig.S 29 | 30 | module Make (Fiber : FIBER) : S with type 'a fiber := 'a Fiber.t 31 | -------------------------------------------------------------------------------- /caqti/lib-platform/system_utils.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Monad_syntax (Monad : System_sig.FIBER) = struct 19 | open Monad.Infix 20 | 21 | let ( let* ) = (>>=) 22 | let ( let+ ) = (>|=) 23 | 24 | let ( >>=? ) m f = 25 | m >>= function Ok x -> f x | Error _ as r -> Monad.return r 26 | let ( >|=? ) m f = 27 | m >|= function Ok x -> Ok (f x) | Error _ as r -> r 28 | 29 | let ( let*? ) = ( >>=? ) 30 | let ( let+? ) = ( >|=? ) 31 | end 32 | -------------------------------------------------------------------------------- /caqti/lib-platform/system_utils.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Monad_syntax (Monad : System_sig.FIBER) : sig 19 | open Monad 20 | 21 | val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t 22 | 23 | val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t 24 | 25 | val ( >>=? ) : 26 | ('a, 'e) result t -> ('a -> ('b, 'e) result t) -> ('b, 'e) result t 27 | 28 | val ( >|=? ) : 29 | ('a, 'e) result t -> ('a -> 'b) -> ('b, 'e) result t 30 | 31 | val ( let*? ) : 32 | ('a, 'e) result t -> ('a -> ('b, 'e) result t) -> ('b, 'e) result t 33 | 34 | val ( let+? ) : 35 | ('a, 'e) result t -> ('a -> 'b) -> ('b, 'e) result t 36 | end 37 | -------------------------------------------------------------------------------- /caqti/lib-plugin/caqti_plugin.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Log = (val Logs.src_log (Logs.Src.create "caqti.plugin")) 19 | 20 | let () = 21 | let load pkg = 22 | let pkg = String.map (function '.' -> '-' | c -> c) pkg in 23 | let plugins = Sites.Plugins.Plugins.list () in 24 | Log.debug (fun p -> p "Available plugins: %s" (String.concat ", " plugins)); 25 | if List.mem pkg plugins then 26 | begin 27 | Sites.Plugins.Plugins.load pkg; 28 | Ok () 29 | end 30 | else 31 | Error ("Package " ^ pkg ^ " is not avaliable.") 32 | in 33 | Caqti_platform.Connector.define_loader load 34 | -------------------------------------------------------------------------------- /caqti/lib-plugin/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_plugin) 3 | (public_name caqti.plugin) 4 | (library_flags (:standard -linkall)) 5 | (libraries caqti.platform dune-site dune-site.plugins)) 6 | 7 | (generate_sites_module 8 | (module sites) 9 | (plugins (caqti plugins))) 10 | -------------------------------------------------------------------------------- /caqti/lib-template/dialect.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | type t = .. 19 | 20 | type t += 21 | | Pgsql of { 22 | server_version: Version.t; 23 | client_library: [`postgresql | `pgx]; 24 | } 25 | | Mysql of {server_version: Version.t} 26 | | Sqlite of {server_version: Version.t} 27 | | Unknown of {purpose: [`Dummy | `Printing]} 28 | 29 | let create_pgsql ~server_version ~client_library () = 30 | Pgsql {server_version; client_library} 31 | let create_mysql ~server_version () = Mysql {server_version} 32 | let create_sqlite ~server_version () = Sqlite {server_version} 33 | let create_unknown ~purpose () = Unknown {purpose} 34 | -------------------------------------------------------------------------------- /caqti/lib-template/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti_template) 3 | (public_name caqti.template) 4 | (libraries angstrom bigstringaf logs ptime uri)) 5 | 6 | (mdx 7 | (package caqti) 8 | (preludes mdx.prelude) 9 | (files :standard *.mli) 10 | (libraries caqti.template uri)) 11 | -------------------------------------------------------------------------------- /caqti/lib-template/field_type.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Database field types. *) 19 | 20 | open Shims 21 | 22 | type 'a t = 23 | | Bool : bool t 24 | | Int : int t 25 | | Int16 : int t 26 | | Int32 : int32 t 27 | | Int64 : int64 t 28 | | Float : float t 29 | | String : string t 30 | | Octets : string t 31 | | Pdate : Ptime.t t 32 | | Ptime : Ptime.t t 33 | | Ptime_span : Ptime.span t 34 | | Enum : string -> string t 35 | 36 | val unify : 'a t -> 'b t -> ('a, 'b) Type.eq option 37 | 38 | val equal_value : 'a t -> 'a -> 'a -> bool 39 | 40 | val to_string : 'a t -> string 41 | 42 | val pp : Format.formatter -> 'a t -> unit 43 | 44 | val pp_value : Format.formatter -> 'a t * 'a -> unit 45 | -------------------------------------------------------------------------------- /caqti/lib-template/mdx.prelude: -------------------------------------------------------------------------------- 1 | [@@@alert "-caqti_unstable"] 2 | -------------------------------------------------------------------------------- /caqti/lib-template/request_type.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | type ('a, 'b, 'm) t = 'a Row_type.t * 'b Row_type.t * 'm Row_mult.t 19 | 20 | module Infix = struct 21 | let ( -->. ) t u = (t, u, Row_mult.zero) 22 | let ( -->! ) t u = (t, u, Row_mult.one) 23 | let ( -->? ) t u = (t, u, Row_mult.zero_or_one) 24 | let ( -->* ) t u = (t, u, Row_mult.zero_or_more) 25 | end 26 | 27 | let param_type (t, _, _) = t 28 | let row_type (_, u, _) = u 29 | let row_mult (_, _, m) = m 30 | -------------------------------------------------------------------------------- /caqti/lib-template/request_type.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Type descriptors for requests. *) 19 | 20 | type ('a, 'b, +'m) t = 'a Row_type.t * 'b Row_type.t * 'm Row_mult.t 21 | 22 | module Infix : sig 23 | 24 | val ( -->. ) : 25 | 'a Row_type.t -> unit Row_type.t -> ('a, unit, Row_mult.zero) t 26 | 27 | val ( -->! ) : 28 | 'a Row_type.t -> 'b Row_type.t -> ('a, 'b, Row_mult.one) t 29 | 30 | val ( -->? ) : 31 | 'a Row_type.t -> 'b Row_type.t -> ('a, 'b, Row_mult.zero_or_one) t 32 | 33 | val ( -->* ) : 34 | 'a Row_type.t -> 'b Row_type.t -> ('a, 'b, Row_mult.zero_or_more) t 35 | 36 | end 37 | 38 | val param_type : ('a, _, _) t -> 'a Row_type.t 39 | val row_type : (_, 'b, _) t -> 'b Row_type.t 40 | val row_mult : (_, _, 'm) t -> 'm Row_mult.t 41 | -------------------------------------------------------------------------------- /caqti/lib-template/row_mult.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Multiplicities of zero, one, and many. *) 19 | 20 | type +'m t = (* not GADT due to variance *) 21 | | Zero 22 | | One 23 | | Zero_or_one 24 | | Zero_or_more 25 | constraint 'm = [< `Zero | `One | `Many] 26 | 27 | type zero = [`Zero] 28 | type one = [`One] 29 | type zero_or_one = [`Zero | `One] 30 | type zero_or_more = [`Zero | `One | `Many] 31 | 32 | let zero : [> `Zero] t = Zero 33 | let one : [> `One] t = One 34 | let zero_or_one : [> `Zero | `One] t = Zero_or_one 35 | let zero_or_more : ([> `Zero | `One | `Many] as 'a) t = Zero_or_more 36 | 37 | let only_zero : [< `Zero] t -> unit = 38 | function Zero -> () | _ -> assert false 39 | let only_one : [< `One] t -> unit = 40 | function One -> () | _ -> assert false 41 | let only_zero_or_one : [< `Zero | `One] t -> unit = 42 | function Zero | One -> () | _ -> assert false 43 | 44 | let expose = function 45 | | Zero -> `Zero 46 | | One -> `One 47 | | Zero_or_one -> `Zero_or_one 48 | | Zero_or_more -> `Zero_or_more 49 | 50 | let can_be_zero = function 51 | | One -> false 52 | | Zero | Zero_or_one | Zero_or_more -> true 53 | 54 | let can_be_many = function 55 | | Zero | One | Zero_or_one -> false 56 | | Zero_or_more -> true 57 | -------------------------------------------------------------------------------- /caqti/lib-template/row_mult.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Row multiplicity. *) 19 | 20 | type +'m t constraint 'm = [< `Zero | `One | `Many] 21 | 22 | type zero = [`Zero] 23 | type one = [`One] 24 | type zero_or_one = [`Zero | `One] 25 | type zero_or_more = [`Zero | `One | `Many] 26 | 27 | val zero : [> `Zero] t 28 | val one : [> `One] t 29 | val zero_or_one : [> `Zero | `One] t 30 | val zero_or_more : [> `Zero | `One | `Many] t 31 | 32 | val only_zero : [< `Zero] t -> unit 33 | val only_one : [< `One] t -> unit 34 | val only_zero_or_one : [< `Zero | `One] t -> unit 35 | 36 | val expose : 'm t -> [`Zero | `One | `Zero_or_one | `Zero_or_more] 37 | 38 | val can_be_zero : 'm t -> bool 39 | val can_be_many : 'm t -> bool 40 | -------------------------------------------------------------------------------- /caqti/lib-template/shims.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Type = struct 19 | type (_, _) eq = Equal : ('a, 'a) eq (* OCaml 5.1 *) 20 | end 21 | -------------------------------------------------------------------------------- /caqti/lib-template/shims.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Compatibility shims. *) 19 | 20 | module Type : sig 21 | type (_, _) eq = Equal : ('a, 'a) eq 22 | (** Type equality witness. This will eventually be replaced by the equavalent 23 | definition available in [Stdlib.Type] since OCaml 5.1, but for now, we 24 | must keep backwards compatibility with older compilers. *) 25 | end 26 | -------------------------------------------------------------------------------- /caqti/lib/caqti_connect_config.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (* Map Implementation *) 19 | 20 | type 'a tag = .. 21 | 22 | module type KEY = sig 23 | type value 24 | type 'a tag += Tag : value tag 25 | val name : string [@@warning "-32"] 26 | val default : value 27 | end 28 | 29 | type 'a key = (module KEY with type value = 'a) 30 | 31 | let create_key (type a) name (default : a) : a key = 32 | let module Key = struct 33 | type value = a 34 | type _ tag += Tag : value tag 35 | let name = name 36 | let default = default 37 | end in 38 | (module Key : KEY with type value = a) 39 | 40 | module String_map = Map.Make (String) 41 | 42 | type binding = Binding : 'a tag * 'a -> binding 43 | 44 | type t = binding String_map.t 45 | 46 | let default = String_map.empty 47 | 48 | let mem_name key_name = String_map.mem key_name 49 | 50 | let get : type a. a key -> t -> a = fun (module Key) m -> 51 | (match String_map.find_opt Key.name m with 52 | | Some (Binding (Key.Tag, v)) -> v 53 | | _ -> Key.default) 54 | 55 | let set : type a. a key -> a -> t -> t = fun (module Key) v m -> 56 | String_map.add Key.name (Binding (Key.Tag, v)) m 57 | 58 | let reset : type a. a key -> t -> t = fun (module Key) m -> 59 | String_map.remove Key.name m 60 | 61 | (* Configuration Keys *) 62 | 63 | let tweaks_version : (int * int) key = create_key "tweaks_version" (1, 7) 64 | 65 | let dynamic_prepare_capacity = create_key "dynamic_prepare_capacity" 32 66 | -------------------------------------------------------------------------------- /caqti/lib/caqti_connect_config.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Configuration passed to connect functions. *) 19 | 20 | type _ key 21 | 22 | type t 23 | 24 | (** {2 Construction and Lookup} *) 25 | 26 | val default : t 27 | (** The configuration with all keys set to their default values. *) 28 | 29 | val get : 'a key -> t -> 'a 30 | (** [get key cfg] is the value associated with [key] in [cfg], which may be a 31 | default value if the key has not been explicitly {!set} or if it has been 32 | {!reset}. *) 33 | 34 | val set : 'a key -> 'a -> t -> t 35 | (** [set key value cfg] associates [key] with [value] in [cfg]. *) 36 | 37 | val reset : 'a key -> t -> t 38 | (** [reset key cfg] associates [key] with its default value in [cfg]. *) 39 | 40 | (** {2 Configuration Keys} *) 41 | 42 | val tweaks_version : (int * int) key 43 | (** Declares compatibility with {{!tweaks} database tweaks} introduced up to the 44 | given version of Caqti. Defaults to a conservative value. *) 45 | 46 | val dynamic_prepare_capacity : int key 47 | (** The maximum number of dynamic queries to keep in the prepare-cache. *) 48 | 49 | (**/**) (* for internal use *) 50 | val create_key : string -> 'a -> 'a key 51 | val mem_name : string -> t -> bool 52 | -------------------------------------------------------------------------------- /caqti/lib/caqti_mult.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Row multiplicity. *) 19 | 20 | include Caqti_template.Row_mult 21 | -------------------------------------------------------------------------------- /caqti/lib/caqti_pool_sig.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Resource pool signature. *) 19 | 20 | module type S = sig 21 | 22 | type +'a fiber 23 | 24 | type ('a, +'e) t 25 | 26 | val size : ('a, 'e) t -> int 27 | (** [size pool] is the current number of open resources in [pool]. *) 28 | 29 | val use : 30 | ?priority: float -> 31 | ('a -> ('b, 'e) result fiber) -> ('a, 'e) t -> ('b, 'e) result fiber 32 | (** [use f pool] calls [f] on a resource drawn from [pool], handing back the 33 | resource to the pool when [f] exits. 34 | 35 | @param priority 36 | Requests for the resource are handled in decreasing order of priority. 37 | The default priority is [0.0]. *) 38 | 39 | val drain : ('a, 'e) t -> unit fiber 40 | (** [drain pool] closes all resources in [pool]. The pool is still usable, as 41 | new resources will be created on demand. *) 42 | 43 | end 44 | -------------------------------------------------------------------------------- /caqti/lib/caqti_query.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Caqti_template 19 | 20 | include Caqti_template.Query 21 | include Caqti_template.Query.Private [@@alert "-caqti_private"] 22 | 23 | type expand_error = Query.Expand_error.t 24 | let pp_expand_error = Query.Expand_error.pp 25 | 26 | let of_string repr = 27 | let conv err = `Invalid Query.Parse_error.(position err, message err) in 28 | Query.parse_result repr |> Result.map_error conv 29 | 30 | let of_string_exn repr = 31 | (try Query.parse repr with 32 | | Query.Parse_error err -> Format.kasprintf failwith "%a" Parse_error.pp err) 33 | 34 | let concat sep = concat ~sep 35 | let qprintf = Query_fmt.qprintf 36 | let kqprintf = Query_fmt.kqprintf 37 | let param = Query_fmt.param 38 | let env = Query_fmt.env 39 | let quote = Query_fmt.quote 40 | let query = Query_fmt.query 41 | -------------------------------------------------------------------------------- /caqti/lib/caqti_query_fmt.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Caqti_template.Query_fmt 19 | -------------------------------------------------------------------------------- /caqti/lib/caqti_query_fmt.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | (** Format-based query construction. *) 19 | 20 | include module type of (struct include Caqti_template.Query_fmt end) 21 | -------------------------------------------------------------------------------- /caqti/lib/caqti_request.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | [@@@alert "-caqti_private"] 19 | 20 | open Caqti_template 21 | 22 | include Request 23 | 24 | let create ?(oneshot = false) pt rt rm make_query = 25 | create (if oneshot then Direct else Static) (pt, rt, rm) 26 | (fun dialect -> make_query (Caqti_driver_info.of_dialect dialect)) 27 | 28 | let query req driver_info = 29 | query req (Caqti_driver_info.dummy_dialect driver_info) 30 | 31 | let query_id = query_id 32 | 33 | module Infix = struct 34 | let (-->.) t u ?oneshot f = create ?oneshot t u Row_mult.zero f 35 | let (-->!) t u ?oneshot f = create ?oneshot t u Row_mult.one f 36 | let (-->?) t u ?oneshot f = create ?oneshot t u Row_mult.zero_or_one f 37 | let (-->*) t u ?oneshot f = create ?oneshot t u Row_mult.zero_or_more f 38 | 39 | let (@:-) f s = 40 | let q = Caqti_query.of_string_exn s in 41 | f (fun _ -> q) 42 | 43 | let (@@:-) f g = 44 | f (fun d -> Caqti_query.of_string_exn (g (Caqti_driver_info.dialect_tag d))) 45 | 46 | let (->.) t u ?oneshot s = create ?oneshot t u Row_mult.zero @:- s 47 | let (->!) t u ?oneshot s = create ?oneshot t u Row_mult.one @:- s 48 | let (->?) t u ?oneshot s = create ?oneshot t u Row_mult.zero_or_one @:- s 49 | let (->*) t u ?oneshot s = create ?oneshot t u Row_mult.zero_or_more @:- s 50 | end 51 | 52 | let no_env _ _ = raise Not_found 53 | 54 | let make_pp ?(env = no_env) ?(driver_info = Caqti_driver_info.dummy) () = 55 | let dialect = Caqti_driver_info.dummy_dialect driver_info in 56 | make_pp ~subst:(env driver_info) ~dialect () 57 | 58 | let make_pp_with_param 59 | ?(env = no_env) ?(driver_info = Caqti_driver_info.dummy) () = 60 | let dialect = Caqti_driver_info.dummy_dialect driver_info in 61 | make_pp_with_param ~subst:(env driver_info) ~dialect () 62 | -------------------------------------------------------------------------------- /caqti/lib/caqti_type.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | [@@@alert "-caqti_private"] 19 | 20 | type ('a, 'b) eq = ('a, 'b) Caqti_template.Shims.Type.eq = Equal : ('a, 'a) eq 21 | module Field = Caqti_template.Field_type 22 | include Caqti_template.Row_type 23 | include Caqti_template.Row_type.Private 24 | module Std = struct 25 | include (Caqti_template.Row_type : Caqti_template.Row_type.STD) 26 | 27 | (* moved away from STD signature *) 28 | let enum = enum 29 | let product = product 30 | let proj = proj 31 | let proj_end = proj_end 32 | let custom = custom 33 | 34 | (* deprecated *) 35 | let tup2 = t2 36 | let tup3 = t3 37 | let tup4 = t4 38 | end 39 | include Std 40 | -------------------------------------------------------------------------------- /caqti/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name caqti) 3 | (public_name caqti) 4 | (wrapped false) 5 | (flags (:standard -alert -caqti_unstable)) 6 | (library_flags (:standard -linkall)) 7 | (libraries angstrom bigstringaf caqti.template logs mtime ptime uri)) 8 | -------------------------------------------------------------------------------- /caqti/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name main) 3 | (package caqti) 4 | (flags (:standard -alert -caqti_unstable)) 5 | (libraries alcotest caqti caqti.platform re.pcre)) 6 | -------------------------------------------------------------------------------- /caqti/test/main.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | let tests = [ 19 | "heap", Test_heap.test_cases; 20 | "query", Test_query.test_cases; 21 | "request", Test_request.test_cases; 22 | "request_cache", Test_request_cache.test_cases; 23 | "switch", Test_switch.test_cases; 24 | "version", Test_version.test_cases; 25 | ] 26 | 27 | let () = Alcotest.V1.run "caqti" tests 28 | -------------------------------------------------------------------------------- /caqti/test/test_heap.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2014--2022 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module H = 19 | Caqti_platform.Heap.Make (struct type t = int let compare = compare end) 20 | 21 | let test_push_pop_n n = 22 | let a = Array.init n (fun _ -> Random.int n) in 23 | let h = Array.fold_right H.push a H.empty in 24 | Array.sort (fun i j -> compare j i) a; 25 | let check_pop x h = 26 | let x', h' = H.pop_e h in 27 | assert (x = x'); h' in 28 | let h' = Array.fold_right check_pop a h in 29 | assert (H.is_empty h') 30 | 31 | let test_push_pop () = for i = 0 to 599 do test_push_pop_n i done 32 | 33 | let test_cases = [ 34 | "push, pop", `Quick, test_push_pop; 35 | ] 36 | -------------------------------------------------------------------------------- /caqti/test/test_request.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2020--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | open Printf 19 | 20 | module Q = Caqti_template.Query 21 | 22 | let expect_parse ~subst qs q' = 23 | let rq = 24 | let open Caqti_template.Create in 25 | let q = qs |> Q.parse |> Q.expand subst in 26 | static_gen T.(unit -->. unit) @@ fun _ -> q 27 | in 28 | let q = Caqti_query.normal (Caqti_request.query rq Caqti_driver_info.dummy) in 29 | if not (Q.equal q q') then begin 30 | eprintf "Parsed: %s\nExpected: %s\n" 31 | (Q.show q) (Q.show q'); 32 | assert false 33 | end 34 | 35 | let test_request_parse () = 36 | let subst = function 37 | | "alpha" -> Q.lit "α" 38 | | "beta" -> Q.lit "β" 39 | | "beta." -> Q.lit "β[dot]" 40 | | "gamma" -> Q.lit "γ" 41 | | "delta" -> Q.lit "δ" 42 | | _ -> raise Not_found 43 | in 44 | expect_parse ~subst "$(alpha) $$ $beta. $(gamma) $delta. $$ $Q$ $beta. $Q$" 45 | (Q.lit "α $$ β[dot] γ δ. $$ $Q$ $beta. $Q$") 46 | 47 | let test_cases = [ 48 | "parse", `Quick, test_request_parse; 49 | ] 50 | -------------------------------------------------------------------------------- /caqti/test/test_switch.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module A = Alcotest.V1 19 | 20 | module Switch = Caqti_platform.Switch.Make (struct 21 | type 'a t = 'a 22 | let return = Fun.id 23 | module Infix = struct 24 | let (>>=) m f = f m 25 | end 26 | let finally f h = try let y = f () in h (); y with exn -> h (); raise exn 27 | end) 28 | 29 | let test_switch sw = 30 | Switch.check sw; 31 | let state = ref 0 in 32 | let transit i j () = A.(check int) "transit" i !state; state := j in 33 | let _ = Switch.on_release_cancellable sw (transit 2 3) in 34 | let hook1 = Switch.on_release_cancellable sw (fun () -> A.fail "removed") in 35 | let _ = Switch.on_release_cancellable sw (transit 1 2) in 36 | let hook2 = Switch.on_release_cancellable sw (fun () -> A.fail "removed") in 37 | let _ = Switch.on_release_cancellable sw (transit 0 1) in 38 | Switch.remove_hook hook1; 39 | Switch.remove_hook hook2; 40 | Switch.check sw 41 | 42 | let test_eternal () = 43 | let sw = Switch.eternal in 44 | let _ = Switch.on_release_cancellable sw (fun () -> A.fail "on eternal") in 45 | let hook = Switch.on_release_cancellable sw (fun () -> A.fail "on eternal") in 46 | Switch.remove_hook hook 47 | 48 | let test_create () = 49 | let sw = Switch.create () in 50 | test_switch sw; 51 | Switch.release sw; 52 | A.check_raises "released switch" Switch.Off (fun () -> Switch.check sw) 53 | 54 | let test_run () = 55 | let sw' = ref None in 56 | Switch.run begin fun sw -> 57 | sw' := Some sw; 58 | test_switch sw 59 | end; 60 | A.check_raises "outside run" 61 | Switch.Off (fun () -> Option.iter Switch.check !sw') 62 | 63 | let test_cases = [ 64 | A.test_case "eternal" `Quick test_eternal; 65 | A.test_case "create" `Quick test_create; 66 | A.test_case "run" `Quick test_run; 67 | ] 68 | -------------------------------------------------------------------------------- /caqti/test/test_version.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | [@@@alert "-caqti_private"] 19 | 20 | open Caqti_template 21 | 22 | module A = struct 23 | include Alcotest.V1 24 | 25 | let version = testable Version.pp Version.equal 26 | end 27 | 28 | let versions = List.map (List.map Version.of_string_unsafe) [ 29 | ["~beta"]; 30 | ["0~beta"; "00~beta"]; 31 | [""; "0"; "0.0"; "0.0.0"; "0.000.0"; "000.00.0"]; 32 | ["0.1~"]; 33 | ["0.1.0~"]; 34 | ["0.1"; "0.1.0"; "000.1.000"]; 35 | ["0.1.0r1"; "00.001.0r1"; "000.1.000r1"]; 36 | ["0.1r1"]; 37 | ["0.2~"]; 38 | ["0.2.0.000"]; 39 | ["0.2-2"]; 40 | ["0.2.1"]; 41 | ["25.100"; "025.0100"]; 42 | ] 43 | 44 | let test_equal () = 45 | let equal_to v0 v = A.(check version) "same version" v0 v in 46 | let all_equal = function 47 | | [] -> assert false 48 | | v0 :: vs -> List.iter (equal_to v0) vs 49 | in 50 | List.iter all_equal versions 51 | 52 | let test_compare () = 53 | let versions = List.map List.hd versions in 54 | A.(check (list version)) "order" versions (List.sort Version.compare versions) 55 | 56 | let test_cases = [ 57 | A.test_case "equal" `Quick test_equal; 58 | A.test_case "compare" `Quick test_compare; 59 | ] 60 | -------------------------------------------------------------------------------- /caqti/testlib-blocking/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name testlib_blocking) 3 | (libraries 4 | alcotest 5 | caqti 6 | caqti_blocking 7 | testlib)) 8 | -------------------------------------------------------------------------------- /caqti/testlib-blocking/testlib_blocking.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Fiber = struct 19 | type 'a t = 'a 20 | let return x = x 21 | let catch f g = try f () with exn -> g exn 22 | let fail = raise 23 | module Infix = struct 24 | let (>>=) x f = f x 25 | let (>|=) x f = f x 26 | let (>>=?) x f = match x with Ok x -> f x | Error _ as r -> r 27 | let (>|=?) x f = match x with Ok x -> Ok (f x) | Error _ as r -> r 28 | end 29 | end 30 | 31 | include Caqti_blocking 32 | 33 | module Alcotest_cli = 34 | Testlib.Make_alcotest_cli 35 | (Alcotest.Unix_platform) 36 | (Alcotest_engine.Monad.Identity) 37 | 38 | module List_result_fiber = struct 39 | open Fiber.Infix 40 | 41 | let rec iter_s f = function 42 | | [] -> Fiber.return (Ok ()) 43 | | x :: xs -> f x >>=? fun () -> iter_s f xs 44 | end 45 | -------------------------------------------------------------------------------- /caqti/testlib-blocking/testlib_blocking.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | include Testlib.Sig.Ground 19 | with type 'a Fiber.t = 'a 20 | and module Stream = Caqti_blocking.Stream 21 | and module Pool = Caqti_blocking.Pool 22 | -------------------------------------------------------------------------------- /caqti/testlib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name testlib) 3 | (libraries 4 | alcotest 5 | caqti 6 | dynlink 7 | logs 8 | uri)) 9 | -------------------------------------------------------------------------------- /caqti/testlib/sig.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2023 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module type Alcotest_cli = sig 19 | include Alcotest_engine.V1.Cli.S 20 | 21 | val test_case : 22 | string -> Alcotest.speed_level -> ('a -> return) -> 'a test_case 23 | 24 | val test_case_sync : 25 | string -> Alcotest.speed_level -> ('a -> unit) -> 'a test_case 26 | 27 | val run_with_args_dependency : 28 | ?argv: string array -> string -> 29 | 'a Cmdliner.Term.t -> ('a -> unit test list) -> return 30 | end 31 | 32 | module type Ground = sig 33 | module Fiber : sig 34 | type +'a t 35 | 36 | module Infix : sig 37 | val (>>=) : 'a t -> ('a -> 'b t) -> 'b t 38 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 39 | 40 | val (>>=?) : 41 | ('a, 'e) result t -> ('a -> ('b, 'e) result t) -> ('b, 'e) result t 42 | 43 | val (>|=?) : 44 | ('a, 'e) result t -> ('a -> 'b) -> ('b, 'e) result t 45 | end 46 | 47 | val return : 'a -> 'a t 48 | 49 | val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t 50 | 51 | val fail : exn -> 'a t 52 | 53 | end 54 | 55 | val or_fail : ('a, [< Caqti_error.t]) result -> 'a Fiber.t 56 | 57 | module Stream : Caqti_stream_sig.S with type 'a fiber := 'a Fiber.t 58 | 59 | module Pool : Caqti_pool_sig.S with type 'a fiber := 'a Fiber.t 60 | 61 | module type CONNECTION = Caqti_connection_sig.S 62 | with type 'a fiber := 'a Fiber.t 63 | and type ('a, 'err) stream := ('a, 'err) Stream.t 64 | 65 | type connection = (module CONNECTION) 66 | 67 | module Alcotest_cli : Alcotest_cli with type return = unit Fiber.t 68 | 69 | module List_result_fiber : sig 70 | val iter_s : 71 | ('a -> (unit, 'e) result Fiber.t) -> 'a list -> (unit, 'e) result Fiber.t 72 | end 73 | 74 | end 75 | -------------------------------------------------------------------------------- /caqti/testlib/testlib.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2021--2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Sig = Sig 19 | 20 | type common_args = { 21 | uris: Uri.t list; 22 | connect_config: Caqti_connect_config.t; 23 | } 24 | 25 | val register_common_arg : (common_args -> common_args) Cmdliner.Term.t -> unit 26 | 27 | val common_args : unit -> common_args Cmdliner.Term.t 28 | 29 | val test_name_of_uri : Uri.t -> string 30 | 31 | val init_list : int -> (int -> 'a) -> 'a list 32 | 33 | module Make_alcotest_cli : 34 | functor (_ : Alcotest_engine.Platform.MAKER) -> 35 | functor (Monad : Alcotest_engine.Monad.S) -> 36 | Sig.Alcotest_cli with type return = unit Monad.t 37 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | ; Add CircleCI exclusion if build from a GitHub action 2 | (rule 3 | (alias doc) 4 | (enabled_if (<> %{env:GITHUB_ACTION=none} none)) 5 | (action 6 | (progn 7 | (run mkdir -p _doc/_html/.circleci) 8 | (run cp -f ../../.circleci/config.yml "_doc/_html/.circleci/config.yml")))) 9 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.9) 2 | (using dune_site 0.1) 3 | (using mdx 0.4) 4 | 5 | (name caqti) 6 | 7 | (package (name caqti) (sites (lib plugins))) 8 | (package (name caqti-async) (allow_empty)) 9 | (package (name caqti-driver-mariadb) (allow_empty)) 10 | (package (name caqti-driver-pgx) (allow_empty)) 11 | (package (name caqti-driver-postgresql) (allow_empty)) 12 | (package (name caqti-driver-sqlite3) (allow_empty)) 13 | (package (name caqti-dynload) (allow_empty)) 14 | (package (name caqti-eio) (allow_empty)) 15 | (package (name caqti-lwt) (allow_empty)) 16 | (package (name caqti-mirage) (allow_empty)) 17 | (package (name caqti-tls-async) (allow_empty)) 18 | (package (name caqti-tls-eio) (allow_empty)) 19 | (package (name caqti-tls-lwt) (allow_empty)) 20 | (package (name caqti-tls) (allow_empty)) 21 | (package (name caqti-type-calendar) (allow_empty)) 22 | (package (name caqti-miou) (allow_empty)) 23 | (package (name caqti-tls-miou) (allow_empty)) 24 | -------------------------------------------------------------------------------- /dune-workspace.dev: -------------------------------------------------------------------------------- 1 | (lang dune 1.2) 2 | 3 | (context (opam (switch 5.3.0-caqti))) 4 | (context (opam (switch 5.2.1-caqti))) 5 | (context (opam (switch 5.1.1-caqti))) 6 | (context (opam (switch 5.0.0-caqti))) 7 | (context (opam (switch 4.14.2-caqti))) 8 | (context (opam (switch 4.11.2-caqti))) 9 | (context (opam (switch 4.08.1-caqti))) 10 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | ## Example 2 | 3 | This directory contains an example which is also runs as part of the unit 4 | tests to make sure it is up to date. 5 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name bikereg) 3 | (modules bikereg) 4 | (flags (:standard -alert -caqti_unstable)) 5 | (libraries caqti caqti.plugin caqti-lwt caqti-lwt.unix testlib)) 6 | 7 | (rule 8 | (alias runtest) 9 | (package caqti-lwt) 10 | (deps 11 | (:test bikereg.exe) 12 | (:u %{env:CAQTI_TEST_URIS_FILE=../testsuite/uris.conf}) 13 | (include ../testsuite/dune.uri-deps-lwt) 14 | (env_var CAQTI_TEST_X509_AUTHENTICATOR)) 15 | (locks /db/bikereg) 16 | (action (run %{test} -U %{u}))) 17 | -------------------------------------------------------------------------------- /testsuite/README.md: -------------------------------------------------------------------------------- 1 | ## Main Testsuite 2 | 3 | This directory contains tests to be run across different concurrency engines 4 | and across different database drivers. Additional tests can be found in the 5 | `test` subdirectories of some per-package subdirectories. 6 | 7 | By default the tests are only run against sqlite3. To run it against other 8 | database systems, create a file `uris.conf` in the current directory 9 | containing a list of database URLs, one per line. This will cause each test 10 | executable to run a duplicate of the testsuite for each URL. 11 | -------------------------------------------------------------------------------- /testsuite/main_miou_unix.ml: -------------------------------------------------------------------------------- 1 | open Testlib 2 | open Testlib_miou_unix 3 | 4 | module Test_error_cause = Test_error_cause.Make (Testlib_miou_unix) 5 | module Test_parallel = Test_parallel.Make (Testlib_miou_unix) 6 | module Test_param = Test_param.Make (Testlib_miou_unix) 7 | module Test_sql = Test_sql.Make (Testlib_miou_unix) 8 | module Test_failure = Test_failure.Make (Testlib_miou_unix) 9 | module Test_connect = Test_connect.Make (Testlib_miou_unix) 10 | 11 | let mk_test (name, connect, pool) = 12 | let pass_connect (name, speed, f) = (name, speed, (fun () -> f connect)) in 13 | let pass_conn (name, speed, f) = 14 | let f' () = 15 | match Caqti_miou_unix.Pool.use (fun c -> Ok (f c)) pool with 16 | | Ok () -> () 17 | | Error err -> Alcotest.failf "%a" Caqti_error.pp err 18 | in 19 | (name, speed, f') 20 | in 21 | let pass_pool (name, speed, f) = (name, speed, (fun () -> f pool)) in 22 | let test_cases = 23 | List.map pass_conn Test_sql.connection_test_cases @ 24 | List.map pass_conn Test_error_cause.test_cases @ 25 | List.map pass_pool Test_parallel.test_cases @ 26 | List.map pass_conn Test_param.test_cases @ 27 | List.map pass_conn Test_failure.test_cases @ 28 | List.map pass_pool Test_sql.pool_test_cases @ 29 | List.map pass_connect Test_connect.test_cases 30 | in 31 | (name, test_cases) 32 | 33 | let post_connect conn = 34 | List_result_fiber.iter_s (fun f -> f conn) [ 35 | Test_sql.post_connect; 36 | ] 37 | 38 | let env = 39 | let (&) f g di var = try f di var with Not_found -> g di var in 40 | Test_sql.env & Test_error_cause.env 41 | 42 | let mk_tests sw {uris; connect_config} = 43 | let pool_config = Caqti_pool_config.create ~max_size:16 () in 44 | let create_target uri = 45 | let connect () = Caqti_miou_unix.connect ~sw ~config:connect_config ~env uri in 46 | (match Caqti_miou_unix.connect_pool ~sw uri 47 | ~pool_config ~post_connect ~config:connect_config ~env with 48 | | Ok pool -> (test_name_of_uri uri, connect, pool) 49 | | Error err -> raise (Caqti_error.Exn err)) 50 | in 51 | let targets = List.map create_target uris in 52 | List.map mk_test targets 53 | 54 | let () = Miou_unix.run @@ fun () -> 55 | let rng = Mirage_crypto_rng_miou_unix.(initialize (module Pfortuna)) in 56 | let finally () = Mirage_crypto_rng_miou_unix.kill rng in 57 | Fun.protect ~finally @@ fun () -> 58 | Caqti_miou.Switch.run @@ fun sw -> 59 | Alcotest_cli.run_with_args_dependency "test_sql_miou_unix" 60 | (Testlib.common_args ()) (mk_tests sw) 61 | -------------------------------------------------------------------------------- /testsuite/test_connect.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2024 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Make (Ground : Testlib.Sig.Ground) = struct 19 | open Ground 20 | open Ground.Fiber.Infix 21 | 22 | let test_connect connect = 23 | let rec loop n = 24 | if n = 0 then Fiber.return () else 25 | connect () >>= or_fail >>= fun (module C : CONNECTION) -> 26 | C.disconnect () >>= fun () -> 27 | loop (n - 1) 28 | in 29 | loop 2049 (* assumes ulimit -n 2048 or smaller *) 30 | 31 | let test_cases = [ 32 | "connect", `Slow, test_connect; 33 | ] 34 | end 35 | -------------------------------------------------------------------------------- /testsuite/test_param.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2017--2025 Petter A. Urkedal 2 | * 3 | * This library is free software; you can redistribute it and/or modify it 4 | * under the terms of the GNU Lesser General Public License as published by 5 | * the Free Software Foundation, either version 3 of the License, or (at your 6 | * option) any later version, with the LGPL-3.0 Linking Exception. 7 | * 8 | * This library is distributed in the hope that it will be useful, but WITHOUT 9 | * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 10 | * FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 11 | * License for more details. 12 | * 13 | * You should have received a copy of the GNU Lesser General Public License 14 | * and the LGPL-3.0 Linking Exception along with this library. If not, see 15 | * and , respectively. 16 | *) 17 | 18 | module Q = struct 19 | open Caqti_template.Create 20 | 21 | let nonlin1 = 22 | static_gen T.(t3 int int int -->! int) @@ fun _ -> 23 | Q.concat [ 24 | Q.lit "SELECT 2 * "; Q.param 2; Q.lit " + "; Q.param 2; 25 | Q.lit " - 3 * "; Q.param 0; Q.lit " + 5 * "; Q.param 1; 26 | ] 27 | 28 | let nonlin2 = 29 | static T.(t3 int int int -->! int) 30 | "SELECT 2 * $3 + $3 - 3 * $1 + 5 * $2" 31 | 32 | let env1 = 33 | let env = let open Caqti_template.Create in function 34 | | "." -> Q.lit "100" 35 | | "fourty" -> Q.lit "40" 36 | | _ -> raise Not_found 37 | in 38 | let q = "SELECT $. - $(fourty)" 39 | |> Caqti_template.Query.parse 40 | |> Caqti_template.Query.expand env 41 | in 42 | static_gen T.(Caqti_type.unit -->! Caqti_type.int) (fun _ -> q) 43 | end 44 | 45 | module Make (Ground : Testlib.Sig.Ground) = struct 46 | open Ground 47 | open Ground.Fiber.Infix 48 | 49 | let nonlin (p0, p1, p2) = 2 * p2 + p2 - 3 * p0 + 5 * p1 50 | 51 | let test_nonlin (module Db : CONNECTION) = 52 | let rec loop n = 53 | if n = 0 then Fiber.return () else 54 | let p = (Random.int 1000, Random.int 1000, Random.int 1000) in 55 | (Db.find Q.nonlin1 p >>= or_fail >|= fun y -> assert (y = nonlin p)) 56 | >>= fun () -> 57 | (Db.find Q.nonlin2 p >>= or_fail >|= fun y -> assert (y = nonlin p)) 58 | >>= fun () -> 59 | loop (n - 1) 60 | in 61 | loop 1000 62 | 63 | let test_env (module Db : CONNECTION) = 64 | Db.find Q.env1 () >>= or_fail >|= fun y -> assert (y = 60) 65 | 66 | let test_cases = [ 67 | "nonlinear", `Quick, test_nonlin; 68 | "environment", `Quick, test_env; 69 | ] 70 | 71 | end 72 | --------------------------------------------------------------------------------