Changes in metadata handling

 - metadata is specific to web, move it there
 - create Web_serializable, and also move randomness there
 - metadata is not optional (but its components can be)
 - rename user_type into user_domain
 - serializable version of ACLs

src/bin/election_tool.ml

@@ -163,19 +163,12 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
 
   (* Finish setting up the election *)
 
-  let metadata =
-    match (load_from_file Serializable_j.metadata_of_string "metadata.json") with
-    | Some [m] -> Some m
-    | Some _ -> failwith "invalid metadata.json"
-    | None -> None
-
   let pks = match public_keys with
     | Some pks -> pks
     | None -> failwith "missing public keys"
 
   let e = {
     e_params = { params with e_public_key = P.y };
-    e_meta = metadata;
     e_pks = Some pks;
     e_fingerprint = election_fingerprint;
   }

src/lib/serializable.atd

@@ -132,16 +132,3 @@ type 'a result = {
   partial_decryptions : 'a partial_decryption list <ocaml repr="array">;
   result : plaintext;
 }
-
-(** {1 Other datastructures} *)
-
-type randomness = {
-  randomness : string;
-}
-<doc text="Randomness generated by the server sent to the client.">
-
-type metadata = {
-  voting_starts_at : datetime;
-  voting_ends_at : datetime;
-  ?voters_list : string list option;
-} <ocaml field_prefix="e_">

src/lib/signatures.mli

@@ -110,9 +110,6 @@ type 'a election = {
   e_params : 'a Serializable_t.params;
   (** Parameters of the election. *)
 
-  e_meta : Serializable_t.metadata option;
-  (** Other optional, serializable, metadata. *)
-
   e_pks : 'a array option;
   (** Trustee public keys. *)
 

src/web/auth_common.ml

@@ -21,11 +21,13 @@
 
 open Lwt
 open Util
+open Serializable_t
+open Web_serializable_t
 open Web_signatures
 open Web_common
 
-let string_of_user {user_type; user_name} =
-  user_type ^ ":" ^ user_name
+let string_of_user {user_domain; user_name} =
+  user_domain ^ ":" ^ user_name
 
 type instantiator = string -> (module AUTH_SERVICE) -> unit
 
@@ -49,12 +51,12 @@ module Make (X : EMPTY) = struct
     ~scope:Eliom_common.default_session_scope
     None
 
-  let on_success user_admin user_type ~user_name ~user_logout =
-    let user_user = {user_type; user_name} in
+  let on_success user_admin user_domain ~user_name ~user_logout =
+    let user_user = {user_domain; user_name} in
     let logged_user = {user_admin; user_user; user_logout} in
     security_log (fun () ->
       Printf.sprintf "%s successfully logged in%s using %s"
-        user_name (if user_admin then " (as admin)" else "") user_type
+        user_name (if user_admin then " (as admin)" else "") user_domain
     ) >>
     Eliom_reference.set user (Some logged_user)
 

src/web/auth_common.mli

@@ -19,6 +19,8 @@
 (*  <http://www.gnu.org/licenses/>.                                       *)
 (**************************************************************************)
 
+open Serializable_t
+open Web_serializable_t
 open Web_signatures
 
 val string_of_user : user -> string

src/web/registration.ml

@@ -22,6 +22,7 @@
 open Signatures
 open Util
 open Serializable_t
+open Web_serializable_j
 open Lwt
 open Web_common
 open Web_signatures
@@ -36,6 +37,11 @@ module E = Election.MakeElection(G)(M)
 
 module EMap = Map.Make(Uuidm)
 
+module AclSet = Set.Make(struct
+  type t = Web_serializable_t.acl
+  let compare = compare
+end)
+
 let ( / ) = Filename.concat
 
 let file_exists x =
@@ -151,9 +157,8 @@ lwt election_table =
               if b then (
                 Lwt_io.chars_of_file fname |>
                 Lwt_stream.to_string >>=
-                wrap1 Serializable_j.metadata_of_string >>=
-                (fun x -> return (Some x))
-              ) else return None
+                wrap1 metadata_of_string
+              ) else return empty_metadata
             in
             let public_creds_fname = path/"public_creds.txt" in
             lwt public_creds =
@@ -162,17 +167,19 @@ lwt election_table =
                 return (SSet.add c accu)
               )
             in
