add display nick

src/babillard.ml

@@ -12,6 +12,7 @@ type post =
   ; parent_id : string
   ; date : float
   ; nick : string
+  ; display_nick : string
   ; comment : string
   ; image_info : (string * string) option
   ; tags : string list
@@ -241,7 +242,7 @@ let () =
   if
     Array.exists Result.is_error
       (Array.map (fun query -> Db.exec query ()) tables)
-  then Dream.error (fun log -> log "can't create table")
+  then Dream.error (fun log -> log "can't create babillard's tables")
 
 let parse_image image =
   match image with
@@ -377,11 +378,13 @@ let build_reply ~comment ?image ~tags ?parent_id nick =
         in
         let date = Unix.time () in
         let comment, citations = parse_comment comment in
+        let* display_nick = User.get_display_nick nick in
         let reply =
           { id
           ; parent_id
           ; date
           ; nick
+          ; display_nick
           ; comment
           ; image_info
           ; tags = tag_list
@@ -432,6 +435,7 @@ let post_exist id = Result.is_ok (Db.find Q.get_is_post id)
 let get_post id =
   let^ parent_id = Db.find Q.get_post_thread id in
   let^ nick = Db.find Q.get_post_nick id in
+  let* display_nick = User.get_display_nick nick in
   let^ comment = Db.find Q.get_post_comment id in
   let^ date = Db.find Q.get_post_date id in
   let^ image_info = Db.find_opt Q.get_post_image_info id in
@@ -440,7 +444,17 @@ let get_post id =
   let^ replies = Db.collect_list Q.get_post_replies id in
   let^ citations = Db.collect_list Q.get_post_citations id in
   let reply =
-    { id; parent_id; date; nick; comment; image_info; tags; replies; citations }
+    { id
+    ; parent_id
+    ; date
+    ; nick
+    ; display_nick
+    ; comment
+    ; image_info
+    ; tags
+    ; replies
+    ; citations
+    }
   in
   Ok reply
 

src/content/assets/css/style.css

@@ -40,7 +40,7 @@ blockquote.blockquote {
   width: 100%;
 }
 
-.nick {
+.display-nick {
   color: #FFB300;
 }
 

src/permap.ml

@@ -186,10 +186,12 @@ let profile_get request =
   match Dream.session "nick" request with
   | None -> render_unsafe "Not logged in" request
   | Some nick ->
-    if User.exist nick then
+    let res =
-      let bio = match User.get_bio nick with Ok bio -> bio | Error e -> e in
+      match User.get_user nick with
-      render_unsafe (User_profile.f nick bio request) request
+      | Error e -> e
-    else Dream.respond ~status:`Not_Found "User does not exists"
+      | Ok user -> User_profile.f user request
+    in
+    render_unsafe res request
 
 let profile_post request =
   match Dream.session "nick" request with
@@ -203,6 +205,13 @@ let profile_post request =
           ~headers:[ ("Location", "/profile") ]
           "Your bio was updated!"
       | Error e -> render_unsafe e request )
+    | `Ok [ ("display-nick", display_nick) ] -> (
+      match User.update_display_nick display_nick nick with
+      | Ok () ->
+        Dream.respond ~status:`See_Other
+          ~headers:[ ("Location", "/profile") ]
+          "Your display nick was updated!"
+      | Error e -> render_unsafe e request )
     | `Ok _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
     | `Wrong_session _ | `Expired _ | `Wrong_content_type -> (
       match%lwt Dream.multipart request with

src/pp_babillard.ml

@@ -12,6 +12,7 @@ let pp_post fmt t =
       ; parent_id = _parent_id
       ; date
       ; nick
+      ; display_nick
       ; comment
       ; image_info
       ; tags
@@ -79,7 +80,7 @@ let pp_post fmt t =
     Format.fprintf fmt
       {|
     <div class="post-info">
-        <span class="nick">%s</span>
+        <span class="display-nick" data-nick="%s">%s</span>
         <span class="date" data-time="%f"></span>
         <div class="dropend post-menu-div">
           <a class="dropdown-toggle post-menu-link" href="#" role="button" id="dropdownMenuLink" data-bs-toggle="dropdown" aria-expanded="false">
@@ -92,7 +93,7 @@ let pp_post fmt t =
         </div>
         %a
     </div>|}
-      nick date id id id post_links_view ()
+      nick display_nick date id id id post_links_view ()
   in
 
   let pp_print_tag fmt tag =

src/user.ml

@@ -3,6 +3,7 @@ open Db
 
 type t =
   { nick : string
+  ; display_nick : string
   ; password : string
   ; email : string
   ; bio : string
@@ -12,8 +13,8 @@ type t =
 module Q = struct
   let create_user_table =
     Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS user (nick TEXT, password TEXT, email TEXT, \
+      "CREATE TABLE IF NOT EXISTS user (nick TEXT, display_nick TEXT, password \
-       bio TEXT, avatar BLOB, PRIMARY KEY(nick));"
+       TEXT, email TEXT, bio TEXT, avatar BLOB, PRIMARY KEY(nick));"
 
   let get_password =
     Caqti_request.find_opt Caqti_type.string Caqti_type.string
@@ -25,10 +26,11 @@ module Q = struct
       Caqti_type.int
       "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?);"
 
-  let inser_new_user =
+  let upload_user =
     Caqti_request.exec
-      Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
+      Caqti_type.(
-      "INSERT INTO user VALUES (?, ?, ?, ?, ?);"
+        tup4 string string string Caqti_type.(tup3 string string string))
+      "INSERT INTO user VALUES (?, ?, ?, ?, ?, ?);"
 
   let list_nicks =
     Caqti_request.collect Caqti_type.unit Caqti_type.string
@@ -36,7 +38,9 @@ module Q = struct
 
   let get_user =
     Caqti_request.find Caqti_type.string
-      Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
+      (* there is no "tup6" *)
+      Caqti_type.(
+        tup4 string string string Caqti_type.(tup3 string string string))
       "SELECT * FROM user WHERE nick=?;"
 
   let update_bio =
@@ -44,16 +48,35 @@ module Q = struct
       Caqti_type.(tup2 string string)
       "UPDATE user SET bio=? WHERE nick=?;"
 
+  let update_display_nick =
+    Caqti_request.exec
+      Caqti_type.(tup2 string string)
+      "UPDATE user SET display_nick=? WHERE nick=?;"
+
+  let update_email =
+    Caqti_request.exec
+      Caqti_type.(tup2 string string)
+      "UPDATE user SET email=? WHERE nick=?;"
+
+  let update_password =
+    Caqti_request.exec
+      Caqti_type.(tup2 string string)
+      "UPDATE user SET password=? WHERE nick=?;"
+
+  let get_display_nick =
+    Caqti_request.find Caqti_type.string Caqti_type.string
+      "SELECT display_nick FROM user WHERE nick=?;"
+
   let get_bio =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.string
+    Caqti_request.find Caqti_type.string Caqti_type.string
       "SELECT bio FROM user WHERE nick=?;"
 
   let get_email =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.string
+    Caqti_request.find Caqti_type.string Caqti_type.string
       "SELECT email FROM user WHERE nick=?;"
 
   let get_avatar =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.string
+    Caqti_request.find Caqti_type.string Caqti_type.string
       "SELECT avatar FROM user WHERE nick=?;"
 
   let upload_avatar =
@@ -84,10 +107,16 @@ let () =
   if
     Array.exists Result.is_error
       (Array.map (fun query -> Db.exec query ()) tables)
-  then Dream.error (fun log -> log "can't create table")
+  then Dream.error (fun log -> log "can't create user tables")
 
 let exist nick = Result.is_ok (Db.find Q.get_user nick)
 
+let get_user nick =
+  let^? nick, display_nick, password, (email, bio, avatar) =
+    Db.find_opt Q.get_user nick
+  in
+  Ok { nick; display_nick; password; email; bio; avatar }
+
 let is_banished nick = Result.is_ok (Db.find Q.get_banished nick)
 
 let login ~nick ~password request =
@@ -101,13 +130,13 @@ let login ~nick ~password request =
   else if is_banished nick then Error "YOU ARE BANISHED"
   else Error "wrong user name"
 
-let register ~email ~nick ~password =
+let valid_nick nick =
-  (* TODO: remove bad characters (e.g. delthas) *)
-  let valid_nick =
   String.length nick < 64
   && String.length nick > 0
   && Dream.html_escape nick = nick
-  in
+
+let register ~email ~nick ~password =
+  let valid_nick = valid_nick nick in
 
   let valid_email =
     match Emile.of_string email with Ok _ -> true | Error _ -> false
@@ -126,7 +155,7 @@ let register ~email ~nick ~password =
   else
     let^? nb = Db.find_opt Q.is_already_user (nick, email) in
     if nb = 0 then
-      let^ () = Db.exec Q.inser_new_user (nick, password, email, ("", "")) in
+      let^ () = Db.exec Q.upload_user (nick, nick, password, (email, "", "")) in
       Ok ()
     else Error "nick or email already exists"
 
@@ -140,7 +169,7 @@ let list () =
        users )
 
 let public_profile nick =
-  let^? nick, _password, _email, (bio, _) = Db.find_opt Q.get_user nick in
+  let* user = get_user nick in
   let user_info =
     Format.sprintf
       {|
@@ -155,7 +184,7 @@ let public_profile nick =
       </div>
     </div>
 |}
-      nick bio nick
+      user.nick user.bio user.nick
   in
   Ok user_info
 
@@ -180,6 +209,10 @@ let get_email nick =
   let^? email = Db.find_opt Q.get_email nick in
   Ok email
 
+let get_display_nick nick =
+  let^? display_nick = Db.find_opt Q.get_display_nick nick in
+  Ok display_nick
+
 let get_avatar nick =
   let^? avatar = Db.find_opt Q.get_avatar nick in
   if String.length avatar = 0 then Ok None else Ok (Some avatar)
@@ -201,3 +234,9 @@ let banish nick =
   let^ () = Db.exec Q.delete_user nick in
   let^ () = Db.exec Q.upload_banished (nick, email) in
   Ok ()
+
+let update_display_nick display_nick nick =
+  if valid_nick display_nick then
+    let^ () = Db.exec Q.update_display_nick (display_nick, nick) in
+    Ok ()
+  else Error "invalid display nick"

src/user_profile.eml.html

@@ -1,17 +1,26 @@
-let f nick bio request =
+let f (user: User.t) request =
-  <h1><%s  Format.sprintf "Hello %s !" nick %></h1>
+  <h1><%s  Format.sprintf "Hello %s !" user.nick %></h1>
-  <p>Check your <a href="/user/<%s nick %>">public profile rendering</a>.</p>
+  <p>Check your <a href="/user/<%s user.nick %>">public profile rendering</a>.</p>
   <h2>Edit profile</h2>
+  <%s! Dream.form_tag ~action:"/profile" request %>
+    <div class="mb-3">
+      <label for="display-nick" class="form-label">Change display name</label>
+      <input name="display-nick" type="text" class="form-control" id="display-nick" value="<%s! user.display_nick %>"></input>
+    </div>
+    <button type="submit" class="btn btn-primary">Save</button>
+  </form>
+  <br />
+  <br />
   <%s! Dream.form_tag ~action:"/profile" request %>
     <div class="mb-3">
       <label for="bio" class="form-label">Bio</label>
-      <textarea name="bio" type="text" class="form-control" id="bio" aria-describedby="bioHelp"><%s! bio %></textarea>
+      <textarea name="bio" type="text" class="form-control" id="bio" aria-describedby="bioHelp"><%s! user.bio %></textarea>
       <div id="bioHelp" class="form-text">Who are you?</div>
     </div>
     <button type="submit" class="btn btn-primary">Save</button>
   </form>
   <br />
-  <img src="/user/<%s nick %>/avatar" class="img-thumbnail" alt="Your avatar picture" />
+  <img src="/user/<%s user.nick %>/avatar" class="img-thumbnail" alt="Your avatar picture" />
   <br />
   <br />
   <%s! Dream.form_tag ~action:"/profile" ~enctype:`Multipart_form_data request %>