package octez-libs

  1. Overview
  2. Docs
package octez-libs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file bls12_381_signature.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
module CommonStubs = struct
  type ctxt

  type scalar

  external allocate_g1_affine : unit -> Bls12_381.G1.affine
    = "allocate_p1_affine_stubs"

  external allocate_g2_affine : unit -> Bls12_381.G2.affine
    = "allocate_p2_affine_stubs"

  external uncompress_g1 : Bls12_381.G1.affine -> Bytes.t -> int
    = "caml_blst_p1_uncompress_stubs"

  external uncompress_g2 : Bls12_381.G2.affine -> Bytes.t -> int
    = "caml_blst_p2_uncompress_stubs"

  external allocate_scalar : unit -> scalar = "allocate_scalar_stubs"

  external scalar_of_fr : scalar -> Bls12_381.Fr.t -> int
    = "caml_blst_scalar_from_fr_stubs"

  external scalar_to_bytes_le : Bytes.t -> scalar -> int
    = "caml_blst_scalar_to_bytes_stubs"

  external keygen :
    scalar ->
    Bytes.t ->
    Unsigned.Size_t.t ->
    Bytes.t ->
    Unsigned.Size_t.t ->
    unit = "caml_bls12_381_signature_blst_signature_keygen_stubs"

  external pairing_init : bool -> Bytes.t -> Unsigned.Size_t.t -> ctxt
    = "caml_bls12_381_signature_blst_pairing_init_stubs"

  external pairing_commit : ctxt -> int
    = "caml_bls12_381_signature_blst_pairing_commit_stubs"

  external pairing_finalverify : ctxt -> bool
    = "caml_bls12_381_signature_blst_pairing_finalverify_stubs"
end

let check_unicity_lst list =
  let hashtbl = Hashtbl.create (List.length list) in
  List.for_all
    (fun x ->
      let res = not (Hashtbl.mem hashtbl x) in
      Hashtbl.add hashtbl x 0 ;
      res)
    list

let with_aggregation_ctxt ciphersuite f =
  let ciphersuite_length = Bytes.length ciphersuite in
  let ctxt =
    CommonStubs.pairing_init
      true
      ciphersuite
      (Unsigned.Size_t.of_int ciphersuite_length)
  in
  f ctxt

type sk = CommonStubs.scalar

let sk_size_in_bytes = Bls12_381.Fr.size_in_bytes

let sk_of_bytes_exn bytes =
  let buffer = CommonStubs.allocate_scalar () in
  let exn =
    Invalid_argument
      "Input should be maximum 32 bytes, encoded the secret key in little \
       endian and must be smaller than the order of Bls12_381.Fr"
  in
  if Bytes.length bytes > 32 then raise exn
  else
    try
      let sk = Bls12_381.Fr.of_bytes_exn bytes in
      ignore @@ CommonStubs.scalar_of_fr buffer sk ;
      buffer
    with Bls12_381.Fr.Not_in_field _ -> raise exn

let sk_of_bytes_opt bytes =
  try Some (sk_of_bytes_exn bytes) with Invalid_argument _ -> None

let sk_to_bytes sk =
  let bytes = Bytes.make 32 '\000' in
  ignore @@ CommonStubs.scalar_to_bytes_le bytes sk ;
  bytes

let generate_sk ?(key_info = Bytes.empty) ikm =
  let buffer_scalar = CommonStubs.allocate_scalar () in
  let key_info_length = Bytes.length key_info in
  let ikm_length = Bytes.length ikm in

  (* https://datatracker.ietf.org/doc/html/draft-irtf-cfrg-bls-signature-04
     Section 2.3 - KeyGen

     For security, IKM MUST be infeasible to guess, e.g., generated by a trusted
     source of randomness. IKM MUST be at least 32 bytes long, but it MAY be
     longer.

     Also, blst_keygen returns a vector of zero (commit
     095a8c53787d6c91b725152ebfbbf33acf05a931) if ikm is less than 32 bytes *)
  if ikm_length < 32 then
    raise
      (Invalid_argument
         "generate_sk: ikm argument must be at least 32 bytes long")
  else
    CommonStubs.keygen
      buffer_scalar
      ikm
      (Unsigned.Size_t.of_int ikm_length)
      key_info
      (Unsigned.Size_t.of_int key_info_length) ;
  buffer_scalar

