Cmd-Dwarf
view release on metacpan or search on metacpan
share/app/lib/Dwarf/Module/SocialMedia/Rakuten.pm view on Meta::CPAN
package Dwarf::Module::SocialMedia::Rakuten;
use Dwarf::Pragma;
use parent 'Dwarf::Module';
use Dwarf::HTTP::Async;
use HTTP::Request::Common ();
use JSON;
use LWP::UserAgent;
use MIME::Base64 qw/decode_base64 encode_base64url/;
use Dwarf::Util qw/safe_decode_json encode_utf8/;
use Digest::SHA qw/hmac_sha256_base64/;
use URI::Escape;
use Dwarf::Accessor qw/
ua urls
key secret
access_token
user_id name profile_image
on_error
/;
sub init {
my $self = shift;
$self->{ua} ||= LWP::UserAgent->new;
$self->{urls} ||= {
api => 'https://app.rakuten.co.jp/engine/api/MemberInformation/GetOpenIdUserInfo/20160715',
access_token => 'https://app.rakuten.co.jp/engine/idtoken',
};
$self->{on_error} ||= sub { die @_ };
}
sub show_user {
my $self = shift;
die 'access token must be specified.' unless defined $self->access_token;
my $params = {};
$params->{access_token} = $self->access_token;
my $uri = URI->new($self->urls->{api});
$uri->query_form(%$params);
my $res = $self->ua->post($uri);
my $content = eval { safe_decode_json(encode_utf8 $res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
return $content;
}
sub request_access_token {
my ($self, %params) = @_;
die 'key must be specified.' unless defined $self->key;
die 'secret must be specified.' unless defined $self->secret;
die "redirect_uri must be specified." unless defined $params{redirect_uri};
die "code must be specified." unless defined $params{code};
$params{grant_type} = "authorization_code";
$params{client_id} ||= $self->key;
$params{client_secret} ||= $self->secret;
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->post($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Rakuten OAuth Error: Could not get access token.');
return;
}
my $content = eval { decode_json $res->decoded_content };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
$self->_validate_id_token($content->{id_token});
my $access_token = $content->{access_token};
$self->access_token($access_token);
}
sub _validate_id_token {
my ($self, $id_token) = @_;
my ($header, $payload, $signature) = split /\./, $id_token;
my $alg = eval { decode_json(decode_base64 $header)->{alg} };
die "Something wrong with JWT header. " if $@;
my $data = eval { decode_json(decode_base64 $payload) };
die "Something wrong with JWT payload." if $@;
my $valid_signature;
if ($alg eq "HS256") {
$valid_signature = hmac_sha256_base64($header . "." . $payload, $self->secret);
while (length($valid_signature) % 4) {
$valid_signature .= "=";
}
# hmac_sha256 -> base64url encode ã®ããæ¹ãåãããªãã®ã§ä¸æ¦ããã§...
$valid_signature = encode_base64url decode_base64 $valid_signature;
}
die "Something wrong with JWT header. Couldn't specify hash algorythm." unless $valid_signature;
die "Invalid signature." unless $signature eq $valid_signature;
die "Wrong value: payload.iss" unless $data->{iss} && $data->{iss} eq "https://app.rakuten.co.jp/";
die "Wrong value: payload.aud" unless $data->{aud} && $data->{aud} eq $self->key;
die "Wrong value: payload.exp" unless $data->{exp} && $data->{exp} > time();
die "Wrong value: payload.iat" unless $data->{iat} && $data->{iat} <= time() && time() <= ($data->{iat} + 300);
}
1;
( run in 0.626 second using v1.01-cache-2.11-cpan-39bf76dae61 )