helios_templates.ml 11.3 KB
Newer Older
1
open StdExtra
2
open Helios_datatypes_t
Stephane Glondu's avatar
Stephane Glondu committed
3
4
5
6
open Eliom_content.Html5.F

let site_title = "Helios Election Server"
let welcome_message = "This is the default message"
Stephane Glondu's avatar
Stephane Glondu committed
7

8
9
let s x = Xml.uri_of_string ("/static/" ^ x)

Stephane Glondu's avatar
Stephane Glondu committed
10
11
12
13
14
15
16
17
18
let format_user u size = Helios_services.([
  img
    ~src:(Printf.ksprintf s "auth/login-icons/%s.png" u.user_type)
    ~a:[a_style "border:0;"; a_height size]
    ~alt:u.user_type ();
  pcdata " ";
  pcdata u.user_name;
])

Stephane Glondu's avatar
Stephane Glondu committed
19
let base ~title ~header ~content =
Stephane Glondu's avatar
Stephane Glondu committed
20
21
  lwt user = Eliom_reference.get Helios_services.user in
  Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
Stephane Glondu's avatar
Stephane Glondu committed
22
    (head (Eliom_content.Html5.F.title (pcdata (title ^ " - Helios"))) [
Stephane Glondu's avatar
Stephane Glondu committed
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
      link
        ~rel:[`Stylesheet]
        ~href:(s "main.css")
        ~a:[a_mime_type "text/css"; a_media [`Screen]]
        ();
      link
        ~rel:[`Stylesheet]
        ~href:(s "helios/css/ui-lightness/jquery-ui-1.8.1.custom.css")
        ~a:[a_mime_type "text/css"]
        ();
      script (pcdata "") ~a:[a_src (s "helios/js/jquery-1.4.2.min.js")];
      script (pcdata "") ~a:[a_src (s "helios/js/jquery-ui-1.8.1.custom.min.js")];
      script (pcdata "") ~a:[a_src (s "helios/js/jqsplitdatetime.js")];
      script (pcdata "") ~a:[a_src (s "helios/helios/jquery.json.min.js")];
      (* block js *)
      (* block extra-head *)
    ])
    (body [
      div ~a:[a_id "content"] [
        div ~a:[a_id "header"] ([
Stephane Glondu's avatar
Stephane Glondu committed
43
44
45
46
47
48
          a ~service:Helios_services.home [
            img
              ~src:(s "logo.gif")
              ~a:[a_style "border:0;"; a_height 110]
              ~alt:"Helios" ()
          ] ();
Stephane Glondu's avatar
Stephane Glondu committed
49
50
51
          br ();
        ] @ header);
        div ~a:[a_id "contentbody"] content;
Stephane Glondu's avatar
Stephane Glondu committed
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
        div ~a:[a_id "footer"] (
          [span ~a:[a_style "float:right;"] [ (* footer logo *) ]] @
          (match user with
            | Some (admin_p, user) ->
              [pcdata "logged in as "] @ (format_user user 15) @ [
                pcdata " [";
                a ~service:Helios_services.logout [pcdata "logout"] ();
                pcdata "]";
                br ()
              ]
            | None ->
              [pcdata "not logged in."] @ [
                pcdata " [";
                a ~service:Helios_services.login [pcdata "log in"] ();
                pcdata "]";
                br ();
              ]
          ) @ [
            a ~service:Helios_services.project_home [
Stephane Glondu's avatar
Stephane Glondu committed
71
              pcdata "About Helios"
Stephane Glondu's avatar
Stephane Glondu committed
72
            ] ();
Stephane Glondu's avatar
Stephane Glondu committed
73
            pcdata " | Help!";
Stephane Glondu's avatar
Stephane Glondu committed
74
          (* footer links *)
Stephane Glondu's avatar
Stephane Glondu committed
75
76
77
            br ~a:[a_style "clear:right;"] ();
          ]
        )
Stephane Glondu's avatar
Stephane Glondu committed
78
      ];
Stephane Glondu's avatar
Stephane Glondu committed
79
     ]))
Stephane Glondu's avatar
Stephane Glondu committed
80

81
82
83
84
85
let not_implemented title = base
  ~title
  ~header:[h2 [pcdata title]]
  ~content:[div [pcdata "This service is not implemented."]]

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
let login_box auth_systems = List.map
  (fun x ->
    p [
      a
        ~service:Helios_services.login
        ~a:[a_style "font-size: 1.4em;"] [
          img
            ~a:[a_style "border:0;"; a_height 35]
            ~src:(Printf.ksprintf s "auth/login-icons/%s.png" x)
            ~alt:x ();
          pcdata x;
        ] ();
    ]
  ) auth_systems

Stephane Glondu's avatar
Stephane Glondu committed
101
102
103
104
105
106
107
108
109
110
111
type answer = {
  count : int;
  answer : string;
  winner : bool;
}

type question = {
  answers : answer list;
  question : string;
}

112
type election_extradata = {
Stephane Glondu's avatar
Stephane Glondu committed
113
  xelection : Helios_services.election_data;
114
  election : Z.t Helios_datatypes_t.election;
Stephane Glondu's avatar
Stephane Glondu committed
115
  (* FIXME: datatypes should be revisited, election is xelection.election! *)
Stephane Glondu's avatar
Stephane Glondu committed
116
  election_admin : Helios_services.user;
Stephane Glondu's avatar
Stephane Glondu committed
117
118
  election_trustees : string list;
  election_state : [`Finished of question list | `Stopped | `Started];
119
}
120

