├── .dockerignore ├── .gitignore ├── .travis.yml ├── .vscode └── tasks.json ├── CHANGES.md ├── Dockerfile.test ├── LICENSE.md ├── README.md ├── doc └── doc.odocl ├── docker-compose.yml ├── dune-project ├── ezpostgresql.opam ├── jbuild-workspace.dev ├── lib ├── dune ├── ezpostgresql.ml └── ezpostgresql.mli ├── pkg └── pkg.ml └── test ├── dune └── test.ml /.dockerignore: -------------------------------------------------------------------------------- 1 | _build* 2 | .vscode* 3 | .merlin 4 | README.md 5 | *.install 6 | *.swp 7 | _opam 8 | Dockerfile 9 | .dockerignore 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .merlin 2 | _build 3 | _opam 4 | *.install 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: required 2 | 3 | services: 4 | - docker 5 | 6 | script: 7 | - docker-compose run --rm tester 8 | -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | // See https://go.microsoft.com/fwlink/?LinkId=733558 3 | // for the documentation about the tasks.json format 4 | "version": "2.0.0", 5 | "tasks": [ 6 | { 7 | "taskName": "build", 8 | "type": "shell", 9 | "command": "make", 10 | "group": { 11 | "kind": "build", 12 | "isDefault": true 13 | } 14 | }, 15 | { 16 | "taskName": "test", 17 | "type": "shell", 18 | "command": "make test", 19 | "group": { 20 | "kind": "test", 21 | "isDefault": true 22 | } 23 | } 24 | ] 25 | } 26 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ### 0.2.1 (2018-08-22) 2 | 3 | * Remove silly debug print 4 | 5 | ### 0.2.0 (2018-07-15) 6 | 7 | * Upgrade to Dune 1.0.0 8 | * Use postgres async mechanism instead of preemptive threads 9 | 10 | ### 0.1.1 (2018-06-14) 11 | 12 | * Fix compatibility with Lwt 4.0.0 13 | 14 | ### 0.1.0 (2018-01-20) 15 | 16 | * Initial version (experimental) 17 | -------------------------------------------------------------------------------- /Dockerfile.test: -------------------------------------------------------------------------------- 1 | FROM ocaml/opam2:alpine 2 | WORKDIR ezpostgresql 3 | ENV OPAMYES true 4 | ADD ezpostgresql.opam . 5 | RUN sudo apk update && \ 6 | opam pin add -yn ezpostgresql . && \ 7 | opam install depext && \ 8 | opam depext ezpostgresql && \ 9 | opam install --deps-only --build-test ezpostgresql && \ 10 | sudo rm -rf /var/cache/apk/* 11 | ADD . . 12 | RUN sudo chown -R opam:nogroup . 13 | CMD opam config exec dune runtest 14 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017 Bobby Priambodo bobby.priambodo@gmail.com 2 | 3 | Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. 4 | 5 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Ezpostgresql [![Build Status](https://travis-ci.org/bobbypriambodo/ezpostgresql.svg?branch=master)](https://travis-ci.org/bobbypriambodo/ezpostgresql) 2 | 3 | [Lwt](https://github.com/ocsigen/lwt)-friendly wrapper for postgresql-ocaml which supports connection pooling. 4 | 5 | ## Motivation 6 | 7 | ### Problem 8 | 9 | Using databases (in particular, postgresql) in OCaml is not straightforward. 10 | 11 | Some libraries, such as the popular [PG'OCaml](https://github.com/darioteixeira/pgocaml), implements sophisticated compile-time type-safety while hiding the cruft in a now-deprecated camlp4 syntax extension. Others, such as [postgresql-ocaml](https://github.com/mmottl/postgresql-ocaml) goes even lower as a wrapper for libpq, the C client lib for postgres. To use it, one must be familiar with how libpq works, which means reading the docs with examples written in C. What's more, in case of postgresql-ocaml, errors are found in the form of thrown exceptions, which is undesirable and demands users' discipline for handling it. 12 | 13 | Another problem that usually comes when building apps that comunicates with databases is to have a pooled DB connections. Most libraries don't give this support out of the box, and there doesn't seem to be any generic resource pool library for OCaml that I'm aware of except for Lwt_pool from Lwt, and the example of its usage is less documented. 14 | 15 | ### Solution 16 | 17 | This library is a wrapper to the low-level postgresql-ocaml lib that aims to give users a friendlier interface in using postgres database by making them non-blocking (via Lwt). By friendlier, it means that we give up many points of sophisticated type safety that other libs provide and stick with writing SQL query strings with params and returning string arrays, in plain OCaml (without any syntax extension). This enables a consistent and easy-to-grasp API. 18 | 19 | Ezpostgresql also provides a better error handling mechanism by utilizing the `result` monad. Most of the APIs have the return type of `(t, Postgresql.error) result Lwt.t`. This way, users are "forced" to handle error cases, enforced by the compiler. The use of [`Lwt_result`](https://ocsigen.org/lwt/3.1.0/api/Lwt_result) is recommended to ease dealing with the return values as well as chaining operations (see examples below). 20 | 21 | This lib also provides an easy way of using pools of postgres connections powered by `Lwt_pool`. The API of using pooled connection is analogous to the one for single connection. 22 | 23 | If you want more type-safe queries, then this lib is most likely not for you. 24 | 25 | The name was inspired by the awesome [Ezjsonm](https://github.com/mirage/ezjsonm) library. 26 | 27 | ## Features 28 | 29 | * Non-blocking, lwt-friendly interface 30 | * Transactions 31 | * Pooled connections 32 | * Error handling with Result monad 33 | * Consistent API for single connection, connection pools, and transactions 34 | 35 | ## Usage 36 | 37 | _This library is still a work in progress! Consider yourself warned for breaking changes._ 38 | 39 | To use this library, install via opam: 40 | 41 | ``` 42 | opam pin add ezpostgresql https://github.com/bobbypriambodo/ezpostgresql.git 43 | ``` 44 | 45 | ## Examples 46 | 47 | ### Single connection 48 | 49 | ```ocaml 50 | let () = 51 | (* Brings >>= into scope for dealing with ('a, 'b) result Lwt.t. *) 52 | let open Lwt_result.Infix in 53 | 54 | let open Ezpostgresql in 55 | 56 | Lwt_main.run ( 57 | 58 | let%lwt operation_result = 59 | 60 | (* Connect to a database. `conninfo` is the usual postgres conninfo string. *) 61 | connect ~conninfo:"host=localhost" () >>= fun conn -> 62 | 63 | (* Run a command. The passed ~params is guaranteed to be escaped. *) 64 | command 65 | ~query:"INSERT INTO person (name, age) VALUES ($1, $2)" 66 | ~params:[| "Bobby"; (string_of_int 19) |] 67 | conn >>= fun () -> 68 | 69 | (* Run a query returning one result. *) 70 | one 71 | ~query:"SELECT name, age FROM person WHERE name = $1" 72 | ~params:[| "Bobby" |] 73 | conn >>= fun row_opt -> 74 | 75 | (* `row_opt` will be a `string array option` containing the values in order of select. 76 | It will have the value of `Some row` if the record is found, `None` otherwise. *) 77 | let () = 78 | match row_opt with 79 | | Some row -> 80 | print_endline row.(0); (* outputs Bobby *) 81 | print_endline row.(1); (* outputs 19 *) 82 | | None -> failwith "Record not found!" 83 | in 84 | 85 | (* Run a query returning multiple result. You may provide optional ~params. *) 86 | all 87 | ~query:"SELECT name, age FROM person" 88 | conn >>= fun rows -> 89 | 90 | (* `rows` will be a `string array array` (array of entries). *) 91 | print_endline (string_of_int @@ Array.length rows); (* outputs 1 *) 92 | 93 | (* Close the connection. *) 94 | finish conn in 95 | 96 | (* Handling of errors. `operation_result` has the type `('a, Postgresql.error) result`. *) 97 | match operation_result with 98 | | Ok () -> print_endline "Operations were successful!" |> Lwt.return 99 | | Error e -> print_endline (Postgresql.string_of_error e) |> Lwt.return 100 | ) 101 | ``` 102 | 103 | ### Pooled connections 104 | 105 | ```ocaml 106 | let () = 107 | let open Lwt_result.Infix in 108 | 109 | let open Ezpostgresql.Pool in 110 | 111 | (* Create a pool of DB connections with size 10. *) 112 | let pool = create ~conninfo:"host=localhost" ~size:10 () in 113 | 114 | Lwt_main.run ( 115 | let%lwt operation_result = 116 | 117 | (* Run a command. The passed ~params is guaranteed to be escaped. *) 118 | command 119 | ~query:"INSERT INTO person (name, age) VALUES ($1, $2)" 120 | ~params:[| "Bobby"; (string_of_int 19) |] 121 | pool >>= fun () -> 122 | 123 | (* Run a query returning one result. *) 124 | one 125 | ~query:"SELECT name, age FROM person WHERE name = $1" 126 | ~params:[| "Bobby" |] 127 | pool >>= fun row_opt -> 128 | 129 | (* `row_opt` will be a `string array option` containing the values in order of select. 130 | It will have the value of `Some row` if the record is found, `None` otherwise. *) 131 | let () = 132 | match row_opt with 133 | | Some row -> 134 | print_endline row.(0); (* outputs Bobby *) 135 | print_endline row.(1); (* outputs 19 *) 136 | | None -> failwith "Record not found!" 137 | in 138 | 139 | (* Run a query returning multiple result. You may provide optional ~params. *) 140 | all 141 | ~query:"SELECT name, age FROM person" 142 | pool >>= fun rows -> 143 | 144 | (* `rows` will be a `string array array` (array of entries). *) 145 | print_endline (string_of_int @@ Array.length rows); (* outputs 1 *) 146 | 147 | Lwt_result.return () in 148 | 149 | (* Handling of errors. `operation_result` has the type `('a, Postgresql.error) result`. *) 150 | match operation_result with 151 | | Ok () -> print_endline "Operations were successful!" |> Lwt.return 152 | | Error e -> print_endline (Postgresql.string_of_error e) |> Lwt.return 153 | ) 154 | ``` 155 | 156 | ### Transactions 157 | 158 | ```ocaml 159 | let () = 160 | let open Lwt_result.Infix in 161 | 162 | let open Ezpostgresql.Transaction in 163 | 164 | Lwt_main.run ( 165 | let%lwt operation_result = 166 | 167 | (* Given that we have a connection... *) 168 | Ezpostgresql.connect ~conninfo:"host=localhost" () >>= fun conn -> 169 | 170 | (* Begin the transaction block. *) 171 | begin_ conn >>= fun trx -> 172 | 173 | (* Issue multiple commands. You can also use `one` or `all`. *) 174 | command 175 | ~query:"INSERT INTO person VALUES ($1, $2)" 176 | ~params:[| "Bobby"; (string_of_int 19) |] 177 | trx >>= fun () -> 178 | 179 | command 180 | ~query:"INSERT INTO person VALUES ($1, $2)" 181 | ~params:[| "Bobby"; (string_of_int 19) |] 182 | trx >>= fun () -> 183 | 184 | (* Commit the transaction. *) 185 | commit trx 186 | 187 | (* You can rollback using 188 | rollback trx 189 | and all commands issued with trx will be canceled. *) 190 | 191 | (* If you want to use pool, rather than `begin_` you may use 192 | Pool.begin_ pool 193 | the rest of the commands are the same. *) 194 | in 195 | 196 | (* Handling of errors. *) 197 | match operation_result with 198 | | Ok () -> print_endline "Operations were successful!" |> Lwt.return 199 | | Error e -> print_endline (Postgresql.string_of_error e) |> Lwt.return 200 | ) 201 | ``` 202 | -------------------------------------------------------------------------------- /doc/doc.odocl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bobbypriam/ezpostgresql/5f5200495474b5ef1719e524da4c5fede7f25710/doc/doc.odocl -------------------------------------------------------------------------------- /docker-compose.yml: -------------------------------------------------------------------------------- 1 | version: '2' 2 | services: 3 | tester: 4 | build: 5 | context: . 6 | dockerfile: Dockerfile.test 7 | command: opam config exec dune runtest 8 | environment: 9 | - DATABASE_URL=postgresql://postgres:password@db/test_db 10 | links: 11 | - db 12 | db: 13 | image: postgres:alpine 14 | environment: 15 | - POSTGRES_PASSWORD=password 16 | - POSTGRES_DB=test_db 17 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | 3 | (name ezpostgresql) 4 | 5 | (formatting disabled) 6 | -------------------------------------------------------------------------------- /ezpostgresql.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | name: "ezpostgresql" 3 | maintainer: "Bobby Priambodo " 4 | authors: ["Bobby Priambodo "] 5 | homepage: "https://github.com/bobbypriambodo/ezpostgresql" 6 | bug-reports: "https://github.com/bobbypriambodo/ezpostgresql/issues" 7 | dev-repo: "git+https://github.com/bobbypriambodo/ezpostgresql" 8 | doc: "https://bobbypriambodo.github.io/ezpostgresql/" 9 | license: ["MIT"] 10 | build: [ 11 | ["dune" "subst"] {pinned} 12 | ["dune" "build" "-p" name "-j" jobs] 13 | ] 14 | depends: [ 15 | "dune" {build} 16 | "lwt" {>= "3.0"} 17 | "postgresql" {>= "4.0"} 18 | "lwt_ppx" {test} 19 | "alcotest" {test & >= "0.8"} 20 | "alcotest-lwt" {test & >= "0.8"} 21 | "result" 22 | ] 23 | -------------------------------------------------------------------------------- /jbuild-workspace.dev: -------------------------------------------------------------------------------- 1 | (context ((switch 4.04.2))) 2 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ezpostgresql) 3 | (public_name ezpostgresql) 4 | (wrapped false) 5 | (libraries postgresql lwt.unix result)) 6 | -------------------------------------------------------------------------------- /lib/ezpostgresql.ml: -------------------------------------------------------------------------------- 1 | open Lwt.Infix 2 | open Result 3 | 4 | 5 | type connection = Postgresql.connection 6 | type error = Postgresql.error 7 | 8 | module type QUERYABLE = sig 9 | type t 10 | val one : query:string -> ?params:string array -> t -> (string array option, error) result Lwt.t 11 | val all : query:string -> ?params:string array -> t -> (string array array, error) result Lwt.t 12 | val command : query:string -> ?params:string array -> t -> (unit, error) result Lwt.t 13 | val command_returning : query:string -> ?params:string array -> t -> (string array array, error) result Lwt.t 14 | end 15 | 16 | 17 | 18 | type t = connection 19 | 20 | let connect ~conninfo = 21 | Lwt_preemptive.detach (fun () -> 22 | try Ok (new Postgresql.connection ~conninfo ()) 23 | with Postgresql.Error e -> Error e 24 | ) 25 | 26 | 27 | let rec wait_for_result (conn : connection) = 28 | conn#consume_input; 29 | if conn#is_busy then 30 | Lwt_unix.yield () >>= fun () -> wait_for_result conn 31 | else 32 | match conn#get_result with 33 | | None -> Lwt.return (Ok None) 34 | | Some result -> 35 | (* Free up the connection. *) 36 | assert (conn#get_result = None); 37 | Lwt.return (Ok (Some result)) 38 | 39 | let send_query_and_wait query params (conn : connection) = 40 | Lwt.catch 41 | (fun () -> 42 | conn#send_query ~params query; 43 | wait_for_result conn) 44 | (function 45 | | Postgresql.Error e -> Lwt.return (Error e) 46 | | e -> Lwt.fail e) 47 | 48 | 49 | 50 | let one ~query ?(params=[||]) (conn : connection) = 51 | let open Lwt_result.Infix in 52 | send_query_and_wait query params conn >|= function 53 | | None -> None 54 | | Some result -> 55 | try Some (result#get_tuple 0) with 56 | | Postgresql.Error Postgresql.Tuple_out_of_range (_, _) -> None 57 | 58 | let all ~query ?(params=[||]) conn = 59 | let open Lwt_result.Infix in 60 | send_query_and_wait query params conn >|= function 61 | | None -> [||] 62 | | Some result -> result#get_all 63 | 64 | let command ~query ?(params=[||]) conn = 65 | let open Lwt_result.Infix in 66 | send_query_and_wait query params conn >|= fun _ -> () 67 | 68 | (* command_returning has the same semantic as all. 69 | We're keeping them separate for clarity. *) 70 | let command_returning = all 71 | 72 | let finish conn = 73 | Lwt_preemptive.detach (fun (c : connection) -> 74 | try Ok c#finish 75 | with Postgresql.Error e -> Error e 76 | ) conn 77 | 78 | 79 | 80 | module Pool = struct 81 | 82 | type t = connection Lwt_pool.t 83 | 84 | let create ~conninfo ~size () = 85 | let open Lwt.Infix in 86 | Lwt_pool.create size (fun () -> 87 | connect ~conninfo () >>= function 88 | | Ok conn -> Lwt.return conn 89 | | Error _e -> 90 | failwith @@ "Ezpostgresql: Failed to connect. Conninfo=" ^ conninfo 91 | ) 92 | 93 | let one ~query ?(params=[||]) pool = 94 | Lwt_pool.use pool (one ~query ~params) 95 | 96 | let all ~query ?(params=[||]) pool = 97 | Lwt_pool.use pool (all ~query ~params) 98 | 99 | let command ~query ?(params=[||]) pool = 100 | Lwt_pool.use pool (command ~query ~params) 101 | 102 | let command_returning = all 103 | 104 | end 105 | 106 | 107 | 108 | module Transaction = struct 109 | 110 | type t = connection 111 | 112 | let begin_ (conn : connection) = 113 | command ~query:"BEGIN" conn >>= fun res -> 114 | match res with 115 | | Ok () -> Ok conn |> Lwt.return 116 | | Error e -> Error e |> Lwt.return 117 | 118 | let commit (trx : t) = 119 | command ~query:"COMMIT" trx 120 | 121 | let rollback (trx : t) = 122 | command ~query:"ROLLBACK" trx 123 | 124 | let one = one 125 | let all = all 126 | let command = command 127 | let command_returning = all 128 | 129 | 130 | 131 | module Pool = struct 132 | 133 | let begin_ pool = 134 | Lwt_pool.use pool begin_ 135 | 136 | end 137 | 138 | end 139 | -------------------------------------------------------------------------------- /lib/ezpostgresql.mli: -------------------------------------------------------------------------------- 1 | (** Lwt-friendly wrapper for postgresql-ocaml which supports connection pooling. *) 2 | open Result 3 | 4 | 5 | (** The database connection. This is just an alias to [Postgresql.connection]. *) 6 | type connection = Postgresql.connection 7 | 8 | (** Database related errors. This is just an alias to [Postgresql.error]. *) 9 | type error = Postgresql.error 10 | 11 | 12 | 13 | (** Interface for queryable entities, for example a connection, a pool, or a transaction. *) 14 | module type QUERYABLE = sig 15 | 16 | (** The queryable entity. *) 17 | type t 18 | 19 | (** Run a query that expects a single row result. *) 20 | val one : query:string -> ?params:string array -> t -> (string array option, error) result Lwt.t 21 | 22 | (** Run a query that expects multiple row result. *) 23 | val all : query:string -> ?params:string array -> t -> (string array array, error) result Lwt.t 24 | 25 | (** Run a command (e.g. insert, update, delete) that expects no result. *) 26 | val command : query:string -> ?params:string array -> t -> (unit, error) result Lwt.t 27 | 28 | (** Run a command (e.g. insert, update, delete) that uses RETURNING clause. *) 29 | val command_returning : query:string -> ?params:string array -> t -> (string array array, error) result Lwt.t 30 | 31 | end 32 | 33 | 34 | 35 | (** A connection is queryable. *) 36 | include QUERYABLE with type t = connection 37 | 38 | (** Connect to a database. [conninfo] is the usual Postgresql conninfo. *) 39 | val connect : conninfo:string -> unit -> (connection, error) result Lwt.t 40 | 41 | (** Close a connection (must be called after [connect]). *) 42 | val finish : connection -> (unit, error) result Lwt.t 43 | 44 | 45 | 46 | (** Module to work with connection pools. *) 47 | module Pool : sig 48 | 49 | (** A connection pool is queryable. *) 50 | include QUERYABLE with type t = connection Lwt_pool.t 51 | 52 | (** Create a connection pool. *) 53 | val create : conninfo:string -> size:int -> unit -> connection Lwt_pool.t 54 | 55 | end 56 | 57 | 58 | 59 | (** Module to work with database transactions. *) 60 | module Transaction : sig 61 | 62 | (** A transaction is queryable with an abstract type. *) 63 | include QUERYABLE 64 | 65 | (** Begin a transaction. *) 66 | val begin_ : connection -> (t, error) result Lwt.t 67 | 68 | (** Commit an ongoing transaction (must be called after [begin_]). *) 69 | val commit : t -> (unit, error) result Lwt.t 70 | 71 | (** Rollback an ongoing transaction (must be called after [begin_]). *) 72 | val rollback : t -> (unit, error) result Lwt.t 73 | 74 | (** Module to work with transactions using connection pools. For queries and commands, we can reuse 75 | the functions on [Transaction] module. *) 76 | module Pool : sig 77 | 78 | (** Begin the transaction on a pool. *) 79 | val begin_ : Pool.t -> (t, error) result Lwt.t 80 | 81 | end 82 | 83 | end 84 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #use "topfind" 2 | #require "topkg-jbuilder.auto" 3 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test) 3 | (libraries ezpostgresql alcotest alcotest-lwt) 4 | (preprocess (pps lwt_ppx))) 5 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (* This brings the >>= symbols into scope. *) 2 | open Lwt_result.Infix 3 | 4 | let conninfo = 5 | try Sys.getenv "DATABASE_URL" 6 | with Not_found -> "postgresql://localhost:5432" 7 | 8 | let get_fail_message (e : Postgresql.error) : string = 9 | match e with 10 | | Postgresql.Tuple_out_of_range (_, _) -> "Tuple out of range" 11 | | Postgresql.Field_out_of_range (_, _) -> "Field out of range" 12 | | Postgresql.Connection_failure s -> "Connection failure: " ^ s 13 | | _ -> "General failure" 14 | 15 | let raw_execute query = 16 | try 17 | let conn = new Postgresql.connection ~conninfo () in 18 | let _ = conn#exec ~expect:[Postgresql.Command_ok] query in 19 | conn#finish 20 | with Postgresql.Error e -> print_endline (get_fail_message e); exit 1 21 | 22 | let create_test_table () = 23 | raw_execute " 24 | CREATE TABLE IF NOT EXISTS person ( 25 | name VARCHAR(100) NOT NULL, 26 | age INTEGER NOT NULL 27 | ) 28 | " 29 | 30 | let drop_test_table () = 31 | raw_execute " 32 | DROP TABLE IF EXISTS person 33 | " 34 | 35 | let tear_down () = 36 | raw_execute " 37 | TRUNCATE TABLE person 38 | " 39 | 40 | let tests = [ 41 | 42 | "connect", [ 43 | Alcotest_lwt.test_case "could connect" `Quick (fun _ _ -> 44 | let open Ezpostgresql in 45 | 46 | let%lwt test_result = 47 | connect ~conninfo () >>= fun conn -> 48 | finish conn in 49 | 50 | match test_result with 51 | | Ok () -> Alcotest.(check unit) "Finish successfully" () () |> Lwt.return 52 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 53 | ); 54 | ]; 55 | 56 | "one", [ 57 | Alcotest_lwt.test_case "could run `one` query" `Quick (fun _ _ -> 58 | let open Ezpostgresql in 59 | 60 | let%lwt test_result = 61 | connect ~conninfo () >>= fun conn -> 62 | 63 | raw_execute "INSERT INTO person VALUES ('Bobby', 19), ('Anne', 18)"; 64 | 65 | one 66 | ~query:"SELECT * FROM person WHERE name = $1" 67 | ~params:[| "Bobby" |] 68 | conn >>= fun row_opt -> 69 | 70 | finish conn >>= fun () -> 71 | 72 | Lwt_result.return row_opt in 73 | 74 | tear_down (); 75 | 76 | match test_result with 77 | | Ok (Some row) -> Alcotest.(check (string)) "have correct name" "Bobby" (row.(0)) |> Lwt.return 78 | | Ok None -> Alcotest.fail "Record not found" |> Lwt.return 79 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 80 | ); 81 | 82 | Alcotest_lwt.test_case "returns Ok None if record not found" `Quick (fun _ _ -> 83 | let open Ezpostgresql in 84 | 85 | let%lwt test_result = 86 | connect ~conninfo () >>= fun conn -> 87 | 88 | raw_execute "INSERT INTO person VALUES ('Bobby', 19), ('Anne', 18)"; 89 | 90 | one 91 | ~query:"SELECT * FROM person WHERE name = $1" 92 | ~params:[| "Non Existent" |] 93 | conn >>= fun row_opt -> 94 | 95 | finish conn >>= fun () -> 96 | 97 | Lwt_result.return row_opt in 98 | 99 | tear_down (); 100 | 101 | match test_result with 102 | | Ok (Some _) -> Alcotest.fail "Should not match any record" |> Lwt.return 103 | | Ok None -> Alcotest.(check unit) "returns Ok None" () () |> Lwt.return 104 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 105 | ); 106 | ]; 107 | 108 | "all", [ 109 | Alcotest_lwt.test_case "could run `all` query" `Quick (fun _ _ -> 110 | let open Ezpostgresql in 111 | 112 | let%lwt test_result = 113 | connect ~conninfo () >>= fun conn -> 114 | 115 | raw_execute "INSERT INTO person VALUES ('Bobby', 19), ('Anne', 18)"; 116 | 117 | all ~query:"SELECT * FROM person" conn >>= fun rows -> 118 | 119 | finish conn >>= fun () -> 120 | 121 | Lwt_result.return rows in 122 | 123 | tear_down (); 124 | 125 | match test_result with 126 | | Ok rows -> Alcotest.(check (int)) "have length 2" 2 (Array.length rows) |> Lwt.return 127 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 128 | ); 129 | ]; 130 | 131 | "command", [ 132 | Alcotest_lwt.test_case "could run `command` query" `Quick (fun _ _ -> 133 | let open Ezpostgresql in 134 | 135 | let%lwt test_result = 136 | connect ~conninfo () >>= fun conn -> 137 | 138 | command 139 | ~query:"CREATE TEMP TABLE test_data (some_num INTEGER NOT NULL)" 140 | conn >>= fun () -> 141 | 142 | command 143 | ~query:"INSERT INTO test_data VALUES ($1)" 144 | ~params:[| (string_of_int 42) |] 145 | conn >>= fun () -> 146 | 147 | one ~query:"SELECT some_num FROM test_data" conn >>= fun row_opt -> 148 | 149 | finish conn >>= fun () -> 150 | 151 | Lwt_result.return row_opt in 152 | 153 | tear_down (); 154 | 155 | match test_result with 156 | | Ok (Some row) -> 157 | Alcotest.(check (int)) "have correct value" 42 (int_of_string row.(0)) |> Lwt.return 158 | | Ok None -> Alcotest.fail "Record not found" |> Lwt.return 159 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 160 | ); 161 | ]; 162 | 163 | "command_returning", [ 164 | Alcotest_lwt.test_case "could run `command_returning` query" `Quick (fun _ _ -> 165 | let open Ezpostgresql in 166 | 167 | let%lwt test_result = 168 | connect ~conninfo () >>= fun conn -> 169 | 170 | command_returning 171 | ~query:" 172 | INSERT INTO person (name, age) VALUES ($1, $2), ($3, $4) 173 | RETURNING name 174 | " 175 | ~params:[| "Bobby"; (string_of_int 19); "Anne"; (string_of_int 17) |] 176 | conn >>= fun rows -> 177 | 178 | command_returning 179 | ~query:" 180 | UPDATE person SET age = $1 WHERE 1=1 181 | RETURNING age 182 | " 183 | ~params:[| (string_of_int 10) |] 184 | conn >>= fun rows2 -> 185 | 186 | finish conn >>= fun () -> 187 | 188 | Lwt_result.return (rows, rows2) in 189 | 190 | tear_down (); 191 | 192 | match test_result with 193 | | Ok (rows, rows2) -> Lwt.return @@ ( 194 | Alcotest.(check (int)) "correct rows length" 2 (Array.length rows); 195 | Alcotest.(check (string)) "corect name value" "Bobby" rows.(0).(0); 196 | Alcotest.(check (int)) "correct rows2 length" 2 (Array.length rows2); 197 | Alcotest.(check (int)) "correct updated age value" 10 (int_of_string rows2.(0).(0)); 198 | Alcotest.(check (int)) "correct updated age value" 10 (int_of_string rows2.(1).(0)); 199 | ) 200 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 201 | ); 202 | ]; 203 | 204 | "Pool.create", [ 205 | Alcotest_lwt.test_case "could use connection from pool" `Quick (fun _ _ -> 206 | let pool = Ezpostgresql.Pool.create ~conninfo ~size:10 () in 207 | Lwt_pool.use pool (fun c -> 208 | Lwt.return @@ Alcotest.(check (bool)) "test" true (c#backend_pid > 0) 209 | ) 210 | ); 211 | ]; 212 | 213 | "Pool.one", [ 214 | Alcotest_lwt.test_case "could run `one` query using pool" `Quick (fun _ _ -> 215 | let open Ezpostgresql.Pool in 216 | 217 | let pool = create ~conninfo ~size:10 () in 218 | 219 | let%lwt test_result = 220 | raw_execute "INSERT INTO person VALUES ('Bobby', 19), ('Anne', 18)"; 221 | 222 | one 223 | ~query:"SELECT * FROM person WHERE name = $1" 224 | ~params:[| "Bobby" |] 225 | pool in 226 | 227 | tear_down (); 228 | 229 | match test_result with 230 | | Ok (Some row) -> Alcotest.(check (string)) "have correct name" "Bobby" (row.(0)) |> Lwt.return 231 | | Ok None -> Alcotest.fail "Record not found" |> Lwt.return 232 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 233 | ); 234 | 235 | Alcotest_lwt.test_case "returns Ok None if record not found" `Quick (fun _ _ -> 236 | let open Ezpostgresql.Pool in 237 | 238 | let pool = create ~conninfo ~size:10 () in 239 | 240 | let%lwt test_result = 241 | raw_execute "INSERT INTO person VALUES ('Bobby', 19), ('Anne', 18)"; 242 | 243 | one 244 | ~query:"SELECT * FROM person WHERE name = $1" 245 | ~params:[| "Non Existent" |] 246 | pool in 247 | 248 | tear_down (); 249 | 250 | match test_result with 251 | | Ok (Some _) -> Alcotest.fail "Should not match any record" |> Lwt.return 252 | | Ok None -> Alcotest.(check unit) "returns Ok None" () () |> Lwt.return 253 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 254 | ); 255 | ]; 256 | 257 | "Pool.all", [ 258 | Alcotest_lwt.test_case "could run `all` query using pool" `Quick (fun _ _ -> 259 | let open Ezpostgresql.Pool in 260 | 261 | let pool = create ~conninfo ~size:10 () in 262 | 263 | let%lwt test_result = 264 | raw_execute "INSERT INTO person VALUES ('Bobby', 19), ('Anne', 18)"; 265 | 266 | all ~query:"SELECT * FROM person" pool in 267 | 268 | tear_down (); 269 | 270 | match test_result with 271 | | Ok rows -> Alcotest.(check (int)) "have length 2" 2 (Array.length rows) |> Lwt.return 272 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 273 | ) 274 | ]; 275 | 276 | "Pool.command", [ 277 | Alcotest_lwt.test_case "could run `command` query using pool" `Quick (fun _ _ -> 278 | let open Ezpostgresql.Pool in 279 | 280 | let pool = create ~conninfo ~size:10 () in 281 | 282 | let%lwt test_result = 283 | command 284 | ~query:"CREATE TEMP TABLE test_data (some_num INTEGER NOT NULL)" 285 | pool >>= fun () -> 286 | 287 | command 288 | ~query:"INSERT INTO test_data VALUES ($1)" 289 | ~params:[| (string_of_int 42) |] 290 | pool >>= fun () -> 291 | 292 | one ~query:"SELECT some_num FROM test_data" pool in 293 | 294 | tear_down (); 295 | 296 | match test_result with 297 | | Ok (Some row) -> 298 | Alcotest.(check (int)) "have correct value" 42 (int_of_string row.(0)) |> Lwt.return 299 | | Ok None -> Alcotest.fail "Record not found" |> Lwt.return 300 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 301 | ); 302 | ]; 303 | 304 | "Pool.command_returning", [ 305 | Alcotest_lwt.test_case "could run `command_returning` query using pool" `Quick (fun _ _ -> 306 | let open Ezpostgresql.Pool in 307 | let pool = create ~conninfo ~size:10 () in 308 | 309 | let%lwt test_result = 310 | command_returning 311 | ~query:" 312 | INSERT INTO person (name, age) VALUES ($1, $2), ($3, $4) 313 | RETURNING name 314 | " 315 | ~params:[| "Bobby"; (string_of_int 19); "Anne"; (string_of_int 17) |] 316 | pool >>= fun rows -> 317 | 318 | command_returning 319 | ~query:" 320 | UPDATE person SET age = $1 WHERE 1=1 321 | RETURNING age 322 | " 323 | ~params:[| (string_of_int 10) |] 324 | pool >>= fun rows2 -> 325 | 326 | Lwt_result.return (rows, rows2) in 327 | 328 | tear_down (); 329 | 330 | match test_result with 331 | | Ok (rows, rows2) -> Lwt.return @@ ( 332 | Alcotest.(check (int)) "correct rows length" 2 (Array.length rows); 333 | Alcotest.(check (string)) "corect name value" "Bobby" rows.(0).(0); 334 | Alcotest.(check (int)) "correct rows2 length" 2 (Array.length rows2); 335 | Alcotest.(check (int)) "correct updated age value" 10 (int_of_string rows2.(0).(0)); 336 | Alcotest.(check (int)) "correct updated age value" 10 (int_of_string rows2.(1).(0)); 337 | ) 338 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 339 | ); 340 | ]; 341 | 342 | 343 | "Transaction", [ 344 | Alcotest_lwt.test_case "could run `command` in transaction" `Quick (fun _ _ -> 345 | let open Ezpostgresql.Transaction in 346 | 347 | let%lwt test_result = 348 | Ezpostgresql.connect ~conninfo () >>= fun conn -> 349 | 350 | begin_ conn >>= fun trx -> 351 | 352 | command 353 | ~query:"INSERT INTO person VALUES ('Bobby', 19)" 354 | trx >>= fun () -> 355 | 356 | command 357 | ~query:"INSERT INTO person VALUES ('Anne', 18)" 358 | trx >>= fun () -> 359 | 360 | commit trx >>= fun () -> 361 | 362 | Ezpostgresql.all ~query:"SELECT * FROM person" conn >>= fun rows -> 363 | 364 | Ezpostgresql.finish conn >>= fun () -> 365 | 366 | Lwt_result.return rows in 367 | 368 | tear_down (); 369 | 370 | match test_result with 371 | | Ok rows -> Alcotest.(check (int)) "have length 2" 2 (Array.length rows) |> Lwt.return 372 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 373 | ); 374 | 375 | Alcotest_lwt.test_case "rollback aborts all commands" `Quick (fun _ _ -> 376 | let open Ezpostgresql.Transaction in 377 | 378 | let%lwt test_result = 379 | Ezpostgresql.connect ~conninfo () >>= fun conn -> 380 | 381 | begin_ conn >>= fun trx -> 382 | 383 | command 384 | ~query:"INSERT INTO person VALUES ('Bobby', 19)" 385 | trx >>= fun () -> 386 | 387 | command 388 | ~query:"INSERT INTO person VALUES ('Anne', 18)" 389 | trx >>= fun () -> 390 | 391 | rollback trx >>= fun () -> 392 | 393 | Ezpostgresql.all ~query:"SELECT * FROM person" conn >>= fun rows -> 394 | 395 | Ezpostgresql.finish conn >>= fun () -> 396 | 397 | Lwt_result.return rows in 398 | 399 | tear_down (); 400 | 401 | match test_result with 402 | | Ok rows -> Alcotest.(check (int)) "have length 0" 0 (Array.length rows) |> Lwt.return 403 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 404 | ) 405 | ]; 406 | 407 | "Transaction.Pool", [ 408 | Alcotest_lwt.test_case "could run `command` in transaction" `Quick (fun _ _ -> 409 | let open Ezpostgresql.Transaction in 410 | 411 | let pool = Ezpostgresql.Pool.create ~conninfo ~size:10 () in 412 | 413 | let%lwt test_result = 414 | Pool.begin_ pool >>= fun trx -> 415 | 416 | command 417 | ~query:"INSERT INTO person VALUES ('Bobby', 19)" 418 | trx >>= fun () -> 419 | 420 | command 421 | ~query:"INSERT INTO person VALUES ('Anne', 18)" 422 | trx >>= fun () -> 423 | 424 | commit trx >>= fun () -> 425 | 426 | Ezpostgresql.Pool.all ~query:"SELECT * FROM person" pool in 427 | 428 | tear_down (); 429 | 430 | match test_result with 431 | | Ok rows -> Alcotest.(check (int)) "have length 2" 2 (Array.length rows) |> Lwt.return 432 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 433 | ); 434 | 435 | Alcotest_lwt.test_case "rollback aborts all commands" `Quick (fun _ _ -> 436 | let open Ezpostgresql.Transaction in 437 | 438 | let pool = Ezpostgresql.Pool.create ~conninfo ~size:10 () in 439 | 440 | let%lwt test_result = 441 | Pool.begin_ pool >>= fun trx -> 442 | 443 | command 444 | ~query:"INSERT INTO person VALUES ('Bobby', 19)" 445 | trx >>= fun () -> 446 | 447 | command 448 | ~query:"INSERT INTO person VALUES ('Anne', 18)" 449 | trx >>= fun () -> 450 | 451 | rollback trx >>= fun () -> 452 | 453 | Ezpostgresql.Pool.all ~query:"SELECT * FROM person" pool in 454 | 455 | tear_down (); 456 | 457 | match test_result with 458 | | Ok rows -> Alcotest.(check (int)) "have length 0" 0 (Array.length rows) |> Lwt.return 459 | | Error e -> Alcotest.fail (get_fail_message e) |> Lwt.return 460 | ) 461 | ]; 462 | 463 | ] 464 | 465 | let _ = 466 | drop_test_table (); 467 | create_test_table (); 468 | Alcotest.run "Ezpostgresql" tests 469 | --------------------------------------------------------------------------------