swrup/geochan
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

add display nick

Browse source
This commit is contained in:
Swrup 2022-03-06 19:23:52 +01:00
parent cb12b4a2a8
commit e4498a64a9
6 changed files with 105 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/babillard.ml
View file

@ -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

2
src/content/assets/css/style.css
View file

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

17
src/permap.ml
View file

@ -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

5
src/pp_babillard.ml
View file

@ -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 =

77
src/user.ml
View file

@ -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 =
</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"

19
src/user_profile.eml.html
View file

@ -1,17 +1,26 @@
let f nick bio request =
<h1><%s Format.sprintf "Hello %s !" nick %></h1>
<p>Check your <a href="/user/<%s nick %>">public profile rendering</a>.</p>
let f (user: User.t) request =
<h1><%s Format.sprintf "Hello %s !" user.nick %></h1>
<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 %>