package Crypt::Perl::ECDSA::KeyBase;
use strict;
use warnings;
use Try::Tiny;
use parent qw(
Crypt::Perl::KeyBase
);
use Crypt::Format ();
use Crypt::Perl::ASN1 ();
use Crypt::Perl::BigInt ();
use Crypt::Perl::Math ();
use Crypt::Perl::ECDSA::EC::Curve ();
use Crypt::Perl::ECDSA::EC::DB ();
use Crypt::Perl::ECDSA::EC::Point ();
use Crypt::Perl::ECDSA::ECParameters ();
use Crypt::Perl::ECDSA::NIST ();
use Crypt::Perl::ECDSA::EncodedPoint ();
use Crypt::Perl::ECDSA::Utils ();
use Crypt::Perl::X ();
use constant ASN1_SIGNATURE => q<
SEQUENCE {
r INTEGER,
s INTEGER
}
>;
use constant ASN1_Params => Crypt::Perl::ECDSA::ECParameters::ASN1_ECParameters() . q<
EcpkParameters ::= CHOICE {
namedCurve OBJECT IDENTIFIER,
ecParameters ECParameters
}
>;
use constant _JWK_THUMBPRINT_JSON_ORDER => qw( crv kty x y );
use constant JWA_DIGEST_prime256v1 => 'sha256';
use constant JWA_DIGEST_secp384r1 => 'sha384';
use constant JWA_DIGEST_secp521r1 => 'sha512';
use constant JWA_CURVE_ALG_prime256v1 => 'ES256';
use constant JWA_CURVE_ALG_secp384r1 => 'ES384';
use constant JWA_CURVE_ALG_secp521r1 => 'ES512';
#Expects $key_parts to be a hash ref:
#
# version - AFAICT unused
# private - BigInt or its byte-string representation
# public - ^^
#
sub new_by_curve_name {
my ($class, $key_parts, $curve_name) = @_;
#We could store the curve name on here if looking it up
#in to_der_with_curve_name() proves prohibitive.
return $class->new(
$key_parts,
#“Fake out” the $curve_parts attribute by recreating
#the structure that ASN.1 would give from a named curve.
{
namedCurve => Crypt::Perl::ECDSA::EC::DB::get_oid_for_curve_name($curve_name),
},
);
}
#$msg has to be small enough that the key could have signed it.
#It’s probably a digest rather than the original message.
sub verify {
my ($self, $msg, $sig) = @_;
my $struct = Crypt::Perl::ASN1->new()->prepare(ASN1_SIGNATURE)->decode($sig);
return $self->_verify($msg, @{$struct}{ qw( r s ) });
}
#cf. RFC 7518, page 8
sub verify_jwa {
my ($self, $msg, $sig) = @_;
my $dgst_cr = $self->_get_jwk_digest_cr();
my $half_len = (length $sig) / 2;
my $r = substr($sig, 0, $half_len);
my $s = substr($sig, $half_len);
$_ = Crypt::Perl::BigInt->from_bytes($_) for ($r, $s);
return $self->_verify($dgst_cr->($msg), $r, $s);
}
sub to_der_with_curve_name {
my ($self, %params) = @_;
if ($params{'seed'}) {
die Crypt::Perl::X::create('Generic', '“seed” is meaningless to a named-curve export.');
}
return $self->_get_asn1_parts($self->_named_curve_parameters(), %params);
}
sub to_der_with_explicit_curve {
my ($self, @params) = @_;
return $self->_get_asn1_parts($self->_explicit_curve_parameters(@params), @params);
}
sub to_pem_with_curve_name {
my ($self, @params) = @_;
my $der = $self->to_der_with_curve_name(@params);
return Crypt::Format::der2pem($der, $self->_PEM_HEADER());
}
sub to_pem_with_explicit_curve {
my ($self, @params) = @_;
my $der = $self->to_der_with_explicit_curve(@params);
return Crypt::Format::der2pem($der, $self->_PEM_HEADER());
}
sub max_sign_bits {
my ($self) = @_;
return $self->_get_curve_obj()->keylen();
}
sub get_curve_name {
my ($self) = @_;
return Crypt::Perl::ECDSA::EC::DB::get_curve_name_by_data( $self->_curve() );
}
sub get_struct_for_public_jwk {
my ($self) = @_;
my ($xb, $yb) = Crypt::Perl::ECDSA::Utils::split_G_or_public( $self->_decompress_public_point() );
require MIME::Base64;
return {
kty => 'EC',
crv => $self->_get_jwk_curve_name(),
x => MIME::Base64::encode_base64url($xb),
y => MIME::Base64::encode_base64url($yb),
}
}
sub get_jwa_alg {
my ($self) = @_;
my $name = $self->get_curve_name();
my $getter_cr = __PACKAGE__->can("JWA_CURVE_ALG_$name") or do {
my $err = sprintf( "“%s” knows of no JWA “alg” for the curve “%s”!", ref($self), $name);
die Crypt::Perl::X::create('Generic', $err);
};
return $getter_cr->();
}
#----------------------------------------------------------------------
sub _set_public {
my ($self, $pub_in) = @_;
$self->{'_public'} = Crypt::Perl::ECDSA::EncodedPoint->new($pub_in);
return;
}
sub _compress_public_point {
my ($self) = @_;
return $self->{'_public'}->get_compressed();
}
sub _decompress_public_point {
my ($self) = @_;
return $self->{'_public'}->get_uncompressed( $self->_curve() );
}
sub _get_jwk_digest_name {
my ($self) = @_;
my $name = $self->get_curve_name();
my $getter_cr = $self->can("JWA_DIGEST_$name") or do {
my $err = sprintf( "“%s” knows of no digest to use for JWA with the curve “%s”!", ref($self), $name);
die Crypt::Perl::X::create('Generic', $err);
};
return $getter_cr->();
}
sub _get_jwk_digest_cr {
require Digest::SHA;
return Digest::SHA->can( $_[0]->_get_jwk_digest_name() );
}
sub _get_jwk_curve_name {
my ($self) = @_;
my $name = $self->get_curve_name();
return Crypt::Perl::ECDSA::NIST::get_nist_for_curve_name($name);
}
sub _verify {
my ($self, $msg, $r, $s) = @_;
$_ = Crypt::Perl::BigInt->new($_) for ($r, $s);
if ($r->is_positive() && $s->is_positive()) {
my ($x, $y) = Crypt::Perl::ECDSA::Utils::split_G_or_public( $self->_decompress_public_point() );
$_ = Crypt::Perl::BigInt->from_bytes($_) for ($x, $y);
my $curve = $self->_get_curve_obj();
my $Q = Crypt::Perl::ECDSA::EC::Point->new(
$curve,
$curve->from_bigint($x),
$curve->from_bigint($y),
);
my $e = Crypt::Perl::BigInt->from_bytes($msg);
#----------------------------------------------------------------------
my $n = $self->_curve()->{'n'};
if ($r->blt($n) && $s->blt($n)) {
my $c = $s->copy()->bmodinv($n);
my $u1 = $e->copy()->bmul($c)->bmod($n);
my $u2 = $r->copy()->bmul($c)->bmod($n);
my $point = $self->_G()->multiply($u1)->add( $Q->multiply($u2) );
my $v = $point->get_x()->to_bigint()->copy()->bmod($n);
return 1 if $v->beq($r);
}
}
return 0;
}
#return isa EC::Point
sub _G {
my ($self) = @_;
return $self->_get_curve_obj()->decode_point( @{$self->_curve()}{ qw( gx gy ) } );
}
sub _pad_bytes_for_asn1 {
my ($self, $bytes) = @_;
return Crypt::Perl::ECDSA::Utils::pad_bytes_for_asn1( $bytes, $self->_curve()->{'p'} );
}
sub _named_curve_parameters {
my ($self) = @_;
my $curve_name = $self->get_curve_name();
return {
namedCurve => Crypt::Perl::ECDSA::EC::DB::get_oid_for_curve_name($curve_name),
};
}
#The idea is to emulate what Convert::ASN1 gives us as the parse.
sub _explicit_curve_parameters {
my ($self, %params) = @_;
my $curve_hr = $self->_curve();
my ($gx, $gy) = map { $_->as_bytes() } @{$curve_hr}{'gx', 'gy'};
for my $str ( $gx, $gy ) {
$str = $self->_pad_bytes_for_asn1($str);
}
my %curve = (
a => $curve_hr->{'a'}->as_bytes(),
b => $curve_hr->{'b'}->as_bytes(),
);
if ($params{'seed'} && $curve_hr->{'seed'}) {
#We don’t care about the bit count. (Right?)
$curve{'seed'} = $curve_hr->{'seed'}->as_bytes();
}
my $base = "\x{04}$gx$gy";
if ( $params{'compressed'} ) {
$base = Crypt::Perl::ECDSA::Utils::compress_point($base);
}
return {
ecParameters => {
version => 1,
fieldID => {
fieldType => Crypt::Perl::ECDSA::ECParameters::OID_prime_field(),
parameters => {
'prime-field' => $curve_hr->{'p'},
},
},
curve => \%curve,
base => $base,
order => $curve_hr->{'n'},
cofactor => $curve_hr->{'h'},
},
};
}
sub __to_der {
my ($self, $macro, $template, $data_hr, %params) = @_;
my $pub_bin = $params{'compressed'} ? $self->_compress_public_point() : $self->_decompress_public_point();
local $data_hr->{'publicKey'} = $pub_bin;
require Crypt::Perl::ASN1;
my $asn1 = Crypt::Perl::ASN1->new()->prepare($template);
return $asn1->find($macro)->encode( $data_hr );
}
#return isa EC::Curve
sub _get_curve_obj {
my ($self) = @_;
return $self->{'_curve_obj'} ||= Crypt::Perl::ECDSA::EC::Curve->new( @{$self->_curve()}{ qw( p a b ) } );
}
sub _add_params {
my ($self, $params_struct) = @_;
if (my $params = $params_struct->{'ecParameters'}) {
#Convert::ASN1 returns bit strings as an array of [ $content, $length ].
#Since normalize() wants that, we local() it here.
#local $params->{'curve'}{'seed'} = [$params->{'curve'}{'seed'}] if $params->{'curve'} && $params->{'curve'}{'seed'};
$self->{'curve'} = Crypt::Perl::ECDSA::ECParameters::normalize($params);
}
else {
$self->{'curve'} = $self->_curve_params_for_OID($params_struct->{'namedCurve'});
}
return $self;
}
sub _curve_params_for_OID {
my ($self, $oid) = @_;
return Crypt::Perl::ECDSA::EC::DB::get_curve_data_by_oid($oid);
}
sub _curve {
my ($self) = @_;
return $self->{'curve'};
}
#----------------------------------------------------------------------
1;