Commit 9fd8af59 authored by Stephane Glondu's avatar Stephane Glondu

Merge branch 'blank'

# Conflicts:
#	src/web/web_i18n_sig.mli
#	src/web/web_l10n_de.ml
#	src/web/web_l10n_en.ml
#	src/web/web_l10n_fr.ml
#	src/web/web_l10n_ro.ml
parents 3f9efc6f 4afafa60
......@@ -42,11 +42,11 @@ belenios-tool mkelection $uuid $group --template $BELENIOS/demo/templates/questi
header "Simulate votes"
cat > votes.txt <<EOF
[[1,0]]
[[1,0]]
[[0,1]]
[[1,0]]
[[0,0]]
[[1,0],[1,0,0]]
[[1,0],[0,1,0]]
[[0,1],[0,0,1]]
[[1,0],[1,0,0]]
[[0,0],[0,1,0]]
EOF
paste private_creds.txt votes.txt | while read id cred vote; do
......
{"description":"Description of the election.","name":"Name of the election","questions":[{"answers":["Answer 1","Answer 2"],"min":0,"max":1,"question":"Question 1?"}],"short_name":"short_name"}
{"description":"Description of the election.","name":"Name of the election","questions":[{"answers":["Answer 1","Answer 2"],"min":0,"max":1,"question":"Question 1?"},{"answers":["Answer 1","Answer 2"],"blank":true,"min":1,"max":1,"question":"Question 2?"}]}
This diff is collapsed.
......@@ -144,9 +144,13 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
Dom.appendChild c t;
Dom.appendChild div c
in
let q_answers = match q.q_blank with
| Some true -> Array.append [|getHtmlById "str_blank_vote"|] q.q_answers
| _ -> q.q_answers
in
let () =
let choices = document##createElement (Js.string "div") in
Array.iteri (fun i a ->
let choices_divs = Array.mapi (fun i a ->
let div = document##createElement (Js.string "div") in
let checkbox = document##createElement (Js.string "input") in
let cb =
......@@ -164,21 +168,48 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
Js._true
);
Dom.appendChild div t;
Dom.appendChild choices div
) q.q_answers;
div
) q_answers
in
begin match q.q_blank with
| Some true ->
for i = 1 to Array.length choices_divs - 1 do
Dom.appendChild choices choices_divs.(i)
done;
(* Put the blank choice at the end of the list *)
Dom.appendChild choices (Dom_html.createBr document);
Dom.appendChild choices choices_divs.(0)
| _ ->
for i = 0 to Array.length choices_divs - 1 do
Dom.appendChild choices choices_divs.(i)
done
end;
Dom.appendChild div choices
in
let check_constraints () =
let total = Array.fold_left (+) 0 answers in
if total < q.q_min then (
let fmt = Scanf.format_from_string (getHtmlById "at_least") "%d" in
Printf.ksprintf alert fmt q.q_min;
false
) else if total > q.q_max then (
let fmt = Scanf.format_from_string (getHtmlById "at_most") "%d" in
Printf.ksprintf alert fmt q.q_max;
false
) else true
let check_min_max total =
if total < q.q_min then (
let fmt = Scanf.format_from_string (getHtmlById "at_least") "%d" in
Printf.ksprintf alert fmt q.q_min;
false
) else if total > q.q_max then (
let fmt = Scanf.format_from_string (getHtmlById "at_most") "%d" in
Printf.ksprintf alert fmt q.q_max;
false
) else true
in
match q.q_blank with
| Some true ->
let answers' = Array.sub answers 1 (Array.length answers - 1) in
let total = Array.fold_left (+) 0 answers' in
if answers.(0) > 0 then (
if total <> 0 then
(alert (getHtmlById "no_other_blank"); false)
else true
) else check_min_max total
| _ ->
let total = Array.fold_left (+) 0 answers in
check_min_max total
in
let () =
(* previous button *)
......@@ -231,7 +262,11 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
if a > 0 then (
incr checked;
let li = document##createElement (Js.string "li") in
let t = document##createTextNode (Js.string q.q_answers.(i)) in
let text = match q.q_blank with
| Some true -> if i = 0 then getHtmlById "str_blank_vote" else q.q_answers.(i-1)
| _ -> q.q_answers.(i)
in
let t = document##createTextNode (Js.string text) in
Dom.appendChild li t;
Dom.appendChild ul li;
)
......@@ -275,7 +310,7 @@ let addQuestions sk params qs =
let n = Array.length qs in
let qs =
Array.to_list qs |>
List.map (fun q -> q, Array.make (Array.length q.q_answers) 0)
List.map (fun q -> q, Array.make (Election.question_length q) 0)
in
match qs with
| [] -> failwith "no questions"
......
This diff is collapsed.
......@@ -25,6 +25,8 @@ open Platform
open Serializable_t
open Signatures
val question_length : question -> int
module MakeSimpleMonad (G : GROUP) : sig
(** {2 Monadic definitions} *)
......
......@@ -67,6 +67,7 @@ type ('a, 'b) wrapped_pubkey = {
type question = {
answers : string list <ocaml repr="array">;
?blank : bool option;
min : int;
max : int;
question : string;
......@@ -92,6 +93,7 @@ type 'a answer = {
choices : 'a ciphertext list <ocaml repr="array">;
individual_proofs : disjunctive_proof list <ocaml repr="array">;
overall_proof : disjunctive_proof;
?blank_proof : disjunctive_proof option;
}
<doc text="An answer to a question. It consists of a weight for each
choice, a proof that each of these weights is 0 or 1, and an overall
......
......@@ -46,6 +46,9 @@ let extractQuestion q =
try return (int_of_string x)
with _ -> failwith (error_msg ^ ": " ^ x ^ ".")
in
p2##querySelector (Js.string ".question_blank") >>= fun q_blank ->
Dom_html.CoerceTo.input q_blank >>= fun q_blank ->
let q_blank = if Js.to_bool q_blank##checked then Some true else None in
numeric ".question_min" "Invalid minimum number of choices" >>= fun q_min ->
numeric ".question_max" "Invalid maximum number of choices" >>= fun q_max ->
if not (q_min <= q_max) then
......@@ -58,7 +61,7 @@ let extractQuestion q =
let a = answers##item (i) >>= extractAnswer in
Js.Opt.get a (fun () -> failwith "extractQuestion"))
in
return {q_question; q_min; q_max; q_answers}
return {q_question; q_blank; q_min; q_max; q_answers}
let extractTemplate () =
let t_name = get_input "election_name" in
......@@ -131,7 +134,7 @@ let rec createQuestion q =
let insert_text = document##createTextNode (Js.string "Insert") in
let insert_btn = Dom_html.createButton document in
let f _ =
let x = createQuestion {q_question=""; q_min=0; q_max=1; q_answers=[||]} in
let x = createQuestion {q_question=""; q_blank=None; q_min=0; q_max=1; q_answers=[||]} in
container##parentNode >>= fun p ->
Dom.insertBefore p x (Js.some container);
return ()
......@@ -159,6 +162,15 @@ let rec createQuestion q =
let t = document##createTextNode (Js.string " answers.") in
Dom.appendChild x t;
Dom.appendChild container x;
(* is blank allowed? *)
let x = Dom_html.createDiv document in
let h_blank = Dom_html.createInput ~_type:(Js.string "checkbox") document in
h_blank##className <- Js.string "question_blank";
h_blank##checked <- Js.(match q.q_blank with Some true -> _true | _ -> _false);
Dom.appendChild x h_blank;
let t = document##createTextNode (Js.string "Blank vote is allowed") in
Dom.appendChild x t;
Dom.appendChild container x;
(* answers *)
let h_answers = Dom_html.createDiv document in
h_answers##className <- Js.string "question_answers";
......@@ -229,7 +241,7 @@ let createTemplate template =
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Add a question") in
let f _ =
let x = createQuestion {q_question=""; q_min=0; q_max=1; q_answers=[||]} in
let x = createQuestion {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;
......
......@@ -108,6 +108,8 @@ module type LocalizedStrings = sig
val number_accepted_ballots : string
val you_can_also_download : string
val result_with_crypto_proofs : string
val blank_vote : string
val no_other_blank : string
val mail_password_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
val mail_password : (string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
val mail_credential_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
......
......@@ -107,6 +107,8 @@ let election_archived = "This election is archived." (* FIXME *)
let number_accepted_ballots = "Number of accepted ballots: " (* FIXME *)
let you_can_also_download = "You can also download the " (* FIXME *)
let result_with_crypto_proofs = "result with cryptographic proofs" (* FIXME *)
let blank_vote = "Blank vote" (* FIXME *)
let no_other_blank = "No other choices are allowed when voting blank" (* FIXME *)
let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
......
......@@ -107,6 +107,8 @@ let election_archived = "This election is archived."
let number_accepted_ballots = "Number of accepted ballots: "
let you_can_also_download = "You can also download the "
let result_with_crypto_proofs = "result with cryptographic proofs"
let blank_vote = "Blank vote"
let no_other_blank = "No other choices are allowed when voting blank"
let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
......
......@@ -107,6 +107,8 @@ let election_archived = "Cette élection est archivée."
let number_accepted_ballots = "Nombre de bulletins acceptés : "
let you_can_also_download = "Vous pouvez également télécharger le "
let result_with_crypto_proofs = "résultat avec les preuves cryptographiques"
let blank_vote = "Vote blanc"
let no_other_blank = "Vous ne pouvez pas sélectionner d'autres choix lors d'un vote blanc"
let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
......
......@@ -107,6 +107,8 @@ let election_archived = "This election is archived." (* FIXME *)
let number_accepted_ballots = "Number of accepted ballots: " (* FIXME *)
let you_can_also_download = "You can also download the " (* FIXME *)
let result_with_crypto_proofs = "result with cryptographic proofs" (* FIXME *)
let blank_vote = "Blank vote" (* FIXME *)
let no_other_blank = "No other choices are allowed when voting blank" (* FIXME *)
let mail_password_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
......
......@@ -331,6 +331,7 @@ let create_new_election owner cred auth =
} in
let question = {
q_answers = [| "Answer 1"; "Answer 2"; "Blank" |];
q_blank = None;
q_min = 1;
q_max = 1;
q_question = "Question 1?";
......
......@@ -1151,13 +1151,20 @@ let election_home w state () =
return @@ div [
ul (List.mapi (fun i x ->
let answers = Array.to_list x.q_answers in
let answers = match x.q_blank with
| Some true -> L.blank_vote :: answers
| _ -> answers
in
let answers = List.mapi (fun j x ->
tr [td [pcdata x]; td [pcdata @@ string_of_int result.(i).(j)]]
) answers in
let answers =
match answers with
| [] -> pcdata ""
| x :: xs -> table (x :: xs)
| y :: ys ->
match x.q_blank with
| Some true -> table (ys @ [y])
| _ -> table (y :: ys)
in
li [
pcdata x.q_question;
......@@ -1982,6 +1989,8 @@ let booth () =
span ~a:[a_id "str_nothing"] [pcdata L.nothing];
span ~a:[a_id "enter_cred"] [pcdata L.enter_cred];
span ~a:[a_id "invalid_cred"] [pcdata L.invalid_cred];
span ~a:[a_id "str_blank_vote"] [pcdata L.blank_vote];
span ~a:[a_id "no_other_blank"] [pcdata L.no_other_blank];
];
]
in
......
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