diff --git a/src/babillard.ml b/src/babillard.ml index ae6f061..0f41d23 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -193,6 +193,10 @@ module Q = struct let get_threads = Caqti_request.collect Caqti_type.unit Caqti_type.string "SELECT thread_id FROM thread_info;" + + let delete_post = + Caqti_request.exec Caqti_type.string + "DELETE FROM post_user WHERE post_id=?;" end let () = @@ -442,3 +446,10 @@ let get_op id = let get_posts ids = unwrap_list get_post ids let get_ops ids = unwrap_list get_op ids + +let try_delete_post ~nick id = + let* post = get_post id in + if post.nick = nick then + let^ () = Db.exec Q.delete_post id in + Ok () + else Error "You can only delete your posts" diff --git a/src/delete_page.eml.html b/src/delete_page.eml.html new file mode 100644 index 0000000..9cfd0d2 --- /dev/null +++ b/src/delete_page.eml.html @@ -0,0 +1,20 @@ +let f post_preview post_id request = + + + <%s! post_preview %> +% let url = Format.sprintf "/delete/%s" post_id in +% begin match Dream.session "nick" request with +% | None -> +% let redirect = Dream.to_percent_encoded url in + Login to delete your post. +% | Some _nick -> +
+
+
+<%s! Dream.form_tag ~action:url ~enctype:`Multipart_form_data request %> + + +
+
+
+% end; diff --git a/src/dune b/src/dune index 917bc41..552b159 100644 --- a/src/dune +++ b/src/dune @@ -5,6 +5,7 @@ babillard babillard_page catalog_page + delete_page bindings content db @@ -42,6 +43,12 @@ (action (run dream_eml %{deps} --workspace %{workspace_root}))) +(rule + (targets delete_page.ml) + (deps delete_page.eml.html) + (action + (run dream_eml %{deps} --workspace %{workspace_root}))) + (rule (targets template.ml) (deps template.eml.html) diff --git a/src/permap.ml b/src/permap.ml index aabc085..be2acd1 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -70,6 +70,25 @@ let catalog request = in render_unsafe (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 + +let delete_post request = + let post_id = Dream.param request "post_id" in + match Dream.session "nick" request with + | None -> render_unsafe "Not logged in" request + | Some nick -> ( + match Babillard.try_delete_post ~nick post_id with + | Error e -> render_unsafe e request + | Ok () -> + Dream.respond ~status:`See_Other + ~headers:[ ("Location", "/") ] + "Your post was deleted!" ) + let user request = render_unsafe (Result.fold ~ok:Fun.id ~error:Fun.id (User.list ())) request @@ -273,6 +292,8 @@ let routes = ; get_ "/thread/:thread_id" thread_get ; post "/thread/:thread_id" reply_post ; get_ "/catalog" catalog + ; get_ "/delete/:post_id" delete_get + ; post "/delete/:post_id" delete_post ] @ if App.open_registration then diff --git a/src/pp_babillard.ml b/src/pp_babillard.ml index bf90705..ecac00e 100644 --- a/src/pp_babillard.ml +++ b/src/pp_babillard.ml @@ -122,6 +122,10 @@ let pp_post fmt t = in pp +let view_post id = + let* post = get_post id in + Ok (Format.asprintf "%a" pp_post (Post post)) + let pp_thread_preview fmt op = let thread_data, post = op in let thread_preview = @@ -137,7 +141,6 @@ let pp_thread_preview fmt op = thread_preview let catalog_content () = - Format.printf "catalog_content@."; let^ ids = Db.collect_list Q.get_threads () in let* ops = get_ops ids in let previews = List.map (Format.asprintf "%a" pp_thread_preview) ops in