module MinPk = struct
  module Stubs = struct
    external sk_to_pk : Bls12_381.G1.t -> CommonStubs.scalar -> int
      = "caml_bls12_381_signature_blst_sk_to_pk_in_g1_stubs"

    external sign :
      Bls12_381.G2.t -> Bls12_381.G2.t -> CommonStubs.scalar -> int
      = "caml_bls12_381_signature_blst_sign_pk_in_g1_stubs"

    external pairing_chk_n_mul_n_aggr_pk_in_g1 :
      CommonStubs.ctxt ->
      Bls12_381.G1.affine ->
      bool ->
      Bls12_381.G2.affine option ->
      bool ->
      Bytes.t ->
      Unsigned.Size_t.t ->
      Bytes.t ->
      Unsigned.Size_t.t ->
      Bytes.t ->
      Unsigned.Size_t.t ->
      int
      = "caml_bls12_381_signature_blst_pairing_chk_n_mul_n_aggr_pk_in_g1_stubs_bytecode" "caml_bls12_381_signature_blst_pairing_chk_n_mul_n_aggr_pk_in_g1_stubs"
  end

  type pk = Bytes.t

  let pk_size_in_bytes = Bls12_381.G1.size_in_bytes / 2

  let unsafe_pk_of_bytes pk_bytes = Bytes.copy pk_bytes

  let pk_of_bytes_exn pk_bytes =
    let pk_opt = Bls12_381.G1.of_compressed_bytes_opt pk_bytes in
    match pk_opt with
    | None ->
        raise
          (Invalid_argument
             (Printf.sprintf
                "%s is not a valid public key"
                Hex.(show (`Hex (Bytes.to_string pk_bytes)))))
    | Some _ -> Bytes.copy pk_bytes

  let pk_of_bytes_opt pk_bytes =
    let pk_opt = Bls12_381.G1.of_compressed_bytes_opt pk_bytes in
    match pk_opt with None -> None | Some _ -> Some (Bytes.copy pk_bytes)

  let pk_to_bytes pk_bytes = Bytes.copy pk_bytes

  let derive_pk sk =
    let buffer_g1 = Bls12_381.G1.(copy zero) in
    ignore @@ Stubs.sk_to_pk buffer_g1 sk ;
    Bls12_381.G1.to_compressed_bytes buffer_g1

  type signature = Bytes.t

  let signature_size_in_bytes = Bls12_381.G2.size_in_bytes / 2

  let unsafe_signature_of_bytes bytes = Bytes.copy bytes

  let signature_of_bytes_exn bytes =
    let opt = Bls12_381.G2.of_compressed_bytes_opt bytes in
    match opt with
    | None ->
        raise
          (Invalid_argument
             (Printf.sprintf
                "%s is not a valid signature"
                Hex.(show (`Hex (Bytes.to_string bytes)))))
    | Some _ -> Bytes.copy bytes

  let signature_of_bytes_opt bytes =
    let opt = Bls12_381.G2.of_compressed_bytes_opt bytes in
    match opt with None -> None | Some _ -> Some (Bytes.copy bytes)

  let signature_to_bytes bytes = Bytes.copy bytes

  let core_sign sk message ciphersuite =
    let hash = Bls12_381.G2.hash_to_curve message ciphersuite in
    let buffer = Bls12_381.G2.(copy zero) in
    ignore @@ Stubs.sign buffer hash sk ;
    Bls12_381.G2.to_compressed_bytes buffer

  let core_verify pk msg signature_bytes ciphersuite =
    with_aggregation_ctxt ciphersuite (fun ctxt ->
        let msg_length = Bytes.length msg in
        let unsafe_signature_affine = CommonStubs.allocate_g2_affine () in
        let res_signature =
          CommonStubs.uncompress_g2 unsafe_signature_affine signature_bytes
        in
        let unsafe_pk_affine = CommonStubs.allocate_g1_affine () in
        let res_pk = CommonStubs.uncompress_g1 unsafe_pk_affine pk in
        if res_signature = 0 && res_pk = 0 then
          let res =
            Stubs.pairing_chk_n_mul_n_aggr_pk_in_g1
              ctxt
              unsafe_pk_affine
              (* the pk argument might not be in the subgroup even if the
                 decompression went successfull. `true` means the function must
                 verify the point is in the prime subgroup. IMPORTANT: a test
                 called test_sign_and_verify_with_a_pk_not_in_the_subgroup does
                 exist. We can check the verification is performed correctly
                 because this call returns 3, neaning the point is not in the
                 subgroup. However, even when not verifying the point is in the
                 subgroup, the verification will fail. *)
              true
              (Some unsafe_signature_affine)
              (* the signature argument might not be in the subgroup even if the
                 decompression went successfull. `true` means the function must
                 verify the point is in the prime subgroup. *)
              true
              (* scalar *)
              Bytes.empty
              Unsigned.Size_t.zero
              (* msg *)
              msg
              (Unsigned.Size_t.of_int msg_length)
              (* aug *)
              Bytes.empty
              Unsigned.Size_t.zero
          in
          if res = 0 then (
            ignore @@ CommonStubs.pairing_commit ctxt ;
            CommonStubs.pairing_finalverify ctxt)
          else false
        else false)

  let aggregate_signature_opt signatures =
    let rec aux signatures acc =
      match signatures with
      | [] -> Some acc
      | signature :: signatures -> (
          let signature = Bls12_381.G2.of_compressed_bytes_opt signature in
          match signature with
          | None -> None
          | Some signature ->
              let acc = Bls12_381.G2.(add signature acc) in
              aux signatures acc)
    in
    let res = aux signatures Bls12_381.G2.zero in
    Option.map Bls12_381.G2.to_compressed_bytes res

  let core_aggregate_verify pks_with_msgs aggregated_signature ciphersuite =
    let rec aux aggregated_signature pks_with_msgs ctxt =
      match pks_with_msgs with
      | (unsafe_pk_affine, msg) :: rest ->
          let msg_length = Bytes.length msg in
          (* sign the message *)
          let res =
            Stubs.pairing_chk_n_mul_n_aggr_pk_in_g1
              ctxt
              unsafe_pk_affine
              (* the signature argument might not be in the subgroup even if the
                 decompression went successfull. `true` means the function must
                 verify the point is in the prime subgroup. *)
              true
              aggregated_signature
              (* IMPORTANT: does not check signature is a point on the curve and
                 in the subgroup, it is verified by of_compressed_bytes_opt
                 below. *)
              false
              (* scalar *)
              Bytes.empty
              Unsigned.Size_t.zero
              (* msg *)
              msg
              (Unsigned.Size_t.of_int msg_length)
              (* aug *)
              Bytes.empty
              Unsigned.Size_t.zero
          in
          if res = 0 then
            (* signature: must be null except the first one *)
            aux None rest ctxt
          else false
      | [] -> true
    in
    (* IMPORTANT: the verification the aggregated signature is in the subgroup
       is performed here. *)
    let aggregated_signature_opt =
      Bls12_381.G2.of_compressed_bytes_opt aggregated_signature
    in
    (* Converts the pk received as bytes in points on the curve. There are no
       checks about points belonging to the subgroup. It is verified when
       calling the auxiliary function. *)
    let pks = List.map fst pks_with_msgs in
    let are_pks_on_curve = ref true in
    let unsafe_pks_affine =
      List.map
        (fun pk_bytes ->
          let pk_affine = CommonStubs.allocate_g1_affine () in
          let res = CommonStubs.uncompress_g1 pk_affine pk_bytes in
          are_pks_on_curve := res = 0 && !are_pks_on_curve ;
          pk_affine)
        pks
    in
    let pks_with_msgs =
      List.map2
        (fun pk_affine (_, msg) -> (pk_affine, msg))
        unsafe_pks_affine
        pks_with_msgs
    in
    if !are_pks_on_curve then
      match aggregated_signature_opt with
      | None -> false
      | Some aggregated_signature ->
          with_aggregation_ctxt ciphersuite (fun ctxt ->
              let signature_affine =
                Bls12_381.G2.affine_of_jacobian aggregated_signature
              in
              let res = aux (Some signature_affine) pks_with_msgs ctxt in
              if res then (
                ignore @@ CommonStubs.pairing_commit ctxt ;
                CommonStubs.pairing_finalverify ctxt)
              else false)
    else false

  module Basic = struct
    let ciphersuite =
      Bytes.of_string "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_NUL_"

    let sign sk message = core_sign sk message ciphersuite

    let verify pk msg signature = core_verify pk msg signature ciphersuite

    let aggregate_verify pks_with_msgs aggregated_signature =
      let msgs = List.map snd pks_with_msgs in
      if check_unicity_lst msgs then
        core_aggregate_verify pks_with_msgs aggregated_signature ciphersuite
      else raise (Invalid_argument "Messages must be distinct")
  end

  module Aug = struct
    let ciphersuite =
      Bytes.of_string "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_AUG_"

    let sign sk msg =
      let pk = derive_pk sk in
      (* Important note: we concatenate with the compressed representation of
         the point! *)
      let msg = Bytes.concat Bytes.empty [pk; msg] in
      core_sign sk msg ciphersuite

    let verify pk msg signature =
      (* Important note: we concatenate with the compressed representation of
         the point! *)
      let msg = Bytes.concat Bytes.empty [pk; msg] in
      core_verify pk msg signature ciphersuite

    let aggregate_verify pks_with_msgs aggregated_signature =
      let pks_with_msgs =
        List.map
          (fun (pk, msg) -> (pk, Bytes.concat Bytes.empty [pk; msg]))
          pks_with_msgs
      in
      core_aggregate_verify pks_with_msgs aggregated_signature ciphersuite
  end

  module Pop = struct
    type proof = Bytes.t

    let sign sk message =
      let ciphersuite =
        Bytes.of_string "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_"
      in
      core_sign sk message ciphersuite

    let verify pk msg signature =
      let ciphersuite =
        Bytes.of_string "BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_"
      in
      core_verify pk msg signature ciphersuite

    let pop_prove sk =
      let ciphersuite =
        Bytes.of_string "BLS_POP_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_"
      in
      let pk = derive_pk sk in
      core_sign sk pk ciphersuite

    let pop_verify pk signature =
      let ciphersuite =
        Bytes.of_string "BLS_POP_BLS12381G2_XMD:SHA-256_SSWU_RO_POP_"
      in
      core_verify pk pk signature ciphersuite

    let aggregate_verify pks_with_pops msg aggregated_signature =
      let pks_bytes = List.map fst pks_with_pops in
      let pks_opts = List.map Bls12_381.G1.of_compressed_bytes_opt pks_bytes in
      let pks_are_ok = List.for_all Option.is_some pks_opts in
      if not pks_are_ok then false
      else
        let pks = List.map Option.get pks_opts in
        let aggregated_pk =
          List.fold_left Bls12_381.G1.add Bls12_381.G1.zero pks
        in
        let aggregated_pk = Bls12_381.G1.to_compressed_bytes aggregated_pk in
        let signature_check = verify aggregated_pk msg aggregated_signature in
        let pop_checks =
          List.for_all
            (fun (pk, signature) -> pop_verify pk signature)
            pks_with_pops
        in
        pop_checks && signature_check
  end
