diff --git a/src/add_plant.eml.html b/src/add_plant.eml.html
new file mode 100644
index 0000000..92a218d
--- /dev/null
+++ b/src/add_plant.eml.html
@@ -0,0 +1,13 @@
+let f nick request =
+<%s Format.sprintf "Add a plant to your Collection %s !" nick %>
+
+ <%s! Dream.form_tag ~action:"/add_plant" ~enctype:`Multipart_form_data request %>
+
Tags
+
+
Describe your plant with tags
+
+
+
Add a optional picture for your plant
+
Add Plant
+
+
diff --git a/src/dune b/src/dune
index 5607817..dea9cf7 100644
--- a/src/dune
+++ b/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)
diff --git a/src/permap.ml b/src/permap.ml
index 86f8b4c..afe2e6d 100644
--- a/src/permap.ml
+++ b/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
diff --git a/src/template.eml.html b/src/template.eml.html
index 1622eee..d305546 100644
--- a/src/template.eml.html
+++ b/src/template.eml.html
@@ -33,6 +33,9 @@ let render_unsafe ~title ~content request =
<%s! nick %>
+
+ Add Plant
+
Logout
diff --git a/src/user.ml b/src/user.ml
index 3fe3ae6..530ccc0 100644
--- a/src/user.ml
+++ b/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
- match res with
- | Ok () -> ()
- | Error e ->
- Dream.warning (fun log ->
- log "can't create table user: %s" (Caqti_error.show e) )
+ let tables =
+ [ 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)
+ 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
+ {| |}
+ 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, _)) ->
- Format.sprintf
- {|nick = `%s`; password = `%s`; email = `%s`; bio = '%s';
+ | Some (nick, password, email, (bio, _)) -> (
+ (* TODO show plants *)
+ 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';
+ %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 () ) ) )