Pretty ballots for archived elections

src/web/web_persist.ml

@@ -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

src/web/web_persist.mli

@@ -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

src/web/web_site.ml

@@ -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 ->

src/web/web_templates.ml

@@ -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);