geochan/src/discuss.ml

open Db
open Syntax

(** 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 =
  let pp_one_discuss fmt (id, nick) =
    Format.fprintf fmt {|<li><a href="/discuss/%s">%s</a></li>|} id nick
  in
  fun request ->
    Utils.logged_in_or_redirect request (fun user_id ->
        Utils.render_result request
        @@ let* comrades = find_comrades user_id in
           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
           Ok
             (Format.asprintf "<ul>%a</ul>"
                (Format.pp_print_list
                   ~pp_sep:(fun fmt () -> Format.fprintf fmt "<br />")
                   pp_one_discuss )
                comrades ) )

let pp_discussion (request, user_id, comrade_id) =
  let path = Format.sprintf "/discuss/%s" comrade_id in
  Utils.render_result request
  @@ let* msg = find_messages user_id comrade_id in
     let* user_nick = User.get_nick user_id in
     let* comrade_nick = User.get_nick comrade_id in
     let pp_one_msg fmt (from_id, msg) =
       Format.fprintf fmt "<li>%s | %s</li>"
         (if from_id = user_id then user_nick else comrade_nick)
         msg
     in
     let pp_all_msg fmt msg =
       Format.fprintf fmt "<ul>%a</ul>"
         (Format.pp_print_list
            ~pp_sep:(fun fmt () -> Format.fprintf fmt "<br />")
            pp_one_msg )
         msg
     in
     Ok
       (Format.asprintf
          {|%a<br />
          %s
          <input value="" name="msg" type="text" />
          <button type="submit" class="btn btn-primary">Send</button>
        </form>|}
          pp_all_msg msg
          (Dream.form_tag ~action:path request) )

(** display one discussion *)
let renderone request =
  Utils.logged_in_or_redirect request (fun user_id ->
      let comrade_id = Dream.param request "comrade_id" in
      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 =
  Utils.logged_in_or_redirect request (fun user_id ->
      match%lwt Dream.form request with
      | `Ok [ ("msg", msg) ] -> begin
        let comrade_id = Dream.param request "comrade_id" in
        match insert_msg user_id comrade_id msg with
        | Ok () -> pp_discussion (request, user_id, comrade_id)
        | Error e -> Utils.render 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 )