Attention une mise à jour du service Gitlab va être effectuée le mardi 30 novembre entre 17h30 et 18h00. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes. Cette mise à jour intermédiaire en version 14.0.12 nous permettra de rapidement pouvoir mettre à votre disposition une version plus récente.

templates.ml 12.7 KB
Newer Older
Stephane Glondu's avatar
Stephane Glondu committed
1 2 3
(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
Stephane Glondu's avatar
Stephane Glondu committed
4
(*  Copyright © 2012-2014 Inria                                           *)
Stephane Glondu's avatar
Stephane Glondu committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
(*                                                                        *)
(*  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/>.                                       *)
(**************************************************************************)

Stephane Glondu's avatar
Stephane Glondu committed
22
open Signatures
Stephane Glondu's avatar
Stephane Glondu committed
23
open Util
24
open Serializable_t
25
open Web_signatures
Stephane Glondu's avatar
Stephane Glondu committed
26 27
open Eliom_content.Html5.F

Stephane Glondu's avatar
Stephane Glondu committed
28
(* TODO: these pages should be redesigned *)
Stephane Glondu's avatar
Stephane Glondu committed
29

Stephane Glondu's avatar
Stephane Glondu committed
30 31
let site_title = "Election Server"
let welcome_message = "Welcome!"
Stephane Glondu's avatar
Stephane Glondu committed
32

Stephane Glondu's avatar
Stephane Glondu committed
33
let format_user u =
34 35
  em [pcdata (Auth_common.(string_of_user u.user_user))]

Stephane Glondu's avatar
Stephane Glondu committed
36
module Make (S : Web_signatures.ALL_SERVICES) = struct
Stephane Glondu's avatar
Stephane Glondu committed
37

Stephane Glondu's avatar
Stephane Glondu committed
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
  let base ~title ~content =
    lwt user = S.get_logged_user () in
    Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
      (head (Eliom_content.Html5.F.title (pcdata title)) [])
      (body [
        div ~a:[a_id "header"] [
          div [
            div ~a:[a_style "float: left;"] [
              a ~service:S.home [pcdata site_title] ();
            ];
            div ~a:[a_style "float: right; text-align: right;"] (
              match user with
              | Some user ->
                [
                  div [
                    pcdata "Logged in as ";
                    format_user user;
                    pcdata ".";
                  ];
                  div [
                    a ~service:S.logout [pcdata "Log out"] ();
                    pcdata ".";
                  ];
                ]
              | None ->
                [
                  div [
                    pcdata "Not logged in.";
                  ];
                  let auth_systems = List.map (fun name ->
                    let service = Eliom_service.preapply S.login (Some name) in
                    a ~service [pcdata name] ()
                  ) (S.get_auth_systems ()) in
                  div (
                    [ pcdata "Login: " ] @
                    list_join (pcdata ", ") auth_systems @
                    [ pcdata "." ]
                  );
                ]
            );
            div ~a:[a_style "clear: both;"] [];
Stephane Glondu's avatar
Stephane Glondu committed
79 80
          ];
        ];
Stephane Glondu's avatar
Stephane Glondu committed
81 82 83 84 85 86 87 88
        div ~a:[a_id "content"] content;
        hr ();
        div ~a:[a_id "footer"; a_style "text-align: center;" ] [
          pcdata "Powered by ";
          a ~service:S.source_code [pcdata "Belenios"] ();
          pcdata ".";
        ]
       ]))
89

Stephane Glondu's avatar
Stephane Glondu committed
90 91 92 93 94 95 96 97
  let format_one_featured_election e =
    li [
      h3 [
        a ~service:(S.election_file e Services.ESIndex)
          [pcdata e.e_name] ();
      ];
      p [pcdata e.e_description];
    ]
Stephane Glondu's avatar
Stephane Glondu committed
98

Stephane Glondu's avatar
Stephane Glondu committed
99 100 101
  let index ~featured =
    let featured_box = match featured with
      | _::_ ->
Stephane Glondu's avatar
Stephane Glondu committed
102
        div [
Stephane Glondu's avatar
Stephane Glondu committed
103 104
          h2 [pcdata "Current featured elections"];
          ul (List.map format_one_featured_election featured);
Stephane Glondu's avatar
Stephane Glondu committed
105
        ]
Stephane Glondu's avatar
Stephane Glondu committed
106
      | [] ->
107
        div [
Stephane Glondu's avatar
Stephane Glondu committed
108
          pcdata "No featured elections at the moment.";
109
        ]
Stephane Glondu's avatar
Stephane Glondu committed
110 111 112 113 114 115 116 117 118
    in
    let content = [
      h1 [pcdata site_title];
      div [
        pcdata welcome_message;
        featured_box;
      ];
    ] in
    base ~title:site_title ~content
119

Stephane Glondu's avatar
Stephane Glondu committed
120 121 122
  let dummy_login ~service =
    let title, field_name, input_type =
      "Dummy login", "Username:", `Text
Stephane Glondu's avatar
Stephane Glondu committed
123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
    in
    let form = post_form ~service
      (fun name ->
        [
          tablex [tbody [
            tr [
              th [label ~a:[a_for name] [pcdata field_name]];
              td [string_input ~a:[a_maxlength 50] ~input_type ~name ()];
            ]]
          ];
          div [
            string_input ~input_type:`Submit ~value:"Login" ();
          ]
        ]) ()
    in
    let content = [
      h1 [pcdata title];
      form;
    ] in
    base ~title ~content
143

Stephane Glondu's avatar
Stephane Glondu committed
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
  let password_login ~service =
    let form = post_form ~service
      (fun (llogin, lpassword) ->
        [
          tablex [tbody [
            tr [
              th [label ~a:[a_for llogin] [pcdata "Username:"]];
              td [string_input ~a:[a_maxlength 50] ~input_type:`Text ~name:llogin ()];
            ];
            tr [
              th [label ~a:[a_for lpassword] [pcdata "Password:"]];
              td [string_input ~a:[a_maxlength 50] ~input_type:`Password ~name:lpassword ()];
            ];
          ]];
          div [
            string_input ~input_type:`Submit ~value:"Login" ();
          ]
        ]) ()
    in
    let content = [
      h1 [pcdata "Password login"];
      form;
    ] in
    base ~title:"Password login" ~content
Stephane Glondu's avatar
Stephane Glondu committed
168

Stephane Glondu's avatar
Stephane Glondu committed
169 170 171 172 173 174
  let generic_login () =
    let content = [
      h1 [pcdata "Log in"];
      div [p [pcdata "Please choose one authentication system."]];
    ] in
    base ~title:"Log in" ~content
Stephane Glondu's avatar
Stephane Glondu committed
175

Stephane Glondu's avatar
Stephane Glondu committed
176 177
  let format_date (date, _) =
    CalendarLib.Printer.Precise_Fcalendar.sprint "%a, %d %b %Y %T %z" date
Stephane Glondu's avatar
Stephane Glondu committed
178

Stephane Glondu's avatar
Stephane Glondu committed
179 180 181 182 183 184
  let make_button ~service contents =
    let uri = Eliom_uri.make_string_uri ~service () in
    Printf.ksprintf unsafe_data (* FIXME: unsafe *)
      "<button onclick=\"location.href='%s';\">%s</button>"
      uri
      contents
185

Stephane Glondu's avatar
Stephane Glondu committed
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215
  let election_view ~election ~user =
    let open Web_election in
    let params = election.election.e_params in
    let service = S.election_file params Services.ESRaw in
    lwt permissions =
      match election.election_web.can_vote with
        | Any ->
          Lwt.return [ pcdata "Anyone can vote in this election." ]
        | Restricted p ->
          match user with
            | None ->
              Lwt.return [
                pcdata "Log in to check if you can vote. Alternatively, you can try to vote and log in at the last moment.";
              ]
            | Some u ->
              lwt b = p u.user_user in
              let can = if b then pcdata "can" else pcdata "cannot" in
              Lwt.return [
                pcdata "You ";
                can;
                pcdata " vote in this election.";
              ]
    in
    let voting_period = match election.election.e_meta with
      | Some m ->
        [
          pcdata "This election starts on ";
          em [pcdata (format_date m.e_voting_starts_at)];
          pcdata " and ends on ";
          em [pcdata (format_date m.e_voting_ends_at)];
Stephane Glondu's avatar
Stephane Glondu committed
216 217
          pcdata ".";
        ]
Stephane Glondu's avatar
Stephane Glondu committed
218 219 220 221 222 223 224
      | None ->
        [
          pcdata "This election starts and ends at the administrator's discretion."
        ]
    in
    let audit_info = div [
      h3 [pcdata "Audit Info"];
225
      div [
Stephane Glondu's avatar
Stephane Glondu committed
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246
        div [
          pcdata "Election fingerprint: ";
          code [ pcdata election.election.e_fingerprint ];
        ];
        div [
          pcdata "Election data: ";
          a ~service [ pcdata "parameters" ] ();
          pcdata ", ";
          a ~service:(S.election_file params Services.ESCreds) [
            pcdata "public credentials"
          ] ();
          pcdata ", ";
          a ~service:(S.election_file params Services.ESKeys) [
            pcdata "trustee public keys"
          ] ();
          pcdata ", ";
          a ~service:(S.election_file params Services.ESBallots) [
            pcdata "ballots";
          ] ();
          pcdata ".";
        ];
247
      ]
Stephane Glondu's avatar
Stephane Glondu committed
248 249 250 251 252 253 254 255
    ] in
    let content = [
      h1 [ pcdata params.e_name ];
      p ~a:[a_style "margin: 1em; padding: 2pt; font-style: italic; border: 1pt solid;"] [
        pcdata params.e_description
      ];
      p voting_period;
      p permissions;
Stephane Glondu's avatar
Stephane Glondu committed
256
      div [
Stephane Glondu's avatar
Stephane Glondu committed
257 258 259 260 261 262 263 264 265 266 267 268 269 270
        div [
          make_button
            ~service:(Services.preapply_uuid S.election_vote params)
            "Go to the booth";
          pcdata " or ";
          make_button
            ~service:(Services.preapply_uuid S.election_cast params)
            "Submit a raw ballot";
        ];
      ];
      br ();
      audit_info;
    ] in
    base ~title:params.e_name ~content
Stephane Glondu's avatar
Stephane Glondu committed
271

Stephane Glondu's avatar
Stephane Glondu committed
272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303
  let election_cast_raw ~election =
    let open Web_election in
    let params = election.election.e_params in
    let form_rawballot = post_form ~service:S.election_cast_post
      (fun (name, _) ->
        [
          div [pcdata "Please paste your raw ballot in JSON format in the following box:"];
          div [textarea ~a:[a_rows 10; a_cols 40] ~name ()];
          div [string_input ~input_type:`Submit ~value:"Submit" ()];
        ]
      ) params.e_uuid
    in
    let form_upload = post_form ~service:S.election_cast_post
      (fun (_, name) ->
        [
          div [pcdata "Alternatively, you can also upload a file containing your ballot:"];
          div [
            pcdata "File: ";
            file_input ~name ();
          ];
          div [string_input ~input_type:`Submit ~value:"Submit" ()];
        ]
      ) params.e_uuid
    in
    let content = [
      h1 [ pcdata params.e_name ];
      h3 [ pcdata "Submit by copy/paste" ];
      form_rawballot;
      h3 [ pcdata "Submit by file" ];
      form_upload;
    ] in
    base ~title:params.e_name ~content
Stephane Glondu's avatar
Stephane Glondu committed
304

Stephane Glondu's avatar
Stephane Glondu committed
305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321
  let ballot_received ~election ~confirm ~user ~can_vote =
    let open Web_election in
    let params = election.election.e_params in
    let name = params.e_name in
    let user_div = match user with
      | Some u when can_vote ->
        let service = confirm () in
        post_form ~service (fun () -> [
          div [
            pcdata "I am ";
            format_user u;
            pcdata " and ";
            string_input ~input_type:`Submit ~value:"I confirm my vote" ();
            pcdata ".";
          ]
        ]) params.e_uuid
      | Some _ ->
Stephane Glondu's avatar
Stephane Glondu committed
322
        div [
Stephane Glondu's avatar
Stephane Glondu committed
323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376
          pcdata "You cannot vote in this election!";
        ]
      | None ->
        div [
          pcdata "Please log in to confirm your vote.";
        ]
    in
    let content = [
      h1 [ pcdata name ];
      p [
        pcdata "Your ballot for ";
        em [pcdata name];
        pcdata " has been received, but not recorded yet.";
      ];
      user_div;
      p [
        a ~service:(S.election_file params Services.ESIndex) [
          pcdata "Go back to election"
        ] ();
        pcdata ".";
      ];
    ] in
    base ~title:name ~content

  let do_cast_ballot ~election ~result =
    let params = election.Web_election.election.e_params in
    let name = params.e_name in
    let content = [
      h1 [ pcdata name ];
      p [
        pcdata "Your ballot for ";
        em [pcdata name];
        (match result with
           | `Valid hash -> pcdata (" has been accepted, its hash is " ^ hash ^ ".")
           | `Error e -> pcdata (" is rejected, because " ^ Web_common.explain_error e ^ ".")
        );
      ];
      p [
        a ~service:(S.election_file params Services.ESIndex) [
          pcdata "Go back to election"
        ] ();
        pcdata ".";
      ];
    ] in
    base ~title:name ~content

  let election_update_credential ~election =
    let params = election.Web_election.election.e_params in
    let form = post_form ~service:S.election_update_credential
      (fun (old, new_) ->
        [
          div [
            p [
              pcdata "\
377 378
This form allows you to change a single credential at a time. To get \
the hash of a credential, run the following command:";
Stephane Glondu's avatar
Stephane Glondu committed
379 380 381 382 383 384 385 386 387
            ];
            pre [
              pcdata "printf old-credential | sha256sum";
            ];
            p [
              pcdata "In the above command, ";
              code [pcdata "old-credential"];
              pcdata " should look like a big number written in base 10.";
            ];
388
          ];
Stephane Glondu's avatar
Stephane Glondu committed
389 390 391
          p [
            pcdata "Hash of the old credential: ";
            string_input ~name:old ~input_type:`Text ~a:[a_size 64] ();
392 393
          ];
          p [
Stephane Glondu's avatar
Stephane Glondu committed
394 395
            pcdata "New credential: ";
            string_input ~name:new_ ~input_type:`Text ~a:[a_size 617] ();
396
          ];
Stephane Glondu's avatar
Stephane Glondu committed
397 398 399 400 401 402 403 404 405
          p [string_input ~input_type:`Submit ~value:"Submit" ()];
        ]
      ) params.e_uuid
    in
    let content = [
      h1 [ pcdata params.e_name ];
      form;
    ] in
    base ~title:params.e_name ~content
406 407

end