From 3796a969974a977ad505d3570f3131b2e29d4b85 Mon Sep 17 00:00:00 2001 From: zapashcanon Date: Tue, 5 Apr 2022 23:08:57 +0200 Subject: [PATCH] refactor some code --- src/babillard.ml | 25 +-- src/discuss.ml | 153 +++++-------- src/dune | 4 +- src/permap.ml | 493 +++++++++++++++++++----------------------- src/pp_babillard.ml | 13 +- src/template_utils.ml | 21 -- src/utils.ml | 24 ++ 7 files changed, 330 insertions(+), 403 deletions(-) delete mode 100644 src/template_utils.ml create mode 100644 src/utils.ml diff --git a/src/babillard.ml b/src/babillard.ml index 7b1d89a..8a17784 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -267,11 +267,13 @@ let upload_post ~image post = (fun cited_id -> Db.exec Q.upload_post_reply (cited_id, id)) citations in - match thread_data with - | None -> Ok id - | Some { subject; lng; lat } -> - let^ () = Db.exec Q.upload_thread_info (id, subject, lat, lng) in - Ok id + let^ () = + match thread_data with + | None -> Ok () + | Some { subject; lng; lat } -> + Db.exec Q.upload_thread_info (id, subject, lat, lng) + in + Ok id let build_reply ~comment ~image_info ~tag_list ?parent_id user_id = let comment = Dream.html_escape comment in @@ -323,14 +325,8 @@ let build_op ~comment ~image_info ~tag_list ~categories ~subject ~lat ~lng if not is_valid_latlng then Error "Invalid coordinate" else if String.length subject > 600 then Error "Invalid subject" else - let thread_data = { subject; lng; lat } in let* reply = build_reply ~comment ~image_info ~tag_list user_id in - let op = (thread_data, reply) in - Ok op - -let build_image image_input = - let* image = Image.make_image image_input in - Ok image + Ok ({ subject; lng; lat }, reply) let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id = let tag_list = String.split_on_char ',' tags in @@ -338,7 +334,7 @@ let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id = match image_input with | None -> Ok (None, None) | Some image_input -> - let* image = build_image image_input in + let* image = Image.make_image image_input in Ok (Some image, Some (image.name, image.alt)) in let* post = @@ -391,8 +387,7 @@ let get_post id = let get_thread_data id = if thread_exist id then let^? subject, lat, lng = Db.find_opt Q.get_thread_info id in - let thread_data = { subject; lat; lng } in - Ok thread_data + Ok { subject; lat; lng } else Error "not an op" let get_op id = diff --git a/src/discuss.ml b/src/discuss.ml index 21cf414..42b1d47 100644 --- a/src/discuss.ml +++ b/src/discuss.ml @@ -1,4 +1,5 @@ open Db +open Syntax (** Creating the table of all messages. @@ -57,87 +58,62 @@ let find_messages k1 k2 = Ok comrades (** display the list of discussions *) -let render request = - match Dream.session "user_id" request with - | None -> - let redirect_url = - Format.sprintf "/login=?redirect=%s" (Dream.to_percent_encoded "/discuss") - in - Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" - | Some user_id -> ( - match find_comrades user_id with - | Error e -> Template_utils.render_unsafe e request - | Ok comrades -> ( - let comrades = - Syntax.unwrap_list - (fun id -> - match User.get_nick id with - | Error _e as e -> e - | Ok nick -> Ok (id, nick) ) - comrades - in - match comrades with - | Error e -> Template_utils.render_unsafe e request - | Ok comrades -> - let pp_one_discuss fmt (id, nick) = - Format.fprintf fmt {|
  • %s
    • |} id nick - in - let output = - Format.asprintf "" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "
    ") - pp_one_discuss ) - comrades - in - Template_utils.render_unsafe output request ) ) +let render = + let pp_one_discuss fmt (id, nick) = + Format.fprintf fmt {|
  • %s
    • |} id nick + in + fun request -> + Utils.logged_in_or_redirect request (fun user_id -> + Utils.render_result request + @@ let* comrades = find_comrades user_id in + let* comrades = + Syntax.unwrap_list + (fun id -> + match User.get_nick id with + | Error _e as e -> e + | Ok nick -> Ok (id, nick) ) + comrades + in + Ok + (Format.asprintf "" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt "
    ") + pp_one_discuss ) + comrades ) ) let pp_discussion (request, user_id, comrade_id) = let path = Format.sprintf "/discuss/%s" comrade_id in - match find_messages user_id comrade_id with - | Error e -> Template_utils.render_unsafe e request - | Ok msg -> ( - match User.get_nick user_id with - | Error e -> Template_utils.render_unsafe e request - | Ok user_nick -> ( - match User.get_nick comrade_id with - | Error e -> Template_utils.render_unsafe e request - | Ok comrade_nick -> - let pp_one_msg fmt (from_id, msg) = - Format.fprintf fmt "
  • %s | %s
    • " - (if from_id = user_id then user_nick else comrade_nick) - msg - in - let pp_all_msg fmt msg = - Format.fprintf fmt "" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "
    ") - pp_one_msg ) - msg - in - Template_utils.render_unsafe - (Format.asprintf - {|%a
    + Utils.render_result request + @@ let* msg = find_messages user_id comrade_id in + let* user_nick = User.get_nick user_id in + let* comrade_nick = User.get_nick comrade_id in + let pp_one_msg fmt (from_id, msg) = + Format.fprintf fmt "
  • %s | %s
    • " + (if from_id = user_id then user_nick else comrade_nick) + msg + in + let pp_all_msg fmt msg = + Format.fprintf fmt "" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt "
    ") + pp_one_msg ) + msg + in + Ok + (Format.asprintf + {|%a
    %s |} - pp_all_msg msg - (Dream.form_tag ~action:path request) ) - request ) ) + pp_all_msg msg + (Dream.form_tag ~action:path request) ) (** display one discussion *) -let render_one request = - let comrade_id = Dream.param request "comrade_id" in - - let path = Format.sprintf "/discuss/%s" comrade_id in - - match Dream.session "user_id" request with - | None -> - let redirect_url = - Format.sprintf "/login=?redirect=%s" (Dream.to_percent_encoded path) - in - Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" - | Some user_id -> pp_discussion (request, user_id, comrade_id) +let renderone request = + Utils.logged_in_or_redirect request (fun user_id -> + let comrade_id = Dream.param request "comrade_id" in + pp_discussion (request, user_id, comrade_id) ) let insert_msg from_id to_id msg = let open Syntax in @@ -146,24 +122,15 @@ let insert_msg from_id to_id msg = (** handle posts *) let post request = - let comrade_id = Dream.param request "comrade_id" in - - let path = Format.sprintf "/discuss/%s" comrade_id in - - match Dream.session "user_id" request with - | None -> - let redirect_url = - Format.sprintf "/login=?redirect=%s" (Dream.to_percent_encoded path) - in - Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" - | Some user_id -> ( - match%lwt Dream.form request with - | `Ok [ ("msg", msg) ] -> begin - match insert_msg user_id comrade_id msg with - | Ok () -> pp_discussion (request, user_id, comrade_id) - | Error e -> Template_utils.render_unsafe e request - end - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ - | `Wrong_session _ | `Wrong_content_type -> - Dream.empty `Bad_Request ) + Utils.logged_in_or_redirect request (fun user_id -> + match%lwt Dream.form request with + | `Ok [ ("msg", msg) ] -> begin + let comrade_id = Dream.param request "comrade_id" in + match insert_msg user_id comrade_id msg with + | Ok () -> pp_discussion (request, user_id, comrade_id) + | Error e -> Utils.render e request + end + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Wrong_content_type -> + Dream.empty `Bad_Request ) diff --git a/src/dune b/src/dune index bff5792..2fc9b92 100644 --- a/src/dune +++ b/src/dune @@ -17,11 +17,11 @@ report_page syntax template - template_utils thread_page user user_account - user_profile) + user_profile + utils) (libraries bos caqti diff --git a/src/permap.ml b/src/permap.ml index f17f7ed..254f36a 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -1,12 +1,5 @@ -open Template_utils - -let not_logged_in redirect request = - let content = - Format.sprintf - {|Not logged in, please login to access this page|} - (Dream.to_percent_encoded redirect) - in - render_unsafe content request +open Utils +open Syntax let asset_loader _root path _request = match Content.read ("assets/" ^ path) with @@ -19,36 +12,36 @@ let page name request = | None -> Dream.empty `Not_Found | Some page -> let content = Omd.of_string page |> Omd.to_html in - render_unsafe content request + render content request let about request = page "about" request -let register_get request = render_unsafe (Register.f request) request +let register_get request = render (Register.f request) request let register_post request = match%lwt Dream.form request with | `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> ( match User.register ~email ~nick ~password with - | Error e -> render_unsafe e request + | Error e -> render e request | Ok () -> let res = Result.fold ~error:Fun.id ~ok:(fun _ -> "User created ! Welcome !") (User.login ~login:nick ~password request) in - render_unsafe res request ) + render res request ) | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ | `Expired _ | `Wrong_content_type -> Dream.empty `Bad_Request -let login_get request = render_unsafe (Login.f request) request +let login_get request = render (Login.f request) request let login_post request = match%lwt Dream.form request with | `Ok [ ("login", login); ("password", password) ] -> ( match User.login ~login ~password request with - | Error e -> render_unsafe e request + | Error e -> render e request | Ok () -> let url = match Dream.query request "redirect" with @@ -79,228 +72,200 @@ let admin_get request = | Ok (posts, reports) -> Pp_babillard.admin_page_content posts reports request in - render_unsafe res request + render res request let admin_post request = - match Dream.session "user_id" request with - | None -> not_logged_in "/admin" request - | Some user_id -> ( - if not (User.is_admin user_id) 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_user_id = post.user_id in - 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 - | Ok () -> - Dream.respond ~status:`See_Other - ~headers:[ ("Location", "/admin") ] - "" ) - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ - | `Wrong_session _ | `Wrong_content_type -> - Dream.empty `Bad_Request ) + Utils.logged_in_or_redirect request (fun user_id -> + if not (User.is_admin user_id) then Dream.respond ~status:`Forbidden "" + else + match%lwt Dream.form request with + | `Ok [ ("action", action); ("post_id", id) ] -> ( + (* TODO: use let* and Utils.render_result ? *) + let res = + match Babillard.get_post id with + | Error _e as e -> e + | Ok post -> ( + let evil_user_id = post.user_id in + 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 e request + | Ok () -> + (* TODO: ??? *) + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/admin") ] + "" ) + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `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 ()) in - render_unsafe (Catalog_page.f catalog_content) request + render (Catalog_page.f catalog_content) request let delete_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 (Delete_page.f post_preview post_id request) request + render (Delete_page.f post_preview post_id request) request let delete_post request = - let post_id = Dream.param request "post_id" in - match Dream.session "user_id" request with - | None -> not_logged_in (Format.sprintf "/delete/%s" post_id) request - | Some user_id -> ( - (* match on Dream.form needed for hidden csrf field *) - match%lwt Dream.form request with - | `Ok [] -> ( - match Babillard.try_delete_post ~user_id post_id with - | Error e -> render_unsafe e request - | Ok () -> - Dream.respond ~status:`See_Other - ~headers:[ ("Location", "/") ] - "Your post was deleted!" ) - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ - | `Wrong_session _ | `Wrong_content_type -> - Dream.empty `Bad_Request ) + Utils.logged_in_or_redirect request (fun user_id -> + (* match on Dream.form needed for hidden csrf field *) + match%lwt Dream.form request with + | `Ok [] -> ( + (* TODO: use let* and Utils.render_result ? *) + let post_id = Dream.param request "post_id" in + match Babillard.try_delete_post ~user_id post_id with + | Error e -> render e request + | Ok () -> + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/") ] + "Your post was deleted!" ) + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `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 + render (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 "user_id" request with - | None -> not_logged_in (Format.sprintf "/report/%s" post_id) request - | Some user_id -> ( - match%lwt Dream.form request with - | `Ok [ ("reason", reason) ] -> - let res = - match Babillard.report ~user_id ~reason post_id with - | Error e -> e - | Ok () -> "The post was reported!" - in - render_unsafe res request - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ - | `Wrong_session _ | `Wrong_content_type -> - Dream.empty `Bad_Request ) + Utils.logged_in_or_redirect request (fun user_id -> + match%lwt Dream.form request with + | `Ok [ ("reason", reason) ] -> + Utils.render_result request + @@ + let post_id = Dream.param request "post_id" in + let* () = Babillard.report ~user_id ~reason post_id in + Ok "The post was reported!" + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `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 + render (Result.fold ~ok:Fun.id ~error:Fun.id (User.list ())) request let user_profile request = let nick = Dream.param request "user" in match User.get_user_id_from_nick nick with | Error _e -> Dream.respond ~status:`Not_Found "User does not exists" | Ok user_id -> - render_unsafe + render (Result.fold ~ok:Fun.id ~error:Fun.id (User.public_profile user_id)) request let logout request = let _ = Dream.invalidate_session request in let content = "Logged out !" in - render_unsafe content request + render content request let account_get request = - match Dream.session "user_id" request with - | None -> not_logged_in "/account" request - | Some user_id -> - let res = - match User.get_user user_id with - | Error e -> e - | Ok user -> User_account.f user request - in - render_unsafe res request + Utils.logged_in_or_redirect request (fun user_id -> + Utils.render_result request + @@ let* user = User.get_user user_id in + Ok (User_account.f user request) ) (*TODO ask for password *) let account_post request = - match Dream.session "user_id" request with - | None -> not_logged_in "/account" request - | Some user_id -> ( - match%lwt Dream.form request with - | `Ok [ ("delete", _) ] -> - (*TODO ask for confirmation *) - let res = - Result.fold ~error:Fun.id - ~ok:(fun () -> - let _unit_lwt = Dream.invalidate_session request in - "Your account was deleted" ) - (User.delete_user user_id) - in - render_unsafe res request - | `Ok [ ("email", email) ] -> - let res = - Result.fold ~error:Fun.id - ~ok:(fun () -> "Your email was updated!") - (User.update_email email user_id) - in - render_unsafe res request - | `Ok - [ ("confirm-new-password", confirm_password) - ; ("new-password", password) - ] -> - let res = + Utils.logged_in_or_redirect request (fun user_id -> + match%lwt Dream.form request with + | `Ok [ ("delete", _) ] -> + Utils.render_result request + @@ (*TODO ask for confirmation *) + let* () = User.delete_user user_id in + let _unit_lwt = Dream.invalidate_session request in + Ok "Your account was deleted" + | `Ok [ ("email", email) ] -> + Utils.render_result request + @@ let* () = User.update_email email user_id in + Ok "Your email was updated!" + | `Ok + [ ("confirm-new-password", confirm_password) + ; ("new-password", password) + ] -> + Utils.render_result request + @@ if password = confirm_password then - Result.fold ~error:Fun.id - ~ok:(fun _ -> "Your password was updated!") - (User.update_password password user_id) - else "Password confimation does not match" - in - render_unsafe res request - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ - | `Expired _ | `Wrong_content_type -> - Dream.empty `Bad_Request ) + let* () = User.update_password password user_id in + Ok "Your password was updated!" + else Error "Password confirmation does not match" + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ + | `Expired _ | `Wrong_content_type -> + Dream.empty `Bad_Request ) let profile_get request = - match Dream.session "user_id" request with - | None -> not_logged_in "/profile" request - | Some user_id -> - let res = - match User.get_user user_id with - | Error e -> e - | Ok user -> User_profile.f user request - in - render_unsafe res request + Utils.logged_in_or_redirect request (fun user_id -> + Utils.render_result request + @@ let* user = User.get_user user_id in + Ok (User_profile.f user request) ) let profile_post request = - match Dream.session "user_id" request with - | None -> not_logged_in "/profile" request - | Some user_id -> ( - match%lwt Dream.form request with - | `Ok [ ("bio", bio) ] -> ( - match User.update_bio bio user_id with - | Ok () -> - Dream.respond ~status:`See_Other - ~headers:[ ("Location", "/profile") ] - "Your bio was updated!" - | Error e -> render_unsafe e request ) - | `Ok [ ("nick", nick) ] -> ( - match User.update_nick nick user_id with - | Ok () -> - Dream.respond ~status:`See_Other - ~headers:[ ("Location", "/profile") ] - "Your display nick was updated!" - | Error e -> render_unsafe e request ) - | `Ok [ ("content", content); ("count", count); ("label", label) ] -> ( - match int_of_string_opt count with - | None -> render_unsafe "Error: invalid count" request - | Some count -> ( - match User.update_metadata count label content user_id with + Utils.logged_in_or_redirect request (fun user_id -> + match%lwt Dream.form request with + | `Ok [ ("bio", bio) ] -> ( + match User.update_bio bio user_id with + | Ok () -> + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/profile") ] + "Your bio was updated!" + | Error e -> render e request ) + | `Ok [ ("nick", nick) ] -> ( + match User.update_nick nick user_id with | Ok () -> Dream.respond ~status:`See_Other ~headers:[ ("Location", "/profile") ] "Your display nick was updated!" - | Error e -> render_unsafe e request ) ) - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ - | `Expired _ | `Wrong_content_type -> ( - match%lwt Dream.multipart request with - | `Ok [ ("file", file) ] -> ( - match User.upload_avatar file user_id with - | Ok () -> - Dream.respond ~status:`See_Other - ~headers:[ ("Location", "/profile") ] - "Your avatar was updated!" - | Error e -> render_unsafe e request ) + | Error e -> render e request ) + | `Ok [ ("content", content); ("count", count); ("label", label) ] -> ( + match int_of_string_opt count with + | None -> render "Error: invalid count" request + | Some count -> ( + match User.update_metadata count label content user_id with + | Ok () -> + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/profile") ] + "Your display nick was updated!" + | Error e -> render e request ) ) | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ - | `Wrong_session _ | `Wrong_content_type -> - Dream.empty `Bad_Request ) ) + | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ + | `Expired _ | `Wrong_content_type -> ( + match%lwt Dream.multipart request with + | `Ok [ ("file", file) ] -> ( + match User.upload_avatar file user_id with + | Ok () -> + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/profile") ] + "Your avatar was updated!" + | Error e -> render e request ) + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Wrong_content_type -> + Dream.empty `Bad_Request ) ) let get_post_image ~thumbnail request = let id = Dream.param request "id" in let image = - if thumbnail then Image.get_thumbnail id else Image.get_content id + (if thumbnail then Image.get_thumbnail else Image.get_content) id in match image with - | Error e -> render_unsafe e request + | Error e -> render e request | Ok image_opt -> ( match image_opt with | None -> Dream.respond ~status:`Not_Found "Image does not exists" @@ -327,73 +292,71 @@ let get_avatar_image request = | None -> failwith "can't find default avatar" | Some avatar -> Dream.respond ~headers:[ ("Content-Type", "image") ] avatar ) - | Error e -> render_unsafe e request ) + | Error e -> render e request ) let markers request = let markers = Pp_babillard.get_markers () in match markers with | Ok markers -> Dream.respond ~headers:[ ("Content-Type", "application/json") ] markers - | Error e -> render_unsafe e request + | Error e -> render e request -let babillard_get request = render_unsafe (Babillard_page.f request) request +let babillard_get request = render (Babillard_page.f request) request let babillard_post request = - match Dream.session "user_id" request with - | None -> not_logged_in "/" request - | Some user_id -> ( - match%lwt Dream.multipart request with - | `Ok - [ ("alt", [ (_, alt) ]) - ; ("category", categories) - ; ("file", file) - ; ("lat-input", [ (_, lat) ]) - ; ("lng-input", [ (_, lng) ]) - ; ("subject", [ (_, subject) ]) - ; ("tags", [ (_, tags) ]) - ; ("thread-comment", [ (_, comment) ]) - ] - | `Ok - ( ("alt", [ (_, alt) ]) - :: ("file", file) - :: ("lat-input", [ (_, lat) ]) - :: ("lng-input", [ (_, lng) ]) - :: ("subject", [ (_, subject) ]) - :: ("tags", [ (_, tags) ]) - :: ("thread-comment", [ (_, comment) ]) - :: ([] as categories) ) -> ( - let categories = List.map snd categories in - match (Float.of_string_opt lat, Float.of_string_opt lng) with - | None, _ -> render_unsafe "Invalide coordinate" request - | _, None -> render_unsafe "Invalide coordinate" request - | Some lat, Some lng -> ( - let op_or_reply_data = `Op_data (categories, subject, lat, lng) in - let res = - match file with - | [] -> Babillard.make_post ~comment ~tags ~op_or_reply_data user_id - | _ :: _ :: _ -> Error "More than one image" - | [ (image_name, image_content) ] -> - let image_input = (image_name, alt, image_content) in - Babillard.make_post ~comment ~image_input ~tags ~op_or_reply_data - user_id - in - match res with - | Ok thread_id -> - let adress = Format.asprintf "/thread/%s" thread_id in - Dream.respond ~status:`See_Other - ~headers:[ ("Location", adress) ] - "Your thread was posted!" - | Error e -> render_unsafe e request ) ) - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ - | `Wrong_session _ | `Wrong_content_type -> - Dream.empty `Bad_Request ) + Utils.logged_in_or_redirect request (fun user_id -> + match%lwt Dream.multipart request with + | `Ok + [ ("alt", [ (_, alt) ]) + ; ("category", categories) + ; ("file", file) + ; ("lat-input", [ (_, lat) ]) + ; ("lng-input", [ (_, lng) ]) + ; ("subject", [ (_, subject) ]) + ; ("tags", [ (_, tags) ]) + ; ("thread-comment", [ (_, comment) ]) + ] + | `Ok + ( ("alt", [ (_, alt) ]) + :: ("file", file) + :: ("lat-input", [ (_, lat) ]) + :: ("lng-input", [ (_, lng) ]) + :: ("subject", [ (_, subject) ]) + :: ("tags", [ (_, tags) ]) + :: ("thread-comment", [ (_, comment) ]) + :: ([] as categories) ) -> ( + let categories = List.map snd categories in + match (Float.of_string_opt lat, Float.of_string_opt lng) with + | None, _ -> render "Invalide coordinate" request + | _, None -> render "Invalide coordinate" request + | Some lat, Some lng -> ( + let op_or_reply_data = `Op_data (categories, subject, lat, lng) in + let res = + match file with + | [] -> Babillard.make_post ~comment ~tags ~op_or_reply_data user_id + | _ :: _ :: _ -> Error "More than one image" + | [ (image_name, image_content) ] -> + let image_input = (image_name, alt, image_content) in + Babillard.make_post ~comment ~image_input ~tags ~op_or_reply_data + user_id + in + match res with + | Ok thread_id -> + let adress = Format.asprintf "/thread/%s" thread_id in + Dream.respond ~status:`See_Other + ~headers:[ ("Location", adress) ] + "Your thread was posted!" + | Error e -> render e request ) ) + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Wrong_content_type -> + Dream.empty `Bad_Request ) let thread_feed_get request = let thread_id = Dream.param request "thread_id" in if Babillard.thread_exist thread_id then match Pp_babillard.feed thread_id with - | Error e -> render_unsafe e request + | Error e -> render e request | Ok feed -> Dream.respond ~headers:[ ("Content-Type", "application/atom+xml") ] feed else Dream.respond ~status:`Not_Found "Thread not found" @@ -407,43 +370,41 @@ let thread_get request = | Error e -> e | Ok thread_view -> Thread_page.f thread_view thread_id request in - render_unsafe res request + render res request else Dream.respond ~status:`Not_Found "Thread not found" (*form to reply to a thread *) let reply_post request = - let parent_id = Dream.param request "thread_id" in - match Dream.session "user_id" request with - | None -> not_logged_in (Format.sprintf "/thread/%s" parent_id) request - | Some user_id -> ( - match%lwt Dream.multipart request with - | `Ok - [ ("alt", [ (_, alt) ]) - ; ("file", file) - ; ("reply-comment", [ (_, comment) ]) - ; ("tags", [ (_, tags) ]) - ] -> ( - let op_or_reply_data = `Reply_data parent_id in - let res = - match file with - | [] -> Babillard.make_post ~comment ~tags ~op_or_reply_data user_id - | [ (image_name, image_content) ] -> - let image_input = (image_name, alt, image_content) in - Babillard.make_post ~comment ~image_input ~tags ~op_or_reply_data - user_id - | _ :: _ :: _ -> Error "More than one image" - in - match res with - | Ok post_id -> - let adress = Format.sprintf "/thread/%s#%s" parent_id post_id in - Dream.respond ~status:`See_Other - ~headers:[ ("Location", adress) ] - "Your reply was posted!" - | Error e -> render_unsafe e request ) - | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" - | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ - | `Wrong_session _ | `Wrong_content_type -> - Dream.empty `Bad_Request ) + Utils.logged_in_or_redirect request (fun user_id -> + match%lwt Dream.multipart request with + | `Ok + [ ("alt", [ (_, alt) ]) + ; ("file", file) + ; ("reply-comment", [ (_, comment) ]) + ; ("tags", [ (_, tags) ]) + ] -> ( + let parent_id = Dream.param request "thread_id" in + let op_or_reply_data = `Reply_data parent_id in + let res = + match file with + | [] -> Babillard.make_post ~comment ~tags ~op_or_reply_data user_id + | [ (image_name, image_content) ] -> + let image_input = (image_name, alt, image_content) in + Babillard.make_post ~comment ~image_input ~tags ~op_or_reply_data + user_id + | _ :: _ :: _ -> Error "More than one image" + in + match res with + | Ok post_id -> + let adress = Format.sprintf "/thread/%s#%s" parent_id post_id in + Dream.respond ~status:`See_Other + ~headers:[ ("Location", adress) ] + "Your reply was posted!" + | Error e -> render e request ) + | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" + | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Wrong_content_type -> + Dream.empty `Bad_Request ) let error_template _error _debug_info response = let status = Dream.status response in @@ -474,7 +435,7 @@ let routes = ; get_ "/delete/:post_id" delete_get ; post "/delete/:post_id" delete_post ; get_ "/discuss" Discuss.render - ; get_ "/discuss/:comrade_id" Discuss.render_one + ; get_ "/discuss/:comrade_id" Discuss.renderone ; post "/discuss/:comrade_id" Discuss.post ; get_ "/img/:id" (get_post_image ~thumbnail:false) ; get_ "/img/s/:id" (get_post_image ~thumbnail:true) diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml index ca7de6f..c61a6da 100644 --- a/src/pp_babillard.ml +++ b/src/pp_babillard.ml @@ -31,7 +31,7 @@ let pp_post fmt t = %s - + |} id id image_alt image_alt id | None -> Format.fprintf fmt "" @@ -108,10 +108,11 @@ let pp_post fmt t = in let categories = List.sort String.compare categories in let tags = List.sort String.compare tags in + let pp_sep = Format.pp_print_space in Format.fprintf fmt {|
    %a%a
    |} - (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_category) + (Format.pp_print_list ~pp_sep pp_print_category) categories - (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_tag) + (Format.pp_print_list ~pp_sep pp_print_tag) tags in let tags = List.sort String.compare tags in @@ -138,9 +139,9 @@ let pp_post fmt t = %a %a %a -
    %s
    +
    %s
    %a - + |} id subject link () post_info_view () image_view () comment tags_view () @@ -295,7 +296,7 @@ let pp_checkboxes fmt () = category category category category in Format.fprintf fmt - {| + {|
    %a
    |} diff --git a/src/template_utils.ml b/src/template_utils.ml deleted file mode 100644 index 5293aca..0000000 --- a/src/template_utils.ml +++ /dev/null @@ -1,21 +0,0 @@ -let get_title content = - let open Soup in - try - let soup = content |> parse in - soup $ "h1" |> R.leaf_text - with Failure _e -> "Permap" - -let render ?title content request = - let title = - match title with None -> get_title content | Some title -> title - in - Dream.html - @@ Template.render_unsafe ~title:(Dream.html_escape title) - ~content:(Dream.html_escape content) - request - -let render_unsafe ?title content request = - let title = - match title with None -> get_title content | Some title -> title - in - Dream.html @@ Template.render_unsafe ~title ~content request diff --git a/src/utils.ml b/src/utils.ml new file mode 100644 index 0000000..4aae133 --- /dev/null +++ b/src/utils.ml @@ -0,0 +1,24 @@ +let get_title content = + let open Soup in + try + let soup = content |> parse in + soup $ "h1" |> R.leaf_text + with Failure _e -> "Permap" + +let render ?title content request = + let title = + match title with None -> get_title content | Some title -> title + in + Dream.html @@ Template.render_unsafe ~title ~content request + +(* TODO: different error code ? *) +let render_result request = function Error cnt | Ok cnt -> render cnt request + +(* TODO: maybe we can remove path and find it in request ? *) +let logged_in_or_redirect request logged_in = + match Dream.session "user_id" request with + | None -> + let target = Dream.target request in + let redirect_url = Format.sprintf "/login=?redirect=%s" target in + Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" + | Some user_id -> logged_in user_id