Shamir.ml

(** MPC using Shamir sharing *)

(* Copyright Xavier Leroy.
   License: LGPL 2.1 or later with OCaml LGPL Linking Exception *)

open Printf

let p = 2147483647    (* prime number 2^31 - 1 *)

module M = Algebra.Int_p(struct let p = p end)
module P = Algebra.Polynomials(M)

type value = int
type share = M.t

(* Lagrange interpolation *)

module Interpolation = struct

  let lagrange_poly xi xs =
    List.fold_left
      (fun p xj ->
        if xj = xi then p else
          let d = M.(inv (xi - xj)) in
          let q = [M.(- xj * d); d] in   (* (X - xj) / (xi - xj) *)
          P.mul p q)
      P.one xs

(* [polynomial [x1...xN] [y1...yN] is the polynomial P of degree N-1
   such that P(x1) = y1 ... P(xN) = yN. *)

  let polynomial xs ys =
    List.fold_left2
      (fun p xi yi ->
        P.add p (P.scale yi (lagrange_poly xi xs)))
      P.zero xs ys

  let lagrange_coeff i n =
    let r = ref M.one in
    for k = 1 to n do
      if k <> i then r := M.(!r * k / (k - i))
    done;
    !r

(* [value_at_0 N [y1...yN]] is P(0) where P is the polynomial of degree N-1
   such that P(1) = y1 ... P(N) = yN. *)

  let value_at_0 n ys =
    let r = ref M.zero in
    for i = 1 to n do
      r := M.(!r + ys.(i - 1) * (lagrange_coeff i n))
    done;
    !r

end

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

(* The degree of polynomials.
   Must be < number of participants / 2 for multiplication to work. *)

let n = Multiparty.num_participants() - 1
let t = (n - 1) / 2

(* A Shamir sharing of a number x is P(1) ... P(n)
   where P is a polynomial of degree t with x as constant coefficient. *)

let sharing (x: M.t) : P.t =
  x :: List.init t (fun _ -> M.random ~rng)

let shares (x: M.t) : M.t array =
  let p = sharing x in
  Array.init n (fun i -> P.eval p (i + 1))

(* Recover the value x from a Shamir sharing of x. *)

let rec take n l =
  if n <= 0 then ([], l) else
    match l with
    | [] -> failwith "Shamir.take"
    | x :: l -> let (l1, l2) = take (n-1) l in (x :: l1, l2)

let unshare (sl: M.t list) : M.t =
  (* Rebuild the polynomial P by Lagrange interpolation from
     the t+1 shares. *)
  let xs = List.init (t + 1) (fun i -> i + 1)
  and (ys, zs) = take (t + 1) sl in
  let p = Interpolation.polynomial xs ys in
  (* Check that the remaining shares agree with P *)
  List.iteri
    (fun i y ->
      if P.eval p (t + 2 + i) <> y then
        Multiparty.log "Wrong point %d in sharing\n" (t + 2 + i))
    zs;
  (* The shared value is the constant coefficient of P *)
  P.constant p

(* Participant 0 sends a sharing of [x] to participants 1...N *)

let send (x: int) =
  match Multiparty.self() with
  | 0 ->
      let s = shares (M.of_int x) in
      for i = 0 to n - 1 do
        Multiparty.send_int (i + 1) s.(i)
      done
  | _ ->
      assert false

(* Participants 1...N receive a share from participant 0 *)

let receive () : M.t =
  Multiparty.receive_int 0

(* Each participant [i] shares its value [xi] with all the participants.
   The result is a vector of shares for the N values [x1,...xN]. *)

let share (x: M.t) : M.t array =
  Multiparty.alltoall_int (shares x)

(* Participants 1 to N put their shares of [x] in common,
   so that they all learn the value of [x]. *)

let reveal (x: M.t) : int =
  let sh = Multiparty.allgather_int x in
  unshare (Array.to_list sh)

(* Constants *)

let of_int (n: int) = M.of_int n

(* Linear operations *)

let add = M.add
let neg = M.neg
let scale n x = M.mul (M.of_int n) x

(* Multiplication *)

let mul (x: M.t) (y: M.t) =
  let z = share (M.mul x y) in
  (* There's a polynomial A of degree t corresponding to the x shares
     and a polynomial B of degree t corresponding to the y shares.
     AB has degree 2t, and AB(0) = the desired product xy.
     We distribute shares of AB(1) ... AB(n) and use them to
     build shares of AB(0) by Lagrange interpolation.
     This assumes 2t + 1 <= n. *)
  Interpolation.value_at_0 n z

(* Multiparty evaluation of a polynomial *)

let poly_eval (p: P.t) (x: M.t) =
  List.fold_left
    (fun acc c -> add (mul acc x) c)
    (of_int 0) (List.rev p)

(* Boolean gates using polynomials *)

(* not x = 1 - x *)

let not x = add (of_int 1) (neg x)

(* and x y = P (x + y)  where P(0) = P(1) = 0 and P(2) = 1 *)

let poly_and =
  Interpolation.polynomial
    M.[of_int 0; of_int 1; of_int 2]
    M.[of_int 0; of_int 0; of_int 1]

let and_ x y = poly_eval poly_and (add x y)

(* or x y = P (x + y)  where P(0) = 0 and P(1) = P(2) = 1 *)

let poly_or =
  Interpolation.polynomial
    M.[of_int 0; of_int 1; of_int 2]
    M.[of_int 0; of_int 1; of_int 1]

let or_ x y = poly_eval poly_or (add x y)

(* xor x y = P (x + y)  where P(0) = 0  P(1) = 1  P(2) = 0 *)

let poly_xor =
  Interpolation.polynomial
    M.[of_int 0; of_int 1; of_int 2]
    M.[of_int 0; of_int 1; of_int 0]

let xor x y = poly_eval poly_xor (add x y)

(* Carry-out of a full adder: cout x y cin = P (x + y + cin) where
     P(0) = P(1) = 0   P(2) = P(3) = 1 *)

let poly_carry_out =
  Interpolation.polynomial
    M.[of_int 0; of_int 1; of_int 2; of_int 3]
    M.[of_int 0; of_int 0; of_int 1; of_int 1]

let carry_out x y cin = poly_eval poly_carry_out (add (add x y) cin)