From a951a7584afb7c150c9ce57551bb62fa9a4a1acb Mon Sep 17 00:00:00 2001 From: zapashcanon Date: Sun, 7 Nov 2021 00:31:32 +0100 Subject: [PATCH] add db, user registering into db, format --- src/app.ml | 14 +++++++++ src/db.ml | 13 +++++++++ src/dune | 11 +++----- src/permap.ml | 23 +++++++-------- src/register.eml.html | 4 +-- src/user.ml | 66 ++++++++++++++++++++++++++++++------------- 6 files changed, 91 insertions(+), 40 deletions(-) create mode 100644 src/app.ml create mode 100644 src/db.ml diff --git a/src/app.ml b/src/app.ml new file mode 100644 index 0000000..519cd28 --- /dev/null +++ b/src/app.ml @@ -0,0 +1,14 @@ +module App_id = struct + let qualifier = "org" + + let organization = "Permap" + + let application = "permap" +end + +module Project_dirs = Directories.Project_dirs (App_id) + +let data_dir = + match Project_dirs.data_dir with + | None -> failwith "can't compute data directory" + | Some data_dir -> data_dir diff --git a/src/db.ml b/src/db.ml new file mode 100644 index 0000000..47806d7 --- /dev/null +++ b/src/db.ml @@ -0,0 +1,13 @@ +let db_root = App.data_dir + +let () = + match Bos.OS.Dir.create (Fpath.v db_root) with + | Ok true -> Dream.log "created %s" db_root + | Ok false -> Dream.log "%s already exists" db_root + | Error (`Msg _) -> + Dream.warning (fun log -> log "error when creating %s" db_root) + +let db = Filename.concat db_root "permap.db" + +let with_db ?mode ?mutex ?cache ?vfs ?timeout f = + Sqlite3_utils.with_db ?mode ?mutex ?cache ?vfs ?timeout db f diff --git a/src/dune b/src/dune index 43bf8a1..d217429 100644 --- a/src/dune +++ b/src/dune @@ -1,12 +1,9 @@ (executable (public_name permap) - (modules content login permap register template user) - (libraries - dream - emile - omd - lambdasoup) - (preprocess (pps lwt_ppx))) + (modules app content db login permap register template user) + (libraries bos directories dream emile omd sqlite3_utils lambdasoup) + (preprocess + (pps lwt_ppx))) (rule (targets template.ml) diff --git a/src/permap.ml b/src/permap.ml index daf9039..74536ed 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -45,22 +45,23 @@ let register _request = page_of_name "register" let () = Dream.run ~interface:"0.0.0.0" - @@ Dream.logger - @@ Dream.memory_sessions + @@ Dream.logger @@ Dream.memory_sessions @@ Dream.router [ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "") ; Dream.get "/" homepage - ; Dream.get "/register" (fun request -> render_unsafe (Register.f request)) + ; Dream.get "/register" (fun request -> + render_unsafe (Register.f request) ) ; Dream.post "/register" (fun request -> - match%lwt Dream.form request with - | `Ok ["email", email; "nick", nick; "password", password] -> - render_unsafe (Register.f ~nick ~email ~password request) - | _ -> assert false) + match%lwt Dream.form request with + | `Ok [ ("email", email); ("nick", nick); ("password", password) ] + -> + render_unsafe (Register.f ~nick ~email ~password request) + | _ -> assert false ) ; Dream.get "/login" (fun request -> render_unsafe (Login.f request)) ; Dream.post "/login" (fun request -> - match%lwt Dream.form request with - | `Ok ["nick", nick; "password", password] -> - render_unsafe (Login.f ~nick ~password request) - | _ -> assert false) + match%lwt Dream.form request with + | `Ok [ ("nick", nick); ("password", password) ] -> + render_unsafe (Login.f ~nick ~password request) + | _ -> assert false ) ] @@ Dream.not_found diff --git a/src/register.eml.html b/src/register.eml.html index 0704d13..ff1fbb4 100644 --- a/src/register.eml.html +++ b/src/register.eml.html @@ -2,10 +2,10 @@ let f ?email ?nick ?password request = % begin match email, nick, password with % | Some email, Some nick, Some password -> -% begin match User.make ~email ~nick ~password with +% begin match User.register ~email ~nick ~password with % | Error e -> Error: <%s e %> -% | Ok () -> +% | Ok _ -> User created ! % end; % | _ -> diff --git a/src/user.ml b/src/user.ml index d33c77f..056750e 100644 --- a/src/user.ml +++ b/src/user.ml @@ -1,35 +1,61 @@ -type t = { - nick: string; - password: string; - email: string option; -} +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) ) let login ~nick ~password = if nick = nick && password = password then - Ok () + Ok () else Error "DDD" -let make ~email ~nick ~password = - - let nick_escaped = String.escaped nick in +let register ~email ~nick ~password = (* TODO: remove bad characters (e.g. delthas) *) - let valid_nick = String.length nick < 64 && String.length nick > 0 && nick_escaped = nick in - - let valid_email = match Emile.of_string email with - | Ok _ -> true - | Error _ -> false + let valid_nick = + String.length nick < 64 + && String.length nick > 0 + && String.escaped nick = nick in - let valid_password = String.length password < 128 && String.length password > 0 in + let valid_email = + match Emile.of_string email with + | Ok _ -> true + | Error _ -> false + in + + let valid_password = + String.length password < 128 && String.length password > 0 + in let valid = valid_nick && valid_email && valid_password in (* TODO: HASH PASSWORD XD *) - - if valid then - (* TODO: add to db and check uniqueness of id *) - Ok () + if not valid then + Error "Something is wrong" else - Error "Something is wrong." + (* TODO: add check uniqueness of id *) + let open Sqlite3_utils in + 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))