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.

src/bin/election_tool.ml

@@ -209,7 +209,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
 
   let vote (b, hash) =
     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
 
   let () = ballots |> option_map (List.iter vote) |> ignore
@@ -218,7 +218,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
     match ballots with
       | None -> failwith "ballots.jsons is missing"
       | Some _ ->
-        M.fold_ballots (fun b t ->
+        M.fold_ballots (fun () b t ->
           M.return (E.combine_ciphertexts (E.extract_ciphertext b) t)
         ) (E.neutral_ciphertext e) ()
   )

src/lib/election.ml

@@ -99,7 +99,6 @@ let prng = lazy (Cryptokit.Random.(pseudo_rng (string secure_rng 16)))
 module MakeSimpleMonad (G : GROUP) = struct
   type 'a t = unit -> 'a
   let ballots = ref []
-  let records = ref []
   let return x () = x
   let bind x f = f (x ())
   let fail e = raise e
@@ -111,10 +110,8 @@ module MakeSimpleMonad (G : GROUP) = struct
       Z.(of_bits r mod q)
 
   type ballot = G.t Serializable_t.ballot
-  type record = string
-  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_records f x () = List.fold_left (fun accu b -> f b accu ()) x !records
+  let cast x () = ballots := x :: !ballots
+  let fold_ballots f x () = List.fold_left (fun accu b -> f () b accu ()) x !ballots
   let turnout () = List.length !ballots
 end
 

src/lib/election.mli

@@ -60,7 +60,9 @@ module MakeSimpleMonad (G : GROUP) : sig
   include Signatures.BALLOT_BOX
   with type 'a m := 'a t
   and type ballot = G.t Serializable_t.ballot
-  and type record = string
+  and type receipt := unit
+
+  val cast : ballot -> unit t
 end
 (** Simple election monad that keeps all ballots in memory. *)
 

src/lib/signatures.mli

@@ -97,18 +97,13 @@ module type BALLOT_BOX = sig
   (** The type of ballots. The monad is supposed to keep track of all
       cast ballots (e.g. in a database). *)
 
-  type record
-  (** The type of log records. *)
+  type receipt
+  (** 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
-  (** Cast a ballot. *)
-
-  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 fold_ballots : (receipt -> ballot -> 'a -> 'a m) -> 'a -> 'a m
+  (** [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 turnout : int m
   (** Number of cast ballots. *)

src/web/registration.ml

@@ -539,7 +539,7 @@ let f_ballots uuid election user () =
   let open Web_common in
   let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
   (* 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)
   ) [] in
   let s = List.map (fun b () ->
@@ -552,7 +552,7 @@ let f_records uuid election user () =
     let open Web_common in
     let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
     (* 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"
         (Serializable_builtin_j.string_of_datetime d) u
       in return (x::xs)
@@ -643,8 +643,8 @@ let do_cast election uuid () =
               in
               lwt result =
                 try_lwt
-                  X.B.cast ballot record >>
-                  return (`Valid (sha256_b64 ballot))
+                  lwt hash = X.B.cast ballot record in
+                  return (`Valid hash)
                 with Error e -> return (`Error e)
               in
               Eliom_reference.unset Services.ballot >>

src/web/web_common.ml

@@ -158,11 +158,16 @@ let security_log s =
     ) ic
 
 module type WEB_BALLOT_BOX = sig
-  include Signatures.BALLOT_BOX
-  with type 'a m = 'a Lwt.t
-  and type ballot = string
-  and type record = string * datetime
-
+  module Ballots : Signatures.BALLOT_BOX
+    with type 'a m = 'a Lwt.t
+    and type ballot = string
+    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 extract_creds : unit -> SSet.t 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 =
 
     module B : WEB_BALLOT_BOX = struct
 
-      type 'a m = 'a Lwt.t
-
       let suffix = "_" ^ String.map (function
         | '-' -> '_'
         | c -> c
       ) (Uuidm.to_string e_params.e_uuid)
 
-      let ballot_table = Ocsipersist.open_table ("ballots" ^ suffix)
-      let record_table = Ocsipersist.open_table ("records" ^ suffix)
-      let cred_table = Ocsipersist.open_table ("creds" ^ suffix)
+      module Ballots = struct
+        type 'a m = 'a Lwt.t
+        type ballot = string
+        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
 
-      type ballot = string
-      type record = string * Serializable_builtin_t.datetime
+      let cred_table = Ocsipersist.open_table ("creds" ^ suffix)
 
       let extract_creds () =
         Ocsipersist.fold_step (fun k v x ->
@@ -268,7 +284,7 @@ let make_web_election raw_election e_meta election_web =
           with Not_found -> fail InvalidCredential
         and old_record =
           try_lwt
-            lwt x = Ocsipersist.find record_table user in
+            lwt x = Ocsipersist.find Records.table user in
             Lwt.return (Some x)
           with Not_found -> Lwt.return None
         in
@@ -278,11 +294,11 @@ let make_web_election raw_election e_meta election_web =
             if E.check_ballot election ballot then (
               let hash = sha256_b64 rawballot in
               Ocsipersist.add cred_table credential (Some hash) >>
-              Ocsipersist.add ballot_table hash rawballot >>
-              Ocsipersist.add record_table user (date, credential) >>
+              Ocsipersist.add Ballots.table hash rawballot >>
+              Ocsipersist.add Records.table user (date, credential) >>
               security_log (fun () ->
                 Printf.sprintf "%s successfully cast ballot %s" user hash
-              )
+              ) >> return hash
             ) else (
               fail ProofCheck
             )
@@ -290,18 +306,18 @@ let make_web_election raw_election e_meta election_web =
             (* revote *)
             if credential = old_credential then (
               if E.check_ballot election ballot then (
-                lwt old_ballot = Ocsipersist.find ballot_table h in
-                Ocsipersist.remove ballot_table h >>
+                lwt old_ballot = Ocsipersist.find Ballots.table h in
+                Ocsipersist.remove Ballots.table h >>
                 security_log (fun () ->
                   Printf.sprintf "%s successfully removed ballot %S" user old_ballot
                 ) >>
                 let hash = sha256_b64 rawballot in
                 Ocsipersist.add cred_table credential (Some hash) >>
-                Ocsipersist.add ballot_table hash rawballot >>
-                Ocsipersist.add record_table user (date, credential) >>
+                Ocsipersist.add Ballots.table hash rawballot >>
+                Ocsipersist.add Records.table user (date, credential) >>
                 security_log (fun () ->
                   Printf.sprintf "%s successfully cast ballot %s" user hash
-                )
+                ) >> return hash
               ) else (
                 fail ProofCheck
               )
@@ -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
             ) >> 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_ =
         match_lwt Ocsipersist.fold_step (fun k v x ->
           if sha256_hex k = old then (

src/web/web_common.mli

@@ -76,11 +76,16 @@ exception Error of error
 val explain_error : error -> string
 
 module type WEB_BALLOT_BOX = sig
-  include Signatures.BALLOT_BOX
-  with type 'a m = 'a Lwt.t
-  and type ballot = string
-  and type record = string * datetime
-
+  module Ballots : Signatures.BALLOT_BOX
+    with type 'a m = 'a Lwt.t
+    and type ballot = string
+    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 extract_creds : unit -> SSet.t Lwt.t
   val update_cred : old:string -> new_:string -> unit Lwt.t