diff --git a/src/babillard.ml b/src/babillard.ml
index b83c635..6ad58d5 100644
--- a/src/babillard.ml
+++ b/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
diff --git a/src/content/assets/css/style.css b/src/content/assets/css/style.css
index 87a9198..a65e21c 100644
--- a/src/content/assets/css/style.css
+++ b/src/content/assets/css/style.css
@@ -40,7 +40,7 @@ blockquote.blockquote {
width: 100%;
}
-.nick {
+.display-nick {
color: #FFB300;
}
diff --git a/src/permap.ml b/src/permap.ml
index f20dfda..8b98fb2 100644
--- a/src/permap.ml
+++ b/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 bio = match User.get_bio nick with Ok bio -> bio | Error e -> e in
- render_unsafe (User_profile.f nick bio request) request
- else Dream.respond ~status:`Not_Found "User does not exists"
+ let res =
+ match User.get_user nick with
+ | Error e -> e
+ | 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
diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml
index b937b41..0b6c69c 100644
--- a/src/pp_babillard.ml
+++ b/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
{|
|}
- 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 =
diff --git a/src/user.ml b/src/user.ml
index 7f103ab..51241f5 100644
--- a/src/user.ml
+++ b/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, \
- bio TEXT, avatar BLOB, PRIMARY KEY(nick));"
+ "CREATE TABLE IF NOT EXISTS user (nick TEXT, display_nick TEXT, password \
+ 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))
- "INSERT INTO user VALUES (?, ?, ?, ?, ?);"
+ Caqti_type.(
+ 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 valid_nick nick =
+ String.length nick < 64
+ && String.length nick > 0
+ && Dream.html_escape nick = nick
+
let register ~email ~nick ~password =
- (* 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 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 =
|}
- 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"
diff --git a/src/user_profile.eml.html b/src/user_profile.eml.html
index 75d3327..edfa795 100644
--- a/src/user_profile.eml.html
+++ b/src/user_profile.eml.html
@@ -1,17 +1,26 @@
-let f nick bio request =
-