diff --git a/src/dune b/src/dune index c80f969..5607817 100644 --- a/src/dune +++ b/src/dune @@ -2,6 +2,8 @@ (public_name permap) (modules app content db login permap register template user user_profile) (libraries + caqti.blocking + caqti-driver-sqlite3 bos directories dream diff --git a/src/user.ml b/src/user.ml index 335459f..0448883 100644 --- a/src/user.ml +++ b/src/user.ml @@ -6,40 +6,90 @@ type t = ; avatar : string } +module Q = struct + let create_user_table = + Caqti_request.exec Caqti_type.unit + {| + CREATE TABLE IF NOT EXISTS user ( + nick TEXT, + password TEXT, + email TEXT, + bio TEXT, + avatar BLOB + ); + |} + + let get_password = + Caqti_request.find_opt Caqti_type.string Caqti_type.string + "SELECT password FROM user WHERE nick=?;" + + let find_user = + Caqti_request.find_opt + Caqti_type.(tup2 string string) + Caqti_type.unit + "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?);" + + let inser_new_user = + Caqti_request.exec + Caqti_type.(tup4 string string string Caqti_type.(tup2 string string)) + "INSERT INTO user VALUES (?, ?, ?, ?, ?);" + + let list_nicks = + Caqti_request.collect Caqti_type.unit Caqti_type.string + "SELECT nick FROM user;" + + let get_user = + Caqti_request.find_opt Caqti_type.string + Caqti_type.(tup4 string string string Caqti_type.(tup2 string string)) + "SELECT * FROM user WHERE nick=?;" + + let update_bio = + Caqti_request.exec + Caqti_type.(tup2 string string) + "UPDATE user SET bio=? WHERE nick=?;" + + let get_bio = + Caqti_request.find_opt Caqti_type.string Caqti_type.string + "SELECT bio FROM user WHERE nick=?;" + + let get_avatar = + Caqti_request.find_opt Caqti_type.string Caqti_type.string + "SELECT avatar FROM user WHERE nick=?;" + + let upload_avatar = + Caqti_request.exec + Caqti_type.(tup2 string string) + "UPDATE user SET avatar=? WHERE nick=?;" +end + +module Db = +( val Caqti_blocking.connect (Uri.of_string (Filename.concat "sqlite3://" Db.db)) + |> Caqti_blocking.or_fail ) + let () = - let open Sqlite3_utils in - let res = - Db.with_db (fun db -> - exec0 db - "CREATE TABLE IF NOT EXISTS user (nick TEXT, password TEXT, email \ - TEXT, bio TEXT, avatar BLOB);" ) - in + let res = Db.exec Q.create_user_table () in match res with | Ok () -> () | Error e -> Dream.warning (fun log -> - log "can't create table user: %s" (Sqlite3.Rc.to_string e) ) + log "can't create table user: %s" (Caqti_error.show e) ) let login ~nick ~password request = - let open Sqlite3_utils in - let good_password = - Db.with_db (fun db -> - exec_raw_args db "SELECT password FROM user WHERE nick=?;" - [| Data.TEXT nick |] ~f:Cursor.to_list ) - in + let good_password = Db.find_opt Q.get_password nick in match good_password with - | Ok [ [| Data.TEXT good_password |] ] -> - if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then - let _ = - let%lwt () = Dream.invalidate_session request in - Dream.put_session "nick" nick request - in - Ok () - else - Error "wrong password" - | Ok [] -> Error (Format.sprintf "user `%s` doesn't exist" nick) - | Ok _ -> Error "incoherent db answer" - | Error e -> Error (Format.sprintf "db error: %s" (Rc.to_string e)) + | Ok foo -> ( + match foo with + | Some good_password -> + if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then + let _ = + let%lwt () = Dream.invalidate_session request in + Dream.put_session "nick" nick request + in + Ok () + else + Error "wrong password" + | None -> Error (Format.sprintf "user `%s` doesn't exist" nick) ) + | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) let register ~email ~nick ~password = (* TODO: remove bad characters (e.g. delthas) *) @@ -67,73 +117,44 @@ let register ~email ~nick ~password = if not valid then Error "Something is wrong" else - let open Sqlite3_utils in - let unique = - Db.with_db (fun db -> - exec_raw_args db - "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?);" - [| Data.TEXT nick; Data.TEXT email |] - ~f:Cursor.to_list ) - in + let unique = Db.find_opt Q.find_user (nick, email) in match unique with - | Ok [ [| Data.INT 0L |] ] -> ( - let res = - Db.with_db (fun db -> - exec_raw_args db "INSERT INTO user VALUES (?, ?, ?, ?, ?);" - [| Data.TEXT nick - ; Data.TEXT password - ; Data.TEXT email - ; Data.TEXT "" - ; Data.BLOB "" - |] - ~f:Cursor.to_list ) - in - match res with - | Ok res -> Ok res - | Error e -> Error (Format.sprintf "db error: %s" (Rc.to_string e)) ) - | Ok _ -> Error "nick or email already exists" - | Error e -> Error (Format.sprintf "db error: %s" (Rc.to_string e)) + | Ok unique -> ( + match unique with + | Some _ -> Error "nick or email already exists" + | None -> ( + let res = Db.exec Q.inser_new_user (nick, password, email, ("", "")) in + match res with + | Ok res -> Ok res + | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) + ) ) + | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) let list () = - let open Sqlite3_utils in - let users = - Db.with_db (fun db -> - exec_raw_args db "SELECT nick FROM user;" [||] ~f:Cursor.to_list ) - in + let users = Db.fold Q.list_nicks (fun nick acc -> nick :: acc) () [] in match users with - | Error e -> Format.sprintf "db error: %s" (Rc.to_string e) | Ok users -> Format.asprintf "