From 14b1deb4463f318111bb441c0db84c9f0e1c723f Mon Sep 17 00:00:00 2001 From: Swrup Date: Wed, 23 Feb 2022 22:39:48 +0100 Subject: [PATCH] add /admin --- src/app.ml | 15 +++++++++---- src/babillard.ml | 25 ++++++++++++++++++--- src/permap.ml | 55 +++++++++++++++++++++++++++++++++++++++++++-- src/pp_babillard.ml | 49 ++++++++++++++++++++++++++++++++++++++++ src/user.ml | 43 ++++++++++++++++++++++++++++++----- 5 files changed, 172 insertions(+), 15 deletions(-) diff --git a/src/app.ml b/src/app.ml index b5a814f..62f722f 100644 --- a/src/app.ml +++ b/src/app.ml @@ -45,8 +45,8 @@ let () = Dream.log "open_registration: %b" open_registration let port = match Scfg.Query.get_dir "port" config with | None -> 8080 - | Some open_registration -> ( - match Scfg.Query.get_param 0 open_registration with + | Some port -> ( + match Scfg.Query.get_param 0 port with | Error e -> failwith e | Ok n -> ( try @@ -61,11 +61,18 @@ let () = Dream.log "port: %d" port let log = match Scfg.Query.get_dir "log" config with | None -> true - | Some open_registration -> ( - match Scfg.Query.get_param 0 open_registration with + | Some log -> ( + match Scfg.Query.get_param 0 log with | Error e -> failwith e | Ok "true" -> true | Ok "false" -> false | Ok _unknown -> failwith "invalid `log` value in configuration file" ) let () = Dream.log "log: %b" log + +let admins = + let dirs = Scfg.Query.get_dirs "admin" config in + List.map + (fun dir -> + Result.fold ~error:failwith ~ok:Fun.id (Scfg.Query.get_param 0 dir) ) + dirs diff --git a/src/babillard.ml b/src/babillard.ml index 55d0d26..5d5e7b4 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -98,11 +98,19 @@ module Q = struct ON DELETE CASCADE, FOREIGN KEY(nick) REFERENCES user(nick) ON DELETE \ CASCADE);" - let upload_report_post = + let upload_report = Caqti_request.exec Caqti_type.(tup4 string string float string) "INSERT INTO report VALUES (?,?,?,?);" + let ignore_report = + Caqti_request.exec Caqti_type.string "DELETE FROM report WHERE post_id=?;" + + let get_reports = + Caqti_request.collect Caqti_type.unit + Caqti_type.(tup4 string string float string) + "SELECT * FROM report;" + let upload_post_id = Caqti_request.exec Caqti_type.(tup2 string string) @@ -468,7 +476,7 @@ let get_ops ids = unwrap_list get_op ids let try_delete_post ~nick id = let* post = get_post id in - if post.nick = nick then + if post.nick = nick || User.is_admin nick then let^ () = Db.exec Q.delete_post id in Ok () else Error "You can only delete your posts" @@ -479,5 +487,16 @@ let report ~nick ~reason id = else let reason = Dream.html_escape reason in let date = Unix.time () in - let^ () = Db.exec Q.upload_report_post (nick, reason, date, id) in + let^ () = Db.exec Q.upload_report (nick, reason, date, id) in Ok () + +let ignore_report id = + let^ () = Db.exec Q.ignore_report id in + Ok () + +let get_reports () = + let^ reports = Db.collect_list Q.get_reports () in + let* posts = + unwrap_list (fun (_nick, _reason, _date, id) -> get_post id) reports + in + Ok (posts, reports) diff --git a/src/permap.ml b/src/permap.ml index ff1f9e9..bd166d8 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -64,6 +64,53 @@ let login_post request = | `Wrong_session _ | `Expired _ | `Wrong_content_type -> Dream.empty `Bad_Request +let admin_get request = + match Dream.session "nick" request with + | None -> + let redirect_url = + Format.sprintf "/login?redirect=%s" (Dream.to_percent_encoded "/admin") + in + Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" + | Some nick -> + if not (User.is_admin nick) then Dream.respond ~status:`Forbidden "" + else + let res = + match Babillard.get_reports () with + | Error e -> e + | Ok (posts, reports) -> + Pp_babillard.admin_page_content posts reports request + in + render_unsafe res request + +let admin_post request = + match Dream.session "nick" request with + | None -> render_unsafe "Not logged in" request + | Some nick -> ( + if not (User.is_admin nick) then Dream.respond ~status:`Forbidden "" + else + match%lwt Dream.form request with + | `Ok [ ("action", action); ("post_id", id) ] -> ( + let res = + match Babillard.get_post id with + | Error _e as e -> e + | Ok post -> ( + let evil_nick = post.nick in + match action with + | "delete" -> Babillard.try_delete_post ~nick id + | "banish" -> User.banish evil_nick + | "ignore" -> Babillard.ignore_report id + | a -> Error (Format.sprintf "invalid action: `%s`" a) ) + in + match res with + | Error e -> render_unsafe e request + | Ok () -> + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/admin") ] + "" ) + | `Ok _ | `Expired _ | `Many_tokens _ | `Missing_token _ + | `Invalid_token _ | `Wrong_session _ | `Wrong_content_type -> + Dream.empty `Bad_Request ) + let catalog request = let catalog_content = Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.catalog_content ()) @@ -139,8 +186,10 @@ let profile_get request = match Dream.session "nick" request with | None -> render_unsafe "Not logged in" request | Some nick -> - let bio = match User.get_bio nick with Ok bio -> bio | Error e -> e in - render_unsafe (User_profile.f nick bio request) request + if User.exist nick then + let bio = match User.get_bio nick with Ok bio -> bio | Error e -> e in + render_unsafe (User_profile.f nick bio request) request + else Dream.respond ~status:`Not_Found "User does not exists" let profile_post request = match Dream.session "nick" request with @@ -304,6 +353,8 @@ let routes = [ get_ "/" babillard_get ; post "/" babillard_post ; get_ "/about" about + ; get_ "/admin" admin_get + ; post "/admin" admin_post ; get_ "/assets/**" (Dream.static ~loader:asset_loader "") ; get_ "/catalog" catalog ; get_ "/delete/:post_id" delete_get diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml index 5a7d790..78e49c3 100644 --- a/src/pp_babillard.ml +++ b/src/pp_babillard.ml @@ -159,6 +159,55 @@ let catalog_content () = (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_thread_preview) ops ) +let pp_report fmt post report request = + let url = "/admin" in + let nick, reason, _date, id = report in + let input_post_id fmt id = + Format.fprintf fmt + {||} id + in + let button fmt value = + Format.fprintf fmt + {||} + value + (String.uppercase_ascii value) + in + let form fmt value = + Format.fprintf fmt {|%s %a %a |} + (Dream.form_tag ~action:url request) + input_post_id id button value + in + + Format.fprintf fmt + {| +
+
+
+ %a +
+
+ From: %s Reason: %s +
+ %a +
+ %a +
+ %a +
+
+
+
+

+|} + pp_post (Post post) nick reason form "ignore" form "delete" form "banish" + +let admin_page_content posts reports request = + let posts_reports = List.combine posts reports in + Format.asprintf "%a" + (Format.pp_print_list ~pp_sep:Format.pp_print_space + (fun fmt (post, report) -> pp_report fmt post report request) ) + posts_reports + let pp_thread fmt op posts = let thread_data, _post = op in (*order by date *) diff --git a/src/user.ml b/src/user.ml index 6ca7948..7252112 100644 --- a/src/user.ml +++ b/src/user.ml @@ -15,11 +15,6 @@ module Q = struct "CREATE TABLE IF NOT EXISTS user (nick TEXT, password TEXT, email TEXT, \ bio TEXT, avatar BLOB, PRIMARY KEY(nick));" - let create_plant_user_table = - Caqti_request.exec Caqti_type.unit - "CREATE TABLE IF NOT EXISTS plant_user (plant_id TEXT, nick TEXT, \ - PRIMARY KEY(plant_id), FOREIGN KEY(nick) REFERENCES user(nick));" - let get_password = Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT password FROM user WHERE nick=?;" @@ -53,6 +48,10 @@ module Q = struct Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT bio FROM user WHERE nick=?;" + let get_email = + Caqti_request.find_opt Caqti_type.string Caqti_type.string + "SELECT email FROM user WHERE nick=?;" + let get_avatar = Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT avatar FROM user WHERE nick=?;" @@ -61,10 +60,27 @@ module Q = struct Caqti_request.exec Caqti_type.(tup2 string string) "UPDATE user SET avatar=? WHERE nick=?;" + + let create_banished_table = + Caqti_request.exec Caqti_type.unit + "CREATE TABLE IF NOT EXISTS banished (nick TEXT, email TEXT);" + + let delete_user = + Caqti_request.exec Caqti_type.string "DELETE FROM user WHERE nick=?;" + + let upload_banished = + Caqti_request.exec + Caqti_type.(tup2 string string) + "INSERT INTO banished VALUES (?,?);" + + let get_banished = + Caqti_request.find Caqti_type.string + Caqti_type.(tup2 string string) + "SELECT * FROM banished WHERE nick=?;" end let () = - let tables = [ Q.create_user_table ] in + let tables = [ Q.create_user_table; Q.create_banished_table ] in if List.exists Result.is_error (List.map (fun query -> Db.exec query ()) tables) @@ -72,6 +88,8 @@ let () = let exist nick = Result.is_ok (Db.find Q.get_user nick) +let is_banished nick = Result.is_ok (Db.find Q.get_banished nick) + let login ~nick ~password request = if exist nick then let^? good_password = Db.find_opt Q.get_password nick in @@ -80,6 +98,7 @@ let login ~nick ~password request = let _unit_lwt = Dream.put_session "nick" nick request in Ok () else Error "wrong password" + else if is_banished nick then Error "YOU ARE BANISHED" else Error "wrong user name" let register ~email ~nick ~password = @@ -157,6 +176,10 @@ let get_bio nick = let^? bio = Db.find_opt Q.get_bio nick in Ok bio +let get_email nick = + let^? email = Db.find_opt Q.get_email nick in + Ok email + let get_avatar nick = let^? avatar = Db.find_opt Q.get_avatar nick in if String.length avatar = 0 then Ok None else Ok (Some avatar) @@ -170,3 +193,11 @@ let upload_avatar files nick = let^ () = Db.exec Q.upload_avatar (content, nick) in Ok () | _files -> Error "More than one file provided" + +let is_admin nick = List.mem nick App.admins + +let banish nick = + let* email = get_email nick in + let^ () = Db.exec Q.delete_user nick in + let^ () = Db.exec Q.upload_banished (nick, email) in + Ok ()