Move link for credential authority to a new page

src/web/web_services.ml

@@ -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") ()

src/web/web_site.ml

@@ -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 ()
 

src/web/web_templates.ml

@@ -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 =

src/web/web_templates.mli

@@ -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