Expose sqlstate in the connection and stmt APIs.

Author: paurkedal

Diff for: bindings/ffi_bindings.ml

@@ -320,6 +320,9 @@ module Functions (F : Ctypes.FOREIGN) = struct
   let mysql_get_proto_info = foreign "mysql_get_proto_info"
     (mysql @-> returning uint)
 
+  let mysql_sqlstate = foreign "mysql_sqlstate"
+    (mysql @-> returning string)
+
   let mysql_stmt_prepare = foreign "mysql_stmt_prepare"
     (stmt @-> ptr char @-> ulong @-> returning int)
 
@@ -332,6 +335,9 @@ module Functions (F : Ctypes.FOREIGN) = struct
   let mysql_stmt_fetch = foreign "mysql_stmt_fetch"
     (stmt @-> returning int)
 
+  let mysql_stmt_sqlstate = foreign "mysql_stmt_sqlstate"
+    (stmt @-> returning string)
+
   let mysql_stmt_close = foreign "mysql_stmt_close"
     (stmt @-> returning my_bool)
 

Diff for: lib/blocking.ml

@@ -158,6 +158,8 @@ let prepare mariadb query =
 let start_txn mariadb =
   wrap_unit mariadb (B.mysql_real_query mariadb.Common.raw "START TRANSACTION")
 
