Commit 83b27c28 authored by Stephane Glondu's avatar Stephane Glondu

Do no longer rely on Ocsipersist for record management

parent b4767a4d
......@@ -38,7 +38,6 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
module G = E.G
let uuid_u = underscorize uuid
let records_table = Ocsipersist.open_table ("records_" ^ uuid_u)
let cred_table = Ocsipersist.open_table ("creds_" ^ uuid_u)
let inject_cred cred =
......@@ -97,10 +96,7 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
try%lwt Ocsipersist.find cred_table credential
with Not_found -> fail InvalidCredential
and old_record =
try%lwt
let%lwt x = Ocsipersist.find records_table user in
Lwt.return (Some x)
with Not_found -> Lwt.return None
Web_persist.find_extended_record uuid user
in
match old_cred, old_record with
| None, None ->
......@@ -110,7 +106,7 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
let hash = sha256_b64 rawballot in
Ocsipersist.add cred_table credential (Some hash) >>
Web_persist.add_ballot uuid hash rawballot >>
Ocsipersist.add records_table user (date, credential) >>
Web_persist.add_extended_record uuid user (date, credential) >>
send_confirmation_email false login email hash >>
return hash
) else (
......@@ -125,7 +121,7 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
let hash = sha256_b64 rawballot in
Ocsipersist.add cred_table credential (Some hash) >>
Web_persist.add_ballot uuid hash rawballot >>
Ocsipersist.add records_table user (date, credential) >>
Web_persist.add_extended_record uuid user (date, credential) >>
send_confirmation_email true login email hash >>
return hash
) else (
......@@ -171,21 +167,12 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
) cred_table
)
let do_write_records () =
do_write ESRecords (fun oc ->
Ocsipersist.iter_step (fun u (d, _) ->
Printf.sprintf "%s %S\n" (string_of_datetime d) u |>
Lwt_io.write oc
) records_table
)
let mutex = Lwt_mutex.create ()
let cast rawballot (user, date) =
Lwt_mutex.with_lock mutex (fun () ->
let%lwt r = do_cast rawballot (user, date) in
do_write_ballots () >>
do_write_records () >>
return r
)
......@@ -198,7 +185,6 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
let update_files () =
Lwt_mutex.with_lock mutex (fun () ->
do_write_ballots () >>
do_write_records () >>
do_write_creds ()
)
......
......@@ -270,11 +270,52 @@ let compute_encrypted_tally uuid =
let%lwt () = write_file ~uuid (string_of_election_file ESETally) [tally] in
return (num_tallied, sha256_b64 tally, tally)
module ExtendedRecordsCacheTypes = struct
type key = uuid
type value = (datetime * string) StringMap.t
end
module ExtendedRecordsCache = Ocsigen_cache.Make (ExtendedRecordsCacheTypes)
let raw_get_extended_records uuid =
match%lwt read_file ~uuid "extended_records.jsons" with
| Some xs ->
let xs = List.map extended_record_of_string xs in
return (
List.fold_left (fun accu r ->
StringMap.add r.r_username (r.r_date, r.r_credential) accu
) StringMap.empty xs
)
| None -> return StringMap.empty
let dump_extended_records uuid rs =
let rs = StringMap.bindings rs in
let extended_records =
List.map (fun (r_username, (r_date, r_credential)) ->
string_of_extended_record {r_username; r_date; r_credential}
) rs
in
let records =
List.map (fun (u, (d, _)) ->
Printf.sprintf "%s %S\n" (string_of_datetime d) u
) rs
in
write_file ~uuid "extended_records.jsons" extended_records >>
write_file ~uuid (string_of_election_file ESRecords) records
let extended_records_cache =
new ExtendedRecordsCache.cache raw_get_extended_records ~timer:3600. 10
let find_extended_record uuid username =
let%lwt rs = extended_records_cache#find uuid in
return (try Some (StringMap.find username rs) with Not_found -> None)
let add_extended_record uuid username r =
let%lwt rs = extended_records_cache#find uuid in
let rs = StringMap.add username r rs in
extended_records_cache#add uuid rs;
dump_extended_records uuid rs
let has_voted uuid user =
let uuid_u = underscorize uuid in
let records_table = Ocsipersist.open_table ("records_" ^ uuid_u) in
try%lwt
let%lwt _ = Ocsipersist.find records_table (string_of_user user) in
return true
with Not_found ->
return false
let%lwt rs = extended_records_cache#find uuid in
return @@ StringMap.mem (string_of_user user) rs
......@@ -69,4 +69,7 @@ val remove_ballot : uuid -> string -> unit Lwt.t
val dump_ballots : uuid -> unit Lwt.t
val compute_encrypted_tally : uuid -> (int * string * string) Lwt.t
val find_extended_record : uuid -> string -> (datetime * string) option Lwt.t
val add_extended_record : uuid -> string -> datetime * string -> unit Lwt.t
val has_voted : uuid -> user -> bool Lwt.t
......@@ -63,6 +63,12 @@ type election_dates = {
?last_mail : datetime option;
} <ocaml field_prefix="e_">
type extended_record = {
username : string;
date : datetime;
credential : string;
} <ocaml field_prefix="r_">
(** {1 Types related to elections being prepared} *)
type draft_voter = {
......
......@@ -256,7 +256,7 @@ let delete_sensitive_data uuid =
let%lwt () = cleanup_table ~uuid_s "election_states" in
let%lwt () = cleanup_table ~uuid_s "site_tokens_decrypt" in
let%lwt () = cleanup_table ~uuid_s "election_pds" in
let%lwt () = cleanup_table ("records_" ^ uuid_u) in
let%lwt () = cleanup_file (!spool_dir / uuid_s / "extended_records.jsons") in
let%lwt () = cleanup_table ("creds_" ^ uuid_u) in
let%lwt () = rmdir (!spool_dir / uuid_s / "ballots") in
let%lwt () = cleanup_file (!spool_dir / uuid_s / "private_key.json") in
......
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