clean code

src/dune

@@ -5,11 +5,11 @@
   asset
   content
   pellest
-  util
   template
   home
   register
   login
+  logout
   user
   syntax
   db

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

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

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

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
          ]

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

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

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)

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 ()