big squish

src/moderation.ml

@@ -0,0 +1,107 @@
+open Syntax
+open Types
+open Caqti_request.Infix
+open Caqti_type
+open Caqti_db
+
+(* TODO do something for multiples report on same post
+   - don't allow multiple report on same post from same user
+   - add TEST *)
+
+let () =
+  let tables =
+    [| (unit ->. unit)
+         "CREATE TABLE IF NOT EXISTS report (report_id TEXT, date FLOAT, \
+          post_id INTEGER, user_id TEXT, reason TEXT, FOREIGN KEY(post_id) \
+          REFERENCES post(id) ON DELETE CASCADE, FOREIGN KEY(user_id) \
+          REFERENCES user(user_id) ON DELETE CASCADE)"
+     ; (unit ->. unit)
+         "CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT)"
+    |]
+  in
+  Array.iter (fun query -> Db.exec_unsafe query ()) tables
+
+module Q = struct
+  let upload_report =
+    Db.exec
+      ((t5 string float int string string ->. unit)
+         "INSERT INTO report VALUES (?,?,?,?,?)" )
+
+  let get_reports_all =
+    Db.collect_list
+      ((unit ->* t6 string float int string string string)
+         "SELECT r.report_id, r.date, r.post_id, r.user_id, u.nick, reason \
+          FROM report r JOIN user u ON r.user_id = u.user_id" )
+
+  let get_reports_made_by =
+    Db.collect_list
+      ((string ->* t6 string float int string string string)
+         "SELECT r.report_id, r.date, r.post_id, r.user_id, u.nick, reason \
+          FROM report r JOIN user u ON r.user_id = u.user_id WHERE r.user_id=?" )
+
+  let delete_report =
+    Db.exec @@ (int ->. unit) "DELETE FROM report WHERE post_id=?"
+
+  let upload_banished =
+    Db.exec @@ (t2 string string ->. unit) "INSERT INTO banished VALUES (?,?)"
+
+  let find_banished =
+    Db.find_opt
+    @@ (t2 string string ->! t2 string string)
+         "SELECT * FROM banished WHERE nick=? OR email=?"
+end
+
+let get_report_aux
+    ( report_id
+    , report_date
+    , reported_post_id
+    , reporter_user_id
+    , reporter_nick
+    , reason ) =
+  let+ reported_post = Post.get_post reported_post_id in
+  { report_id
+  ; report_date
+  ; reported_post
+  ; reporter_user_id
+  ; reporter_nick
+  ; reason
+  }
+
+let get_reports_all () =
+  Db.do_transaction @@ fun () ->
+  let* l = Q.get_reports_all () in
+  list_map get_report_aux l
+
+let get_reports_made_by user_id =
+  Db.do_transaction @@ fun () ->
+  let* l = Q.get_reports_made_by user_id in
+  list_map get_report_aux l
+
+let make_report ~reporter_user_id ~reason reported_post_id =
+  let* reason = Validate_str.report reason in
+  (* check post exists *)
+  let* _post = Post.get_post reported_post_id in
+  let report_date = Unix.time () in
+  let report_id = Util.gen_uuid () in
+  Db.do_transaction @@ fun () ->
+  Q.upload_report
+    ( report_id
+    , report_date
+    , reported_post_id
+    , reporter_user_id
+    , (reason :> string) )
+
+(* todo sql: no need to use transaction for a single query? *)
+let delete_report id = Db.do_transaction @@ fun () -> Q.delete_report id
+
+let is_banished login =
+  let+ opt = Db.do_transaction @@ fun () -> Q.find_banished (login, login) in
+  match opt with None -> false | Some _ -> true
+
+(* it would be better to also invalidate banned user's session here
+   since Api.get_logged_user check for user existance it should be fine *)
+let banish user_id =
+  let* user_private = User.get_user_private user_id in
+  let* () = User.delete_user user_id in
+  Db.do_transaction @@ fun () ->
+  Q.upload_banished (user_private.user_nick, user_private.email)