<commit_before>(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
(*  Copyright © 2012-2019 Inria                                           *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful, but   *)
(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

open Platform
open Common
open Serializable_core_t
open Signatures

module Make (M : RANDOM) (G : GROUP) = struct
  open G
  let ( >>= ) = M.bind

  let randoms n =
    let res = Array.make n Z.zero in
    let rec loop i =
      if i < n then
        M.random G.q >>= fun x ->
        res.(i) <- x;
        loop (succ i)
      else
        M.return res
    in
    loop 0

  let gen_permutation n =
    let tmp = Array.init n (fun i -> i) in
    let psi = Array.make n 0 in
    let rec loop i =
      if i < n then
        M.random (Z.of_int Pervasives.(n - i)) >>= fun k ->
        let k = Pervasives.(Z.to_int k + i) in
        psi.(i) <- tmp.(k);
        tmp.(k) <- tmp.(i);
        loop (succ i)
      else
        M.return psi
    in
    loop 0

  let re_encrypt y {alpha; beta} r =
    {
      alpha = alpha *~ (g **~ r);
      beta = beta *~ (y **~ r);
    }

  let gen_shuffle y e =
    let n = Array.length e in
    gen_permutation n >>= fun psi ->
    randoms n >>= fun r ->
    let e = Array.map2 (re_encrypt y) e r in
    let e = Array.init n (fun i -> e.(psi.(i))) in
    M.return (e, r, psi)

  let gen_permutation_commitment psi h =
    let n = Array.length psi in
    let c = Array.make n G.one and r = Array.make n Z.zero in
    let rec loop i =
      if i < n then
        M.random G.q >>= fun r_ ->
        r.(psi.(i)) <- r_;
        c.(psi.(i)) <- (g **~ r_) *~ h.(i);
        loop (succ i)
      else
        M.return (c, r)
    in loop 0

  let get_nizkp_challenges n str =
    let h = sha256_hex str in
    Array.init n (fun i ->
        let i = sha256_hex (string_of_int i) in
        Z.(of_string_base 16 (sha256_hex (h ^ i)) mod G.q)
      )

  let get_nizkp_challenge str =
    let h = sha256_hex str in
    Z.(of_string_base 16 h mod G.q)

  let str_egs e =
    let b = Buffer.create 1024 in
    for i = 0 to pred (Array.length e) do
      let {alpha; beta} = e.(i) in
      Printf.bprintf b "%s,%s," (G.to_string alpha) (G.to_string beta);
    done;
    Buffer.contents b

  let str_elts c =
    let b = Buffer.create 1024 in
    for i = 0 to pred (Array.length c) do
      Printf.bprintf b "%s," (G.to_string c.(i));
    done;
    Buffer.contents b

  let gen_commitment_chain c0 uu =
    let n = Array.length uu in
    randoms n >>= fun rr ->
    let cc = Array.make n G.one in
    for i = 0 to pred n do
      let ccpred = if i = 0 then c0 else cc.(pred i) in
      cc.(i) <- (g **~ rr.(i)) *~ (ccpred **~ uu.(i));
    done;
    M.return (cc, rr)

  module GMap = Map.Make (G)

  let make_get_generator_indep () =
    let to_avoid = ref GMap.empty in
    fun n ->
    let x = G.get_generator n in
    match GMap.find_opt x !to_avoid with
    | None -> to_avoid := GMap.add x n !to_avoid; x
    | Some n' ->
       Printf.ksprintf failwith "Generator #%d collides with #%d!" n n'

  let gen_shuffle_proof y ee ee' rr' psi =
    let get_generator_indep = make_get_generator_indep () in
    let n = Array.length ee in
    let h = get_generator_indep (-1) in
    assert (n = Array.length ee');
    assert (n = Array.length rr');
    assert (n = Array.length psi);
    let hh = Array.init n get_generator_indep in
    gen_permutation_commitment psi hh >>= fun (cc, rr) ->
    let str1 = str_egs ee ^ str_egs ee' ^ str_elts cc in
    let uu = get_nizkp_challenges n ("shuffle-challenges|" ^ str1) in
    let uu' = Array.init n (fun i -> uu.(psi.(i))) in
    gen_commitment_chain h uu' >>= fun (cc_hat, rr_hat) ->
    M.random G.q >>= fun w1 ->
    M.random G.q >>= fun w2 ->
    M.random G.q >>= fun w3 ->
    M.random G.q >>= fun w4 ->
    randoms n >>= fun ww_hat ->
    randoms n >>= fun ww' ->
    let t1 = g **~ w1 and t2 = g **~ w2 in
    let t3 = Array.fold_left ( *~ ) (g **~ w3) (Array.map2 ( **~ ) hh ww') in
    let t41 = Array.fold_left ( *~ ) (invert (y **~ w4)) (Array.map2 (fun e' w' -> e'.beta **~ w') ee' ww') in
    let t42 = Array.fold_left ( *~ ) (invert (g **~ w4)) (Array.map2 (fun e' w' -> e'.alpha **~ w') ee' ww') in
    let cc_hat' = Array.init n (fun i -> if i = 0 then h else cc_hat.(pred i)) in
    let tt_hat = Array.map3 (fun w_hat w' c_hat -> (g **~ w_hat) *~ (c_hat **~ w')) ww_hat ww' cc_hat' in
    let t = (t1, t2, t3, (t41, t42), tt_hat) in<commit_msg>More cooperativeness in gen_shuffle and gen_shuffle_proof<commit_after>(**************************************************************************)
(*                                BELENIOS                                *)
(*                                                                        *)
(*  Copyright © 2012-2019 Inria                                           *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful, but   *)
(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

open Platform
open Common
open Serializable_core_t
open Signatures

module Make (M : RANDOM) (G : GROUP) = struct
  open G
  let ( >>= ) = M.bind

  let mmap2 f a b =
    let n = Array.length a in
    assert (n = Array.length b);
    if n > 0 then
      let r = Array.make n (f a.(0) b.(0)) in
      M.yield () >>= fun () ->
      let rec loop i =
        if i < n then (
          r.(i) <- f a.(i) b.(i);
          M.yield () >>= fun () ->
          loop (succ i)
        ) else M.return r
      in
      loop 1
    else M.return [||]

  let mmap3 f a b c =
    let n = Array.length a in
    assert (n = Array.length b);
    assert (n = Array.length c);
    if n > 0 then
      let r = Array.make n (f a.(0) b.(0) c.(0)) in
      M.yield () >>= fun () ->
      let rec loop i =
        if i < n then (
          r.(i) <- f a.(i) b.(i) c.(i);
          M.yield () >>= fun () ->
          loop (succ i)
        ) else M.return r
      in
      loop 1
    else M.return [||]

  let randoms n =
    let res = Array.make n Z.zero in
    let rec loop i =
      if i < n then
        M.random G.q >>= fun x ->
        res.(i) <- x;
        loop (succ i)
      else
        M.return res
    in
    loop 0

  let gen_permutation n =
    let tmp = Array.init n (fun i -> i) in
    let psi = Array.make n 0 in
    let rec loop i =
      if i < n then
        M.random (Z.of_int Pervasives.(n - i)) >>= fun k ->
        let k = Pervasives.(Z.to_int k + i) in
        psi.(i) <- tmp.(k);
        tmp.(k) <- tmp.(i);
        loop (succ i)
      else
        M.return psi
    in
    loop 0

  let re_encrypt y {alpha; beta} r =
    {
      alpha = alpha *~ (g **~ r);
      beta = beta *~ (y **~ r);
    }

  let gen_shuffle y e =
    let n = Array.length e in
    gen_permutation n >>= fun psi ->
    randoms n >>= fun r ->
    mmap2 (re_encrypt y) e r >>= fun e ->
    let e = Array.init n (fun i -> e.(psi.(i))) in
    M.return (e, r, psi)

  let gen_permutation_commitment psi h =
    let n = Array.length psi in
    let c = Array.make n G.one and r = Array.make n Z.zero in
    let rec loop i =
      if i < n then
        M.random G.q >>= fun r_ ->
        r.(psi.(i)) <- r_;
        c.(psi.(i)) <- (g **~ r_) *~ h.(i);
        loop (succ i)
      else
        M.return (c, r)
    in loop 0

  let get_nizkp_challenges n str =
    let h = sha256_hex str in
    Array.init n (fun i ->
        let i = sha256_hex (string_of_int i) in
        Z.(of_string_base 16 (sha256_hex (h ^ i)) mod G.q)
      )

  let get_nizkp_challenge str =
    let h = sha256_hex str in
    Z.(of_string_base 16 h mod G.q)

  let str_egs e =
    let b = Buffer.create 1024 in
    for i = 0 to pred (Array.length e) do
      let {alpha; beta} = e.(i) in
      Printf.bprintf b "%s,%s," (G.to_string alpha) (G.to_string beta);
    done;
    Buffer.contents b

  let str_elts c =
    let b = Buffer.create 1024 in
    for i = 0 to pred (Array.length c) do
      Printf.bprintf b "%s," (G.to_string c.(i));
    done;
    Buffer.contents b

  let gen_commitment_chain c0 uu =
    let n = Array.length uu in
    randoms n >>= fun rr ->
    let cc = Array.make n G.one in
    let rec loop i =
      if i < n then (
        let ccpred = if i = 0 then c0 else cc.(pred i) in
        cc.(i) <- (g **~ rr.(i)) *~ (ccpred **~ uu.(i));
        M.yield () >>= fun () ->
        loop (succ i)
      ) else M.return (cc, rr)
    in
    loop 0

  module GMap = Map.Make (G)

  let make_get_generator_indep () =
    let to_avoid = ref GMap.empty in
    fun n ->
    let x = G.get_generator n in
    match GMap.find_opt x !to_avoid with
    | None -> to_avoid := GMap.add x n !to_avoid; x
    | Some n' ->
       Printf.ksprintf failwith "Generator #%d collides with #%d!" n n'

  let gen_shuffle_proof y ee ee' rr' psi =
    let get_generator_indep = make_get_generator_indep () in
    let n = Array.length ee in
    let h = get_generator_indep (-1) in
    assert (n = Array.length ee');
    assert (n = Array.length rr');
    assert (n = Array.length psi);
    let hh = Array.init n get_generator_indep in
    gen_permutation_commitment psi hh >>= fun (cc, rr) ->
    let str1 = str_egs ee ^ str_egs ee' ^ str_elts cc in
    let uu = get_nizkp_challenges n ("shuffle-challenges|" ^ str1) in
    let uu' = Array.init n (fun i -> uu.(psi.(i))) in
    gen_commitment_chain h uu' >>= fun (cc_hat, rr_hat) ->
    M.random G.q >>= fun w1 ->
    M.random G.q >>= fun w2 ->
    M.random G.q >>= fun w3 ->
    M.random G.q >>= fun w4 ->
    randoms n >>= fun ww_hat ->
    randoms n >>= fun ww' ->
    let t1 = g **~ w1 and t2 = g **~ w2 in
    M.yield () >>= fun () ->
    mmap2 ( **~ ) hh ww' >>= fun t3_ ->
    let t3 = Array.fold_left ( *~ ) (g **~ w3) t3_ in
    mmap2 (fun e' w' -> e'.beta **~ w') ee' ww' >>= fun t41_ ->
    let t41 = Array.fold_left ( *~ ) (invert (y **~ w4)) t41_ in
    mmap2 (fun e' w' -> e'.alpha **~ w') ee' ww' >>= fun t42_ ->
    let t42 = Array.fold_left ( *~ ) (invert (g **~ w4)) t42_ in
    let cc_hat' = Array.init n (fun i -> if i = 0 then h else cc_hat.(pred i)) in
    mmap3 (fun w_hat w' c_hat -> (g **~ w_hat) *~ (c_hat **~ w')) ww_hat ww' cc_hat' >>= fun tt_hat ->
    let t = (t1, t2, t3, (t41, t42), tt_hat) in
{'fraction_non_alphanumeric': 0.14954682779456194, 'fraction_numerical': 0.013595166163141994, 'mean_word_length': 1.6843790012804096, 'pattern_counts': {'":': 0, '<': 28, '<?xml version=': 0, '>': 150, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 30, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4180831', 'n_tokens_mistral': 4460, 'n_tokens_neox': 4246, 'n_words': 1509}