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 %s %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 "%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 "Send
|}
- 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 =
-
+
|}
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
-
+
%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
