diff --git a/src/babillard.ml b/src/babillard.ml index 3827c0b..34a48e7 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -11,8 +11,8 @@ type post = { id : string ; parent_id : string ; date : float + ; user_id : string ; nick : string - ; display_nick : string ; comment : string ; image_info : (string * string) option ; tags : string list @@ -27,9 +27,9 @@ type t = module Q = struct let create_post_user_table = Caqti_request.exec Caqti_type.unit - "CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, nick TEXT, PRIMARY \ - KEY(post_id), FOREIGN KEY(nick) REFERENCES user(nick) ON DELETE \ - CASCADE);" + "CREATE TABLE IF NOT EXISTS post_user (post_id TEXT, user_id TEXT, \ + PRIMARY KEY(post_id), FOREIGN KEY(user_id) REFERENCES user(user_id) ON \ + DELETE CASCADE);" (* one row for each thread, with thread's data *) let create_thread_info_table = @@ -86,10 +86,10 @@ module Q = struct let create_report_table = Caqti_request.exec Caqti_type.unit - "CREATE TABLE IF NOT EXISTS report (nick TEXT, reason TEXT, date \ + "CREATE TABLE IF NOT EXISTS report (user_id TEXT, reason TEXT, date \ FLOAT,post_id TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) \ - ON DELETE CASCADE, FOREIGN KEY(nick) REFERENCES user(nick) ON DELETE \ - CASCADE);" + ON DELETE CASCADE, FOREIGN KEY(user_id) REFERENCES user(user_id) ON \ + DELETE CASCADE);" let upload_report = Caqti_request.exec @@ -149,9 +149,9 @@ module Q = struct Caqti_type.(tup2 string float) "INSERT INTO post_date VALUES (?,?);" - let get_post_nick = + let get_post_user_id = Caqti_request.find Caqti_type.string Caqti_type.string - "SELECT nick FROM post_user WHERE post_id=?;" + "SELECT user_id FROM post_user WHERE post_id=?;" let get_post_comment = Caqti_request.find Caqti_type.string Caqti_type.string @@ -310,11 +310,12 @@ let upload_post ?image_content post = | Op (thread_data, reply) -> (Some thread_data, reply) | Post reply -> (None, reply) in - let { id; parent_id; date; nick; comment; image_info; tags; citations; _ } = + let { id; parent_id; date; user_id; comment; image_info; tags; citations; _ } + = reply in - let^ () = Db.exec Q.upload_post_id (id, nick) in + let^ () = Db.exec Q.upload_post_id (id, user_id) in let^ () = Db.exec Q.upload_post_comment (id, comment) in let^ () = Db.exec Q.upload_post_date (id, date) in let^ () = Db.exec Q.upload_thread_post (parent_id, id) in @@ -342,7 +343,7 @@ let upload_post ?image_content post = let^ () = Db.exec Q.upload_thread_info (id, subject, lat, lng) in Ok id -let build_reply ~comment ?image ~tags ?parent_id nick = +let build_reply ~comment ?image ~tags ?parent_id user_id = let comment = Dream.html_escape comment in let tags = Dream.html_escape tags in let id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in @@ -370,13 +371,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* nick = User.get_nick user_id in let reply = { id ; parent_id ; date + ; user_id ; nick - ; display_nick ; comment ; image_info ; tags = tag_list @@ -386,7 +387,7 @@ let build_reply ~comment ?image ~tags ?parent_id nick = in Ok reply -let build_op ~comment ?image ~tags ~subject ~lat ~lng nick = +let build_op ~comment ?image ~tags ~subject ~lat ~lng user_id = let subject = Dream.html_escape subject in (* TODO latlng validation? *) let is_valid_latlng = true in @@ -396,21 +397,21 @@ let build_op ~comment ?image ~tags ~subject ~lat ~lng nick = let thread_data = { subject; lng; lat } in let* reply = match image with - | Some image -> build_reply ~comment ~image ~tags nick - | None -> build_reply ~comment ~tags nick + | Some image -> build_reply ~comment ~image ~tags user_id + | None -> build_reply ~comment ~tags user_id in let op = Op (thread_data, reply) in Ok op -let make_reply ~comment ?image ~tags ~parent_id nick = - let* reply = build_reply ~comment ?image ~tags ~parent_id nick in +let make_reply ~comment ?image ~tags ~parent_id user_id = + let* reply = build_reply ~comment ?image ~tags ~parent_id user_id in let post = Post reply in match image with | None -> upload_post post | Some (_image_info, image_content) -> upload_post ~image_content post -let make_op ~comment ?image ~tags ~subject ~lat ~lng nick = - let* op = build_op ~comment ?image ~tags ~subject ~lat ~lng nick in +let make_op ~comment ?image ~tags ~subject ~lat ~lng user_id = + let* op = build_op ~comment ?image ~tags ~subject ~lat ~lng user_id in match image with | None -> upload_post op | Some (_image_info, image_content) -> upload_post ~image_content op @@ -426,8 +427,8 @@ 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^ user_id = Db.find Q.get_post_user_id id in + let* nick = User.get_nick user_id 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 @@ -439,8 +440,8 @@ let get_post id = { id ; parent_id ; date + ; user_id ; nick - ; display_nick ; comment ; image_info ; tags @@ -466,20 +467,20 @@ let get_posts ids = unwrap_list get_post ids let get_ops ids = unwrap_list get_op ids -let try_delete_post ~nick id = +let try_delete_post ~user_id id = let* post = get_post id in - if post.nick = nick || User.is_admin nick then + if post.user_id = user_id || User.is_admin user_id then let^ () = Db.exec Q.delete_post id in Ok () else Error "You can only delete your posts" -let report ~nick ~reason id = +let report ~user_id ~reason id = if not (post_exist id) then Error "This post exists not" else if String.length reason > 2000 then Error "Your reason is too long.." else let reason = Dream.html_escape reason in let date = Unix.time () in - let^ () = Db.exec Q.upload_report (nick, reason, date, id) in + let^ () = Db.exec Q.upload_report (user_id, reason, date, id) in Ok () let ignore_report id = @@ -489,6 +490,14 @@ let ignore_report id = let get_reports () = let^ reports = Db.collect_list Q.get_reports () in let* posts = - unwrap_list (fun (_nick, _reason, _date, id) -> get_post id) reports + unwrap_list (fun (_reporter_id, _reason, _date, id) -> get_post id) reports + in + (* add reporter_nick to reports so we can display it *) + let* reports = + unwrap_list + (fun (reporter_id, reason, date, id) -> + let* reporter_nick = User.get_nick reporter_id in + Ok (reporter_id, reporter_nick, reason, date, id) ) + reports in Ok (posts, reports) diff --git a/src/login.eml.html b/src/login.eml.html index 89cf27c..4337869 100644 --- a/src/login.eml.html +++ b/src/login.eml.html @@ -8,9 +8,9 @@ let f request = % in <%s! Dream.form_tag ~action:url request %>
- - -
What is you nickname?
+ + +
What is you nickname or email?
diff --git a/src/permap.ml b/src/permap.ml index e4a54f2..5f44e82 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -56,8 +56,8 @@ let login_get request = render_unsafe (Login.f request) request let login_post request = match%lwt Dream.form request with - | `Ok [ ("nick", nick); ("password", password) ] -> ( - match User.login ~nick ~password request with + | `Ok [ ("login", login); ("password", password) ] -> ( + match User.login ~login ~password request with | Error e -> render_unsafe e request | Ok () -> let url = @@ -73,14 +73,14 @@ let login_post request = Dream.empty `Bad_Request let admin_get request = - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> let redirect_url = Format.sprintf "/login?redirect=%s" (Dream.to_percent_encoded "/admin") in Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" - | Some nick -> - if not (User.is_admin nick) then Dream.respond ~status:`Forbidden "" + | Some user_id -> + if not (User.is_admin user_id) then Dream.respond ~status:`Forbidden "" else let res = match Babillard.get_reports () with @@ -91,10 +91,10 @@ let admin_get request = render_unsafe res request let admin_post request = - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> not_logged_in "/admin" request - | Some nick -> ( - if not (User.is_admin nick) then Dream.respond ~status:`Forbidden "" + | Some user_id -> ( + if not (User.is_admin user_id) then Dream.respond ~status:`Forbidden "" else match%lwt Dream.form request with | `Ok [ ("action", action); ("post_id", id) ] -> ( @@ -102,10 +102,10 @@ let admin_post request = match Babillard.get_post id with | Error _e as e -> e | Ok post -> ( - let evil_nick = post.nick in + let evil_user_id = post.user_id in match action with - | "delete" -> Babillard.try_delete_post ~nick id - | "banish" -> User.banish evil_nick + | "delete" -> Babillard.try_delete_post ~user_id:evil_user_id id + | "banish" -> User.banish evil_user_id | "ignore" -> Babillard.ignore_report id | a -> Error (Format.sprintf "invalid action: `%s`" a) ) in @@ -134,13 +134,13 @@ let delete_get request = let delete_post request = let post_id = Dream.param request "post_id" in - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> not_logged_in (Format.sprintf "/delete/%s" post_id) request - | Some nick -> ( + | Some user_id -> ( (* match on Dream.form needed for hidden csrf field *) match%lwt Dream.form request with | `Ok [] -> ( - match Babillard.try_delete_post ~nick post_id with + match Babillard.try_delete_post ~user_id post_id with | Error e -> render_unsafe e request | Ok () -> Dream.respond ~status:`See_Other @@ -159,13 +159,13 @@ let report_get request = let report_post request = let post_id = Dream.param request "post_id" in - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> not_logged_in (Format.sprintf "/report/%s" post_id) request - | Some nick -> ( + | Some user_id -> ( match%lwt Dream.form request with | `Ok [ ("reason", reason) ] -> let res = - match Babillard.report ~nick ~reason post_id with + match Babillard.report ~user_id ~reason post_id with | Error e -> e | Ok () -> "The post was reported!" in @@ -179,11 +179,12 @@ let user request = let user_profile request = let nick = Dream.param request "user" in - if User.exist nick then + match User.get_user_id_from_nick nick with + | Error _e -> Dream.respond ~status:`Not_Found "User does not exists" + | Ok user_id -> render_unsafe - (Result.fold ~ok:Fun.id ~error:Fun.id (User.public_profile nick)) + (Result.fold ~ok:Fun.id ~error:Fun.id (User.public_profile user_id)) request - else Dream.respond ~status:`Not_Found "User does not exists" let logout request = let _ = Dream.invalidate_session request in @@ -191,11 +192,11 @@ let logout request = render_unsafe content request let account_get request = - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> not_logged_in "/account" request - | Some nick -> + | Some user_id -> let res = - match User.get_user nick with + match User.get_user user_id with | Error e -> e | Ok user -> User_account.f user request in @@ -203,23 +204,23 @@ let account_get request = (*TODO ask for password *) let account_post request = - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> not_logged_in "/account" request - | Some nick -> ( + | Some user_id -> ( match%lwt Dream.form request with | `Ok [ ("delete", _) ] -> (*TODO ask for confirmation *) let res = Result.fold ~error:Fun.id ~ok:(fun _ -> "Your account was deleted") - (User.delete_user nick) + (User.delete_user user_id) in render_unsafe res request | `Ok [ ("email", email) ] -> let res = Result.fold ~error:Fun.id ~ok:(fun _ -> "Your email was updated!") - (User.update_email email nick) + (User.update_email email user_id) in render_unsafe res request | `Ok @@ -230,7 +231,7 @@ let account_post request = if password = confirm_password then Result.fold ~error:Fun.id ~ok:(fun _ -> "Your password was updated!") - (User.update_password password nick) + (User.update_password password user_id) else "Password confimation does not match" in render_unsafe res request @@ -239,30 +240,30 @@ let account_post request = Dream.empty `Bad_Request ) let profile_get request = - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> not_logged_in "/profile" request - | Some nick -> + | Some user_id -> let res = - match User.get_user nick with + match User.get_user user_id 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 + match Dream.session "user_id" request with | None -> not_logged_in "/profile" request - | Some nick -> ( + | Some user_id -> ( match%lwt Dream.form request with | `Ok [ ("bio", bio) ] -> ( - match User.update_bio bio nick with + match User.update_bio bio user_id with | Ok () -> Dream.respond ~status:`See_Other ~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 [ ("nick", nick) ] -> ( + match User.update_nick nick user_id with | Ok () -> Dream.respond ~status:`See_Other ~headers:[ ("Location", "/profile") ] @@ -272,7 +273,7 @@ let profile_post request = match int_of_string_opt count with | None -> render_unsafe "Error: invalid count" request | Some count -> ( - match User.update_metadata count label content nick with + match User.update_metadata count label content user_id with | Ok () -> Dream.respond ~status:`See_Other ~headers:[ ("Location", "/profile") ] @@ -282,7 +283,7 @@ let profile_post request = | `Wrong_session _ | `Expired _ | `Wrong_content_type -> ( match%lwt Dream.multipart request with | `Ok [ ("file", file) ] -> ( - match User.upload_avatar file nick with + match User.upload_avatar file user_id with | Ok () -> Dream.respond ~status:`See_Other ~headers:[ ("Location", "/profile") ] @@ -294,8 +295,10 @@ let profile_post request = let avatar_image request = let nick = Dream.param request "user" in - if User.exist nick then - let avatar = User.get_avatar nick in + match User.get_user_id_from_nick nick with + | Error _e -> Dream.respond ~status:`Not_Found "User does not exists" + | Ok user_id -> ( + let avatar = User.get_avatar user_id in match avatar with | Ok (Some avatar) -> Dream.respond ~headers:[ ("Content-Type", "image") ] avatar @@ -303,8 +306,7 @@ let avatar_image request = match Content.read "/assets/img/default_avatar.png" with | None -> failwith "can't find default avatar" | Some avatar -> - Dream.respond ~headers:[ ("Content-Type", "image") ] avatar ) - else Dream.respond ~status:`Not_Found "User does not exists" + Dream.respond ~headers:[ ("Content-Type", "image") ] avatar ) ) let post_image request = let post_id = Dream.param request "post_id" in @@ -325,9 +327,9 @@ let markers request = let babillard_get request = render_unsafe (Babillard_page.f request) request let babillard_post request = - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> not_logged_in "/" request - | Some nick -> ( + | Some user_id -> ( match%lwt Dream.multipart request with | `Ok [ ("alt", [ (_, alt) ]) @@ -344,11 +346,11 @@ let babillard_post request = | Some lat, Some lng -> ( let res = match file with - | [] -> Babillard.make_op ~comment ~lat ~lng ~subject ~tags nick + | [] -> Babillard.make_op ~comment ~lat ~lng ~subject ~tags user_id | _ :: _ :: _ -> Error "More than one image" | [ (image_name, image_content) ] -> let image = ((image_name, alt), image_content) in - Babillard.make_op ~comment ~image ~lat ~lng ~subject ~tags nick + Babillard.make_op ~comment ~image ~lat ~lng ~subject ~tags user_id in match res with | Ok thread_id -> @@ -386,9 +388,9 @@ let thread_get request = (*form to reply to a thread *) let reply_post request = let parent_id = Dream.param request "thread_id" in - match Dream.session "nick" request with + match Dream.session "user_id" request with | None -> not_logged_in (Format.sprintf "/thread/%s" parent_id) request - | Some nick -> ( + | Some user_id -> ( match%lwt Dream.multipart request with | `Ok [ ("alt", [ (_, alt) ]) @@ -398,10 +400,10 @@ let reply_post request = ] -> ( let res = match file with - | [] -> Babillard.make_reply ~comment ~tags ~parent_id nick + | [] -> Babillard.make_reply ~comment ~tags ~parent_id user_id | [ (image_name, image_content) ] -> let image = ((image_name, alt), image_content) in - Babillard.make_reply ~comment ~image ~tags ~parent_id nick + Babillard.make_reply ~comment ~image ~tags ~parent_id user_id | _ :: _ :: _ -> Error "More than one image" in match res with diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml index 0b6c69c..d8cb650 100644 --- a/src/pp_babillard.ml +++ b/src/pp_babillard.ml @@ -11,8 +11,8 @@ let pp_post fmt t = let { id ; parent_id = _parent_id ; date + ; user_id ; nick - ; display_nick ; comment ; image_info ; tags @@ -80,7 +80,7 @@ let pp_post fmt t = Format.fprintf fmt {|
- %s + %s