wip: delete post

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"

src/delete_page.eml.html

@@ -0,0 +1,20 @@
+let f post_preview post_id request =
+
+<script type="text/javascript" src="/assets/js/js_catalog.js" defer="defer"></script>
+      <%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
+  <a href="/login?redirect=<%s redirect%>">Login</a> to delete your post.
+% | Some _nick ->
+  <div class="row mb-3">
+    <div class="col-md-6" id="delete-form">
+      <div class="postForm">
+<%s! Dream.form_tag ~action:url ~enctype:`Multipart_form_data request %>
+          <button name="delete-button" type="submit" class="btn btn-primary">DELETE</button>
+        </form>
+      </div>
+    </div>
+  </div>
+% end;

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)

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

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