File Coverage

blib/lib/Crypto/ECC/Point.pm
Criterion Covered Total %
statement 5 80 6.2
branch 0 44 0.0
condition 0 18 0.0
subroutine 2 8 25.0
pod 0 7 0.0
total 7 157 4.4


line stmt bran cond sub pod time code
1             package Crypto::ECC::Point;
2             $Crypto::ECC::Point::VERSION = '0.004';
3 2     2   68268 use Moo;
  2         11322  
  2         11  
4              
5             extends(my $CurveFp = "Crypto::ECC::CurveFp");
6              
7             has x => ( is => 'ro' );
8             has y => ( is => 'ro' );
9             has order => ( is => 'ro' );
10              
11             around BUILDARGS => __PACKAGE__->BUILDARGS_val2gmp(qw(x y order));
12              
13 0     0 0 0 sub infinity { 'infinity' }
14              
15             sub cmp {
16 0     0 0 0 my ( $class, $p1, $p2 ) = @_;
17              
18 0 0       0 if ( !$p1->isa($class) ) {
19 0 0       0 if ( $p2->isa($class) ) {
20 0         0 return 1;
21             }
22 0 0       0 if ( !$p2->isa($class) ) {
23 0         0 return 0;
24             }
25             }
26              
27 0 0       0 if ( !$p2->isa($class) ) {
28 0 0       0 if ( $p1->isa($class) ) {
29 0         0 return 1;
30             }
31 0 0       0 if ( !$p1->isa($class) ) {
32 0         0 return 0;
33             }
34             }
35              
36 0 0       0 return 1 if ( $p1->x <=> $p2->x ) != 0;
37              
38 0 0       0 return 1 if ( $p1->y <=> $p2->y ) != 0;
39              
40 0         0 return $class->next( $p1, $p2 );
41             }
42              
43             sub add {
44 0     0 0 0 my ( $class, $p1, $p2 ) = @_;
45              
46 0 0 0     0 if ( $class->cmp( $p2, $class->infinity ) == 0 && $p1->isa($class) ) {
47 0         0 return $p1;
48             }
49              
50 0 0 0     0 if ( $class->cmp( $p1, $class->infinity ) == 0 && $p2->isa($class) ) {
51 0         0 return $p2;
52             }
53              
54 0 0 0     0 if ( $class->cmp( $p1, $class->infinity ) == 0
55             && $class->cmp( $p2, $class->infinity ) == 0 )
56             {
57 0         0 return $class->infinity;
58             }
59              
60 0 0       0 if ( $CurveFp->cmp( $p1, $p2 ) != 0 ) {
61 0         0 die "The Elliptic Curves do not match.";
62             }
63              
64 0 0       0 if ( ( ( $p1->x <=> $p2->x ) % $p1->prime ) == 0 ) {
65 0 0       0 if ( ( ( $p1->y + $p2->y ) % $p1->prime ) == 0 ) {
66 0         0 return $class->infinity;
67             }
68             else {
69 0         0 return $class->double($p1);
70             }
71             }
72              
73 0         0 my $p = $p1->prime;
74              
75 0         0 my $l = ( $p2->y - $p1->y ) * ( $p2->x - $p1->x )->bmodinv($p);
76              
77 0         0 my $x3 = ( ( ( $l**2 ) - $p1->x ) - $p2->x ) % $p;
78              
79 0         0 my $y3 = ( ( $l * ( $p1->x - $x3 ) ) - $p1->y ) % $p;
80              
81 0         0 my $p3 = $p1->copy( x => $x3, y => $y3 );
82              
83 0         0 return $p3;
84             }
85              
86             sub mul {
87 0     0 0 0 my ( $class, $x2, $p1 ) = @_;
88              
89 0         0 my $e = $x2;
90              
91 0 0       0 if ( $class->cmp( $p1, $class->infinity ) == 0 ) {
92 0         0 return $class->infinity;
93             }
94              
95 0 0       0 if ( defined $p1->order ) {
96 0         0 $e %= $p1->order;
97             }
98              
99 0 0       0 if ( ( $e <=> 0 ) == 0 ) {
100 0         0 return $class->infinity;
101             }
102              
103 0 0       0 return if ( $e <=> 0 ) <= 0;
104              
105 0         0 my $e3 = $e * 3;
106              
107 0         0 my $negative_self = $p1->negative;
108              
109 0         0 my $i = $class->leftmost_bit($e3) / 2;
110              
111 0         0 my $result = $p1;
112              
113 0         0 while ( ( $i <=> 1 ) > 0 ) {
114 0         0 $result = $class->double($result);
115              
116 0         0 my $e3bit = ( $e3 & $i ) <=> 0;
117 0         0 my $ebit = ( $e & $i ) <=> 0;
118              
119 0 0 0     0 if ( $e3bit != 0 && $ebit == 0 ) {
    0 0        
120 0         0 $result = $class->add( $result, $p1 );
121             }
122             elsif ( $e3bit == 0 && $ebit != 0 ) {
123 0         0 $result = $class->add( $result, $negative_self );
124             }
125              
126 0         0 $i /= 2;
127             }
128              
129 0         0 return $result;
130             }
131              
132             sub double {
133 0     0 0 0 my ( $class, $p1 ) = @_;
134              
135 0         0 my $p = $p1->prime;
136 0         0 my $a = $p1->a;
137              
138 0         0 my $inverse = ( 2 * $p1->y )->bmodinv($p);
139              
140 0         0 my $three_x2 = 3 * ( $p1->x**2 );
141              
142 0         0 my $l = ( ( $three_x2 + $a ) * $inverse ) % $p;
143              
144 0         0 my $x3 = ( ( $l**2 ) - ( 2 * $p1->x ) ) % $p;
145              
146 0         0 my $y3 = ( ( $l * ( $p1->x - $x3 ) ) - $p1->y ) % $p;
147              
148 0 0       0 if ( ( 0 <=> $y3 ) > 0 ) {
149 0         0 $y3 = $p + $y3;
150             }
151              
152 0         0 my $p3 = $p1->copy( x => $x3, y => $y3 );
153              
154 0         0 return $p3;
155             }
156              
157             sub leftmost_bit {
158 0     0 0 0 my ( $class, $x ) = @_;
159              
160 0 0       0 return if ( $x <=> 0 ) < 1;
161              
162 0         0 my $result = Math::BigInt->new(1);
163              
164 0   0     0 while ( ( $result <=> $x ) < 0 || ( $result <=> $x ) == 0 ) {
165 0         0 $result *= 2;
166             }
167              
168 0         0 $result /= 2;
169              
170 0         0 return $result;
171             }
172              
173             sub negative {
174 1     1 0 11902 my ($p) = @_;
175 1         9 return $p->copy( y => 0 - $p->y );
176             }
177              
178             1;