(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
(*  Copyright © 2012-2021 Inria                                           *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful, but   *)
(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

open Lwt
open Lwt.Syntax
open Belenios_core
open Serializable_j
open Common
open Belenios_api.Serializable_t
open Web_serializable_j
open Web_common
open Eliom_content.Html.F
open Eliom_content.Html.F.Form

module Make
         (Web_state : Web_state_sig.S)
         (Web_i18n : Web_i18n_sig.S)
         (Web_services : Web_services_sig.S)
         (Pages_common : Pages_common_sig.S)
         (Mails_admin : Belenios_ui.Mails_admin_sig.S)
  = struct

  open Web_services
  open Pages_common

  let admin_background = " background: #FF9999;"

  let get_preferred_gettext () = Web_i18n.get_preferred_gettext "admin"

  let privacy_notice cont =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Election server" ^ " — " ^ s_ "Personal data processing notice" in
    let content =
      [
        div [
            txt (s_ "To use this site, you must accept our ");
            direct_a !Web_config.gdpr_uri (s_ "personal data policy");
            txt ".";
          ];
        post_form ~service:privacy_notice_accept
          (fun ncont ->
            [
              div [
                  input ~input_type:`Hidden ~name:ncont ~value:cont (user string_of_privacy_cont);
                  input ~input_type:`Submit ~value:(s_ "Accept") string;
                ];
            ]
          ) ();
      ]
    in
    base ~title ~content ()

  let login_box ?cont () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let style = "float: right; text-align: right;" ^ admin_background in
    let* user = Eliom_reference.get Web_state.site_user in
    let auth_systems = List.map (fun x -> x.auth_instance) !Web_config.site_auth_config in
    let cont = match cont with
      | None -> ContSiteHome
      | Some x -> x
    in
    let login service = Eliom_service.preapply ~service:site_login (Some service, cont) in
    let logout () = Eliom_service.preapply ~service:logout cont in
    let body =
      match user with
      | Some (_, account, _) ->
         [
           div [
               txt (s_ "Logged in as");
               txt " ";
               em [a ~service:Web_services.account [txt account.account_name] ()];
               txt ".";
             ];
           div [
               a ~a:[a_id "logout"] ~service:(logout ()) [txt (s_ "Log out")] ();
               txt ".";
             ];
         ]
      | None ->
         [
           div [
               txt (s_ "Not logged in.");
             ];
           let auth_systems =
             List.map (fun name ->
                 a ~a:[a_id ("login_" ^ name)]
                   ~service:(login name) [txt name] ()
               ) auth_systems |> List.join (txt ", ")
           in
           div (
               [txt (s_ "Log in:"); txt " ["] @ auth_systems @ [txt "]"]
             );
         ]
    in
    return (div ~a:[a_style style] body)

  let admin_login get_handler =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let contact = match !Web_config.contact_uri with
      | None -> txt ""
      | Some uri ->
         div [
             txt (s_ "If you do not have any account, you may ");
             direct_a ~target:"_blank" uri (s_ "contact us");
             txt ".";
           ]
    in
    let* auth_div =
      match !Web_config.site_auth_config with
      | [] -> return @@ txt ""
      | {auth_instance = service; _} :: others ->
         let* default = get_handler service in
         let default =
           match default with
           | Web_auth_sig.Html x ->
              div ~a:[a_class ["embedded-login-form"]] [x]
           | Web_auth_sig.Redirection _ ->
              div
                [
                  txt (s_ "Log in with");
                  txt " ";
                  a ~service:site_login [txt service]
                    (Some service, ContSiteAdmin);
                  txt ".";
                ]
         in
         let others =
           List.map
             (fun {auth_instance = service; _} ->
               div
                 [
                   txt (s_ "You can also log in with");
                   txt " ";
                   a ~service:site_login [txt service]
                     (Some service, ContSiteAdmin);
                   txt ".";
                 ]
             ) others
         in
         return @@ div (default :: others)
    in
    let* body =
      let default =
        div [
            txt (s_ "To administer an election, you need to log in.");
            contact;
          ]
      in
      read_snippet ~default ~lang !Web_config.admin_home
    in
    let content = [
        body;
        auth_div;
      ] in
    let title = "Belenios" ^ " — " ^ s_ "Verifiable online voting platform" in
    let* login_box = login_box ~cont:ContSiteAdmin () in
    base ~title ~login_box ~content ()

  let admin ~elections =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let format_election (uuid, name) =
      let name = if name = "" then s_ "(untitled)" else name in
      li [
          a ~service:election_admin
            ~a:[a_id ("election_admin_" ^ (Uuid.unwrap uuid))]
            [txt name] uuid;
        ]
    in
    let format_draft_election (uuid, name) =
      let name = if name = "" then s_ "(untitled)" else name in
      li [
          a ~service:election_draft
            ~a:[a_id ("election_draft_" ^ (Uuid.unwrap uuid))]
            [txt name] uuid;
        ]
    in
    let title = s_ "Election server" ^ " — " ^ s_ "Administration" in
    match elections with
    | (draft, elections, tallied, archived) ->
       let draft =
         match draft with
         | [] -> p [txt (s_ "You own no such elections!")]
         | _ -> ul @@ List.map format_draft_election draft
       in
       let elections =
         match elections with
         | [] -> p [txt (s_ "You own no such elections!")]
         | _ -> ul @@ List.map format_election elections
       in
       let tallied =
         match tallied with
         | [] -> p [txt (s_ "You own no such elections!")]
         | _ -> ul @@ List.map format_election tallied
       in
       let archived =
         match archived with
         | [] -> p [txt (s_ "You own no such elections!")]
         | _ -> ul @@ List.map format_election archived
       in
       let prepare_new_election =
         if !Web_config.deny_newelection then (
           div [
               txt (s_ "New elections are not allowed on this server.");
             ]
         ) else (
           div [
               a ~a:[a_id "prepare_new_election"] ~service:election_draft_pre [
                   txt (s_ "Prepare a new election");
                 ] ();
             ]
         )
       in
       let content = [
           div [
               prepare_new_election;
               div [br ()];
               h2 [txt (s_ "Elections being prepared")];
               draft;
               div [br ()];
               h2 [txt (s_ "Elections you can administer")];
               elections;
               div [br ()];
               h2 [txt (s_ "Tallied elections")];
               tallied;
               div [br ()];
               h2 [txt (s_ "Archived elections")];
               archived;
             ];
         ] in
       let* login_box = login_box () in
       let* lang_box = lang_box ContSiteAdmin in
       base ~lang_box ~title ~login_box ~content ()

  let new_election_failure reason () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Create new election" in
    let reason =
      match reason with
      | `Exists -> txt (s_ "An election with the same UUID already exists.")
      | `Exception e -> txt @@ Printexc.to_string e
    in
    let content = [
        div [
            p [txt (s_ "The creation failed.")];
            p [reason];
          ]
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_draft_pre () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Prepare a new election" in
    let form =
      post_form ~service:election_draft_new
        (fun (credmgmt, (auth, cas_server)) ->
          let auth_systems =
            !Web_config.exported_auth_config
            |> List.mapi
                 (fun i x ->
                   let checked = i = 0 in
                   match x with
                   | `BuiltinPassword ->
                      div [
                          label [
                              radio ~checked ~name:auth ~value:"password" string;
                              txt " ";
                              txt (s_ "sent in advance by e-mail (useful for multiple elections)");
                            ]
                        ]
                   | `BuiltinCAS ->
                      div [
                          label [
                              radio ~checked ~name:auth ~value:"cas" string;
                              txt " ";
                              txt (s_ "CAS (external authentication server, offers better security guarantees when applicable)");
                            ];
                          div ~a:[a_style "margin-left: 5em;"] [
                              txt (s_ "Server address:");
                              txt " ";
                              input ~input_type:`Text ~name:cas_server string;
                              txt " ";
                              txt (s_ "(for example: https://cas.inria.fr/cas)");
                            ];
                        ]
                   | `Export a ->
                      let legend =
                        match a.auth_system with
                        | "email" ->
                           [
                             txt (s_ "sent by email when voting (a short password, renewed for each vote)");
                           ]
                        | _ ->
                           [
                             txt a.auth_instance;
                             txt " ";
                             txt (s_ "(imported from server)");
                           ]
                      in
                      div [
                          label (
                              radio ~checked ~name:auth ~value:("%" ^ a.auth_instance) string
                              :: txt " "
                              :: legend
                            );
                        ]
                 )
          in
          [
            div [
                txt (s_ "For a better control of eligibility, voters will be authenticated by two factors: credentials and passwords");
                txt " (";
                direct_a Belenios_ui.Links.setup (s_ "more info");
                txt ").";
              ];
            ol [
                li [
                    txt (s_ "Credentials:");
                    div [
                        label [
                            radio ~checked:true ~name:credmgmt ~value:"auto" string;
                            txt " ";
                            txt (s_ "sent by our server (easier mode but offers less security)");
                          ]
                      ];
                    div [
                        label [
                            radio ~name:credmgmt ~value:"manual" string;
                            txt " ";
                            txt (s_ "sent by a third party chosen by you (safe mode)");
                          ]
                      ];
                  ];
                li (txt (s_ "Passwords:") :: auth_systems);
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Proceed") string;
              ];
          ]
        ) ()
    in
    let content = [
        form
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let preview_booth l uuid metadata =
    let open (val l : Belenios_ui.I18n.GETTEXT) in
    let hash =
      Netencoding.Url.mk_url_encoded_parameters
        [
          "uuid", Uuid.unwrap uuid;
          "lang", lang;
        ]
    in
    let Booth election_vote = fst booths.(get_booth_index metadata.e_booth_version) in
    let service =
      Eliom_uri.make_string_uri
        ~service:(election_vote ()) ~absolute:true () |> rewrite_prefix
    in
    span [
        direct_a (service ^ "#" ^ hash) (s_ "Preview booth");
        txt " ";
        txt (Printf.sprintf (f_ "(you can use any credential such as %s).") "123-456-789-abc-deN");
      ]

  let election_draft uuid se () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = Printf.sprintf (f_ "Preparation of election %s") (br_truncate se.se_questions.t_name) in
    let available_languages = List.map fst Belenios_ui.Languages.available in
    let form_languages =
      post_form ~service:election_draft_languages
        (fun languages ->
          [
            div [
                txt (s_ "Languages:");
                txt " ";
                input ~name:languages ~input_type:`Text
                  ~value:(string_of_languages se.se_metadata.e_languages) string;
                txt " (";
                txt (s_ "Available languages:");
                txt " ";
                txt (string_of_languages (Some available_languages));
                txt ")";
              ];
            div [
                txt (s_ "This is a space-separated list of languages that will be used in emails sent by the server.");
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Save changes") string;
              ];
        ]) uuid
    in
    let div_languages =
      div [
          h2 [txt (s_ "Languages")];
          form_languages;
        ]
    in
    let form_description =
      post_form ~service:election_draft_description
        ~a:[a_id "name_and_description_form"]
        (fun (name, description) ->
          [
            div [
                txt (s_ "Name of the election:");
                txt " ";
                input ~name:name
                  ~input_type:`Text ~value:se.se_questions.t_name
                  ~a:[a_placeholder (s_ "Name of the election")]
                  string;
              ];
            div [
                div [
                    txt (s_ "Description of the election:");
                    txt " ";
                  ];
                div [
                    textarea ~name:description
                      ~a:[a_cols 80; a_placeholder (s_ "Description of the election.")]
                      ~value:se.se_questions.t_description
                      ();
                  ];
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Save changes") string;
              ];
          ]
        ) uuid
    in
    let div_description =
      div [
          h2 [txt (s_ "Name and description of the election")];
          form_description;
        ]
    in
    let form_admin_name =
      post_form ~service:election_draft_admin_name ~a:[a_id "form_admin_name"]
        (fun name ->
          [
            div [
                txt (s_ "Public name of the administrator:");
                txt " ";
                let value =
                  match se.se_administrator with
                  | Some x -> x
                  | None -> ""
                in
                input ~name ~input_type:`Text ~value string;
              ];
            div [
                txt (s_ "This name will be published on the election result page.");
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Save changes") string;
              ];
        ]) uuid
    in
    let div_admin_name =
      div [
          h2 [txt (s_ "Public name of the administrator")];
          form_admin_name;
        ]
    in
    let form_contact =
      post_form ~service:election_draft_contact ~a:[a_id "form_contact"]
        (fun contact ->
          [
            div [
                txt (s_ "Contact:");
                txt " ";
                let value =
                  match se.se_metadata.e_contact with
                  | Some x -> x
                  | None -> default_contact
                in
                input ~name:contact ~input_type:`Text ~value
                  ~a:[a_placeholder (s_ "Name <user@example.org>")]
                  string;
              ];
            div [
                txt (s_ "This contact will be added to emails sent to the voters.");
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Save changes") string;
              ];
        ]) uuid
    in
    let div_contact =
      div [
          h2 [txt (s_ "Contact")];
          form_contact;
        ]
    in
    let auth = match se.se_metadata.e_auth_config with
      | Some [{auth_system = "password"; _}] -> `Password
      | Some [{auth_system = "dummy"; _}] -> `Dummy
      | Some [{auth_system = "cas"; auth_config = ["server", server]; _}] -> `CAS server
      | Some [{auth_system = "import"; auth_instance = name; _}] -> `Import name
      | _ -> failwith "unknown authentication scheme in election_draft"
    in
    let div_auth =
      div [
          h2 [txt (s_ "Authentication")];
          match auth with
          | `Password ->
             div [
                 txt (s_ "Authentication scheme: password");
                 if List.for_all (fun v -> v.sv_password <> None) se.se_voters then
                   div [txt (s_ "All passwords have been sent!")]
                 else
                   post_form ~service:election_draft_auth_genpwd
                     (fun () ->
                       [input ~input_type:`Submit ~value:(s_ "Generate and mail missing passwords") string]
                     ) uuid;
               ]
          | `Dummy ->
             div [
                 txt (s_ "Authentication scheme: dummy")
               ]
          | `CAS server ->
             div [
                 txt (s_ "Authentication scheme: CAS with server ");
                 txt server;
               ]
          | `Import name ->
             div [
                 txt (Printf.sprintf (f_ "Authentication scheme: %s (imported from server)") name);
               ]
        ]
    in
    let div_questions =
      div [
          h2 [
              a ~a:[a_id "edit_questions"] ~service:election_draft_questions
                [txt (s_ "Edit questions")]
                uuid;
            ];
          preview_booth l uuid se.se_metadata;
        ]
    in
    let div_voters =
      div [
          h2 [
              a ~a:[a_id "edit_voters"] ~service:election_draft_voters
                [txt (s_ "Edit voters")]
                uuid
            ];
          div [
              txt @@ string_of_int @@ List.length se.se_voters;
              txt (s_ " voter(s) registered");
            ];
        ]
    in
    let div_trustees =
      div [
          h2 [txt (s_ "Trustees")];
          div [
              txt (s_ "By default, the election server manages the keys of the election (degraded privacy mode).");
              txt " ";
              txt (s_ "For real elections, the key must be shared among independent trustees.");
              txt " ";
              txt (s_ "Click ");
              a ~service:election_draft_trustees [txt (s_ "here")] uuid;
              txt (s_ " to set up the election key.");
            ];
        ]
    in
    let cred_auth_is_server = se.se_metadata.e_cred_authority = Some "server" in
    let div_credentials =
      div [
          h2 [txt (s_ "Credentials")];
          if se.se_public_creds_received then (
            let div_private_creds =
              if cred_auth_is_server then
                div [
                    a ~service:election_draft_credentials_get
                      [txt (s_ "Download private credentials")] uuid
                  ]
              else txt ""
            in
            let div_edit_credential_authority_name =
              if cred_auth_is_server then
                txt ""
              else
                div [
                    a ~service:election_draft_credential_authority [
                        txt (s_ "Edit credential authority name");
                      ] uuid;
                  ]
            in
            div [
                div [txt (s_ "Credentials have already been generated!")];
                div_edit_credential_authority_name;
                div_private_creds;
              ]
          ) else (
            div [
                txt (s_ "Warning: this will freeze the voter list!");
                if cred_auth_is_server then (
                  post_form ~service:election_draft_credentials_server
                    (fun () ->
                      [input ~input_type:`Submit ~value:(s_ "Generate on server") string]
                    ) uuid
                ) else (
                  div [
                      a ~service:election_draft_credential_authority [txt (s_ "Credential management")] uuid;
                    ]
                );
              ]
          )
        ]
    in
    let link_confirm = div [
                           h2 [txt (s_ "Validate creation")];
                           a ~service:election_draft_confirm [txt (s_ "Create election")] uuid;
                         ] in
    let form_destroy =
      let t = Option.value se.se_creation_date ~default:default_creation_date in
      let t = Period.add t (Period.day days_to_delete) in
      post_form
        ~service:election_draft_destroy
        (fun () ->
          [
            div [
                h2 [txt (s_ "Destroy election")];
                div [
                    txt (s_ "Note: this election will be automatically destroyed after ");
                    txt (Datetime.format t);
                    txt ".";
                  ];
                input ~input_type:`Submit ~value:(s_ "Destroy election") string;
              ]
          ]
        ) uuid
    in
    let content = [
        div_description;
        hr ();
        div_admin_name;
        hr ();
        div_languages;
        hr ();
        div_contact;
        hr ();
        div_questions;
        hr ();
        div_voters;
        hr ();
        div_credentials;
        hr ();
        div_auth;
        hr ();
        div_trustees;
        hr ();
        link_confirm;
        hr ();
        form_destroy;
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_draft_trustees ?token uuid se () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = Printf.sprintf (f_ "Trustees for election %s") se.se_questions.t_name in
    let form_trustees_add =
      post_form
        ~service:election_draft_trustee_add
        (fun (n_id, n_comment) ->
          [
            txt (s_ "Trustee's e-mail address:");
            txt " ";
            input ~input_type:`Text ~name:n_id string;
            txt ", ";
            txt (s_ "public name:");
            txt " ";
            input ~input_type:`Text ~name:n_comment string;
            input ~input_type:`Submit ~value:(s_ "Add") string;
          ]
        ) uuid
    in
    let mk_form_trustee_del value =
      post_form
        ~service:election_draft_trustee_del
        (fun name ->
          [
            input ~input_type:`Hidden ~name ~value string;
            input ~input_type:`Submit ~value:(s_ "Remove") string;
        ]) uuid
    in
    let langs = get_languages se.se_metadata.e_languages in
    let* trustees =
      match se.se_trustees with
      | `Basic x when x.dbp_trustees <> [] ->
         let ts = x.dbp_trustees in
         let* ts =
           Lwt_list.map_s
             (fun t ->
               let this_line =
                 match token with
                 | Some x when x = t.st_token -> true
                 | _ -> false
               in
               let uri =
                 Printf.sprintf "%s/draft/trustee.html#%s-%s"
                   !Web_config.prefix (Uuid.unwrap uuid) t.st_token
               in
               let* mail_cell, link_cell =
                 if t.st_token <> "" then (
                   if t.st_public_key = "" then (
                     let* subject, body = Mails_admin.mail_trustee_generation_basic langs uri in
                     let mail_cell = a_mailto ~dest:t.st_id ~subject ~body (s_ "E-mail") in
                     let link_cell =
                       if this_line then
                         a ~service:election_draft_trustees [txt (s_ "Hide link")] uuid
                       else
                         Raw.a ~a:[a_href (uri_of_string (fun () -> uri))] [txt (s_ "Link")]
                     in
                     return (mail_cell, link_cell)
                   ) else (
                     let cell = txt (s_ "(done)") in
                     return (cell, cell)
                   )
                 ) else (
                   let cell = txt (s_ "(server)") in
                   return (cell, cell)
                 )
               in
               let first_line =
                 tr [
                     td [
                         txt t.st_id;
                       ];
                     td [
                         match t.st_name with
                         | None -> txt (s_ "(not available)")
                         | Some x -> txt x
                       ];
                     td [mail_cell];
                     td [link_cell];
                     td [
                         txt (if t.st_public_key = "" then s_ "No" else s_ "Yes");
                       ];
                     td [if t.st_id = "server" then txt (s_ "(cannot be removed)") else mk_form_trustee_del t.st_id];
                   ]
               in
               let second_line =
                 if this_line then
                   [
                     tr
                       [
                         td ~a:[a_colspan 6]
                           [
                             txt (s_ "The link that must be sent to trustee ");
                             txt t.st_id;
                             txt (s_ " is:");
                             br ();
                             txt uri;
                           ]
                       ]
                   ]
                 else []
               in
               return (first_line :: second_line)
             ) ts
         in
         return @@ table (
                       tr [
                           th [txt (s_ "Trustee")];
                           th [txt (s_ "Public name")];
                           th [txt (s_ "E-mail")];
                           th [txt (s_ "Link")];
                           th [txt (s_ "Done?")];
                           th [txt (s_ "Remove")];
                         ] :: (List.flatten ts)
                     )
      | _ -> return (txt "")
    in
    let import_link = div [
                          a ~service:Web_services.election_draft_import_trustees
                            [txt (s_ "Import trustees from another election")] uuid
                        ]
    in
    let div_trustees =
      match se.se_trustees with
      | `Basic x ->
         div [
             trustees;
             (if x.dbp_trustees <> [] then
                div [
                    txt (s_ "There is one link per trustee. Send each trustee the respective link.");
                    br ();
                    br ();
                  ]
              else txt "");
             form_trustees_add;
           ]
      | `Threshold _ -> txt ""
    in
    let div_content =
      div [
          div [
              txt (s_ "To set up the election key, you need to nominate trustees. Each trustee will create a secret key.");
              txt " ";
              txt (s_ "To set up the election so that only a subset of trustees is needed, go to the ");
              a ~service:election_draft_threshold_trustees [txt (s_ "threshold mode")] uuid;
              txt ".";
            ];
          br ();
          div_trustees;
        ]
    in
    let back_link = div [
                        a ~service:Web_services.election_draft
                          [txt (s_ "Go back to election draft")] uuid;
                      ] in
    let content = [
        div_content;
        import_link;
        back_link;
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_draft_threshold_trustees ?token uuid se () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = Printf.sprintf (f_ "Trustees for election %s") se.se_questions.t_name in
    let dtp =
      match se.se_trustees with
      | `Basic _ ->
         {
           dtp_threshold = None;
           dtp_trustees = [];
           dtp_parameters = None;
           dtp_error = None;
         }
      | `Threshold x -> x
    in
    let show_add_remove = dtp.dtp_threshold = None in
    let form_trustees_add =
      if show_add_remove then
        post_form
          ~service:election_draft_threshold_trustee_add
          (fun (n_id, n_comment) ->
            [
              txt (s_ "Trustee's e-mail address:");
              txt " ";
              input ~input_type:`Text ~name:n_id string;
              txt ", ";
              txt (s_ "public name:");
              txt " ";
              input ~input_type:`Text ~name:n_comment string;
              input ~input_type:`Submit ~value:(s_ "Add") string;
            ]
          ) uuid
      else txt ""
    in
    let mk_form_trustee_del value =
      post_form
        ~service:election_draft_threshold_trustee_del
        (fun name ->
          [
            input ~input_type:`Hidden ~name ~value string;
            input ~input_type:`Submit ~value:(s_ "Remove") string;
        ]) uuid
    in
    let langs = get_languages se.se_metadata.e_languages in
    let* trustees =
      match dtp.dtp_trustees with
      | [] -> return (txt "")
      | ts ->
         let* ts =
           Lwt_list.map_s
             (fun t ->
               let this_line =
                 match token with
                 | Some x when x = t.stt_token -> true
                 | _ -> false
               in
               let state =
                 match t.stt_step with
                 | None -> "init"
                 | Some 1 -> "1a"
                 | Some 2 -> "1b"
                 | Some 3 -> "2a"
                 | Some 4 -> "2b"
                 | Some 5 -> "3a"
                 | Some 6 -> "3b"
                 | Some 7 -> "done"
                 | _ -> "unknown"
               in
               let uri =
                 Printf.sprintf "%s/draft/threshold-trustee.html#%s-%s"
                   !Web_config.prefix (Uuid.unwrap uuid) t.stt_token
               in
               let* mail_cell =
                 let* subject, body = Mails_admin.mail_trustee_generation_threshold langs uri in
                 return (a_mailto ~dest:t.stt_id ~subject ~body (s_ "E-mail"))
               in
               let first_line =
                 tr (
                     [
                       td [
                           txt t.stt_id;
                         ];
                       td [
                           match t.stt_name with
                           | None -> txt (s_ "(not available)")
                           | Some x -> txt x
                         ];
                       td [mail_cell];
                       td [
                           if this_line then
                             a ~service:election_draft_threshold_trustees [txt (s_ "Hide link")] uuid
                           else
                             Raw.a ~a:[a_href (uri_of_string (fun () -> uri))] [txt (s_ "Link")]
                         ];
                       td [
                           txt state;
                         ];
                     ] @ (if show_add_remove then [td [mk_form_trustee_del t.stt_id]] else [])
                   )
               in
               let second_line =
                 if this_line then
                   [
                     tr
                       [
                         td ~a:[a_colspan (if show_add_remove then 6 else 5)]
                           [
                             txt (s_ "The link that must be sent to trustee ");
                             txt t.stt_id;
                             txt (s_ " is:");
                             br ();
                             txt uri;
                           ]
                       ]
                   ]
                 else []
               in
               return (first_line :: second_line)
             ) ts
         in
         return @@ div [
                       table (
                           tr (
                               [
                                 th [txt (s_ "Trustee")];
                                 th [txt (s_ "Public name")];
                                 th [txt (s_ "Mail")];
                                 th [txt (s_ "Link")];
                                 th [txt (s_ "State")];
                               ] @ (if show_add_remove then [th [txt (s_ "Remove")]] else [])
                             ) :: (List.flatten ts)
                         );
                       div [
                           txt (s_ "Meaning of states:");
                           ul [
                               li [txt (s_ "init: administrator needs to set threshold")];
                               li [txt (s_ "1a: action needed from trustee: generate private key")];
                               li [txt (s_ "2a, 3a: action needed from trustee: enter private key")];
                               li [txt (s_ "1b, 2b, 3b: waiting for other trustees")];
                               li [txt (s_ "done: the key establishment protocol is finished")];
                             ];
                         ];
                       br ();
                     ]
    in
    let form_threshold, form_reset =
      match dtp.dtp_trustees with
      | [] -> txt "", txt ""
      | ts ->
         match dtp.dtp_threshold with
         | None ->
            post_form ~service:election_draft_threshold_set
              (fun name ->
                [
                  txt (s_ "Threshold:");
                  txt " ";
                  input ~input_type:`Text ~name int;
                  input ~input_type:`Submit ~value:(s_ "Set") string;
                  txt " ";
                  txt (s_ "(the threshold must be smaller than the number of trustees)");
                ]
              ) uuid,
            txt ""
         | Some i ->
            div [
                txt (string_of_int i);
                txt (s_ " out of ");
                txt (string_of_int (List.length ts));
                txt (s_ " trustees will be needed to decrypt the result.");
              ],
            post_form ~service:election_draft_threshold_set
              (fun name ->
                [
                  input ~input_type:`Hidden ~name ~value:0 int;
                  input ~input_type:`Submit ~value:(s_ "Reset threshold") string;
                ]
              ) uuid
    in
    let maybe_error =
      match dtp.dtp_error with
      | None -> txt ""
      | Some e -> div [b [txt "Error: "]; txt e; br (); br ()]
    in
    let div_content =
      div [
          div [txt (s_ "On this page, you can configure a group of trustees so that only a subset of them is needed to perform the decryption.")];
          br ();
          form_threshold;
          br ();
          trustees;
          (if dtp.dtp_trustees <> [] then
             div [
                 txt (s_ "There is one link per trustee. Send a link to each trustee.");
                 br ();
                 br ();
                 maybe_error;
               ]
           else txt "");
          form_trustees_add;
          form_reset;
        ]
    in
    let back_link = div [
                        a ~service:Web_services.election_draft
                          [txt (s_ "Go back to election draft")] uuid;
                      ] in
    let content = [
        div_content;
        br ();
        back_link;
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_draft_credential_authority uuid se () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = Printf.sprintf (f_ "Credentials for election %s") se.se_questions.t_name in
    let public_name_form =
      post_form ~service:election_draft_set_credential_authority
        (fun name ->
          let value =
            match se.se_metadata.e_cred_authority with
            | Some x -> x
            | None -> ""
          in
          [
            txt (s_ "Public name of the credential authority:");
            txt " ";
            input ~input_type:`Text ~name ~value string;
            input ~input_type:`Submit ~value:(s_ "Set") string;
          ]
        ) uuid
    in
    let back =
      div [
          a ~service:Web_services.election_draft
            [txt (s_ "Back to election preparation page")] uuid;
        ]
    in
    let url =
      Printf.sprintf "%s/draft/credentials.html#%s-%s"
        !Web_config.prefix (Uuid.unwrap uuid) se.se_public_creds
    in
    let content = [
        back;
        public_name_form;
        div [
            let subject, body = Mails_admin.mail_credential_authority l url in
            a_mailto ~subject ~body (s_ "Send instructions to the credential authority");
          ];
        div [
            txt (s_ "Alternatively, you can send the credential authority the following link:");
          ];
        ul [
            li [
                Raw.a
                  ~a:[
                    a_id "credential_authority_link";
                    a_href (uri_of_string (fun () -> url))
                  ]
                  [txt url];
              ];
          ];
        div [
            txt (s_ "Note that this authority will personally have to send each credential to its respective voter.");
          ];
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_draft_credentials_done se () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = Printf.sprintf (f_ "Credentials for election %s") se.se_questions.t_name in
    let content =
      [
        div [txt (s_ "Credentials have been received and checked!")];
        div [
            div [b [txt (s_ "Instructions")]];
            div [
                txt (s_ "Once the election is open, check that:");
                ol [
                    li [
                        txt (s_ "the number of voters is correct, and the fingerprint of the voter list matches what has been saved;");
                      ];
                    li [
                        txt (s_ "the fingerprint of public credentials matches what has been saved;");
                      ];
                    li [
                        txt (s_ "you can send the private credential back to its rightful owner in case it gets lost.")
                      ];
                  ];
              ];
            div [
                txt (s_ "Once the election is over, the file creds.txt must be destroyed.");
              ];
          ];
      ]
    in
    base ~title ~content ()

  let script_with_lang ~lang file =
    let file = static file in
    let dir = Filename.dirname (string_of_uri file) in
    div [
        Printf.ksprintf Unsafe.data
          "<script>var belenios_lang = %S; var belenios_dir = %S;</script>"
          lang (dir ^ "/");
        script ~a:[a_src file] (txt "");
      ]

  let election_draft_questions uuid se () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = Printf.sprintf (f_ "Questions for election %s") se.se_questions.t_name in
    let booth_version =
      match se.se_metadata.e_booth_version with
      | None -> 1
      | Some v -> v
    in
    let form =
      let value = string_of_template se.se_questions in
      post_form
        ~service:election_draft_questions_post
        (fun (nquestions, nbooth) ->
          [
            div [txt (s_ "Questions:")];
            div [textarea ~a:[a_id "questions"; a_rows 5; a_cols 80] ~name:nquestions ~value ()];
            div [input ~input_type:`Text ~a:[a_id "booth_version"] ~name:nbooth ~value:booth_version int];
            div [input ~input_type:`Submit ~value:(s_ "Save changes") string]])
        uuid
    in
    let allow_nh =
      match get_suitable_group_kind se.se_questions with
      | `NH -> true
      | `H -> not (is_group_fixed se)
    in
    let hybrid_box =
      div ~a:[a_class ["hybrid_box"]]
        [
          div [txt (s_ "Alternative voting methods (warning, still experimental):")];
          div
            [
              txt (s_ "You may wish voters to rank candidates or give each candidate a score.");
              txt " ";
              txt (s_ "This allows deciding the winner according to your favorite counting method.");
              txt " ";
              txt (s_ "Our platform currently supports Condorcet, STV and majority judgment, but you may also apply your own method on the raw result (shuffled list of ballots).");
            ];
          div [txt (s_ "Note that:")];
          ol
            [
              li [txt (s_ "the after-the-vote procedure will require more steps;")];
              li
                [
                  txt (s_ "the voting interface will depend on the selected counting method. In some cases, you should explain to voters (e.g. in the question field) how they are supposed to express their vote.");
                  txt " ";
                  direct_a Belenios_ui.Links.mixnet (s_ "More information.");
                ];
            ];
          div
            [
              label
                [
                  input ~a:[a_id "hybrid_mode"] ~input_type:`Checkbox string;
                  txt (s_ "Tick the box to activate this mode.");
                ];
            ];
        ]
    in
    let interactivity =
      div
        ~a:[a_id "interactivity"]
        [
          script (Printf.ksprintf txt "var allow_nh = %b;" allow_nh);
          script_with_lang ~lang "tool_js_questions.js";
          hybrid_box;
        ]
    in
    let back =
      div [
          a ~service:Web_services.election_draft [txt (s_ "Go back to election draft")] uuid;
        ]
    in
    let content = [
        back;
        interactivity;
        form;
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_draft_voters uuid se maxvoters () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = Printf.sprintf (f_ "Voters for election %s") se.se_questions.t_name in
    let tooltip =
        div ~a:[a_class ["tooltip"]; a_style "position:relative;display:inline-block;"] [
            div ~a:[a_style "display:inline-block;width:3ex;line-height:3ex;text-align:center;border-radius:1.5ex;background-color:black;color:white;"] [ txt "?" ];
            div ~a:[a_class ["tooltiptext"]; a_style "position:absolute;left:3ex;line-height:2.5ex;border:1px solid black;font-size:90%;display:inline-block;width:400px;padding:3px;background-color:#eee;"] [
                txt (s_ "An identity is either \"address\", or \"address,username\", or \"address,username,weight\", or \"address,,weight\" where \"address\" is an e-mail address, \"username\" the associated user name for authentication, and \"weight\" is the number of votes of the voter (in case voters don't have all the same number of votes).");
            ]
        ]
    in
    let form =
      let placeholder =
        "bart.simpson@example.com              # " ^ s_ "typical use"
        ^ "\nalbert.einstein@example.com,albert_e  # " ^ s_ "when a login is needed, e.g. CAS"
        ^ "\nasterix.legaulois@example.com,,2      # " ^ s_ "when some voters have several votes"
      in
      post_form
        ~service:election_draft_voters_add
        (fun name ->
          [
            div [textarea ~a:[a_style "vertical-align:top"; a_placeholder placeholder; a_rows 20; a_cols 80] ~name (); tooltip ];
            div [input ~input_type:`Submit ~value:(s_ "Add") string]])
        uuid
    in
    let mk_remove_button id =
      post_form
        ~service:election_draft_voters_remove
        (fun name ->
          [
            input ~input_type:`Hidden ~name ~value:id string;
            input ~input_type:`Submit ~value:(s_ "Remove") string;
          ]
        ) uuid
    in
    let remove_all_button =
      if se.se_public_creds_received then
        div []
      else
        post_form ~service:election_draft_voters_remove_all
          (fun () ->
            [input ~input_type:`Submit ~value:(s_ "Remove all") string]
          ) uuid
    in
    let has_passwords = match se.se_metadata.e_auth_config with
      | Some [{auth_system = "password"; _}] -> true
      | _ -> false
    in
    let mk_regen_passwd value =
      post_form ~service:election_draft_voters_passwd
        ~a:[a_style "display: inline;"]
        (fun name ->
          [
            input ~input_type:`Hidden ~name ~value string;
            input ~input_type:`Submit ~value:(s_ "Send again") string;
          ]
        ) uuid
    in
    let format_password_cell x = match x.sv_password with
      | Some _ -> [txt (s_ "Yes"); txt " "; mk_regen_passwd x.sv_id]
      | None -> [txt (s_ "No")]
    in
    let voters =
      List.map (fun v ->
          tr (
              [td [txt v.sv_id]] @
                (if has_passwords then [td (format_password_cell v)] else []) @
                  (if se.se_public_creds_received then [] else [td [mk_remove_button v.sv_id]])
            )
        ) se.se_voters
    in
    let form_passwords =
      if has_passwords then
        post_form ~service:election_draft_auth_genpwd
          (fun () ->
            [input ~input_type:`Submit ~value:(s_ "Generate and mail missing passwords") string]
          ) uuid
      else txt ""
    in
    let voters =
      match voters with
      | [] -> div [txt (s_ "No voters")]
      | _ :: _ ->
         div [
             form_passwords;
             br ();
             table
               (tr (
                    [th [txt (s_ "Identity")]] @
                      (if has_passwords then [th [txt (s_ "Password sent?")]] else []) @
                        (if se.se_public_creds_received then [] else [th [txt (s_ "Remove")]])
                  ) :: voters);
             remove_all_button;
           ]
    in
    let back = div [
                   a ~service:Web_services.election_draft [txt (s_ "Go back to election draft")] uuid;
                 ] in
    let div_add =
      if se.se_public_creds_received then
        txt ""
      else
        div [
            div [
                txt (s_ "Please enter the identities of voters to add, one per line");
                txt " (max ";
                txt (string_of_int maxvoters);
                txt ").";
              ];
            form;
          ]
    in
    let warning =
      div [
          div ~a:[a_style "text-align:center;font-size:120%;"]
            [
              b [txt (s_ "Warning:")];
              txt " ";
              txt (s_ "you have to make sure that the email addresses are valid.");
            ];
          div ~a:[a_style "text-align:center;font-style:italic;width:80%;margin-left:auto;margin-right:auto;"]
            [
              txt (s_ "You won't be able to change the email addresses once the credentials are created. Voters with invalid email addresses won't be able to vote.");
            ]
        ]
    in
    let div_import = div [
                         a ~service:election_draft_import
                           [txt (s_ "Import voters from another election")]
                           uuid
                       ] in
    let content = [
        back;
        div_import;
        br ();
        warning;
        voters;
        div_add;
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_draft_credentials_already_generated () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Credential generation" in
    let content =
      [
        div [txt (s_ "Credentials have already been generated!")];
      ]
    in
    base ~title ~content ()

  let election_draft_credentials_static () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Credential generation" in
    let div_link =
      div [
          txt (s_ "The link to the election will be:");
          ul [li [span ~a:[a_id "election_url"] []]];
        ]
    in
    let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in
    let form_textarea =
      post_form ~a:[a_id "submit_form"; a_style "display:none;"]
        ~service:election_draft_credentials_post
        (fun name ->
          [div
             [div [txt (s_ "Public credentials:")];
              div [textarea ~a:[a_id "pks"; a_rows 5; a_cols 40] ~name ()];
              div [
                  txt (s_ "Fingerprint of public credentials:");
                  txt " ";
                  span ~a:[a_id "public_creds_fp"] [];
                ];
              div [
                  b [txt (s_ "Instructions:")];
                  ol [
                      li [
                          txt (s_ "Download ");
                          raw_a ~service:home ~a:[a_id "creds"] [txt (s_ "private credentials")] ();
                          txt (s_ " and save the file to a secure location.");
                          br ();
                          txt (s_ "You will use it to send credentials to voters.");
                        ];
                      li [
                          txt (s_ "Download ");
                          raw_a ~service:home ~a:[a_id "voters_txt"] [txt (s_ "the list of voters")] ();
                          txt ".";
                          br ();
                          txt (s_ "This list must be the one approved by the election commission.");
                        ];
                      li [
                          txt (s_ "Save the two fingerprints above.");
                          br ();
                          txt (s_ "Once the election is open, you must check that they match with what is published by the server.");
                        ];
                      li [txt (s_ "Submit public credentials using the button below.")];
                    ];
                ];
              div [input ~input_type:`Submit ~value:(s_ "Submit public credentials") string]]])
        (uuid, token)
    in
    let disclaimer =
      p
        [
          b [txt (s_ "Note:")];
          txt " ";
          txt (s_ "submitting a large number of credentials using the above form may fail; in this case, you have to use the command-line tool and the form below.");
        ]
    in
    let form_file =
      post_form ~a:[a_id "submit_form_file"]
        ~service:election_draft_credentials_post_file
        (fun name ->
          [div
             [h2 [txt (s_ "Submit by file")];
              div [txt (s_ "Use this form to upload public credentials generated with the command-line tool.")];
              div [file_input ~name ()];
              div [input ~input_type:`Submit ~value:(s_ "Submit") string]]])
        (uuid, token)
    in
    let voters =
      let hash = span ~a:[a_id "voters_hash"] [] in
      div [
          div [txt (s_ "List of voters:")];
          div [raw_textarea ~rows:5 ~cols:40 "voters" ""];
          div [txt (s_ "Fingerprint of voters:"); txt " "; hash];
        ]
    in
    let interactivity =
      div
        ~a:[a_id "interactivity"]
        [
          script_with_lang ~lang "tool_js_credgen.js";
        ]
    in
    let div_textarea = div [voters; interactivity; form_textarea; disclaimer] in
    let content =
      div ~a:[a_id "initially_hidden_content"; a_style "display: none;"] [
        div_link;
        div_textarea;
        form_file;
      ]
    in
    base ~title ~content:[content] ~static:true ()

  let election_draft_trustee_static () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Trustee key generation" in
    let div_link =
      div [
          txt (s_ "The link to the election will be:");
          ul [li [span ~a:[a_id "election_url"] []]];
        ]
    in
    let form =
      let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in
      let service = Eliom_service.preapply ~service:election_draft_trustee_post (uuid, token) in
      post_form
        ~a:[a_id "data_form"]
        ~service
        (fun name ->
          [
            div ~a:[a_id "submit_form"; a_style "display:none;"] [
                div [txt (s_ "Public key:")];
                div [textarea ~a:[a_rows 5; a_cols 40; a_id "pk"] ~name ()];
                div [
                    txt (s_ "Fingerprint of the verification key:");
                    txt " ";
                    span ~a:[a_id "public_key_fp"] [];
                  ];
                div [
                    b [txt (s_ "Instructions:")];
                    ol [
                        li [
                            txt (s_ "Download your ");
                            raw_a ~service:home ~a:[a_id "private_key"] [txt (s_ "private key")] ();
                            txt (s_ " and save it to a secure location.");
                            br ();
                            txt (s_ "You will use it to decrypt the final result.");
                          ];
                        li [
                            txt (s_ "Save the fingerprint above.");
                            br ();
                            txt (s_ "Once the election is open, you must check that it is present in the set of public keys published by the server.");
                          ];
                        li [txt (s_ "Submit your public key using the button below.")];
                      ];
                  ];
                div [input ~input_type:`Submit ~value:(s_ "Submit public key") string];
              ]
          ]
        ) ()
    in
    let interactivity =
      div
        ~a:[a_id "interactivity"]
        [
          script_with_lang ~lang "tool_js_tkeygen.js";
        ]
    in
    let content =
      div ~a:[a_id "initially_hidden_content"; a_style "display: none;"] [
        div_link;
        interactivity;
        form;
      ]
    in
    base ~title ~content:[content] ~static:true ()

  let election_draft_threshold_trustee_static () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Trustee key generation" in
    let header =
      div ~a:[a_style "text-align:center;"] [
          h2 [txt (s_ "Collaborative key generation")];
          div ~a:[a_id "current_step"] [
              txt (s_ "Step 0/3")
            ];
        ]
    in
    let div_link =
      div [
          txt (s_ "The link to the election will be:");
          ul [li [span ~a:[a_id "election_url"] []]];
        ]
    in
    let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in
    let form =
      post_form
        ~service:election_draft_threshold_trustee_post
        ~a:[a_id "data_form"]
        (fun data ->
          [
            div ~a:[a_id "key_helper"; a_style "display:none;"] [
                b [txt (s_ "Instructions:")];
                ol [
                    li [
                        txt (s_ "Download your ");
                        raw_a ~service:home ~a:[a_id "private_key"] [txt (s_ "private key")] ();
                        txt (s_ " and save it to a secure location.");
                        br ();
                        txt (s_ "You will use it in the next steps and to decrypt the final result.");
                      ];
                    li [
                        txt (s_ "The fingerprint of your public key is ");
                        span ~a:[a_id "pki_fp"] [];
                        txt (s_ ". Save it so that you can check that it appears on the election home later.");
                      ];
                    li [
                        txt (s_ "Submit data using the following button:");
                        txt " ";
                        input ~input_type:`Submit ~value:(s_ "Submit") string;
                        txt ".";
                        div [
                            txt (s_ "Data:");
                            txt " ";
                            textarea ~a:[a_id "data"; a_rows 5; a_cols 40] ~name:data ();
                          ];
                      ];
                  ];
              ];
          ]
        ) (uuid, token)
    in
    let form_compute =
      div ~a:[a_id "compute_form"; a_style "display: none;"] [
          b [txt (s_ "Instructions:")];
          ol [
              li [
                  txt (s_ "Enter your private key:");
                  txt " ";
                  input ~input_type:`Text ~a:[a_id "compute_private_key"] string;
                  txt " ";
                  button_no_value ~a:[a_id "compute_button"] ~button_type:`Button [
                      txt (s_ "Proceed");
                    ];
                ];
              li [
                  txt (s_ "Submit data using the following button:");
                  post_form
                    ~a:[a_id "data_form_compute"]
                    ~service:election_draft_threshold_trustee_post
                    (fun data ->
                      [
                        input ~input_type:`Submit ~value:(s_ "Submit") string;
                        div [
                            txt (s_ "Data:");
                            txt " ";
                            textarea ~a:[a_id "compute_data"; a_rows 5; a_cols 40] ~name:data ();
                          ];
                      ]
                    ) (uuid, token);
                ];
            ];
        ]
    in
    let interactivity =
      div
        ~a:[a_id "interactivity"]
        [
          script_with_lang ~lang "tool_js_ttkeygen.js";
        ]
    in
    let div_instructions =
      div ~a:[a_id "div_instructions"; a_style "display: none;"]
        [
          b [txt (s_ "Instructions")];
          ol [
              li [txt (s_ "Save the fingerprint above.")];
              li [txt (s_ "Once the election is open, you must check that it is present in the set of verification keys published by the server.")];
              li [txt (s_ "Remember that you must also check the presence of your public key.")];
              li [txt (s_ "Remember to store you private key securely.")];
            ];
        ]
    in
    let content =
      div ~a:[a_id "initially_hidden_content"; a_style "display: none;"] [
        header;
        div_link;
        br ();
        div ~a:[a_id "explain"] [];
        interactivity;
        form;
        form_compute;
        div_instructions;
      ]
    in
    base ~title ~content:[content] ~static:true ()

  let election_draft_importer l ~service ~title ~note uuid (elections, tallied, archived) =
    let open (val l : Belenios_ui.I18n.GETTEXT) in
    let format_election (from_uuid, name) =
      let from_uuid = Uuid.unwrap from_uuid in
      let form = post_form ~service
                   (fun from ->
                     [
                       div [
                           txt name;
                           txt " (";
                           txt from_uuid;
                           txt ")"
                         ];
                       div [
                           input
                             ~input_type:`Hidden
                             ~name:from
                             ~value:from_uuid string;
                           input ~input_type:`Submit ~value:(s_ "Import from this election") string;
                         ]
                     ]
                   ) uuid
      in
      li [form]
    in
    let itemize xs = match xs with
      | [] -> p [txt (s_ "You own no such elections!")]
      | _ -> ul @@ List.map format_election xs
    in
    let content = [
        b [txt (s_ "Note:")];
        txt " ";
        txt note;
        h2 [txt (s_ "Elections you can administer")];
        itemize elections;
        h2 [txt (s_ "Tallied elections")];
        itemize tallied;
        h2 [txt (s_ "Archived elections")];
        itemize archived;
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_draft_import uuid se elections () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Election " ^ se.se_questions.t_name ^ " — " ^ s_ "Import voters from another election" in
    let note = s_ "Imported voters will have the same password as in the original election, and no new e-mail will be sent." in
    let service = election_draft_import_post in
    election_draft_importer l ~service ~title ~note uuid elections

  let election_draft_import_trustees uuid se elections () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Election " ^ se.se_questions.t_name ^ " — " ^ s_ "Import trustees from another election" in
    let note = s_ "Imported trustees will have the same keys as in the original election." in
    let service = election_draft_import_trustees_post in
    election_draft_importer l ~service ~title ~note uuid elections

  let election_draft_confirm uuid se () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let notok x = span ~a:[a_style "color: red;"] [txt x] in
    let ok x = txt x in
    let title = s_ "Election " ^ se.se_questions.t_name ^ " — " ^ s_ "Validate creation" in
    let* s = Api_drafts.get_draft_status uuid se in
    let ready = true in
    let ready, name =
      if se.se_questions.t_name = default_name then
        false, notok (s_ "Not edited")
      else
        ready, ok "OK"
    in
    let ready, description =
      if se.se_questions.t_description = default_description then
        false, notok (s_ "Not edited")
      else
        ready, ok "OK"
    in
    let ready, admin_name =
      if se.se_administrator = None then
        false, notok (s_ "Missing")
      else
        ready, ok "OK"
    in
    let ready, questions =
      if se.se_questions.t_questions = default_questions then
        false, notok (s_ "Not edited")
      else
        ready, ok "OK"
    in
    let ready, voters =
      match s.status_num_voters with
      | 0 -> false, notok "Missing"
      | n -> ready, ok (Printf.sprintf (f_ "%d voter(s)") n)
    in
    let ready, passwords =
      match s.status_passwords_ready with
      | Some true -> ready, ok "OK"
      | Some false -> false, notok (s_ "Missing")
      | None -> ready, ok (s_ "Not applicable")
    in
    let ready, credential_authority =
      match se.se_metadata.e_cred_authority with
      | None | Some "" -> false, notok (s_ "Missing")
      | Some _ -> ready, ok "OK"
    in
    let ready, credentials =
      match s.status_credentials_ready with
      | true -> ready, ok "OK"
      | false -> false, notok (s_ "Missing")
    in
    let private_creds =
      match s.status_private_credentials_downloaded with
      | Some true -> ok "OK"
      | Some false ->
         span [
             notok (s_ "Not downloaded.");
             txt " ";
             txt (s_ "Please ");
             a ~service:election_draft_credentials_get [txt (s_ "download")] uuid;
             txt (s_ " and save them securely.");
           ]
      | None -> ok (s_ "Not applicable")
    in
    let ready, trustees =
      match s.status_trustees_ready with
      | true -> ready, ok "OK"
      | false -> false, notok (s_ "Missing")
    in
    let ready, nh_and_weights =
      match s.status_nh_and_weights_compatible with
      | true -> ready, []
      | false ->
         false,
         [
           tr [
               td [txt (s_ "Compatibility of weights with questions?")];
               td [notok (s_ "Alternative questions cannot be combined with weights.")];
             ]
         ]
    in
    let div_trustee_warning =
      match se.se_trustees with
      | `Basic x when x.dbp_trustees = [] ->
         div [
             b [txt (s_ "Warning:")];
             txt " ";
             txt (s_ "No trustees were set. This means the server will manage the election key by itself.");
           ]
      | _ -> txt ""
    in
    let contact, div_contact_warning =
      match se.se_metadata.e_contact with
      | None ->
         s_ "No",
         div [
             b [txt (s_ "Warning:")];
             txt " ";
             txt (s_ "No contact was set!");
           ]
      | Some _ -> s_ "Yes", txt ""
    in
    let table_checklist =
      [
        [
          tr [
              td [txt (s_ "Name?")];
              td [name];
            ];
          tr [
              td [txt (s_ "Description?")];
              td [description];
            ];
          tr [
              td [txt (s_ "Public name of the administrator?")];
              td [admin_name];
            ];
          tr [
              td [txt (s_ "Questions?")];
              td [questions; txt " "; preview_booth l uuid se.se_metadata];
            ];
          tr [
              td [txt (s_ "Voters?")];
              td [voters];
            ];
          tr [
              td [txt (s_ "Passwords?")];
              td [passwords];
            ];
          tr [
              td [txt (s_ "Credential authority?")];
              td [credential_authority];
            ];
          tr [
              td [txt (s_ "Credentials?")];
              td [credentials];
            ];
          tr [
              td [txt (s_ "Private credentials?")];
              td [private_creds];
            ];
          tr [
              td [txt (s_ "Trustees?")];
              td [trustees];
            ];
          tr [
              td [txt (s_ "Contact?")];
              td [txt contact];
            ];
        ];
        nh_and_weights;
      ]
      |> List.flatten
      |> table
    in
    let status =
      if ready then
        span ~a:[a_style "color: green;"] [txt (s_ "election ready")]
      else
        span ~a:[a_style "color: red;"] [txt (s_ "election not ready")]
    in
    let checklist = div [
                        h2 [txt (s_ "Checklist:"); txt " "; status];
                        table_checklist;
                        div_trustee_warning;
                        div_contact_warning;
                      ] in
    let form_create =
      if ready then
        post_form
          ~service:election_draft_create
          (fun () ->
            [div
               [h2 [txt (s_ "Validate creation")];
                input ~input_type:`Submit ~value:(s_ "Create election") string;
                txt " ";
                txt (s_ "(Warning: This action is irreversible.)");
            ]]
          ) uuid
      else div []
    in
    let back = div [
                   a ~service:Web_services.election_draft [txt (s_ "Go back to election draft")] uuid;
                 ] in
    let content = [
        back;
        checklist;
        form_create;
      ] in
    let* login_box = login_box () in
    base ~title ~login_box ~content ()

  let election_admin ?shuffle_token ?tally_token election metadata status () =
    let langs = get_languages metadata.e_languages in
    let* l = get_preferred_gettext () in
    let open (val l) in
    let open (val election : Site_common_sig.ELECTION_LWT) in
    let uuid = election.e_uuid in
    let title = br_truncate election.e_name ^ " — " ^ s_ "Administration" in
    let auto_form () =
      let* d = Api_elections.get_election_automatic_dates uuid in
      let format = function
        | None -> ""
        | Some x -> Datetime.format @@ Datetime.from_unixfloat x
      in
      return @@ post_form ~service:election_auto_post
                  (fun (lopen, lclose) ->
                    [
                      div [txt (s_ "Alternatively, you may set up automatic dates.")];
                      div [
                          b [txt (s_ "Note:")];
                          txt " ";
                          txt (s_ "times are in UTC. Now is ");
                          txt (Datetime.format @@ Datetime.now ());
                          txt ".";
                        ];
                      div ~a:[a_style "margin-left: 3em;"] [
                          div [
                              txt (s_ "Automatically open the election at:");
                              txt " ";
                              input ~name:lopen ~input_type:`Text ~value:(format d.auto_date_open) string;
                            ];
                          div [
                              txt (s_ "Automatically close the election at:");
                              txt " ";
                              input ~name:lclose ~input_type:`Text ~value:(format d.auto_date_close) string;
                            ];
                          div [
                              txt (s_ "Enter dates in UTC format, as per YYYY-MM-DD HH:MM:SS, leave empty for no date.");
                            ];
                        ];
                      div [
                          input ~input_type:`Submit ~value:(s_ "Change automatic dates") string;
                        ];
                    ]
                  ) uuid
    in
    let state_form checked =
      let service, value, msg, msg2 =
        if checked then
          election_close, s_ "Close election",
          s_ "The election is open. Voters can vote.",
          s_ " You may re-open the election when it is closed."
        else
          election_open, s_ "Open election",
          s_ "The election is closed. No one can vote.",
          ""
      in
      post_form
        ~service
        (fun () ->
          [
            div ~a:[a_style "text-align: center;"] [
                txt msg;
                txt " ";
              ];
            br ();
            input ~input_type:`Submit ~value string;
            txt msg2;
        ]) uuid
    in
    let* state_div =
      match status.status_state with
      | `Open ->
         let* auto_form = auto_form () in
         return @@ div [
                       state_form true;
                       br ();
                       auto_form;
                     ]
      | `Closed ->
         let* auto_form = auto_form () in
         return @@ div [
                       state_form false;
                       br ();
                       auto_form;
                       br ();
                       hr ();
                       post_form
                         ~service:election_compute_encrypted_tally
                         (fun () ->
                           [input
                              ~input_type:`Submit
                              ~value:(s_ "Proceed to vote counting")
                              string;
                            txt " ";
                            txt (s_ "Warning: This action is irreversible; the election will be definitively closed.");
                         ]) uuid;
                     ]
      | `Shuffling ->
         let* shuffles = Api_elections.get_shuffles uuid metadata in
         let shufflers = shuffles.shuffles_shufflers in
         let select_disabled = List.exists (fun x -> x.shuffler_token <> None) shufflers in
         let* table_contents =
           Lwt_list.map_s
             (fun x ->
               let skip, hash, done_ =
                 let mk_skip disabled =
                   post_form ~service:election_shuffler_skip_confirm
                     (fun (nuuid, ntrustee) ->
                       let a = if disabled then [a_disabled ()] else [] in
                       [
                         input ~input_type:`Hidden ~name:nuuid ~value:uuid (user Uuid.unwrap);
                         input ~input_type:`Hidden ~name:ntrustee ~value:x.shuffler_address string;
                         input ~a ~input_type:`Submit ~value:(s_ "Skip") string;
                       ]
                     ) ()
                 in
                 match x.shuffler_fingerprint with
                 | None -> mk_skip false, txt "", false
                 | Some h -> mk_skip true, txt (if h = "" then s_ "(skipped)" else h), true
               in
               let this_line =
                 match shuffle_token with
                 | Some y when x.shuffler_token = Some y -> true
                 | _ -> false
               in
               let* cell =
                 match x.shuffler_token with
                 | Some token ->
                    let uri =
                      rewrite_prefix @@
                        Eliom_uri.make_string_uri
                          ~absolute:true ~service:election_shuffle_link (uuid, token)
                    in
                    let* subject, body = Mails_admin.mail_shuffle langs uri in
                    return @@ div
                                [
                                  a_mailto ~dest:x.shuffler_address ~subject ~body (s_ "Mail");
                                  txt " | ";
                                  if this_line then
                                    a ~service:election_admin [txt (s_ "Hide link")] uuid
                                  else
                                    a ~service:election_shuffle_link ~a:[a_id "shuffle-link"] [txt (s_ "Link")] (uuid, token)
                                ]
                 | None ->
                    return @@ post_form ~service:election_shuffler_select
                                (fun (nuuid, ntrustee) ->
                                  let a = if select_disabled || done_ then [a_disabled ()] else [] in
                                  [
                                    input ~input_type:`Hidden ~name:nuuid ~value:uuid (user Uuid.unwrap);
                                    input ~input_type:`Hidden ~name:ntrustee ~value:x.shuffler_address string;
                                    input ~a ~input_type:`Submit ~value:(s_ "Select this trustee") string;
                                  ]
                                ) ()
               in
               let first_line =
                 tr
                   [
                     td [txt x.shuffler_address];
                     td [cell];
                     td [if done_ then txt (s_ "Yes") else txt (s_ "No")];
                     td [skip];
                     td [hash];
                   ]
               in
               let second_line =
                 match this_line, x.shuffler_token with
                 | true, Some token ->
                    [
                      tr
                        [
                          td ~a:[a_colspan 5]
                            [
                              txt (s_ "The link that must be sent to trustee ");
                              txt x.shuffler_address;
                              txt (s_ " is:");
                              br ();
                              Eliom_uri.make_string_uri ~absolute:true
                                ~service:election_shuffle_link (uuid, token)
                              |> rewrite_prefix |> txt
                            ]
                        ]
                    ]
                 | _, _ -> []
               in
               return (first_line :: second_line)
             ) shufflers
         in
         let proceed =
           if List.for_all (fun x -> x.shuffler_fingerprint <> None) shufflers then
             post_form ~service:election_decrypt
               (fun () ->
                 [
                   input ~input_type:`Submit ~value:(s_ "Proceed to decryption") string;
                 ]
               ) uuid
           else
             txt ""
         in
         return (
             div [
                 div [
                     div ~a:[a_style "text-align: center;"]
                       [txt (s_ "Shuffling of ballots")];
                     table
                       (tr
                          [
                            th [txt (s_ "Trustee")];
                            th [];
                            th [txt (s_ "Done?")];
                            th [];
                            th [txt (s_ "Fingerprint")];
                          ] :: (List.flatten table_contents)
                       );
                   ];
                 proceed;
               ]
           )
      | `EncryptedTally ->
         let* p = Api_elections.get_partial_decryptions uuid metadata in
         let threshold_or_not =
           match p.partial_decryptions_threshold with
           | None -> txt ""
           | Some x -> txt (" " ^ Printf.sprintf (f_ "At least %d trustee(s) must act.") x)
         in
         let* trustees =
           p.partial_decryptions_trustees
           |> Lwt_list.map_s
                (fun t ->
                  let this_line =
                    match tally_token with
                    | Some x when x = t.trustee_pd_token -> true
                    | _ -> false
                  in
                  let service = election_tally_trustees in
                  let x = (uuid, t.trustee_pd_token) in
                  let uri = rewrite_prefix @@ Eliom_uri.make_string_uri ~absolute:true ~service x in
                  let* mail, link =
                    if t.trustee_pd_address = "server" then (
                      return (txt (s_ "(server)"), txt (s_ "(server)"))
                    ) else (
                      let* subject, body = Mails_admin.mail_trustee_tally langs uri in
                      let mail = a_mailto ~dest:t.trustee_pd_address ~subject ~body (s_ "E-mail") in
                      let link =
                        if this_line then
                          a ~service:election_admin [txt (s_ "Hide link")] uuid
                        else
                          a ~service [txt (s_ "Link")] x
                      in
                      return (mail, link)
                    )
                  in
                  let first_line =
                    tr [
                        td [txt t.trustee_pd_address];
                        td [mail];
                        td [link];
                        td [
                            txt (if t.trustee_pd_done then s_ "Yes" else s_ "No");
                          ];
                      ]
                  in
                  let second_line =
                    if this_line then
                      [
                        tr
                          [
                            td ~a:[a_colspan 4]
                              [
                                txt (s_ "The link that must be sent to trustee ");
                                txt t.trustee_pd_address;
                                txt (s_ " is:");
                                br ();
                                txt uri;
                              ]
                          ]
                      ]
                    else []
                  in
                  return (first_line :: second_line)
                )
         in
         let* release_form =
           let* hidden = Web_persist.get_election_result_hidden uuid in
           match hidden with
           | Some t ->
              let scheduled =
                div [
                    Printf.sprintf
                      (f_ "The result is scheduled to be published after %s.")
                      (Datetime.unwrap t)
                    |> txt
                  ]
              in
              post_form ~service:election_show_result
                (fun () ->
                  [
                    scheduled;
                    input ~input_type:`Submit ~value:(s_ "Publish the result as soon as possible") string;
                  ]
                ) uuid
              |> return
           | None ->
              let postpone_form =
                post_form ~service:election_hide_result
                  (fun date ->
                    [
                      div [
                          Printf.ksprintf txt (f_ "You may postpone the publication of the election result up to %d days in the future.") days_to_publish_result;
                        ];
                      div [
                          input ~input_type:`Submit ~value:(s_ "Postpone publication until") string;
                          txt " ";
                          input ~name:date ~input_type:`Text string;
                        ];
                      div [
                          txt (s_ "Enter the date in UTC fornat, as per YYYY-MM-DD HH:MM:SS. For example, today is ");
                          txt (String.sub (string_of_datetime (Datetime.now ())) 1 19);
                          txt ".";
                        ];
                    ]
                  ) uuid
              in
              let release_form =
                post_form ~service:election_tally_release
                  (fun () ->
                    [
                      div [
                          txt @@ s_ "You may force the computation of the result now, if the required number of trustees have done their job, by clicking on the following button.";
                          txt " ";
                          txt @@ s_ "Note: no more partial decryptions will be allowed.";
                        ];
                      div [input ~input_type:`Submit ~value:(s_ "Compute the result") string];
                    ]
                  ) uuid
              in
              div [postpone_form; hr (); release_form] |> return
         in
         return @@ div [
                       div [
                           txt (s_ "The ");
                           a
                             ~service:election_dir
                             [txt (s_ "encrypted tally")]
                             (uuid, ESETally);
                           txt (s_ " has been computed.")
                         ];
                       div [
                           div [txt (s_ "Awaiting trustees…"); threshold_or_not];
                           table
                             (tr [
                                  th [txt (s_ "Trustee")];
                                  th [txt (s_ "E-mail")];
                                  th [txt (s_ "Link")];
                                  th [txt (s_ "Done?")];
                                ] :: List.flatten trustees)
                         ];
                       release_form;
                     ]
      | `Tallied ->
         return @@ div [
                       div [txt (s_ "This election has been tallied.")];
                     ]
      | `Archived ->
         return @@ div [
                       txt (s_ "This election is archived.");
                       txt " ";
                       a ~service:election_download_archive [
                           txt (s_ "Download archive.");
                         ] (uuid, ());
                     ]
    in
    let archive_date =
      match status.status_auto_archive_date with
      | None -> txt ""
      | Some t ->
         div [
             txt (s_ "This election will be automatically archived after ");
             txt (Datetime.format @@ Datetime.from_unixfloat t);
             txt ".";
           ]
    in
    let div_archive =
      match status.status_state with
      | `Archived -> txt ""
      | _ -> div [
                 br ();
                 hr ();
                 archive_date;
               ]
    in
    let delete_date =
      let t = status.status_auto_delete_date in
      div [
          txt (s_ "This election will be automatically deleted after ");
          txt (Datetime.format @@ Datetime.from_unixfloat t);
          txt ".";
        ]
    in
    let div_delete =
      div [
          br ();
          hr ();
          delete_date;
          post_form ~service:election_delete (fun () ->
              [
                input ~input_type:`Submit ~value:(s_ "Delete election") string;
                txt " ";
                txt (s_ "Warning: This action is irreversible.");
              ]
            ) uuid;
        ]
    in
    let password = match metadata.e_auth_config with
      | Some [{auth_system = "password"; _}] -> true
      | _ -> false
    in
    let div_regenpwd =
      if password && (match status.status_state with `Open | `Closed -> true | _ -> false) then
        div [
            a ~a:[a_id "election_regenpwd"] ~service:election_regenpwd [txt (s_ "Regenerate and e-mail a password")] uuid;
          ]
      else txt ""
    in
    let content = [
        div [
            a ~service:Web_services.election_home [txt (s_ "Election home")] (uuid, ());
          ];
        div [
            a ~service:election_dir [txt (s_ "Voter list")] (uuid, ESVoters);
          ];
        div [
            a ~service:election_pretty_records [txt (s_ "Voting records")] (uuid, ());
          ];
        div [
            a ~service:election_missing_voters [txt (s_ "Missing voters")] (uuid, ());
          ];
        div_regenpwd;
        hr ();
        div [state_div];
        div_archive;
        div_delete;
      ] in
    let* login_box = login_box ~cont:(ContSiteElection uuid) () in
    base ~title ~login_box ~content ()

  let regenpwd uuid () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let form = post_form ~service:election_regenpwd_post
                 (fun user ->
                   [
                     div [
                         txt (s_ "Username:");
                         txt " ";
                         input ~name:user ~input_type:`Text string;
                       ];
                     div [input ~input_type:`Submit ~value:(s_ "Submit") string];
                   ]
                 ) uuid
    in
    let content = [ form ] in
    let title = s_ "Regenerate and e-mail password" in
    let* login_box = login_box ~cont:(ContSiteElection uuid) () in
    base ~title ~login_box ~content ~uuid ()

  let pretty_records election records () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let open (val election : Site_common_sig.ELECTION_LWT) in
    let uuid = election.e_uuid in
    let title = br_truncate election.e_name ^ " — " ^ s_ "Records" in
    let nrecords = List.length records in
    let records =
      List.map
        (fun {vr_date; vr_username} ->
          tr [
              td [txt @@ Datetime.format @@ Datetime.from_unixfloat vr_date];
              td [txt vr_username]
            ]
        ) records
    in
    let* voters = Web_persist.get_voters uuid in
    let nvoters =
      match voters with
      | None -> failwith "voter list not found"
      | Some l -> List.length l
    in
    let summary =
      div [
          Printf.ksprintf txt
            (f_ "Number of records: %d/%d") nrecords nvoters;
        ]
    in
    let table = match records with
      | [] -> div [txt (s_ "Nobody voted!")]
      | _ ->
         div [
             table
               (tr [th [txt (s_ "Date/Time (UTC)")]; th [txt (s_ "Username")]]
                :: records);
           ]
    in
    let content = [
        div [
            txt (s_ "You can also access the ");
            a ~service:election_dir [txt (s_ "raw data")] (uuid, ESRecords);
            txt ".";
          ];
        summary;
        table;
      ] in
    let* login_box = login_box ~cont:(ContSiteElection uuid) () in
    base ~title ~login_box ~content ()

  let election_shuffler_skip_confirm uuid trustee =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = Printf.sprintf (f_ "Skipping trustee %s") trustee in
    let content =
      [
        post_form ~service:election_shuffler_skip
          (fun (nuuid, ntrustee) ->
            [
              div [txt (s_ "You may skip a trustee if they do not answer. Be aware that this reduces the security.")];
              div
                [
                  input ~input_type:`Hidden ~name:nuuid ~value:uuid (user Uuid.unwrap);
                  input ~input_type:`Hidden ~name:ntrustee ~value:trustee string;
                  input ~input_type:`Submit ~value:(s_ "Confirm") string;
                  txt " ";
                  a ~service:Web_services.election_admin [txt (s_ "Cancel")] uuid;
                ]
            ]
          ) ()
      ]
    in
    base ~title ~content ()

  let shuffle_static () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in
    let title = s_ "Shuffle" in
    let content = [
        div [txt (s_ "As a trustee, your first role is to shuffle the encrypted ballots.")];
        div [
            txt (s_ "Current list of ballots:");
            txt " ";
            raw_textarea ~rows:5 ~cols:40 "current_ballots" "";
            txt " ";
            let service = Eliom_service.preapply ~service:election_nh_ciphertexts uuid in
            raw_a ~a:[a_id "nh_ciphertexts_link"] ~service [txt (s_ "Download as a file")] ();
          ];
        div ~a:[a_id "estimation"] [
            txt (s_ "Estimating computation time…");
          ];
        div ~a:[a_id "wait_div"] [
            txt (s_ "Please wait… ");
            img ~src:(static "encrypting.gif") ~alt:(s_ "Loading…") ();
          ];
        div ~a:[a_id "controls_div"; a_style "display: none;"] [
            button_no_value ~button_type:`Button ~a:[a_id "compute_shuffle"] [txt (s_ "Compute shuffle")];
          ];
        post_form ~service:election_shuffle_post
          ~a:[a_id "submit_form"]
          (fun nshuffle ->
            [
              div [
                  txt (s_ "Shuffled list of ballots:");
                  txt " ";
                  textarea ~a:[a_rows 5; a_cols 40; a_id "shuffle"] ~name:nshuffle ();
                ];
              div ~a:[a_id "hash_div"; a_style "display:none;"] [
                  div [
                      txt (s_ "The fingerprint of your shuffle is:");
                      txt " ";
                      b ~a:[a_id "hash"] [];
                      txt ".";
                    ];
                  div [txt (s_ "You must record this fingerprint and check that it appears on the election result page.")];
                ];
              div [
                  input ~input_type:`Submit ~value:(s_ "Submit") string;
                ];
            ]
          ) (uuid, token);
        script_with_lang ~lang "tool_js_shuffle.js";
      ]
    in
    base ~title ~content ~static:true ()

  let tally_trustees_static () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Partial decryption" in
    let content = [
        p [txt (s_ "It is now time to compute your partial decryption factors.")];
        p [
            txt (s_ "The fingerprint of the encrypted tally is ");
            b [span ~a:[a_id "hash"] []];
            txt "."
          ];
        hr ();
        div [
            b [txt (s_ "Instructions:")];
            ol [
                li [
                    div ~a:[a_id "input_private_key"] [
                        div [
                            p [txt (s_ "Please enter your private key:")];
                            input
                              ~a:[a_id "private_key"; a_size 80]
                              ~input_type:`Text
                              string;
                          ];
                        div [
                            p [txt (s_ "Or load it from a file:")];
                            input
                              ~a:[a_id "private_key_file"]
                              ~input_type:`File
                              string;
                          ];
                      ];
                    br ();
                  ];
                li [
                    div [
                        button_no_value
                          ~a:[a_id "compute"]
                          ~button_type:`Button
                          [txt (s_ "Generate your contribution to decryption")];
                      ];
                    br ();
                  ];
                li [
                    div ~a:[a_id "pd_done"] [
                        let uuid = Uuid.wrap "XXXXXXXXXXXXXX" and token = "XXXXXXXXXXXXXX" in
                        post_form
                          ~a:[a_id "pd_form"]
                          ~service:election_tally_trustees_post
                          (fun pd ->
                            [
                              div [
                                  input ~input_type:`Submit ~value:(s_ "Submit") string;
                                  txt (s_ " your contribution to decryption.");
                                ];
                              div [
                                  txt "Data: ";
                                  textarea
                                    ~a:[a_rows 5; a_cols 40; a_id "pd"]
                                    ~name:pd
                                    ();
                                ];
                            ]
                          ) (uuid,  token);
                      ];
                  ];
              ];
          ];
        script_with_lang ~lang "tool_js_pd.js";
      ] in
    base ~title ~content ~static:true ()

  let signup_captcha ~service error challenge email =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let form =
      post_form ~service:signup_captcha_post
        (fun (lchallenge, (lresponse, lemail)) ->
          [
            div [
                txt (s_ "E-mail address:");
                txt " ";
                input ~input_type:`Text ~name:lemail ~value:email string;
              ];
            div [
                input ~input_type:`Hidden ~name:lchallenge ~value:challenge string;
                txt (s_ "Please enter ");
                Pages_common.signup_captcha_img challenge;
                txt (s_ " in the following box: ");
                input ~input_type:`Text ~name:lresponse string;
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Submit") string;
              ];
          ]
        ) service
    in
    let error = format_captcha_error l error in
    let content = [error; form] in
    base ~title:(s_ "Create an account") ~content ()

  let signup_changepw ~service error challenge email username =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let form =
      post_form ~service:changepw_captcha_post
        (fun (lchallenge, (lresponse, (lemail, lusername))) ->
          [
            div [
                txt (s_ "E-mail address:");
                txt " ";
                input ~input_type:`Text ~name:lemail ~value:email string;
                txt (s_ " or username: ");
                input ~input_type:`Text ~name:lusername ~value:username string;
                txt ".";
              ];
            div [
                input ~input_type:`Hidden ~name:lchallenge ~value:challenge string;
                txt (s_ "Please enter ");
                Pages_common.signup_captcha_img challenge;
                txt (s_ " in the following box: ");
                input ~input_type:`Text ~name:lresponse string;
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Submit") string;
              ];
          ]
        ) service
    in
    let error = format_captcha_error l error in
    let content = [error; form] in
    base ~title:(s_ "Change password") ~content ()

  let signup_login () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let form =
      post_form ~service:signup_login_post
        (fun lcode ->
          [
            div [
                txt (s_ "Please enter the verification code received by e-mail:");
                txt " ";
                input ~input_type:`Text ~name:lcode string;
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Submit") string;
              ];
          ]
        ) ()
    in
    let content = [form] in
    base ~title:(s_ "Account management") ~content ()

  let signup address error username =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let error = match error with
      | None -> txt ""
      | Some e ->
         let msg = match e with
           | UsernameTaken -> s_ "the username is already taken"
           | AddressTaken -> s_ "there is already an account with this e-mail address"
           | BadUsername -> s_ "the username is invalid"
           | BadPassword e -> Printf.sprintf (f_ "the password is too weak (%s)") e
           | PasswordMismatch -> s_ "the two passwords are not the same"
           | BadSpaceInPassword -> s_ "the password starts or ends with a space"
         in
         div [
             txt (s_ "The account creation ");
             span ~a:[a_style "color: red;"] [txt (s_ "failed")];
             txt (s_ " because ");
             txt msg;
             txt (s_ ". Please try again with a different one.");
           ]
    in
    let form =
      post_form ~service:signup_post
        (fun (lusername, (lpassword, lpassword2)) ->
          [
            div [
                txt (s_ "Your e-mail address is: ");
                txt address;
                txt ".";
              ];
            div [
                txt (s_ "Please choose a username: ");
                input ~input_type:`Text ~name:lusername ~value:username string;
                txt (s_ " and a password: ");
                input ~input_type:`Password ~name:lpassword string;
                txt ".";
              ];
            div[
                txt (s_ "Type the password again: ");
                input ~input_type:`Password ~name:lpassword2 string;
                txt ".";
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Submit") string;
              ];
          ]
        ) ()
    in
    let content = [error; form] in
    base ~title:(s_ "Create an account") ~content ()

  let changepw ~username ~address error =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let error = match error with
      | None -> txt ""
      | Some e ->
         let reason = match e with
           | PasswordMismatch -> s_ "the two passwords are not the same"
           | BadPassword e -> Printf.sprintf (f_ "the new password is too weak (%s)") e
           | BadSpaceInPassword -> s_ "the new password starts or ends with a space"
           | _ -> s_ "of an unknown reason"
         in
         div [
             txt (s_ "The change ");
             span ~a:[a_style "color: red;"] [txt (s_ "failed")];
             txt (s_ " because ");
             txt reason;
             txt (s_ ". Please try again with a different one.");
           ]
    in
    let form =
      post_form ~service:changepw_post
        (fun (lpassword, lpassword2) ->
          [
            div [
                txt (s_ "Your username is: ");
                txt username;
                txt (s_ " and your e-mail address is: ");
                txt address;
                txt ".";
              ];
            div [
                txt (s_ "Please choose a password: ");
                input ~input_type:`Password ~name:lpassword string;
                txt ".";
              ];
            div [
                txt (s_ "Type the password again: ");
                input ~input_type:`Password ~name:lpassword2 string;
                txt ".";
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Submit") string;
              ];
          ]
        ) ()
    in
    let content = [error; form] in
    base ~title:(s_ "Change password") ~content ()

  let compute_fingerprint () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let interactivity =
      div
        ~a:[a_id "interactivity"]
        [
          script_with_lang ~lang "tool_js_fingerprint.js";
        ]
    in
    let content = [interactivity] in
    base ~title:(s_ "Compute fingerprint") ~content ()

  let set_email () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let form =
      post_form ~service:set_email_post
        (fun name ->
          [
            div [
                txt (s_ "There is no e-mail address attached to your account.");
                txt " ";
                txt (s_ "Please provide one:");
                txt " ";
                input ~input_type:`Text ~name string;
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Proceed") string;
              ];
          ]
        ) ()
    in
    let content = [form] in
    let title = s_ "Your e-mail address" in
    base ~title ~content ()

  let set_email_confirm ~address =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let form =
      post_form ~service:set_email_confirm
        (fun name ->
          [
            div [
                txt (Printf.sprintf (f_ "An e-mail with a code has been sent to %s.") address);
                txt " ";
                txt (s_ "Please enter the code here:");
                txt " ";
                input ~input_type:`Text ~name string;
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Proceed") string;
              ];
          ]
        ) ()
    in
    let content = [form] in
    let title = s_ "Your e-mail address" in
    base ~title ~content ()

  let sudo () =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let form =
      post_form ~service:sudo_post
        (fun (ndomain, nuser) ->
          [
            div [
                txt "Domain: ";
                input ~input_type:`Text ~name:ndomain string;
                txt ", user: ";
                input ~input_type:`Text ~name:nuser string;
              ];
            div [
                input ~input_type:`Submit ~value:(s_ "Proceed") string;
              ];
          ]
        ) ()
    in
    let content = [form] in
    let title = s_ "Impersonate a user" in
    base ~title ~content ()

  let account account =
    let* l = get_preferred_gettext () in
    let open (val l) in
    let title = s_ "Account settings" in
    let content = [
        post_form ~service:account_post
          (fun name ->
            [
              div [
                  txt (s_ "Name:");
                  txt " ";
                  input ~input_type:`Text ~name ~value:account.account_name string;
                ];
              div [
                  txt (s_ "E-mail address:");
                  txt " ";
                  txt account.account_email;
                ];
              div [
                  txt (s_ "Authentication methods:");
                  txt " ";
                  ul (
                      List.map
                        (fun u ->
                          li [
                              Printf.ksprintf txt "%s:%s" u.user_domain u.user_name;
                            ]
                        ) account.account_authentications;
                    );
                ];
              div [
                  txt (s_ "Consent date:");
                  txt " ";
                  txt (
                      match account.account_consent with
                      | None -> s_ "(none)"
                      | Some t -> Datetime.format t
                    );
                ];
              div [
                  input ~input_type:`Submit ~value:(s_ "Submit") string;
                ];
            ]
          ) ()
      ]
    in
    base ~title ~content ()

