Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit 40915600 authored by Stephane Glondu's avatar Stephane Glondu

Pretty page for records

parent 39674d25
......@@ -81,6 +81,7 @@ let election_cast_post = post_service ~fallback:election_cast ~post_params:(opt
let election_cast_confirm = post_coservice ~csrf_safe:true ~fallback:election_cast ~post_params:unit ()
let election_pretty_ballots = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "ballots")) ()
let election_pretty_ballot = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "ballot") (string "hash")) ()
let election_pretty_records = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "pretty-records")) ()
let election_missing_voters = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "missing")) ()
......
......@@ -1243,6 +1243,30 @@ let () =
) voters;
String.send (Buffer.contents buf, "text/plain"))
let () =
let rex = Pcre.regexp "\"(.*)\\..*\" \".*:(.*)\"" in
Any.register ~service:election_pretty_records
(fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
lwt w = find_election uuid_s in
let module W = (val w) in
lwt () =
match_lwt Web_auth_state.get_site_user () with
| Some u when W.metadata.e_owner = Some u -> return_unit
| _ -> forbidden ()
in
let records = Lwt_io.lines_of_file
(W.dir / string_of_election_file ESRecords)
in
lwt records = Lwt_stream.fold (fun r accu ->
let s = Pcre.exec ~rex r in
let date = Pcre.get_substring s 1 in
let voter = Pcre.get_substring s 2 in
(date, voter) :: accu
) records [] in
T.pretty_records w (List.rev records) () >>= Html5.send
)
let () =
Any.register
~service:election_tally_trustees
......
......@@ -1146,7 +1146,7 @@ let election_admin w state () =
a ~service:election_dir [pcdata "Voter list"] (uuid, ESVoters);
];
div [
a ~service:election_dir [pcdata "Voting records"] (uuid, ESRecords);
a ~service:election_pretty_records [pcdata "Voting records"] (uuid, ());
];
div [
a ~service:election_missing_voters [pcdata "Missing voters"] (uuid, ());
......@@ -1444,6 +1444,33 @@ let pretty_ballots w hashes result () =
let uuid = params.e_uuid in
base ~title ~login_box ~content ~uuid ()
let pretty_records w records () =
let module W = (val w : WEB_ELECTION_DATA) in
let uuid = W.election.e_params.e_uuid in
let title = W.election.e_params.e_name ^ " — Records" in
let records = List.map (fun (date, voter) ->
tr [td [pcdata date]; td [pcdata voter]]
) records in
let table = match records with
| [] -> div [pcdata "Nobody voted!"]
| _ ->
div [
table
(tr [th [pcdata "Date/Time (UTC)"]; th [pcdata "Username"]]
:: records);
]
in
let content = [
div [
pcdata "You can also access the ";
a ~service:election_dir [pcdata "raw data"] (uuid, ESRecords);
pcdata ".";
];
table;
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let tally_trustees w trustee_id () =
let module W = (val w : WEB_ELECTION_DATA) in
let params = W.election.e_params in
......
......@@ -47,6 +47,7 @@ val cast_raw : (module WEB_ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Ht
val cast_confirmation : (module WEB_ELECTION_DATA) -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmed : (module WEB_ELECTION_DATA) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_ballots : (module WEB_ELECTION_DATA) -> string list -> Yojson.Safe.json result option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_records : (module WEB_ELECTION_DATA) -> (string * string) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val tally_trustees : (module WEB_ELECTION_DATA) -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment