Type safe database requests using Macaque

We will implement our database access function using the Macaque library, that allows easy manipulation of Postgresql database fully compatible with Lwt. (For more information see Macaque manual).

We will store the login and the password of users in a Postgresql database. For more information on how to set up and run it, see Postgresql manual.

When the base is up and running, we create the base by running in a shell:

$ createdb testbase

Then we create the users table, by executing this sql script:

CREATE TABLE users (
       login text NOT NULL,
       password text NOT NULL
);

We save it under create_table.sql and run

$ psql -d testbase -f create_table.sql

Macaque can use any thread library that provides a monadic interface. The default one provides simple blocking access to the database. It isn't good for us because an access to the base by one user will prevent the server from handling anything else until the request is finished. We need a version of Macaque specialised for Lwt. It is obtained by

module Lwt_thread = struct
  include Lwt
  include Lwt_chan
end
module Lwt_PGOCaml = PGOCaml_generic.Make(Lwt_thread)
module Lwt_Query = Query.Make_with_Db(Lwt_thread)(Lwt_PGOCaml)

We can now open the database with our newly created Lwt_PGOCaml.connect.

let get_db : unit -> unit Lwt_PGOCaml.t Lwt.t =
  let db_handler = ref None in
  fun () ->
    match !db_handler with
      | Some h -> Lwt.return h
      | None -> Lwt_PGOCaml.connect ~database:"testbase" ()

Then we declare the table on which we will work and the different requests we do on it.

let table = <:table< users (
  login text NOT NULL,
  password text NOT NULL
) >>

let find name =
  (get_db () >>= fun dbh ->
   Lwt_Query.view dbh
   <:view< {password = user_.password} |
            user_ in $table$;
            user_.login = $string:name$; >>)

let insert name pwd =
  get_db () >>= fun dbh ->
  Lwt_Query.query dbh
  <:insert< $table$ :=
    { login = $string:name$; password = $string:pwd$; } >>

Finally, we modify the handling code :

let check_pwd name pwd =
  (get_db () >>= fun dbh ->
   Lwt_Query.view dbh
   <:view< {password = user_.password} |
            user_ in $table$;
            user_.login = $string:name$;
	    user_.password = $string:pwd$ >>)
  >|= (function [] -> false | _ -> true)

let () = Eliom_registration.Action.register
  ~service:create_account_service
  (fun () (name, pwd) ->
    find name >>=
      (function
	| [] -> insert name pwd
	| _ -> Lwt.return ()) )

let () = Eliom_registration.Action.register
  ~service:connection_service
  (fun () (name, password) ->
    check_pwd name password >>=
      (function
	| true -> Eliom_reference.set username (Some name)
	| false -> Lwt.return ()))

We need to reference macaque in the Makefile :

SERVER_PACKAGE := macaque.syntax

and in ocsigenserver.conf :

<extension findlib-package="macaque"/>