File Coverage

blib/lib/Net/OAuth2Server/OIDC.pm
Criterion Covered Total %
statement 30 45 66.6
branch 0 10 0.0
condition 0 5 0.0
subroutine 10 14 71.4
pod n/a
total 40 74 54.0


line stmt bran cond sub pod time code
1 1     1   474 use strict; use warnings;
  1     1   2  
  1         28  
  1         4  
  1         2  
  1         65  
2              
3             package Net::OAuth2Server::OIDC;
4              
5             our $VERSION = '0.004';
6              
7             package Net::OAuth2Server::Request::Authorization::Role::OIDC;
8              
9             our $VERSION = '0.004';
10              
11 1     1   600 use Role::Tiny;
  1         4335  
  1         6  
12 1     1   731 use Class::Method::Modifiers 'fresh';
  1         1676  
  1         390  
13              
14 0     0     sub fresh__response_type_requiring_nonce { qw( token id_token ) }
15             sub fresh__valid_parameter_values { (
16 0     0     display => [qw( page popup touch wap )],
17             prompt => [qw( none login consent select_account )],
18             ) }
19             fresh response_type_requiring_nonce => \&fresh__response_type_requiring_nonce;
20             fresh valid_parameter_values => \&fresh__valid_parameter_values;
21             undef *fresh__response_type_requiring_nonce;
22             undef *fresh__valid_parameter_values;
23              
24             sub around__new {
25             my $orig = shift;
26             my $class = shift;
27             my $self = $class->$orig( @_ );
28             return $self if $self->error;
29             if ( $self->scope->contains( 'openid' ) ) {
30             return $self->set_error_invalid_request( 'missing parameter: nonce' )
31             if ( not defined $self->param('nonce') )
32             and $self->response_type->contains( $self->response_type_requiring_nonce );
33              
34             my %validate = $self->valid_parameter_values;
35             my @invalid = sort grep {
36             my $name = $_;
37             my $value = $self->param( $name );
38             defined $value and not grep $value eq $_, @{ $validate{ $name } };
39             } keys %validate;
40             return $self->set_error_invalid_request( "invalid value for parameter: @invalid" ) if @invalid;
41             }
42             else {
43             return $self->set_error_invalid_request( 'id_token requested outside of openid scope' )
44             if $self->response_type->contains( 'id_token' );
45             }
46             $self;
47             }
48             around 'new' => \&around__new;
49             undef *around__new;
50              
51             package Net::OAuth2Server::Response::Role::OIDC;
52              
53             our $VERSION = '0.004';
54              
55 1     1   9 use Role::Tiny;
  1         2  
  1         6  
56 1     1   158 use Class::Method::Modifiers 'fresh';
  1         2  
  1         61  
57 1     1   522 use MIME::Base64 ();
  1         726  
  1         25  
58 1     1   496 use JSON::WebToken ();
  1         20102  
  1         30  
59 1     1   654 use Digest::SHA ();
  1         4949  
  1         29  
60 1     1   24 use Carp ();
  1         2  
  1         658  
61              
62             # copy-paste from newer MIME::Base64 for older versions without it
63             my $b64url_enc = MIME::Base64->can( 'encode_base64url' ) || sub {
64             my $e = MIME::Base64::encode_base64( shift, '' );
65             $e =~ s/=+\z//;
66             $e =~ tr[+/][-_];
67             return $e;
68             };
69              
70 0     0     sub fresh__supported_response_types { qw( code id_token token ) }
71             fresh supported_response_types => \&fresh__supported_response_types;
72             undef *fresh__supported_response_types;
73              
74             sub around__for_authorization {
75             my $orig = shift;
76             my ( $class, $req, $grant ) = ( shift, @_ );
77             my $self = $class->$orig( @_ );
78             return $self if $self->is_error or not $grant;
79             $grant->create_id_token( $self, 1 ) if $req->response_type->contains( 'id_token' );
80             $self;
81             }
82             around for_authorization => \&around__for_authorization;
83             undef *around__for_authorization;
84              
85             sub around__for_token {
86             my $orig = shift;
87             my ( $class, $req, $grant ) = ( shift, @_ );
88             my $self = $class->$orig( @_ );
89             return $self if $self->is_error or not $grant;
90             $grant->create_id_token( $self, 0 ) if $grant->scope->contains( 'openid' );
91             $self;
92             }
93             around for_token => \&around__for_token;
94             undef *around__for_token;
95              
96             my %hashed = qw( code c_hash access_token at_hash );
97              
98             sub fresh__add_id_token {
99 0     0     my ( $self, $nonce, $pay, $head, $key ) = ( shift, @_ );
100 0 0         Carp::croak 'missing payload' unless $pay;
101 0 0 0       Carp::croak 'header and payload must be hashes' if grep 'HASH' ne ref, $pay, $head || ();
102 0 0         $pay->{'nonce'} = $nonce if $nonce;
103 0           my $p = $self->param;
104 0   0       my $alg = ( $head && $head->{'alg'} ) || 'none';
105 0 0         if ( $alg =~ /\A[A-Za-z]{2}([0-9]+)\z/ ) {
106 0           my $sha = Digest::SHA->new( "$1" );
107 0           while ( my ( $k, $k_hash ) = each %hashed ) {
108 0 0         my $digest = exists $p->{ $k } ? $sha->reset->add( $p->{ $k } )->digest : next;
109 0           $pay->{ $k_hash } = $b64url_enc->( substr $digest, 0, length( $digest ) / 2 );
110             }
111             }
112 0           $self->add_token( id_token => JSON::WebToken->encode( $pay, $key, $alg, $head ) );
113             }
114             fresh add_id_token => \&fresh__add_id_token;
115             undef *fresh__add_id_token;
116              
117             1;
118              
119             __END__