Threshold.ml

(** Threshold decryption *)

(* Copyright Xavier Leroy.  License: GPL 2 or later *)

open Printf
open Cryptokit
open Algebra

let rng = Random.(pseudo_rng (string secure_rng 32))

module M = Z_p(struct let p = Z.succ Group5.order end)
module R = Replicated23.Make(M)
module EG = ElGamal.Make(Group5)

(* Given three optional shares, with at most one empty share,
   recover the three components of the secret *)

let extract s1 s2 s3 =
  let x = Array.make 3 None in
  let set i xi =
    match x.(i - 1) with
    | None ->
        x.(i - 1) <- Some xi
    | Some yi ->
        if xi <> yi then Multiparty.log "Wrong point %d in sharing\n" i in
  begin match s1 with None -> () | Some(x1, x2) -> set 1 x1; set 2 x2 end;
  begin match s2 with None -> () | Some(x2, x3) -> set 2 x2; set 3 x3 end;
  begin match s3 with None -> () | Some(x3, x1) -> set 3 x3; set 1 x1 end;
  match x with
  | [| Some x1; Some x2; Some x3 |] -> (x1, x2, x3)
  | _ -> failwith "Threshold.extract: not enough points"

(* Put shares in common and extract the components of the secret *)

let reveal_components (s: R.share option) : R.value * R.value * R.value =
  match Multiparty.self() with
  | 1 ->
      Multiparty.send 2 s;
      Multiparty.send 3 s;
      let t2 : R.share option = Multiparty.receive 2 in
      let t3 : R.share option = Multiparty.receive 3 in
      extract s t2 t3
  | 2 ->
      Multiparty.send 3 s;
      let t1 : R.share option = Multiparty.receive 1 in
      Multiparty.send 1 s;
      let t3 : R.share option = Multiparty.receive 3 in
      extract t1 s t3
  | 3 ->
      let t1 : R.share option = Multiparty.receive 1 in
      let t2 : R.share option = Multiparty.receive 2 in
      Multiparty.send 1 s;
      Multiparty.send 2 s;
      extract t1 t2 s
  | _ ->
      assert false

(* Multiparty computation of [a^x].
   Each participant has a share of [x].
   One participant (but no more) can opt not to reveal its share.
   All participants learn the value of [g^x]. *)

let exponentiation a x =
  let gx =
    match x with
    | None -> None
    | Some(x1, x2) -> Some(M.(a ** x1), M.(a ** x2)) in
  let (gx1, gx2, gx3) = reveal_components gx in
  M.(gx1 * gx2 * gx3)

(* Shareholders are participants 1, 2, 3. *)

let shareholder n =
  (* The shareholders jointly draw a secret key.
     Each shareholder has a share of this key. *)
  let s =
    let (s1, s2, s3) = R.share (M.random ~rng) in
    R.add s1 (R.add s2 s3) in
  (* The shareholder reveal the public key [g^s] and send it
     to the client. *)
  let pk = exponentiation Group5.generator (Some s) in
  Multiparty.send 0 pk;
  (* Joint decryption of [n] ciphertexts *)
  for i = 0 to n - 1 do
    let (a, b) : EG.ciphertext = Multiparty.receive 0 in
    (* Choose whether to participate in the decryption *)
    let maybe_s =
      if i = 0 || i mod 3 <> Multiparty.self() - 1 then begin
        Multiparty.log "participates in decryption\n";
        Some s
      end else begin
        Multiparty.log "is not available\n";
        None
      end in
    (* Joint computation of a^s *)
    let a_s = exponentiation a maybe_s in
    (* Decryption *)
    let p = M.(b / a_s) in
    Multiparty.log "cleartext is %S\n" (M.to_bytes p)
  done

(* Client is participant 0 *)

let client msgs =
  (* Get the public key *)
  let pk  : EG.public_key = Multiparty.receive 1
  and pk2 : EG.public_key = Multiparty.receive 2
  and pk3 : EG.public_key = Multiparty.receive 3 in
  Multiparty.log "received public key\n";
  if pk2 <> pk || pk3 <> pk then
    Multiparty.log "public key is inconsistent\n";
  List.iter
    (fun msg ->
      Multiparty.log "encrypting %S\n" msg;
      let c = EG.encrypt ~rng pk (M.of_bytes msg) in
      for i = 1 to 3 do Multiparty.send i c done)
    msgs

let _ =
  if Multiparty.num_participants() < 4
  || Array.length Sys.argv < 2 then begin
      if Multiparty.self() = 0 then
        printf "Usage: mpirun -np 4 ./Threshold.exe <word 1> <word 2> ...\n";
      exit 2
  end;
  begin match Multiparty.self() with
  | 0 -> client (List.tl (Array.to_list Sys.argv))
  | 1 | 2 | 3 -> shareholder (Array.length Sys.argv - 1)
  | _ -> ()
  end;
  Multiparty.barrier()