view release on metacpan or  search on metacpan

lib/At/UserAgent.pm  view on Meta::CPAN

use v5.42;
use feature 'class';
no warnings 'experimental::class';
use URI;
use JSON::PP qw[decode_json encode_json];
use Digest::SHA;
use MIME::Base64;
use Crypt::JWT;
use Crypt::PRNG;
use experimental 'try';
use feature 'class';
no warnings 'experimental::class';

class At::UserAgent 1.6 {
    field $accessJwt  : reader : param = undef;
    field $refreshJwt : reader : param = undef;
    field $token_type : reader : param = 'Bearer';
    field $dpop_key   : reader : param = undef;
    field $dpop_nonce;
    field $auth;
    field $at_protocol_proxy : param = undef;

    method at_protocol_proxy ( $new_val = undef ) {
        $at_protocol_proxy = $new_val if defined $new_val;
        return $at_protocol_proxy;
    }

    method dpop_nonce ( $new_val = undef ) {
        $dpop_nonce = $new_val if defined $new_val;
        return $dpop_nonce;
    }

    method auth ( $new_val = undef ) {
        $auth = $new_val if defined $new_val;
        return $auth;
    }

    method set_tokens ( $access, $refresh, $type, $key ) {
        $accessJwt  = $access;
        $refreshJwt = $refresh;
        $token_type = $type // 'Bearer';
        $dpop_key   = $key;
        if ( defined $accessJwt ) {
            $self->_set_auth_header( $token_type . ' ' . $accessJwt );
        }
        else {
            $self->_set_auth_header(undef);
        }
    }

    method _generate_dpop_proof( $url, $method, $skip_ath = 0 ) {
        return unless $dpop_key;
        my $jwk_json = $dpop_key->export_key_jwk('public');
        my $jwk      = JSON::PP::decode_json($jwk_json);
        my $now      = time;
        my $htu      = URI->new($url);
        $htu->query(undef);
        $htu->fragment(undef);
        my $chars = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-._~';
        my $payload
            = { jti => Crypt::PRNG::random_string_from( $chars, 32 ), htm => $method, htu => $htu->as_string, iat => $now, exp => $now + 60, };
        $payload->{nonce} = $dpop_nonce if defined $dpop_nonce;

        if ( $accessJwt && !$skip_ath ) {
            $payload->{ath} = MIME::Base64::encode_base64url( Digest::SHA::sha256($accessJwt) );
            $payload->{ath} =~ s/=+$//;
        }
        return Crypt::JWT::encode_jwt( payload => $payload, key => $dpop_key, alg => 'ES256', extra_headers => { typ => 'dpop+jwt', jwk => $jwk } );
    }
    method _set_auth_header ($token)               { die "Abstract" }
    method get              ( $url, $req = undef ) { die "Abstract" }
    method post             ( $url, $req = undef ) { die "Abstract" }
    method websocket        ( $url, $cb )          { die "Abstract" }
}
class    #
    At::UserAgent::Tiny : isa(At::UserAgent) {
    use HTTP::Tiny;
    field $agent : param
        = HTTP::Tiny->new( agent => 'At.pm/Tiny', default_headers => { 'Content-Type' => 'application/json', Accept => 'application/json' } );

    method get( $url, $req = {} ) {
        $req //= {};
        $req->{headers}{DPoP} = $self->_generate_dpop_proof( $url, 'GET', $req->{skip_ath} ) if $self->token_type eq 'DPoP';
        my $res
            = $agent->get( $url . ( defined $req->{content} && keys %{ $req->{content} } ? '?' . $agent->www_form_urlencode( $req->{content} ) : '' ),
            { defined $req->{headers} ? ( headers => $req->{headers} ) : () } );
        $res->{content} = JSON::PP::decode_json( $res->{content} ) if $res->{content} && ( $res->{headers}{'content-type'} // '' ) =~ m[json];
        unless ( $res->{success} ) {
            my $msg = $res->{reason} // 'Unknown error';
            if ( ref $res->{content} eq 'HASH' ) {
                my $json    = $res->{content};
                my $details = $json->{error} // '';
                if ( $json->{message} && $json->{message} ne $details ) {
                    $details .= ( $details ? ': ' : '' ) . $json->{message};
                }
                $msg .= ": " . $details                    if $details;
                $msg .= " - " . $json->{error_description} if $json->{error_description};
            }
            elsif ( $res->{content} ) {
                $msg .= " (" . $res->{content} . ")";
            }
            $res->{content} = At::Error->new( message => $msg, fatal => 1 );
        }
        wantarray ? ( $res->{content}, $res->{headers} ) : $res->{content};
    }

    method post( $url, $req = {} ) {
        $req //= {};
        $req->{headers}{DPoP} = $self->_generate_dpop_proof( $url, 'POST', $req->{skip_ath} ) if $self->token_type eq 'DPoP';
        my $content;
        if ( defined $req->{content} ) {
            if ( $req->{encoding} && $req->{encoding} eq 'form' ) {
                $content = $agent->www_form_urlencode( $req->{content} );
                $req->{headers}{'Content-Type'} = 'application/x-www-form-urlencoded';
            }
            elsif ( ref $req->{content} ) {
                $content = JSON::PP::encode_json( $req->{content} );
                $req->{headers}{'Content-Type'} = 'application/json';