File Coverage

lib/Crypt/Perl/ECDSA/KeyBase.pm

Criterion	Covered	Total	%
statement	180	189	95.2
branch	15	20	75.0
condition	9	12	75.0
subroutine	51	52	98.0
pod	0	11	0.0
total	255	284	89.7

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;