separate image_content from image_info

src/babillard.ml

@@ -13,7 +13,7 @@ type reply =
   ; date : int
   ; nick : string
   ; comment : string
-  ; image : (string * string * string) option
+  ; image_info : (string * string) option
   ; tags : string list
   ; replies : string list
   ; citations : string list
@@ -64,11 +64,15 @@ module Q = struct
       "CREATE TABLE IF NOT EXISTS post_comment (post_id TEXT, comment TEXT, \
        FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
 
-  let create_post_image_table =
+  let create_image_info_table =
     Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS post_image (post_id TEXT, image_name TEXT, \
+      "CREATE TABLE IF NOT EXISTS image_info (post_id TEXT, image_name TEXT, \
-       image_content TEXT, image_alt TEXT, FOREIGN KEY(post_id) REFERENCES \
+       image_alt TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
-       post_user(post_id));"
+
+  let create_image_content_table =
+    Caqti_request.exec Caqti_type.unit
+      "CREATE TABLE IF NOT EXISTS image_content (post_id TEXT,image_content \
+       TEXT, FOREIGN KEY(post_id) REFERENCES post_user(post_id));"
 
   let create_post_gps_table =
     Caqti_request.exec Caqti_type.unit
@@ -95,10 +99,15 @@ module Q = struct
       Caqti_type.(tup3 string float float)
       "INSERT INTO post_gps VALUES (?,?,?);"
 
-  let upload_post_image =
+  let upload_image_info =
     Caqti_request.exec
-      Caqti_type.(tup4 string string string string)
+      Caqti_type.(tup3 string string string)
-      "INSERT INTO post_image VALUES (?,?,?,?);"
+      "INSERT INTO image_info VALUES (?,?,?);"
+
+  let upload_image_content =
+    Caqti_request.exec
+      Caqti_type.(tup2 string string)
+      "INSERT INTO image_content VALUES (?,?);"
 
   let upload_post_reply =
     Caqti_request.exec
@@ -145,12 +154,12 @@ module Q = struct
 
   let get_post_image_content =
     Caqti_request.find_opt Caqti_type.string Caqti_type.string
-      "SELECT image_content FROM post_image WHERE post_id=?;"
+      "SELECT image_content FROM image_content WHERE post_id=?;"
 
   let get_post_image_info =
     Caqti_request.find_opt Caqti_type.string
       Caqti_type.(tup2 string string)
-      "SELECT image_name,image_alt FROM post_image WHERE post_id=?;"
+      "SELECT image_name,image_alt FROM image_info WHERE post_id=?;"
 
   let get_post_tags =
     Caqti_request.collect Caqti_type.string Caqti_type.string
@@ -203,7 +212,8 @@ let () =
     ; Q.create_post_citations_table
     ; Q.create_post_date_table
     ; Q.create_post_comment_table
-    ; Q.create_post_image_table
+    ; Q.create_image_info_table
+    ; Q.create_image_content_table
     ; Q.create_post_gps_table
     ; Q.create_post_subject_table
     ; Q.create_post_tags_table
@@ -217,7 +227,7 @@ let () =
 let parse_image image =
   match image with
   | None -> Ok None
-  | Some (name, content, alt) ->
+  | Some ((name, alt), content) ->
     let name =
       match name with
       | Some name -> Dream.html_escape name
@@ -227,7 +237,7 @@ let parse_image image =
     in
     if not (is_valid_image content) then Error "invalid image"
     else if String.length alt > 1000 then Error "Image description too long"
