Move management of questions to its own page

src/web/web_services.ml

@@ -43,7 +43,8 @@ let election_setup_new = post_coservice ~csrf_safe:true ~fallback:election_setup
 let election_setup = service ~path:["setup"; "election"] ~get_params:(uuid "uuid") ()
 let election_setup_group = post_coservice ~fallback:election_setup ~post_params:(string "group") ()
 let election_setup_metadata = post_coservice ~fallback:election_setup ~post_params:(string "metadata") ()
-let election_setup_questions = post_coservice ~fallback:election_setup ~post_params:(string "questions") ()
+let election_setup_questions = service ~path:["setup"; "questions"] ~get_params:(uuid "uuid") ()
+let election_setup_questions_post = post_coservice ~fallback:election_setup_questions ~post_params:(string "questions") ()
 let election_setup_trustee_add = post_coservice ~fallback:election_setup ~post_params:unit ()
 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") ()

src/web/web_site.ml

@@ -456,7 +456,7 @@ let delete_shallow_directory dir =
 
   let election_setup_mutex = Lwt_mutex.create ()
 
-  let handle_setup f uuid x =
+  let handle_setup f cont uuid x =
     match_lwt get_user () with
     | Some u ->
        let uuid_s = Uuidm.to_string uuid in
@@ -466,7 +466,7 @@ let delete_shallow_directory dir =
            try_lwt
              f se x u;
              Ocsipersist.add election_stable uuid_s se >>
-             Redirection.send (preapply election_setup uuid)
+             Redirection.send (preapply cont uuid)
            with e ->
              T.generic_error_page (Printexc.to_string e) () >>= Html5.send
          ) else forbidden ()
@@ -480,7 +480,7 @@ let delete_shallow_directory dir =
          (fun se x _ ->
           let _group = Group.of_string x in
           (* we keep it as a string since it contains a type *)
-          se.se_group <- x))
+          se.se_group <- x) election_setup)
 
   let () =
     Any.register
@@ -489,14 +489,28 @@ let delete_shallow_directory dir =
          (fun se x u ->
           let metadata = metadata_of_string x in
           if metadata.e_owner <> Some u then failwith "wrong owner";
-          se.se_metadata <- metadata))
+          se.se_metadata <- metadata) election_setup)
 
   let () =
-    Any.register
+    Html5.register
       ~service:election_setup_questions
+      (fun uuid () ->
+       match_lwt get_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_questions uuid se ()
+          else forbidden ()
+       | None -> forbidden ()
+      )
+
+  let () =
+    Any.register
+      ~service:election_setup_questions_post
       (handle_setup
          (fun se x _ ->
-          se.se_questions <- template_of_string x))
+          se.se_questions <- template_of_string x) election_setup_questions)
 
   let () =
     Redirection.register

src/web/web_templates.ml

@@ -394,11 +394,13 @@ let make_login_box style auth links =
         (Eliom_service.preapply election_setup_metadata uuid)
         value "Election metadata"
     in
-    let form_questions =
-      let value = string_of_template se.se_questions in
-      make_form
-        (Eliom_service.preapply election_setup_questions uuid)
-        value "Questions"
+    let div_questions =
+      div
+        [h2 [pcdata "Questions"];
+         a
+           ~service:election_setup_questions
+           [pcdata "Manage questions"]
+           uuid]
     in
     let form_trustees =
       post_form
@@ -438,12 +440,32 @@ let make_login_box style auth links =
       div_credentials;
       form_group;
       form_metadata;
-      form_questions;
+      div_questions;
       form_create;
     ] in
     lwt login_box = site_login_box () in
     base ~title ~login_box ~content
 
+  let election_setup_questions uuid se () =
+    let title = "Questions for election " ^ Uuidm.to_string uuid in
+    let form =
+      let value = string_of_template se.se_questions in
+      post_form
+        ~service:election_setup_questions_post
+        (fun name ->
+         [
+           div [pcdata "Questions:"];
+           div [textarea ~a:[a_id "questions"; a_rows 5; a_cols 80] ~name ~value ()];
+           div [string_input ~input_type:`Submit ~value:"Submit" ()]])
+        uuid
+    in
+    let content = [
+      h1 [pcdata title];
+      form;
+    ] in
+    lwt login_box = site_login_box () in
+    base ~title ~login_box ~content
+
   let election_setup_credentials token uuid se () =
     let title = "Credentials for election " ^ uuid in
     let form_textarea =

src/web/web_templates.mli

@@ -31,6 +31,7 @@ val generic_error_page : string -> unit -> [> `Html ] Eliom_content.Html5.F.elt
 
 val election_setup_index : Uuidm.t list -> 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_questions : 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_trustee : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t