File Coverage

blib/lib/Mojar/Auth/Jwt.pm

Criterion	Covered	Total	%
statement	56	73	76.7
branch	10	20	50.0
condition	2	6	33.3
subroutine	14	17	82.3
pod	9	9	100.0
total	91	125	72.8

package Mojar::Auth::Jwt;
use Mojo::Base -base;

our $VERSION = 0.032;

use Carp 'croak';
use Crypt::OpenSSL::RSA ();
use MIME::Base64 ();
use Mojar::ClassShare 'have';
use Mojo::JSON 'encode_json', 'decode_json';

# Attributes

# JWT Header
has typ => 'JWT';
has alg => 'RS256';

# JWT Claim Set
has 'iss';
has scope => sub { q{https://www.googleapis.com/auth/analytics.readonly} };
has aud => q{https://accounts.google.com/o/oauth2/token};
has iat => sub { time };
has duration => 60*60;  # 1 hour
has exp => sub { time + $_[0]->duration };

# JWT Signature
has 'private_key';

# Mogrified chunks

sub header {
  my $self = shift;

  if (@_ == 0) {
    my @h = map +( ($_, $self->$_) ), qw(typ alg);
    return $self->{header} = $self->mogrify( { @h } );
  }
  else {
    %$self = ( %$self, @_ );
  }
  return $self;
}

sub body {
  my $self = shift;

  if (@_ == 0) {
    foreach (qw(iss scope)) {
      croak "Missing required field ($_)" unless defined $self->$_;
    }
    $self->{scope} = join ' ', @{$self->{scope}} if ref $self->{scope};
    my @c = map +( ($_, $self->$_) ), qw(iss scope aud exp iat);
    return $self->{body} = $self->mogrify( { @c } );
  }
  else {
    %$self = ( %$self, @_ );
  }
  return $self;
}

sub signature {
  my $self = shift;

  if (@_ == 0) {
    croak 'Unrecognised algorithm (not RS256)' unless $self->alg eq 'RS256';
    my $input = $self->header .q{.}. $self->body;

    return $self->{signature} = MIME::Base64::encode_base64url(
      $self->cipher->sign($input)
    );
  }
  else {
    %$self = ( %$self, @_ );
  }
  return $self;
}

has cipher => sub {
  my $self = shift;
  foreach ('private_key') {
    croak qq{Missing required field ($_)} unless defined $self->$_;
  }

  my $cipher = Crypt::OpenSSL::RSA->new_private_key($self->private_key);
  $cipher->use_pkcs1_padding;
  $cipher->use_sha256_hash;  # Requires openssl v0.9.8+
  return $cipher;
};

# Public methods

sub reset {
  my ($self) = @_;
  delete @$self{qw(iat exp body signature)};
  return;
}

sub encode {
  my $self = shift;
  if (ref $self) {
    # Encoding an existing object
    %$self = (%$self, @_) if @_;
  }
  else {
    # Class method => create object
    $self = $self->new(@_);
  }
  return join q{.}, $self->header, $self->body, $self->signature;
}

sub decode {
  my ($self, $triplet) = @_;
  my ($header, $body, $signature) = split /\./, $triplet;

  my %param = %{ $self->demogrify($header) };
  %param = ( %param, %{ $self->demogrify($body) } );
  return $self->new(%param);
}

sub verify_signature {
  my $self = shift;
  my $plaintext = $self->header .q{.}. $self->body;
  my $plainsign = MIME::Base64::decode_base64url( $self->signature );
  return $self->cipher->verify($plaintext, $plainsign);
}

sub mogrify {
  my ($self, $hashref) = @_;
  return '' unless ref $hashref && ref $hashref eq 'HASH';
  return MIME::Base64::encode_base64url(encode_json $hashref);
}

sub demogrify {
  my ($self, $safestring) = @_;
  return {} unless defined $safestring && length $safestring;
  return decode_json(MIME::Base64::decode_base64url($safestring));
}

package Mojo::JSON;
# Need json keys to be sorted => s/keys/sort keys/
no warnings 'redefine';
sub _encode_object {
  my $object = shift;
  my @pairs = map { _encode_string($_) . ':' . _encode_value($object->{$_}) }
    sort keys %$object;
  return '{' . join(',', @pairs) . '}';
};

1;
__END__