type t = { nick : string ; password : string ; email : string ; bio : string ; avatar : string } 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, 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 ( 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, gps TEXT, 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=?;" let is_already_user = Caqti_request.find_opt Caqti_type.(tup2 string string) Caqti_type.int "SELECT EXISTS(SELECT 1 FROM user WHERE nick=? OR email=?);" let inser_new_user = Caqti_request.exec Caqti_type.(tup4 string string string Caqti_type.(tup2 string string)) "INSERT INTO user VALUES (?, ?, ?, ?, ?);" let list_nicks = Caqti_request.collect Caqti_type.unit Caqti_type.string "SELECT nick FROM user;" let get_user = Caqti_request.find_opt Caqti_type.string Caqti_type.(tup4 string string string Caqti_type.(tup2 string string)) "SELECT * FROM user WHERE nick=?;" let update_bio = Caqti_request.exec Caqti_type.(tup2 string string) "UPDATE user SET bio=? WHERE nick=?;" let get_bio = Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT bio FROM user WHERE nick=?;" let get_avatar = Caqti_request.find_opt Caqti_type.string Caqti_type.string "SELECT avatar FROM user WHERE nick=?;" let upload_avatar = 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.(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 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.string "SELECT gps 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 = [ 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 match good_password with | Ok foo -> ( match foo with | Some good_password -> if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then let _ = let%lwt () = Dream.invalidate_session request in Dream.put_session "nick" nick request in Ok () else Error "wrong password" | None -> Error (Format.sprintf "user `%s` doesn't exist" nick) ) | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) let register ~email ~nick ~password = (* TODO: remove bad characters (e.g. delthas) *) let valid_nick = String.length nick < 64 && String.length nick > 0 && String.escaped nick = nick in let valid_email = match Emile.of_string email with | Ok _ -> true | Error _ -> false in let valid_password = String.length password < 128 && String.length password > 0 in let valid = valid_nick && valid_email && valid_password in let password = Bcrypt.hash password in let password = Bcrypt.string_of_hash password in if not valid then Error "Something is wrong" else let unique = Db.find_opt Q.is_already_user (nick, email) in match unique with | Ok unique -> ( match unique with | Some nb -> ( match nb with | 0 -> ( let res = Db.exec Q.inser_new_user (nick, password, email, ("", "")) in match res with | Ok res -> Ok res | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) ) | _ -> Error "nick or email already exists" ) | 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 gps) -> gps | Ok None -> "" | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) in let images = String.concat "\n" (List.map (Format.sprintf {|