Commit 02259d1f authored by Stephane Glondu's avatar Stephane Glondu
Browse files

BALLOT_BOX: remove records, add receipts

A record (i.e. who voted, when and with which credential in the
context of the web server) is a notion that does not exist in the
cryptographic protocol and does not really make sense in the context
of the command-line tool.

By the way, we add the notion of receipt which, in the context of the
web server, is the ballot hash computed by the server.

Bonus: when a ballot is accepted, we compute its hash only once.
parent 3ac7a8c9
...@@ -209,7 +209,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct ...@@ -209,7 +209,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
let vote (b, hash) = let vote (b, hash) =
if check_signature_present b && E.check_ballot e b if check_signature_present b && E.check_ballot e b
then M.cast b "anonymous" () then M.cast b ()
else Printf.ksprintf failwith "ballot %s failed tests" hash else Printf.ksprintf failwith "ballot %s failed tests" hash
let () = ballots |> option_map (List.iter vote) |> ignore let () = ballots |> option_map (List.iter vote) |> ignore
...@@ -218,7 +218,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct ...@@ -218,7 +218,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
match ballots with match ballots with
| None -> failwith "ballots.jsons is missing" | None -> failwith "ballots.jsons is missing"
| Some _ -> | Some _ ->
M.fold_ballots (fun b t -> M.fold_ballots (fun () b t ->
M.return (E.combine_ciphertexts (E.extract_ciphertext b) t) M.return (E.combine_ciphertexts (E.extract_ciphertext b) t)
) (E.neutral_ciphertext e) () ) (E.neutral_ciphertext e) ()
) )
......
...@@ -99,7 +99,6 @@ let prng = lazy (Cryptokit.Random.(pseudo_rng (string secure_rng 16))) ...@@ -99,7 +99,6 @@ let prng = lazy (Cryptokit.Random.(pseudo_rng (string secure_rng 16)))
module MakeSimpleMonad (G : GROUP) = struct module MakeSimpleMonad (G : GROUP) = struct
type 'a t = unit -> 'a type 'a t = unit -> 'a
let ballots = ref [] let ballots = ref []
let records = ref []
let return x () = x let return x () = x
let bind x f = f (x ()) let bind x f = f (x ())
let fail e = raise e let fail e = raise e
...@@ -111,10 +110,8 @@ module MakeSimpleMonad (G : GROUP) = struct ...@@ -111,10 +110,8 @@ module MakeSimpleMonad (G : GROUP) = struct
Z.(of_bits r mod q) Z.(of_bits r mod q)
type ballot = G.t Serializable_t.ballot type ballot = G.t Serializable_t.ballot
type record = string let cast x () = ballots := x :: !ballots
let cast x r () = ballots := x :: !ballots; records := r :: !records let fold_ballots f x () = List.fold_left (fun accu b -> f () b accu ()) x !ballots
let fold_ballots f x () = List.fold_left (fun accu b -> f b accu ()) x !ballots
let fold_records f x () = List.fold_left (fun accu b -> f b accu ()) x !records
let turnout () = List.length !ballots let turnout () = List.length !ballots
end end
......
...@@ -60,7 +60,9 @@ module MakeSimpleMonad (G : GROUP) : sig ...@@ -60,7 +60,9 @@ module MakeSimpleMonad (G : GROUP) : sig
include Signatures.BALLOT_BOX include Signatures.BALLOT_BOX
with type 'a m := 'a t with type 'a m := 'a t
and type ballot = G.t Serializable_t.ballot and type ballot = G.t Serializable_t.ballot
and type record = string and type receipt := unit
val cast : ballot -> unit t
end end
(** Simple election monad that keeps all ballots in memory. *) (** Simple election monad that keeps all ballots in memory. *)
......
...@@ -97,18 +97,13 @@ module type BALLOT_BOX = sig ...@@ -97,18 +97,13 @@ module type BALLOT_BOX = sig
(** The type of ballots. The monad is supposed to keep track of all (** The type of ballots. The monad is supposed to keep track of all
cast ballots (e.g. in a database). *) cast ballots (e.g. in a database). *)
type record type receipt
(** The type of log records. *) (** The type of receipts. This is something the voter gets after
casting a ballot to check his vote later. *)
val cast : ballot -> record -> unit m val fold_ballots : (receipt -> ballot -> 'a -> 'a m) -> 'a -> 'a m
(** Cast a ballot. *) (** [fold_ballots f a] computes [(f rN bN ... (f r2 b2 (f r1 b1 a))...)],
where [r1,b1 ... rN,bN] are all cast ballots. *)
val fold_ballots : (ballot -> 'a -> 'a m) -> 'a -> 'a m
(** [fold_ballots f a] computes [(f bN ... (f b2 (f b1 a))...)],
where [b1 ... bN] are all cast ballots. *)
val fold_records : (record -> 'a -> 'a m) -> 'a -> 'a m
(** Same as [fold_ballots] for records. *)
val turnout : int m val turnout : int m
(** Number of cast ballots. *) (** Number of cast ballots. *)
......
...@@ -539,7 +539,7 @@ let f_ballots uuid election user () = ...@@ -539,7 +539,7 @@ let f_ballots uuid election user () =
let open Web_common in let open Web_common in
let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
(* TODO: streaming *) (* TODO: streaming *)
lwt ballots = X.B.fold_ballots (fun x xs -> lwt ballots = X.B.Ballots.fold_ballots (fun _ x xs ->
return ((x^"\n")::xs) return ((x^"\n")::xs)
) [] in ) [] in
let s = List.map (fun b () -> let s = List.map (fun b () ->
...@@ -552,7 +552,7 @@ let f_records uuid election user () = ...@@ -552,7 +552,7 @@ let f_records uuid election user () =
let open Web_common in let open Web_common in
let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
(* TODO: streaming *) (* TODO: streaming *)
lwt ballots = X.B.fold_records (fun (u, d) xs -> lwt ballots = X.B.Records.fold_ballots (fun u (d, _) xs ->
let x = Printf.sprintf "%s %S\n" let x = Printf.sprintf "%s %S\n"
(Serializable_builtin_j.string_of_datetime d) u (Serializable_builtin_j.string_of_datetime d) u
in return (x::xs) in return (x::xs)
...@@ -643,8 +643,8 @@ let do_cast election uuid () = ...@@ -643,8 +643,8 @@ let do_cast election uuid () =
in in
lwt result = lwt result =
try_lwt try_lwt
X.B.cast ballot record >> lwt hash = X.B.cast ballot record in
return (`Valid (sha256_b64 ballot)) return (`Valid hash)
with Error e -> return (`Error e) with Error e -> return (`Error e)
in in
Eliom_reference.unset Services.ballot >> Eliom_reference.unset Services.ballot >>
......
...@@ -158,11 +158,16 @@ let security_log s = ...@@ -158,11 +158,16 @@ let security_log s =
) ic ) ic
module type WEB_BALLOT_BOX = sig module type WEB_BALLOT_BOX = sig
include Signatures.BALLOT_BOX module Ballots : Signatures.BALLOT_BOX
with type 'a m = 'a Lwt.t with type 'a m = 'a Lwt.t
and type ballot = string and type ballot = string
and type record = string * datetime and type receipt = string
module Records : Signatures.BALLOT_BOX
with type 'a m = 'a Lwt.t
and type ballot = Serializable_builtin_t.datetime * string
and type receipt = string
val cast : string -> string * datetime -> string Lwt.t
val inject_creds : SSet.t -> unit Lwt.t val inject_creds : SSet.t -> unit Lwt.t
val extract_creds : unit -> SSet.t Lwt.t val extract_creds : unit -> SSet.t Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t val update_cred : old:string -> new_:string -> unit Lwt.t
...@@ -202,19 +207,30 @@ let make_web_election raw_election e_meta election_web = ...@@ -202,19 +207,30 @@ let make_web_election raw_election e_meta election_web =
module B : WEB_BALLOT_BOX = struct module B : WEB_BALLOT_BOX = struct
type 'a m = 'a Lwt.t
let suffix = "_" ^ String.map (function let suffix = "_" ^ String.map (function
| '-' -> '_' | '-' -> '_'
| c -> c | c -> c
) (Uuidm.to_string e_params.e_uuid) ) (Uuidm.to_string e_params.e_uuid)
let ballot_table = Ocsipersist.open_table ("ballots" ^ suffix) module Ballots = struct
let record_table = Ocsipersist.open_table ("records" ^ suffix) type 'a m = 'a Lwt.t
let cred_table = Ocsipersist.open_table ("creds" ^ suffix)
type ballot = string type ballot = string
type record = string * Serializable_builtin_t.datetime type receipt = string
let table = Ocsipersist.open_table ("ballots" ^ suffix)
let turnout = Ocsipersist.length table
let fold_ballots f x = Ocsipersist.fold_step f table x
end
module Records = struct
type 'a m = 'a Lwt.t
type ballot = Serializable_builtin_t.datetime * string
type receipt = string
let table = Ocsipersist.open_table ("records" ^ suffix)
let turnout = Ocsipersist.length table
let fold_ballots f x = Ocsipersist.fold_step f table x
end
let cred_table = Ocsipersist.open_table ("creds" ^ suffix)
let extract_creds () = let extract_creds () =
Ocsipersist.fold_step (fun k v x -> Ocsipersist.fold_step (fun k v x ->
...@@ -268,7 +284,7 @@ let make_web_election raw_election e_meta election_web = ...@@ -268,7 +284,7 @@ let make_web_election raw_election e_meta election_web =
with Not_found -> fail InvalidCredential with Not_found -> fail InvalidCredential
and old_record = and old_record =
try_lwt try_lwt
lwt x = Ocsipersist.find record_table user in lwt x = Ocsipersist.find Records.table user in
Lwt.return (Some x) Lwt.return (Some x)
with Not_found -> Lwt.return None with Not_found -> Lwt.return None
in in
...@@ -278,11 +294,11 @@ let make_web_election raw_election e_meta election_web = ...@@ -278,11 +294,11 @@ let make_web_election raw_election e_meta election_web =
if E.check_ballot election ballot then ( if E.check_ballot election ballot then (
let hash = sha256_b64 rawballot in let hash = sha256_b64 rawballot in
Ocsipersist.add cred_table credential (Some hash) >> Ocsipersist.add cred_table credential (Some hash) >>
Ocsipersist.add ballot_table hash rawballot >> Ocsipersist.add Ballots.table hash rawballot >>
Ocsipersist.add record_table user (date, credential) >> Ocsipersist.add Records.table user (date, credential) >>
security_log (fun () -> security_log (fun () ->
Printf.sprintf "%s successfully cast ballot %s" user hash Printf.sprintf "%s successfully cast ballot %s" user hash
) ) >> return hash
) else ( ) else (
fail ProofCheck fail ProofCheck
) )
...@@ -290,18 +306,18 @@ let make_web_election raw_election e_meta election_web = ...@@ -290,18 +306,18 @@ let make_web_election raw_election e_meta election_web =
(* revote *) (* revote *)
if credential = old_credential then ( if credential = old_credential then (
if E.check_ballot election ballot then ( if E.check_ballot election ballot then (
lwt old_ballot = Ocsipersist.find ballot_table h in lwt old_ballot = Ocsipersist.find Ballots.table h in
Ocsipersist.remove ballot_table h >> Ocsipersist.remove Ballots.table h >>
security_log (fun () -> security_log (fun () ->
Printf.sprintf "%s successfully removed ballot %S" user old_ballot Printf.sprintf "%s successfully removed ballot %S" user old_ballot
) >> ) >>
let hash = sha256_b64 rawballot in let hash = sha256_b64 rawballot in
Ocsipersist.add cred_table credential (Some hash) >> Ocsipersist.add cred_table credential (Some hash) >>
Ocsipersist.add ballot_table hash rawballot >> Ocsipersist.add Ballots.table hash rawballot >>
Ocsipersist.add record_table user (date, credential) >> Ocsipersist.add Records.table user (date, credential) >>
security_log (fun () -> security_log (fun () ->
Printf.sprintf "%s successfully cast ballot %s" user hash Printf.sprintf "%s successfully cast ballot %s" user hash
) ) >> return hash
) else ( ) else (
fail ProofCheck fail ProofCheck
) )
...@@ -319,14 +335,6 @@ let make_web_election raw_election e_meta election_web = ...@@ -319,14 +335,6 @@ let make_web_election raw_election e_meta election_web =
Printf.sprintf "%s attempted to vote with already used credential %s" user credential Printf.sprintf "%s attempted to vote with already used credential %s" user credential
) >> fail ReusedCredential ) >> fail ReusedCredential
let fold_ballots f x =
Ocsipersist.fold_step (fun k v x -> f v x) ballot_table x
let fold_records f x =
Ocsipersist.fold_step (fun k v x -> f (k, fst v) x) record_table x
let turnout = Ocsipersist.length ballot_table
let do_update_cred ~old ~new_ = let do_update_cred ~old ~new_ =
match_lwt Ocsipersist.fold_step (fun k v x -> match_lwt Ocsipersist.fold_step (fun k v x ->
if sha256_hex k = old then ( if sha256_hex k = old then (
......
...@@ -76,11 +76,16 @@ exception Error of error ...@@ -76,11 +76,16 @@ exception Error of error
val explain_error : error -> string val explain_error : error -> string
module type WEB_BALLOT_BOX = sig module type WEB_BALLOT_BOX = sig
include Signatures.BALLOT_BOX module Ballots : Signatures.BALLOT_BOX
with type 'a m = 'a Lwt.t with type 'a m = 'a Lwt.t
and type ballot = string and type ballot = string
and type record = string * datetime and type receipt = string
module Records : Signatures.BALLOT_BOX
with type 'a m = 'a Lwt.t
and type ballot = Serializable_builtin_t.datetime * string
and type receipt = string
val cast : string -> string * datetime -> string Lwt.t
val inject_creds : SSet.t -> unit Lwt.t val inject_creds : SSet.t -> unit Lwt.t
val extract_creds : unit -> SSet.t Lwt.t val extract_creds : unit -> SSet.t Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t val update_cred : old:string -> new_:string -> unit 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