wip: add /add_plant

src/add_plant.eml.html

@@ -0,0 +1,13 @@
+let f nick request =
+<%s  Format.sprintf "Add a plant to your Collection %s !" nick %>
+      <div class="mb-3">
+        <%s! Dream.form_tag ~action:"/add_plant" ~enctype:`Multipart_form_data request %>
+        <label for="tags" class="form-label">Tags</label>
+        <textarea name="tags" type="text" class="form-control" id="tags" aria-describedby="tagsHelp"></textarea>
+        <div id="tagsHelp" class="form-text">Describe your plant with tags</div>
+
+        <input id="files" name="files" aria-describedby="filesHelp" type="file" multiple>
+        <div id="filesHelp" class="form-text">Add a optional picture for your plant</div>
+      <button type="submit" class="btn btn-primary">Add Plant</button>
+      </div>
+    </form>

src/dune

@@ -1,7 +1,18 @@
 (executable
  (public_name permap)
- (modules app content db login permap register template user user_profile)
+ (modules
+  app
+  content
+  db
+  login
+  permap
+  register
+  template
+  user
+  user_profile
+  add_plant)
  (libraries
+  uuidm
   caqti.blocking
   caqti-driver-sqlite3
   bos
@@ -43,6 +54,12 @@
  (action
   (run dream_eml %{deps} --workspace %{workspace_root})))
 
+(rule
+ (targets add_plant.ml)
+ (deps add_plant.eml.html)
+ (action
+  (run dream_eml %{deps} --workspace %{workspace_root})))
+
 (rule
  (targets user_profile.ml)
  (deps user_profile.eml.html)

src/permap.ml

@@ -131,8 +131,51 @@ let avatar_image request =
     | Some avatar -> Dream.respond ~headers:[ ("Content-Type", "image") ] avatar
     )
 
+let plant_image request =
+  let plant_id = Dream.param "plant_id" request in
+  let nb = Dream.param "nb" request in
+  let image = User.get_plant_image plant_id nb in
+  match image with
+  | Ok (Some image) ->
+    Dream.respond ~headers:[ ("Content-Type", "image") ] image
+  | Ok None
+  | Error _ ->
+    Dream.empty `Not_Found
+
 let map request = page "map" request
 
+let add_plant_get request =
+  match Dream.session "nick" request with
+  | None -> render_unsafe "Not logged in" request
+  | Some nick -> render_unsafe (Add_plant.f nick request) request
+
+let add_plant_post request =
+  match Dream.session "nick" request with
+  | None -> render_unsafe "Not logged in" request
+  | Some nick -> (
+    match%lwt Dream.multipart request with
+    (* TODO match pas bien la form :s *)
+    | `Ok [ ("files", files); ("tags", tags) ]
+    | `Ok (("files", files) :: ("tags", tags) :: _ :: _) -> (
+      match tags with
+      | [] -> render_unsafe "Field tag is empty" request
+      | [ (_, tags) ] ->
+        let res =
+          match User.add_plant tags files nick with
+          | Ok () -> "Your plant was uploaded!"
+          | Error e -> e
+        in
+        render_unsafe res request
+      | _tags -> Dream.empty `Bad_Request )
+    | `Ok _ -> Dream.empty `Bad_Request
+    | `Expired _
+    | `Many_tokens _
+    | `Missing_token _
+    | `Invalid_token _
+    | `Wrong_session _
+    | `Wrong_content_type ->
+      Dream.empty `Bad_Request )
+
 let () =
   Dream.run @@ Dream.logger @@ Dream.memory_sessions
   @@ Dream.router
@@ -149,5 +192,8 @@ let () =
        ; Dream.get "/logout" logout
        ; Dream.get "/profile" profile_get
        ; Dream.post "/profile" profile_post
+       ; Dream.get "/add_plant" add_plant_get
+       ; Dream.post "/add_plant" add_plant_post
+       ; Dream.get "/plant_pic/:plant_id/:nb" plant_image
        ]
   @@ Dream.not_found

src/template.eml.html

@@ -33,6 +33,9 @@ let render_unsafe ~title ~content request =
                           <li class="nav-item">
                             <a class="nav-link" href="/profile"><%s! nick %></a>
                           </li>
+                          <li class="nav-item">
+                            <a class="nav-link" href="/add_plant">Add Plant</a>
+                          </li>
                           <li class="nav-item">
                               <a class="nav-link" href="/logout">Logout</a>
                           </li>

src/user.ml

