add db, user registering into db, format
This commit is contained in:
parent
6c64dcfffd
commit
82e65cfad4
6 changed files with 91 additions and 40 deletions
14
src/app.ml
Normal file
14
src/app.ml
Normal file
|
|
@ -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
|
||||||
13
src/db.ml
Normal file
13
src/db.ml
Normal file
|
|
@ -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
|
||||||
11
src/dune
11
src/dune
|
|
@ -1,12 +1,9 @@
|
||||||
(executable
|
(executable
|
||||||
(public_name permap)
|
(public_name permap)
|
||||||
(modules content login permap register template user)
|
(modules app content db login permap register template user)
|
||||||
(libraries
|
(libraries bos directories dream emile omd sqlite3_utils lambdasoup)
|
||||||
dream
|
(preprocess
|
||||||
emile
|
(pps lwt_ppx)))
|
||||||
omd
|
|
||||||
lambdasoup)
|
|
||||||
(preprocess (pps lwt_ppx)))
|
|
||||||
|
|
||||||
(rule
|
(rule
|
||||||
(targets template.ml)
|
(targets template.ml)
|
||||||
|
|
|
||||||
|
|
@ -45,22 +45,23 @@ let register _request = page_of_name "register"
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
Dream.run ~interface:"0.0.0.0"
|
Dream.run ~interface:"0.0.0.0"
|
||||||
@@ Dream.logger
|
@@ Dream.logger @@ Dream.memory_sessions
|
||||||
@@ Dream.memory_sessions
|
|
||||||
@@ Dream.router
|
@@ Dream.router
|
||||||
[ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
|
[ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
|
||||||
; Dream.get "/" homepage
|
; 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 ->
|
; Dream.post "/register" (fun request ->
|
||||||
match%lwt Dream.form request with
|
match%lwt Dream.form request with
|
||||||
| `Ok ["email", email; "nick", nick; "password", password] ->
|
| `Ok [ ("email", email); ("nick", nick); ("password", password) ]
|
||||||
render_unsafe (Register.f ~nick ~email ~password request)
|
->
|
||||||
| _ -> assert false)
|
render_unsafe (Register.f ~nick ~email ~password request)
|
||||||
|
| _ -> assert false )
|
||||||
; Dream.get "/login" (fun request -> render_unsafe (Login.f request))
|
; Dream.get "/login" (fun request -> render_unsafe (Login.f request))
|
||||||
; Dream.post "/login" (fun request ->
|
; Dream.post "/login" (fun request ->
|
||||||
match%lwt Dream.form request with
|
match%lwt Dream.form request with
|
||||||
| `Ok ["nick", nick; "password", password] ->
|
| `Ok [ ("nick", nick); ("password", password) ] ->
|
||||||
render_unsafe (Login.f ~nick ~password request)
|
render_unsafe (Login.f ~nick ~password request)
|
||||||
| _ -> assert false)
|
| _ -> assert false )
|
||||||
]
|
]
|
||||||
@@ Dream.not_found
|
@@ Dream.not_found
|
||||||
|
|
|
||||||
|
|
@ -2,10 +2,10 @@ let f ?email ?nick ?password request =
|
||||||
|
|
||||||
% begin match email, nick, password with
|
% begin match email, nick, password with
|
||||||
% | Some email, Some nick, Some password ->
|
% | 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 e ->
|
||||||
Error: <%s e %>
|
Error: <%s e %>
|
||||||
% | Ok () ->
|
% | Ok _ ->
|
||||||
User created !
|
User created !
|
||||||
% end;
|
% end;
|
||||||
% | _ ->
|
% | _ ->
|
||||||
|
|
|
||||||
66
src/user.ml
66
src/user.ml
|
|
@ -1,35 +1,61 @@
|
||||||
type t = {
|
type t =
|
||||||
nick: string;
|
{ nick : string
|
||||||
password: string;
|
; password : string
|
||||||
email: string option;
|
; 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 =
|
let login ~nick ~password =
|
||||||
if nick = nick && password = password then
|
if nick = nick && password = password then
|
||||||
Ok ()
|
Ok ()
|
||||||
else
|
else
|
||||||
Error "DDD"
|
Error "DDD"
|
||||||
|
|
||||||
let make ~email ~nick ~password =
|
let register ~email ~nick ~password =
|
||||||
|
|
||||||
let nick_escaped = String.escaped nick in
|
|
||||||
(* TODO: remove bad characters (e.g. delthas) *)
|
(* TODO: remove bad characters (e.g. delthas) *)
|
||||||
let valid_nick = String.length nick < 64 && String.length nick > 0 && nick_escaped = nick in
|
let valid_nick =
|
||||||
|
String.length nick < 64
|
||||||
let valid_email = match Emile.of_string email with
|
&& String.length nick > 0
|
||||||
| Ok _ -> true
|
&& String.escaped nick = nick
|
||||||
| Error _ -> false
|
|
||||||
in
|
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
|
let valid = valid_nick && valid_email && valid_password in
|
||||||
|
|
||||||
(* TODO: HASH PASSWORD XD *)
|
(* TODO: HASH PASSWORD XD *)
|
||||||
|
if not valid then
|
||||||
if valid then
|
Error "Something is wrong"
|
||||||
(* TODO: add to db and check uniqueness of id *)
|
|
||||||
Ok ()
|
|
||||||
else
|
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))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue