refactor some code
This commit is contained in:
parent
5f89b5eb61
commit
855564bed6
7 changed files with 330 additions and 403 deletions
493
src/permap.ml
493
src/permap.ml
|
|
@ -1,12 +1,5 @@
|
|||
open Template_utils
|
||||
|
||||
let not_logged_in redirect request =
|
||||
let content =
|
||||
Format.sprintf
|
||||
{|Not logged in, please <a href="/login?redirect=%s">login<a> 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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue