swrup/geochan
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

refactor some code

Browse source
This commit is contained in:
pena 2022-04-05 23:08:57 +02:00 • committed by Swrup
parent 5f89b5eb61
commit 855564bed6
7 changed files with 330 additions and 403 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/babillard.ml
View file

@ -267,10 +267,12 @@ let upload_post ~image post =
(fun cited_id -> Db.exec Q.upload_post_reply (cited_id, id)) (fun cited_id -> Db.exec Q.upload_post_reply (cited_id, id))
citations citations
in in
let^ () =
match thread_data with match thread_data with
| None -> Ok id | None -> Ok ()
| Some { subject; lng; lat } -> | Some { subject; lng; lat } ->
let^ () = Db.exec Q.upload_thread_info (id, subject, lat, lng) in Db.exec Q.upload_thread_info (id, subject, lat, lng)
in
Ok id Ok id
let build_reply ~comment ~image_info ~tag_list ?parent_id user_id = let build_reply ~comment ~image_info ~tag_list ?parent_id user_id =
@ -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" if not is_valid_latlng then Error "Invalid coordinate"
else if String.length subject > 600 then Error "Invalid subject" else if String.length subject > 600 then Error "Invalid subject"
else else
let thread_data = { subject; lng; lat } in
let* reply = build_reply ~comment ~image_info ~tag_list user_id in let* reply = build_reply ~comment ~image_info ~tag_list user_id in
let op = (thread_data, reply) in Ok ({ subject; lng; lat }, reply)
Ok op
let build_image image_input =
let* image = Image.make_image image_input in
Ok image
let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id = let make_post ~comment ?image_input ~tags ~op_or_reply_data user_id =
let tag_list = String.split_on_char ',' tags in 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 match image_input with
| None -> Ok (None, None) | None -> Ok (None, None)
| Some image_input -> | 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)) Ok (Some image, Some (image.name, image.alt))
in in
let* post = let* post =
@ -391,8 +387,7 @@ let get_post id =
let get_thread_data id = let get_thread_data id =
if thread_exist id then if thread_exist id then
let^? subject, lat, lng = Db.find_opt Q.get_thread_info id in let^? subject, lat, lng = Db.find_opt Q.get_thread_info id in
let thread_data = { subject; lat; lng } in Ok { subject; lat; lng }
Ok thread_data
else Error "not an op" else Error "not an op"
let get_op id = let get_op id =

79
src/discuss.ml
View file

