115 lines
3.7 KiB
OCaml
115 lines
3.7 KiB
OCaml
open Syntax
|
|
open Types
|
|
open Err
|
|
|
|
let check_nick nick =
|
|
let* nick = Validate_str.nick nick in
|
|
let* opt = Db_user.find_user_of_nick nick in
|
|
match opt with
|
|
| None -> Ok nick
|
|
| Some _user -> Error (Unprocessable "nick already taken")
|
|
|
|
let check_email email =
|
|
let* email = Validate_str.email email in
|
|
match Emile.of_string (email :> string) with
|
|
| Error _ -> Error (Unprocessable "invalid email format")
|
|
| Ok _ -> (
|
|
let* opt = Db_user.find_user_of_email email in
|
|
match opt with
|
|
| None -> Ok email
|
|
| Some _user -> Error (Unprocessable "email already taken") )
|
|
|
|
let get_user user_id =
|
|
let* opt = Db_user.find_user user_id in
|
|
match opt with None -> Error (Not_found_user user_id) | Some o -> Ok o
|
|
|
|
let get_user_private user_id =
|
|
let* opt = Db_user.find_user_private user_id in
|
|
match opt with None -> Error (Not_found_user user_id) | Some o -> Ok o
|
|
|
|
(* login can be nick or email *)
|
|
let login ~login ~password =
|
|
let f find s =
|
|
let* opt = find s in
|
|
match opt with
|
|
| None -> Ok None
|
|
| Some user ->
|
|
let* good_password = Db_user.get_password_hash user.user_id in
|
|
if Bcrypt.verify password (Bcrypt.hash_of_string good_password) then
|
|
let* opt = Db_user.find_user_private user.user_id in
|
|
match opt with
|
|
| None ->
|
|
Error
|
|
(Internal (Db_not_found (Fmt.str "user_private `%s`" user.user_id)))
|
|
| Some o -> Ok (Some o)
|
|
else Error (Unauthorized_login login)
|
|
in
|
|
(* assume login is nick *)
|
|
let* opt =
|
|
match Validate_str.nick login with
|
|
| Error _ -> Ok None
|
|
| Ok nick -> f Db_user.find_user_of_nick nick
|
|
in
|
|
match opt with
|
|
| Some u -> Ok u
|
|
| None -> (
|
|
(* assume login is email *)
|
|
let* email = Validate_str.email login in
|
|
let* opt = f Db_user.find_user_of_email email in
|
|
match opt with Some u -> Ok u | None -> Error (Unauthorized_login login) )
|
|
|
|
let register ~email ~nick ~password =
|
|
let* password = Validate_str.password password in
|
|
let* nick = check_nick nick in
|
|
let* email = check_email email in
|
|
let* () =
|
|
let* opt1 = Db_user.find_user_of_nick nick in
|
|
let* opt2 = Db_user.find_user_of_email email in
|
|
let loggin_not_taken = Option.is_none opt1 && Option.is_none opt2 in
|
|
if loggin_not_taken then Ok ()
|
|
else Error (Unprocessable "nick or email already taken")
|
|
in
|
|
let password_hash =
|
|
Bcrypt.hash (password :> string) |> Bcrypt.string_of_hash
|
|
in
|
|
Db_user.add_user ~email ~nick ~password_hash
|
|
|
|
let delete_user user_id = Db_user.delete_user user_id
|
|
|
|
let update_bio user_id bio =
|
|
let* bio = Validate_str.bio bio in
|
|
Db_user.update_bio user_id bio
|
|
|
|
let update_nick user_id nick =
|
|
let* nick = check_nick nick in
|
|
Db_user.update_nick user_id nick
|
|
|
|
let update_email user_id email =
|
|
let* email = check_email email in
|
|
Db_user.update_email user_id email
|
|
|
|
let update_password user_id password =
|
|
let* password = Validate_str.password password in
|
|
let password_hash =
|
|
Bcrypt.hash (password :> string) |> Bcrypt.string_of_hash
|
|
in
|
|
Db_user.update_password_hash user_id password_hash
|
|
|
|
let get_image user_id =
|
|
let default_avatar_path = "/img/default_avatar.png" in
|
|
let* opt = Db_image.U.data user_id in
|
|
match opt with
|
|
| Some data -> Ok data
|
|
| None -> (
|
|
match Assets.read default_avatar_path with
|
|
| None -> Error (Internal (Db_not_found "can not find default avatar file"))
|
|
| Some avatar -> Ok avatar )
|
|
|
|
(* TODO sql : rm image db functor, handle avatar image and transaction in db_user *)
|
|
let upload_avatar user_id (name_opt, alt, content) =
|
|
let name = Option.value ~default:"" name_opt in
|
|
let* image = Image.build ~name ~alt content in
|
|
Caqti_db.Db.do_transaction @@ fun () -> Db_image.U.upload user_id image
|
|
|
|
let delete_avatar user_id =
|
|
Caqti_db.Db.do_transaction @@ fun () -> Db_image.U.delete user_id
|