@@ -119,6 +119,20 @@ module type Foreign_proj = sig
119
119
val scalar_mult_base_c : out_point -> string -> unit
120
120
end
121
121
122
+ module Point_kiila = struct
123
+ type point = Point of string [@@ unboxed]
124
+ type out_point = Point_out of bytes [@@ unboxed]
125
+ end
126
+
127
+ module type Foreign_kiila = sig
128
+ include Foreign
129
+ open Point_kiila
130
+
131
+ val scalar_mult_base_c : out_point -> string -> unit
132
+ val scalar_mult_c : out_point -> string -> point -> unit
133
+ val scalar_mult_add_c : out_point -> string -> string -> point -> unit
134
+ end
135
+
122
136
module type Field_element = sig
123
137
val create : unit -> out_field_element
124
138
val mul : field_element -> field_element -> field_element
@@ -459,6 +473,187 @@ module Make_point (P : Parameters) (F : Foreign_proj) : Point = struct
459
473
460
474
end
461
475
476
+ (*
477
+ This is an alternative Point implementation, that uses
478
+ - concatenated affine coordinates as used by ECCKiila generated code, and
479
+ - simplified calculations for a=0 like for the secp256k1 curve
480
+ *)
481
+ module Make_point_k1 (P : Parameters ) (F : Foreign_kiila ) : Point = struct
482
+ module Fe = Make_field_element (P )(F )
483
+ include Point_kiila
484
+
485
+ let make x y = Point (String. cat x y)
486
+ let p_x (Point p ) = String. sub p 0 P. fe_length
487
+ let p_y (Point p ) = String. sub p P. fe_length P. fe_length
488
+ let out_point () = Point_out (Bytes. create (P. fe_length * 2 ))
489
+ let out_p_to_p (Point_out p ) = Point (Bytes. unsafe_to_string p)
490
+
491
+ let at_infinity () =
492
+ let f_x = Fe. zero in
493
+ let f_y = Fe. zero in
494
+ make f_x f_y
495
+
496
+ let is_infinity (p : point ) = not (Fe. nz (p_y p))
497
+
498
+ let is_solution_to_curve_equation =
499
+ let b = Fe. from_be_octets P. b in
500
+ fun ~x ~y ->
501
+ let x3 = Fe. sqr x in
502
+ let x3 = Fe. mul x3 x in
503
+ let y2 = Fe. sqr y in
504
+ let sum = Fe. add x3 b in
505
+ let sum = Fe. sub sum y2 in
506
+ not (Fe. nz sum)
507
+
508
+ let check_coordinate buf =
509
+ (* ensure buf < p: *)
510
+ match Eqaf. compare_be_with_len ~len: P. byte_length buf P. p > = 0 with
511
+ | true -> None
512
+ | exception Invalid_argument _ -> None
513
+ | false -> Some (Fe. from_be_octets buf)
514
+
515
+ (* * Convert coordinates to a finite point ensuring:
516
+ - x < p
517
+ - y < p
518
+ - y^2 = x^3 + b
519
+ *)
520
+ let validate_finite_point ~x ~y =
521
+ match (check_coordinate x, check_coordinate y) with
522
+ | Some f_x , Some f_y ->
523
+ if is_solution_to_curve_equation ~x: f_x ~y: f_y then
524
+ Ok (make f_x f_y)
525
+ else Error `Not_on_curve
526
+ | _ -> Error `Invalid_range
527
+
528
+ let to_affine_raw p =
529
+ if is_infinity p then
530
+ None
531
+ else
532
+ let x = Fe. from_montgomery (p_x p) in
533
+ let y = Fe. from_montgomery (p_y p) in
534
+ Some (x, y)
535
+
536
+ let to_affine p =
537
+ Option. map (fun (x , y ) -> Fe. to_octets x, Fe. to_octets y)
538
+ (to_affine_raw p)
539
+
540
+ let to_octets ~compress p =
541
+ let buf =
542
+ match to_affine p with
543
+ | None -> String. make 1 '\000'
544
+ | Some (x , y ) ->
545
+ let len_x = String. length x and len_y = String. length y in
546
+ let res = Bytes. create (1 + len_x + len_y) in
547
+ Bytes. set res 0 '\004' ;
548
+ let rev_x = rev_string x and rev_y = rev_string y in
549
+ Bytes. unsafe_blit_string rev_x 0 res 1 len_x ;
550
+ Bytes. unsafe_blit_string rev_y 0 res (1 + len_x) len_y ;
551
+ Bytes. unsafe_to_string res
552
+ in
553
+ if compress then
554
+ let out = Bytes. create (P. byte_length + 1 ) in
555
+ let ident =
556
+ 2 + (String. get_uint8 buf ((P. byte_length * 2 ) - 1 )) land 1
557
+ in
558
+ Bytes. unsafe_blit_string buf 1 out 1 P. byte_length;
559
+ Bytes. set_uint8 out 0 ident;
560
+ Bytes. unsafe_to_string out
561
+ else
562
+ buf
563
+
564
+ let x_of_finite_point p =
565
+ match to_affine p with None -> assert false | Some (x , _ ) -> rev_string x
566
+
567
+ let pow x exp =
568
+ let r0 = ref Fe. one in
569
+ let r1 = ref x in
570
+ for i = P. byte_length * 8 - 1 downto 0 do
571
+ let bit = bit_at exp i in
572
+ let multiplied = Fe. mul ! r0 ! r1 in
573
+ let r0_sqr = Fe. sqr ! r0 in
574
+ let r1_sqr = Fe. sqr ! r1 in
575
+ r0 := Fe. select bit ~then_: multiplied ~else_: r0_sqr;
576
+ r1 := Fe. select bit ~then_: r1_sqr ~else_: multiplied;
577
+ done ;
578
+ ! r0
579
+
580
+ let decompress =
581
+ (* When p = 4*k+3, as is the case of NIST-P256, there is an efficient square
582
+ root algorithm to recover the y, as follows:
583
+
584
+ Given the compact representation of Q as x,
585
+ y2 = x^3 + b (with a=0)
586
+ y' = y2^((p+1)/4)
587
+ y = min(y',p-y')
588
+ Q=(x,y) is the canonical representation of the point
589
+ *)
590
+ let pident = P. pident (* (Params.p + 1) / 4*) in
591
+ let b = Fe. from_be_octets P. b in
592
+ let p = Fe. from_be_octets P. p in
593
+ fun pk ->
594
+ let x = Fe. from_be_octets (String. sub pk 1 P. byte_length) in
595
+ let x3 = Fe. mul x x in
596
+ let x3 = Fe. mul x3 x in (* x3 *)
597
+ let sum = Fe. add x3 b in (* y^2 *)
598
+ let y = pow sum pident in (* https://tools.ietf.org/id/draft-jivsov-ecc-compact-00.xml#sqrt point 4.3*)
599
+ let y' = Fe. sub p y in
600
+ let y = Fe. from_montgomery y in
601
+ let y_struct = Fe. to_octets y in (* number must not be in montgomery domain*)
602
+ let y_struct = rev_string y_struct in
603
+ let y' = Fe. from_montgomery y' in
604
+ let y_struct2 = Fe. to_octets y' in (* number must not be in montgomery domain*)
605
+ let y_struct2 = rev_string y_struct2 in
606
+ let ident = String. get_uint8 pk 0 in
607
+ let signY =
608
+ 2 + (String. get_uint8 y_struct (P. byte_length - 2 )) land 1
609
+ in
610
+ let res = if Int. equal signY ident then y_struct else y_struct2 in
611
+ let out = Bytes. create ((P. byte_length * 2 ) + 1 ) in
612
+ Bytes. set out 0 '\004' ;
613
+ Bytes. unsafe_blit_string pk 1 out 1 P. byte_length;
614
+ Bytes. unsafe_blit_string res 0 out (P. byte_length + 1 ) P. byte_length;
615
+ Bytes. unsafe_to_string out
616
+
617
+ let of_octets buf =
618
+ let len = P. byte_length in
619
+ if String. length buf = 0 then
620
+ Error `Invalid_format
621
+ else
622
+ let of_octets buf =
623
+ let x = String. sub buf 1 len in
624
+ let y = String. sub buf (1 + len) len in
625
+ validate_finite_point ~x ~y
626
+ in
627
+ match String. get_uint8 buf 0 with
628
+ | 0x00 when String. length buf = 1 ->
629
+ Ok (at_infinity () )
630
+ | 0x02 | 0x03 when String. length P. pident > 0 ->
631
+ let decompressed = decompress buf in
632
+ of_octets decompressed
633
+ | 0x04 when String. length buf = 1 + len + len ->
634
+ of_octets buf
635
+ | 0x00 | 0x04 -> Error `Invalid_length
636
+ | _ -> Error `Invalid_format
637
+
638
+ let scalar_mult_base (Scalar d ) =
639
+ let tmp = out_point () in
640
+ F. scalar_mult_base_c tmp d;
641
+ out_p_to_p tmp
642
+
643
+ let scalar_mult (Scalar s ) p =
644
+ let tmp = out_point () in
645
+ F. scalar_mult_c tmp s p;
646
+ out_p_to_p tmp
647
+
648
+ let scalar_mult_add (Scalar a ) (Scalar b ) p =
649
+ let tmp = out_point () in
650
+ F. scalar_mult_add_c tmp a b p;
651
+ out_p_to_p tmp
652
+
653
+ let generator_tables () =
654
+ assert false
655
+ end
656
+
462
657
module type Scalar = sig
463
658
val not_zero : string -> bool
464
659
val is_in_range : string -> bool
@@ -819,6 +1014,59 @@ module P256 : Dh_dsa = struct
819
1014
module Dsa = Make_dsa (Params )(Fn )(P )(S )(Digestif. SHA256 )
820
1015
end
821
1016
1017
+
1018
+ module P256k1 : Dh_dsa = struct
1019
+ module Params = struct
1020
+ let a = " \x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00 "
1021
+ let b = " \x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07 "
1022
+ let g_x = " \x79\xBE\x66\x7E\xF9\xDC\xBB\xAC\x55\xA0\x62\x95\xCE\x87\x0B\x07\x02\x9B\xFC\xDB\x2D\xCE\x28\xD9\x59\xF2\x81\x5B\x16\xF8\x17\x98 "
1023
+ let g_y = " \x48\x3A\xDA\x77\x26\xA3\xC4\x65\x5D\xA4\xFB\xFC\x0E\x11\x08\xA8\xFD\x17\xB4\x48\xA6\x85\x54\x19\x9C\x47\xD0\x8F\xFB\x10\xD4\xB8 "
1024
+ let p = " \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFE\xFF\xFF\xFC\x2F "
1025
+ let n = " \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFE\xBA\xAE\xDC\xE6\xAF\x48\xA0\x3B\xBF\xD2\x5E\x8C\xD0\x36\x41\x41 "
1026
+ let pident = " \x3F\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xBF\xFF\xFF\x0C " |> rev_string (* (Params.p + 1) / 4*)
1027
+ let byte_length = 32
1028
+ let bit_length = 256
1029
+ let fe_length = 32
1030
+ let first_byte_bits = None
1031
+ end
1032
+
1033
+ module Foreign = struct
1034
+ include Point_kiila
1035
+ external mul : out_field_element -> field_element -> field_element -> unit = " mc_secp256k1_mul" [@@ noalloc]
1036
+ external sub : out_field_element -> field_element -> field_element -> unit = " mc_secp256k1_sub" [@@ noalloc]
1037
+ external add : out_field_element -> field_element -> field_element -> unit = " mc_secp256k1_add" [@@ noalloc]
1038
+ external to_montgomery : out_field_element -> field_element -> unit = " mc_secp256k1_to_montgomery" [@@ noalloc]
1039
+ external from_octets : out_field_element -> string -> unit = " mc_secp256k1_from_bytes" [@@ noalloc]
1040
+ external set_one : out_field_element -> unit = " mc_secp256k1_set_one" [@@ noalloc]
1041
+ external nz : field_element -> bool = " mc_secp256k1_nz" [@@ noalloc]
1042
+ external sqr : out_field_element -> field_element -> unit = " mc_secp256k1_sqr" [@@ noalloc]
1043
+ external from_montgomery : out_field_element -> field_element -> unit = " mc_secp256k1_from_montgomery" [@@ noalloc]
1044
+ external to_octets : bytes -> field_element -> unit = " mc_secp256k1_to_bytes" [@@ noalloc]
1045
+ external inv : out_field_element -> field_element -> unit = " mc_secp256k1_inv" [@@ noalloc]
1046
+ external select_c : out_field_element -> bool -> field_element -> field_element -> unit = " mc_secp256k1_select" [@@ noalloc]
1047
+ external scalar_mult_c : out_point -> string -> point -> unit = " mc_secp256k1_scalar_mult" [@@ noalloc]
1048
+ external scalar_mult_add_c : out_point -> string -> string -> point -> unit = " mc_secp256k1_scalar_mult_add" [@@ noalloc]
1049
+ external scalar_mult_base_c : out_point -> string -> unit = " mc_secp256k1_scalar_mult_base" [@@ noalloc]
1050
+ end
1051
+
1052
+ module Foreign_n = struct
1053
+ external mul : out_field_element -> field_element -> field_element -> unit = " mc_nsecp256k1_mul" [@@ noalloc]
1054
+ external add : out_field_element -> field_element -> field_element -> unit = " mc_nsecp256k1_add" [@@ noalloc]
1055
+ external inv : out_field_element -> field_element -> unit = " mc_nsecp256k1_inv" [@@ noalloc]
1056
+ external one : out_field_element -> unit = " mc_nsecp256k1_one" [@@ noalloc]
1057
+ external from_bytes : out_field_element -> string -> unit = " mc_nsecp256k1_from_bytes" [@@ noalloc]
1058
+ external to_bytes : bytes -> field_element -> unit = " mc_nsecp256k1_to_bytes" [@@ noalloc]
1059
+ external from_montgomery : out_field_element -> field_element -> unit = " mc_nsecp256k1_from_montgomery" [@@ noalloc]
1060
+ external to_montgomery : out_field_element -> field_element -> unit = " mc_nsecp256k1_to_montgomery" [@@ noalloc]
1061
+ end
1062
+
1063
+ module P = Make_point_k1 (Params )(Foreign )
1064
+ module S = Make_scalar (Params )(P )
1065
+ module Dh = Make_dh (Params )(P )(S )
1066
+ module Fn = Make_Fn (Params )(Foreign_n )
1067
+ module Dsa = Make_dsa (Params )(Fn )(P )(S )(Digestif. SHA256 )
1068
+ end
1069
+
822
1070
module P384 : Dh_dsa = struct
823
1071
module Params = struct
824
1072
let a = " \xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFE\xFF\xFF\xFF\xFF\x00\x00\x00\x00\x00\x00\x00\x00\xFF\xFF\xFF\xFC "
0 commit comments