geochan/src/user.ml

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