Source file kzg_pack.ml

(*****************************************************************************)
(*                                                                           *)
(* MIT License                                                               *)
(* Copyright (c) 2022 Nomadic Labs <contact@nomadic-labs.com>                *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module Make
    (PC : Kzg.Polynomial_commitment_sig
            with type Commitment.t = Bls12_381.G1.t SMap.t)
    (Pack : Pack.Aggregator) =
struct
  module Scalar = PC.Scalar
  module Polynomial = PC.Polynomial
  module Domain = Polynomial.Domain
  module Poly = PC.Polynomial.Polynomial
  module Scalar_map = PC.Scalar_map
  module Fr_generation = PC.Fr_generation

  type secret = Poly.t SMap.t
  type query = Scalar.t SMap.t
  type answer = Scalar.t SMap.t SMap.t

  let answer_encoding : answer Data_encoding.t =
    SMap.encoding @@ SMap.encoding Encodings.fr_encoding

  let bytes_of_query =
    Data_encoding.Binary.to_bytes_exn @@ SMap.encoding Encodings.fr_encoding

  let bytes_of_answer = Data_encoding.Binary.to_bytes_exn answer_encoding

  type transcript = Bytes.t

  module Public_parameters = struct
    type prover = {
      pp_pc_prover : PC.Public_parameters.prover;
      pp_pack_prover : Pack.prover_public_parameters;
    }

    type verifier = {
      pp_pc_verifier : PC.Public_parameters.verifier;
      pp_pack_verifier : Pack.verifier_public_parameters;
    }

    let verifier_encoding : verifier Data_encoding.t =
      Data_encoding.(
        conv
          (fun { pp_pc_verifier; pp_pack_verifier } ->
            (pp_pc_verifier, pp_pack_verifier))
          (fun (pp_pc_verifier, pp_pack_verifier) ->
            { pp_pc_verifier; pp_pack_verifier })
          (obj2
             (req "pp_pc_verifier" PC.Public_parameters.verifier_encoding)
             (req "pp_pack_prover" Pack.verifier_public_parameters_encoding)))

    type setup_params = int * int

    let setup ?state setup_params =
      let pp_pc_prover, pp_pc_verifier =
        PC.Public_parameters.setup ?state setup_params
      in
      let pp_pack_prover, pp_pack_verifier =
        Pack.setup ?state (snd setup_params)
      in
      let pp_prover = { pp_pc_prover; pp_pack_prover } in
      let pp_verifier = { pp_pc_verifier; pp_pack_verifier } in
      (pp_prover, pp_verifier)

    let get_d (public_parameters : prover) =
      PC.Public_parameters.get_d public_parameters.pp_pc_prover

    let import setup_params srsfiles =
      let pp_pc_prover, pp_pc_verifier =
        PC.Public_parameters.import setup_params srsfiles
      in
      let pp_pack_prover, pp_pack_verifier =
        Pack.import (snd setup_params) srsfiles
      in
      let pp_prover = { pp_pc_prover; pp_pack_prover } in
      let pp_verifier = { pp_pc_verifier; pp_pack_verifier } in
      (pp_prover, pp_verifier)

    let to_bytes ({ pp_pc_prover; pp_pack_prover } : prover) =
      Utils.Hash.hash_bytes
        [
          PC.Public_parameters.to_bytes pp_pc_prover;
          Pack.public_parameters_to_bytes pp_pack_prover;
        ]
  end

  module Commitment = struct
    type t = Pack.commitment

    let encoding : t Data_encoding.t = Pack.commitment_encoding

    (* [PC.Commitment.t] is required to be [Bls12_381.G1.t SMap.t],
       containing all the commitments that were packed *)
    type prover_aux = PC.Commitment.t * PC.Commitment.prover_aux

    let expand_transcript =
      Utils.expand_transcript
        ~to_bytes:(Data_encoding.Binary.to_bytes_exn encoding)

    let commit (pp : Public_parameters.prover) f_map =
      let prover_aux = PC.Commitment.commit pp.pp_pc_prover f_map in
      let cm_list = List.map snd @@ SMap.bindings (fst prover_aux) in
      let pack_cmt = Pack.commit pp.pp_pack_prover cm_list in
      (pack_cmt, prover_aux)

    let cardinal = Pack.commitment_cardinal
  end

  type proof = {
    pc_proof : PC.proof;
    packed_values : Pack.packed list;
    pack_proof : Pack.proof;
  }

  let proof_encoding : proof Data_encoding.t =
    Data_encoding.(
      conv
        (fun { pc_proof; packed_values; pack_proof } ->
          (pc_proof, packed_values, pack_proof))
        (fun (pc_proof, packed_values, pack_proof) ->
          { pc_proof; packed_values; pack_proof })
        (obj3
           (req "pc_proof" PC.proof_encoding)
           (req "packed_values" @@ list Pack.packed_encoding)
           (req "pack_proof" Pack.proof_encoding)))

  let expand_with_proof =
    Utils.expand_transcript
      ~to_bytes:(Data_encoding.Binary.to_bytes_exn proof_encoding)

  let expand_with_query = Utils.list_expand_transcript ~to_bytes:bytes_of_query

  let expand_with_answer =
    Utils.list_expand_transcript ~to_bytes:bytes_of_answer

  let batch ~zero ~add ~mul r map =
    SMap.fold
      (fun _ x (acc, rk) -> (add acc (mul rk x), Scalar.mul r rk))
      map (zero, Scalar.one)
    |> fst

  let batch_polys r map =
    let polys = SMap.bindings map |> List.map snd in
    let r_coeffs = Fr_generation.powers (List.length polys) r in
    Poly.linear polys @@ Array.to_list r_coeffs

  let batch_answers r = SMap.map Scalar.(batch ~zero ~add ~mul r)
  let evaluate = PC.evaluate

  (* compute P := cmt₀ + r cmt₁ + r² cmt₂ + ... for every group of commitments
     in the list [prover_aux_list], and common randomness r (freshly sampled);
     such P values are returned as [packed_values], together with a proof
     [packed_proof] of their correctness;
     also, on input a list of evaluations [answer_list], at the requested points
     in [query_list], produce a proof of their validity: such proof is a PC
     proof (for every group) on the aggregatted commitment P with respect to the
     corresponding aggregated evaluations (we thus batch [answer_list] with [r]
     similarly) *)
  let prove (pp : Public_parameters.prover) transcript f_map_list
      (prover_aux_list : Commitment.prover_aux list) query_list answer_list =
    let transcript = expand_with_query transcript query_list in
    let transcript = expand_with_answer transcript answer_list in
    let r, transcript = Fr_generation.random_fr transcript in
    let f_list = List.map (batch_polys r) f_map_list in
    let s_list = List.map (batch_answers r) answer_list in
    (* [cmts_list] is a list of G1.t SMap.t, containing the PC commitments to
       every polynomial (note that PC.Commitment.t = Bls12_381.G1.t SMap.t) *)
    let cmts_list =
      List.map
        (fun (cmts, _prover_aux) -> List.map snd @@ SMap.bindings cmts)
        prover_aux_list
    in
    (* [packed_values] has type [G1.t list] and it is the result of batching
       each map in [cmt_list] with powers of [r].
       [pack_proof] asserts that [packed_values] was correctly computed. *)
    let (packed_values, pack_proof), transcript =
      Pack.prove pp.pp_pack_prover transcript r cmts_list
    in
    (* prepare [f_list] and [s_list], the batched version of [f_map_list]
       polys and [answer_list] (using randomness [r]) by selecting a dummy
       name for them [string_of_int i] in order to call the underlying PC *)
    let f_map_list =
      List.mapi (fun i l -> SMap.singleton (string_of_int i) l) f_list
    in
    let s_map_list =
      List.mapi
        (fun i m -> SMap.map (fun s -> SMap.singleton (string_of_int i) s) m)
        s_list
    in
    let prover_aux_list = List.map snd prover_aux_list in
    (* call the underlying PC prover on the batched polynomials/evaluations
       the verifier will verify such proof using [packed_values] as the
       commitments *)
    let pc_proof, transcript =
      PC.prove pp.pp_pc_prover transcript f_map_list prover_aux_list query_list
        s_map_list
    in
    let proof = { pc_proof; packed_values; pack_proof } in
    (proof, expand_with_proof transcript proof)

  let verify (pp : Public_parameters.verifier) transcript cmt_list query_list
      s_map_list proof =
    let transcript = expand_with_query transcript query_list in
    let transcript = expand_with_answer transcript s_map_list in
    let r, transcript = Fr_generation.random_fr transcript in
    (* verify that the [packed_values] are correct, they will be used as
       the commitments for the PC proof of (batched) evaluations *)
    let pack_ok, transcript =
      Pack.verify pp.pp_pack_verifier transcript cmt_list r
        (proof.packed_values, proof.pack_proof)
    in
    (* batch the evaluations using [r] and prepare the query to the PC verifier
       by selecting the default dummy names [string_of_int i] names *)
    let s_list = List.map (batch_answers r) s_map_list in
    let s_map_list =
      List.mapi
        (fun i m -> SMap.map (fun s -> SMap.singleton (string_of_int i) s) m)
        s_list
    in
    let cmt_map_list =
      List.mapi
        (fun i l -> SMap.singleton (string_of_int i) l)
        proof.packed_values
    in
    (* verify that the batched evaluations are correct *)
    let pc_ok, transcript =
      PC.verify pp.pp_pc_verifier transcript cmt_map_list query_list s_map_list
        proof.pc_proof
    in
    (pack_ok && pc_ok, expand_with_proof transcript proof)
end

include (Make (Kzg) (Pack) : Kzg.Polynomial_commitment_sig)