Commit 8b637b64 authored by Stephane Glondu's avatar Stephane Glondu Committed by Stéphane Glondu

Rework the shuffling phase w.r.t. the administrator

parent 46f35052
Pipeline #102842 passed with stages
in 27 minutes and 13 seconds
......@@ -394,15 +394,18 @@ let compute_encrypted_tally uuid =
return (Some (num_tallied, sha256_b64 tally, tally))
let get_shuffle_token uuid =
match%lwt read_file ~uuid "shuffle_token" with
| Some [x] -> return x
| _ ->
let%lwt token = generate_token () in
let%lwt () = write_file ~uuid "shuffle_token" [token] in
return token
match%lwt read_file ~uuid "shuffle_token.json" with
| Some [x] -> return_some (shuffle_token_of_string x)
| _ -> return_none
let gen_shuffle_token uuid tk_trustee =
let%lwt tk_token = generate_token () in
let t = {tk_trustee; tk_token} in
let%lwt () = write_file ~uuid "shuffle_token.json" [string_of_shuffle_token t] in
return t
let clear_shuffle_token uuid =
let f = !Web_config.spool_dir / raw_string_of_uuid uuid / "shuffle_token" in
let f = !Web_config.spool_dir / raw_string_of_uuid uuid / "shuffle_token.json" in
try%lwt Lwt_unix.unlink f with _ -> return_unit
let get_nh_ciphertexts uuid =
......@@ -442,6 +445,31 @@ let get_shuffles uuid =
in
loop [] x
let get_shuffle_hashes uuid =
match%lwt read_file ~uuid "shuffle_hashes.jsons" with
| None -> return_none
| Some x ->
let rec loop accu = function
| s :: rest -> loop (shuffle_hash_of_string s :: accu) rest
| [] -> return_some (List.rev accu)
in
loop [] x
let add_shuffle_hash uuid sh =
let%lwt current =
match%lwt get_shuffle_hashes uuid with
| None -> return []
| Some x -> return x
in
let () =
if List.exists (fun x -> x.sh_trustee = sh.sh_trustee) current then (
Printf.ksprintf failwith "add_shuffle_hash(%s, %s): existing trustee"
(raw_string_of_uuid uuid) sh.sh_trustee
)
in
let new_ = current @ [sh] in
write_file ~uuid "shuffle_hashes.jsons" (List.map string_of_shuffle_hash new_)
let compute_encrypted_tally_after_shuffling uuid =
let%lwt election = get_raw_election uuid in
match election with
......@@ -480,10 +508,11 @@ let append_to_shuffles uuid shuffle =
| None -> return []
| Some x -> return x
in
let new_ = current @ [string_of_shuffle E.G.write shuffle] in
let shuffle_ = string_of_shuffle E.G.write shuffle in
let new_ = current @ [shuffle_] in
let%lwt () = write_file ~uuid "shuffles.jsons" new_ in
return true
) else return false
return_some (sha256_b64 shuffle_)
) else return_none
)
module ExtendedRecordsCacheTypes = struct
......
......@@ -83,14 +83,17 @@ val get_ballot_by_hash : uuid -> string -> string option Lwt.t
val compute_encrypted_tally : uuid -> (int * string * string) option Lwt.t
val get_shuffles : uuid -> string list option Lwt.t
val get_shuffle_hashes : uuid -> shuffle_hash list option Lwt.t
val add_shuffle_hash : uuid -> shuffle_hash -> unit Lwt.t
val compute_encrypted_tally_after_shuffling : uuid -> (string * string) option Lwt.t
val get_shuffle_token : uuid -> string Lwt.t
val get_shuffle_token : uuid -> shuffle_token option Lwt.t
val gen_shuffle_token : uuid -> string -> shuffle_token Lwt.t
val clear_shuffle_token : uuid -> unit Lwt.t
val get_nh_ciphertexts : uuid -> string Lwt.t
val append_to_shuffles : uuid -> string -> bool Lwt.t
val append_to_shuffles : uuid -> string -> string option Lwt.t
val has_voted : uuid -> user -> bool Lwt.t
......
......@@ -135,6 +135,18 @@ type draft_election = {
?creation_date : datetime option;
} <ocaml field_prefix="se_">
(** {1 Types related to elections being tallied} *)
type shuffle_hash = {
trustee : string;
hash : string;
} <ocaml field_prefix="sh_">
type shuffle_token = {
trustee : string;
token : string;
} <ocaml field_prefix="tk_">
(** {1 Types related to deleted elections} *)
type authentication_method = [ CAS of string | Password | Unknown ]
......
......@@ -107,6 +107,9 @@ let election_compute_encrypted_tally = create_attached_post ~csrf_safe:true ~fal
let election_nh_ciphertexts = create ~path:(Path ["election"; "nh-ciphertexts"]) ~meth:(Get (uuid "uuid")) ()
let election_shuffle_link = create ~path:(Path ["election"; "shuffle"]) ~meth:(Get uuid_and_token) ()
let election_shuffle_post = create ~path:(Path ["election"; "submit-shuffle"]) ~meth:(Post (uuid_and_token, string "shuffle")) ()
let election_shuffler_select = create ~path:No_path ~meth:(Post (unit, string "uuid" ** string "trustee")) ()
let election_shuffler_skip_confirm = create ~path:No_path ~meth:(Post (unit, string "uuid" ** string "trustee")) ()
let election_shuffler_skip = create ~path:No_path ~meth:(Post (unit, string "uuid" ** string "trustee")) ()
let election_decrypt = create_attached_post ~csrf_safe:true ~fallback:election_admin ~post_params:unit ()
let election_tally_trustees = create ~path:(Path ["election"; "trustees"]) ~meth:(Get uuid_and_token) ()
let election_tally_trustees_post = create ~path:(Path ["election"; "submit-partial-decryption"]) ~meth:(Post (uuid_and_token, string "partial_decryption")) ()
......
......@@ -1301,11 +1301,12 @@ let () =
let cc = nh_ciphertexts_of_string E.G.read cc in
let%lwt shuffle = E.shuffle_ciphertexts cc in
let shuffle = string_of_shuffle E.G.write shuffle in
if%lwt Web_persist.append_to_shuffles uuid shuffle then (
return_unit
) else (
Lwt.fail (Failure (Printf.sprintf "Automatic shuffle by server has failed for election %s!" (raw_string_of_uuid uuid)))
)
match%lwt Web_persist.append_to_shuffles uuid shuffle with
| Some h ->
let sh = {sh_trustee = "server"; sh_hash = h} in
Web_persist.add_shuffle_hash uuid sh
| None ->
Lwt.fail (Failure (Printf.sprintf "Automatic shuffle by server has failed for election %s!" (raw_string_of_uuid uuid)))
) else return_unit
in
let get_tokens_decrypt () =
......@@ -2029,10 +2030,11 @@ let () =
(fun (uuid, token) () ->
without_site_user (fun () ->
let%lwt expected_token = Web_persist.get_shuffle_token uuid in
if token = expected_token then (
let%lwt election = find_election uuid in
T.shuffle election token >>= Html.send
) else forbidden ()
match expected_token with
| Some x when token = x.tk_token ->
let%lwt election = find_election uuid in
T.shuffle election token >>= Html.send
| _ -> forbidden ()
)
)
......@@ -2041,15 +2043,60 @@ let () =
(fun (uuid, token) shuffle ->
without_site_user (fun () ->
let%lwt expected_token = Web_persist.get_shuffle_token uuid in
if token = expected_token then (
match%lwt Web_persist.append_to_shuffles uuid shuffle with
| true ->
let%lwt () = Web_persist.clear_shuffle_token uuid in
T.generic_page ~title:"Success" "The shuffle has been successfully applied!" () >>= Html.send
| false ->
T.generic_page ~title:"Error" "An error occurred while applying the shuffle." () >>= Html.send
| exception e ->
T.generic_page ~title:"Error" (Printf.sprintf "Data is invalid! (%s)" (Printexc.to_string e)) () >>= Html.send
match expected_token with
| Some x when token = x.tk_token ->
(match%lwt Web_persist.append_to_shuffles uuid shuffle with
| Some h ->
let%lwt () = Web_persist.clear_shuffle_token uuid in
let sh = {sh_trustee = x.tk_trustee; sh_hash = h} in
let%lwt () = Web_persist.add_shuffle_hash uuid sh in
T.generic_page ~title:"Success" "The shuffle has been successfully applied!" () >>= Html.send
| None ->
T.generic_page ~title:"Error" "An error occurred while applying the shuffle." () >>= Html.send
| exception e ->
T.generic_page ~title:"Error" (Printf.sprintf "Data is invalid! (%s)" (Printexc.to_string e)) () >>= Html.send
)
| _ -> forbidden ()
)
)
let () =
Any.register ~service:election_shuffler_select
(fun () (uuid, trustee) ->
let uuid = uuid_of_raw_string uuid in
with_site_user (fun u ->
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
let%lwt () = Web_persist.clear_shuffle_token uuid in
let%lwt _ = Web_persist.gen_shuffle_token uuid trustee in
redir_preapply election_admin uuid ()
) else forbidden ()
)
)
let () =
Any.register ~service:election_shuffler_skip_confirm
(fun () (uuid, trustee) ->
let uuid = uuid_of_raw_string uuid in
with_site_user (fun u ->
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
T.election_shuffler_skip_confirm uuid trustee >>= Html.send
) else forbidden ()
)
)
let () =
Any.register ~service:election_shuffler_skip
(fun () (uuid, trustee) ->
let uuid = uuid_of_raw_string uuid in
with_site_user (fun u ->
let%lwt metadata = Web_persist.get_election_metadata uuid in
if metadata.e_owner = Some u then (
let%lwt () = Web_persist.clear_shuffle_token uuid in
let sh = {sh_trustee = trustee; sh_hash = ""} in
let%lwt () = Web_persist.add_shuffle_hash uuid sh in
redir_preapply election_admin uuid ()
) else forbidden ()
)
)
......
......@@ -1931,6 +1931,12 @@ Thank you again for your help,
-- \nThe election administrator."
type web_shuffler = {
ws_trustee : string;
mutable ws_select : string option;
mutable ws_hash : string option;
}
let election_admin election metadata state get_tokens_decrypt () =
let uuid = election.e_params.e_uuid in
let title = election.e_params.e_name ^ " — Administration" in
......@@ -2021,33 +2027,108 @@ let election_admin election metadata state get_tokens_decrypt () =
]) uuid;
]
| `Shuffling ->
let%lwt shuffles = Web_persist.get_shuffles uuid in
let shuffles =
match shuffles with
| None -> failwith "Web_templates.admin, state Shuffling: no shuffles"
| Some ss -> ul (List.map (fun s -> li [pcdata (Platform.sha256_b64 s)]) ss)
let shufflers =
match metadata.e_trustees with
| None -> [{ws_trustee = "server"; ws_select = None; ws_hash = None}]
| Some ts ->
List.map
(fun ws_trustee ->
{ws_trustee; ws_select = None; ws_hash = None}
) ts
in
let%lwt () =
match%lwt Web_persist.get_shuffle_hashes uuid with
| None -> failwith "shuffle hashes are missing"
| Some hashes ->
List.iter
(fun x ->
match List.find_opt (fun y -> y.ws_trustee = x.sh_trustee) shufflers with
| Some y -> y.ws_hash <- Some x.sh_hash
| None -> ()
) hashes;
return_unit
in
let%lwt select_disabled =
match%lwt Web_persist.get_shuffle_token uuid with
| None -> return_false
| Some t ->
match List.find_opt (fun x -> x.ws_trustee = t.tk_trustee) shufflers with
| Some y -> y.ws_select <- Some t.tk_token; return_true
| None -> return_false
in
let table_contents =
List.map
(fun x ->
let skip, hash, done_ =
let mk_skip disabled =
post_form ~service:election_shuffler_skip_confirm
(fun (nuuid, ntrustee) ->
let a = if disabled then [a_disabled ()] else [] in
[
input ~input_type:`Hidden ~name:nuuid ~value:(raw_string_of_uuid uuid) string;
input ~input_type:`Hidden ~name:ntrustee ~value:x.ws_trustee string;
input ~a ~input_type:`Submit ~value:"Skip" string;
]
) ()
in
match x.ws_hash with
| None -> mk_skip false, pcdata "", false
| Some h -> mk_skip true, pcdata (if h = "" then "(skipped)" else h), true
in
tr
[
td [pcdata x.ws_trustee];
td
[
match x.ws_select with
| Some token ->
a ~service:election_shuffle_link ~a:[a_id "shuffle-link"]
[pcdata "Link"] (uuid, token)
| None ->
post_form ~service:election_shuffler_select
(fun (nuuid, ntrustee) ->
let a = if select_disabled || done_ then [a_disabled ()] else [] in
[
input ~input_type:`Hidden ~name:nuuid ~value:(raw_string_of_uuid uuid) string;
input ~input_type:`Hidden ~name:ntrustee ~value:x.ws_trustee string;
input ~a ~input_type:`Submit ~value:"Select this trustee" string;
]
) ()
];
td [if done_ then pcdata "Yes" else pcdata "No"];
td [skip];
td [hash];
]
) shufflers
in
let proceed =
if List.for_all (fun x -> x.ws_hash <> None) shufflers then
post_form ~service:election_decrypt
(fun () ->
[
input ~input_type:`Submit ~value:"Proceed to decryption" string;
]
) uuid
else
pcdata ""
in
let%lwt token = Web_persist.get_shuffle_token uuid in
return (
div [
div [
div [pcdata "The ballots are being shuffled."];
div [
pcdata "Shuffles applied so far:";
shuffles;
];
div [
a ~service:election_shuffle_link ~a:[a_id "shuffle-link"] [
pcdata "New shuffle";
] (uuid, token);
];
div ~a:[a_style "text-align: center;"]
[pcdata "Shuffling of ballots"];
table
(tr
[
th [pcdata "Trustee"];
th [];
th [pcdata "Done?"];
th [];
th [pcdata "Hash"];
] :: table_contents
);
];
post_form ~service:election_decrypt
(fun () ->
[
input ~input_type:`Submit ~value:"Proceed to decryption" string;
]
) uuid;
proceed;
]
)
| `EncryptedTally (npks, _, hash) ->
......@@ -2623,6 +2704,28 @@ let pretty_records election records () =
let%lwt login_box = login_box ~cont:(ContSiteElection uuid) () in
base ~title ~login_box ~content ()
let election_shuffler_skip_confirm uuid trustee =
let title = "Skipping trustee " ^ trustee in
let content =
[
post_form ~service:election_shuffler_skip
(fun (nuuid, ntrustee) ->
[
div [pcdata "You may skip a trustee if they do not answer. Be aware that this reduces the security."];
div
[
input ~input_type:`Hidden ~name:nuuid ~value:(raw_string_of_uuid uuid) string;
input ~input_type:`Hidden ~name:ntrustee ~value:trustee string;
input ~input_type:`Submit ~value:"Confirm" string;
pcdata " ";
a ~service:Web_services.election_admin [pcdata "Cancel"] uuid;
]
]
) ()
]
in
base ~title ~content ()
let shuffle election token =
let params = election.e_params in
let uuid = params.e_uuid in
......
......@@ -61,6 +61,7 @@ val cast_confirmed : 'a election -> result:(string, Web_common.error) result ->
val pretty_ballots : 'a election -> string list -> Yojson.Safe.json election_result option -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val pretty_records : 'a election -> (string * string) list -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val election_shuffler_skip_confirm : uuid -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val shuffle : 'a election -> string -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
val tally_trustees : 'a election -> int -> string -> unit -> [> `Html ] Eliom_content.Html.F.elt Lwt.t
......
......@@ -69,45 +69,6 @@ class BeleniosTestElectionScenario1(BeleniosElectionTestBase):
wait_a_bit()
# She looks for the "Shuffle link" link
shuffle_element = wait_for_element_exists(browser, "#shuffle-link", settings.EXPLICIT_WAIT_TIMEOUT)
shuffle_link = shuffle_element.get_attribute("href")
console_log("Shuffle link is " + shuffle_link);
# She logs out and goes to the shuffle link
log_out(browser)
wait_a_bit()
browser.get(shuffle_link)
wait_a_bit()
# She clicks on the "Compute shuffle" button
wait_for_element_visible(browser, "#compute_shuffle", settings.EXPLICIT_WAIT_TIMEOUT).click()
wait_a_bit()
# She waits for the "shuffle" textarea to be filled
wait_for_element_exists_and_has_non_empty_attribute(browser, "#shuffle", "value", settings.EXPLICIT_WAIT_TIMEOUT)
# She clicks on the "Submit" button
submit_element = wait_for_element_exists(browser, "input", settings.EXPLICIT_WAIT_TIMEOUT)
submit_element.click()
wait_a_bit()
wait_for_element_exists_and_contains_expected_text(browser, "h1", "Success", settings.EXPLICIT_WAIT_TIMEOUT)
wait_a_bit()
browser.get(election_url)
# She clicks on the "Administer this election" link
administration_link_label = "Administer this election"
administration_link_element = wait_for_an_element_with_partial_link_text_exists(browser, administration_link_label, settings.EXPLICIT_WAIT_TIMEOUT)
administration_link_element.click()
# She logs in as administrator
log_in_as_administrator(browser, from_a_login_page=True)
# She clicks on the "Proceed to decryption" button
decrypt_button_label = "Proceed to decryption"
decrypt_button_css_selector = build_css_selector_to_find_buttons_in_page_content_by_value(decrypt_button_label)
......
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