-            let can_vote = match metadata with
+            let can_vote = match metadata.e_voters with
               | None -> Any
-              | Some m -> match m.e_voters_list with
-                | None -> Any
-                | Some voters ->
-                  let set = List.fold_left (fun accu u ->
-                    SSet.add u accu
-                  ) SSet.empty voters in
-                  Restricted (fun u ->
-                    return (SSet.mem (Auth_common.string_of_user u) set)
+              | Some acls ->
+                let set = List.fold_left (fun accu u ->
+                  AclSet.add u accu
+                ) AclSet.empty acls in
+                Restricted (fun u ->
+                  return (
+                    AclSet.mem `Any set ||
+                    AclSet.mem (`Domain u.user_domain) set ||
+                    AclSet.mem (`User u) set
                   )
+                )
             in
             let election_web = Web_election.({
               params_fname;
@@ -323,7 +330,7 @@ module SSite = struct
       (fun () () ->
         lwt r = do_get_randomness () in
         Cryptokit.(transform_string (Base64.encode_compact ()) r) |>
-        (fun x -> Serializable_j.string_of_randomness { randomness=x }) |>
+        (fun x -> string_of_randomness { randomness=x }) |>
         (fun x -> return (x, "application/json"))
       )
 

src/web/server.mllib

 Util
 Serializable_builtin_j
 Serializable_j
+Web_serializable_j
 Web_common
 Auth_common
 Auth_dummy

src/web/templates.ml

@@ -206,18 +206,32 @@ module Make (S : Web_signatures.ALL_SERVICES) = struct
                 pcdata " vote in this election.";
               ]
     in
-    let voting_period = match election.election.e_meta with
-      | Some m ->
+    let voting_period =
+      let m = election.metadata in
+      match m.e_voting_starts_at, m.e_voting_ends_at with
+      | None, None ->
+        [
+          pcdata "This election starts and ends at the administrator's discretion."
+        ]
+      | Some s, None ->
         [
           pcdata "This election starts on ";
-          em [pcdata (format_date m.e_voting_starts_at)];
-          pcdata " and ends on ";
-          em [pcdata (format_date m.e_voting_ends_at)];
+          em [pcdata (format_date s)];
+          pcdata " and ends at the administrator's discretion.";
+        ]
+      | None, Some s ->
+        [
+          pcdata "This election starts at the administrator's discretion and ends on ";
+          em [pcdata (format_date s)];
           pcdata ".";
         ]
-      | None ->
+      | Some s, Some e ->
         [
-          pcdata "This election starts and ends at the administrator's discretion."
+          pcdata "This election starts on ";
+          em [pcdata (format_date s)];
+          pcdata " and ends on ";
+          em [pcdata (format_date e)];
+          pcdata ".";
         ]
     in
     let audit_info = div [

src/web/web_common.ml

@@ -24,6 +24,7 @@ open Lwt
 open Util
 open Serializable_builtin_t
 open Serializable_t
+open Web_serializable_t
 
 let enforce_single_element s =
   let open Lwt_stream in
@@ -145,3 +146,11 @@ let set_rewrite_prefix ~src ~dst =
       dst ^ String.sub x nsrc (n-nsrc)
     else x
   in rewrite_fun := f
+
+let empty_metadata = {
+  e_voting_starts_at = None;
+  e_voting_ends_at = None;
+  e_readers = None;
+  e_voters = None;
+  e_owner = None;
+}

src/web/web_common.mli

@@ -21,6 +21,7 @@
 
 open Serializable_builtin_t
 open Serializable_t
+open Web_serializable_t
 
 val make_rng : unit -> Cryptokit.Random.rng Lwt.t
 (** Create a pseudo random number generator initialized by a 128-bit
@@ -64,3 +65,5 @@ val forbidden : unit -> 'a Lwt.t
 
 val rewrite_prefix : string -> string
 val set_rewrite_prefix : src:string -> dst:string -> unit
+
+val empty_metadata : metadata

src/web/web_election.ml

@@ -25,9 +25,10 @@ open Lwt
 open Util
 open Serializable_builtin_t
 open Serializable_t
+open Web_serializable_t
 open Web_common
 
-let make_web_election raw_election e_meta election_web =
+let make_web_election raw_election metadata election_web =
 
   let e_fingerprint = sha256_b64 raw_election in
   let wrapped_params = Serializable_j.params_of_string
@@ -36,7 +37,7 @@ let make_web_election raw_election e_meta election_web =
   let {ffpk_g = g; ffpk_p = p; ffpk_q = q; ffpk_y = y} = wrapped_params.e_public_key in
   let group = {g; p; q} in
   let e_params = { wrapped_params with e_public_key = y } in
-  let election = {e_params; e_meta; e_pks = None; e_fingerprint} in
+  let election = {e_params; e_pks = None; e_fingerprint} in
 
   let module X : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t = struct
     type elt = Z.t
@@ -96,13 +97,15 @@ let make_web_election raw_election e_meta election_web =
         )
 
       let do_cast rawballot (user, date) =
-        let voting_open = match election.e_meta with
-          | Some m ->
-            let date = fst date in
+        let voting_open =
+          let compare a b =
             let open CalendarLib.Fcalendar.Precise in
-            compare (fst m.e_voting_starts_at) date <= 0 &&
-            compare date (fst m.e_voting_ends_at) < 0
-          | None -> true
+            match a, b with
+            | Some a, Some b -> compare (fst a) (fst b)
+            | _, _ -> -1
+          in
+          compare metadata.e_voting_starts_at (Some date) <= 0 &&
+          compare (Some date) metadata.e_voting_ends_at < 0
         in
         if not voting_open then fail ElectionClosed else return () >>
         if String.contains rawballot '\n' then (
@@ -200,5 +203,6 @@ let make_web_election raw_election e_meta election_web =
   {
     modules = (module X : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t);
     election;
+    metadata;
     election_web;
   }

src/web/web_election.mli

@@ -21,10 +21,11 @@
 
 open Serializable_builtin_t
 open Serializable_t
+open Web_serializable_t
 open Web_signatures
 
 val make_web_election :
   string ->
-  metadata option ->
+  metadata ->
   election_web ->
   Z.t web_election

src/web/web_serializable.atd

+(**************************************************************************)
+(*                                BELENIOS                                *)
+(*                                                                        *)
+(*  Copyright © 2012-2014 Inria                                           *)
+(*                                                                        *)
+(*  This program is free software: you can redistribute it and/or modify  *)
+(*  it under the terms of the GNU Affero General Public License as        *)
+(*  published by the Free Software Foundation, either version 3 of the    *)
+(*  License, or (at your option) any later version, with the additional   *)
+(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
+(*                                                                        *)
+(*  This program is distributed in the hope that it will be useful, but   *)
+(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
+(*  Affero General Public License for more details.                       *)
+(*                                                                        *)
+(*  You should have received a copy of the GNU Affero General Public      *)
+(*  License along with this program.  If not, see                         *)
+(*  <http://www.gnu.org/licenses/>.                                       *)
+(**************************************************************************)
+
+<doc text="Web-specific serializable datatypes">
+
+(** {1 Predefined types} *)
+
+type datetime <ocaml predef from="Serializable_builtin"> = abstract
+
+(** {1 Web-specific types} *)
+
+type randomness = {
+  randomness : string;
+}
+<doc text="Randomness generated by the server sent to the client.">
+
+type user = {
+  domain : string;
+  name : string;
+} <ocaml field_prefix="user_">
+
+type acl =
+  [ Any
+  | Domain of string
+  | User of user
+  ]
+
+type metadata = {
+  ?voting_starts_at : datetime option;
+  ?voting_ends_at : datetime option;
+  ?readers : acl list option;
+  ?voters : acl list option;
+  ?owner: user option;
+} <ocaml field_prefix="e_">

src/web/web_signatures.mli

@@ -20,6 +20,8 @@
 (**************************************************************************)
 
 open Serializable_builtin_t
+open Serializable_t
+open Web_serializable_t
 open Signatures
 
 module type EMPTY = sig end
@@ -194,11 +196,6 @@ module type CONT_SERVICE = sig
     Eliom_service.service Lwt.t
 end
 
-type user = {
-  user_type : string;
-  user_name : string;
-}
-
 type logged_user = {
   user_admin : bool;
   user_user : user;
@@ -281,6 +278,7 @@ end
 type 'a web_election = {
   modules : (module WEB_BALLOT_BOX_BUNDLE with type elt = 'a);
   election : 'a election;
+  metadata : metadata;
   election_web : election_web;
 }