@ -1,4 +1,5 @@
open Db open Db
open Syntax
(** Creating the table of all messages. (** Creating the table of all messages.
@ -57,18 +58,15 @@ let find_messages k1 k2 =
Ok comrades Ok comrades
(** display the list of discussions *) (** display the list of discussions *)
let render request = let render =
match Dream.session "user_id" request with let pp_one_discuss fmt (id, nick) =
| None -> Format.fprintf fmt {|<li><a href="/discuss/%s">%s</a></li>|} id nick
let redirect_url =
Format.sprintf "/login=?redirect=%s" (Dream.to_percent_encoded "/discuss")
in in
Dream.respond ~status:`See_Other ~headers:[ ("Location", redirect_url) ] "" fun request ->
| Some user_id -> ( Utils.logged_in_or_redirect request (fun user_id ->
match find_comrades user_id with Utils.render_result request
| Error e -> Template_utils.render_unsafe e request @@ let* comrades = find_comrades user_id in
| Ok comrades -> ( let* comrades =
let comrades =
Syntax.unwrap_list Syntax.unwrap_list
(fun id -> (fun id ->
match User.get_nick id with match User.get_nick id with
@ -76,32 +74,19 @@ let render request =
| Ok nick -> Ok (id, nick) ) | Ok nick -> Ok (id, nick) )
comrades comrades
in in
match comrades with Ok
| Error e -> Template_utils.render_unsafe e request (Format.asprintf "<ul>%a</ul>"
| Ok comrades ->
let pp_one_discuss fmt (id, nick) =
Format.fprintf fmt {|<li><a href="/discuss/%s">%s</a></li>|} id nick
in
let output =
Format.asprintf "<ul>%a</ul>"
(Format.pp_print_list (Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "<br />") ~pp_sep:(fun fmt () -> Format.fprintf fmt "<br />")
pp_one_discuss ) pp_one_discuss )
comrades comrades ) )
in
Template_utils.render_unsafe output request ) )
let pp_discussion (request, user_id, comrade_id) = let pp_discussion (request, user_id, comrade_id) =
let path = Format.sprintf "/discuss/%s" comrade_id in let path = Format.sprintf "/discuss/%s" comrade_id in
match find_messages user_id comrade_id with Utils.render_result request
| Error e -> Template_utils.render_unsafe e request @@ let* msg = find_messages user_id comrade_id in
| Ok msg -> ( let* user_nick = User.get_nick user_id in
match User.get_nick user_id with let* comrade_nick = User.get_nick comrade_id in
| 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) = let pp_one_msg fmt (from_id, msg) =
Format.fprintf fmt "<li>%s | %s</li>" Format.fprintf fmt "<li>%s | %s</li>"
(if from_id = user_id then user_nick else comrade_nick) (if from_id = user_id then user_nick else comrade_nick)
@ -114,7 +99,7 @@ let pp_discussion (request, user_id, comrade_id) =
pp_one_msg ) pp_one_msg )
msg msg
in in
Template_utils.render_unsafe Ok
(Format.asprintf (Format.asprintf
{|%a<br /> {|%a<br />
%s %s
@ -123,21 +108,12 @@ let pp_discussion (request, user_id, comrade_id) =
</form>|} </form>|}
pp_all_msg msg pp_all_msg msg
(Dream.form_tag ~action:path request) ) (Dream.form_tag ~action:path request) )
request ) )
(** display one discussion *) (** display one discussion *)
let render_one request = let renderone request =
Utils.logged_in_or_redirect request (fun user_id ->
let comrade_id = Dream.param request "comrade_id" in let comrade_id = Dream.param request "comrade_id" in
pp_discussion (request, user_id, comrade_id) )
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 insert_msg from_id to_id msg = let insert_msg from_id to_id msg =
let open Syntax in let open Syntax in
@ -146,22 +122,13 @@ let insert_msg from_id to_id msg =
(** handle posts *) (** handle posts *)
let post request = let post request =
let comrade_id = Dream.param request "comrade_id" in Utils.logged_in_or_redirect request (fun user_id ->
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 match%lwt Dream.form request with
| `Ok [ ("msg", msg) ] -> begin | `Ok [ ("msg", msg) ] -> begin
let comrade_id = Dream.param request "comrade_id" in
match insert_msg user_id comrade_id msg with match insert_msg user_id comrade_id msg with
| Ok () -> pp_discussion (request, user_id, comrade_id) | Ok () -> pp_discussion (request, user_id, comrade_id)
| Error e -> Template_utils.render_unsafe e request | Error e -> Utils.render e request
end end
| `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
| `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _

4
src/dune
View file

@ -17,11 +17,11 @@
report_page report_page
syntax syntax
template template
template_utils
thread_page thread_page
user user
user_account user_account
user_profile) user_profile
utils)
(libraries (libraries
bos bos
caqti caqti

181
src/permap.ml
View file

@ -1,12 +1,5 @@
open Template_utils open Utils
open Syntax
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
let asset_loader _root path _request = let asset_loader _root path _request =
match Content.read ("assets/" ^ path) with match Content.read ("assets/" ^ path) with
@ -19,36 +12,36 @@ let page name request =
| None -> Dream.empty `Not_Found | None -> Dream.empty `Not_Found
| Some page -> | Some page ->
let content = Omd.of_string page |> Omd.to_html in let content = Omd.of_string page |> Omd.to_html in
render_unsafe content request render content request
let about request = page "about" 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 = let register_post request =
match%lwt Dream.form request with match%lwt Dream.form request with
| `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> ( | `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> (
match User.register ~email ~nick ~password with match User.register ~email ~nick ~password with
| Error e -> render_unsafe e request | Error e -> render e request
| Ok () -> | Ok () ->
let res = let res =
Result.fold ~error:Fun.id Result.fold ~error:Fun.id
~ok:(fun _ -> "User created ! Welcome !") ~ok:(fun _ -> "User created ! Welcome !")
(User.login ~login:nick ~password request) (User.login ~login:nick ~password request)
in in
render_unsafe res request ) render res request )
| `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
| `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _
| `Expired _ | `Wrong_content_type -> | `Expired _ | `Wrong_content_type ->
Dream.empty `Bad_Request 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 = let login_post request =
match%lwt Dream.form request with match%lwt Dream.form request with
| `Ok [ ("login", login); ("password", password) ] -> ( | `Ok [ ("login", login); ("password", password) ] -> (
match User.login ~login ~password request with match User.login ~login ~password request with
| Error e -> render_unsafe e request | Error e -> render e request
| Ok () -> | Ok () ->
let url = let url =
match Dream.query request "redirect" with match Dream.query request "redirect" with
@ -79,16 +72,15 @@ let admin_get request =
| Ok (posts, reports) -> | Ok (posts, reports) ->
Pp_babillard.admin_page_content posts reports request Pp_babillard.admin_page_content posts reports request
in in
render_unsafe res request render res request
let admin_post request = let admin_post request =
match Dream.session "user_id" request with Utils.logged_in_or_redirect request (fun user_id ->
| None -> not_logged_in "/admin" request
| Some user_id -> (
if not (User.is_admin user_id) then Dream.respond ~status:`Forbidden "" if not (User.is_admin user_id) then Dream.respond ~status:`Forbidden ""
else else
match%lwt Dream.form request with match%lwt Dream.form request with
| `Ok [ ("action", action); ("post_id", id) ] -> ( | `Ok [ ("action", action); ("post_id", id) ] -> (
(* TODO: use let* and Utils.render_result ? *)
let res = let res =
match Babillard.get_post id with match Babillard.get_post id with
| Error _e as e -> e | Error _e as e -> e
@ -103,8 +95,9 @@ let admin_post request =
| Ignore -> Babillard.ignore_report id ) ) | Ignore -> Babillard.ignore_report id ) )
in in
match res with match res with
| Error e -> render_unsafe e request | Error e -> render e request
| Ok () -> | Ok () ->
(* TODO: ??? *)
Dream.respond ~status:`See_Other Dream.respond ~status:`See_Other
~headers:[ ("Location", "/admin") ] ~headers:[ ("Location", "/admin") ]
"" ) "" )
@ -117,25 +110,24 @@ let catalog request =
let catalog_content = let catalog_content =
Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.catalog_content ()) Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.catalog_content ())
in in
render_unsafe (Catalog_page.f catalog_content) request render (Catalog_page.f catalog_content) request
let delete_get request = let delete_get request =
let post_id = Dream.param request "post_id" in let post_id = Dream.param request "post_id" in
let post_preview = let post_preview =
Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.view_post post_id) Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.view_post post_id)
in 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 delete_post request =
let post_id = Dream.param request "post_id" in Utils.logged_in_or_redirect request (fun user_id ->
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 on Dream.form needed for hidden csrf field *)
match%lwt Dream.form request with match%lwt Dream.form request with
| `Ok [] -> ( | `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 match Babillard.try_delete_post ~user_id post_id with
| Error e -> render_unsafe e request | Error e -> render e request
| Ok () -> | Ok () ->
Dream.respond ~status:`See_Other Dream.respond ~status:`See_Other
~headers:[ ("Location", "/") ] ~headers:[ ("Location", "/") ]
@ -150,109 +142,82 @@ let report_get request =
let post_preview = let post_preview =
Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.view_post post_id) Result.fold ~ok:Fun.id ~error:Fun.id (Pp_babillard.view_post post_id)
in 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 report_post request =
let post_id = Dream.param request "post_id" in Utils.logged_in_or_redirect request (fun user_id ->
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 match%lwt Dream.form request with
| `Ok [ ("reason", reason) ] -> | `Ok [ ("reason", reason) ] ->
let res = Utils.render_result request
match Babillard.report ~user_id ~reason post_id with @@
| Error e -> e let post_id = Dream.param request "post_id" in
| Ok () -> "The post was reported!" let* () = Babillard.report ~user_id ~reason post_id in
in Ok "The post was reported!"
render_unsafe res request
| `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
| `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
| `Wrong_session _ | `Wrong_content_type -> | `Wrong_session _ | `Wrong_content_type ->
Dream.empty `Bad_Request ) Dream.empty `Bad_Request )
let user 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 user_profile request =
let nick = Dream.param request "user" in let nick = Dream.param request "user" in
match User.get_user_id_from_nick nick with match User.get_user_id_from_nick nick with
| Error _e -> Dream.respond ~status:`Not_Found "User does not exists" | Error _e -> Dream.respond ~status:`Not_Found "User does not exists"
| Ok user_id -> | Ok user_id ->
render_unsafe render
(Result.fold ~ok:Fun.id ~error:Fun.id (User.public_profile user_id)) (Result.fold ~ok:Fun.id ~error:Fun.id (User.public_profile user_id))
request request
let logout request = let logout request =
let _ = Dream.invalidate_session request in let _ = Dream.invalidate_session request in
let content = "Logged out !" in let content = "Logged out !" in
render_unsafe content request render content request
let account_get request = let account_get request =
match Dream.session "user_id" request with Utils.logged_in_or_redirect request (fun user_id ->
| None -> not_logged_in "/account" request Utils.render_result request
| Some user_id -> @@ let* user = User.get_user user_id in
let res = Ok (User_account.f user request) )
match User.get_user user_id with
| Error e -> e
| Ok user -> User_account.f user request
in
render_unsafe res request
(*TODO ask for password *) (*TODO ask for password *)
let account_post request = let account_post request =
match Dream.session "user_id" request with Utils.logged_in_or_redirect request (fun user_id ->
| None -> not_logged_in "/account" request
| Some user_id -> (
match%lwt Dream.form request with match%lwt Dream.form request with
| `Ok [ ("delete", _) ] -> | `Ok [ ("delete", _) ] ->
(*TODO ask for confirmation *) Utils.render_result request
let res = @@ (*TODO ask for confirmation *)
Result.fold ~error:Fun.id let* () = User.delete_user user_id in
~ok:(fun () ->
let _unit_lwt = Dream.invalidate_session request in let _unit_lwt = Dream.invalidate_session request in
"Your account was deleted" ) Ok "Your account was deleted"
(User.delete_user user_id)
in
render_unsafe res request
| `Ok [ ("email", email) ] -> | `Ok [ ("email", email) ] ->
let res = Utils.render_result request
Result.fold ~error:Fun.id @@ let* () = User.update_email email user_id in
~ok:(fun () -> "Your email was updated!") Ok "Your email was updated!"
(User.update_email email user_id)
in
render_unsafe res request
| `Ok | `Ok
[ ("confirm-new-password", confirm_password) [ ("confirm-new-password", confirm_password)
; ("new-password", password) ; ("new-password", password)
] -> ] ->
let res = Utils.render_result request
@@
if password = confirm_password then if password = confirm_password then
Result.fold ~error:Fun.id let* () = User.update_password password user_id in
~ok:(fun _ -> "Your password was updated!") Ok "Your password was updated!"
(User.update_password password user_id) else Error "Password confirmation does not match"
else "Password confimation does not match"
in
render_unsafe res request
| `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
| `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _
| `Expired _ | `Wrong_content_type -> | `Expired _ | `Wrong_content_type ->
Dream.empty `Bad_Request ) Dream.empty `Bad_Request )
let profile_get request = let profile_get request =
match Dream.session "user_id" request with Utils.logged_in_or_redirect request (fun user_id ->
| None -> not_logged_in "/profile" request Utils.render_result request
| Some user_id -> @@ let* user = User.get_user user_id in
let res = Ok (User_profile.f user request) )
match User.get_user user_id with
| Error e -> e
| Ok user -> User_profile.f user request
in
render_unsafe res request
let profile_post request = let profile_post request =
match Dream.session "user_id" request with Utils.logged_in_or_redirect request (fun user_id ->
| None -> not_logged_in "/profile" request
| Some user_id -> (
match%lwt Dream.form request with match%lwt Dream.form request with
| `Ok [ ("bio", bio) ] -> ( | `Ok [ ("bio", bio) ] -> (
match User.update_bio bio user_id with match User.update_bio bio user_id with
@ -260,24 +225,24 @@ let profile_post request =
Dream.respond ~status:`See_Other Dream.respond ~status:`See_Other
~headers:[ ("Location", "/profile") ] ~headers:[ ("Location", "/profile") ]
"Your bio was updated!" "Your bio was updated!"
| Error e -> render_unsafe e request ) | Error e -> render e request )
| `Ok [ ("nick", nick) ] -> ( | `Ok [ ("nick", nick) ] -> (
match User.update_nick nick user_id with match User.update_nick nick user_id with
| Ok () -> | Ok () ->
Dream.respond ~status:`See_Other Dream.respond ~status:`See_Other
~headers:[ ("Location", "/profile") ] ~headers:[ ("Location", "/profile") ]
"Your display nick was updated!" "Your display nick was updated!"
| Error e -> render_unsafe e request ) | Error e -> render e request )
| `Ok [ ("content", content); ("count", count); ("label", label) ] -> ( | `Ok [ ("content", content); ("count", count); ("label", label) ] -> (
match int_of_string_opt count with match int_of_string_opt count with
| None -> render_unsafe "Error: invalid count" request | None -> render "Error: invalid count" request
| Some count -> ( | Some count -> (
match User.update_metadata count label content user_id with match User.update_metadata count label content user_id with
| Ok () -> | Ok () ->
Dream.respond ~status:`See_Other Dream.respond ~status:`See_Other
~headers:[ ("Location", "/profile") ] ~headers:[ ("Location", "/profile") ]
"Your display nick was updated!" "Your display nick was updated!"
| Error e -> render_unsafe e request ) ) | Error e -> render e request ) )
| `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
| `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Wrong_session _
| `Expired _ | `Wrong_content_type -> ( | `Expired _ | `Wrong_content_type -> (
@ -288,7 +253,7 @@ let profile_post request =
Dream.respond ~status:`See_Other Dream.respond ~status:`See_Other
~headers:[ ("Location", "/profile") ] ~headers:[ ("Location", "/profile") ]
"Your avatar was updated!" "Your avatar was updated!"
| Error e -> render_unsafe e request ) | Error e -> render e request )
| `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
| `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
| `Wrong_session _ | `Wrong_content_type -> | `Wrong_session _ | `Wrong_content_type ->
@ -297,10 +262,10 @@ let profile_post request =
let get_post_image ~thumbnail request = let get_post_image ~thumbnail request =
let id = Dream.param request "id" in let id = Dream.param request "id" in
let image = 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 in
match image with match image with
| Error e -> render_unsafe e request | Error e -> render e request
| Ok image_opt -> ( | Ok image_opt -> (
match image_opt with match image_opt with
| None -> Dream.respond ~status:`Not_Found "Image does not exists" | None -> Dream.respond ~status:`Not_Found "Image does not exists"
@ -327,21 +292,19 @@ let get_avatar_image request =
| None -> failwith "can't find default avatar" | None -> failwith "can't find default avatar"
| Some avatar -> | Some avatar ->
Dream.respond ~headers:[ ("Content-Type", "image") ] avatar ) Dream.respond ~headers:[ ("Content-Type", "image") ] avatar )
| Error e -> render_unsafe e request ) | Error e -> render e request )
let markers request = let markers request =
let markers = Pp_babillard.get_markers () in let markers = Pp_babillard.get_markers () in
match markers with match markers with
| Ok markers -> | Ok markers ->
Dream.respond ~headers:[ ("Content-Type", "application/json") ] 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 = let babillard_post request =
match Dream.session "user_id" request with Utils.logged_in_or_redirect request (fun user_id ->
| None -> not_logged_in "/" request
| Some user_id -> (
match%lwt Dream.multipart request with match%lwt Dream.multipart request with
| `Ok | `Ok
[ ("alt", [ (_, alt) ]) [ ("alt", [ (_, alt) ])
@ -364,8 +327,8 @@ let babillard_post request =
:: ([] as categories) ) -> ( :: ([] as categories) ) -> (
let categories = List.map snd categories in let categories = List.map snd categories in
match (Float.of_string_opt lat, Float.of_string_opt lng) with match (Float.of_string_opt lat, Float.of_string_opt lng) with
| None, _ -> render_unsafe "Invalide coordinate" request | None, _ -> render "Invalide coordinate" request
| _, None -> render_unsafe "Invalide coordinate" request | _, None -> render "Invalide coordinate" request
| Some lat, Some lng -> ( | Some lat, Some lng -> (
let op_or_reply_data = `Op_data (categories, subject, lat, lng) in let op_or_reply_data = `Op_data (categories, subject, lat, lng) in
let res = let res =
@ -383,7 +346,7 @@ let babillard_post request =
Dream.respond ~status:`See_Other Dream.respond ~status:`See_Other
~headers:[ ("Location", adress) ] ~headers:[ ("Location", adress) ]
"Your thread was posted!" "Your thread was posted!"
| Error e -> render_unsafe e request ) ) | Error e -> render e request ) )
| `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
| `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
| `Wrong_session _ | `Wrong_content_type -> | `Wrong_session _ | `Wrong_content_type ->
@ -393,7 +356,7 @@ let thread_feed_get request =
let thread_id = Dream.param request "thread_id" in let thread_id = Dream.param request "thread_id" in
if Babillard.thread_exist thread_id then if Babillard.thread_exist thread_id then
match Pp_babillard.feed thread_id with match Pp_babillard.feed thread_id with
| Error e -> render_unsafe e request | Error e -> render e request
| Ok feed -> | Ok feed ->
Dream.respond ~headers:[ ("Content-Type", "application/atom+xml") ] feed Dream.respond ~headers:[ ("Content-Type", "application/atom+xml") ] feed
else Dream.respond ~status:`Not_Found "Thread not found" else Dream.respond ~status:`Not_Found "Thread not found"
@ -407,15 +370,12 @@ let thread_get request =
| Error e -> e | Error e -> e
| Ok thread_view -> Thread_page.f thread_view thread_id request | Ok thread_view -> Thread_page.f thread_view thread_id request
in in
render_unsafe res request render res request
else Dream.respond ~status:`Not_Found "Thread not found" else Dream.respond ~status:`Not_Found "Thread not found"
(*form to reply to a thread *) (*form to reply to a thread *)
let reply_post request = let reply_post request =
let parent_id = Dream.param request "thread_id" in Utils.logged_in_or_redirect request (fun user_id ->
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 match%lwt Dream.multipart request with
| `Ok | `Ok
[ ("alt", [ (_, alt) ]) [ ("alt", [ (_, alt) ])
@ -423,6 +383,7 @@ let reply_post request =
; ("reply-comment", [ (_, comment) ]) ; ("reply-comment", [ (_, comment) ])
; ("tags", [ (_, tags) ]) ; ("tags", [ (_, tags) ])
] -> ( ] -> (
let parent_id = Dream.param request "thread_id" in
let op_or_reply_data = `Reply_data parent_id in let op_or_reply_data = `Reply_data parent_id in
let res = let res =
match file with match file with
@ -439,7 +400,7 @@ let reply_post request =
Dream.respond ~status:`See_Other Dream.respond ~status:`See_Other
~headers:[ ("Location", adress) ] ~headers:[ ("Location", adress) ]
"Your reply was posted!" "Your reply was posted!"
| Error e -> render_unsafe e request ) | Error e -> render e request )
| `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form" | `Ok _ -> Dream.respond ~status:`Bad_Request "invalid form"
| `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
| `Wrong_session _ | `Wrong_content_type -> | `Wrong_session _ | `Wrong_content_type ->
@ -474,7 +435,7 @@ let routes =
; get_ "/delete/:post_id" delete_get ; get_ "/delete/:post_id" delete_get
; post "/delete/:post_id" delete_post ; post "/delete/:post_id" delete_post
; get_ "/discuss" Discuss.render ; get_ "/discuss" Discuss.render
; get_ "/discuss/:comrade_id" Discuss.render_one ; get_ "/discuss/:comrade_id" Discuss.renderone
; post "/discuss/:comrade_id" Discuss.post ; post "/discuss/:comrade_id" Discuss.post
; get_ "/img/:id" (get_post_image ~thumbnail:false) ; get_ "/img/:id" (get_post_image ~thumbnail:false)
; get_ "/img/s/:id" (get_post_image ~thumbnail:true) ; get_ "/img/s/:id" (get_post_image ~thumbnail:true)

5
src/pp_babillard.ml
View file

@ -108,10 +108,11 @@ let pp_post fmt t =
in in
let categories = List.sort String.compare categories in let categories = List.sort String.compare categories in
let tags = List.sort String.compare tags in let tags = List.sort String.compare tags in
let pp_sep = Format.pp_print_space in
Format.fprintf fmt {|<div class="tags">%a%a</div>|} Format.fprintf fmt {|<div class="tags">%a%a</div>|}
(Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_category) (Format.pp_print_list ~pp_sep pp_print_category)
categories categories
(Format.pp_print_list ~pp_sep:Format.pp_print_space pp_print_tag) (Format.pp_print_list ~pp_sep pp_print_tag)
tags tags
in in
let tags = List.sort String.compare tags in let tags = List.sort String.compare tags in

21
src/template_utils.ml
View file

@ -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

24
src/utils.ml Normal file
View file

@ -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