@@ -10,7 +10,28 @@ module Q = struct
   let create_user_table =
     Caqti_request.exec Caqti_type.unit
       "CREATE TABLE IF NOT EXISTS user (nick TEXT, password TEXT, email TEXT, \
-       bio TEXT, avatar BLOB);"
+       bio TEXT, avatar BLOB, PRIMARY KEY(nick));"
+
+  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 (id INTEGER PRIMARY KEY, \
+       plant_id TEXT, image TEXT, 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, gps TEXT, FOREIGN \
+       KEY(plant_id) REFERENCES plant_user(plant_id));"
 
   let get_password =
     Caqti_request.find_opt Caqti_type.string Caqti_type.string
@@ -53,19 +74,66 @@ 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.(tup2 string string)
+      "INSERT INTO plant_gps VALUES (?,?);"
+
+  let upload_plant_image =
+    Caqti_request.exec
+      Caqti_type.(tup2 string string)
+      "INSERT INTO plant_image VALUES (NULL,?,?);"
+
+  let get_user_plants =
+    Caqti_request.collect Caqti_type.string Caqti_type.string
+      "SELECT plant_id FROM plant_user WHERE nick=?;"
+
+  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 string)
+      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=?;"
 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 res = Db.exec Q.create_user_table () in
+  let tables =
-  match res with
+    [ Q.create_user_table
-  | Ok () -> ()
+    ; Q.create_plant_user_table
-  | Error e ->
+    ; Q.create_plant_image_table
-    Dream.warning (fun log ->
+    ; Q.create_plant_tag_table
-        log "can't create table user: %s" (Caqti_error.show e) )
+    ; 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 login ~nick ~password request =
   let good_password = Db.find_opt Q.get_password nick in
@@ -128,6 +196,30 @@ let register ~email ~nick ~password =
       | None -> Error "db error" )
     | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
 
+let plant_view 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 images =
+        String.concat "\n"
+          (List.map
+             (Format.sprintf
+                {|<li><img src="/plant_pic/%s/%i" class="img-thumbnail"></li>|}
+                plant_id )
+             (List.init count succ) )
+      in
+      let tags = Db.fold Q.get_tags (fun tag acc -> tag :: acc) plant_id [] in
+      match tags with
+      | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+      | Ok tags ->
+        let tags = String.concat " " tags in
+        (* TODO add link to gps/map too *)
+        Ok (images ^ tags) )
+    | None -> Error "db error" )
+  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+
 let list () =
   let users = Db.fold Q.list_nicks (fun nick acc -> nick :: acc) () [] in
   match users with
@@ -145,12 +237,32 @@ let public_profile request =
   match user with
   | Ok user -> (
     match user with
-    | Some (nick, password, email, (bio, _)) ->
+    | Some (nick, password, email, (bio, _)) -> (
-      Format.sprintf
+      (* TODO show plants *)
-        {|nick = `%s`; password = `%s`; email = `%s`; bio = '%s';
+      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_result = List.map plant_view plant_id_list in
+        if List.exists Result.is_error plants_result then
+          Format.sprintf "db error"
+        else
+          let plants =
+            String.concat "\n"
+              (List.map
+                 (function
+                   | Ok s -> s
+                   | Error _ -> assert false )
+                 plants_result )
+          in
+          Format.sprintf
+            {|nick = `%s`; password = `%s`; email = `%s`; bio = '%s';
     <img src="/user/%s/avatar" class="img-thumbnail" alt="Your avatar picture">
+        %s
 |}
-        nick password email (Dream.html_escape bio) nick
+            nick password email (Dream.html_escape bio) nick plants )
     | None -> "incoherent db answer" )
   | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
 
@@ -193,6 +305,15 @@ 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"
@@ -208,3 +329,45 @@ 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 *)
+let is_valid_image _content = true
+
+let add_plant tags files nick =
+  match files with
+  | files -> (
+    (* TODO parse tags*)
+    (* 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 *)
+
+      (* TODO make a plant_id *)
+      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 <-> tag table*)
+        (* TODO iter on tags*)
+        let res_tags = Db.exec Q.upload_plant_tag (plant_id, tags) in
+        match res_tags with
+        | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
+        | Ok _ -> (
+          (* add to plant_id <-> image*)
+          let res_images =
+            List.find_opt Result.is_error
+              (List.map
+                 (fun (_, content) ->
+                   Db.exec Q.upload_plant_image (plant_id, content) )
+                 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 () ) ) )