File Coverage

blib/lib/Net/OAuth2Server/PKCE.pm

Criterion	Covered	Total	%
statement	40	50	80.0
branch	12	22	54.5
condition	3	3	100.0
subroutine	11	13	84.6
pod			n/a
total	66	88	75.0

use strict; use warnings;

package Net::OAuth2Server::PKCE;

our $VERSION = '0.002';

use Digest::SHA ();

our %transform = (
	plain => sub () { $_[0] },
	S256  => sub () { my $v = &Digest::SHA::sha256_base64; $v =~ y[+/][-_]; $v },
);

package Net::OAuth2Server::Request::Authorization::Role::PKCE;

our $VERSION = '0.002';

use Role::Tiny;
use Class::Method::Modifiers 'fresh';

sub fresh__get_pkce_challenge {
	my $self = shift;
	$self->ensure_required( qw( code_challenge code_challenge_method ) ) or return;
	my ( $challenge, $method ) = $self->params( qw( code_challenge code_challenge_method ) );
	$self->set_error_invalid_request( "unsupported code_challenge_method: $method" ), return
		if not exists $transform{ $method };
	$self->set_error_invalid_request( sprintf 'bad code_challenge length: %s (must be 43)', length $challenge ), return
		unless 43 == length $challenge;
	$self->set_error_invalid_request( sprintf 'bad character in code_challenge: 0x%02X at position %d', ord $1, -1 + pos $challenge ), return
		if $challenge =~ /([^A-Za-z0-9_-])/g;
	( $challenge, $method );
}
fresh get_pkce_challenge => \&fresh__get_pkce_challenge;
undef *fresh__get_pkce_challenge;

sub fresh__get_pkce_token {
	my ( $self, $secret ) = ( shift, @_ );
	my ( $challenge, $method ) = $self->get_pkce_challenge or return;
	( my $hmac = Digest::SHA::hmac_sha256_base64( "$method $challenge", $secret ) ) =~ y[+/][-_];
	"$hmac $method";
}
fresh get_pkce_token => \&fresh__get_pkce_token;
undef *fresh__get_pkce_token;

package Net::OAuth2Server::Request::Token::AuthorizationCode::Role::PKCE;

our $VERSION = '0.002';

use Role::Tiny;
use Class::Method::Modifiers 'fresh';
use Carp ();

sub no_secret_required { my $orig = shift; grep 'client_secret' ne $_, shift->$orig( @_ ) };
around required_parameters => \&no_secret_required;

sub fresh__get_pkce_challenge {
	my ( $self, $method ) = ( shift, @_ );
	my $t = $transform{ $method }
		or Carp::croak( "bad code_challenge_method: $method" );
	$self->ensure_required( 'code_verifier' ) or return;
	my $verifier = $self->param( 'code_verifier' );
	$self->set_error_invalid_request( sprintf 'bad code_challenge length: %s (must be 43 (min) to 128 (max))', length $verifier ), return
		unless grep 43 <= $_ && $_ <= 128, length $verifier;
	$self->set_error_invalid_request( sprintf 'bad character in code_challenge: 0x%02X at position %d', ord $1, -1 + pos $verifier ), return
		if $verifier =~ /([^.~A-Za-z0-9_-])/g;
	$t->( $verifier );
}
fresh get_pkce_challenge => \&fresh__get_pkce_challenge;
undef *fresh__get_pkce_challenge;

sub fresh__ensure_pkce_token {
	my ( $self, $secret, $token ) = ( shift, @_ );
	my ( $orig_hmac, $method ) = split / /, $token, 2;
	my ( $challenge ) = $self->get_pkce_challenge( $method ) or return !1;
	( my $hmac = Digest::SHA::hmac_sha256_base64( "$method $challenge", $secret ) ) =~ y[+/][-_];
	( my $ok = $hmac eq $orig_hmac ) or $self->set_error_invalid_client;
	$ok;
}
fresh ensure_pkce_token => \&fresh__ensure_pkce_token;
undef *fresh__ensure_pkce_token;

1;

__END__