diff --git a/src/discuss.ml b/src/discuss.ml new file mode 100644 index 0000000..916de87 --- /dev/null +++ b/src/discuss.ml @@ -0,0 +1,169 @@ +(** Creating the table of all messages. + + Each message is made of : + + - an id (msg_id) + - the id of the sender (from_id) + - the id of the receiver (to_id) + - some text (msg) + + TODO: add date ? *) +let () = + let create_msg_table = + Caqti_request.exec Caqti_type.unit + "CREATE TABLE IF NOT EXISTS msg ( msg_id TEXT, from_id TEXT, to_id TEXT, \ + msg TEXT, PRIMARY KEY(msg_id), FOREIGN KEY(from_id) REFERENCES \ + user(user_id) ON DELETE CASCADE, FOREIGN KEY(to_id) REFERENCES \ + user(user_id) ON DELETE CASCADE);" + in + match Db.Db.exec create_msg_table () with + | Ok () -> () + | Error _e -> Dream.error (fun log -> log "can't create msg table") + +(** let's find who the user is talking to so we can know if they're dangerous *) +let find_comrades = + let find_comrades = + Caqti_request.collect + Caqti_type.(tup2 string string) + Caqti_type.(tup2 string string) + "SELECT from_id, to_id FROM msg WHERE from_id=? OR to_id=?" + in + fun user_id -> + let open Bindings in + let^ comrades = Db.Db.collect_list find_comrades (user_id, user_id) in + let comrades = + List.map (fun (l, r) -> if l = user_id then r else l) comrades + in + Ok (List.sort_uniq String.compare comrades) + +(** find all messages between two товарищи *) +let find_messages = + let find_messages = + Caqti_request.collect + Caqti_type.(tup2 (tup2 string string) (tup2 string string)) + Caqti_type.(tup2 string string) + "SELECT from_id, msg FROM msg WHERE (from_id=? AND to_id=?) OR \ + (from_id=? AND to_id=?)" + in + fun k1 k2 -> + let open Bindings in + let^ comrades = Db.Db.collect_list find_messages ((k1, k2), (k2, k1)) in + Ok comrades + +(** display the list of discussions *) +let render request = + match Dream.session "user_id" request with + | None -> + let redirect_url = + Format.sprintf "/login=?redirect=%s" (Dream.to_percent_encoded "/discuss") + in + Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" + | Some user_id -> ( + match find_comrades user_id with + | Error e -> Template_utils.render_unsafe e request + | Ok comrades -> ( + let comrades = + Bindings.unwrap_list + (fun id -> + match User.get_nick id with + | Error _e as e -> e + | Ok nick -> Ok (id, nick) ) + comrades + in + match comrades with + | Error e -> Template_utils.render_unsafe e request + | Ok comrades -> + let pp_one_discuss fmt (id, nick) = + Format.fprintf fmt {|
  • %s
    • |} id nick + in + let output = + Format.asprintf "" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt "
    ") + pp_one_discuss ) + comrades + in + Template_utils.render_unsafe output request ) ) + +let pp_discussion (request, user_id, comrade_id) = + let path = Format.sprintf "/discuss/%s" comrade_id in + match find_messages user_id comrade_id with + | Error e -> Template_utils.render_unsafe e request + | Ok msg -> ( + match User.get_nick user_id with + | Error e -> Template_utils.render_unsafe e request + | Ok user_nick -> ( + match User.get_nick comrade_id with + | Error e -> Template_utils.render_unsafe e request + | Ok comrade_nick -> + let pp_one_msg fmt (from_id, msg) = + Format.fprintf fmt "
  • %s | %s
    • " + (if from_id = user_id then user_nick else comrade_nick) + msg + in + let pp_all_msg fmt msg = + Format.fprintf fmt "" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt "
    ") + pp_one_msg ) + msg + in + Template_utils.render_unsafe + (Format.asprintf + {|%a
    + %s + + + |} + pp_all_msg msg + (Dream.form_tag ~action:path request) ) + request ) ) + +(** display one discussion *) +let render_one request = + let comrade_id = Dream.param request "comrade_id" in + + let path = Format.sprintf "/discuss/%s" comrade_id in + + match Dream.session "user_id" request with + | None -> + let redirect_url = + Format.sprintf "/login=?redirect=%s" (Dream.to_percent_encoded path) + in + Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" + | Some user_id -> pp_discussion (request, user_id, comrade_id) + +let insert_msg = + let insert_msg = + Caqti_request.exec + Caqti_type.(tup3 string string string) + "INSERT INTO msg VALUES (NULL, ?, ?, ?);" + in + fun from_id to_id msg -> + let open Bindings in + let^ () = Db.Db.exec insert_msg (from_id, to_id, msg) in + Ok () + +(** handle posts *) +let post request = + let comrade_id = Dream.param request "comrade_id" in + + let path = Format.sprintf "/discuss/%s" comrade_id in + + match Dream.session "user_id" request with + | None -> + let redirect_url = + Format.sprintf "/login=?redirect=%s" (Dream.to_percent_encoded path) + in + Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" + | Some user_id -> ( + match%lwt Dream.form request with + | `Ok [ ("msg", msg) ] -> begin + match insert_msg user_id comrade_id msg with + | Ok () -> pp_discussion (request, user_id, comrade_id) + | Error e -> Template_utils.render_unsafe e request + end + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Wrong_content_type -> + Dream.empty `Bad_Request ) diff --git a/src/dune b/src/dune index c62730e..d7e57a5 100644 --- a/src/dune +++ b/src/dune @@ -9,12 +9,14 @@ content db delete_page + discuss login permap pp_babillard register report_page template + template_utils thread_page user user_account diff --git a/src/permap.ml b/src/permap.ml index 237e48b..8f0312d 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -1,26 +1,4 @@ -include Bindings - -let get_title content = - let open Soup in - try - let soup = content |> parse in - soup $ "h1" |> R.leaf_text - with Failure _e -> "Permap" - -let render ?title content request = - let title = - match title with None -> get_title content | Some title -> title - in - Dream.html - @@ Template.render_unsafe ~title:(Dream.html_escape title) - ~content:(Dream.html_escape content) - request - -let render_unsafe ?title content request = - let title = - match title with None -> get_title content | Some title -> title - in - Dream.html @@ Template.render_unsafe ~title ~content request +open Template_utils let not_logged_in redirect request = let content = @@ -484,6 +462,9 @@ let routes = ; get_ "/catalog" catalog ; get_ "/delete/:post_id" delete_get ; post "/delete/:post_id" delete_post + ; get_ "/discuss" Discuss.render + ; get_ "/discuss/:comrade_id" Discuss.render_one + ; post "/discuss/:comrade_id" Discuss.post ; get_ "/img/:post_id" (get_post_image ~thumbnail:false) ; get_ "/img/s/:post_id" (get_post_image ~thumbnail:true) ; get_ "/login" login_get diff --git a/src/template.eml.html b/src/template.eml.html index a545581..65304e8 100644 --- a/src/template.eml.html +++ b/src/template.eml.html @@ -27,6 +27,11 @@ let render_unsafe ~title ~content request =
  • Discover users
    • +% begin if Option.is_some @@ Dream.session "nick" request then +
  • + Discuss +
    • +% end;