Commit 678a6faa authored by Stephane Glondu's avatar Stephane Glondu

Complete change of terminology

parent 2dcb1e5d
Pipeline #91677 failed with stages
in 16 minutes and 53 seconds
......@@ -49,8 +49,8 @@ let get_group x =
let has_nh_questions e =
Array.exists (function
| Question.Open _ -> true
| Question.Standard _ -> false
| Question.NonHomomorphic _ -> true
| Question.Homomorphic _ -> false
) e.e_params.e_questions
let check_modulo p x = Z.(geq x zero && lt x p)
......@@ -176,8 +176,8 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
let rec loop i accu =
if i >= 0 then (
match election.e_params.e_questions.(i) with
| Question.Standard _ -> loop (i-1) accu
| Question.Open _ -> loop (i-1) (Shape.to_array x.(i) :: accu)
| Question.Homomorphic _ -> loop (i-1) accu
| Question.NonHomomorphic _ -> loop (i-1) (Shape.to_array x.(i) :: accu)
) else Array.of_list accu
in
loop (Array.length x - 1) []
......@@ -188,8 +188,8 @@ module Make (W : ELECTION_DATA) (M : RANDOM) = struct
let rec loop i j =
if i < n && j < m then (
match election.e_params.e_questions.(i) with
| Question.Standard _ -> loop (i+1) j
| Question.Open _ ->
| Question.Homomorphic _ -> loop (i+1) j
| Question.NonHomomorphic _ ->
x.(i) <- Shape.of_array cc.(j);
loop (i+1) (j+1)
) else (
......
......@@ -22,8 +22,8 @@
open Signatures_core
type question =
| Standard of Question_h_t.question
| Open of Question_nh_t.question
| Homomorphic of Question_h_t.question
| NonHomomorphic of Question_nh_t.question
let read_question l b =
let x = Yojson.Safe.read_json l b in
......@@ -31,11 +31,11 @@ let read_question l b =
| `Assoc o ->
(match List.assoc_opt "type" o with
| None ->
Standard (Question_h_j.question_of_string (Yojson.Safe.to_string x))
| Some (`String "open") ->
Homomorphic (Question_h_j.question_of_string (Yojson.Safe.to_string x))
| Some (`String "NonHomomorphic") ->
(match List.assoc_opt "value" o with
| None -> failwith "Question.read_question: value is missing"
| Some v -> Open (Question_nh_j.question_of_string (Yojson.Safe.to_string v))
| Some v -> NonHomomorphic (Question_nh_j.question_of_string (Yojson.Safe.to_string v))
)
| Some _ ->
failwith "Question.read_question: unexpected type"
......@@ -43,28 +43,28 @@ let read_question l b =
| _ -> failwith "Question.read_question: unexpected JSON value"
let write_question b = function
| Standard q -> Question_h_j.write_question b q
| Open q ->
| Homomorphic q -> Question_h_j.write_question b q
| NonHomomorphic q ->
let o = [
"type", `String "open";
"type", `String "NonHomomorphic";
"value", Yojson.Safe.from_string (Question_nh_j.string_of_question q);
]
in
Yojson.Safe.write_json b (`Assoc o)
let erase_question = function
| Standard q ->
| Homomorphic q ->
let open Question_h_t in
Standard {
Homomorphic {
q_answers = Array.map (fun _ -> "") q.q_answers;
q_blank = q.q_blank;
q_min = q.q_min;
q_max = q.q_max;
q_question = "";
}
| Open q ->
| NonHomomorphic q ->
let open Question_nh_t in
Open {
NonHomomorphic {
q_answers = Array.map (fun _ -> "") q.q_answers;
q_question = "";
}
......@@ -72,19 +72,19 @@ let erase_question = function
module Make (M : RANDOM) (G : GROUP) = struct
let ( >>= ) = M.bind
module QStandard = Question_h.Make (M) (G)
module QOpen = Question_nh.Make (M) (G)
module QHomomorphic = Question_h.Make (M) (G)
module QNonHomomorphic = Question_nh.Make (M) (G)
let create_answer q ~public_key ~prefix m =
match q with
| Standard q ->
QStandard.create_answer q ~public_key ~prefix m >>= fun answer ->
| Homomorphic q ->
QHomomorphic.create_answer q ~public_key ~prefix m >>= fun answer ->
answer
|> Question_h_j.string_of_answer G.write
|> Yojson.Safe.from_string
|> M.return
| Open q ->
QOpen.create_answer q ~public_key ~prefix m >>= fun answer ->
| NonHomomorphic q ->
QNonHomomorphic.create_answer q ~public_key ~prefix m >>= fun answer ->
answer
|> Question_nh_j.string_of_answer G.write
|> Yojson.Safe.from_string
......@@ -92,44 +92,44 @@ module Make (M : RANDOM) (G : GROUP) = struct
let verify_answer q ~public_key ~prefix a =
match q with
| Standard q ->
| Homomorphic q ->
a
|> Yojson.Safe.to_string
|> Question_h_j.answer_of_string G.read
|> QStandard.verify_answer q ~public_key ~prefix
| Open q ->
|> QHomomorphic.verify_answer q ~public_key ~prefix
| NonHomomorphic q ->
a
|> Yojson.Safe.to_string
|> Question_nh_j.answer_of_string G.read
|> QOpen.verify_answer q ~public_key ~prefix
|> QNonHomomorphic.verify_answer q ~public_key ~prefix
let extract_ciphertexts q a =
match q with
| Standard q ->
| Homomorphic q ->
a
|> Yojson.Safe.to_string
|> Question_h_j.answer_of_string G.read
|> QStandard.extract_ciphertexts q
| Open q ->
|> QHomomorphic.extract_ciphertexts q
| NonHomomorphic q ->
a
|> Yojson.Safe.to_string
|> Question_nh_j.answer_of_string G.read
|> QOpen.extract_ciphertexts q
|> QNonHomomorphic.extract_ciphertexts q
let process_ciphertexts q e =
match q with
| Standard q -> QStandard.process_ciphertexts q e
| Open q -> QOpen.process_ciphertexts q e
| Homomorphic q -> QHomomorphic.process_ciphertexts q e
| NonHomomorphic q -> QNonHomomorphic.process_ciphertexts q e
let compute_result ~num_tallied =
let compute_std = lazy (QStandard.compute_result ~num_tallied) in
let compute_h = lazy (QHomomorphic.compute_result ~num_tallied) in
fun q x ->
match q with
| Standard q -> Lazy.force compute_std q x
| Open q -> QOpen.compute_result ~num_tallied q x
| Homomorphic q -> Lazy.force compute_h q x
| NonHomomorphic q -> QNonHomomorphic.compute_result ~num_tallied q x
let check_result q x r =
match q with
| Standard q -> QStandard.check_result q x r
| Open q -> QOpen.check_result q x r
| Homomorphic q -> QHomomorphic.check_result q x r
| NonHomomorphic q -> QNonHomomorphic.check_result q x r
end
......@@ -22,8 +22,8 @@
open Signatures_core
type question =
| Standard of Question_h_t.question
| Open of Question_nh_t.question
| Homomorphic of Question_h_t.question
| NonHomomorphic of Question_nh_t.question
val read_question : Yojson.Safe.lexer_state -> Lexing.lexbuf -> question
val write_question : Bi_outbuf.t -> question -> unit
......
......@@ -19,7 +19,7 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
<doc text="Serializable datatypes for standard questions">
<doc text="Serializable datatypes for homomorphic questions">
(** {2 Predefined types} *)
......
......@@ -19,7 +19,7 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
<doc text="Serializable datatypes for open questions">
<doc text="Serializable datatypes for non-homomorphic questions">
(** {2 Predefined types} *)
......
......@@ -54,7 +54,7 @@ let progress_step n =
new_##.style##.fontWeight := Js.string "bold"
in ()
let appendStdQuestion div num_questions i q answers =
let appendHomomorphicQuestion div num_questions i q answers =
let open Question_h_t in
let () =
let c = Dom_html.createH2 document in
......@@ -138,7 +138,7 @@ let appendStdQuestion div num_questions i q answers =
in
check_constraints
let appendOpenQuestion div q answers =
let appendNonHomomorphicQuestion div q answers =
let open Question_nh_t in
let () =
let c = Dom_html.createH2 document in
......@@ -203,7 +203,7 @@ let appendOpenQuestion div q answers =
in
check_constraints
let appendStdSummary e a q =
let appendHomomorphicSummary e a q =
let open Question_h_t in
let h = Dom_html.createH3 document in
let t = document##createTextNode (Js.string q.q_question) in
......@@ -230,7 +230,7 @@ let appendStdSummary e a q =
);
Dom.appendChild e ul
let appendOpenSummary e a q =
let appendNonHomomorphicSummary e a q =
let open Question_nh_t in
let h = Dom_html.createH3 document in
let t = document##createTextNode (Js.string q.q_question) in
......@@ -253,8 +253,8 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
let div = Dom_html.createDiv document in
let check_constraints =
match q with
| Question.Standard q -> appendStdQuestion div num_questions i q answers
| Question.Open q -> appendOpenQuestion div q answers
| Question.Homomorphic q -> appendHomomorphicQuestion div num_questions i q answers
| Question.NonHomomorphic q -> appendNonHomomorphicQuestion div q answers
in
let () =
(* previous button *)
......@@ -298,8 +298,8 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
document##getElementById (Js.string "pretty_choices") >>== fun e ->
Array.iteri (fun i a ->
match all_questions.(i) with
| Question.Standard q -> appendStdSummary e a q
| Question.Open q -> appendOpenSummary e a q
| Question.Homomorphic q -> appendHomomorphicSummary e a q
| Question.NonHomomorphic q -> appendNonHomomorphicSummary e a q
) all_answers
in
Lwt_js_events.async (encryptBallot params sk all_answers);
......@@ -336,8 +336,8 @@ let addQuestions sk params qs =
Array.to_list qs |>
List.map (fun q ->
match q with
| Question.Standard x -> q, Array.make (Question_h.question_length x) 0
| Question.Open x -> q, Array.make (Array.length x.Question_nh_t.q_answers) 0
| Question.Homomorphic x -> q, Array.make (Question_h.question_length x) 0
| Question.NonHomomorphic x -> q, Array.make (Array.length x.Question_nh_t.q_answers) 0
)
in
match qs with
......
......@@ -67,10 +67,10 @@ let extractQuestion q =
if (q_max > Array.length q_answers) then
failwith "Maximum number of choices is greater than number of choices!";
let open Question_h_t in
return (Question.Standard {q_question; q_blank; q_min; q_max; q_answers})
return (Question.Homomorphic {q_question; q_blank; q_min; q_max; q_answers})
| None ->
let open Question_nh_t in
return (Question.Open {q_question; q_answers})
return (Question.NonHomomorphic {q_question; q_answers})
let extractTemplate () =
let t_name = get_input "election_name" in
......@@ -122,7 +122,7 @@ let rec createAnswer a =
Dom.appendChild container insert_btn;
container
let createStdQuestionPropDiv min max blank =
let createHomomorphicQuestionPropDiv min max blank =
let container = Dom_html.createDiv document in
let x = Dom_html.createDiv document in
let t = document##createTextNode (Js.string "The voter has to choose between ") in
......@@ -195,7 +195,7 @@ let rec createQuestionDiv question answers props =
| Some x -> x
| None -> default_props
in
createStdQuestionPropDiv min max blank
createHomomorphicQuestionPropDiv min max blank
in
let prop_div_nh = Dom_html.createDiv document in
let x = Dom_html.createDiv document in
......@@ -251,10 +251,10 @@ let rec createQuestionDiv question answers props =
let createQuestion q =
let question, answers, props =
match q with
| Question.Standard q ->
| Question.Homomorphic q ->
let open Question_h_t in
q.q_question, q.q_answers, Some (q.q_blank, q.q_min, q.q_max)
| Question.Open q ->
| Question.NonHomomorphic q ->
let open Question_nh_t in
q.q_question, q.q_answers, None
in
......@@ -304,7 +304,7 @@ let createTemplate template =
let t = document##createTextNode (Js.string "Add a question") in
let f _ =
let open Question_h_t in
let x = createQuestion (Question.Standard {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]}) in
let x = createQuestion (Question.Homomorphic {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]}) in
Dom.appendChild h_questions_div x
in
b##.onclick := handler f;
......
......@@ -413,8 +413,8 @@ let unwebize_trustee_public_key pk =
let get_suitable_group_kind {t_questions; _} =
let group = ref `H in
Array.iter (function
| Question.Open _ -> group := `NH
| Question.Standard _ -> ()
| Question.NonHomomorphic _ -> group := `NH
| Question.Homomorphic _ -> ()
) t_questions;
!group
......@@ -438,7 +438,7 @@ let default_questions =
q_question = "Question 1?";
}
in
[| Question.Standard question |]
[| Question.Homomorphic question |]
let default_name = "Name of the election"
let default_description = "Description of the election."
......
......@@ -1659,7 +1659,7 @@ let rec list_concat elt = function
let format_question_result l q r =
let module L = (val l : Web_i18n_sig.LocalizedStrings) in
match q with
| Question.Standard x ->
| Question.Homomorphic x ->
let r = Shape.to_array r in
let open Question_h_t in
let answers = Array.to_list x.q_answers in
......@@ -1684,12 +1684,12 @@ let format_question_result l q r =
pcdata x.q_question;
answers;
]
| Question.Open x ->
| Question.NonHomomorphic x ->
let open Question_nh_t in
li [
pcdata x.q_question;
pcdata " ";
em [pcdata "(open)"];
em [pcdata "(non-homomorphic)"];
]
let election_home election state () =
......
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