+let sqlstate = Common.sqlstate
+
 module Res = struct
   type t = [`Blocking] Common.Res.t
 
@@ -208,6 +210,8 @@ module Stmt = struct
     else
       Error (Common.Stmt.error stmt)
 
+  let sqlstate = Common.Stmt.sqlstate
+
   let close stmt =
     Common.Stmt.free_meta stmt;
     let raw = stmt.Common.Stmt.raw in

Diff for: lib/common.ml

@@ -85,6 +85,9 @@ type error = int * string
 let error mariadb =
   (B.mysql_errno mariadb.raw, B.mysql_error mariadb.raw)
 
+let sqlstate mariadb =
+  B.mysql_sqlstate mariadb.raw
+
 let int_of_server_option = function
   | Multi_statements true -> T.Server_options.multi_statements_on
   | Multi_statements false -> T.Server_options.multi_statements_off
@@ -295,6 +298,9 @@ module Stmt = struct
   let error stmt =
     (B.mysql_stmt_errno stmt.raw, B.mysql_stmt_error stmt.raw)
 
+  let sqlstate stmt =
+    B.mysql_stmt_sqlstate stmt.raw
+
   let fetch_field res i =
     coerce (ptr void) (ptr T.Field.t) (B.mysql_fetch_field_direct res i)
 

Diff for: lib/mariadb.ml

@@ -80,6 +80,7 @@ module type S = sig
 
     val execute : t -> Field.value array -> Res.t result
     val reset : t -> unit result
+    val sqlstate : t -> string
     val close : t -> unit result
   end
 
@@ -168,6 +169,7 @@ module type S = sig
   val commit : t -> unit result
   val rollback : t -> unit result
   val prepare : t -> string -> Stmt.t result
+  val sqlstate : t -> string
 end
 
 module B = Binding_wrappers

Diff for: lib/mariadb.mli

@@ -160,6 +160,12 @@ module type S = sig
           were after [stmt] was prepared, and frees up any {!Res.t} produced by
           [stmt]. *)
 
+    val sqlstate : t -> string
+      (** [sqlstate stmt] is the SQLSTATE with MariaDB extensions indicating the
+          status of the previous execution of the statement. The string
+          ["00000"] is returned if no error occurred or if the statement has not
+          been executed. *)
+
     val close : t -> unit result
       (** [close stmt] closes the prepapred statement [stmt] and frees any
           allocated memory associated with it and its result. *)
@@ -294,6 +300,10 @@ module type S = sig
     (** [prepare mariadb query] creates a prepared statement for [query].  The
         query may contain [?] as placeholders for parameters that can be bound
         by calling [Stmt.execute]. *)
+
+  val sqlstate : t -> string
+    (* [sqlstate mariadb] is the SQLSTATE with MariaDB extensions of the last
+     * operation on [mariadb]. Returns ["00000"] if no error occurred. *)
 end
 
 (** The module for blocking MariaDB API calls. It should be possible to call
@@ -449,6 +459,7 @@ module Nonblocking : sig
 
       val execute : t -> Field.value array -> Res.t result future
       val reset : t -> unit result future
+      val sqlstate : t -> string
       val close : t -> unit result future
     end
 
@@ -538,6 +549,7 @@ module Nonblocking : sig
     val commit : t -> unit result future
     val rollback : t -> unit result future
     val prepare : t -> string -> Stmt.t result future
+    val sqlstate : t -> string
   end
 
   (** Functor that generates a nonblocking database interface, given a

Diff for: lib/nonblocking.ml

@@ -449,6 +449,7 @@ module type S = sig
 
     val execute : t -> Field.value array -> Res.t result future
     val reset : t -> unit result future
+    val sqlstate : t -> string
     val close : t -> unit result future
   end
 
@@ -537,6 +538,7 @@ module type S = sig
   val commit : t -> unit result future
   val rollback : t -> unit result future
   val prepare : t -> string -> Stmt.t result future
+  val sqlstate : t -> string
 end
 
 module Make (W : Wait) : S with type 'a future = 'a W.IO.future = struct
@@ -676,6 +678,8 @@ module Make (W : Wait) : S with type 'a future = 'a W.IO.future = struct
       >>= function
       | Ok () -> nonblocking stmt.Common.Stmt.mariadb (Stmt.close stmt)
       | Error _ as e -> return e
+
+    let sqlstate = Common.Stmt.sqlstate
   end
 
   let connect ?host ?user ?pass ?db ?(port=0) ?socket ?(flags=[]) ?(options=[]) () =
@@ -742,4 +746,6 @@ module Make (W : Wait) : S with type 'a future = 'a W.IO.future = struct
     match prepare m q with
     | `Ok nb -> nonblocking m nb
     | `Error e -> return (Error e)
+
+  let sqlstate = Common.sqlstate
 end

Diff for: tests/nonblocking/nonblocking_testsuite.ml

@@ -22,6 +22,10 @@ struct
     | Ok r -> return r
     | Error (i, e) -> eprintf "%s: (%d) %s\n%!" where i e; exit 2
 
+  let then_die where = function
+    | Ok _ -> eprintf "unexpected ok: %s" where; exit 2
+    | Error _ -> return ()
+
   let rec iter_s_list f = function
     | [] -> return ()
     | x :: xs -> f x >>= fun () -> iter_s_list f xs
@@ -154,6 +158,40 @@ struct
     assert (proto >= 0 && proto < 10000); (* it's 10 for MariaDB 10.11.8 *)
     return ()
 
+  let test_sqlstate () =
+    connect () >>= or_die "connect" >>= fun dbh ->
+    assert (M.sqlstate dbh = "00000");
+
+    (* Test select from missing table. *)
+    (M.prepare dbh "SELECT * FROM inexistent_table" >|= function
+     | Error _ -> assert (M.sqlstate dbh <> "00000") (* actually "42S02" *)
+     | Ok _ -> assert false) >>= fun () ->
+
+    (* Prepare table for testing. *)
+    M.prepare dbh
+              "CREATE TEMPORARY TABLE test_sqlstate (i integer PRIMARY KEY)"
+      >>= or_die "prepare CREATE TABLE test_sqlstate"
+      >>= fun stmt ->
+    M.Stmt.execute stmt [||]
+      >>= or_die "exec CREATE TABLE test_sqlstate"
+      >>= fun _ ->
+    M.Stmt.close stmt
+      >>= or_die "stmt close CREATE TABLE test_sqlstate"
+      >>= fun () ->
+
+    (* Test duplicate insertion of unique key. *)
+    M.prepare dbh "INSERT INTO test_sqlstate VALUES (?)"
+      >>= or_die "prepare in test_sqlstate"
+      >>= fun stmt ->
+    M.Stmt.execute stmt [|`Int 1|]
+      >>= or_die "first insert in test_sqlstate"
+      >>= fun _ ->
+    M.Stmt.execute stmt [|`Int 1|]
+      >>= then_die "second insert in test_sqlstate"
+      >>= fun () ->
+    assert (M.Stmt.sqlstate stmt <> "00000"); (* actually "23000" *)
+    M.Stmt.close stmt >>= or_die "stmt close in test_sqlstate"
+
   let test_insert_id () =
     connect () >>= or_die "connect" >>= fun dbh ->
     M.prepare dbh
@@ -344,6 +382,7 @@ struct
 
   let main () =
     test_server_properties () >>= fun () ->
+    test_sqlstate () >>= fun () ->
     test_insert_id () >>= fun () ->
     test_txn () >>= fun () ->
     test_many_select () >>= fun () ->