Record more dates for data retention policy

src/web/web_common.ml

@@ -272,3 +272,5 @@ let write_file ?uuid x lines =
   )
 
 let default_contact = "Name <user@example.org>"
+
+let default_finalization_date = datetime_of_string "\"2015-10-01 00:00:00.000000\""

src/web/web_common.mli

@@ -109,3 +109,4 @@ val read_file : ?uuid:uuid -> string -> string list option Lwt.t
 val write_file : ?uuid:uuid -> string -> string list -> unit Lwt.t
 
 val default_contact : string
+val default_finalization_date : datetime

src/web/web_persist.ml

@@ -51,18 +51,41 @@ let get_election_state x =
 let set_election_state x s =
   Ocsipersist.add election_states (raw_string_of_uuid x) s
 
-let past = datetime_of_string "\"2015-10-01 00:00:00.000000\""
+type election_date =
+  [ `Creation
+  | `Finalization
+  | `Tally
+  | `Archive
+  ]
 
-let set_election_date uuid d =
-  let dates = string_of_election_dates { e_finalization = d } in
+let get_election_dates uuid =
+  match%lwt read_file ~uuid "dates.json" with
+  | Some [x] -> return (election_dates_of_string x)
+  | _ -> return {
+             e_creation = None;
+             e_finalization = None;
+             e_tally = None;
+             e_archive = None;
+           }
+
+let set_election_date kind uuid d =
+  let%lwt dates = get_election_dates uuid in
+  let dates = match kind with
+    | `Creation -> { dates with e_creation = Some d }
+    | `Finalization -> { dates with e_finalization = Some d }
+    | `Tally -> { dates with e_tally = Some d }
+    | `Archive -> { dates with e_archive = Some d }
+  in
+  let dates = string_of_election_dates dates in
   write_file ~uuid "dates.json" [dates]
 
-let get_election_date uuid =
-  match%lwt read_file ~uuid "dates.json" with
-  | Some [x] ->
-     let dates = election_dates_of_string x in
-     return dates.e_finalization
-  | _ -> return past
+let get_election_date kind uuid =
+  let%lwt dates = get_election_dates uuid in
+  match kind with
+  | `Creation -> return dates.e_creation
+  | `Finalization -> return dates.e_finalization
+  | `Tally -> return dates.e_tally
+  | `Archive -> return dates.e_archive
 
 let election_pds = Ocsipersist.open_table "election_pds"
 

src/web/web_persist.mli

@@ -33,8 +33,14 @@ type election_state =
 val get_election_state : uuid -> election_state Lwt.t
 val set_election_state : uuid -> election_state -> unit Lwt.t
 
-val get_election_date : uuid -> datetime Lwt.t
-val set_election_date : uuid -> datetime -> unit Lwt.t
+type election_date =
+  [ `Creation
+  | `Finalization
+  | `Tally
+  | `Archive
+  ]
+val get_election_date : election_date -> uuid -> datetime option Lwt.t
+val set_election_date : election_date -> uuid -> datetime -> unit Lwt.t
 
 val get_partial_decryptions : uuid -> (int * string) list Lwt.t
 val set_partial_decryptions : uuid -> (int * string) list -> unit Lwt.t

src/web/web_serializable.atd

@@ -56,7 +56,10 @@ type metadata = {
 } <ocaml field_prefix="e_">
 
 type election_dates = {
-  finalization : datetime;
+  ?creation : datetime option;
+  ?finalization : datetime option;
+  ?tally : datetime option;
+  ?archive : datetime option;
 } <ocaml field_prefix="e_">
 
 (** {1 Types related to elections being prepared} *)
@@ -96,6 +99,7 @@ type setup_election = {
   ?threshold_trustees <ocaml mutable> : setup_threshold_trustee list option;
   ?threshold_parameters <ocaml mutable> : string option;
   ?threshold_error <ocaml mutable> : string option;
+  ?creation_date : datetime option;
 } <ocaml field_prefix="se_">
 
 (** {1 OpenID Connect-related types} *)

src/web/web_site.ml

@@ -274,7 +274,7 @@ let finalize_election uuid se =
   | _ -> return_unit) >>
   (* finish *)
   Web_persist.set_election_state uuid `Open >>
-  Web_persist.set_election_date uuid (now ())
+  Web_persist.set_election_date `Finalization uuid (now ())
 
 let cleanup_table ?uuid_s table =
   let table = Ocsipersist.open_table table in
@@ -303,6 +303,7 @@ let archive_election uuid =
   let%lwt () = cleanup_table ("ballots_" ^ uuid_u) in
   let%lwt () = cleanup_file (!spool_dir / uuid_s / "private_key.json") in
   let%lwt () = cleanup_file (!spool_dir / uuid_s / "private_keys.jsons") in
+  let%lwt () = Web_persist.set_election_date `Archive uuid (now ()) in
   return_unit
 
 let () = Any.register ~service:home
@@ -317,7 +318,11 @@ let get_finalized_elections_by_owner u =
     Lwt_list.fold_left_s (fun accu uuid ->
         let%lwt w = find_election uuid in
         let%lwt state = Web_persist.get_election_state uuid in
-        let%lwt date = Web_persist.get_election_date uuid in
+        let%lwt date = Web_persist.get_election_date `Finalization uuid in
+        let date = match date with
+          | None -> default_finalization_date
+          | Some x -> x
+        in
         let elections, tallied, archived = accu in
         match state with
         | `Tallied _ -> return (elections, (date, w) :: tallied, archived)
@@ -430,6 +435,7 @@ let create_new_election owner cred auth =
     se_threshold_trustees = None;
     se_threshold_parameters = None;
     se_threshold_error = None;
+    se_creation_date = Some (now ());
   } in
   let%lwt () = set_setup_election uuid se in
   let%lwt () = Ocsipersist.add election_credtokens token uuid_s in
@@ -1603,6 +1609,7 @@ let handle_election_tally_release (uuid, ()) () =
           write_file ~uuid (string_of_election_file ESResult) [result]
         in
         let%lwt () = Web_persist.set_election_state uuid (`Tallied result.result) in
+        let%lwt () = Web_persist.set_election_date `Tally uuid (now ()) in
         let%lwt () = Ocsipersist.remove election_tokens_decrypt uuid_s in
         redir_preapply election_home (uuid, ()) ()
       ) else forbidden ()