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 ->
+
+% 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