File Coverage

lib/At/UserAgent.pm

Criterion	Covered	Total	%
statement	38	62	61.2
branch	0	10	0.0
condition	0	2	0.0
subroutine	13	14	92.8
pod			n/a
total	51	88	57.9

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';
            }
            else {
                $content = $req->{content};
            }
        }
        my $res = $agent->post( $url,
            { defined $req->{headers} ? ( headers => $req->{headers} ) : (), defined $content ? ( content => $content ) : () } );
        $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 websocket ( $url, $cb ) {
        die "At::UserAgent::Tiny does not support WebSockets. Please install Mojo::UserAgent.";
    }

    method _set_auth_header($token) {
        $self->auth($token);
        $agent->{default_headers}{Authorization} = $token;
    }
    } class    #
    At::UserAgent::Mojo : isa(At::UserAgent) {
    field $agent : param = do { require Mojo::UserAgent; Mojo::UserAgent->new };

    method get( $url, $req = {} ) {
        $req //= {};
        my $headers = { %{ $req->{headers} // {} } };
        if ( $self->at_protocol_proxy ) {
            $headers->{'atproto-proxy'} = $self->at_protocol_proxy;
        }
        $headers->{Authorization} = $self->auth                                                  if defined $self->auth;
        $headers->{DPoP}          = $self->_generate_dpop_proof( $url, 'GET', $req->{skip_ath} ) if $self->token_type eq 'DPoP';
        if ( $ENV{DEBUG} ) {
            say "[DEBUG] [At] GET $url";
            say "[DEBUG] [At] Headers: " . JSON::PP::encode_json($headers);
        }
        my $tx  = $agent->get( $url, $headers, defined $req->{content} ? ( form => $req->{content} ) : () );
        my $res = $tx->result;
        if ( my $nonce = $res->headers->header('DPoP-Nonce') ) { $self->dpop_nonce($nonce); }
        if ( $ENV{DEBUG} ) {
            say "[DEBUG] [At] Response Code: " . $res->code;
            say "[DEBUG] [At] Response Headers: " . JSON::PP::encode_json( $res->headers->to_hash );
        }
        if ( $res->code == 401 || $res->code == 400 ) {
            my $body = $res->body // '';
            if ( $body =~ /use_dpop_nonce/i ) {
                say "[DEBUG] [At] Retrying with fresh DPoP nonce..."                            if $ENV{DEBUG};
                $headers->{DPoP} = $self->_generate_dpop_proof( $url, 'GET', $req->{skip_ath} ) if $self->token_type eq 'DPoP';
                if ( $ENV{DEBUG} ) {
                    say "[DEBUG] [At] GET (Retry) $url";
                    say "[DEBUG] [At] Headers (Retry): " . JSON::PP::encode_json($headers);
                }
                $tx  = $agent->get( $url, $headers, defined $req->{content} ? ( form => $req->{content} ) : () );
                $res = $tx->result;
                if ( my $nonce = $res->headers->header('DPoP-Nonce') ) { $self->dpop_nonce($nonce); }
                if ( $ENV{DEBUG} ) {
                    say "[DEBUG] [At] Response Code (Retry): " . $res->code;
                    say "[DEBUG] [At] Response Headers (Retry): " . JSON::PP::encode_json( $res->headers->to_hash );
                }
            }
        }
        if ( $res->is_success ) {
            my $content = $res->body ? ( $res->headers->content_type // '' ) =~ m[json] ? $res->json : $res->body : ();
            return wantarray ? ( $content, $res->headers->to_hash ) : $content;
        }
        my $msg = $res->message;
        if ( my $body = $res->body ) {
            my $json;
            try { $json = JSON::PP::decode_json($body) }
            catch ($e) { }
            if ($json) {
                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};
            }
            else {
                $msg .= " (" . $body . ")";
            }
        }
        return At::Error->new( message => $msg, fatal => 1 );
    }

    method post( $url, $req = {} ) {
        $req //= {};
        my $headers = { %{ $req->{headers} // {} } };
        if ( $self->at_protocol_proxy ) {
            $headers->{'atproto-proxy'} = $self->at_protocol_proxy;
        }
        $headers->{Authorization} = $self->auth                                                   if defined $self->auth;
        $headers->{DPoP}          = $self->_generate_dpop_proof( $url, 'POST', $req->{skip_ath} ) if $self->token_type eq 'DPoP';
        if ( $ENV{DEBUG} ) {
            say "[DEBUG] [At] POST $url";
            say "[DEBUG] [At] Headers: " . JSON::PP::encode_json($headers);
        }
        my %args;
        if ( defined $req->{content} ) {
            if    ( $req->{encoding} && $req->{encoding} eq 'form' ) { $args{form}    = $req->{content}; }
            elsif ( ref $req->{content} )                            { $args{json}    = $req->{content}; }
            else                                                     { $args{content} = $req->{content}; }
        }
        my $tx  = $agent->post( $url, $headers, %args );
        my $res = $tx->result;
        if ( my $nonce = $res->headers->header('DPoP-Nonce') ) { $self->dpop_nonce($nonce); }
        if ( $ENV{DEBUG} ) {
            say "[DEBUG] [At] Response Code: " . $res->code;
            say "[DEBUG] [At] Response Headers: " . JSON::PP::encode_json( $res->headers->to_hash );
        }
        if ( $res->code == 401 || $res->code == 400 ) {
            my $body = $res->body // '';
            if ( $body =~ /use_dpop_nonce/i ) {
                say "[DEBUG] [At] Retrying with fresh DPoP nonce..."                             if $ENV{DEBUG};
                $headers->{DPoP} = $self->_generate_dpop_proof( $url, 'POST', $req->{skip_ath} ) if $self->token_type eq 'DPoP';
                if ( $ENV{DEBUG} ) {
                    say "[DEBUG] [At] POST (Retry) $url";
                    say "[DEBUG] [At] Headers (Retry): " . JSON::PP::encode_json($headers);
                }
                $tx  = $agent->post( $url, $headers, %args );
                $res = $tx->result;
                if ( my $nonce = $res->headers->header('DPoP-Nonce') ) { $self->dpop_nonce($nonce); }
                if ( $ENV{DEBUG} ) {
                    say "[DEBUG] [At] Response Code (Retry): " . $res->code;
                    say "[DEBUG] [At] Response Headers (Retry): " . JSON::PP::encode_json( $res->headers->to_hash );
                }
            }
        }
        if ( $res->is_success ) {
            my $content = $res->body ? ( $res->headers->content_type // '' ) =~ m[json] ? $res->json : $res->body : ();
            return wantarray ? ( $content, $res->headers->to_hash ) : $content;
        }
        my $msg = $res->message;
        if ( my $body = $res->body ) {
            my $json;
            try { $json = JSON::PP::decode_json($body) }
            catch ($e) { }
            if ($json) {
                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};
            }
            else {
                $msg .= " (" . $body . ")";
            }
        }
        return At::Error->new( message => $msg, fatal => 1 );
    }

    method websocket( $url, $cb ) {
        $agent->inactivity_timeout(0);    # Disable inactivity timeout for firehose
        $agent->websocket(
            $url => sub ( $ua, $tx ) {
                if ( !$tx->is_websocket ) {
                    $cb->( undef, At::Error->new( message => "WebSocket handshake failed", fatal => 0 ) );
                    return;
                }

                # Keep-alive heartbeat every 20 seconds
                my $id = Mojo::IOLoop->recurring(
                    20 => sub {
                        return unless $tx;
                        $tx->send( [ 1, 0, 0, 0, 9, '' ] );    # Raw Ping frame
                    }
                );

                # Activity watchdog: if we don't get a message for 10 seconds, close and reconnect
                my $watchdog;
                my $reset_watchdog = sub {
                    Mojo::IOLoop->remove($watchdog) if defined $watchdog;
                    $watchdog = Mojo::IOLoop->timer(
                        10 => sub {
                            $tx->finish( 4000, "Watchdog timeout" );
                        }
                    );
                };
                $reset_watchdog->();
                $tx->on(
                    message => sub ( $tx, $msg ) {
                        $reset_watchdog->();
                        $cb->( $msg, undef );
                    }
                );
                $tx->on(
                    finish => sub ( $tx, $code, $reason ) {
                        Mojo::IOLoop->remove($id)       if defined $id;
                        Mojo::IOLoop->remove($watchdog) if defined $watchdog;
                        $cb->( undef, At::Error->new( message => "WebSocket finished: $code " . ( $reason // '' ), fatal => 0 ) );
                        $tx = undef;
                    }
                );
            }
        );
    }
    method _set_auth_header($token) { $self->auth($token); }
    } 1;
__END__