| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package WWW::FCM::HTTP::V1::OAuth; | 
| 2 | 3 |  |  | 3 |  | 51 | use 5.008001; | 
|  | 3 |  |  |  |  | 10 |  | 
| 3 | 3 |  |  | 3 |  | 13 | use strict; | 
|  | 3 |  |  |  |  | 5 |  | 
|  | 3 |  |  |  |  | 61 |  | 
| 4 | 3 |  |  | 3 |  | 12 | use warnings; | 
|  | 3 |  |  |  |  | 5 |  | 
|  | 3 |  |  |  |  | 151 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | our $VERSION = "0.01"; | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | use Class::Accessor::Lite ( | 
| 9 | 3 |  |  |  |  | 24 | new => 0, | 
| 10 |  |  |  |  |  |  | ro => [qw/ua jwt_config scopes grant_type timeout expires_in/], | 
| 11 |  |  |  |  |  |  | rw => [qw/token_url cache/], | 
| 12 | 3 |  |  | 3 |  | 16 | ); | 
|  | 3 |  |  |  |  | 5 |  | 
| 13 |  |  |  |  |  |  |  | 
| 14 | 3 |  |  | 3 |  | 419 | use JSON qw(encode_json decode_json); | 
|  | 3 |  |  |  |  | 4 |  | 
|  | 3 |  |  |  |  | 15 |  | 
| 15 | 3 |  |  | 3 |  | 1349 | use JSON::WebToken; | 
|  | 3 |  |  |  |  | 18379 |  | 
|  | 3 |  |  |  |  | 155 |  | 
| 16 | 3 |  |  | 3 |  | 1146 | use Furl; | 
|  | 3 |  |  |  |  | 52443 |  | 
|  | 3 |  |  |  |  | 99 |  | 
| 17 | 3 |  |  | 3 |  | 776 | use HTTP::Status qw(:constants); | 
|  | 3 |  |  |  |  | 8329 |  | 
|  | 3 |  |  |  |  | 1120 |  | 
| 18 | 3 |  |  | 3 |  | 23 | use Carp qw(carp croak); | 
|  | 3 |  |  |  |  | 5 |  | 
|  | 3 |  |  |  |  | 1897 |  | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | our $DEFAULT_TOKEN_URL  = "https://accounts.google.com/o/oauth2/token"; | 
| 21 |  |  |  |  |  |  | our $DEFAULT_GRANT_TYPE = "urn:ietf:params:oauth:grant-type:jwt-bearer"; | 
| 22 |  |  |  |  |  |  | our $DEFAULT_TIMEOUT    = 5; | 
| 23 |  |  |  |  |  |  | our $DEFAULT_EXPIRES_IN = 3600; | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | sub new { | 
| 26 | 4 |  |  | 4 | 0 | 13094 | my ($class, %args) = @_; | 
| 27 | 4 |  | 33 |  |  | 25 | $args{grant_type} ||= $DEFAULT_GRANT_TYPE; | 
| 28 | 4 |  | 33 |  |  | 20 | $args{timeout}    ||= $DEFAULT_TIMEOUT; | 
| 29 | 4 |  | 100 |  |  | 12 | $args{scopes}     ||= []; | 
| 30 | 4 |  | 33 |  |  | 23 | $args{jwt_config} ||= _jwt_config_from_json($args{api_key_json}, $args{scopes}); | 
| 31 | 4 |  | 33 |  |  | 20 | $args{token_url}  ||= $args{jwt_config}->{token_url}; | 
| 32 | 4 |  | 33 |  |  | 31 | $args{ua}         ||= Furl->new(timeout => $args{timeout}); | 
| 33 | 4 |  | 50 |  |  | 244 | $args{cache}      ||= undef; # if you will cache the oAuth token, create get/set/delete method | 
| 34 | 4 |  | 33 |  |  | 18 | $args{expires_in} ||= $DEFAULT_EXPIRES_IN; # for cache | 
| 35 |  |  |  |  |  |  |  | 
| 36 | 4 |  |  |  |  | 20 | bless \%args, $class; | 
| 37 |  |  |  |  |  |  | } | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | sub request { | 
| 40 | 4 |  |  | 4 | 0 | 957 | my ($self, %args) = @_; | 
| 41 |  |  |  |  |  |  |  | 
| 42 | 4 |  |  |  |  | 78 | my $token = $self->get_token(force_refresh => $args{retry}); | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | my $res = $self->ua->request( | 
| 45 |  |  |  |  |  |  | method => $args{method}, | 
| 46 |  |  |  |  |  |  | url => $args{uri}, | 
| 47 |  |  |  |  |  |  | headers => [ | 
| 48 |  |  |  |  |  |  | 'Content-Type' => $args{content_type} || 'application/json; UTF-8', | 
| 49 |  |  |  |  |  |  | 'Authorization' => sprintf("Bearer %s", $token->{access_token}), | 
| 50 |  |  |  |  |  |  | ], | 
| 51 | 3 |  | 50 |  |  | 17 | content => $args{content} || (), | 
|  |  |  | 33 |  |  |  |  | 
| 52 |  |  |  |  |  |  | ); | 
| 53 |  |  |  |  |  |  |  | 
| 54 | 3 | 50 | 33 |  |  | 22411 | if ($res->code == HTTP_UNAUTHORIZED && !$args{retry}) { | 
| 55 | 0 |  |  |  |  | 0 | $args{retry} = 1; | 
| 56 | 0 |  |  |  |  | 0 | return $self->request(%args); | 
| 57 |  |  |  |  |  |  | } | 
| 58 |  |  |  |  |  |  |  | 
| 59 | 3 |  |  |  |  | 74 | return $res; | 
| 60 |  |  |  |  |  |  | } | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | sub _jwt_config_from_json { | 
| 63 | 4 |  |  | 4 |  | 11 | my ($json, $scopes) = @_; | 
| 64 | 4 |  |  |  |  | 39 | my $secret = decode_json($json); | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | return +{ | 
| 67 |  |  |  |  |  |  | client_email   => $secret->{client_email}, | 
| 68 |  |  |  |  |  |  | private_key    => $secret->{private_key}, | 
| 69 |  |  |  |  |  |  | private_key_id => $secret->{private_key_id}, | 
| 70 |  |  |  |  |  |  | scopes         => $scopes, | 
| 71 | 4 |  | 33 |  |  | 34 | token_url      => $secret->{token_url} || $DEFAULT_TOKEN_URL, | 
| 72 |  |  |  |  |  |  | }; | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | sub get_token { | 
| 76 | 4 |  |  | 4 | 0 | 116 | my ($self, %args) = @_; | 
| 77 |  |  |  |  |  |  |  | 
| 78 | 4 |  |  |  |  | 64 | my $cache_key = $self->jwt_config->{private_key_id}; | 
| 79 | 4 | 50 |  |  |  | 123 | if ($self->cache) { | 
| 80 | 0 | 0 |  |  |  | 0 | if ($args{force_refresh}) { | 
| 81 | 0 |  |  |  |  | 0 | $self->cache->delete($cache_key); | 
| 82 |  |  |  |  |  |  | } else { | 
| 83 | 0 |  |  |  |  | 0 | my $token_cache = $self->cache->get($cache_key); | 
| 84 | 0 | 0 |  |  |  | 0 | return $token_cache if $token_cache; | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 4 |  |  |  |  | 38 | my $claims = $self->_construct_claims($self->jwt_config); | 
| 89 | 4 |  |  |  |  | 19 | my $jwt = JSON::WebToken->encode($claims, $self->jwt_config->{private_key}, 'RS256'); | 
| 90 | 4 |  |  |  |  | 15769 | my $res = $self->ua->post( | 
| 91 |  |  |  |  |  |  | $self->token_url, | 
| 92 |  |  |  |  |  |  | ['Content-Type' => 'application/x-www-form-urlencoded'], | 
| 93 |  |  |  |  |  |  | ['grant_type' => $self->grant_type, assertion => $jwt], | 
| 94 |  |  |  |  |  |  | ); | 
| 95 | 4 | 100 |  |  |  | 25263 | unless ($res->is_success) { | 
| 96 | 1 |  |  |  |  | 42 | croak sprintf('Failed to get access token. %s [req] %s [res] %s', $res->status_line, $res->request->request_line, $res->content) | 
| 97 |  |  |  |  |  |  | } | 
| 98 |  |  |  |  |  |  |  | 
| 99 | 3 |  |  |  |  | 37 | my $res_content; | 
| 100 | 3 |  |  |  |  | 14 | eval { | 
| 101 | 3 |  |  |  |  | 41 | $res_content = decode_json($res->content); | 
| 102 |  |  |  |  |  |  | }; | 
| 103 | 3 | 50 |  |  |  | 92 | if ( my $e = $@ ) { | 
| 104 | 0 |  |  |  |  | 0 | croak sprintf('decode_json error. %s', $e), | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  |  | 
| 107 | 3 | 50 |  |  |  | 17 | if ($self->cache) { | 
| 108 | 0 |  |  |  |  | 0 | eval { | 
| 109 | 0 | 0 |  |  |  | 0 | $self->cache->set($cache_key, $res_content, $self->expires_in) if $res_content; | 
| 110 |  |  |  |  |  |  | }; | 
| 111 | 0 | 0 |  |  |  | 0 | if ( my $e = $@ ) { | 
| 112 | 0 |  |  |  |  | 0 | carp sprintf('Failed to set cache. %s %s', $e), | 
| 113 |  |  |  |  |  |  | } | 
| 114 |  |  |  |  |  |  | } | 
| 115 |  |  |  |  |  |  |  | 
| 116 | 3 |  |  |  |  | 91 | return $res_content; | 
| 117 |  |  |  |  |  |  | } | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | sub _construct_claims { | 
| 120 | 4 |  |  | 4 |  | 36 | my ($self, $config) = @_; | 
| 121 | 4 |  |  |  |  | 15 | my $result = +{}; | 
| 122 | 4 |  |  |  |  | 9 | my $now = time; | 
| 123 | 4 |  |  |  |  | 176 | $result->{iss}   = $config->{client_email}; | 
| 124 | 4 |  |  |  |  | 11 | $result->{scope} = join(' ', @{$config->{scopes}}); | 
|  | 4 |  |  |  |  | 40 |  | 
| 125 | 4 |  |  |  |  | 140 | $result->{aud}   = $config->{token_url}; | 
| 126 | 4 |  |  |  |  | 19 | $result->{iat}   = $now; | 
| 127 | 4 |  |  |  |  | 18 | $result->{exp}   = $now + $self->expires_in; | 
| 128 | 4 | 50 |  |  |  | 123 | $result->{sub}   = $config->{subject} if defined $config->{subject}; | 
| 129 |  |  |  |  |  |  | # prn is the old name of sub. Keep setting it | 
| 130 |  |  |  |  |  |  | # to be compatible with legacy OAuth 2.0 providers. | 
| 131 | 4 | 50 |  |  |  | 20 | $result->{prn}   = $config->{subject} if defined $config->{subject}; | 
| 132 |  |  |  |  |  |  |  | 
| 133 | 4 |  |  |  |  | 42 | return $result; | 
| 134 |  |  |  |  |  |  | } | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | 1; |