cleanup user.ml, add plant.ml

src/db.ml

@@ -9,5 +9,15 @@ let () =
 
 let db = Filename.concat db_root "permap.db"
 
+let random_state = Random.State.make_self_init ()
+
 let with_db ?mode ?mutex ?cache ?vfs ?timeout f =
   Sqlite3_utils.with_db ?mode ?mutex ?cache ?vfs ?timeout db f
+
+module Db =
+( val Caqti_blocking.connect (Uri.of_string ("sqlite3://" ^ db))
+      |> Caqti_blocking.or_fail )
+
+(* TODO do image validation: length and MIME types with conan*)
+(* TODO do the same for text input: check length, forbidden chars and have a forbidden words filter*)
+let is_valid_image _content = true

src/dune

@@ -1,6 +1,8 @@
 (executable
  (public_name permap)
  (modules
+  plant
+  db
   app
   content
   db

src/permap.ml

@@ -134,7 +134,7 @@ let avatar_image request =
 let plant_image request =
   let plant_id = Dream.param "plant_id" request in
   let nb = int_of_string (Dream.param "nb" request) in
-  let image = User.get_plant_image plant_id nb in
+  let image = Plant.get_plant_image plant_id nb in
   match image with
   | Ok (Some image) ->
     Dream.respond ~headers:[ ("Content-Type", "image") ] image
@@ -176,7 +176,7 @@ let add_plant_post request =
           | _, None -> render_unsafe "Invalide coordinate" request
           | Some lat, Some lng ->
             let res =
-              match User.add_plant (lat, lng) tags files nick with
+              match Plant.add_plant (lat, lng) tags files nick with
               | Ok () -> "Your plant was uploaded!"
               | Error e -> e
             in
@@ -193,12 +193,12 @@ let add_plant_post request =
       Dream.empty `Bad_Request )
 
 let markers request =
-  let marker_list = User.marker_list () in
+  let marker_list = Plant.marker_list () in
   match marker_list with
   | Ok marker_list ->
     let json =
       {| [ |}
-      ^ String.concat "," (List.map User.marker_to_geojson marker_list)
+      ^ String.concat "," (List.map Plant.marker_to_geojson marker_list)
       ^ "]"
     in
     Dream.respond ~headers:[ ("Content-Type", "application/json") ] json

src/plant.ml

@@ -0,0 +1,234 @@
+open Db
+
+module Q = struct
+  let create_plant_user_table =
+    Caqti_request.exec Caqti_type.unit
+      "CREATE TABLE IF NOT EXISTS plant_user (plant_id TEXT, nick TEXT, \
+       PRIMARY KEY(plant_id), FOREIGN KEY(nick) REFERENCES user(nick));"
+
+  let create_plant_image_table =
+    Caqti_request.exec Caqti_type.unit
+      "CREATE TABLE IF NOT EXISTS plant_image ( plant_id TEXT, image TEXT,id \
+       INTEGER, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));"
+
+  let create_plant_tag_table =
+    Caqti_request.exec Caqti_type.unit
+      "CREATE TABLE IF NOT EXISTS plant_tag (plant_id TEXT, tag TEXT, FOREIGN \
+       KEY(plant_id) REFERENCES plant_user(plant_id));"
+
+  let create_plant_gps_table =
+    Caqti_request.exec Caqti_type.unit
+      "CREATE TABLE IF NOT EXISTS plant_gps (plant_id TEXT, lat FLOAT,lng \
+       FLOAT, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));"
+
+  let upload_plant_id =
+    Caqti_request.exec
+      Caqti_type.(tup2 string string)
+      "INSERT INTO plant_user VALUES (?,?);"
+
+  let upload_plant_tag =
+    Caqti_request.exec
+      Caqti_type.(tup2 string string)
+      "INSERT INTO plant_tag VALUES (?,?);"
+
+  let upload_plant_gps =
+    Caqti_request.exec
+      Caqti_type.(tup3 string float float)
+      "INSERT INTO plant_gps VALUES (?,?,?);"
+
+  let upload_plant_image =
+    Caqti_request.exec
+      Caqti_type.(tup3 string string int)
+      "INSERT INTO plant_image VALUES (?,?,?);"
+
+  let get_user_plants =
+    Caqti_request.collect Caqti_type.string Caqti_type.string
+      "SELECT plant_id FROM plant_user WHERE nick=?;"
+
+  let list_plant_ids =
+    Caqti_request.collect Caqti_type.unit Caqti_type.string
+      "SELECT plant_id FROM plant_user;"
+
+  let count_plant_image =
+    Caqti_request.find_opt Caqti_type.string Caqti_type.int
+      "SELECT COUNT(*) FROM plant_image WHERE plant_id=?;"
+
+  let get_plant_image =
+    Caqti_request.find_opt
+      Caqti_type.(tup2 string int)
+      Caqti_type.string
+      "SELECT image FROM plant_image WHERE plant_id=? AND id=?;"
+
+  let get_plant_tags =
+    Caqti_request.collect Caqti_type.string Caqti_type.string
+      "SELECT tag FROM plant_tag WHERE plant_id=?;"
+
+  let get_plant_gps =
+    Caqti_request.find_opt Caqti_type.string
+      Caqti_type.(tup2 float float)
+      "SELECT lat, lng FROM plant_gps WHERE plant_id=?;"
+end
+
+let () =
+  let tables =
+    [ Q.create_plant_user_table
+    ; Q.create_plant_image_table
+    ; Q.create_plant_tag_table
+    ; Q.create_plant_gps_table
+    ]
+  in
+  if
+    List.exists Result.is_error
+      (List.map (fun query -> Db.exec query ()) tables)
+  then
+    Dream.warning (fun log -> log "can't create table")
+
+let view_plant plant_id =
+  let count = Db.find_opt Q.count_plant_image plant_id in
+  match count with
+  | Ok count -> (
+    match count with
+    | Some count -> (
+      let gps =
+        match Db.find_opt Q.get_plant_gps plant_id with
+        | Ok (Some (lat, lng)) ->
+          Float.to_string lat ^ " " ^ Float.to_string lng
+        | Ok None -> ""
+        | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
+      in
+      let images =
+        String.concat "\n"
+          (List.map
+             (Format.sprintf
+                {|<li><img src="/plant_pic/%s/%i" class="img-thumbnail"></li>|}
+                plant_id )
+             (List.init count (fun i -> i)) )
+      in
+      let tags =
+        Db.fold Q.get_plant_tags (fun tag acc -> tag :: acc) plant_id []
+      in
+      match tags with
+      | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
+      | Ok tags ->
+        let tags = String.concat " " tags in
+        (* TODO add link to gps/map too *)
+        images ^ tags ^ gps )
+    | None -> "db error" )
+  | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
+
+let marker_list () =
+  let plant_id_list =
+    Db.fold Q.list_plant_ids (fun plant_id acc -> plant_id :: acc) () []
+  in
+  match plant_id_list with
+  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+  | Ok plant_id_list ->
+    let markers_res =
+      List.map
+        (fun plant_id ->
+          match Db.find_opt Q.get_plant_gps plant_id with
+          | Ok (Some (lat, lng)) ->
+            let content = view_plant plant_id in
+            Ok (lat, lng, content)
+          | Ok None -> Error "latlng not found"
+          | Error e ->
+            Error (Format.sprintf "db error: %s" (Caqti_error.show e)) )
+        plant_id_list
+    in
+    let markers =
+      List.map
+        (fun res ->
+          match res with
+          | Ok res -> res
+          | Error _ -> assert false )
+        (List.filter Result.is_ok markers_res)
+    in
+    Ok markers
+
+let marker_to_geojson marker =
+  match marker with
+  | lat, lng, content ->
+    Format.sprintf
+      {|
+{
+  "type": "Feature",
+  "geometry": {
+    "type": "Point",
+    "coordinates": [%s,%s]
+  },
+  "properties": {
+    "content": "%s"
+  }
+} 
+|}
+      (*TODO escape in content ?? *)
+      (* geojson use lng lat, and not lat lng*)
+      (Float.to_string lng)
+      (Float.to_string lat) (String.escaped content)
+
+let view_user_plant_list nick =
+  let plant_id_list =
+    Db.fold Q.get_user_plants (fun plant_id acc -> plant_id :: acc) nick []
+  in
+  match plant_id_list with
+  | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
+  | Ok plant_id_list ->
+    let plants = List.map view_plant plant_id_list in
+    String.concat "\n" plants
+
+let get_plant_image plant_id nb =
+  let res = Db.find_opt Q.get_plant_image (plant_id, nb) in
+  match res with
+  | Ok content -> (
+    match content with
+    | Some content -> Ok (Some content)
+    | None -> Error "Image not found" )
+  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+
+let add_plant (lat, lng) tags files nick =
+  let tags_len = String.length tags in
+  if tags_len > 1000 then
+    Error "tags too long"
+  else
+    let tag_list = Str.split (Str.regexp " +") tags in
+    (* id for plant*)
+    let ok_list = List.map (fun (_, content) -> is_valid_image content) files in
+    let valid_files = List.for_all (fun valid -> valid) ok_list in
+    if not valid_files then
+      Error "Invalid image"
+    else
+      (* add plant to db *)
+      let plant_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
+      (* add to plant_id <-> user*)
+      let res_plant = Db.exec Q.upload_plant_id (plant_id, nick) in
+      match res_plant with
+      | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+      | Ok _ -> (
+        (* add to plant_id <-> gps table*)
+        (*TODO check if valid latlng *)
+        let res_gps = Db.exec Q.upload_plant_gps (plant_id, lat, lng) in
+        match res_gps with
+        | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+        | Ok _ -> (
+          (* add to plant_id <-> tag table*)
+          let res_tags =
+            List.map
+              (fun tag -> Db.exec Q.upload_plant_tag (plant_id, tag))
+              tag_list
+          in
+          if List.exists Result.is_error res_tags then
+            Error (Format.sprintf "db error")
+          else
+            (* add to plant_id <-> image*)
+            let res_images =
+              List.find_opt Result.is_error
+                (List.mapi
+                   (fun nb (_, content) ->
+                     Db.exec Q.upload_plant_image (plant_id, content, nb) )
+                   files )
+            in
+            match res_images with
+            | Some (Error e) ->
+              Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+            | Some (Ok _) -> assert false
+            | None -> Ok () ) )

src/user.ml

@@ -1,3 +1,5 @@
+open Db
+
 type t =
   { nick : string
   ; password : string
@@ -17,21 +19,6 @@ module Q = struct
       "CREATE TABLE IF NOT EXISTS plant_user (plant_id TEXT, nick TEXT, \
        PRIMARY KEY(plant_id), FOREIGN KEY(nick) REFERENCES user(nick));"
 
-  let create_plant_image_table =
-    Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS plant_image ( plant_id TEXT, image TEXT,id \
-       INTEGER, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));"
-
-  let create_plant_tag_table =
-    Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS plant_tag (plant_id TEXT, tag TEXT, FOREIGN \
-       KEY(plant_id) REFERENCES plant_user(plant_id));"
-
-  let create_plant_gps_table =
-    Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS plant_gps (plant_id TEXT, lat FLOAT,lng \
-       FLOAT, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));"
-
   let get_password =
     Caqti_request.find_opt Caqti_type.string Caqti_type.string
       "SELECT password FROM user WHERE nick=?;"
@@ -73,70 +60,10 @@ module Q = struct
     Caqti_request.exec
       Caqti_type.(tup2 string string)
       "UPDATE user SET avatar=? WHERE nick=?;"
-
-  let upload_plant_id =
-    Caqti_request.exec
-      Caqti_type.(tup2 string string)
-      "INSERT INTO plant_user VALUES (?,?);"
-
-  let upload_plant_tag =
-    Caqti_request.exec
-      Caqti_type.(tup2 string string)
-      "INSERT INTO plant_tag VALUES (?,?);"
-
-  let upload_plant_gps =
-    Caqti_request.exec
-      Caqti_type.(tup3 string float float)
-      "INSERT INTO plant_gps VALUES (?,?,?);"
-
-  let upload_plant_image =
-    Caqti_request.exec
-      Caqti_type.(tup3 string string int)
-      "INSERT INTO plant_image VALUES (?,?,?);"
-
-  let get_user_plants =
-    Caqti_request.collect Caqti_type.string Caqti_type.string
-      "SELECT plant_id FROM plant_user WHERE nick=?;"
-
-  let list_plant_ids =
-    Caqti_request.collect Caqti_type.unit Caqti_type.string
-      "SELECT plant_id FROM plant_user;"
-
-  let count_plant_image =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.int
-      "SELECT COUNT(*) FROM plant_image WHERE plant_id=?;"
-
-  let get_plant_image =
-    Caqti_request.find_opt
-      Caqti_type.(tup2 string int)
-      Caqti_type.string
-      "SELECT image FROM plant_image WHERE plant_id=? AND id=?;"
-
-  let get_tags =
-    Caqti_request.collect Caqti_type.string Caqti_type.string
-      "SELECT tag FROM plant_tag WHERE plant_id=?;"
-
-  let get_plant_gps =
-    Caqti_request.find_opt Caqti_type.string
-      Caqti_type.(tup2 float float)
-      "SELECT lat, lng FROM plant_gps WHERE plant_id=?;"
 end
 
-module Db =
-( val Caqti_blocking.connect (Uri.of_string (Filename.concat "sqlite3://" Db.db))
-      |> Caqti_blocking.or_fail )
-
-let random_state = Random.State.make_self_init ()
-
 let () =
-  let tables =
+  let tables = [ Q.create_user_table ] in
-    [ Q.create_user_table
-    ; Q.create_plant_user_table
-    ; Q.create_plant_image_table
-    ; Q.create_plant_tag_table
-    ; Q.create_plant_gps_table
-    ]
-  in
   if
     List.exists Result.is_error
       (List.map (fun query -> Db.exec query ()) tables)
@@ -204,97 +131,6 @@ let register ~email ~nick ~password =
       | None -> Error "db error" )
     | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
 
-let view_plant plant_id =
-  let count = Db.find_opt Q.count_plant_image plant_id in
-  match count with
-  | Ok count -> (
-    match count with
-    | Some count -> (
-      let gps =
-        match Db.find_opt Q.get_plant_gps plant_id with
-        | Ok (Some (lat, lng)) ->
-          Float.to_string lat ^ " " ^ Float.to_string lng
-        | Ok None -> ""
-        | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
-      in
-      let images =
-        String.concat "\n"
-          (List.map
-             (Format.sprintf
-                {|<li><img src="/plant_pic/%s/%i" class="img-thumbnail"></li>|}
-                plant_id )
-             (List.init count (fun i -> i)) )
-      in
-      let tags = Db.fold Q.get_tags (fun tag acc -> tag :: acc) plant_id [] in
-      match tags with
-      | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
-      | Ok tags ->
-        let tags = String.concat " " tags in
-        (* TODO add link to gps/map too *)
-        images ^ tags ^ gps )
-    | None -> "db error" )
-  | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
-
-let marker_list () =
-  let plant_id_list =
-    Db.fold Q.list_plant_ids (fun plant_id acc -> plant_id :: acc) () []
-  in
-  match plant_id_list with
-  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-  | Ok plant_id_list ->
-    let markers_res =
-      List.map
-        (fun plant_id ->
-          match Db.find_opt Q.get_plant_gps plant_id with
-          | Ok (Some (lat, lng)) ->
-            let content = view_plant plant_id in
-            Ok (lat, lng, content)
-          | Ok None -> Error "latlng not found"
-          | Error e ->
-            Error (Format.sprintf "db error: %s" (Caqti_error.show e)) )
-        plant_id_list
-    in
-    let markers =
-      List.map
-        (fun res ->
-          match res with
-          | Ok res -> res
-          | Error _ -> assert false )
-        (List.filter Result.is_ok markers_res)
-    in
-    Ok markers
-
-let marker_to_geojson marker =
-  match marker with
-  | lat, lng, content ->
-    Format.sprintf
-      {|
-{
-  "type": "Feature",
-  "geometry": {
-    "type": "Point",
-    "coordinates": [%s,%s]
-  },
-  "properties": {
-    "content": "%s"
-  }
-} 
-|}
-      (*TODO escape in content ?? *)
-      (* geojson use lng lat, and not lat lng*)
-      (Float.to_string lng)
-      (Float.to_string lat) (String.escaped content)
-
-let view_user_plant_list nick =
-  let plant_id_list =
-    Db.fold Q.get_user_plants (fun plant_id acc -> plant_id :: acc) nick []
-  in
-  match plant_id_list with
-  | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
-  | Ok plant_id_list ->
-    let plants = List.map view_plant plant_id_list in
-    String.concat "\n" plants
-
 let list () =
   let users = Db.fold Q.list_nicks (fun nick acc -> nick :: acc) () [] in
   match users with
@@ -313,7 +149,7 @@ let public_profile request =
   | Ok user -> (
     match user with
     | Some (nick, password, email, (bio, _)) ->
-      let plants = view_user_plant_list nick in
+      let plants = Plant.view_user_plant_list nick in
       let user_info =
         Format.sprintf
           {|nick = `%s`; password = `%s`; email = `%s`; bio = '%s';
@@ -362,15 +198,6 @@ let get_avatar nick =
     | None -> Error "db error:" )
   | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
 
-let get_plant_image plant_id nb =
-  let res = Db.find_opt Q.get_plant_image (plant_id, nb) in
-  match res with
-  | Ok content -> (
-    match content with
-    | Some content -> Ok (Some content)
-    | None -> Error "Image not found" )
-  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-
 let upload_avatar files nick =
   match files with
   | [] -> Error "No file provided"
@@ -384,55 +211,3 @@ let upload_avatar files nick =
       | Ok _ -> Ok ()
       | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) )
   | _files -> Error "More than one file provided"
-
-(* TODO do image validation: length and MIME types with conan*)
-(* TODO do the same for text input: check length, forbidden chars and have a forbidden words filter*)
-let is_valid_image _content = true
-
-let add_plant (lat, lng) tags files nick =
-  let tags_len = String.length tags in
-  if tags_len > 1000 then
-    Error "tags too long"
-  else
-    let tag_list = Str.split (Str.regexp " +") tags in
-    (* id for plant*)
-    let ok_list = List.map (fun (_, content) -> is_valid_image content) files in
-    let valid_files = List.for_all (fun valid -> valid) ok_list in
-    if not valid_files then
-      Error "Invalid image"
-    else
-      (* add plant to db *)
-      let plant_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
-      (* add to plant_id <-> user*)
-      let res_plant = Db.exec Q.upload_plant_id (plant_id, nick) in
-      match res_plant with
-      | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-      | Ok _ -> (
-        (* add to plant_id <-> gps table*)
-        (*TODO check if valid latlng *)
-        let res_gps = Db.exec Q.upload_plant_gps (plant_id, lat, lng) in
-        match res_gps with
-        | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-        | Ok _ -> (
-          (* add to plant_id <-> tag table*)
-          let res_tags =
-            List.map
-              (fun tag -> Db.exec Q.upload_plant_tag (plant_id, tag))
-              tag_list
-          in
-          if List.exists Result.is_error res_tags then
-            Error (Format.sprintf "db error")
-          else
-            (* add to plant_id <-> image*)
-            let res_images =
-              List.find_opt Result.is_error
-                (List.mapi
-                   (fun nb (_, content) ->
-                     Db.exec Q.upload_plant_image (plant_id, content, nb) )
-                   files )
-            in
-            match res_images with
-            | Some (Error e) ->
-              Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-            | Some (Ok _) -> assert false
-            | None -> Ok () ) )

src/user_profile.eml.html

@@ -14,4 +14,4 @@ let f nick bio request =
       <input name="files" type="file" multiple>
       <button>Submit!</button>
     </form>
-    <%s! User.view_user_plant_list nick %>
+    <%s! Plant.view_user_plant_list nick %>