add report

src/babillard.ml

@@ -91,6 +91,18 @@ module Q = struct
       "CREATE TABLE IF NOT EXISTS post_tags (post_id TEXT, tag TEXT, FOREIGN \
        KEY(post_id) REFERENCES post_user(post_id) ON DELETE CASCADE);"
 
+  let create_report_table =
+    Caqti_request.exec Caqti_type.unit
+      "CREATE TABLE IF NOT EXISTS report (nick TEXT, reason TEXT, date \
+       INT,post_id TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id) ON \
+       DELETE CASCADE, FOREIGN KEY(nick) REFERENCES user(nick) ON DELETE \
+       CASCADE);"
+
+  let upload_report_post =
+    Caqti_request.exec
+      Caqti_type.(tup4 string string int string)
+      "INSERT INTO report VALUES (?,?,?,?);"
+
   let upload_post_id =
     Caqti_request.exec
       Caqti_type.(tup2 string string)
@@ -215,6 +227,7 @@ let () =
     ; Q.create_image_info_table
     ; Q.create_image_content_table
     ; Q.create_post_tags_table
+    ; Q.create_report_table
     ]
   in
   if
@@ -459,3 +472,10 @@ let try_delete_post ~nick id =
     let^ () = Db.exec Q.delete_post id in
     Ok ()
   else Error "You can only delete your posts"
+
+let report ~nick ~reason id =
+  if not (post_exists id) then Error "This post doesn't exists"
+  else
+    let date = int_of_float (Unix.time ()) in
+    let^ () = Db.exec Q.upload_report_post (nick, reason, date, id) in
+    Ok ()

src/delete_page.eml.html

@@ -11,8 +11,8 @@ let f post_preview post_id request =
   <div class="row mb-3">
     <div class="col-md-6" id="delete-form">
       <div class="postForm">
-<%s! Dream.form_tag ~action:url ~enctype:`Multipart_form_data request %>
-          <button name="delete-button" type="submit" class="btn btn-primary">DELETE</button>
+<%s! Dream.form_tag ~action:url request %>
+          <button type="submit" class="btn btn-primary">DELETE</button>
         </form>
       </div>
     </div>

src/dune

@@ -13,6 +13,7 @@
   permap
   pp_babillard
   register
+  report_page
   template
   thread_page
   user
@@ -66,6 +67,12 @@
  (action
   (run dream_eml %{deps} --workspace %{workspace_root})))
 
+(rule
+ (targets report_page.ml)
+ (deps report_page.eml.html)
+ (action
+  (run dream_eml %{deps} --workspace %{workspace_root})))
+
 (rule
  (targets template.ml)
  (deps template.eml.html)

src/permap.ml

@@ -82,12 +82,42 @@ let delete_post request =
   match Dream.session "nick" request with
   | None -> render_unsafe "Not logged in" request
   | Some nick -> (
+    (* 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
       | Error e -> render_unsafe e request
       | Ok () ->
         Dream.respond ~status:`See_Other
           ~headers:[ ("Location", "/") ]
           "Your post was deleted!" )
+    | `Ok _ | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
+    | `Wrong_session _ | `Wrong_content_type ->
+      Dream.empty `Bad_Request )
+
+let report_get request =
+  let post_id = Dream.param request "post_id" in
+  let post_preview =
+    Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.view_post post_id)
+  in
+  render_unsafe (Report_page.f post_preview post_id request) request
+
+let report_post request =
+  let post_id = Dream.param request "post_id" in
+  match Dream.session "nick" request with
+  | None -> render_unsafe "Not logged in" request
+  | Some nick -> (
+    match%lwt Dream.form request with
+    | `Ok [ ("reason", reason) ] ->
+      let res =
+        match Babillard.report ~nick ~reason post_id with
+        | Error e -> e
+        | Ok () -> "The post was reported!"
+      in
+      render_unsafe res request
+    | `Ok _ | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
+    | `Wrong_session _ | `Wrong_content_type ->
+      Dream.empty `Bad_Request )
 
 let user request =
   render_unsafe (Result.fold ~ok:Fun.id ~error:Fun.id (User.list ())) request
@@ -286,6 +316,8 @@ let routes =
   ; get_ "/post_pic/:post_id" post_image
   ; get_ "/profile" profile_get
   ; post "/profile" profile_post
+  ; get_ "/report/:post_id" report_get
+  ; post "/report/:post_id" report_post
   ; get_ "/thread/:thread_id" thread_get
   ; post "/thread/:thread_id" reply_post
   ; get_ "/user" user

src/report_page.eml.html

@@ -0,0 +1,22 @@
+let f post_preview post_id request =
+
+<script type="text/javascript" src="/assets/js/js_catalog.js" defer="defer"></script>
+      <%s! post_preview %>
+% let url = Format.sprintf "/report/%s" post_id in
+% begin match Dream.session "nick" request with
+% | None ->
+% let redirect = Dream.to_percent_encoded url in
+  <a href="/login?redirect=<%s redirect%>">Login</a> to report a post.
+% | Some _nick ->
+  <div class="row mb-3">
+    <div class="col-md-6" id="report-form">
+      <div class="postForm">
+<%s! Dream.form_tag ~action:url request %>
+          <label for="reason" id="reason-label" class="form-label">Reason:</label>
+          <input name="reason" id="reason" type="text" class="form-control" aria-labelledby="reason-label"></input>
+          <button type="submit" class="btn btn-primary">REPORT</button>
+        </form>
+      </div>
+    </div>
+  </div>
+% end;