end

let mail_confirmation_link l address code =
  let open (val l : Belenios_ui.I18n.GETTEXT) in
  let open Belenios_ui.Mail_formatter in
  let b = create () in
  add_sentence b (Printf.sprintf (f_ "Dear %s,") address);
  add_newline b; add_newline b;
  add_sentence b (s_ "Your e-mail address has been used to create an account on our Belenios server.");
  add_sentence b (s_ "To confirm this creation, please use the following code:");
  add_newline b; add_newline b;
  add_string b "  "; add_string b code;
  add_newline b; add_newline b;
  add_sentence b (s_ "Warning: this code is valid for 15 minutes, and previous codes sent to this address are no longer valid.");
  add_newline b; add_newline b;
  add_sentence b (s_ "Best regards,");
  add_newline b; add_newline b;
  add_string b "-- ";
  add_newline b;
  add_string b (s_ "Belenios Server");
  let body = contents b in
  let subject = s_ "Belenios account creation" in
  subject, body

let mail_changepw_link l address code =
  let open (val l : Belenios_ui.I18n.GETTEXT) in
  let open Belenios_ui.Mail_formatter in
  let b = create () in
  add_sentence b (Printf.sprintf (f_ "Dear %s,") address);
  add_newline b; add_newline b;
  add_sentence b (s_ "There has been a request to change the password of your account on our Belenios server.");
  add_sentence b (s_ "To confirm this, please use the following code:");
  add_newline b; add_newline b;
  add_string b "  "; add_string b code;
  add_newline b; add_newline b;
  add_sentence b (s_ "Warning: this code is valid for 15 minutes, and previous codes sent to this address are no longer valid.");
  add_newline b; add_newline b;
  add_sentence b (s_ "Best regards,");
  add_newline b; add_newline b;
  add_string b "-- ";
  add_newline b;
  add_string b (s_ "Belenios Server");
  let body = contents b in
  let subject = s_ "Belenios password change" in
  subject, body

let mail_set_email l address code =
  let open (val l : Belenios_ui.I18n.GETTEXT) in
  let open Belenios_ui.Mail_formatter in
  let b = create () in
  add_sentence b (Printf.sprintf (f_ "Dear %s,") address);
  add_newline b; add_newline b;
  add_sentence b (s_ "Someone is trying to associate your e-mail address to an account on our Belenios server.");
  add_sentence b (s_ "To confirm this, please use the following code:");
  add_newline b; add_newline b;
  add_string b "  "; add_string b code;
  add_newline b; add_newline b;
  add_sentence b (s_ "Warning: this code is valid for 15 minutes, and previous codes sent to this address are no longer valid.");
  add_newline b; add_newline b;
  add_sentence b (s_ "Best regards,");
  add_newline b; add_newline b;
  add_string b "-- ";
  add_newline b;
  add_string b (s_ "Belenios Server");
  let body = contents b in
  let subject = s_ "Belenios account e-mail address change" in
  subject, body
