Commit 622b27b6 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Pre-fill signup forms after failures

parent a2d22657
......@@ -230,21 +230,6 @@ type captcha_error =
| BadCaptcha
| BadAddress
let captcha_error_of_string = function
| "captcha" -> BadCaptcha
| "address" -> BadAddress
| _ -> invalid_arg "captcha_error_of_string"
let string_of_captcha_error = function
| BadCaptcha -> "captcha"
| BadAddress -> "address"
let captcha_error x =
Eliom_parameter.user_type
~of_string:captcha_error_of_string
~to_string:string_of_captcha_error
x
type add_account_error =
| UsernameTaken
| AddressTaken
......
......@@ -111,12 +111,6 @@ type captcha_error =
| BadCaptcha
| BadAddress
val captcha_error :
string ->
(captcha_error, [ `WithoutSuffix ],
[ `One of captcha_error ] Eliom_parameter.param_name)
Eliom_parameter.params_type
type add_account_error =
| UsernameTaken
| AddressTaken
......
......@@ -113,13 +113,13 @@ let password_post = create ~path:No_path ~meth:(Post (unit, string "username" **
let set_language = create ~path:No_path ~meth:(Get (string "lang" ** site_cont "cont")) ()
let signup_captcha = create ~path:(Path ["signup"; ""]) ~meth:(Get (string "service" ** opt (captcha_error "error"))) ()
let signup_captcha = create ~path:(Path ["signup"; ""]) ~meth:(Get (string "service")) ()
let signup_captcha_post = create_attached_post ~fallback:signup_captcha ~post_params:(string "challenge" ** string "response" ** string "email") ()
let signup_captcha_img = create ~path:(Path ["signup"; "captcha"]) ~meth:(Get (string "challenge")) ()
let signup_login = create ~path:(Path ["signup"; "login"]) ~meth:(Get (string "token")) ()
let signup = create ~path:(Path ["signup"; "account"]) ~meth:(Get unit) ()
let signup_post = create_attached_post ~fallback:signup ~post_params:(string "username" ** string "password") ()
let changepw_captcha = create ~path:(Path ["signup"; "changepw"]) ~meth:(Get (string "service" ** opt (captcha_error "error"))) ()
let changepw_captcha = create ~path:(Path ["signup"; "changepw"]) ~meth:(Get (string "service")) ()
let changepw_captcha_post = create_attached_post ~fallback:changepw_captcha ~post_params:(string "challenge" ** string "response" ** string "email" ** string "username") ()
let changepw_post = create_attached_post ~fallback:signup ~post_params:(string "password") ()
......@@ -360,7 +360,7 @@ let () =
let%lwt () = Eliom_reference.set Web_state.show_cookie_disclaimer false in
let cont = match cont with
| ContAdmin -> Redirection admin
| ContSignup service -> Redirection (preapply signup_captcha (service, None))
| ContSignup service -> Redirection (preapply signup_captcha service)
in
return cont
)
......@@ -2108,23 +2108,27 @@ end
module Captcha_throttle = Lwt_throttle.Make (HashedInt)
let captcha_throttle = Captcha_throttle.create ~rate:1 ~max:5 ~n:1
let signup_captcha_handler service error email =
if%lwt Captcha_throttle.wait captcha_throttle 0 then
let%lwt challenge = Web_signup.create_captcha () in
T.signup_captcha ~service error challenge email
else
let service = preapply signup_captcha service in
T.generic_page ~title:"Account creation" ~service
"You cannot create an account now. Please try later." ()
let () =
Html.register ~service:signup_captcha
(fun (service, error) () ->
let%lwt gdpr = Eliom_reference.get Web_state.show_cookie_disclaimer in
if gdpr then T.privacy_notice (ContSignup service) else
if%lwt Captcha_throttle.wait captcha_throttle 0 then
let%lwt challenge = Web_signup.create_captcha () in
T.signup_captcha ~service error challenge
(fun service () ->
if%lwt Eliom_reference.get Web_state.show_cookie_disclaimer then
T.privacy_notice (ContSignup service)
else
let service = preapply signup_captcha (service, None) in
T.generic_page ~title:"Account creation" ~service
"You cannot create an account now. Please try later." ()
signup_captcha_handler service None ""
)
let () =
Any.register ~service:signup_captcha_post
(fun (service, _) (challenge, (response, email)) ->
Html.register ~service:signup_captcha_post
(fun service (challenge, (response, email)) ->
let%lwt error =
let%lwt ok = Web_signup.check_captcha ~challenge ~response in
if ok then
......@@ -2138,25 +2142,26 @@ let () =
Printf.sprintf
"An e-mail was sent to %s with a confirmation link. Please click on it to complete account creation." email
in
T.generic_page ~title:"Account creation" message () >>= Html.send
| _ -> redir_preapply signup_captcha (service, error) ()
T.generic_page ~title:"Account creation" message ()
| _ -> signup_captcha_handler service error email
)
let changepw_captcha_handler service error email username =
if%lwt Captcha_throttle.wait captcha_throttle 1 then
let%lwt challenge = Web_signup.create_captcha () in
T.signup_changepw ~service error challenge email username
else
let service = preapply changepw_captcha service in
T.generic_page ~title:"Change password" ~service
"You cannot change your password now. Please try later." ()
let () =
Html.register ~service:changepw_captcha
(fun (service, error) () ->
if%lwt Captcha_throttle.wait captcha_throttle 1 then
let%lwt challenge = Web_signup.create_captcha () in
T.signup_changepw ~service error challenge
else
let service = preapply changepw_captcha (service, None) in
T.generic_page ~title:"Change password" ~service
"You cannot change your password now. Please try later." ()
)
(fun service () -> changepw_captcha_handler service None "" "")
let () =
Any.register ~service:changepw_captcha_post
(fun (service, _) (challenge, (response, (email, username))) ->
Html.register ~service:changepw_captcha_post
(fun service (challenge, (response, (email, username))) ->
let%lwt error =
let%lwt ok = Web_signup.check_captcha ~challenge ~response in
if ok then return None
......@@ -2178,8 +2183,8 @@ let () =
let message =
"If possible, an e-mail was sent with a confirmation link. Please click on it to change your password."
in
T.generic_page ~title:"Change password" message () >>= Html.send
| _ -> redir_preapply changepw_captcha (service, error) ()
T.generic_page ~title:"Change password" message ()
| _ -> changepw_captcha_handler service error email username
)
let () =
......
......@@ -2487,9 +2487,9 @@ let login_password ~service ~allowsignups =
div [
br ();
pcdata "You can also ";
a ~service:signup_captcha [pcdata "create an account"] (service, None);
a ~service:signup_captcha [pcdata "create an account"] service;
pcdata ", or ";
a ~service:changepw_captcha [pcdata "change your password"] (service, None);
a ~service:changepw_captcha [pcdata "change your password"] service;
pcdata " (if you forgot it, for example).";
]
else pcdata ""
......@@ -2527,14 +2527,14 @@ let format_captcha_error = function
| Some BadCaptcha -> div [pcdata "Bad security code!"]
| Some BadAddress -> div [pcdata "Bad e-mail address!"]
let signup_captcha ~service error challenge =
let signup_captcha ~service error challenge email =
let form =
post_form ~service:signup_captcha_post
(fun (lchallenge, (lresponse, lemail)) ->
[
div [
pcdata "E-mail address: ";
input ~input_type:`Text ~name:lemail string;
input ~input_type:`Text ~name:lemail ~value:email string;
];
div [
input ~input_type:`Hidden ~name:lchallenge ~value:challenge string;
......@@ -2547,22 +2547,22 @@ let signup_captcha ~service error challenge =
input ~input_type:`Submit ~value:"Submit" string;
];
]
) (service, None)
) service
in
let error = format_captcha_error error in
let content = [error; form] in
base ~title:"Create an account" ~content ()
let signup_changepw ~service error challenge =
let signup_changepw ~service error challenge email username =
let form =
post_form ~service:changepw_captcha_post
(fun (lchallenge, (lresponse, (lemail, lusername))) ->
[
div [
pcdata "E-mail address: ";
input ~input_type:`Text ~name:lemail string;
input ~input_type:`Text ~name:lemail ~value:email string;
pcdata " or username: ";
input ~input_type:`Text ~name:lusername string;
input ~input_type:`Text ~name:lusername ~value:username string;
pcdata ".";
];
div [
......@@ -2576,7 +2576,7 @@ let signup_changepw ~service error challenge =
input ~input_type:`Submit ~value:"Submit" string;
];
]
) (service, None)
) service
in
let error = format_captcha_error error in
let content = [error; form] in
......
......@@ -74,8 +74,8 @@ val login_choose :
val login_dummy : unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val login_password : service:string -> allowsignups:bool -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val signup_captcha : service:string -> captcha_error option -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val signup_changepw : service:string -> captcha_error option -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
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 changepw : username:string -> address:string -> [> `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