view release on metacpan or  search on metacpan

lib/Catalyst/Plugin/OAuth2/ResourceServer/Server.pm  view on Meta::CPAN

package Catalyst::Plugin::OAuth2::ResourceServer::Server;
use v5.36;
use Moo;
use Carp ();
use Try::Tiny;
use Crypt::JWT qw/decode_jwt/;
use Catalyst::Plugin::OAuth2::ResourceServer::Error;

our $VERSION = '0.003';

has signing_key => ( is => 'ro', required => 1 );
has resource    => ( is => 'ro', required => 1 );
has issuer      => ( is => 'ro', required => 1 );
has jwt_alg     => ( is => 'ro', default => 'HS256' );
has leeway      => ( is => 'ro', default => 0 );

use namespace::clean;
use MooX::StrictConstructor;

sub BUILD ( $self, $args ) {
    Carp::croak 'resource must be a non-empty scalar or arrayref'
        unless @{ $self->_resource_list };
    state %ALLOWED_ALG = map { $_ => 1 } qw/HS256 HS384 HS512/;
    Carp::croak 'jwt_alg must be one of HS256, HS384, HS512'
        unless $ALLOWED_ALG{ $self->jwt_alg };
    state %MIN_KEY_BYTES = ( HS256 => 32, HS384 => 48, HS512 => 64 );
    Carp::croak sprintf(
        'signing_key must be at least %d bytes for %s',
        $MIN_KEY_BYTES{ $self->jwt_alg }, $self->jwt_alg )
        if length( $self->signing_key ) < $MIN_KEY_BYTES{ $self->jwt_alg };
}

# resource may be a scalar or arrayref; normalise to a list.
sub _resource_list ( $self ) {
    my $r = $self->resource;
    return ref $r eq 'ARRAY' ? [ @$r ] : defined $r && length $r ? [$r] : [];
}

sub _invalid ( $self, $desc ) {
    Catalyst::Plugin::OAuth2::ResourceServer::Error->throw(
        error             => 'invalid_token',
        error_description => $desc,
        http_status       => 401,
    );
}

# Verify a bearer JWT: signature + alg allowlist + exp/nbf/iat (with leeway) +
# iss, then an explicit aud-membership check against our own resource(s).
# Returns the claims, or throws a 401 invalid_token (reason never leaked).
#
# Crypt::JWT verify_* semantics (see its POD): 1 = claim REQUIRED and valid,
# undef = "validate only if present". exp is required (a token with no expiry
# is never acceptable here). nbf and iat are optional per RFC 7519 4.1.5/4.1.6
# and the companion AuthorizationServer mints no nbf at all, so both are
# validate-if-present: requiring them would reject legitimate tokens. Note
# verify_iat is asymmetric in Crypt::JWT -- omitting the key entirely disables
# the iat check completely, so it must be passed explicitly as undef.
sub verify_token ( $self, $jwt ) {
    my $claims = try {
        decode_jwt(
            token        => $jwt,
            key          => $self->signing_key,
            accepted_alg => [ $self->jwt_alg ],
            verify_exp   => 1,
            verify_nbf   => undef,