put all image stuff in image.ml, make thumbnail for avatars

This commit is contained in:
Swrup 2022-04-04 14:39:25 +02:00
parent 7ad84cc1ab
commit eed9af951c
7 changed files with 240 additions and 186 deletions

View file

@ -7,7 +7,6 @@ type t =
; password : string
; email : string
; bio : string
; avatar : string
; metadata : (string * string) list
}
@ -15,7 +14,7 @@ module Q = struct
let create_user_table =
Caqti_request.exec Caqti_type.unit
"CREATE TABLE IF NOT EXISTS user (user_id TEXT, nick TEXT, password \
TEXT, email TEXT, bio TEXT, avatar BLOB, PRIMARY KEY(user_id));"
TEXT, email TEXT, bio TEXT, PRIMARY KEY(user_id));"
let create_banished_table =
Caqti_request.exec Caqti_type.unit
@ -59,9 +58,8 @@ module Q = struct
let upload_user =
Caqti_request.exec
Caqti_type.(
tup4 string string string Caqti_type.(tup3 string string string))
"INSERT INTO user VALUES (?, ?, ?, ?, ?, ?);"
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
@ -70,8 +68,7 @@ module Q = struct
let get_user =
Caqti_request.find Caqti_type.string
(* there is no "tup6" *)
Caqti_type.(
tup4 string string string Caqti_type.(tup3 string string string))
Caqti_type.(tup4 string string string Caqti_type.(tup2 string string))
"SELECT * FROM user WHERE user_id=?;"
let update_bio =
@ -106,15 +103,6 @@ module Q = struct
Caqti_request.find Caqti_type.string Caqti_type.string
"SELECT email FROM user WHERE user_id=?;"
let get_avatar =
Caqti_request.find Caqti_type.string Caqti_type.string
"SELECT avatar FROM user WHERE user_id=?;"
let upload_avatar =
Caqti_request.exec
Caqti_type.(tup2 string string)
"UPDATE user SET avatar=? WHERE user_id=?;"
let delete_user =
Caqti_request.exec Caqti_type.string "DELETE FROM user WHERE user_id=?;"
@ -139,6 +127,8 @@ let () =
(Array.map (fun query -> Db.exec query ()) tables)
then Dream.error (fun log -> log "can't create user tables")
let exist id = Result.is_ok (Db.find Q.get_user id)
let exist_nick nick = Result.is_ok (Db.find Q.get_user_id_from_nick nick)
let exist_email email = Result.is_ok (Db.find Q.get_user_id_from_email email)
@ -153,11 +143,11 @@ let get_user_id_from_nick nick =
Ok user_id
let get_user user_id =
let^? user_id, nick, password, (email, bio, avatar) =
let^? user_id, nick, password, (email, bio) =
Db.find_opt Q.get_user user_id
in
let* metadata = get_metadata user_id in
Ok { user_id; nick; password; email; bio; avatar; metadata }
Ok { user_id; nick; password; email; bio; metadata }
let is_banished login = Result.is_ok (Db.find Q.get_banished (login, login))
@ -210,10 +200,8 @@ let register ~email ~nick ~password =
else
let^ nb = Db.find Q.is_already_user (nick, email) in
if nb = 0 then
let user_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
let^ () =
Db.exec Q.upload_user (user_id, nick, password, (email, "", ""))
in
let user_id = Uuidm.to_string (Uuidm.v4_gen App.random_state ()) in
let^ () = Db.exec Q.upload_user (user_id, nick, password, (email, "")) in
let^ () = Db.exec Q.upload_metadata (user_id, Marshal.to_string [] []) in
Ok ()
else Error "nick or email already exists"
@ -248,16 +236,12 @@ let get_email user_id =
let^ email = Db.find Q.get_email user_id in
Ok email
let get_avatar user_id =
let^ avatar = Db.find Q.get_avatar user_id in
if String.length avatar = 0 then Ok None else Ok (Some avatar)
let upload_avatar files user_id =
match files with
| [] -> Error "No file provided"
| [ (name_opt, content) ] ->
let* _name, _alt, content = clean_image (name_opt, "avatar", content) in
let^ () = Db.exec Q.upload_avatar (content, user_id) in
let* image = Image.make_image (name_opt, "avatar", content) in
let* () = Image.upload_avatar image user_id in
Ok ()
| _files -> Error "More than one file provided"