121
let format_one_election e =
122
  li [pcdata e.election.e_name]
123

124
let format_one_featured_election e =
125
  [
126
127
128
129
    div ~a:[a_class ["highlight-box-margin"]] ([
      a
        ~service:(Eliom_service.preapply
                    Helios_services.election_shortcut
130
                    e.election.e_short_name)
131
        ~a:[a_style "font-size: 1.4em;"]
132
        [pcdata e.election.e_name] ();
133
      pcdata " by ";
134
    ] @ format_user e.election_admin 15 @ [
135
      br ();
136
      pcdata e.election.e_description;
137
138
    ]);
    br ();
139
140
  ]

Stephane Glondu's avatar
Stephane Glondu committed
141
142
143
let index ~featured =
  lwt user = Eliom_reference.get Helios_services.user in
  base
Stephane Glondu's avatar
Stephane Glondu committed
144
145
146
  ~title:site_title
  ~header:[h2 [pcdata site_title]]
  ~content:(
Stephane Glondu's avatar
Stephane Glondu committed
147
148
149
150
    let mystuff = match user with
      | Some (admin_p, u) ->
        let administered = if admin_p then Some [] else None in
        let voted = [] in
Stephane Glondu's avatar
Stephane Glondu committed
151
152
153
        let administration_box = match administered with
          | Some admin ->
            let administered_box = match admin with
154
              | _::_ -> ul (List.map format_one_election admin)
Stephane Glondu's avatar
Stephane Glondu committed
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
              | [] -> em [pcdata "none yet"]
            in [
              h4 [pcdata "Administration"];
              administered_box;
              p [pcdata "[";
                 a ~service:Helios_services.elections_administered [
                   pcdata "see all"
                 ] ();
                 pcdata "]"];
              div ~a:[a_style "text-align:right;"] [
                a ~service:Helios_services.election_new
                  ~a:[a_style "font-size: 1.2em; padding:5px; background: #eee; border: 1px solid #888;"]
                  [
                    pcdata "create election >";
                  ] ();
              ]
            ]
          | None -> []
        in
        let recent_votes = [
          h4 [pcdata "Recent votes"];
          match voted with
177
          | _::_ -> ul (List.map format_one_election voted)
Stephane Glondu's avatar
Stephane Glondu committed
178
179
          | [] -> em [pcdata "none yet"]
        ] in
180
        [
181
182
          div ~a:[a_style "font-size:1.4em;"; a_class ["highlight-box"]]
            (format_user u 25)
183
        ]
Stephane Glondu's avatar
Stephane Glondu committed
184
        @ administration_box @ recent_votes
Stephane Glondu's avatar
Stephane Glondu committed
185
      | None ->
Stephane Glondu's avatar
Stephane Glondu committed
186
        [h3 [pcdata "Log In to Start Voting"]]
Stephane Glondu's avatar
Stephane Glondu committed
187
        @ (login_box Helios_services.auth_systems)
Stephane Glondu's avatar
Stephane Glondu committed
188
189
190
191
192
        @ [br (); br ()]
    in
    let featured_box = match featured with
      | _::_ ->
        [
193
          h3 [pcdata "Current Featured Elections"];
194
          div (List.flatten (List.map format_one_featured_election featured));
Stephane Glondu's avatar
Stephane Glondu committed
195
196
197
198
199
        ]
      | [] ->
        [
          h4 [pcdata "no featured elections at the moment"];
        ]
200
    in ([
Stephane Glondu's avatar
Stephane Glondu committed
201
      div ~a:[a_id "mystuff"] mystuff;
Stephane Glondu's avatar
Stephane Glondu committed
202
      p ~a:[a_style "font-size: 1.4em;"] [pcdata welcome_message];
203
    ] @ featured_box @ [
Stephane Glondu's avatar
Stephane Glondu committed
204
205
      br ~a:[a_style "clear:right;"] ();
      br ()
206
    ])
Stephane Glondu's avatar
Stephane Glondu committed
207
  )