end

module MinSig = struct
  module Stubs = struct
    external sk_to_pk : Bls12_381.G2.t -> CommonStubs.scalar -> int
      = "caml_bls12_381_signature_blst_sk_to_pk_in_g2_stubs"

    external sign :
      Bls12_381.G1.t -> Bls12_381.G1.t -> CommonStubs.scalar -> int
      = "caml_bls12_381_signature_blst_sign_pk_in_g2_stubs"

    external pairing_chk_n_mul_n_aggr_pk_in_g2 :
      CommonStubs.ctxt ->
      Bls12_381.G2.affine ->
      bool ->
      Bls12_381.G1.affine option ->
      bool ->
      Bytes.t ->
      Unsigned.Size_t.t ->
      Bytes.t ->
      Unsigned.Size_t.t ->
      Bytes.t ->
      Unsigned.Size_t.t ->
      int
      = "caml_bls12_381_signature_blst_pairing_chk_n_mul_n_aggr_pk_in_g2_stubs_bytecode" "caml_bls12_381_signature_blst_pairing_chk_n_mul_n_aggr_pk_in_g2_stubs"
  end

  type pk = Bytes.t

  let pk_size_in_bytes = Bls12_381.G2.size_in_bytes / 2

  let unsafe_pk_of_bytes pk_bytes = Bytes.copy pk_bytes

  let pk_of_bytes_exn pk_bytes =
    let pk_opt = Bls12_381.G2.of_compressed_bytes_opt pk_bytes in
    match pk_opt with
    | None ->
        raise
          (Invalid_argument
             (Printf.sprintf
                "%s is not a valid public key"
                Hex.(show (`Hex (Bytes.to_string pk_bytes)))))
    | Some _ -> Bytes.copy pk_bytes

  let pk_of_bytes_opt pk_bytes =
    let pk_opt = Bls12_381.G2.of_compressed_bytes_opt pk_bytes in
    match pk_opt with None -> None | Some _ -> Some (Bytes.copy pk_bytes)

  let pk_to_bytes pk_bytes = Bytes.copy pk_bytes

  let derive_pk sk =
    let buffer = Bls12_381.G2.(copy one) in
    ignore @@ Stubs.sk_to_pk buffer sk ;
    Bls12_381.G2.to_compressed_bytes buffer

  type signature = Bytes.t

  let signature_size_in_bytes = Bls12_381.G1.size_in_bytes / 2

  let unsafe_signature_of_bytes bytes = Bytes.copy bytes

  let signature_of_bytes_exn bytes =
    let opt = Bls12_381.G1.of_compressed_bytes_opt bytes in
    match opt with
    | None ->
        raise
          (Invalid_argument
             (Printf.sprintf
                "%s is not a valid signature"
                Hex.(show (`Hex (Bytes.to_string bytes)))))
    | Some _ -> Bytes.copy bytes

  let signature_of_bytes_opt bytes =
    let opt = Bls12_381.G1.of_compressed_bytes_opt bytes in
    match opt with None -> None | Some _ -> Some (Bytes.copy bytes)

  let signature_to_bytes bytes = Bytes.copy bytes

  let core_sign sk message ciphersuite =
    let hash = Bls12_381.G1.hash_to_curve message ciphersuite in
    let buffer = Bls12_381.G1.(copy one) in
    ignore @@ Stubs.sign buffer hash sk ;
    Bls12_381.G1.to_compressed_bytes buffer

  let core_verify pk msg signature_bytes ciphersuite =
    with_aggregation_ctxt ciphersuite (fun ctxt ->
        let msg_length = Bytes.length msg in
        let unsafe_signature_affine = CommonStubs.allocate_g1_affine () in
        let res_signature =
          CommonStubs.uncompress_g1 unsafe_signature_affine signature_bytes
        in
        let unsafe_pk_affine = CommonStubs.allocate_g2_affine () in
        let res_pk = CommonStubs.uncompress_g2 unsafe_pk_affine pk in
        if res_signature = 0 && res_pk = 0 then
          let res =
            Stubs.pairing_chk_n_mul_n_aggr_pk_in_g2
              ctxt
              unsafe_pk_affine
              (* the pk argument might not be in the subgroup even if the
                 decompression went successfull. `true` means the function must
                 verify the point is in the prime subgroup. IMPORTANT: a test
                 called test_sign_and_verify_with_a_pk_not_in_the_subgroup does
                 exist. We can check the verification is performed correctly
                 because this call returns 3, neaning the point is not in the
                 subgroup. However, even when not verifying the point is in the
                 subgroup, the verification will fail. *)
              true
              (Some unsafe_signature_affine)
              (* the signature argument might not be in the subgroup even if the
                 decompression went successfull. `true` means the function must
                 verify the point is in the prime subgroup. *)
              true
              (* scalar *)
              Bytes.empty
              Unsigned.Size_t.zero
              (* msg *)
              msg
              (Unsigned.Size_t.of_int msg_length)
              (* aug *)
              Bytes.empty
              Unsigned.Size_t.zero
          in
          if res = 0 then (
            ignore @@ CommonStubs.pairing_commit ctxt ;
            CommonStubs.pairing_finalverify ctxt)
          else false
        else false)

  let aggregate_signature_opt signatures =
    let rec aux signatures acc =
      match signatures with
      | [] -> Some acc
      | signature :: signatures -> (
          let signature = Bls12_381.G1.of_compressed_bytes_opt signature in
          match signature with
          | None -> None
          | Some signature ->
              let acc = Bls12_381.G1.(add signature acc) in
              aux signatures acc)
    in
    let res = aux signatures Bls12_381.G1.zero in
    Option.map Bls12_381.G1.to_compressed_bytes res

  let core_aggregate_verify pks_with_msgs aggregated_signature ciphersuite =
    let rec aux aggregated_signature pks_with_msgs ctxt =
      match pks_with_msgs with
      | (unsafe_pk_affine, msg) :: rest ->
          let msg_length = Bytes.length msg in
          (* sign the message *)
          let res =
            Stubs.pairing_chk_n_mul_n_aggr_pk_in_g2
              ctxt
              unsafe_pk_affine
              (* the signature argument might not be in the subgroup even if the
                 decompression went successfull. `true` means the function must
                 verify the point is in the prime subgroup. *)
              true
              aggregated_signature
              (* IMPORTANT: does not check signature is a point on the curve and
                 in the subgroup, it is verified by of_compressed_bytes_opt
                 below. *)
              false
              (* scalar *)
              Bytes.empty
              Unsigned.Size_t.zero
              (* msg *)
              msg
              (Unsigned.Size_t.of_int msg_length)
              (* aug *)
              Bytes.empty
              Unsigned.Size_t.zero
          in
          if res = 0 then
            (* signature: must be null except the first one *)
            aux None rest ctxt
          else false
      | [] -> true
    in
    (* IMPORTANT: the verification the aggregated signature is in the subgroup
       is performed here. *)
    let aggregated_signature_opt =
      Bls12_381.G1.of_compressed_bytes_opt aggregated_signature
    in
    (* Converts the pk received as bytes in points on the curve. There are no
       checks about points belonging to the subgroup. It is verified when
       calling the auxiliary function. *)
    let pks = List.map fst pks_with_msgs in
    let are_pks_on_curve = ref true in
    let unsafe_pks_affine =
      List.map
        (fun pk_bytes ->
          let pk_affine = CommonStubs.allocate_g2_affine () in
          let res = CommonStubs.uncompress_g2 pk_affine pk_bytes in
          are_pks_on_curve := res = 0 && !are_pks_on_curve ;
          pk_affine)
        pks
    in
    let pks_with_msgs =
      List.map2
        (fun pk_affine (_, msg) -> (pk_affine, msg))
        unsafe_pks_affine
        pks_with_msgs
    in
    if !are_pks_on_curve then
      match aggregated_signature_opt with
      | None -> false
      | Some aggregated_signature ->
          with_aggregation_ctxt ciphersuite (fun ctxt ->
              let signature_affine =
                Bls12_381.G1.affine_of_jacobian aggregated_signature
              in
              let res = aux (Some signature_affine) pks_with_msgs ctxt in
              if res then (
                ignore @@ CommonStubs.pairing_commit ctxt ;
                CommonStubs.pairing_finalverify ctxt)
              else false)
    else false

  module Basic = struct
    let ciphersuite =
      Bytes.of_string "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_NUL_"

    let sign sk message = core_sign sk message ciphersuite

    let verify pk msg signature = core_verify pk msg signature ciphersuite

    let aggregate_verify pks_with_msgs aggregated_signature =
      let msgs = List.map snd pks_with_msgs in
      if check_unicity_lst msgs then
        core_aggregate_verify pks_with_msgs aggregated_signature ciphersuite
      else raise (Invalid_argument "Messages must be distinct")
  end

  module Aug = struct
    let ciphersuite =
      Bytes.of_string "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_AUG_"

    let sign sk msg =
      let pk = derive_pk sk in
      (* Important note: we concatenate with the compressed representation of
         the point! *)
      let msg = Bytes.concat Bytes.empty [pk; msg] in
      core_sign sk msg ciphersuite

    let verify pk msg signature =
      (* Important note: we concatenate with the compressed representation of
         the point! *)
      let msg = Bytes.concat Bytes.empty [pk; msg] in
      core_verify pk msg signature ciphersuite

    let aggregate_verify pks_with_msgs aggregated_signature =
      let pks_with_msgs =
        List.map
          (fun (pk, msg) -> (pk, Bytes.concat Bytes.empty [pk; msg]))
          pks_with_msgs
      in
      core_aggregate_verify pks_with_msgs aggregated_signature ciphersuite
  end

  module Pop = struct
    type proof = Bytes.t

    let sign sk message =
      let ciphersuite =
        Bytes.of_string "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_"
      in
      core_sign sk message ciphersuite

    let verify pk msg signature =
      let ciphersuite =
        Bytes.of_string "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_"
      in
      core_verify pk msg signature ciphersuite

    let pop_prove sk =
      let ciphersuite =
        Bytes.of_string "BLS_POP_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_"
      in
      let pk = derive_pk sk in
      core_sign sk pk ciphersuite

    let pop_verify pk signature =
      let ciphersuite =
        Bytes.of_string "BLS_POP_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_"
      in
      core_verify pk pk signature ciphersuite

    let aggregate_verify pks_with_pops msg aggregated_signature =
      let pks_bytes = List.map fst pks_with_pops in
      let pks_opts = List.map Bls12_381.G2.of_compressed_bytes_opt pks_bytes in
      let pks_are_ok = List.for_all Option.is_some pks_opts in
      if not pks_are_ok then false
      else
        let pks = List.map Option.get pks_opts in
        let aggregated_pk =
          List.fold_left Bls12_381.G2.add Bls12_381.G2.zero pks
        in
        let aggregated_pk = Bls12_381.G2.to_compressed_bytes aggregated_pk in
        let signature_check = verify aggregated_pk msg aggregated_signature in
        let pop_checks =
          List.for_all
            (fun (pk, signature) -> pop_verify pk signature)
            pks_with_pops
        in
        pop_checks && signature_check
  end
end
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct