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.2 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
Stephane Glondu's avatar
Stephane Glondu committed
25 26
open Eliom_content.Html5.F

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

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

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

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

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

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

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

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

170 171 172 173 174 175 176
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
177 178 179
let format_date (date, _) =
  CalendarLib.Printer.Precise_Fcalendar.sprint "%a, %d %b %Y %T %z" date

Stephane Glondu's avatar
Stephane Glondu committed
180 181 182 183 184 185 186
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

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

273
let election_cast_raw ~election =
274
  let open Web_election in
275
  let params = election.election.e_params in
276
  let form_rawballot = post_form ~service:S.election_cast_post
Stephane Glondu's avatar
Stephane Glondu committed
277
    (fun (name, _) ->
278 279 280 281 282
      [
        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" ()];
      ]
Stephane Glondu's avatar
Stephane Glondu committed
283
    ) params.e_uuid
284
  in
285
  let form_upload = post_form ~service:S.election_cast_post
Stephane Glondu's avatar
Stephane Glondu committed
286 287 288 289 290 291 292 293 294
    (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" ()];
      ]
Stephane Glondu's avatar
Stephane Glondu committed
295
    ) params.e_uuid
Stephane Glondu's avatar
Stephane Glondu committed
296
  in
297
  let content = [
Stephane Glondu's avatar
Stephane Glondu committed
298
    h1 [ pcdata params.e_name ];
Stephane Glondu's avatar
Stephane Glondu committed
299 300 301 302
    h3 [ pcdata "Submit by copy/paste" ];
    form_rawballot;
    h3 [ pcdata "Submit by file" ];
    form_upload;
303
  ] in
Stephane Glondu's avatar
Stephane Glondu committed
304
  base ~title:params.e_name ~content
305

306
let ballot_received ~election ~confirm ~user ~can_vote =
307
  let open Web_election in
308 309
  let params = election.election.e_params in
  let name = params.e_name in
Stephane Glondu's avatar
Stephane Glondu committed
310
  let user_div = match user with
311
    | Some u when can_vote ->
Stephane Glondu's avatar
Stephane Glondu committed
312 313 314 315 316 317 318 319 320
      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 ".";
        ]
321
      ]) params.e_uuid
322 323 324 325
    | Some _ ->
      div [
        pcdata "You cannot vote in this election!";
      ]
Stephane Glondu's avatar
Stephane Glondu committed
326 327 328 329 330
    | None ->
      div [
        pcdata "Please log in to confirm your vote.";
      ]
  in
Stephane Glondu's avatar
Stephane Glondu committed
331 332
  let content = [
    h1 [ pcdata name ];
Stephane Glondu's avatar
Stephane Glondu committed
333 334 335 336 337 338
    p [
      pcdata "Your ballot for ";
      em [pcdata name];
      pcdata " has been received, but not recorded yet.";
    ];
    user_div;
339
    p [
340
      a ~service:(S.election_file params Services.ESIndex) [
341 342 343 344
        pcdata "Go back to election"
      ] ();
      pcdata ".";
    ];
Stephane Glondu's avatar
Stephane Glondu committed
345 346 347 348
  ] in
  base ~title:name ~content

let do_cast_ballot ~election ~result =
349
  let params = election.Web_election.election.e_params in
350
  let name = params.e_name in
Stephane Glondu's avatar
Stephane Glondu committed
351 352 353
  let content = [
    h1 [ pcdata name ];
    p [
Stephane Glondu's avatar
Stephane Glondu committed
354
      pcdata "Your ballot for ";
Stephane Glondu's avatar
Stephane Glondu committed
355
      em [pcdata name];
Stephane Glondu's avatar
Stephane Glondu committed
356
      (match result with
Stephane Glondu's avatar
Stephane Glondu committed
357
         | `Valid hash -> pcdata (" has been accepted, its hash is " ^ hash ^ ".")
358
         | `Error e -> pcdata (" is rejected, because " ^ Web_common.explain_error e ^ ".")
Stephane Glondu's avatar
Stephane Glondu committed
359
      );
Stephane Glondu's avatar
Stephane Glondu committed
360
    ];
361
    p [
362
      a ~service:(S.election_file params Services.ESIndex) [
Stephane Glondu's avatar
Stephane Glondu committed
363 364 365 366
        pcdata "Go back to election"
      ] ();
      pcdata ".";
    ];
Stephane Glondu's avatar
Stephane Glondu committed
367 368
  ] in
  base ~title:name ~content
Stephane Glondu's avatar
Stephane Glondu committed
369 370

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

end