Commit 58245e16 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Prettier behaviour when the account creation failed

parent fbe6b671
......@@ -2202,39 +2202,25 @@ let () =
)
let () =
Any.register ~service:signup
Html.register ~service:signup
(fun () () ->
match%lwt Eliom_reference.get Web_state.signup_env with
| None -> forbidden ()
| Some (_, address, Web_signup.CreateAccount) -> T.signup address >>= Html.send
| Some (_, address, Web_signup.ChangePassword username) -> T.changepw ~username ~address >>= Html.send
| Some (_, address, Web_signup.CreateAccount) -> T.signup address None ""
| Some (_, address, Web_signup.ChangePassword username) -> T.changepw ~username ~address
)
let () =
Any.register ~service:signup_post
Html.register ~service:signup_post
(fun () (username, password) ->
match%lwt Eliom_reference.get Web_state.signup_env with
| Some (service, email, Web_signup.CreateAccount) ->
let user = { user_name = username; user_domain = service } in
(match%lwt Web_auth_password.add_account user ~password ~email with
| Ok () ->
let%lwt () = Eliom_reference.unset Web_state.signup_env in
T.generic_page ~title:"Account creation" ~service:admin
"The account has been created." () >>= Html.send
| Error UsernameTaken ->
T.generic_page ~title:"Account creation" ~service:signup
"The account creation failed because the username is already taken. Please try again with a different one." () >>= Html.send
| Error AddressTaken ->
T.generic_page ~title:"Account creation" ~service:signup
"The account creation failed because there is already an account with this address. Please try again with a different one." () >>= Html.send
| Error BadUsername ->
T.generic_page ~title:"Account creation" ~service:signup
"The account creation failed because the username is invalid. Please try again with a different one." () >>= Html.send
| Error (BadPassword e) ->
Printf.ksprintf
(fun x -> T.generic_page ~title:"Account creation" ~service:signup x () >>= Html.send)
"The account creation failed because the password is too weak (%s). Please try again with a different one"
e
| Ok () ->
let%lwt () = Eliom_reference.unset Web_state.signup_env in
T.generic_page ~title:"Account creation" ~service:admin "The account has been created." ()
| Error e -> T.signup email (Some e) username
)
| _ -> forbidden ()
)
......
......@@ -2586,7 +2586,24 @@ let signup_changepw ~service error challenge email username =
let content = [error; form] in
base ~title:"Change password" ~content ()
let signup address =
let signup address error username =
let error = match error with
| None -> pcdata ""
| Some e ->
let msg = match e with
| UsernameTaken -> "the username is already taken"
| AddressTaken -> "there is already an account with this address"
| BadUsername -> "the username is invalid"
| BadPassword e -> Printf.sprintf "the password is too weak (%s)" e
in
div [
pcdata "The account creation ";
span ~a:[a_style "color: red;"] [pcdata "failed"];
pcdata " because ";
pcdata msg;
pcdata ". Please try again with a different one.";
]
in
let form =
post_form ~service:signup_post
(fun (lusername, lpassword) ->
......@@ -2598,7 +2615,7 @@ let signup address =
];
div [
pcdata "Please choose a username: ";
input ~input_type:`Text ~name:lusername string;
input ~input_type:`Text ~name:lusername ~value:username string;
pcdata " and a password: ";
input ~input_type:`Password ~name:lpassword string;
pcdata ".";
......@@ -2609,7 +2626,7 @@ let signup address =
]
) ()
in
let content = [form] in
let content = [error; form] in
base ~title:"Create an account" ~content ()
let changepw ~username ~address =
......
......@@ -76,7 +76,7 @@ val login_password : service:string -> allowsignups:bool -> [> `Html ] Eliom_con
val signup_captcha : service:string -> captcha_error option -> string -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val signup_changepw : service:string -> captcha_error option -> string -> string -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val signup : string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val signup : string -> add_account_error option -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val changepw : username:string -> address:string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val booth : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment