From c7aa8aaad71dc2046a884f5f47d47795a070b463 Mon Sep 17 00:00:00 2001 From: pena Date: Sun, 7 Nov 2021 10:21:01 +0100 Subject: [PATCH] set up user session on login --- src/login.eml.html | 2 +- src/permap.ml | 25 +++++++++++++------------ src/template.eml.html | 9 ++++++++- src/user.ml | 6 +++++- 4 files changed, 27 insertions(+), 15 deletions(-) diff --git a/src/login.eml.html b/src/login.eml.html index 57c1e19..9968db5 100644 --- a/src/login.eml.html +++ b/src/login.eml.html @@ -2,7 +2,7 @@ let f ?nick ?password request = % begin match nick, password with % | Some nick, Some password -> -% begin match User.login ~nick ~password with +% begin match User.login ~nick ~password request with % | Error e -> Error: <%s e %> % | Ok () -> diff --git a/src/permap.ml b/src/permap.ml index 85852a7..780cce8 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -6,7 +6,7 @@ let get_title content = with | Failure _e -> "Permap" -let render ?title content = +let render ?title content request = let title = match title with | None -> get_title content @@ -15,14 +15,15 @@ let render ?title content = Dream.html @@ Template.render_unsafe ~title:(Dream.html_escape title) ~content:(Dream.html_escape content) + request -let render_unsafe ?title content = +let render_unsafe ?title content request = let title = match title with | None -> get_title content | Some title -> title in - Dream.html @@ Template.render_unsafe ~title ~content + Dream.html @@ Template.render_unsafe ~title ~content request let asset_loader _root path _request = match Content.read ("assets/" ^ path) with @@ -34,32 +35,32 @@ let page path = | None -> None | Some page -> Some (Omd.of_string page |> Omd.to_html) -let page_of_name name = +let page_of_name name request = match page name with | None -> Dream.empty `Not_Found - | Some content -> render_unsafe content + | Some content -> render_unsafe content request -let homepage _request = page_of_name "index" +let homepage request = page_of_name "index" request -let register_get request = render_unsafe (Register.f request) +let register_get request = render_unsafe (Register.f request) request let register_post request = match%lwt Dream.form request with | `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> - render_unsafe (Register.f ~nick ~email ~password request) + render_unsafe (Register.f ~nick ~email ~password request) request | _ -> assert false -let login_get request = render_unsafe (Login.f request) +let login_get request = render_unsafe (Login.f request) request let login_post request = match%lwt Dream.form request with | `Ok [ ("nick", nick); ("password", password) ] -> - render_unsafe (Login.f ~nick ~password request) + render_unsafe (Login.f ~nick ~password request) request | _ -> assert false -let user _request = render_unsafe (User.list ()) +let user request = render_unsafe (User.list ()) request -let user_profile request = render_unsafe (User.profile request) +let user_profile request = render_unsafe (User.profile request) request let () = Dream.run ~interface:"0.0.0.0" diff --git a/src/template.eml.html b/src/template.eml.html index 3a1cef9..b6249e8 100644 --- a/src/template.eml.html +++ b/src/template.eml.html @@ -1,4 +1,4 @@ -let render_unsafe ~title ~content = +let render_unsafe ~title ~content request = @@ -20,12 +20,19 @@ let render_unsafe ~title ~content = +% begin match Dream.session "nick" request with +% | None -> +% | Some nick -> + +% end; diff --git a/src/user.ml b/src/user.ml index 8f819a2..2772fca 100644 --- a/src/user.ml +++ b/src/user.ml @@ -18,7 +18,7 @@ let () = Dream.warning (fun log -> log "can't create table user: %s" (Sqlite3.Rc.to_string e) ) -let login ~nick ~password = +let login ~nick ~password request = let open Sqlite3_utils in let good_password = Db.with_db (fun db -> @@ -28,6 +28,10 @@ let login ~nick ~password = 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"