Commit e96d4387 authored by Stephane Glondu's avatar Stephane Glondu

Add support for threshold decryption (backend)

 - no encryption for now
 - no support in belenios-tool.html
parent f366ac80
......@@ -6,6 +6,7 @@ all:
check: all
demo/demo.sh
demo/demo-threshold.sh
clean:
ocamlbuild -clean
......
#!/bin/bash
set -e
export BELENIOS_USE_URANDOM=1
BELENIOS=${BELENIOS:-$PWD}
belenios-tool () {
$BELENIOS/_build/belenios-tool "$@"
}
header () {
echo
echo "=-=-= $1 =-=-="
echo
}
header "Setup election"
UUID=`uuidgen`
echo "UUID of the election is $UUID"
DIR=$BELENIOS/demo/data/$UUID
mkdir $DIR
cd $DIR
# Common options
uuid="--uuid $UUID"
group="--group $BELENIOS/demo/groups/default.json"
# Generate credentials
belenios-tool credgen $uuid $group --count 5
mv *.pubcreds public_creds.txt
mv *.privcreds private_creds.txt
# Generate trustee keys
ttkeygen () {
belenios-tool threshold-trustee-keygen $group "$@"
}
ttkeygen --step 1
ttkeygen --step 1
ttkeygen --step 1
cat *.cert > certs.jsons
ttkeygen --certs certs.jsons --step 2
for u in *.key; do
ttkeygen --certs certs.jsons --key $u --step 3 --threshold 2
done > polynomials.jsons
ttkeygen --certs certs.jsons --step 4 --polynomials polynomials.jsons
for u in *.key; do
b=${u%.key}
ttkeygen --certs certs.jsons --key $u --step 5 < $b.vinput > $b.voutput
done
cat *.voutput | ttkeygen --certs certs.jsons --step 6 --polynomials polynomials.jsons > threshold.json
# Generate election parameters
belenios-tool mkelection $uuid $group --template $BELENIOS/demo/templates/questions.json
header "Simulate votes"
cat > votes.txt <<EOF
[[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
belenios-tool vote --privcred <(echo "$cred") --ballot <(echo "$vote")
echo "Voter $id voted" >&2
echo >&2
done > ballots.tmp
mv ballots.tmp ballots.jsons
header "Perform verification"
belenios-tool verify
header "Simulate and verify update"
tdir="$(mktemp -d)"
cp election.json threshold.json public_creds.txt "$tdir"
head -n3 ballots.jsons > "$tdir/ballots.jsons"
belenios-tool verify-diff --dir1="$tdir" --dir2=.
rm -rf "$tdir"
header "Perform decryption"
for u in *.key; do
belenios-tool threshold-decrypt --key $u --decryption-key ${u%.key}.dkey
echo >&2
done > partial_decryptions.tmp
head -n2 partial_decryptions.tmp > partial_decryptions.jsons
header "Finalize tally"
belenios-tool finalize
header "Perform final verification"
belenios-tool verify
echo
echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-="
echo
echo "The simulated election was successful! Its result can be seen in"
echo " $DIR/result.json"
echo
echo "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-="
echo
......@@ -123,6 +123,17 @@ module Array = struct
let ssplit a =
mmap fst a, mmap snd a
let findi f a =
let n = Array.length a in
let rec loop i =
if i < n then
match f i a.(i) with
| None -> loop (i+1)
| Some _ as x -> x
else None
in loop 0
end
module String = struct
......
......@@ -40,6 +40,7 @@ module Array : sig
val mmap3 : ('a -> 'b -> 'c -> 'd) ->
'a array array -> 'b array array -> 'c array array -> 'd array array
val ssplit : ('a * 'b) array array -> 'a array array * 'b array array
val findi : (int -> 'a -> 'b option) -> 'a array -> 'b option
end
module String : sig
......
......@@ -563,11 +563,10 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
type result = elt Serializable_t.result
let combine_factors num_tallied encrypted_tally partial_decryptions =
let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in
let factors = Array.fold_left (fun a b ->
Array.mmap2 ( *~ ) a b.decryption_factors
) dummy partial_decryptions in
type combinator = factor array -> elt array array
let combine_factors num_tallied encrypted_tally partial_decryptions combinator =
let factors = combinator partial_decryptions in
let results = Array.mmap2 (fun {beta; _} f ->
beta / f
) encrypted_tally factors in
......@@ -588,17 +587,14 @@ module MakeElection (G : GROUP) (M : RANDOM) = struct
let result = Array.mmap log results in
{num_tallied; encrypted_tally; partial_decryptions; result}
let check_result pks r =
let check_result combinator pks r =
let {encrypted_tally; partial_decryptions; result; _} = r in
check_ciphertext encrypted_tally &&
(* decryption factors may be not in the same order as pks! *)
Array.forall (fun pk ->
Array.exists (check_factor encrypted_tally pk) partial_decryptions
) pks &&
let dummy = Array.mmap (fun _ -> G.one) encrypted_tally in
let factors = Array.fold_left (fun a b ->
Array.mmap2 ( *~ ) a b.decryption_factors
) dummy partial_decryptions in
Array.forall (fun pd ->
Array.exists (fun pk -> check_factor encrypted_tally pk pd) pks
) partial_decryptions &&
let factors = combinator partial_decryptions in
let results = Array.mmap2 (fun {beta; _} f ->
beta / f
) encrypted_tally factors in
......
......@@ -128,3 +128,71 @@ type 'a result = {
partial_decryptions : 'a partial_decryption list <ocaml repr="array">;
result : plaintext;
}
(** {2 Channel messages support} *)
type 'a raw_channel_msg = {
recipient : 'a;
message : string;
} <ocaml field_prefix="raw_">
type channel_msg = {
message : string; (* raw_channel_msg *)
signature : proof;
} <ocaml field_prefix="channel_">
(** {2 Threshold decryption support} *)
type 'a cert_keys = {
verification : 'a;
encryption : 'a;
} <ocaml field_prefix="cert_">
type cert = {
keys : string; (* cert_keys *)
signature : proof;
} <ocaml field_prefix="cert_">
type certs = {
certs : cert list <ocaml repr="array">;
}
type raw_polynomial = number list <ocaml repr="array">
type 'a raw_coefexps = 'a list <ocaml repr="array">
type coefexps = {
coefexps : string; (* raw_coefexps *)
signature : proof;
} <ocaml field_prefix="ce_">
type secret = {
secret : number;
}
type polynomial = {
polynomial : string; (* sent raw_polynomial *)
secrets : string list <ocaml repr="array">; (* sent secrets *)
coefexps : coefexps;
} <ocaml field_prefix="p_">
type vinput = {
polynomial : string; (* sent raw_polynomial *)
secrets : string list <ocaml repr="array">; (* sent secrets *)
coefexps : coefexps list <ocaml repr="array">;
} <ocaml field_prefix="vi_">
type partial_decryption_key = {
decryption_key : number;
} <ocaml field_prefix="pdk_">
type 'a voutput = {
private_key : string; (* sent partial_decryption_key *)
public_key : 'a trustee_public_key;
} <ocaml field_prefix="vo_">
type 'a threshold_parameters = {
threshold : int;
certs : cert list <ocaml repr="array">;
coefexps : coefexps list <ocaml repr="array">;
verification_keys : 'a trustee_public_key list <ocaml repr="array">;
} <ocaml field_prefix="t_">
......@@ -223,13 +223,56 @@ module type ELECTION = sig
(** The election result. It contains the needed data to validate the
result from the encrypted tally. *)
val combine_factors : int -> ciphertext -> factor array -> result
type combinator = factor array -> elt array array
val combine_factors : int -> ciphertext -> factor array -> combinator -> result
(** Combine the encrypted tally and the factors from all trustees to
produce the election result. The first argument is the number of
tallied ballots. May raise [Invalid_argument]. *)
val check_result : public_key array -> result -> bool
val check_result : combinator -> public_key array -> result -> bool
val extract_tally : result -> plaintext
(** Extract the plaintext result of the election. *)
end
module type PKI = sig
type 'a m
type private_key
type public_key
val genkey : unit -> string m
val derive_sk : string -> private_key
val derive_dk : string -> private_key
val sign : private_key -> string -> proof m
val verify : public_key -> string -> proof -> bool
val encrypt : public_key -> string -> string m
val decrypt : private_key -> string -> string
val make_cert : sk:private_key -> dk:private_key -> cert m
val verify_cert : cert -> bool
end
module type CHANNELS = sig
type 'a m
type private_key
type public_key
val send : private_key -> public_key -> string -> string m
val recv : private_key -> public_key -> string -> string
end
module type PEDERSEN = sig
type 'a m
type elt
val step1 : unit -> (string * cert) m
val step2 : certs -> unit
val step3 : certs -> string -> int -> polynomial m
val step4 : certs -> polynomial array -> vinput array
val step5 : certs -> string -> vinput -> elt voutput m
val step6 : certs -> polynomial array -> elt voutput array -> elt threshold_parameters
val check : elt threshold_parameters -> bool
val combine : elt threshold_parameters -> elt
type checker = elt -> elt partial_decryption -> bool
val combine_factors : checker -> elt threshold_parameters -> elt partial_decryption array -> elt array array
end
......@@ -20,7 +20,7 @@
(**************************************************************************)
open Platform
open Serializable_t
open Serializable_j
open Signatures
open Common
......@@ -69,4 +69,372 @@ module MakeSimpleDistKeyGen (G : GROUP) (M : RANDOM) = struct
y *~ trustee_public_key
) G.one pks
let combine_factors pds =
assert (Array.length pds > 0);
let dummy = Array.mmap (fun _ -> G.one) pds.(0).decryption_factors in
Array.fold_left (fun a b ->
Array.mmap2 ( *~ ) a b.decryption_factors
) dummy pds
end
module MakePKI (G : GROUP) (M : RANDOM) = struct
type 'a m = 'a M.t
type private_key = Z.t
type public_key = G.t
let genkey () =
let b58_digits = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" in
let n = 22 and z58 = Z.of_int 58 in
let res = Bytes.create n in
let rec loop i =
if i < n then
M.bind (M.random z58) (fun x ->
Bytes.set res i b58_digits.[Z.to_int x];
loop (i+1)
)
else M.return (Bytes.to_string res)
in loop 0
let derive_sk p =
Z.of_string_base 16 (sha256_hex ("sk|" ^ p))
let derive_dk p =
Z.of_string_base 16 (sha256_hex ("dk|" ^ p))
let sign sk msg =
M.bind (M.random G.q) (fun w ->
let commitment = G.(g **~ w) in
let prefix = "sigmsg|" ^ msg ^ "|" in
let challenge = G.hash prefix [|commitment|] in
let response = Z.(erem (w - sk * challenge) G.q) in
M.return { challenge; response }
)
let verify vk msg { challenge; response } =
check_modulo G.q challenge &&
check_modulo G.q response &&
let commitment = G.(g **~ response *~ vk **~ challenge) in
let prefix = "sigmsg|" ^ msg ^ "|" in
Z.(challenge =% G.hash prefix [|commitment|])
let encrypt y s =
M.return s
let decrypt x s =
s
let make_cert ~sk ~dk =
let cert_keys = {
cert_verification = G.(g **~ sk);
cert_encryption = G.(g **~ dk);
} in
let cert_keys = string_of_cert_keys G.write cert_keys in
M.bind (sign sk cert_keys) (fun cert_signature ->
M.return { cert_keys; cert_signature }
)
let verify_cert { cert_keys; cert_signature } =
let keys = cert_keys_of_string G.read cert_keys in
verify keys.cert_verification cert_keys cert_signature
end
module MakeChannels (G : GROUP) (M : RANDOM)
(P : PKI with type 'a m = 'a M.t
and type private_key = Z.t
and type public_key = G.t) = struct
type 'a m = 'a P.m
type private_key = P.private_key
type public_key = P.public_key
let send sk raw_recipient raw_message =
let msg = { raw_recipient; raw_message } in
let channel_message = string_of_raw_channel_msg G.write msg in
M.bind (P.sign sk channel_message) (fun channel_signature ->
let msg = { channel_message; channel_signature } in
P.encrypt raw_recipient (string_of_channel_msg msg)
)
let recv dk vk msg =
let msg = P.decrypt dk msg |> channel_msg_of_string in
let { channel_message; channel_signature } = msg in
if not (P.verify vk channel_message channel_signature) then
failwith "invalid signature on received message";
let msg = raw_channel_msg_of_string G.read channel_message in
let { raw_recipient; raw_message } = msg in
if not G.(raw_recipient =~ g **~ dk) then
failwith "invalid recipient on received message";
raw_message
end
exception PedersenFailure of string
module MakePedersen (G : GROUP) (M : RANDOM)
(P : PKI with type 'a m = 'a M.t
and type private_key = Z.t
and type public_key = G.t)
(C : CHANNELS with type 'a m = 'a M.t
and type private_key = Z.t
and type public_key = G.t) = struct
type 'a m = 'a M.t
type elt = G.t
open G
let (>>=) = M.bind
module K = MakeSimpleDistKeyGen (G) (M)
let compute_verification_keys coefexps =
let n = Array.length coefexps in
assert (n > 0);
let threshold = Array.length coefexps.(0) in
assert (threshold > 0);
Array.init n (fun j ->
let jj = Z.of_int (j+1) in
let rec loop_compute_vk i vk =
if i < n then
let c = coefexps.(i) in
assert (threshold = Array.length c);
let rec loop k jk accu =
if k < threshold then
loop (k+1) Z.(jk * jj) (accu *~ (c.(k) **~ jk))
else accu
in
let computed_gsij = loop 0 Z.one one in
loop_compute_vk (i+1) (vk *~ computed_gsij)
else vk
in
loop_compute_vk 0 one
)
let check t =
Array.forall P.verify_cert t.t_certs &&
let certs = Array.map (fun x -> cert_keys_of_string G.read x.cert_keys) t.t_certs in
Array.forall2 (fun cert { ce_coefexps; ce_signature } ->
P.verify cert.cert_verification ce_coefexps ce_signature
) certs t.t_coefexps &&
let coefexps = Array.map (fun x -> raw_coefexps_of_string G.read x.ce_coefexps) t.t_coefexps in
Array.forall K.check t.t_verification_keys &&
let computed_vks = compute_verification_keys coefexps in
t.t_threshold = Array.length coefexps.(0) &&
Array.forall2 (fun vk computed_vk ->
vk.trustee_public_key =~ computed_vk
) t.t_verification_keys computed_vks
type checker = elt -> elt partial_decryption -> bool
let lagrange indexes j =
List.fold_left (fun accu k ->
let kj = k - j in
if kj = 0 then accu
else Z.(accu * (of_int k) * invert (of_int kj) q mod q)
) Z.one indexes
let combine_factors checker t pds =
assert (Array.length pds > 0);
let dummy = Array.mmap (fun _ -> G.one) pds.(0).decryption_factors in
let pds_with_ids =
List.map (fun pd ->
match Array.findi (fun i vk ->
if checker vk.trustee_public_key pd then Some i else None
) t.t_verification_keys
with
| Some i -> i+1, pd
| None -> raise (PedersenFailure "a partial decryption does not correspond to any verification key")
) (Array.to_list pds)
in
let pds_with_ids =
let compare (a, _) (b, _) = Pervasives.compare a b in
List.sort_uniq compare pds_with_ids
in
let rec take n accu xs =
if n > 0 then
match xs with
| [] -> raise (PedersenFailure "not enough partial decryptions")
| x :: xs -> take (n-1) (x :: accu) xs
else accu
in
let pds_with_ids = take t.t_threshold [] pds_with_ids in
let indexes = List.map fst pds_with_ids in
List.fold_left (fun a (j, b) ->
let l = lagrange indexes j in
Array.mmap2 (fun x y -> x *~ y **~ l) a b.decryption_factors
) dummy pds_with_ids
let combine t =
t.t_coefexps
|> Array.map (fun x -> raw_coefexps_of_string G.read x.ce_coefexps)
|> Array.fold_left (fun accu x -> G.(accu *~ x.(0))) G.one
let step1 () =
P.genkey () >>= fun seed ->
let sk = P.derive_sk seed in
let dk = P.derive_dk seed in
P.make_cert ~sk ~dk >>= fun cert ->
M.return (seed, cert)
let step2 {certs} =
Array.iteri (fun i cert ->
if P.verify_cert cert then ()
else
let msg = Printf.sprintf "certificate %d does not validate" (i+1) in
raise (PedersenFailure msg)
) certs
let eval_poly polynomial x =
let cur = ref Z.one and res = ref Z.zero in
for i = 0 to Array.length polynomial - 1 do
res := Z.(!res + !cur * polynomial.(i) mod q);
cur := Z.(!cur * x mod q);
done;
!res
let step3 certs seed threshold =
let n = Array.length certs.certs in
let () = step2 certs in
let certs = Array.map (fun x -> cert_keys_of_string G.read x.cert_keys) certs.certs in
let sk = P.derive_sk seed and dk = P.derive_dk seed in
let vk = g **~ sk and ek = g **~ dk in
let i =
Array.findi (fun i cert ->
if cert.cert_verification =~ vk && cert.cert_encryption =~ ek
then Some (i+1) else None
) certs
in
let () = match i with
| None -> raise (PedersenFailure "could not find my certificate")
| Some _ -> ()
in
let polynomial = Array.make threshold Z.zero in
let rec fill_polynomial i =
if i < threshold then
M.random q >>= fun a ->
polynomial.(i) <- a;
fill_polynomial (i+1)
else M.return ()
in fill_polynomial 0 >>= fun () ->
C.send sk ek (string_of_raw_polynomial polynomial) >>= fun p_polynomial ->
let coefexps = Array.map (fun x -> g **~ x) polynomial in
let ce_coefexps = string_of_raw_coefexps G.write coefexps in
P.sign sk ce_coefexps >>= fun ce_signature ->
let p_coefexps = {ce_coefexps; ce_signature} in
let p_secrets = Array.make n "" in
let rec fill_secrets j =
if j < n then
let secret = eval_poly polynomial (Z.of_int (j+1)) in
let secret = string_of_secret {secret} in
C.send sk certs.(j).cert_encryption secret >>= fun x ->
p_secrets.(j) <- x;
fill_secrets (j+1)
else M.return ()
in fill_secrets 0 >>= fun () ->
M.return {p_polynomial; p_secrets; p_coefexps}
let step4 certs polynomials =
let n = Array.length certs.certs in
let () = step2 certs in
assert (n = Array.length polynomials);
let certs = Array.map (fun x -> cert_keys_of_string G.read x.cert_keys) certs.certs in
let vi_coefexps = Array.map (fun x -> x.p_coefexps) polynomials in
Array.iteri (fun i {ce_coefexps; ce_signature} ->
if P.verify certs.(i).cert_verification ce_coefexps ce_signature then ()
else
let msg = Printf.sprintf "coefexps %d does not validate" (i+1) in
raise (PedersenFailure msg)
) vi_coefexps;
Array.init n (fun j ->
let vi_polynomial = polynomials.(j).p_polynomial in
let vi_secrets = Array.init n (fun i -> polynomials.(i).p_secrets.(j)) in
{vi_polynomial; vi_secrets; vi_coefexps}
)
let step5 certs seed vinput =
let n = Array.length certs.certs in
let () = step2 certs in
let certs = Array.map (fun x -> cert_keys_of_string G.read x.cert_keys) certs.certs in
let sk = P.derive_sk seed and dk = P.derive_dk seed in
let vk = g **~ sk and ek = g **~ dk in
let j =
Array.findi (fun i cert ->
if cert.cert_verification =~ vk && cert.cert_encryption =~ ek
then Some (i+1) else None
) certs
in
let j = match j with
| None -> raise (PedersenFailure "could not find my certificate")
| Some i -> Z.of_int i
in
let polynomial = C.recv dk vk vinput.vi_polynomial |> raw_polynomial_of_string in
let threshold = Array.length polynomial in
assert (n = Array.length vinput.vi_secrets);
let secrets =
Array.init n (fun i ->
let x = C.recv dk certs.(i).cert_verification vinput.vi_secrets.(i) in
(secret_of_string x).secret
)
in
assert (n = Array.length vinput.vi_coefexps);
let coefexps =
Array.init n (fun i ->
let { ce_coefexps; ce_signature } = vinput.vi_coefexps.(i) in
if not (P.verify certs.(i).cert_verification ce_coefexps ce_signature) then
raise (PedersenFailure (Printf.sprintf "coefexps %d does not validate" (i+1)));
let res = raw_coefexps_of_string G.read ce_coefexps in
assert (Array.length res = threshold);
res
)
in
for i = 0 to n-1 do
let c = coefexps.(i) in
let rec loop k jk accu =
if k < threshold then
loop (k+1) Z.(jk * j) (accu *~ (c.(k) **~ jk))
else accu
in
let computed_gsij = loop 0 Z.one one in
if not (g **~ secrets.(i) =~ computed_gsij) then
raise (PedersenFailure (Printf.sprintf "secret %d does not validate" (i+1)));
done;
let pdk_decryption_key = Array.fold_left Z.(+) Z.zero secrets in
let pdk = string_of_partial_decryption_key {pdk_decryption_key} in
M.bind (K.prove pdk_decryption_key) (fun vo_public_key ->
M.bind (C.send sk ek pdk) (fun vo_private_key ->
M.return { vo_public_key; vo_private_key }
)
)
let step6 certs polynomials voutputs =
let n = Array.length certs.certs in
let () = step2 certs in
let t_certs = certs.certs in
let certs = Array.map (fun x -> cert_keys_of_string G.read x.cert_keys) t_certs in
assert (n = Array.length polynomials);
assert (n = Array.length voutputs);
let coefexps =
Array.init n (fun i ->
let { ce_coefexps; ce_signature } = polynomials.(i).p_coefexps in
if not (P.verify certs.(i).cert_verification ce_coefexps ce_signature) then
raise (PedersenFailure (Printf.sprintf "coefexps %d does not validate" (i+1)));
raw_coefexps_of_string G.read ce_coefexps
)
in
let computed_vks = compute_verification_keys coefexps in
for j = 0 to n - 1 do
let voutput = voutputs.(j) in
if not (K.check voutput.vo_public_key) then
raise (PedersenFailure (Printf.sprintf "pok %d does not validate" (j+1)));
if not (voutput.vo_public_key.trustee_public_key =~ computed_vks.(j)) then
raise (PedersenFailure (Printf.sprintf "verification key %d is incorrect" (j+1)));
done;
{
t_threshold = Array.length coefexps.(0);
t_certs;
t_coefexps = Array.map (fun x -> x.p_coefexps) polynomials;
t_verification_keys = Array.map (fun x -> x.vo_public_key) voutputs;
}
end
......@@ -43,5 +43,32 @@ module MakeSimpleDistKeyGen (G : GROUP) (M : RANDOM) : sig
val combine : G.t trustee_public_key array -> G.t
(** Combine all public key shares into an election public key. *)
val combine_factors : G.t partial_decryption array -> G.t array array
end
(** Simple distributed generation of an election public key. *)
module MakePKI (G : GROUP) (M : RANDOM) :
PKI with type 'a m = 'a M.t
and type private_key = Z.t
and type public_key = G.t