2021-11-07 00:31:32 +01:00
|
|
|
type t =
|
|
|
|
|
{ nick : string
|
|
|
|
|
; password : string
|
|
|
|
|
; email : string (* TODO: make email optional ? *)
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
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);" )
|
|
|
|
|
in
|
|
|
|
|
match res with
|
|
|
|
|
| Ok () -> ()
|
|
|
|
|
| Error e ->
|
|
|
|
|
Dream.warning (fun log ->
|
|
|
|
|
log "can't create table user: %s" (Sqlite3.Rc.to_string e) )
|
2021-11-05 16:55:19 +01:00
|
|
|
|
|
|
|
|
let login ~nick ~password =
|
|
|
|
|
if nick = nick && password = password then
|
2021-11-07 00:31:32 +01:00
|
|
|
Ok ()
|
2021-11-05 16:55:19 +01:00
|
|
|
else
|
|
|
|
|
Error "DDD"
|
|
|
|
|
|
2021-11-07 00:31:32 +01:00
|
|
|
let register ~email ~nick ~password =
|
2021-11-05 16:55:19 +01:00
|
|
|
(* TODO: remove bad characters (e.g. delthas) *)
|
2021-11-07 00:31:32 +01:00
|
|
|
let valid_nick =
|
|
|
|
|
String.length nick < 64
|
|
|
|
|
&& String.length nick > 0
|
|
|
|
|
&& String.escaped nick = nick
|
|
|
|
|
in
|
2021-11-05 16:55:19 +01:00
|
|
|
|
2021-11-07 00:31:32 +01:00
|
|
|
let valid_email =
|
|
|
|
|
match Emile.of_string email with
|
|
|
|
|
| Ok _ -> true
|
|
|
|
|
| Error _ -> false
|
2021-11-05 16:55:19 +01:00
|
|
|
in
|
|
|
|
|
|
2021-11-07 00:31:32 +01:00
|
|
|
let valid_password =
|
|
|
|
|
String.length password < 128 && String.length password > 0
|
|
|
|
|
in
|
2021-11-05 16:55:19 +01:00
|
|
|
|
|
|
|
|
let valid = valid_nick && valid_email && valid_password in
|
|
|
|
|
|
|
|
|
|
(* TODO: HASH PASSWORD XD *)
|
2021-11-07 00:31:32 +01:00
|
|
|
if not valid then
|
|
|
|
|
Error "Something is wrong"
|
2021-11-05 16:55:19 +01:00
|
|
|
else
|
2021-11-07 00:31:32 +01:00
|
|
|
let open Sqlite3_utils in
|
2021-11-07 00:54:35 +01:00
|
|
|
let unique =
|
2021-11-07 00:31:32 +01:00
|
|
|
Db.with_db (fun db ->
|
2021-11-07 00:54:35 +01:00
|
|
|
exec_raw_args db
|
|
|
|
|
"SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?);"
|
|
|
|
|
[| Data.TEXT nick; Data.TEXT email |]
|
2021-11-07 00:31:32 +01:00
|
|
|
~f:Cursor.to_list )
|
|
|
|
|
in
|
2021-11-07 00:54:35 +01:00
|
|
|
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 |]
|
|
|
|
|
~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"
|
2021-11-07 00:31:32 +01:00
|
|
|
| Error e -> Error (Format.sprintf "db error: %s" (Rc.to_string e))
|
2021-11-07 01:32:38 +01:00
|
|
|
|
2021-11-07 01:42:18 +01:00
|
|
|
let list () =
|
2021-11-07 01:32:38 +01:00
|
|
|
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
|
|
|
|
|
match users with
|
|
|
|
|
| Error e -> Format.sprintf "db error: %s" (Rc.to_string e)
|
|
|
|
|
| Ok users ->
|
|
|
|
|
Format.asprintf "<ul>%a</ul>"
|
|
|
|
|
(Format.pp_print_list (fun fmt -> function
|
|
|
|
|
| [| Data.TEXT s |] ->
|
|
|
|
|
Format.fprintf fmt {|<li><a href="/user/%s">%s</a></li>|} s s
|
|
|
|
|
| _ -> failwith "error" ) )
|
|
|
|
|
users
|
2021-11-07 01:42:18 +01:00
|
|
|
|
|
|
|
|
let profile request =
|
|
|
|
|
let nick = Dream.param "user" request in
|
|
|
|
|
let open Sqlite3_utils in
|
|
|
|
|
let user =
|
|
|
|
|
Db.with_db (fun db ->
|
2021-11-07 01:42:43 +01:00
|
|
|
exec_raw_args db "SELECT * FROM user WHERE nick=?;" [| Data.TEXT nick |]
|
|
|
|
|
~f:Cursor.to_list )
|
2021-11-07 01:42:18 +01:00
|
|
|
in
|
|
|
|
|
match user with
|
2021-11-07 01:42:43 +01:00
|
|
|
| Ok [ [| Data.TEXT nick; Data.TEXT password; Data.TEXT email |] ] ->
|
|
|
|
|
Format.sprintf "nick = `%s`; password = `%s`; email = `%s`" nick password
|
|
|
|
|
email
|
2021-11-07 01:42:18 +01:00
|
|
|
| Ok _ -> "incoherent db answer"
|
|
|
|
|
| Error e -> Format.sprintf "db error: %s" (Rc.to_string e)
|