diff --git a/src/babillard.ml b/src/babillard.ml
index 0d962e0..dc4c71f 100644
--- a/src/babillard.ml
+++ b/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 ()
diff --git a/src/delete_page.eml.html b/src/delete_page.eml.html
index 9cfd0d2..874c235 100644
--- a/src/delete_page.eml.html
+++ b/src/delete_page.eml.html
@@ -11,8 +11,8 @@ let f post_preview post_id request =
diff --git a/src/dune b/src/dune
index b455616..1f15753 100644
--- a/src/dune
+++ b/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)
diff --git a/src/permap.ml b/src/permap.ml
index 047c1d2..2992f18 100644
--- a/src/permap.ml
+++ b/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 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!" )
+ (* 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
diff --git a/src/report_page.eml.html b/src/report_page.eml.html
new file mode 100644
index 0000000..20cb3c1
--- /dev/null
+++ b/src/report_page.eml.html
@@ -0,0 +1,22 @@
+let f post_preview post_id request =
+
+
+ <%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
+
Login to report a post.
+% | Some _nick ->
+
+% end;