diff --git a/src/dune b/src/dune index ce55c43..ba4e8db 100644 --- a/src/dune +++ b/src/dune @@ -5,11 +5,11 @@ asset content pellest - util template home register login + logout user syntax db diff --git a/src/home.ml b/src/home.ml index 5a0c562..741aea4 100644 --- a/src/home.ml +++ b/src/home.ml @@ -1,9 +1,15 @@ open Tyxml.Html -let get _request = +let get request = let title = "Pellest is the best game ever!" in let about = div [ txt App.about ] in let register_link = div [ a ~a:[ a_href "/register" ] [ txt "Register" ] ] in let login_link = div [ a ~a:[ a_href "/login" ] [ txt "Login" ] ] in - let page = div [ about; login_link; register_link ] in + let logout_link = div [ a ~a:[ a_href "/logout" ] [ txt "Logout" ] ] in + let page = + div + @@ + if User.is_logged_in request then [ about; logout_link ] + else [ about; login_link; register_link ] + in Template.render ~title ~scripts:[] page diff --git a/src/login.ml b/src/login.ml index da927b2..d6a83b8 100644 --- a/src/login.ml +++ b/src/login.ml @@ -1,12 +1,16 @@ open Tyxml.Html open Tyx_util +open Syntax let get request = + let** () = User.assert_not_logged request in let title = "Pellest|Login" in let login = let submit = button ~a:[ a_id "submit_login" ] [ txt "submit" ] in - let login = make_input_text "login" in - let password = make_input_text "password" in + let login = input ~a:[ a_id "login"; a_name "login"; a_input_type `Text ] () in + let password = + input ~a:[ a_id "password"; a_name "password"; a_input_type `Password ] () + in div [ make_form request ~action:"/login" ~items:[ login; password; submit ] ] in @@ -15,7 +19,7 @@ let get request = Template.render ~title ~scripts:[] page let post request = - let open Syntax in + let** () = User.assert_not_logged request in match%lwt Dream.form request with | `Ok [ ("login", login); ("password", password) ] -> let** () = User.login ~login ~password request in diff --git a/src/logout.ml b/src/logout.ml new file mode 100644 index 0000000..97a8a30 --- /dev/null +++ b/src/logout.ml @@ -0,0 +1,8 @@ +open Syntax + +let get request = + let** () = User.asserd_logged request in + let title = "Logout" in + let%lwt () = Dream.invalidate_session request in + let page = Tyxml.Html.txt "logged out" in + Template.render ~title ~scripts:[] page diff --git a/src/pellest.ml b/src/pellest.ml index 0c45150..b40e123 100644 --- a/src/pellest.ml +++ b/src/pellest.ml @@ -1,13 +1,13 @@ let () = let logger = if App.log then Dream.logger else Fun.id in - Dream.run ~port:App.port ~error_handler:(Dream.error_template Template.error) - @@ logger @@ Dream.memory_sessions + Dream.run ~port:App.port @@ logger @@ Dream.memory_sessions @@ Dream.router Dream. [ get "/assets/**" Asset.get ; get "/" Home.get ; get "/login" Login.get ; post "/login" Login.post + ; get "logout" Logout.get ; get "/register" Register.get ; post "/register" Register.post ] diff --git a/src/register.ml b/src/register.ml index 08da6a6..700cb89 100644 --- a/src/register.ml +++ b/src/register.ml @@ -1,13 +1,19 @@ open Tyxml.Html open Tyx_util +open Syntax let get request = + let** () = User.assert_not_logged request in let title = "Pellest|Register" in let register = let submit = button ~a:[ a_id "submet_reginster" ] [ txt "submit" ] in - let nick = make_input_text "nick" in - let password = make_input_text "password" in - let email = make_input_text "email" in + let nick = input ~a:[ a_id "nick"; a_name "nick"; a_input_type `Text ] () in + let password = + input ~a:[ a_id "password"; a_name "password"; a_input_type `Password ] () + in + let email = + input ~a:[ a_id "email"; a_name "email"; a_input_type `Text ] () + in div [ make_form request ~action:"/register" ~items:[ nick; password; email; submit ] @@ -18,7 +24,7 @@ let get request = Template.render ~title ~scripts:[] page let post request = - let open Syntax in + let** () = User.assert_not_logged request in match%lwt Dream.form request with | `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> let** () = User.register ~email ~nick ~password in diff --git a/src/template.ml b/src/template.ml index 23e5266..fa99a35 100644 --- a/src/template.ml +++ b/src/template.ml @@ -20,16 +20,3 @@ let render ~title ~scripts content = let err (status, msg) = let code = Dream.status_to_int status in Dream.html ~code @@ generic ~page_title:"Error" ~scripts:[] (Html.txt msg) - -let error _error _debug_info suggested_response = - let status = Dream.status suggested_response in - let code = Dream.status_to_int status in - let reason = Dream.status_to_string status in - - Dream.set_header suggested_response "Content-Type" Dream.text_html; - - let content = Html.txt @@ Format.sprintf "%d: %s" code reason in - let body = generic ~page_title:"Error" ~scripts:[] content in - - Dream.set_body suggested_response body; - Lwt.return suggested_response diff --git a/src/tyx_util.ml b/src/tyx_util.ml index 0d71f9d..5a27465 100644 --- a/src/tyx_util.ml +++ b/src/tyx_util.ml @@ -5,8 +5,6 @@ let csrf_tag request = let token = Dream.csrf_token request in input ~a:[ a_name "dream.csrf"; a_input_type `Hidden; a_value token ] () -let make_input_text id = input ~a:[ a_id id; a_name id; a_input_type `Text ] () - let make_form request ~action ~items = (* TODO labels ...? *) form ~a:[ a_action action; a_method `Post ] (csrf_tag request :: items) diff --git a/src/user.ml b/src/user.ml index 357c6b0..752f6bd 100644 --- a/src/user.ml +++ b/src/user.ml @@ -158,6 +158,8 @@ let list () = ) users ) +let is_logged_in request = Option.is_some @@ Dream.session "nick" request + let profile request = match Dream.session "nick" request with | None -> "not logged in" @@ -211,3 +213,11 @@ let public_profile user_id = user.nick user.nick in Ok user_info + +let asserd_logged request = + if is_logged_in request then Ok () + else Error (`Forbidden, "you should be logged in") + +let assert_not_logged request = + if is_logged_in request then Error (`Forbidden, "you shoudn't be logged in") + else Ok () diff --git a/src/util.ml b/src/util.ml deleted file mode 100644 index e69de29..0000000