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 ...@@ -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_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_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_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 = 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_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") () 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 ...@@ -341,28 +341,24 @@ let () = Redirection.register ~service:election_setup_new
| None -> forbidden () | None -> forbidden ()
) )
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 f uuid se ()
else forbidden ()
| None -> forbidden ()
let () = Html5.register ~service:election_setup let () = Html5.register ~service:election_setup
(fun uuid () -> (generic_setup_page T.election_setup)
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 ()
else forbidden ()
| None -> forbidden ()
)
let () = Html5.register ~service:election_setup_trustees let () = Html5.register ~service:election_setup_trustees
(fun uuid () -> (generic_setup_page T.election_setup_trustees)
match_lwt Web_auth_state.get_site_user () with
| Some u -> let () = Html5.register ~service:election_setup_credential_authority
let uuid_s = Uuidm.to_string uuid in (generic_setup_page T.election_setup_credential_authority)
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 ())
let election_setup_mutex = Lwt_mutex.create () let election_setup_mutex = Lwt_mutex.create ()
......
...@@ -418,31 +418,14 @@ let election_setup uuid se () = ...@@ -418,31 +418,14 @@ let election_setup uuid se () =
div [ div [
h2 [pcdata "Credentials"]; h2 [pcdata "Credentials"];
div [ 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 post_form ~service:election_setup_credentials_server
(fun () -> (fun () ->
[string_input ~input_type:`Submit ~value:"Generate on server" ()] [string_input ~input_type:`Submit ~value:"Generate on server" ()]
) uuid; ) 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 in
let form_create = let form_create =
...@@ -525,6 +508,33 @@ let election_setup_trustees uuid se () = ...@@ -525,6 +508,33 @@ let election_setup_trustees uuid se () =
lwt login_box = site_login_box () in lwt login_box = site_login_box () in
base ~title ~login_box ~content () 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 election_setup_questions uuid se () =
let title = "Questions for election " ^ se.se_questions.t_name in let title = "Questions for election " ^ se.se_questions.t_name in
let form = let form =
......
...@@ -31,6 +31,7 @@ val generic_page : title:string -> string -> unit -> [> `Html ] Eliom_content.Ht ...@@ -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 : 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_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_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_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_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 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