diff --git a/src/babillard.ml b/src/babillard.ml
index 8a355be..6b1a746 100644
--- a/src/babillard.ml
+++ b/src/babillard.ml
@@ -1,6 +1,22 @@
open Db
include Bindings
+type moderation_action =
+ | Ignore
+ | Delete
+ | Banish
+
+let moderation_action_to_string = function
+ | Ignore -> "ignore"
+ | Delete -> "delete"
+ | Banish -> "banish"
+
+let moderation_action_from_string = function
+ | "ignore" -> Some Ignore
+ | "delete" -> Some Delete
+ | "banish" -> Some Banish
+ | _ -> None
+
type thread_data =
{ subject : string
; lng : float
diff --git a/src/permap.ml b/src/permap.ml
index 65547c7..517ce8d 100644
--- a/src/permap.ml
+++ b/src/permap.ml
@@ -115,11 +115,13 @@ let admin_post request =
| Error _e as e -> e
| Ok post -> (
let evil_user_id = post.user_id in
- match action with
- | "delete" -> Babillard.try_delete_post ~user_id:evil_user_id id
- | "banish" -> User.banish evil_user_id
- | "ignore" -> Babillard.ignore_report id
- | a -> Error (Format.sprintf "invalid action: `%s`" a) )
+ match Babillard.moderation_action_from_string action with
+ | None -> Error "Invalid action"
+ | Some action -> (
+ match action with
+ | Delete -> Babillard.try_delete_post ~user_id:evil_user_id id
+ | Banish -> User.banish evil_user_id
+ | Ignore -> Babillard.ignore_report id ) )
in
match res with
| Error e -> render_unsafe e request
diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml
index ae033ad..7ed16fd 100644
--- a/src/pp_babillard.ml
+++ b/src/pp_babillard.ml
@@ -2,6 +2,22 @@ include Bindings
include Babillard
open Db
+type moderation_action =
+ | Ignore
+ | Delete
+ | Banish
+
+let moderation_action_to_string = function
+ | Ignore -> "ignore"
+ | Delete -> "delete"
+ | Banish -> "banish"
+
+let moderation_action_from_string = function
+ | "ignore" -> Some Ignore
+ | "delete" -> Some Delete
+ | "banish" -> Some Banish
+ | _ -> None
+
let pp_post fmt t =
let thread_data_opt, post =
match t with
@@ -177,16 +193,16 @@ let pp_report fmt post report request =
Format.fprintf fmt
{||} id
in
- let button fmt value =
+ let button fmt action =
+ let s = moderation_action_to_string action in
Format.fprintf fmt
{||}
- value
- (String.uppercase_ascii value)
+ s (String.uppercase_ascii s)
in
- let form fmt value =
+ let form fmt action =
Format.fprintf fmt {|%s %a %a |}
(Dream.form_tag ~action:url request)
- input_post_id id button value
+ input_post_id id button action
in
Format.fprintf fmt
@@ -210,8 +226,7 @@ let pp_report fmt post report request =
|}
- pp_post (Post post) reporter_nick reason form "ignore" form "delete" form
- "banish"
+ pp_post (Post post) reporter_nick reason form Ignore form Delete form Banish
let admin_page_content posts reports request =
let posts_reports = List.combine posts reports in
diff --git a/src/user.ml b/src/user.ml
index a4dc3c8..263f23b 100644
--- a/src/user.ml
+++ b/src/user.ml
@@ -321,8 +321,7 @@ let update_metadata count label content user_id =
let^ () = Db.exec Q.upload_metadata (user_id, s) in
Ok ()
-let pp_metadata fmt pair =
- let label, content = pair in
+let pp_metadata fmt (label, content) =
Format.fprintf fmt
{|