open Db (** 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 ? *) module Q = struct open Caqti_request.Infix open Caqti_type let create_msg_table = (unit ->. 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)" let find_comrades = (tup2 string string ->* tup2 string string) "SELECT from_id, to_id FROM msg WHERE from_id=? OR to_id=?" let find_messages = (tup2 (tup2 string string) (tup2 string string) ->* tup2 string string) "SELECT from_id, msg FROM msg WHERE (from_id=? AND to_id=?) OR \ (from_id=? AND to_id=?)" let insert_msg = (tup3 string string string ->. unit) "INSERT INTO msg VALUES (NULL, ?, ?, ?)" end let () = match Db.exec Q.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 user_id = let open Syntax in let^ comrades = Db.collect_list Q.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 k1 k2 = let open Syntax in let^ comrades = Db.collect_list Q.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 = Syntax.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 from_id to_id msg = let open Syntax in let^ () = Db.exec Q.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 )