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 %> + + +
Describe your plant with tags
+ + +
Add a optional picture for your 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 = + 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'; 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 () ) ) )