Beaver.ml

(* MPC with two participants and Boolean gates,
   using the multiplicative triples of Beaver 1991 *)

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

open Printf

type share = bool

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

let random_bool () =
  let s = Cryptokit.Random.(string rng 1) in
  (String.get_uint8 s 0) land 1 = 1

(* Sharings of [false] and [true].
   [ [false] ] is [ false, false ].
   [ [true]  ] is [ true,  false ]. *)

let false_ = false

let true_ = Multiparty.self() = 1

(* Local Boolean operations *)

let xor (x: bool) (y: bool) =
  x <> y

let not (x: bool) =
  xor x true_

(* Participant 0 sends a sharing of [b] to participants 1 and 2 *)

let send (b: bool) =
  match Multiparty.self() with
  | 0 ->
      let m = random_bool() in
      Multiparty.send 1 m;
      Multiparty.send 2 (xor b m)
  | _ ->
      assert false

(* Participants 1 and 2 receive a share from participant 0 *)

let receive () : bool =
  match Multiparty.self() with
  | 1 | 2 ->
      (Multiparty.receive 0 : bool)
  | _ ->
      assert false

(* Participant 1 shares b1 with participant 2,
   while participant 2 shares b2 with participant 1.
   The return value is a pair (share of b1, share of b2). *)

let share (b: bool) : bool * bool =
  let m = random_bool() in
  match Multiparty.self() with
  | 1 ->
      Multiparty.send 2 m;
      let b' : bool = Multiparty.receive 2 in
      (xor b m, b')
  | 2 ->
      let b' : bool = Multiparty.receive 1 in
      Multiparty.send 1 m;
      (b', xor b m)
  | _ ->
      assert false

(* Participants 1 and 2 put their shares of [b] in common,
   so that both learn the value of [b]. *)

let reveal (b: bool) : bool =
  match Multiparty.self() with
  | 1 ->
      Multiparty.send 2 b;
      let b' = Multiparty.receive 2 in
      xor b b'
  | 2 ->
      let b' = Multiparty.receive 1 in
      Multiparty.send 1 b;
      xor b b'
  | _ ->
      assert false

(* Beaver triples: shares of random [a], [b], [c] such that [c = a & b]. *)

let triples: (bool * bool * bool) list ref = ref []

(* AND using triples *)

let and_ (x: bool) (y: bool) =
  let (a, b, c) =
    match !triples with
    | [] -> failwith "Beaver: out of triples!"
    | t :: tl -> triples := tl; t in
  let ax = xor a x and by = xor b y in
  let (d, e) =
    match Multiparty.self() with
    | 1 ->
        Multiparty.send 2 (ax, by);
        let (ax', by' : bool * bool) = Multiparty.receive 2 in
        (xor ax ax', xor by by')
    | 2 ->
        let (ax', by' : bool * bool) = Multiparty.receive 1 in
        Multiparty.send 1 (ax, by);
        (xor ax ax', xor by by')
    | _ ->
        assert false in
  xor (xor (d && y) (a && e)) c

(* Other non-linear gates *)

let nand x y = not (and_ x y)
let or_ x y = nand (not x) (not y)
let nor x y = and_ (not x) (not y)

(* Generate triples using participant #0 as the trusted third party *)

let make_triple () =
  let a = random_bool() and b = random_bool() in
  let c = a && b in
  let ma = random_bool() and mb = random_bool() and mc = random_bool() in
  ((ma, mb, mc), (xor a ma, xor b mb, xor c mc))

let initialize num_triples =
  match Multiparty.self() with
  | 0 ->
      let (t1, t2) =
        List.split (List.init num_triples (fun _ -> make_triple ())) in
      Multiparty.send 1 t1;
      Multiparty.send 2 t2
  | 1 | 2 ->
      triples := Multiparty.receive 0
  | _ ->
      ()