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