-    else Ok (Some (name, content, alt))
+    else Ok (Some ((name, alt), content))
 
 (*TODO switch to markdown !*)
 (* insert html into the comment, and keep tracks of citations :
@@ -302,13 +312,13 @@ let parse_comment comment =
   let cited_posts = List.sort_uniq String.compare cited_posts in
   (comment, cited_posts)
 
-let upload_post post =
+let upload_post ?image_content post =
   let thread_data, reply =
     match post with
     | Op (thread_data, reply) -> (Some thread_data, reply)
     | Reply reply -> (None, reply)
   in
-  let { id; parent_id; date; nick; comment; image; tags; citations; _ } =
+  let { id; parent_id; date; nick; comment; image_info; tags; citations; _ } =
     reply
   in
 
@@ -316,11 +326,15 @@ let upload_post post =
   let^ () = Db.exec Q.upload_post_comment (id, comment) in
   let^ () = Db.exec Q.upload_post_date (id, date) in
   let^ () = Db.exec Q.upload_to_thread (parent_id, id) in
-  let^ () =
+  let _res_image_info, _res_image_content =
-    match image with
+    match image_info with
-    | None -> Ok ()
+    | None -> (Ok (), Ok ())
-    | Some (image_name, image_content, alt) ->
+    | Some (name, alt) -> (
-      Db.exec Q.upload_post_image (id, image_name, image_content, alt)
+      match image_content with
+      | None -> failwith "No image_content for a post with image"
+      | Some content ->
+        ( Db.exec Q.upload_image_info (id, name, alt)
+        , Db.exec Q.upload_image_content (id, content) ) )
   in
   (* what is parent and why do i need it again? TODO TODO *)
   let^ () = Db.exec Q.upload_post_parent (id, parent_id) in
@@ -365,7 +379,11 @@ let build_reply ~comment ?image ~tags ?parent_id nick =
     | Ok image ->
       if String.length tags > 1000 then Error "invalid tags"
       else
-        (* TODO latlng validation? *)
+        let image_info =
+          match image with
+          | None -> None
+          | Some (image_info, _image_content) -> Some image_info
+        in
         let tag_list = Str.split (Str.regexp " +") tags in
         let date = int_of_float (Unix.time ()) in
         let comment, citations = parse_comment comment in
@@ -375,7 +393,7 @@ let build_reply ~comment ?image ~tags ?parent_id nick =
           ; date
           ; nick
           ; comment
-          ; image
+          ; image_info
           ; tags = tag_list
           ; replies = []
           ; citations
@@ -402,11 +420,15 @@ let build_op ~comment ?image ~tags ~subject ~lat ~lng nick =
 let make_reply ~comment ?image ~tags ~parent_id nick =
   let* reply = build_reply ~comment ?image ~tags ~parent_id nick in
   let post = Reply reply in
-  upload_post post
+  match image with
+  | None -> upload_post post
+  | Some (_image_info, image_content) -> upload_post ~image_content post
 
 let make_op ~comment ?image ~tags ~subject ~lat ~lng nick =
   let* op = build_op ~comment ?image ~tags ~subject ~lat ~lng nick in
-  upload_post op
+  match image with
+  | None -> upload_post op
+  | Some (_image_info, image_content) -> upload_post ~image_content op
 
 let get_post_image_content post_id =
   let^? content = Db.find_opt Q.get_post_image_content post_id in

src/permap.ml

@@ -152,7 +152,7 @@ let newthread_post request =
           | [] -> Babillard.make_op ~comment ~lat ~lng ~subject ~tags nick
           | _ :: _ :: _ -> Error "More than one image"
           | [ (image_name, image_content) ] ->
-            let image = (image_name, image_content, alt) in
+            let image = ((image_name, alt), image_content) in
             Babillard.make_op ~comment ~image ~lat ~lng ~subject ~tags nick
         in
         match res with
@@ -200,7 +200,7 @@ let reply_post request =
         match file with
         | [] -> Babillard.make_reply ~comment ~tags ~parent_id nick
         | [ (image_name, image_content) ] ->
-          let image = (image_name, image_content, alt) in
+          let image = ((image_name, alt), image_content) in
           Babillard.make_reply ~comment ~image ~tags ~parent_id nick
         | _ :: _ :: _ -> Error "More than one image"
       in
@@ -247,6 +247,6 @@ let () =
        ; Dream.post "/new_thread" newthread_post
        ; Dream.get "/:thread_id" thread_get
        ; Dream.post "/:thread_id" reply_post
-       ; Dream.get "/post_pic/:post_id" post_image
+       ; Dream.get "/img/:post_id" post_image
        ]
   @@ Dream.not_found

src/pp_babillard.ml

@@ -2,14 +2,19 @@ include Bindings
 include Babillard
 open Db
 
-let view_post ?is_thread_preview post_id =
+let view_post ?is_thread_preview id =
-  let^ nick = Db.find Q.get_post_nick post_id in
+  let* { id
-  let^ comment = Db.find Q.get_post_comment post_id in
+       ; parent_id = _parent_id
-  let^ date = Db.find Q.get_post_date post_id in
+       ; date
-  let^ image_info = Db.find_opt Q.get_post_image_info post_id in
+       ; nick
-
+       ; comment
-  let^ tags = Db.collect_list Q.get_post_tags post_id in
+       ; image_info
-  let^ replies = Db.collect_list Q.get_post_replies post_id in
+       ; tags
+       ; replies
+       ; citations = _citations
+       } =
+    get_post id
+  in
 
   let image_view fmt () =
     match image_info with
@@ -19,12 +24,12 @@ let view_post ?is_thread_preview post_id =
       Format.fprintf fmt
         {|
     <div class="postImageContainer">
-        <a href="/post_pic/%s">
+        <a href="/img/%s">
-        <img class="postImage" src="/post_pic/%s" alt="%s" title="%s" loading="lazy">
+        <img class="postImage" src="/img/%s" alt="%s" title="%s" loading="lazy">
         </a>
     </div> 
 |}
-        post_id post_id image_alt image_alt
+        id id image_alt image_alt
     | None -> Format.fprintf fmt ""
   in
 
@@ -42,7 +47,7 @@ let view_post ?is_thread_preview post_id =
     match is_thread_preview with
     | None -> pp_print_replies fmt replies
     | Some () -> (
-      let res_nb = Db.find Q.count_thread_posts post_id in
+      let res_nb = Db.find Q.count_thread_posts id in
       match res_nb with
       | Error _ -> Format.fprintf fmt ""
       | Ok ((1 | 2) as nb) ->
@@ -62,7 +67,7 @@ let view_post ?is_thread_preview post_id =
         </span>
         %a
         |}
-        post_id post_id post_id replies_view ()
+        id id id replies_view ()
     | Some () -> Format.fprintf fmt {|
         %a
         |} replies_view ()
@@ -102,7 +107,7 @@ let view_post ?is_thread_preview post_id =
         </div> 
 </div> 
 |}
-      post_id post_info_view () image_view () comment tags_view ()
+      id post_info_view () image_view () comment tags_view ()
   in
   Ok post_view
 
@@ -124,7 +129,7 @@ let preview_thread thread_id =
   Ok thread_preview
 
 let view_thread thread_id =
-  let^ _is_thread = Db.find Q.get_thread thread_id in
+  let^ _is_thread = Db.find Q.get_is_thread thread_id in
   let^? subject = Db.find_opt Q.get_post_subject thread_id in
   let^ thread_posts = Db.collect_list Q.get_thread_posts thread_id in
   (*order by date *)