├── .gitignore ├── LICENSE ├── README.md ├── fold_lib.opam ├── lib ├── fold_lib │ ├── dune │ └── fold.ml └── tuple_lib │ ├── double.ml │ ├── dune │ ├── four.ml │ ├── quadruple.ml │ └── triple.ml ├── snarkette.opam ├── src ├── bowe_gabizon.ml ├── dune ├── elliptic_curve.ml ├── elliptic_curve_intf.ml ├── fields.ml ├── groth_maller.ml ├── mnt4753.ml ├── mnt4_80.ml ├── mnt6753.ml ├── mnt6_80.ml ├── nat.ml ├── nat.mli ├── nat_intf.ml └── pairing.ml └── tuple_lib.opam /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | dune-project 3 | **/*.merlin 4 | *.install 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2017-2018 O(1) Labs 2 | 3 | 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: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | 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. 8 | 9 | 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # snarkette 2 | 3 | Snarkette is a pure OCaml implementation of the Groth-Maller SNARK verifier 4 | (and all the requisite number-theoretic primitives), suitable for compiliing 5 | to Javascript using `js_of_ocaml` to be deployed in SNARK-enabled web-apps. 6 | 7 | In the service of the Groth-Maller SNARK verifier, it implements the following primitives: 8 | 9 | - Prime order finite fields 10 | - Degree 2 field extensions 11 | - Degree 3 field extensions 12 | - Degree 6 field extensions 13 | - Weierstrass curves over arbitrary fields 14 | - The ate pairing 15 | 16 | The code has not yet undergone extensive review or testing and as such should not 17 | be used in critical systems. 18 | -------------------------------------------------------------------------------- /fold_lib.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "0.1" 3 | build: [ 4 | ["dune" "build" "--only" "src" "--root" "." "-j" jobs "@install"] 5 | ] 6 | -------------------------------------------------------------------------------- /lib/fold_lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name fold_lib) 3 | (public_name fold_lib) 4 | (flags :standard -short-paths) 5 | (library_flags -linkall) 6 | (inline_tests) 7 | (libraries core_kernel) 8 | (preprocess 9 | (pps ppx_jane ppx_deriving.eq bisect_ppx -- -conditional)) 10 | (synopsis "fold types")) 11 | -------------------------------------------------------------------------------- /lib/fold_lib/fold.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type ('a, 's) fold = init:'s -> f:('s -> 'a -> 's) -> 's 4 | 5 | type 'a t = {fold: 's. ('a, 's) fold} 6 | 7 | let map (t : 'a t) ~(f : 'a -> 'b) : 'b t = 8 | { fold= 9 | (fun ~init ~f:update -> t.fold ~init ~f:(fun acc x -> update acc (f x))) 10 | } 11 | 12 | let concat (t : 'a t t) : 'a t = 13 | { fold= 14 | (fun ~init ~f -> 15 | t.fold ~init ~f:(fun acc inner -> inner.fold ~init:acc ~f) ) } 16 | 17 | let concat_map (t : 'a t) ~(f : 'a -> 'b t) : 'b t = 18 | { fold= 19 | (fun ~init ~f:update -> 20 | t.fold ~init ~f:(fun acc x -> (f x).fold ~init:acc ~f:update) ) } 21 | 22 | let init n ~f:ith_elt = 23 | { fold= 24 | (fun ~init ~f -> 25 | let rec go i acc = 26 | if i = n then acc else go (i + 1) (f acc (ith_elt i)) 27 | in 28 | go 0 init ) } 29 | 30 | include Monad.Make (struct 31 | type nonrec 'a t = 'a t 32 | 33 | let map = `Custom map 34 | 35 | let return x = {fold= (fun ~init ~f -> f init x)} 36 | 37 | let bind = concat_map 38 | end) 39 | 40 | let to_list (t : 'a t) : 'a list = 41 | List.rev (t.fold ~init:[] ~f:(Fn.flip List.cons)) 42 | 43 | let of_list (xs : 'a list) : 'a t = 44 | {fold= (fun ~init ~f -> List.fold xs ~init ~f)} 45 | 46 | let of_array (xs : 'a array) : 'a t = 47 | {fold= (fun ~init ~f -> Array.fold xs ~init ~f)} 48 | 49 | let%test_unit "fold-to-list" = 50 | Quickcheck.test (Quickcheck.Generator.list Int.quickcheck_generator) 51 | ~f:(fun xs -> assert (xs = to_list (of_list xs))) 52 | 53 | let sexp_of_t f t = List.sexp_of_t f (to_list t) 54 | 55 | let compose (t1 : 'a t) (t2 : 'a t) : 'a t = 56 | {fold= (fun ~init ~f -> t2.fold ~init:(t1.fold ~init ~f) ~f)} 57 | 58 | let ( +> ) = compose 59 | 60 | let group3 ~default (t : 'a t) : ('a * 'a * 'a) t = 61 | { fold= 62 | (fun ~init ~f -> 63 | let pt, bs = 64 | t.fold ~init:(init, []) ~f:(fun (pt, bs) b -> 65 | match bs with 66 | | [b2; b1; b0] -> 67 | let pt' = f pt (b0, b1, b2) in 68 | (pt', [b]) 69 | | _ -> 70 | (pt, b :: bs) ) 71 | in 72 | match bs with 73 | | [b2; b1; b0] -> 74 | f pt (b0, b1, b2) 75 | | [b1; b0] -> 76 | f pt (b0, b1, default) 77 | | [b0] -> 78 | f pt (b0, default, default) 79 | | [] -> 80 | pt 81 | | _x1 :: _x2 :: _x3 :: _x4 :: _ -> 82 | assert false ) } 83 | 84 | let%test_unit "group3" = 85 | Quickcheck.test (Quickcheck.Generator.list Int.quickcheck_generator) 86 | ~f:(fun xs -> 87 | let default = 0 in 88 | let n = List.length xs in 89 | let tuples = to_list (group3 ~default (of_list xs)) in 90 | let k = List.length tuples in 91 | let r = n mod 3 in 92 | (let padded = 93 | xs @ if r = 0 then [] else List.init (3 - r) ~f:(fun _ -> default) 94 | in 95 | let concated = 96 | List.concat_map ~f:(fun (b1, b2, b3) -> [b1; b2; b3]) tuples 97 | in 98 | [%test_eq: int list] padded concated) ; 99 | assert ((n + 2) / 3 = k) ) 100 | 101 | let string_bits s = 102 | let ith_bit_int n i = (n lsr i) land 1 = 1 in 103 | { fold= 104 | (fun ~init ~f -> 105 | String.fold s ~init ~f:(fun acc c -> 106 | let c = Char.to_int c in 107 | let update i acc = f acc (ith_bit_int c i) in 108 | update 0 acc |> update 1 |> update 2 |> update 3 |> update 4 109 | |> update 5 |> update 6 |> update 7 ) ) } 110 | 111 | let bool_t_to_string = 112 | let module State = struct 113 | type t = {curr: int; acc: char list; i: int} 114 | end in 115 | let open State in 116 | fun t -> 117 | let {curr; i; acc} = 118 | t.fold ~init:{curr= 0; acc= []; i= 0} ~f:(fun {curr; acc; i} b -> 119 | let curr = if b then curr lor (1 lsl i) else curr in 120 | if i = 7 then {i= 0; acc= Char.of_int_exn curr :: acc; curr= 0} 121 | else {i= i + 1; acc; curr} ) 122 | in 123 | let cs = if i = 0 then acc else Char.of_int_exn curr :: acc in 124 | String.of_char_list cs 125 | 126 | let string_triples s = group3 ~default:false (string_bits s) 127 | -------------------------------------------------------------------------------- /lib/tuple_lib/double.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type 'a t = 'a * 'a [@@deriving bin_io, sexp, eq, compare] 4 | -------------------------------------------------------------------------------- /lib/tuple_lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name tuple_lib) 3 | (public_name tuple_lib) 4 | (flags :standard -short-paths) 5 | (library_flags -linkall) 6 | (inline_tests) 7 | (libraries core_kernel) 8 | (preprocess 9 | (pps ppx_jane ppx_deriving.eq bisect_ppx -- -conditional)) 10 | (synopsis "Tuple types")) 11 | -------------------------------------------------------------------------------- /lib/tuple_lib/four.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type t = Zero | One | Two | Three [@@deriving sexp, eq, bin_io, hash] 4 | 5 | let of_bits_lsb : bool Double.t -> t = function 6 | | false, false -> 7 | Zero 8 | | true, false -> 9 | One 10 | | false, true -> 11 | Two 12 | | true, true -> 13 | Three 14 | -------------------------------------------------------------------------------- /lib/tuple_lib/quadruple.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type 'a t = 'a * 'a * 'a * 'a [@@deriving bin_io, sexp, eq, compare] 4 | 5 | let get ((x0, x1, x2, x3) : 'a t) (i : Four.t) = 6 | match i with Zero -> x0 | One -> x1 | Two -> x2 | Three -> x3 7 | -------------------------------------------------------------------------------- /lib/tuple_lib/triple.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type 'a t = 'a * 'a * 'a [@@deriving bin_io, sexp, eq, compare] 4 | -------------------------------------------------------------------------------- /snarkette.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "0.1" 3 | build: [ 4 | ["dune" "build" "--only" "src" "--root" "." "-j" jobs "@install"] 5 | ] 6 | 7 | -------------------------------------------------------------------------------- /src/bowe_gabizon.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Fold_lib 3 | 4 | let ( = ) = `Don't_use_polymorphic_equality 5 | 6 | module type Backend_intf = sig 7 | module N : Nat_intf.S 8 | 9 | module Fq : Fields.Fp_intf with type nat := N.t 10 | 11 | module Fqe : Fields.Extension_intf with type base = Fq.t 12 | 13 | module G1 : sig 14 | type t [@@deriving sexp, bin_io] 15 | 16 | val zero : t 17 | 18 | val to_affine_coordinates : t -> Fq.t * Fq.t 19 | 20 | val is_well_formed : t -> bool 21 | 22 | val ( * ) : N.t -> t -> t 23 | 24 | val ( + ) : t -> t -> t 25 | end 26 | 27 | module G2 : sig 28 | type t [@@deriving sexp, bin_io] 29 | 30 | val to_affine_coordinates : t -> Fqe.t * Fqe.t 31 | 32 | val ( + ) : t -> t -> t 33 | 34 | val is_well_formed : t -> bool 35 | end 36 | 37 | val hash : 38 | ?message:bool array 39 | -> a:G1.t 40 | -> b:G2.t 41 | -> c:G1.t 42 | -> delta_prime:G2.t 43 | -> G1.t 44 | 45 | module Fq_target : sig 46 | include Fields.Degree_2_extension_intf with type base = Fqe.t 47 | 48 | val unitary_inverse : t -> t 49 | end 50 | 51 | module Pairing : 52 | Pairing.S 53 | with module G1 := G1 54 | and module G2 := G2 55 | and module Fq_target := Fq_target 56 | end 57 | 58 | module Make (Backend : Backend_intf) = struct 59 | open Backend 60 | 61 | module Verification_key = struct 62 | type t = {g_alpha_h_beta: Fq_target.t; h_delta: G2.t; query: G1.t array} 63 | [@@deriving bin_io, sexp] 64 | 65 | let map_to_two t ~f = 66 | let xs, ys = 67 | List.fold_left t ~init:([], []) ~f:(fun (xs, ys) a -> 68 | let x, y = f a in 69 | (x :: xs, y :: ys) ) 70 | in 71 | (List.rev xs, List.rev ys) 72 | 73 | let fold_bits {g_alpha_h_beta; h_delta; query} = 74 | let g1s = Array.to_list query in 75 | let g2s = [h_delta] in 76 | let gts = [Fq_target.unitary_inverse g_alpha_h_beta] in 77 | let g1_elts, g1_signs = map_to_two g1s ~f:G1.to_affine_coordinates in 78 | let non_zero_base_coordinate a = 79 | let x = Fqe.project_to_base a in 80 | assert (not (Fq.equal x Fq.zero)) ; 81 | x 82 | in 83 | let g2_elts, g2_signs = 84 | map_to_two g2s ~f:(fun g -> 85 | let x, y = G2.to_affine_coordinates g in 86 | (Fqe.to_base_elements x, non_zero_base_coordinate y) ) 87 | in 88 | let gt_elts, gt_signs = 89 | map_to_two gts ~f:(fun g -> 90 | (* g is unitary, so (a, b) satisfy a quadratic over Fqe and thus 91 | b is determined by a up to sign *) 92 | let a, b = g in 93 | (Fqe.to_base_elements a, non_zero_base_coordinate b) ) 94 | in 95 | let open Fold in 96 | let of_fq_list_list ls = 97 | let open Let_syntax in 98 | let%bind l = of_list ls in 99 | let%bind x = of_list l in 100 | Fq.fold_bits x 101 | in 102 | let parity_bit x = N.test_bit (Fq.to_bigint x) 0 in 103 | let parity_bits = Fn.compose (map ~f:parity_bit) of_list in 104 | concat_map (of_list g1_elts) ~f:Fq.fold_bits 105 | +> of_fq_list_list g2_elts +> of_fq_list_list gt_elts 106 | +> parity_bits g1_signs +> parity_bits g2_signs +> parity_bits gt_signs 107 | 108 | let fold t = Fold.group3 ~default:false (fold_bits t) 109 | 110 | module Processed = struct 111 | type t = 112 | { g_alpha_h_beta: Fq_target.t 113 | ; h_delta_pc: Pairing.G2_precomputation.t 114 | ; query: G1.t array } 115 | [@@deriving bin_io, sexp] 116 | 117 | let create {g_alpha_h_beta; h_delta; query} = 118 | { g_alpha_h_beta 119 | ; h_delta_pc= Pairing.G2_precomputation.create h_delta 120 | ; query } 121 | end 122 | end 123 | 124 | let check b lab = if b then Ok () else Or_error.error_string lab 125 | 126 | module Proof = struct 127 | type t = {a: G1.t; b: G2.t; c: G1.t; delta_prime: G2.t; z: G1.t} 128 | [@@deriving bin_io, sexp] 129 | 130 | let is_well_formed {a; b; c; delta_prime; z} = 131 | let open Or_error.Let_syntax in 132 | let err x = 133 | sprintf "proof was not well-formed (%s was off its curve)" x 134 | in 135 | let%bind () = check (G1.is_well_formed a) (err "a") in 136 | let%bind () = check (G2.is_well_formed b) (err "b") in 137 | let%bind () = check (G1.is_well_formed c) (err "c") in 138 | let%bind () = 139 | check (G2.is_well_formed delta_prime) (err "delta_prime") 140 | in 141 | let%map () = check (G1.is_well_formed z) (err "z") in 142 | () 143 | end 144 | 145 | let verify ?message (vk : Verification_key.Processed.t) input 146 | ({Proof.a; b; c; delta_prime; z} as proof) = 147 | let open Or_error.Let_syntax in 148 | let%bind () = 149 | check 150 | (Int.equal (List.length input) (Array.length vk.query - 1)) 151 | "Input length was not as expected" 152 | in 153 | let%bind () = Proof.is_well_formed proof in 154 | let input_acc = 155 | List.foldi input ~init:vk.query.(0) ~f:(fun i acc x -> 156 | let q = vk.query.(1 + i) in 157 | G1.(acc + (x * q)) ) 158 | in 159 | let delta_prime_pc = Pairing.G2_precomputation.create delta_prime in 160 | let test1 = 161 | let l = Pairing.unreduced_pairing a b in 162 | let r1 = vk.g_alpha_h_beta in 163 | let r2 = 164 | Pairing.miller_loop 165 | (Pairing.G1_precomputation.create input_acc) 166 | vk.h_delta_pc 167 | in 168 | let r3 = 169 | Pairing.miller_loop (Pairing.G1_precomputation.create c) delta_prime_pc 170 | in 171 | let test = 172 | let open Fq_target in 173 | Pairing.final_exponentiation (unitary_inverse l * r2 * r3) * r1 174 | in 175 | Fq_target.(equal test one) 176 | in 177 | let%bind () = check test1 "First pairing check failed" in 178 | let test2 = 179 | let ys = hash ?message ~a ~b ~c ~delta_prime in 180 | let l = 181 | Pairing.miller_loop 182 | (Pairing.G1_precomputation.create ys) 183 | delta_prime_pc 184 | in 185 | let r = 186 | Pairing.miller_loop (Pairing.G1_precomputation.create z) vk.h_delta_pc 187 | in 188 | let test2 = 189 | Pairing.final_exponentiation Fq_target.(l * unitary_inverse r) 190 | in 191 | Fq_target.(equal test2 one) 192 | in 193 | check test2 "Second pairing check failed" 194 | end 195 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (inline_tests) 3 | (name snarkette) 4 | (public_name snarkette) 5 | (libraries tuple_lib fold_lib num core_kernel ) 6 | (preprocess (pps ppx_jane ppx_deriving.eq )) 7 | (js_of_ocaml (flags +nat.js))) 8 | -------------------------------------------------------------------------------- /src/elliptic_curve.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | let ( = ) = `Don't_use_polymorphic_compare 4 | 5 | module Make (N : sig 6 | type t 7 | 8 | val test_bit : t -> int -> bool 9 | 10 | val num_bits : t -> int 11 | end) 12 | (Fq : Fields.Intf) (Coefficients : sig 13 | val a : Fq.t 14 | 15 | val b : Fq.t 16 | end) = 17 | struct 18 | type t = {x: Fq.t; y: Fq.t; z: Fq.t} [@@deriving bin_io, sexp] 19 | 20 | let zero = {x= Fq.zero; y= Fq.one; z= Fq.zero} 21 | 22 | module Coefficients = Coefficients 23 | 24 | let to_affine_coordinates {x; y; z} = 25 | let z_inv = Fq.inv z in 26 | Fq.(x * z_inv, y * z_inv) 27 | 28 | let of_affine_coordinates (x, y) = {x; y; z= Fq.one} 29 | 30 | let is_zero t = Fq.(equal zero t.x) && Fq.(equal zero t.z) 31 | 32 | let is_well_formed ({x; y; z} as t) = 33 | if is_zero t then true 34 | else 35 | let open Fq in 36 | let x2 = square x in 37 | let y2 = square y in 38 | let z2 = square z in 39 | equal 40 | (z * (y2 - (Coefficients.b * z2))) 41 | (x * (x2 + (Coefficients.a * z2))) 42 | 43 | let ( + ) t1 t2 = 44 | if is_zero t1 then t2 45 | else if is_zero t2 then t1 46 | else 47 | let open Fq in 48 | let x1z2 = t1.x * t2.z in 49 | let x2z1 = t1.z * t2.x in 50 | let y1z2 = t1.y * t2.z in 51 | let y2z1 = t1.z * t2.y in 52 | if equal x1z2 x2z1 && equal y1z2 y2z1 then 53 | (* Double case *) 54 | let xx = square t1.x in 55 | let zz = square t1.z in 56 | let w = (Coefficients.a * zz) + (xx + xx + xx) in 57 | let y1z1 = t1.y * t1.z in 58 | let s = y1z1 + y1z1 in 59 | let ss = square s in 60 | let sss = s * ss in 61 | let r = t1.y * s in 62 | let rr = square r in 63 | let b = square (t1.x + r) - xx - rr in 64 | let h = square w - (b + b) in 65 | let x3 = h * s in 66 | let y3 = (w * (b - h)) - (rr + rr) in 67 | let z3 = sss in 68 | {x= x3; y= y3; z= z3} 69 | else 70 | (* Generic case *) 71 | let z1z2 = t1.z * t2.z in 72 | let u = y2z1 - y1z2 in 73 | let uu = square u in 74 | let v = x2z1 - x1z2 in 75 | let vv = square v in 76 | let vvv = v * vv in 77 | let r = vv * x1z2 in 78 | let a = (uu * z1z2) - (vvv + r + r) in 79 | let x3 = v * a in 80 | let y3 = (u * (r - a)) - (vvv * y1z2) in 81 | let z3 = vvv * z1z2 in 82 | {x= x3; y= y3; z= z3} 83 | 84 | let scale base s = 85 | let rec go found_one acc i = 86 | if i < 0 then acc 87 | else 88 | let acc = if found_one then acc + acc else acc in 89 | if N.test_bit s i then go true (acc + base) (i - 1) 90 | else go found_one acc (i - 1) 91 | in 92 | go false zero (N.num_bits s - 1) 93 | 94 | let ( * ) s g = scale g s 95 | 96 | let negate {x; y; z} = {x; y= Fq.negate y; z} 97 | 98 | let ( - ) t1 t2 = t1 + negate t2 99 | end 100 | -------------------------------------------------------------------------------- /src/elliptic_curve_intf.ml: -------------------------------------------------------------------------------- 1 | module type S = sig 2 | type field 3 | 4 | type t 5 | 6 | module Coefficients : sig 7 | val a : field 8 | 9 | val b : field 10 | end 11 | 12 | val ( + ) : t -> t -> t 13 | 14 | val to_affine_coordinates : t -> field * field 15 | end 16 | -------------------------------------------------------------------------------- /src/fields.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Fold_lib 3 | open Tuple_lib 4 | 5 | let ( = ) = `Don't_use_polymorphic_equality 6 | 7 | module type Intf = sig 8 | type t [@@deriving eq, bin_io, sexp, compare] 9 | 10 | val gen : t Quickcheck.Generator.t 11 | 12 | val one : t 13 | 14 | val zero : t 15 | 16 | val ( + ) : t -> t -> t 17 | 18 | val ( * ) : t -> t -> t 19 | 20 | val ( - ) : t -> t -> t 21 | 22 | val ( / ) : t -> t -> t 23 | 24 | val negate : t -> t 25 | 26 | val inv : t -> t 27 | 28 | val square : t -> t 29 | end 30 | 31 | module type Fp_intf = sig 32 | include Intf 33 | 34 | include Stringable.S with type t := t 35 | 36 | type nat 37 | 38 | include Stringable.S with type t := t 39 | 40 | val of_int : int -> t 41 | 42 | val of_bits : bool list -> t option 43 | 44 | val order : nat 45 | 46 | val to_bigint : t -> nat 47 | 48 | val fold_bits : t -> bool Fold.t 49 | 50 | val fold : t -> bool Triple.t Fold.t 51 | 52 | val length_in_bits : int 53 | 54 | val is_square : t -> bool 55 | 56 | val sqrt : t -> t 57 | end 58 | 59 | module type Extension_intf = sig 60 | type base 61 | 62 | include Intf 63 | 64 | val scale : t -> base -> t 65 | 66 | val of_base : base -> t 67 | 68 | val project_to_base : t -> base 69 | 70 | val to_base_elements : t -> base list 71 | end 72 | 73 | module Make_fp 74 | (N : Nat_intf.S) (Info : sig 75 | val order : N.t 76 | end) : Fp_intf with type nat := N.t = struct 77 | include Info 78 | 79 | (* TODO version *) 80 | type t = N.t [@@deriving eq, bin_io, sexp, compare] 81 | 82 | let to_bigint = Fn.id 83 | 84 | let zero = N.of_int 0 85 | 86 | let one = N.of_int 1 87 | 88 | let length_in_bits = N.num_bits N.(Info.order - one) 89 | 90 | let gen = 91 | let length_in_int32s = (length_in_bits + 31) / 32 in 92 | Quickcheck.Generator.( 93 | map (list_with_length length_in_int32s Int32.quickcheck_generator) 94 | ~f:(fun xs -> 95 | List.foldi xs ~init:zero ~f:(fun i acc x -> 96 | N.log_or acc 97 | (N.shift_left (N.of_int (Int32.to_int_exn x)) (32 * i)) ) )) 98 | 99 | let fold_bits n : bool Fold_lib.Fold.t = 100 | { fold= 101 | (fun ~init ~f -> 102 | let rec go acc i = 103 | if Int.(i = length_in_bits) then acc 104 | else go (f acc (N.test_bit n i)) (i + 1) 105 | in 106 | go init 0 ) } 107 | 108 | let fold n = Fold_lib.Fold.group3 ~default:false (fold_bits n) 109 | 110 | let of_bits bits = 111 | let rec go acc i = function 112 | | [] -> 113 | acc 114 | | b :: bs -> 115 | let acc = if b then N.log_or acc (N.shift_left one i) else acc in 116 | go acc (i + 1) bs 117 | in 118 | let r = go zero 0 bits in 119 | if N.( < ) r Info.order then Some r else None 120 | 121 | open N 122 | 123 | let of_int = N.of_int 124 | 125 | let of_string = N.of_string 126 | 127 | let to_string = N.to_string 128 | 129 | let rec extended_euclidean a b = 130 | if equal b zero then (a, one, zero) 131 | else 132 | match extended_euclidean b (a % b) with 133 | | d, x, y -> 134 | (d, y, x - (a // b * y)) 135 | 136 | let ( + ) x y = (x + y) % Info.order 137 | 138 | let negate x = N.( - ) Info.order x 139 | 140 | let ( - ) x y = (x - y) % Info.order 141 | 142 | let ( * ) x y = x * y % Info.order 143 | 144 | let square x = x * x 145 | 146 | let ( ** ) x n = 147 | let k = N.num_bits n in 148 | let rec go acc i = 149 | if Int.(i < 0) then acc 150 | else 151 | let acc = acc * acc in 152 | let acc = if N.test_bit n i then acc * x else acc in 153 | go acc Int.(i - 1) 154 | in 155 | go one Int.(k - 1) 156 | 157 | let%test_unit "exp test" = [%test_eq: t] (of_int 8) (of_int 2 ** of_int 3) 158 | 159 | let is_square = 160 | let euler = N.((Info.order - one) // of_int 2) in 161 | fun x -> N.equal (x ** euler) one 162 | 163 | let inv_no_mod x = 164 | let _, a, _b = extended_euclidean x Info.order in 165 | a 166 | 167 | let inv x = inv_no_mod x % Info.order 168 | 169 | let ( / ) x y = x * inv_no_mod y 170 | 171 | module Sqrt_params = struct 172 | let two_adicity n = 173 | let rec go i = if N.test_bit n i then i else go Int.(i + 1) in 174 | go 0 175 | 176 | type nonrec t = 177 | {two_adicity: int; quadratic_non_residue_to_t: t; t_minus_1_over_2: t} 178 | 179 | let first f = 180 | let rec go i = match f i with Some x -> x | None -> go Int.(i + 1) in 181 | go 1 182 | 183 | let create () = 184 | let p_minus_one = N.(Info.order - one) in 185 | let s = two_adicity p_minus_one in 186 | let t = N.shift_right p_minus_one s in 187 | let quadratic_non_residue = 188 | first (fun i -> 189 | let i = of_int i in 190 | Option.some_if (not (is_square i)) i ) 191 | in 192 | { two_adicity= s 193 | ; quadratic_non_residue_to_t= quadratic_non_residue ** t 194 | ; t_minus_1_over_2= (t - one) / of_int 2 } 195 | 196 | let t = lazy (create ()) 197 | end 198 | 199 | let rec loop ~while_ ~init f = 200 | if while_ init then loop ~while_ ~init:(f init) f else init 201 | 202 | let ( = ) = equal 203 | 204 | let rec pow2 b n = if n > 0 then pow2 (square b) Int.(n - 1) else b 205 | 206 | let%test_unit "pow2" = 207 | let b = 7 in 208 | [%test_eq: t] (pow2 (of_int b) 3) (of_int Int.(7 ** 8)) 209 | 210 | let sqrt = 211 | let pow2_order b = 212 | loop 213 | ~while_:(fun (b2m, _) -> not (b2m = one)) 214 | ~init:(b, 0) 215 | (fun (b2m, m) -> (square b2m, Int.succ m)) 216 | |> snd 217 | in 218 | let module Loop_params = struct 219 | type nonrec t = {z: t; b: t; x: t; v: int} 220 | end in 221 | let open Loop_params in 222 | fun a -> 223 | let { Sqrt_params.two_adicity= v 224 | ; quadratic_non_residue_to_t= z 225 | ; t_minus_1_over_2 } = 226 | Lazy.force Sqrt_params.t 227 | in 228 | let w = a ** t_minus_1_over_2 in 229 | let x = a * w in 230 | let b = x * w in 231 | let {x; _} = 232 | loop 233 | ~while_:(fun p -> not (p.b = one)) 234 | ~init:{z; b; x; v} 235 | (fun {z; b; x; v} -> 236 | let m = pow2_order b in 237 | let w = pow2 z Int.(v - m - 1) in 238 | let z = square w in 239 | {z; b= b * z; x= x * w; v= m} ) 240 | in 241 | x 242 | 243 | let%test_unit "sqrt agrees with integer square root on small values" = 244 | let rec mem a = function 245 | | [] -> 246 | () 247 | | x :: xs -> ( 248 | try [%test_eq: t] a x with _ -> mem a xs ) 249 | in 250 | let gen = Int.gen_incl 1 Int.max_value_30_bits in 251 | Quickcheck.test ~trials:10 gen ~f:(fun n -> 252 | let n = abs n in 253 | let n2 = Int.(n * n) in 254 | mem (sqrt (of_int n2)) [of_int n; Info.order - of_int n] ) 255 | end 256 | 257 | module type Degree_2_extension_intf = sig 258 | type base 259 | 260 | include Extension_intf with type base := base and type t = base * base 261 | end 262 | 263 | module type Degree_3_extension_intf = sig 264 | type base 265 | 266 | include Extension_intf with type base := base and type t = base * base * base 267 | end 268 | 269 | let ( % ) x n = 270 | let r = x mod n in 271 | if r < 0 then r + n else r 272 | 273 | let find_wnaf (type t) (module N : Nat_intf.S with type t = t) window_size 274 | scalar = 275 | let one = N.of_int 1 in 276 | let first_k_bits c k = 277 | let k_bits = N.(shift_left one k - one) in 278 | N.to_int_exn (N.log_and k_bits c) 279 | in 280 | let length = N.num_bits scalar in 281 | let res = Array.init (length + 1) ~f:(fun _ -> 0) in 282 | let zero = N.of_int 0 in 283 | let rec go c j = 284 | if N.equal zero c then () 285 | else 286 | let u, c = 287 | if N.test_bit c 0 then 288 | let u = 289 | let u = first_k_bits c (window_size + 1) in 290 | if u > 1 lsl window_size then u - (1 lsl (window_size + 1)) else u 291 | in 292 | let c = N.(c - of_int u) in 293 | (u, c) 294 | else (0, c) 295 | in 296 | res.(j) <- u ; 297 | go (N.shift_right c 1) (j + 1) 298 | in 299 | go scalar 0 ; res 300 | 301 | module Make_fp3 302 | (Fp : Intf) (Info : sig 303 | val non_residue : Fp.t 304 | 305 | val frobenius_coeffs_c1 : Fp.t array 306 | 307 | val frobenius_coeffs_c2 : Fp.t array 308 | end) : sig 309 | include Degree_3_extension_intf with type base = Fp.t 310 | 311 | val non_residue : Fp.t 312 | 313 | val frobenius : t -> int -> t 314 | end = struct 315 | include Info 316 | 317 | type base = Fp.t 318 | 319 | type t = Fp.t * Fp.t * Fp.t [@@deriving eq, bin_io, sexp, compare] 320 | 321 | let gen = Quickcheck.Generator.tuple3 Fp.gen Fp.gen Fp.gen 322 | 323 | let to_base_elements (x, y, z) = [x; y; z] 324 | 325 | let componentwise f (x1, x2, x3) (y1, y2, y3) = (f x1 y1, f x2 y2, f x3 y3) 326 | 327 | let of_base x = (x, Fp.zero, Fp.zero) 328 | 329 | let project_to_base (x, _, _) = x 330 | 331 | let one = of_base Fp.one 332 | 333 | let zero = of_base Fp.zero 334 | 335 | let scale (x1, x2, x3) s = Fp.(s * x1, s * x2, s * x3) 336 | 337 | let negate (x1, x2, x3) = Fp.(negate x1, negate x2, negate x3) 338 | 339 | let ( + ) = componentwise Fp.( + ) 340 | 341 | let ( - ) = componentwise Fp.( - ) 342 | 343 | let ( * ) (a1, b1, c1) (a2, b2, c2) = 344 | let a = Fp.(a1 * a2) in 345 | let b = Fp.(b1 * b2) in 346 | let c = Fp.(c1 * c2) in 347 | let open Fp in 348 | ( a + (non_residue * (((b1 + c1) * (b2 + c2)) - b - c)) 349 | , ((a1 + b1) * (a2 + b2)) - a - b + (non_residue * c) 350 | , ((a1 + c1) * (a2 + c2)) - a + b - c ) 351 | 352 | let square (a, b, c) = 353 | let s0 = Fp.square a in 354 | let ab = Fp.(a * b) in 355 | let s1 = Fp.(ab + ab) in 356 | let s2 = Fp.(square (a - b + c)) in 357 | let bc = Fp.(b * c) in 358 | let s3 = Fp.(bc + bc) in 359 | let s4 = Fp.square c in 360 | let open Fp in 361 | (s0 + (non_residue * s3), s1 + (non_residue * s4), s1 + s2 + s3 - s0 - s4) 362 | 363 | let inv (a, b, c) = 364 | let open Fp in 365 | let t0 = square a in 366 | let t1 = square b in 367 | let t2 = square c in 368 | let t3 = a * b in 369 | let t4 = a * c in 370 | let t5 = b * c in 371 | let c0 = t0 - (non_residue * t5) in 372 | let c1 = (non_residue * t2) - t3 in 373 | let c2 = t1 - t4 in 374 | let t6 = (a * c0) + (non_residue * ((c * c1) + (b * c2))) |> inv in 375 | (t6 * c0, t6 * c1, t6 * c2) 376 | 377 | let ( / ) x y = x * inv y 378 | 379 | let frobenius (c0, c1, c2) power = 380 | let open Fp in 381 | let open Info in 382 | let i = power mod 3 in 383 | (c0, frobenius_coeffs_c1.(i) * c1, frobenius_coeffs_c2.(i) * c2) 384 | end 385 | 386 | module Make_fp2 387 | (Fp : Intf) (Info : sig 388 | val non_residue : Fp.t 389 | end) : sig 390 | include Degree_2_extension_intf with type base = Fp.t 391 | end = struct 392 | type base = Fp.t 393 | 394 | type t = Fp.t * Fp.t [@@deriving eq, bin_io, sexp, compare] 395 | 396 | let gen = Quickcheck.Generator.tuple2 Fp.gen Fp.gen 397 | 398 | let of_base x = (x, Fp.zero) 399 | 400 | let to_base_elements (x, y) = [x; y] 401 | 402 | let project_to_base (x, _) = x 403 | 404 | let one = of_base Fp.one 405 | 406 | let zero = of_base Fp.zero 407 | 408 | let componentwise f (x1, x2) (y1, y2) = (f x1 y1, f x2 y2) 409 | 410 | let ( + ) = componentwise Fp.( + ) 411 | 412 | let ( - ) = componentwise Fp.( - ) 413 | 414 | let scale (x1, x2) s = Fp.(s * x1, s * x2) 415 | 416 | let negate (a, b) = Fp.(negate a, negate b) 417 | 418 | let square (a, b) = 419 | let open Info in 420 | let ab = Fp.(a * b) in 421 | Fp.(((a + b) * (a + (non_residue * b))) - ab - (non_residue * ab), ab + ab) 422 | 423 | let ( * ) (a1, b1) (a2, b2) = 424 | let open Fp in 425 | let a = a1 * a2 in 426 | let b = b1 * b2 in 427 | (a + (Info.non_residue * b), ((a1 + b1) * (a2 + b2)) - a - b) 428 | 429 | let inv (a, b) = 430 | let open Fp in 431 | let t0 = square a in 432 | let t1 = square b in 433 | let t2 = t0 - (Info.non_residue * t1) in 434 | let t3 = inv t2 in 435 | let c0 = a * t3 in 436 | let c1 = negate (b * t3) in 437 | (c0, c1) 438 | 439 | let ( / ) x y = x * inv y 440 | end 441 | 442 | module Make_fp6 443 | (N : Nat_intf.S) 444 | (Fp : Intf) 445 | (Fp2 : Degree_2_extension_intf with type base = Fp.t) (Fp3 : sig 446 | include Degree_3_extension_intf with type base = Fp.t 447 | 448 | val frobenius : t -> int -> t 449 | 450 | val non_residue : Fp.t 451 | end) (Info : sig 452 | val non_residue : Fp.t 453 | 454 | val frobenius_coeffs_c1 : Fp.t array 455 | end) : sig 456 | include Degree_2_extension_intf with type base = Fp3.t 457 | 458 | val mul_by_2345 : t -> t -> t 459 | 460 | val frobenius : t -> int -> t 461 | 462 | val cyclotomic_exp : t -> N.t -> t 463 | 464 | val unitary_inverse : t -> t 465 | end = struct 466 | type t = Fp3.t * Fp3.t [@@deriving eq, bin_io, sexp, compare] 467 | 468 | type base = Fp3.t 469 | 470 | let gen = Quickcheck.Generator.tuple2 Fp3.gen Fp3.gen 471 | 472 | let to_base_elements (x, y) = [x; y] 473 | 474 | let int_sub = ( - ) 475 | 476 | let of_base x = (x, Fp3.zero) 477 | 478 | let project_to_base (x, _) = x 479 | 480 | let zero = of_base Fp3.zero 481 | 482 | let one = of_base Fp3.one 483 | 484 | let componentwise f (x1, x2) (y1, y2) = (f x1 y1, f x2 y2) 485 | 486 | let ( + ) = componentwise Fp3.( + ) 487 | 488 | let ( - ) = componentwise Fp3.( - ) 489 | 490 | let scale (x1, x2) s = Fp3.(s * x1, s * x2) 491 | 492 | let mul_by_non_residue ((c0, c1, c2) : Fp3.t) = 493 | Fp.(Info.non_residue * c2, c0, c1) 494 | 495 | let mul_by_2345 (a1, b1) (a2, b2) = 496 | let open Info in 497 | let a1_0, a1_1, a1_2 = a1 in 498 | let _, _, a2_2 = a2 in 499 | (let a2_0, a2_1, _ = a2 in 500 | assert (Fp.(equal a2_0 zero)) ; 501 | assert (Fp.(equal a2_1 zero))) ; 502 | let a = 503 | Fp.(a1_1 * a2_2 * non_residue, a1_2 * a2_2 * non_residue, a1_0 * a2_2) 504 | in 505 | let b = Fp3.(b1 * b2) in 506 | let beta_b = mul_by_non_residue b in 507 | Fp3.(a + beta_b, ((a1 + b2) * (a2 + b2)) - a - b) 508 | 509 | let square (a, b) = 510 | let ab = Fp3.(a * b) in 511 | let open Fp3 in 512 | ( ((a + b) * (a + mul_by_non_residue b)) - ab - mul_by_non_residue ab 513 | , ab + ab ) 514 | 515 | let negate (a, b) = Fp3.(negate a, negate b) 516 | 517 | let ( * ) (a1, b1) (a2, b2) = 518 | let a = Fp3.(a1 * a2) in 519 | let b = Fp3.(b1 * b2) in 520 | let beta_b = mul_by_non_residue b in 521 | Fp3.(a + beta_b, ((a1 + b1) * (a2 + b2)) - a - b) 522 | 523 | let inv (a, b) = 524 | let t1 = Fp3.square b in 525 | let t0 = Fp3.(square a - mul_by_non_residue t1) in 526 | let new_t1 = Fp3.inv t0 in 527 | Fp3.(a * new_t1, negate (b * new_t1)) 528 | 529 | let ( / ) x y = x * inv y 530 | 531 | let unitary_inverse (x, y) = (x, Fp3.negate y) 532 | 533 | let cyclotomic_square ((c00, c01, c02), (c10, c11, c12)) = 534 | let a : Fp2.t = (c00, c11) in 535 | let b : Fp2.t = (c10, c02) in 536 | let c : Fp2.t = (c01, c12) in 537 | let asq = Fp2.square a in 538 | let bsq = Fp2.square b in 539 | let csq = Fp2.square c in 540 | let a_a = 541 | let open Fp in 542 | let a_a = fst asq - fst a in 543 | a_a + a_a + fst asq 544 | in 545 | let a_b = 546 | let open Fp in 547 | let a_b = snd asq + snd a in 548 | a_b + a_b + snd asq 549 | in 550 | let b_a = 551 | let open Fp in 552 | let b_tmp = Fp3.non_residue * snd csq in 553 | let b_a = b_tmp + fst b in 554 | b_a + b_a + b_tmp 555 | in 556 | let b_b = 557 | let open Fp in 558 | let b_b = fst csq - snd b in 559 | b_b + b_b + fst csq 560 | in 561 | let c_a = 562 | let open Fp in 563 | let c_a = fst bsq - fst c in 564 | c_a + c_a + fst bsq 565 | in 566 | let c_b = 567 | let open Fp in 568 | let c_b = snd bsq + snd c in 569 | c_b + c_b + snd bsq 570 | in 571 | ((a_a, c_a, b_b), (b_a, a_b, c_b)) 572 | 573 | let cyclotomic_exp x exponent = 574 | let x_inv = inv x in 575 | let naf = find_wnaf (module N) 1 exponent in 576 | let rec go found_nonzero res i = 577 | if i < 0 then res 578 | else 579 | let res = if found_nonzero then cyclotomic_square res else res in 580 | if naf.(i) <> 0 then 581 | let found_nonzero = true in 582 | let res = if naf.(i) > 0 then res * x else res * x_inv in 583 | go found_nonzero res (int_sub i 1) 584 | else go found_nonzero res (int_sub i 1) 585 | in 586 | go false one (int_sub (Array.length naf) 1) 587 | 588 | let frobenius (c0, c1) power = 589 | ( Fp3.frobenius c0 power 590 | , Fp3.(scale (frobenius c1 power) Info.frobenius_coeffs_c1.(power mod 6)) 591 | ) 592 | end 593 | -------------------------------------------------------------------------------- /src/groth_maller.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Fold_lib 3 | 4 | let ( = ) = `Don't_use_polymorphic_equality 5 | 6 | module type Backend_intf = sig 7 | module N : Nat_intf.S 8 | 9 | module Fq : Fields.Fp_intf with type nat := N.t 10 | 11 | module Fqe : Fields.Extension_intf with type base = Fq.t 12 | 13 | module G1 : sig 14 | type t [@@deriving sexp, bin_io] 15 | 16 | val zero : t 17 | 18 | val to_affine_coordinates : t -> Fq.t * Fq.t 19 | 20 | val is_well_formed : t -> bool 21 | 22 | val ( * ) : N.t -> t -> t 23 | 24 | val ( + ) : t -> t -> t 25 | end 26 | 27 | module G2 : sig 28 | type t [@@deriving sexp, bin_io] 29 | 30 | val to_affine_coordinates : t -> Fqe.t * Fqe.t 31 | 32 | val ( + ) : t -> t -> t 33 | 34 | val is_well_formed : t -> bool 35 | end 36 | 37 | module Fq_target : sig 38 | include Fields.Degree_2_extension_intf with type base = Fqe.t 39 | 40 | val unitary_inverse : t -> t 41 | end 42 | 43 | module Pairing : 44 | Pairing.S 45 | with module G1 := G1 46 | and module G2 := G2 47 | and module Fq_target := Fq_target 48 | end 49 | 50 | module Make (Backend : Backend_intf) = struct 51 | open Backend 52 | 53 | module Verification_key = struct 54 | type t = 55 | { h: G2.t 56 | ; g_alpha: G1.t 57 | ; h_beta: G2.t 58 | ; g_alpha_h_beta: Fq_target.t 59 | ; g_gamma: G1.t 60 | ; h_gamma: G2.t 61 | ; query: G1.t array } 62 | [@@deriving bin_io, sexp] 63 | 64 | let map_to_two t ~f = 65 | let xs, ys = 66 | List.fold_left t ~init:([], []) ~f:(fun (xs, ys) a -> 67 | let x, y = f a in 68 | (x :: xs, y :: ys) ) 69 | in 70 | (List.rev xs, List.rev ys) 71 | 72 | let fold_bits {h; g_alpha; h_beta; g_alpha_h_beta; g_gamma; h_gamma; query} 73 | = 74 | let g1s = Array.to_list query @ [g_alpha; g_gamma] in 75 | let g2s = [h; h_beta; h_gamma] in 76 | let gts = [Fq_target.unitary_inverse g_alpha_h_beta] in 77 | let g1_elts, g1_signs = map_to_two g1s ~f:G1.to_affine_coordinates in 78 | let non_zero_base_coordinate a = 79 | let x = Fqe.project_to_base a in 80 | assert (not (Fq.equal x Fq.zero)) ; 81 | x 82 | in 83 | let g2_elts, g2_signs = 84 | map_to_two g2s ~f:(fun g -> 85 | let x, y = G2.to_affine_coordinates g in 86 | (Fqe.to_base_elements x, non_zero_base_coordinate y) ) 87 | in 88 | let gt_elts, gt_signs = 89 | map_to_two gts ~f:(fun g -> 90 | (* g is unitary, so (a, b) satisfy a quadratic over Fqe and thus 91 | b is determined by a up to sign *) 92 | let a, b = g in 93 | (Fqe.to_base_elements a, non_zero_base_coordinate b) ) 94 | in 95 | let open Fold in 96 | let of_fq_list_list ls = 97 | let open Let_syntax in 98 | let%bind l = of_list ls in 99 | let%bind x = of_list l in 100 | Fq.fold_bits x 101 | in 102 | let parity_bit x = N.test_bit (Fq.to_bigint x) 0 in 103 | let parity_bits = Fn.compose (map ~f:parity_bit) of_list in 104 | concat_map (of_list g1_elts) ~f:Fq.fold_bits 105 | +> of_fq_list_list g2_elts +> of_fq_list_list gt_elts 106 | +> parity_bits g1_signs +> parity_bits g2_signs +> parity_bits gt_signs 107 | 108 | let fold t = Fold.group3 ~default:false (fold_bits t) 109 | 110 | module Processed = struct 111 | type t = 112 | { g_alpha: G1.t 113 | ; h_beta: G2.t 114 | ; g_alpha_h_beta: Fq_target.t 115 | ; g_gamma_pc: Pairing.G1_precomputation.t 116 | ; h_gamma_pc: Pairing.G2_precomputation.t 117 | ; h_pc: Pairing.G2_precomputation.t 118 | ; query: G1.t array } 119 | [@@deriving bin_io, sexp] 120 | 121 | let create {h; g_alpha; h_beta; g_alpha_h_beta; g_gamma; h_gamma; query} 122 | = 123 | { g_alpha 124 | ; h_beta 125 | ; g_alpha_h_beta 126 | ; g_gamma_pc= Pairing.G1_precomputation.create g_gamma 127 | ; h_gamma_pc= Pairing.G2_precomputation.create h_gamma 128 | ; h_pc= Pairing.G2_precomputation.create h 129 | ; query } 130 | end 131 | end 132 | 133 | let check b lab = if b then Ok () else Or_error.error_string lab 134 | 135 | module Proof = struct 136 | type t = {a: G1.t; b: G2.t; c: G1.t} [@@deriving bin_io, sexp] 137 | 138 | let is_well_formed {a; b; c} = 139 | let open Or_error.Let_syntax in 140 | let err x = 141 | sprintf "proof was not well-formed (%s was off its curve)" x 142 | in 143 | let%bind () = check (G1.is_well_formed a) (err "a") in 144 | let%bind () = check (G2.is_well_formed b) (err "b") in 145 | let%map () = check (G1.is_well_formed c) (err "c") in 146 | () 147 | end 148 | 149 | let verify (vk : Verification_key.Processed.t) input 150 | ({Proof.a; b; c} as proof) = 151 | let open Or_error.Let_syntax in 152 | let%bind () = 153 | check 154 | (Int.equal (List.length input) (Array.length vk.query - 1)) 155 | "Input length was not as expected" 156 | in 157 | let%bind () = Proof.is_well_formed proof in 158 | let input_acc = 159 | List.foldi input ~init:vk.query.(0) ~f:(fun i acc x -> 160 | let q = vk.query.(1 + i) in 161 | G1.(acc + (x * q)) ) 162 | in 163 | let test1 = 164 | let l = 165 | Pairing.unreduced_pairing G1.(a + vk.g_alpha) G2.(b + vk.h_beta) 166 | in 167 | let r1 = vk.g_alpha_h_beta in 168 | let r2 = 169 | Pairing.miller_loop 170 | (Pairing.G1_precomputation.create input_acc) 171 | vk.h_gamma_pc 172 | in 173 | let r3 = 174 | Pairing.miller_loop (Pairing.G1_precomputation.create c) vk.h_pc 175 | in 176 | let test = 177 | let open Fq_target in 178 | Pairing.final_exponentiation (unitary_inverse l * r2 * r3) * r1 179 | in 180 | Fq_target.(equal test one) 181 | in 182 | let%bind () = check test1 "First pairing check failed" in 183 | let test2 = 184 | let l = 185 | Pairing.miller_loop (Pairing.G1_precomputation.create a) vk.h_gamma_pc 186 | in 187 | let r = 188 | Pairing.miller_loop vk.g_gamma_pc (Pairing.G2_precomputation.create b) 189 | in 190 | let test2 = 191 | Pairing.final_exponentiation Fq_target.(l * unitary_inverse r) 192 | in 193 | Fq_target.(equal test2 one) 194 | in 195 | check test2 "Second pairing check failed" 196 | end 197 | -------------------------------------------------------------------------------- /src/mnt4753.ml: -------------------------------------------------------------------------------- 1 | open Fields 2 | module N = Nat 3 | 4 | module Fq = 5 | Make_fp 6 | (N) 7 | (struct 8 | let order = 9 | N.of_string 10 | "41898490967918953402344214791240637128170709919953949071783502921025352812571106773058893763790338921418070971888253786114353726529584385201591605722013126468931404347949840543007986327743462853720628051692141265303114721689601" 11 | end) 12 | 13 | let non_residue = Fq.of_int 13 14 | 15 | module Fq2 = struct 16 | module Params = struct 17 | let non_residue = non_residue 18 | end 19 | 20 | include Make_fp2 (Fq) (Params) 21 | end 22 | 23 | module Fq4 = struct 24 | module Params = struct 25 | let frobenius_coeffs_c1 = 26 | [| Fq.of_string "1" 27 | ; Fq.of_string 28 | "18691656569803771296244054523431852464958959799019013859007259692542121208304602539555350517075508287829753932558576476751900235650227380562700444433662761577027341858128610410779088384480737679672900770810745291515010467307990" 29 | ; Fq.of_string 30 | "41898490967918953402344214791240637128170709919953949071783502921025352812571106773058893763790338921418070971888253786114353726529584385201591605722013126468931404347949840543007986327743462853720628051692141265303114721689600" 31 | ; Fq.of_string 32 | "23206834398115182106100160267808784663211750120934935212776243228483231604266504233503543246714830633588317039329677309362453490879357004638891167538350364891904062489821230132228897943262725174047727280881395973788104254381611" 33 | |] 34 | 35 | let non_residue = Fq.(zero, one) 36 | end 37 | 38 | include Fields.Make_fp2 (Fq2) (Params) 39 | end 40 | 41 | module G1 = struct 42 | module Params = struct 43 | let a = Fq.of_string "2" 44 | 45 | let b = 46 | Fq.of_string 47 | "28798803903456388891410036793299405764940372360099938340752576406393880372126970068421383312482853541572780087363938442377933706865252053507077543420534380486492786626556269083255657125025963825610840222568694137138741554679540" 48 | end 49 | 50 | include Elliptic_curve.Make (N) (Fq) (Params) 51 | 52 | let one = 53 | of_affine_coordinates 54 | ( Fq.of_string 55 | "23803503838482697364219212396100314255266282256287758532210460958670711284501374254909249084643549104668878996224193897061976788052185662569738774028756446662400954817676947337090686257134874703224133183061214213216866019444443" 56 | , Fq.of_string 57 | "21091012152938225813050540665280291929032924333518476279110711148670464794818544820522390295209715531901248676888544060590943737249563733104806697968779796610374994498702698840169538725164956072726942500665132927942037078135054" 58 | ) 59 | end 60 | 61 | module G2 = struct 62 | module Params = struct 63 | let a = Fq.(G1.Params.a * non_residue, zero) 64 | 65 | let b = Fq.(zero, G1.Params.b * non_residue) 66 | end 67 | 68 | include Elliptic_curve.Make (N) (Fq2) (Params) 69 | 70 | let one = 71 | of_affine_coordinates 72 | Fq. 73 | ( ( of_string 74 | "22367666623321080720060256844679369841450849258634485122226826668687008928557241162389052587294939105987791589807198701072089850184203060629036090027206884547397819080026926412256978135536735656049173059573120822105654153939204" 75 | , of_string 76 | "19674349354065582663569886390557105215375764356464013910804136534831880915742161945711267871023918136941472003751075703860943205026648847064247080124670799190998395234694182621794580160576822167228187443851233972049521455293042" 77 | ) 78 | , ( of_string 79 | "6945425020677398967988875731588951175743495235863391886533295045397037605326535330657361771765903175481062759367498970743022872494546449436815843306838794729313050998681159000579427733029709987073254733976366326071957733646574" 80 | , of_string 81 | "17406100775489352738678485154027036191618283163679980195193677896785273172506466216232026037788788436442188057889820014276378772936042638717710384987239430912364681046070625200474931975266875995282055499803236813013874788622488" 82 | ) ) 83 | end 84 | 85 | module Pairing_info = struct 86 | let twist = Fq.(zero, one) 87 | 88 | let loop_count = 89 | N.of_string 90 | "204691208819330962009469868104636132783269696790011977400223898462431810102935615891307667367766898917669754470400" 91 | 92 | let is_loop_count_neg = true 93 | 94 | let final_exponent = 95 | N.of_string 96 | "73552111470802397192299133782080682301728710523587802164414953272757803714910813694725910843025422137965798141904448425397132210312763036419196981551382130855705368355580393262211100095907456271531280742739919708794230272306800896198050256355512255795343046414500439648235407402928016221629661971660368018858492377211675996627011913832155809286572006511506918479348970121218134056996473102963627909657625079190739882316882751992741238799066378820181352081085141743775089602078041985556107852922590029377522580702957164527112688206145822971278968699082020672631957410786162945929223941353438866102009621402205679750863679130426460044792078113778548067020007452390228240608175718400" 97 | 98 | let final_exponent_last_chunk_abs_of_w0 = 99 | N.of_string 100 | "204691208819330962009469868104636132783269696790011977400223898462431810102935615891307667367766898917669754470399" 101 | 102 | let final_exponent_last_chunk_is_w0_neg = true 103 | 104 | let final_exponent_last_chunk_w1 = N.of_string "1" 105 | end 106 | -------------------------------------------------------------------------------- /src/mnt4_80.ml: -------------------------------------------------------------------------------- 1 | open Fields 2 | module N = Nat 3 | 4 | module Fq = 5 | Make_fp 6 | (N) 7 | (struct 8 | let order = 9 | N.of_string 10 | "475922286169261325753349249653048451545124879242694725395555128576210262817955800483758081" 11 | end) 12 | 13 | let non_residue = Fq.of_int 17 14 | 15 | module Fq2 = struct 16 | module Params = struct 17 | let non_residue = non_residue 18 | end 19 | 20 | include Make_fp2 (Fq) (Params) 21 | end 22 | 23 | module Fq4 = struct 24 | module Params = struct 25 | let frobenius_coeffs_c1 = 26 | [| Fq.of_string "1" 27 | ; Fq.of_string 28 | "7684163245453501615621351552473337069301082060976805004625011694147890954040864167002308" 29 | ; Fq.of_string 30 | "475922286169261325753349249653048451545124879242694725395555128576210262817955800483758080" 31 | ; Fq.of_string 32 | "468238122923807824137727898100575114475823797181717920390930116882062371863914936316755773" 33 | |] 34 | 35 | let non_residue = Fq.(zero, one) 36 | end 37 | 38 | include Fields.Make_fp2 (Fq2) (Params) 39 | end 40 | 41 | module G1 = struct 42 | module Params = struct 43 | let a = Fq.of_string "2" 44 | 45 | let b = 46 | Fq.of_string 47 | "423894536526684178289416011533888240029318103673896002803341544124054745019340795360841685" 48 | end 49 | 50 | include Elliptic_curve.Make (N) (Fq) (Params) 51 | 52 | let one = 53 | of_affine_coordinates 54 | ( Fq.of_string 55 | "336685752883082228109289846353937104185698209371404178342968838739115829740084426881123453" 56 | , Fq.of_string 57 | "402596290139780989709332707716568920777622032073762749862342374583908837063963736098549800" 58 | ) 59 | end 60 | 61 | module G2 = struct 62 | module Params = struct 63 | let a = Fq.(G1.Params.a * non_residue, zero) 64 | 65 | let b = Fq.(zero, G1.Params.b * non_residue) 66 | end 67 | 68 | include Elliptic_curve.Make (N) (Fq2) (Params) 69 | 70 | let one = 71 | of_affine_coordinates 72 | Fq. 73 | ( ( of_string 74 | "438374926219350099854919100077809681842783509163790991847867546339851681564223481322252708" 75 | , of_string 76 | "37620953615500480110935514360923278605464476459712393277679280819942849043649216370485641" 77 | ) 78 | , ( of_string 79 | "37437409008528968268352521034936931842973546441370663118543015118291998305624025037512482" 80 | , of_string 81 | "424621479598893882672393190337420680597584695892317197646113820787463109735345923009077489" 82 | ) ) 83 | end 84 | 85 | module Pairing_info = struct 86 | let twist = Fq.(zero, one) 87 | 88 | let loop_count = N.of_string "689871209842287392837045615510547309923794944" 89 | 90 | let is_loop_count_neg = false 91 | 92 | let final_exponent = 93 | N.of_string 94 | "107797360357109903430794490309592072278927783803031854357910908121903439838772861497177116410825586743089760869945394610511917274977971559062689561855016270594656570874331111995170645233717143416875749097203441437192367065467706065411650403684877366879441766585988546560" 95 | 96 | let final_exponent_last_chunk_abs_of_w0 = 97 | N.of_string "689871209842287392837045615510547309923794945" 98 | 99 | let final_exponent_last_chunk_is_w0_neg = false 100 | 101 | let final_exponent_last_chunk_w1 = N.of_string "1" 102 | end 103 | -------------------------------------------------------------------------------- /src/mnt6753.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Fields 3 | module N = Nat 4 | 5 | module Fq = 6 | Make_fp 7 | (N) 8 | (struct 9 | let order = 10 | N.of_string 11 | "41898490967918953402344214791240637128170709919953949071783502921025352812571106773058893763790338921418070971888458477323173057491593855069696241854796396165721416325350064441470418137846398469611935719059908164220784476160001" 12 | end) 13 | 14 | let non_residue = Fq.of_int 11 15 | 16 | module Fq3 = struct 17 | module Params = struct 18 | let non_residue = non_residue 19 | 20 | let frobenius_coeffs_c1 = 21 | [| Fq.of_string "1" 22 | ; Fq.of_string 23 | "24129022407817241407134263419936114379815707076943508280977368156625538709102831814843582780138963119807143081677569721953561801075623741378629346409604471234573396989178424163772589090105392407118197799904755622897541183052132" 24 | ; Fq.of_string 25 | "17769468560101711995209951371304522748355002843010440790806134764399814103468274958215310983651375801610927890210888755369611256415970113691066895445191924931148019336171640277697829047741006062493737919155152541323243293107868" 26 | |] 27 | 28 | let frobenius_coeffs_c2 = 29 | [| Fq.of_string "1" 30 | ; Fq.of_string 31 | "17769468560101711995209951371304522748355002843010440790806134764399814103468274958215310983651375801610927890210888755369611256415970113691066895445191924931148019336171640277697829047741006062493737919155152541323243293107868" 32 | ; Fq.of_string 33 | "24129022407817241407134263419936114379815707076943508280977368156625538709102831814843582780138963119807143081677569721953561801075623741378629346409604471234573396989178424163772589090105392407118197799904755622897541183052132" 34 | |] 35 | end 36 | 37 | include Make_fp3 (Fq) (Params) 38 | end 39 | 40 | module Fq2 = 41 | Make_fp2 42 | (Fq) 43 | (struct 44 | let non_residue = non_residue 45 | end) 46 | 47 | module Fq6 = struct 48 | module Params = struct 49 | let non_residue = non_residue 50 | 51 | let frobenius_coeffs_c1 = 52 | Array.map ~f:Fq.of_string 53 | [| "1" 54 | ; "24129022407817241407134263419936114379815707076943508280977368156625538709102831814843582780138963119807143081677569721953561801075623741378629346409604471234573396989178424163772589090105392407118197799904755622897541183052133" 55 | ; "24129022407817241407134263419936114379815707076943508280977368156625538709102831814843582780138963119807143081677569721953561801075623741378629346409604471234573396989178424163772589090105392407118197799904755622897541183052132" 56 | ; "41898490967918953402344214791240637128170709919953949071783502921025352812571106773058893763790338921418070971888458477323173057491593855069696241854796396165721416325350064441470418137846398469611935719059908164220784476160000" 57 | ; "17769468560101711995209951371304522748355002843010440790806134764399814103468274958215310983651375801610927890210888755369611256415970113691066895445191924931148019336171640277697829047741006062493737919155152541323243293107868" 58 | ; "17769468560101711995209951371304522748355002843010440790806134764399814103468274958215310983651375801610927890210888755369611256415970113691066895445191924931148019336171640277697829047741006062493737919155152541323243293107869" 59 | |] 60 | end 61 | 62 | include Make_fp6 (N) (Fq) (Fq2) (Fq3) (Params) 63 | end 64 | 65 | module G1 = struct 66 | include Elliptic_curve.Make (N) (Fq) 67 | (struct 68 | let a = Fq.of_string "11" 69 | 70 | let b = 71 | Fq.of_string 72 | "11625908999541321152027340224010374716841167701783584648338908235410859267060079819722747939267925389062611062156601938166010098747920378738927832658133625454260115409075816187555055859490253375704728027944315501122723426879114" 73 | end) 74 | 75 | let one : t = 76 | { x= 77 | Fq.of_string 78 | "16364236387491689444759057944334173579070747473738339749093487337644739228935268157504218078126401066954815152892688541654726829424326599038522503517302466226143788988217410842672857564665527806044250003808514184274233938437290" 79 | ; y= 80 | Fq.of_string 81 | "4510127914410645922431074687553594593336087066778984214797709122300210966076979927285161950203037801392624582544098750667549188549761032654706830225743998064330900301346566408501390638273322467173741629353517809979540986561128" 82 | ; z= Fq.one } 83 | end 84 | 85 | module G2 = struct 86 | include Elliptic_curve.Make (N) (Fq3) 87 | (struct 88 | let a : Fq3.t = (Fq.zero, Fq.zero, G1.Coefficients.a) 89 | 90 | let b : Fq3.t = 91 | (Fq.(G1.Coefficients.b * Fq3.non_residue), Fq.zero, Fq.zero) 92 | end) 93 | 94 | let one : t = 95 | let open Fq in 96 | { z= Fq3.one 97 | ; x= 98 | ( of_string 99 | "46538297238006280434045879335349383221210789488441126073640895239023832290080310125413049878152095926176013036314720850781686614265244307536450228450615346834324267478485994670716807428718518299710702671895190475661871557310" 100 | , of_string 101 | "10329739935427016564561842963551883445915701424214177782911128765230271790215029185795830999583638744119368571742929964793955375930677178544873424392910884024986348059137449389533744851691082159233065444766899262771358355816328" 102 | , of_string 103 | "19962817058174334691864015232062671736353756221485896034072814261894530786568591431279230352444205682361463997175937973249929732063490256813101714586199642571344378012210374327764059557816647980334733538226843692316285591005879" 104 | ) 105 | ; y= 106 | ( of_string 107 | "5648166377754359996653513138027891970842739892107427747585228022871109585680076240624013411622970109911154113378703562803827053335040877618934773712021441101121297691389632155906182656254145368668854360318258860716497525179898" 108 | , of_string 109 | "26817850356025045630477313828875808893994935265863280918207940412617168254772789578700316551065949899971937475487458539503514034928974530432009759562975983077355912050606509147904958229398389093697494174311832813615564256810453" 110 | , of_string 111 | "32332319709358578441696731586704495581796858962594701633932927358040566210788542624963749336109940335257143899293177116050031684054348958813290781394131284657165540476824211295508498842102093219808642563477603392470909217611033" 112 | ) } 113 | end 114 | 115 | module Pairing_info = struct 116 | let twist : Fq3.t = Fq.(zero, one, zero) 117 | 118 | let loop_count = 119 | N.of_string 120 | "204691208819330962009469868104636132783269696790011977400223898462431810102935615891307667367766898917669754470400" 121 | 122 | let is_loop_count_neg = false 123 | 124 | let final_exponent = 125 | N.of_string 126 | "129119521415595396014710306456032421075529786121916339618043051454538645105373777417137765707049510513015090026587997279208509759539952171373399816556184658054246934445122434683712249758515142075912382855071692226902812699306965286452865875620478620415339135536651578138124630852841411245063114044076427626521354349718502952988285309849333541213630352110932043828698936614474460281448819530109126473106492442797180252857193080048552501189491359213783058841481431978392771722128135286229420891567559544903231970966039315305865230923024300814788334307759652908820805819427293129932717325550045066338621261382334584633469485279042507653112873505613662346162595624798718660978835342384244182483671072189980911818690903244207181753883232560300278713216908336381030175242331281836803196022816489406715804002685525498662502919760346302653911463614694097216541218340832160715975576449518733830908486041613391828183354500089193133793376316346927602330584336604894214847791219714282509301093232896394808735738348953422584365914239193758384912179069975047674736700432948221178135004609440079320720726286913134205559121306917942266019404840960000" 127 | 128 | let final_exponent_last_chunk_abs_of_w0 = 129 | N.of_string 130 | "204691208819330962009469868104636132783269696790011977400223898462431810102935615891307667367766898917669754470400" 131 | 132 | let final_exponent_last_chunk_is_w0_neg = false 133 | 134 | let final_exponent_last_chunk_w1 = N.of_string "1" 135 | end 136 | 137 | module Pairing = Pairing.Make (N) (Fq) (Fq3) (Fq6) (G1) (G2) (Pairing_info) 138 | 139 | module Groth_maller = Groth_maller.Make (struct 140 | module N = N 141 | module G1 = G1 142 | module G2 = G2 143 | module Fq = Fq 144 | module Fqe = Fq3 145 | module Fq_target = Fq6 146 | module Pairing = Pairing 147 | end) 148 | -------------------------------------------------------------------------------- /src/mnt6_80.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Fields 3 | module N = Nat 4 | 5 | module Fq = 6 | Make_fp 7 | (N) 8 | (struct 9 | let order = 10 | N.of_string 11 | "475922286169261325753349249653048451545124878552823515553267735739164647307408490559963137" 12 | end) 13 | 14 | let non_residue = Fq.of_int 5 15 | 16 | module Fq3 = struct 17 | module Params = struct 18 | let non_residue = non_residue 19 | 20 | let frobenius_coeffs_c1 = 21 | [| Fq.of_string "1" 22 | ; Fq.of_string 23 | "471738898967521029133040851318449165997304108729558973770077319830005517129946578866686956" 24 | ; Fq.of_string 25 | "4183387201740296620308398334599285547820769823264541783190415909159130177461911693276180" 26 | |] 27 | 28 | let frobenius_coeffs_c2 = 29 | [| Fq.of_string "1" 30 | ; Fq.of_string 31 | "4183387201740296620308398334599285547820769823264541783190415909159130177461911693276180" 32 | ; Fq.of_string 33 | "471738898967521029133040851318449165997304108729558973770077319830005517129946578866686956" 34 | |] 35 | end 36 | 37 | include Make_fp3 (Fq) (Params) 38 | end 39 | 40 | module Fq2 = 41 | Make_fp2 42 | (Fq) 43 | (struct 44 | let non_residue = non_residue 45 | end) 46 | 47 | module Fq6 = struct 48 | module Params = struct 49 | let non_residue = non_residue 50 | 51 | let frobenius_coeffs_c1 = 52 | Array.map ~f:Fq.of_string 53 | [| "1" 54 | ; "471738898967521029133040851318449165997304108729558973770077319830005517129946578866686957" 55 | ; "471738898967521029133040851318449165997304108729558973770077319830005517129946578866686956" 56 | ; "475922286169261325753349249653048451545124878552823515553267735739164647307408490559963136" 57 | ; "4183387201740296620308398334599285547820769823264541783190415909159130177461911693276180" 58 | ; "4183387201740296620308398334599285547820769823264541783190415909159130177461911693276181" 59 | |] 60 | end 61 | 62 | include Make_fp6 (N) (Fq) (Fq2) (Fq3) (Params) 63 | end 64 | 65 | module G1 = struct 66 | include Elliptic_curve.Make (N) (Fq) 67 | (struct 68 | let a = Fq.of_string "11" 69 | 70 | let b = 71 | Fq.of_string 72 | "106700080510851735677967319632585352256454251201367587890185989362936000262606668469523074" 73 | end) 74 | 75 | let one : t = 76 | { x= 77 | Fq.of_string 78 | "336685752883082228109289846353937104185698209371404178342968838739115829740084426881123453" 79 | ; y= 80 | Fq.of_string 81 | "402596290139780989709332707716568920777622032073762749862342374583908837063963736098549800" 82 | ; z= Fq.one } 83 | end 84 | 85 | module G2 = struct 86 | include Elliptic_curve.Make (N) (Fq3) 87 | (struct 88 | let a : Fq3.t = (Fq.zero, Fq.zero, G1.Coefficients.a) 89 | 90 | let b : Fq3.t = 91 | (Fq.(G1.Coefficients.b * Fq3.non_residue), Fq.zero, Fq.zero) 92 | end) 93 | 94 | let one : t = 95 | let open Fq in 96 | { z= Fq3.one 97 | ; x= 98 | ( of_string 99 | "421456435772811846256826561593908322288509115489119907560382401870203318738334702321297427" 100 | , of_string 101 | "103072927438548502463527009961344915021167584706439945404959058962657261178393635706405114" 102 | , of_string 103 | "143029172143731852627002926324735183809768363301149009204849580478324784395590388826052558" 104 | ) 105 | ; y= 106 | ( of_string 107 | "464673596668689463130099227575639512541218133445388869383893594087634649237515554342751377" 108 | , of_string 109 | "100642907501977375184575075967118071807821117960152743335603284583254620685343989304941678" 110 | , of_string 111 | "123019855502969896026940545715841181300275180157288044663051565390506010149881373807142903" 112 | ) } 113 | end 114 | 115 | module Pairing_info = struct 116 | let twist : Fq3.t = Fq.(zero, one, zero) 117 | 118 | let loop_count = N.of_string "689871209842287392837045615510547309923794944" 119 | 120 | let is_loop_count_neg = true 121 | 122 | let final_exponent = 123 | N.of_string 124 | "24416320138090509697890595414313438768353977489862543935904010715439066975957855922532159264213056712140358746422742237328406558352706591021642230618060502855451264045397444793186876199015256781648746888625527075466063075011307800862173764236311342105211681121426931616843635215852236649271569251468773714424208521977615548771268520882870120900360322044218806712027729351845307690474985502587527753847200130592058098363641559341826790559426614919168" 125 | 126 | let final_exponent_last_chunk_abs_of_w0 = 127 | N.of_string "689871209842287392837045615510547309923794944" 128 | 129 | let final_exponent_last_chunk_is_w0_neg = true 130 | 131 | let final_exponent_last_chunk_w1 = N.of_string "1" 132 | end 133 | 134 | module Pairing = Pairing.Make (N) (Fq) (Fq3) (Fq6) (G1) (G2) (Pairing_info) 135 | 136 | module Groth_maller = Groth_maller.Make (struct 137 | module N = N 138 | module G1 = G1 139 | module G2 = G2 140 | module Fq = Fq 141 | module Fqe = Fq3 142 | module Fq_target = Fq6 143 | module Pairing = Pairing 144 | end) 145 | -------------------------------------------------------------------------------- /src/nat.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type t = Big_int.big_int 4 | 5 | let equal = Big_int.eq_big_int 6 | 7 | let num_bits = Big_int.num_bits_big_int 8 | 9 | let shift_right = Big_int.shift_right_big_int 10 | 11 | let shift_left = Big_int.shift_left_big_int 12 | 13 | let log_and = Big_int.and_big_int 14 | 15 | let log_or = Big_int.or_big_int 16 | 17 | let of_int = Big_int.big_int_of_int 18 | 19 | let test_bit t i = 20 | equal (log_and Big_int.unit_big_int (shift_right t i)) Big_int.unit_big_int 21 | 22 | let to_bytes x = 23 | let n = num_bits x in 24 | let num_bytes = (n + 7) / 8 in 25 | String.init num_bytes ~f:(fun byte -> 26 | let c i = 27 | let bit = (8 * byte) + i in 28 | if test_bit x bit then 1 lsl i else 0 29 | in 30 | Char.of_int_exn 31 | (c 0 lor c 1 lor c 2 lor c 3 lor c 4 lor c 5 lor c 6 lor c 7) ) 32 | 33 | let of_bytes x = 34 | String.foldi x ~init:Big_int.zero_big_int ~f:(fun i acc c -> 35 | log_or acc (shift_left (of_int (Char.to_int c)) (8 * i)) ) 36 | 37 | let ( + ) = Big_int.add_big_int 38 | 39 | let ( - ) = Big_int.sub_big_int 40 | 41 | let ( * ) = Big_int.mult_big_int 42 | 43 | let ( % ) = Big_int.mod_big_int 44 | 45 | let ( // ) = Big_int.div_big_int 46 | 47 | let ( < ) = Big_int.lt_big_int 48 | 49 | let to_int_exn = Big_int.int_of_big_int 50 | 51 | let compare = Big_int.compare_big_int 52 | 53 | module String_hum = struct 54 | type nonrec t = t 55 | 56 | let of_string = Big_int.big_int_of_string 57 | 58 | let to_string = Big_int.string_of_big_int 59 | end 60 | 61 | include Sexpable.Of_stringable (String_hum) 62 | 63 | include (String_hum : Stringable.S with type t := t) 64 | 65 | include Binable.Of_stringable (struct 66 | type nonrec t = t 67 | 68 | let of_string = of_bytes 69 | 70 | let to_string = to_bytes 71 | end) 72 | -------------------------------------------------------------------------------- /src/nat.mli: -------------------------------------------------------------------------------- 1 | include Nat_intf.S 2 | -------------------------------------------------------------------------------- /src/nat_intf.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | module type S = sig 4 | type t [@@deriving eq, bin_io, sexp, compare] 5 | 6 | include Stringable.S with type t := t 7 | 8 | val of_int : int -> t 9 | 10 | val to_int_exn : t -> int 11 | 12 | val ( < ) : t -> t -> bool 13 | 14 | val ( + ) : t -> t -> t 15 | 16 | val ( * ) : t -> t -> t 17 | 18 | val ( - ) : t -> t -> t 19 | 20 | val ( // ) : t -> t -> t 21 | 22 | val ( % ) : t -> t -> t 23 | 24 | val shift_left : t -> int -> t 25 | 26 | val shift_right : t -> int -> t 27 | 28 | val log_and : t -> t -> t 29 | 30 | val log_or : t -> t -> t 31 | 32 | val test_bit : t -> int -> bool 33 | 34 | val num_bits : t -> int 35 | end 36 | -------------------------------------------------------------------------------- /src/pairing.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | module Extended_projective = struct 4 | type 'a t = {x: 'a; y: 'a; z: 'a; t: 'a} [@@deriving sexp] 5 | end 6 | 7 | module type Simple_elliptic_curve_intf = sig 8 | type base 9 | 10 | type t 11 | 12 | val to_affine_coordinates : t -> base * base 13 | end 14 | 15 | module type S = sig 16 | module G1 : sig 17 | type t 18 | end 19 | 20 | module G2 : sig 21 | type t 22 | end 23 | 24 | module Fq_target : sig 25 | type t 26 | end 27 | 28 | module G1_precomputation : sig 29 | type t [@@deriving bin_io, sexp] 30 | 31 | val create : G1.t -> t 32 | end 33 | 34 | module G2_precomputation : sig 35 | type t [@@deriving bin_io, sexp] 36 | 37 | val create : G2.t -> t 38 | end 39 | 40 | val final_exponentiation : Fq_target.t -> Fq_target.t 41 | 42 | val miller_loop : G1_precomputation.t -> G2_precomputation.t -> Fq_target.t 43 | 44 | val unreduced_pairing : G1.t -> G2.t -> Fq_target.t 45 | 46 | val reduced_pairing : G1.t -> G2.t -> Fq_target.t 47 | end 48 | 49 | module Make 50 | (N : Nat_intf.S) 51 | (Fq : Fields.Fp_intf with type nat := N.t) 52 | (Fq_twist : Fields.Extension_intf with type base = Fq.t) (Fq_target : sig 53 | include Fields.Degree_2_extension_intf with type base = Fq_twist.t 54 | 55 | val frobenius : t -> int -> t 56 | 57 | val cyclotomic_exp : t -> N.t -> t 58 | end) 59 | (G1 : Simple_elliptic_curve_intf with type base := Fq.t) (G2 : sig 60 | include Simple_elliptic_curve_intf with type base := Fq_twist.t 61 | 62 | module Coefficients : sig 63 | val a : Fq_twist.t 64 | end 65 | end) (Info : sig 66 | val twist : Fq_twist.t 67 | 68 | val loop_count : N.t 69 | 70 | val is_loop_count_neg : bool 71 | 72 | val final_exponent_last_chunk_w1 : N.t 73 | 74 | val final_exponent_last_chunk_is_w0_neg : bool 75 | 76 | val final_exponent_last_chunk_abs_of_w0 : N.t 77 | end) : 78 | S with module G1 := G1 and module G2 := G2 and module Fq_target := Fq_target = 79 | struct 80 | module G1_precomputation = struct 81 | type t = {px: Fq.t; py: Fq.t; px_twist: Fq_twist.t; py_twist: Fq_twist.t} 82 | [@@deriving bin_io, sexp] 83 | 84 | let create (p : G1.t) = 85 | let px, py = G1.to_affine_coordinates p in 86 | { px 87 | ; py 88 | ; px_twist= Fq_twist.scale Info.twist px 89 | ; py_twist= Fq_twist.scale Info.twist py } 90 | end 91 | 92 | module Dbl_coeffs = struct 93 | type t = 94 | {c_H: Fq_twist.t; c_4C: Fq_twist.t; c_J: Fq_twist.t; c_L: Fq_twist.t} 95 | [@@deriving bin_io, sexp] 96 | end 97 | 98 | module Add_coeffs = struct 99 | type t = {c_L1: Fq_twist.t; c_RZ: Fq_twist.t} [@@deriving bin_io, sexp] 100 | end 101 | 102 | let loop_count_size_in_bits = N.num_bits Info.loop_count 103 | 104 | module G2_precomputation = struct 105 | type t = 106 | { qx: Fq_twist.t 107 | ; qy: Fq_twist.t 108 | ; qy2: Fq_twist.t 109 | ; qx_over_twist: Fq_twist.t 110 | ; qy_over_twist: Fq_twist.t 111 | ; dbl_coeffs: Dbl_coeffs.t array 112 | ; add_coeffs: Add_coeffs.t array } 113 | [@@deriving bin_io, sexp] 114 | 115 | let twist_inv = Fq_twist.inv Info.twist 116 | 117 | let doubling_step_for_flipped_miller_loop 118 | ({Extended_projective.x; y; z= _; t} as current) = 119 | let a = Fq_twist.square t in 120 | let b = Fq_twist.square x in 121 | let c = Fq_twist.square y in 122 | let d = Fq_twist.square c in 123 | let e = Fq_twist.(square (x + c) - b - d) in 124 | let f = Fq_twist.(b + b + b + (G2.Coefficients.a * a)) in 125 | let g = Fq_twist.square f in 126 | let next = 127 | let x = Fq_twist.(negate (e + e + e + e) + g) in 128 | let y = 129 | Fq_twist.(scale d Fq.(negate (of_int 8)) + (f * (e + e - x))) 130 | in 131 | let z = 132 | Fq_twist.(square (current.y + current.z) - c - square current.z) 133 | in 134 | let t = Fq_twist.square z in 135 | {Extended_projective.x; y; z; t} 136 | in 137 | let coeffs = 138 | { Dbl_coeffs.c_H= Fq_twist.(square (next.z + current.t) - next.t - a) 139 | ; c_4C= Fq_twist.(c + c + c + c) 140 | ; c_J= Fq_twist.(square (f + t) - g - a) 141 | ; c_L= Fq_twist.(square (f + current.x) - g - b) } 142 | in 143 | (next, coeffs) 144 | 145 | let mixed_addition_step_for_flipped_miller_loop base_x base_y 146 | base_y_squared {Extended_projective.x= x1; y= y1; z= z1; t= t1} = 147 | let open Fq_twist in 148 | let b = base_x * t1 in 149 | let d = (square (base_y + z1) - base_y_squared - t1) * t1 in 150 | let h = b - x1 in 151 | let i = Fq_twist.square h in 152 | let e = i + i + i + i in 153 | let j = h * e in 154 | let v = x1 * e in 155 | let l1 = d - (y1 + y1) in 156 | let next = 157 | let x = square l1 - j - (v + v) in 158 | let y = (l1 * (v - x)) - ((y1 + y1) * j) in 159 | let z = square (z1 + h) - t1 - i in 160 | let t = square z in 161 | {Extended_projective.x; y; z; t} 162 | in 163 | (next, {Add_coeffs.c_L1= l1; c_RZ= next.z}) 164 | 165 | let create (q : G2.t) = 166 | let qx, qy = G2.to_affine_coordinates q in 167 | let qy2 = Fq_twist.square qy in 168 | let qx_over_twist = Fq_twist.(qx * twist_inv) in 169 | let qy_over_twist = Fq_twist.(qy * twist_inv) in 170 | let rec go found_one r dbl_coeffs add_coeffs i = 171 | if i < 0 then (r, dbl_coeffs, add_coeffs) 172 | else 173 | let bit = N.test_bit Info.loop_count i in 174 | if not found_one then 175 | go (found_one || bit) r dbl_coeffs add_coeffs (i - 1) 176 | else 177 | let r, dc = doubling_step_for_flipped_miller_loop r in 178 | let dbl_coeffs = dc :: dbl_coeffs in 179 | if bit then 180 | let r, ac = 181 | mixed_addition_step_for_flipped_miller_loop qx qy qy2 r 182 | in 183 | let add_coeffs = ac :: add_coeffs in 184 | go found_one r dbl_coeffs add_coeffs (i - 1) 185 | else go found_one r dbl_coeffs add_coeffs (i - 1) 186 | in 187 | let r, dbl_coeffs, add_coeffs = 188 | go false 189 | {x= qx; y= qy; z= Fq_twist.one; t= Fq_twist.one} 190 | [] [] 191 | (loop_count_size_in_bits - 1) 192 | in 193 | let add_coeffs = 194 | if not Info.is_loop_count_neg then add_coeffs 195 | else 196 | let open Fq_twist in 197 | let rZ_inv = inv r.z in 198 | let rZ2_inv = square rZ_inv in 199 | let rZ3_inv = rZ2_inv * rZ_inv in 200 | let minus_R_affine_X = r.x * rZ2_inv in 201 | let minus_R_affine_Y = negate r.y * rZ3_inv in 202 | let minus_R_affine_Y2 = square minus_R_affine_Y in 203 | let _r, ac = 204 | mixed_addition_step_for_flipped_miller_loop minus_R_affine_X 205 | minus_R_affine_Y minus_R_affine_Y2 r 206 | in 207 | ac :: add_coeffs 208 | in 209 | { qx 210 | ; qy 211 | ; qy2 212 | ; qx_over_twist 213 | ; qy_over_twist 214 | ; dbl_coeffs= Array.of_list (List.rev dbl_coeffs) 215 | ; add_coeffs= Array.of_list (List.rev add_coeffs) } 216 | end 217 | 218 | let miller_loop (p : G1_precomputation.t) (q : G2_precomputation.t) = 219 | let l1_coeff = Fq_twist.(of_base p.px - q.qx_over_twist) in 220 | let f = ref Fq_target.one in 221 | let found_one = ref false in 222 | let dbl_idx_r = ref 0 in 223 | let add_idx_r = ref 0 in 224 | for i = loop_count_size_in_bits - 1 downto 0 do 225 | let bit = N.test_bit Info.loop_count i in 226 | if not !found_one then found_one := !found_one || bit 227 | else 228 | let dbl_idx = !dbl_idx_r in 229 | incr dbl_idx_r ; 230 | let dc = q.dbl_coeffs.(dbl_idx) in 231 | let g_RR_at_P : Fq_target.t = 232 | let open Fq_twist in 233 | (negate dc.c_4C - (dc.c_J * p.px_twist) + dc.c_L, dc.c_H * p.py_twist) 234 | in 235 | (f := Fq_target.(square !f * g_RR_at_P)) ; 236 | if bit then ( 237 | let add_idx = !add_idx_r in 238 | incr add_idx_r ; 239 | let ac = q.add_coeffs.(add_idx) in 240 | let g_RQ_at_P = 241 | let open Fq_twist in 242 | ( ac.c_RZ * p.py_twist 243 | , negate ((q.qy_over_twist * ac.c_RZ) + (l1_coeff * ac.c_L1)) ) 244 | in 245 | f := Fq_target.(!f * g_RQ_at_P) ) 246 | done ; 247 | if Info.is_loop_count_neg then ( 248 | let add_idx = !add_idx_r in 249 | incr add_idx_r ; 250 | let ac = q.add_coeffs.(add_idx) in 251 | let g_RnegR_at_P = 252 | let open Fq_twist in 253 | ( ac.c_RZ * p.py_twist 254 | , negate ((q.qy_over_twist * ac.c_RZ) + (l1_coeff * ac.c_L1)) ) 255 | in 256 | f := Fq_target.(inv (!f * g_RnegR_at_P)) ) ; 257 | !f 258 | 259 | let unreduced_pairing p q = 260 | miller_loop (G1_precomputation.create p) (G2_precomputation.create q) 261 | 262 | let final_exponentiation_first_chunk elt elt_inv = 263 | let open Fq_target in 264 | let elt_q3 = frobenius elt 3 in 265 | let elt_q3_over_elt = elt_q3 * elt_inv in 266 | let alpha = frobenius elt_q3_over_elt 1 in 267 | alpha * elt_q3_over_elt 268 | 269 | let final_exponentiation_last_chunk elt elt_inv = 270 | let open Fq_target in 271 | let elt_q = frobenius elt 1 in 272 | let w1_part = cyclotomic_exp elt_q Info.final_exponent_last_chunk_w1 in 273 | let w0_part = 274 | if Info.final_exponent_last_chunk_is_w0_neg then 275 | cyclotomic_exp elt_inv Info.final_exponent_last_chunk_abs_of_w0 276 | else cyclotomic_exp elt Info.final_exponent_last_chunk_abs_of_w0 277 | in 278 | w1_part * w0_part 279 | 280 | let final_exponentiation x = 281 | let x_inv = Fq_target.inv x in 282 | let x_to_first_chunk = final_exponentiation_first_chunk x x_inv in 283 | let x_inv_to_first_chunk = final_exponentiation_first_chunk x_inv x in 284 | final_exponentiation_last_chunk x_to_first_chunk x_inv_to_first_chunk 285 | 286 | let reduced_pairing p q = final_exponentiation (unreduced_pairing p q) 287 | end 288 | -------------------------------------------------------------------------------- /tuple_lib.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | version: "0.1" 3 | build: [ 4 | ["dune" "build" "--only" "src" "--root" "." "-j" jobs "@install"] 5 | ] 6 | --------------------------------------------------------------------------------