Stephane Glondu's avatar
Stephane Glondu committed
208

Stephane Glondu's avatar
Stephane Glondu committed
209
let dummy_login ~service =
Stephane Glondu's avatar
Stephane Glondu committed
210
211
212
  let title = site_title ^ " — Login" in
  let form = post_form
    ~a:[a_id "login_form"; a_class ["prettyform"]]
Stephane Glondu's avatar
Stephane Glondu committed
213
    ~service
Stephane Glondu's avatar
Stephane Glondu committed
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    (fun (username_name, admin_name) ->
      [
        tablex [tbody [
          tr [
            th [label ~a:[a_for username_name] [pcdata "Username:"]];
            td [string_input ~a:[a_maxlength 50] ~input_type:`Text ~name:username_name ()];
          ];
          tr [
            th [label ~a:[a_for admin_name] [pcdata "Admin?"]];
            td [bool_checkbox ~name:admin_name ()];
          ]]
        ];
        div [
          string_input ~input_type:`Submit ~value:"Login" ();
        ]
      ]) ()
  in
  base
    ~title
    ~header:[h2 [pcdata title]]
    ~content:[div [form]]
Stephane Glondu's avatar
Stephane Glondu committed
235
236

let election_view ~election =
237
238
  let service = Eliom_service.preapply Helios_services.election_raw election.election.e_uuid in
  let booth = Helios_services.make_booth election.election.e_uuid in
Stephane Glondu's avatar
Stephane Glondu committed
239
240
241
242
243
244
245
246
247
  let audit_info = [
    (* FIXME: unsafe_data *)
    unsafe_data "<a href=\"#\" onclick=\"$('#auditbody').slideToggle(250);\">Audit Info</a>";
    div ~a:[
      a_id "auditbody";
      a_style "display:none;";
    ] [
      br ();
      pcdata "Election URL:";
248
249
      br ();
      code ~a:[a_style "font-size: 1.2em;"] [
Stephane Glondu's avatar
Stephane Glondu committed
250
251
252
        a ~service [ pcdata (make_string_uri ~absolute:true ~service ()) ] ()
      ];
      br ();
253
      br ();
Stephane Glondu's avatar
Stephane Glondu committed
254
      pcdata "Election Fingerprint:";
255
256
      br ();
      code ~a:[a_style "font-size: 1.3em; font-weight: bold;"] [
Stephane Glondu's avatar
Stephane Glondu committed
257
258
        pcdata election.xelection.Helios_services.fingerprint;
      ];
259
260
      br ();
      br ();
Stephane Glondu's avatar
Stephane Glondu committed
261
262
263
      (* FIXME: Ballot Tracking Center *)
      (* FIXME: Audited Ballots *)
      (* FIXME: result *)
264
265
266
267
268
      p ~a:[a_style "font-size: 1.2em;"] [
        pcdata "Review the ";
        a ~service:booth [ pcdata "voting booth" ] ();
        pcdata ".";
      ];
Stephane Glondu's avatar
Stephane Glondu committed
269
270
    ]
  ] in
Stephane Glondu's avatar
Stephane Glondu committed
271
272
273
274
275
  let content = [
    div ~a:[a_style "float: left; margin-right: 50px;"] [pcdata "FIXME"];
    br ();
    br ();
    br ~a:[a_style "clear: left;"] ();
276
    div ~a:[a_style "margin-bottom: 25px;margin-left: 15px; border-left: 1px solid #aaa; padding-left: 5px; font-size:1.3em;"] [pcdata election.election.e_description];
Stephane Glondu's avatar
Stephane Glondu committed
277
    p ~a:[a_style "text-align: center; font-size: 1.5em;"] [
278
      a ~service:(Eliom_service.preapply Helios_services.election_questions election.election.e_uuid) [
Stephane Glondu's avatar
Stephane Glondu committed
279
        pcdata "questions (";
280
        pcdata (string_of_int (Array.length election.election.e_questions));
Stephane Glondu's avatar
Stephane Glondu committed
281
282
283
284
        pcdata ")";
      ] ();
      (* FIXME: space (&nbsp) breaks the output *)
      pcdata "  |  ";
285
      a ~service:(Eliom_service.preapply Helios_services.election_voters election.election.e_uuid) [
Stephane Glondu's avatar
Stephane Glondu committed
286
287
288
        pcdata "voters & ballots"
      ] ();
      pcdata "  |  ";
289
      a ~service:(Eliom_service.preapply Helios_services.election_trustees election.election.e_uuid) [
Stephane Glondu's avatar
Stephane Glondu committed
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
        pcdata "trustees (";
        pcdata (string_of_int (List.length election.election_trustees));
        pcdata ")";
      ] ();
    ];
    (* NOTE: administration things removed from here! *)
    br ();
    br ();
  ] @ (match election.election_state with
    | `Finished result ->
      [
        span ~a:[a_class ["highlight-box"; "round"]] [
          pcdata "This election is complete.";
        ];
        br ();
        br ();
        h3 ~a:[a_class ["highlight-box"]] [pcdata "Tally"];
      ] @ (
308
        List.iteri (fun i question ->
Stephane Glondu's avatar
Stephane Glondu committed
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
          [
            b [
              span ~a:[a_style "font-size:0.8em;"] [
                pcdata "Question #";
                pcdata (string_of_int i);
              ];
              br ();
              pcdata question.question;
            ];
            br ();
            let table xs = match xs with
              | x :: xs -> table ~a:[a_class ["pretty"]; a_style "width: auto;"] x xs
              | [] -> assert false
            in table (
              List.map (fun answer ->
                let style = if answer.winner then "font-weight:bold;" else "" in
                tr [
                  td ~a:[a_style ("padding-right:80px;" ^ style)] [pcdata answer.answer];
                  td ~a:[a_style ("text-align:right;" ^ style)] [pcdata (string_of_int answer.count)];
                ]
              ) question.answers
            );
          ]
        ) result
      )
    | `Stopped ->
      [
Stephane Glondu's avatar
Stephane Glondu committed
336
337
338
339
        span ~a:[a_class ["highlight-box"; "round"]] [
          pcdata "Election closed. Tally will be computed soon.";
        ];
        br ();
Stephane Glondu's avatar
Stephane Glondu committed
340
341
342
      ]
    | `Started ->
      [
Stephane Glondu's avatar
Stephane Glondu committed
343
344
345
346
347
348
349
350
351
352
        span ~a:[
          a_class ["highlight-box"; "round"];
          a_style "font-size: 1.6em; margin-right: 10px;";
          a_id "votelink";
        ] [
          a ~service:(Eliom_service.preapply Helios_services.election_vote election.election.e_uuid) [
            pcdata "Vote in this election";
          ] ()
        ];
        br ();
Stephane Glondu's avatar
Stephane Glondu committed
353
        br ();
Stephane Glondu's avatar
Stephane Glondu committed
354
355
356
        (* if election.voting_extended_until ... *)
        pcdata "This election ends at the administrator's discretion.";
        br ();
Stephane Glondu's avatar
Stephane Glondu committed
357
      ]
Stephane Glondu's avatar
Stephane Glondu committed
358
359
360
361
362
363
364
  ) @ [
    (* FIXME: privacity, eligibility, etc. *)
    div ~a:[
      a_style "background: lightyellow; padding:5px; padding-left: 10px; margin-top: 15px; border: 1px solid #aaa; width: 720px;";
      a_class ["round"];
    ] audit_info
  ] in
365
  base ~title:election.election.e_name ~header:[] ~content