Commit 24ad900e authored by Stephane Glondu's avatar Stephane Glondu

Move link for credential authority to a new page

parent f57b24a1
......@@ -46,6 +46,7 @@ let election_setup_voters = service ~path:["setup"; "voters"] ~get_params:(uuid
let election_setup_voters_post = post_service ~fallback:election_setup_voters ~post_params:(string "voters") ()
let election_setup_trustee_add = post_coservice ~fallback:election_setup ~post_params:unit ()
let election_setup_trustee_del = post_coservice ~fallback:election_setup ~post_params:unit ()
let election_setup_credential_authority = service ~path:["setup"; "credential-authority"] ~get_params:(uuid "uuid") ()
let election_setup_credentials = service ~path:["setup"; "credentials"] ~get_params:(string "token") ()
let election_setup_credentials_download = service ~path:["setup"; "public_creds.txt"] ~get_params:(string "token") ()
let election_setup_credentials_post = post_coservice ~fallback:election_setup_credentials ~post_params:(string "public_creds") ()
......
......@@ -341,28 +341,24 @@ let () = Redirection.register ~service:election_setup_new
| None -> forbidden ()
)
let () = Html5.register ~service:election_setup
(fun uuid () ->
let generic_setup_page f uuid () =
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
lwt se = Ocsipersist.find election_stable uuid_s in
if se.se_owner = u
then T.election_setup uuid se ()
then f uuid se ()
else forbidden ()
| None -> forbidden ()
)
let () = Html5.register ~service:election_setup
(generic_setup_page T.election_setup)
let () = Html5.register ~service:election_setup_trustees
(fun uuid () ->
match_lwt Web_auth_state.get_site_user () with
| Some u ->
let uuid_s = Uuidm.to_string uuid in
lwt se = Ocsipersist.find election_stable uuid_s in
if se.se_owner = u
then T.election_setup_trustees uuid se ()
else forbidden ()
| None -> forbidden ())
(generic_setup_page T.election_setup_trustees)
let () = Html5.register ~service:election_setup_credential_authority
(generic_setup_page T.election_setup_credential_authority)
let election_setup_mutex = Lwt_mutex.create ()
......
......@@ -418,31 +418,14 @@ let election_setup uuid se () =
div [
h2 [pcdata "Credentials"];
div [
pcdata "The server may generate and email the credentials to the voters. If you prefer to delegate this task to another authority, click here.";
pcdata "The server may generate and email the credentials to the voters. If you prefer to delegate this task to another authority, click ";
a ~service:election_setup_credential_authority [pcdata "here"] uuid;
pcdata ".";
];
post_form ~service:election_setup_credentials_server
(fun () ->
[string_input ~input_type:`Submit ~value:"Generate on server" ()]
) uuid;
div [
pcdata "If you wish the credentials to be generated and managed by an external authority, please send her the following link:";
];
ul [
li [
a
~service:election_setup_credentials
[
pcdata @@ rewrite_prefix @@ Eliom_uri.make_string_uri
~absolute:true
~service:election_setup_credentials
se.se_public_creds
]
se.se_public_creds;
];
];
div [
pcdata "Note that this authority will have to send each credential to each voter herself.";
];
]
in
let form_create =
......@@ -525,6 +508,33 @@ let election_setup_trustees uuid se () =
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let election_setup_credential_authority uuid se () =
let title = "Credentials for election " ^ se.se_questions.t_name in
let content = [
div [
pcdata "If you wish the credentials to be generated and managed by ";
pcdata "an external authority, please send her the following link:";
];
ul [
li [
a
~service:election_setup_credentials
[
pcdata @@ rewrite_prefix @@ Eliom_uri.make_string_uri
~absolute:true
~service:election_setup_credentials
se.se_public_creds
]
se.se_public_creds;
];
];
div [
pcdata "Note that this authority will have to send each credential to each voter herself.";
];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let election_setup_questions uuid se () =
let title = "Questions for election " ^ se.se_questions.t_name in
let form =
......
......@@ -31,6 +31,7 @@ val generic_page : title:string -> string -> unit -> [> `Html ] Eliom_content.Ht
val election_setup : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_voters : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_questions : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_credential_authority : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_credentials : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustees : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustee : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.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