diff --git a/src/babillard.ml b/src/babillard.ml index 6ad58d5..3827c0b 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -24,14 +24,6 @@ type t = | Op of thread_data * post | Post of post -let unwrap_list f ids = - let l = List.map f ids in - let res = List.find_opt Result.is_error l in - match res with - | None -> Ok (List.map Result.get_ok l) - | Some (Ok _) -> assert false - | Some (Error _e as error) -> error - module Q = struct let create_post_user_table = Caqti_request.exec Caqti_type.unit diff --git a/src/bindings.ml b/src/bindings.ml index 5a6f374..aca03fc 100644 --- a/src/bindings.ml +++ b/src/bindings.ml @@ -12,3 +12,11 @@ let ( let^ ) o f = | Ok x -> f x let ( let* ) o f = Result.fold ~ok:f ~error:Result.error o + +let unwrap_list f ids = + let l = List.map f ids in + let res = List.find_opt Result.is_error l in + match res with + | None -> Ok (List.map Result.get_ok l) + | Some (Ok _) -> assert false + | Some (Error _e as error) -> error diff --git a/src/login.eml.html b/src/login.eml.html index 11b8207..89cf27c 100644 --- a/src/login.eml.html +++ b/src/login.eml.html @@ -9,8 +9,8 @@ let f request = <%s! Dream.form_tag ~action:url request %>
- -
Who are u ?
+ +
What is you nickname?
diff --git a/src/permap.ml b/src/permap.ml index f1fb6b9..25db0f9 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -268,6 +268,14 @@ let profile_post request = ~headers:[ ("Location", "/profile") ] "Your display nick was updated!" | Error e -> render_unsafe e request ) + | `Ok [ ("content", content); ("count", count); ("label", label) ] -> ( + let count = int_of_string count in + match User.update_metadata count label content 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/user.ml b/src/user.ml index 18d2a3a..de3b88a 100644 --- a/src/user.ml +++ b/src/user.ml @@ -8,6 +8,7 @@ type t = ; email : string ; bio : string ; avatar : string + ; metadata : (int * string * string) list } module Q = struct @@ -16,6 +17,31 @@ module Q = struct "CREATE TABLE IF NOT EXISTS user (nick TEXT, display_nick TEXT, password \ TEXT, email TEXT, bio TEXT, avatar BLOB, PRIMARY KEY(nick));" + let create_banished_table = + Caqti_request.exec Caqti_type.unit + "CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT);" + + let create_metadata_table = + Caqti_request.exec Caqti_type.unit + "CREATE TABLE IF NOT EXISTS metadata (nick TEXT, count INT, label TEXT, \ + content TEXT, FOREIGN KEY(nick) REFERENCES user(nick) ON DELETE \ + CASCADE);" + + let get_metadata = + Caqti_request.collect Caqti_type.string + Caqti_type.(tup3 int string string) + "SELECT count, label, content FROM metadata WHERE nick=?;" + + let upload_metadata = + Caqti_request.exec + Caqti_type.(tup4 string int string string) + "INSERT INTO metadata VALUES (?, ?, ?, ?);" + + let delete_metadata = + Caqti_request.exec + Caqti_type.(tup2 string int) + "DELETE FROM metadata WHERE nick=? AND count=?;" + let get_password = Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT password FROM user WHERE nick=?;" @@ -84,10 +110,6 @@ module Q = struct Caqti_type.(tup2 string string) "UPDATE user SET avatar=? WHERE nick=?;" - let create_banished_table = - Caqti_request.exec Caqti_type.unit - "CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT);" - let delete_user = Caqti_request.exec Caqti_type.string "DELETE FROM user WHERE nick=?;" @@ -103,7 +125,9 @@ module Q = struct end let () = - let tables = [| Q.create_user_table; Q.create_banished_table |] in + let tables = + [| Q.create_user_table; Q.create_banished_table; Q.create_metadata_table |] + in if Array.exists Result.is_error (Array.map (fun query -> Db.exec query ()) tables) @@ -111,11 +135,17 @@ let () = let exist nick = Result.is_ok (Db.find Q.get_user nick) +let get_metadata nick = + let^ metadata = Db.collect_list Q.get_metadata nick in + let metadata = List.sort (fun (a, _, _) (b, _, _) -> compare a b) metadata in + Ok metadata + 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* metadata = get_metadata nick in + Ok { nick; display_nick; password; email; bio; avatar; metadata } let is_banished nick = Result.is_ok (Db.find Q.get_banished nick) @@ -164,26 +194,6 @@ let list () = ) users ) -let public_profile nick = - let* user = get_user nick in - let user_info = - Format.sprintf - {| -

%s

-
-
-
-
%s
-
-
- Your avatar picture -
-
-|} - user.nick user.bio user.nick - in - Ok user_info - let profile request = match Dream.session "nick" request with | None -> "not logged in" @@ -254,3 +264,107 @@ let update_password password nick = let^ () = Db.exec Q.update_password (password, nick) in Ok () else Error "invalid password" + +let update_metadata count label content nick = + let label = Dream.html_escape label in + let content = Dream.html_escape content in + if String.length label > 200 || String.length content > 400 then + Error "label or content is too long" + else + (* rewrite all user's metadata *) + let* metadata = get_metadata nick in + let^ _unit_list = + unwrap_list + (fun (count, _l, _c) -> Db.exec Q.delete_metadata (nick, count)) + metadata + in + let l = List.filter (fun (i, _, _) -> i <> count) metadata in + let l = + if not (label = "" && content = "") then (count, label, content) :: l + else l + in + let l = List.sort (fun (a, _, _) (b, _, _) -> compare a b) l in + let l = List.mapi (fun i (_, label, content) -> (i, label, content)) l in + let^ _unit_list = + unwrap_list + (fun (i, label, content) -> + Db.exec Q.upload_metadata (nick, i, label, content) ) + l + in + Ok () + +let pp_metadata fmt metadata = + let _count, label, content = metadata in + Format.fprintf fmt + {| +
+
%s
+
%s
+
+ |} + label content + +let pp_metadata_form fmt ?is_last metadata request = + let count, label, content = metadata in + let form_tag = Dream.form_tag ~action:"/profile" request in + let button_text = if Option.is_some is_last then "Add" else "Save" in + Format.fprintf fmt + {| +
+ %s + + + + +
+ |} + form_tag label content count button_text + +let pp_metadata_table fmt metadata = + Format.fprintf fmt + {| +
+ %a +
+|} + (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_metadata) + metadata + +let pp_metadata_table_form fmt metadata request = + let length = List.length metadata in + let new_metadata_field fmt () = + pp_metadata_form fmt ~is_last:() (length, "", "") request + in + Format.fprintf fmt + {| +
+ %a + %a +
+|} + (Format.pp_print_list ~pp_sep:Format.pp_print_space (fun fmt metadata -> + pp_metadata_form fmt metadata request ) ) + metadata new_metadata_field () + +let public_profile nick = + let* user = get_user nick in + let user_info = + Format.asprintf + {| +

%s

+
+
+
+
%s
+
+
+ Your avatar picture +
+
+ %a +
+
+|} + user.display_nick user.bio user.nick pp_metadata_table user.metadata + in + Ok user_info diff --git a/src/user_profile.eml.html b/src/user_profile.eml.html index edfa795..ceda6eb 100644 --- a/src/user_profile.eml.html +++ b/src/user_profile.eml.html @@ -1,7 +1,8 @@ let f (user: User.t) request = -

<%s Format.sprintf "Hello %s !" user.nick %>

+% let metadata_table = Format.asprintf "%a" (fun fmt metadata -> User.pp_metadata_table_form fmt metadata request) user.metadata in +

Edit your profile

Check your public profile rendering.

-

Edit profile

+

Display nickname

<%s! Dream.form_tag ~action:"/profile" request %>
@@ -11,15 +12,22 @@ let f (user: User.t) request =

+

Profile metadata

+

Add items displayed as a table on your profile.

+<%s! metadata_table %> +
+
+

Bio

<%s! Dream.form_tag ~action:"/profile" request %>
- - -
Who are you?
+ + +
Who are you?

+

Avatar

Your avatar picture