Commit 7db23601 authored by Stephane Glondu's avatar Stephane Glondu

Pretty ballots for archived elections

parent 9f29982e
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Lwt
open Platform
open Serializable_j
open Common
open Web_serializable_j
......@@ -133,3 +134,46 @@ let get_passwords uuid =
| _ -> accu
) SMap.empty csv in
return @@ Some res
module Ballots = Map.Make (String)
module BallotsCacheTypes = struct
type key = string
type value = string Ballots.t
end
module BallotsCache = Ocsigen_cache.Make (BallotsCacheTypes)
let raw_get_ballots_archived uuid =
try_lwt
let ballots = Lwt_io.lines_of_file (!spool_dir / uuid / "ballots.jsons") in
Lwt_stream.fold (fun b accu ->
let hash = sha256_b64 b in
Ballots.add hash b accu
) ballots Ballots.empty
with _ -> return Ballots.empty
let archived_ballots_cache =
new BallotsCache.cache raw_get_ballots_archived 10
let get_ballot_hashes ~uuid =
match_lwt get_election_state uuid with
| `Archived ->
lwt ballots = archived_ballots_cache#find uuid in
Ballots.bindings ballots |> List.map fst |> return
| _ ->
let table = Ocsipersist.open_table ("ballots_" ^ underscorize uuid) in
Ocsipersist.fold_step (fun hash _ accu ->
return (hash :: accu)
) table [] >>= (fun x -> return @@ List.rev x)
let get_ballot_by_hash ~uuid ~hash =
match_lwt get_election_state uuid with
| `Archived ->
lwt ballots = archived_ballots_cache#find uuid in
(try Some (Ballots.find hash ballots) with Not_found -> None) |> return
| _ ->
let table = Ocsipersist.open_table ("ballots_" ^ underscorize uuid) in
try_lwt Ocsipersist.find table hash >>= (fun x -> return @@ Some x)
with Not_found -> return_none
......@@ -50,3 +50,6 @@ val get_elections_by_owner : user -> string list Lwt.t
val get_voters : string -> string list option Lwt.t
val get_passwords : string -> (string * string) SMap.t option Lwt.t
val get_ballot_hashes : uuid:string -> string list Lwt.t
val get_ballot_by_hash : uuid:string -> hash:string -> string option Lwt.t
......@@ -1241,26 +1241,16 @@ let () =
(fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
lwt w = find_election uuid_s in
let module W = Web_election.Make ((val w)) (LwtRandom) in
let module B = W.B in
let module W = W.D in
lwt ballots = B.Ballots.fold (fun h _ accu -> return (h :: accu)) [] in
lwt ballots = Web_persist.get_ballot_hashes uuid_s in
lwt result = Web_persist.get_election_result uuid_s in
T.pretty_ballots (module W) ballots result () >>= Html5.send)
T.pretty_ballots w ballots result () >>= Html5.send)
let () =
Any.register
~service:election_pretty_ballot
(fun ((uuid, ()), hash) () ->
let uuid_s = Uuidm.to_string uuid in
lwt w = find_election uuid_s in
let module W = Web_election.Make ((val w)) (LwtRandom) in
lwt ballot =
W.B.Ballots.fold
(fun h b accu ->
if h = hash then return (Some b) else return accu
) None
in
lwt ballot = Web_persist.get_ballot_by_hash ~uuid:uuid_s ~hash in
match ballot with
| None -> fail_http 404
| Some b ->
......
......@@ -1452,15 +1452,6 @@ let pretty_ballots w hashes result () =
(params.e_uuid, ())]
in
let number = match !nballots, result with
| 0, Some r ->
div [
pcdata (string_of_int r.num_tallied);
pcdata " ballot(s) have been accepted.";
pcdata " Ballot details are no longer available for this election,";
pcdata " but you can still download the whole ";
a ~service:(file w ESBallots) [pcdata "ballot list"] ();
pcdata ".";
]
| n, None ->
div [
pcdata (string_of_int n);
......
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