File Coverage

blib/lib/Net/Async/WebSearch/Provider/Reddit/OAuth.pm

Criterion	Covered	Total	%
statement	143	148	96.6
branch	52	68	76.4
condition	30	60	50.0
subroutine	30	30	100.0
pod	12	14	85.7
total	267	320	83.4

package Net::Async::WebSearch::Provider::Reddit::OAuth;
our $VERSION = '0.002';
# ABSTRACT: Reddit search provider using the OAuth2 endpoint
use strict;
use warnings;
use parent 'Net::Async::WebSearch::Provider::Reddit';

use Carp qw( croak );
use Future;
use JSON::MaybeXS qw( decode_json );
use URI;
use HTTP::Request::Common qw( GET POST );
use MIME::Base64 qw( encode_base64 );

sub _init {
  my ( $self ) = @_;
  croak "Reddit::OAuth requires 'client_id'"     unless $self->{client_id};
  croak "Reddit::OAuth requires 'client_secret'" unless defined $self->{client_secret};

  $self->{grant_type}    ||= 'client_credentials';  # client_credentials | password | installed | authorization_code
  $self->{token_url}     ||= 'https://www.reddit.com/api/v1/access_token';
  $self->{authorize_url} ||= 'https://www.reddit.com/api/v1/authorize';
  $self->{endpoint}      ||= 'https://oauth.reddit.com';
  $self->{name}          ||= 'reddit-oauth';
  $self->{link_base}     ||= 'https://www.reddit.com';
  $self->{token_margin}  ||= 60;   # refresh this many seconds before expiry

  if ( $self->{grant_type} eq 'password' ) {
    croak "grant_type=password needs 'username' and 'password'"
      unless defined $self->{username} && defined $self->{password};
  }
  elsif ( $self->{grant_type} eq 'installed' ) {
    $self->{device_id} ||= 'DO_NOT_TRACK_THIS_DEVICE';
  }
  elsif ( $self->{grant_type} eq 'authorization_code' ) {
    # For authorization_code, either the caller seeds us with
    # a refresh_token (persisted from a prior session) or with
    # an access_token + refresh_token pair, or they must drive
    # authorize_url → complete_authorization themselves before
    # the first search.
  }

  $self->SUPER::_init;
  # Parent sets link_base to www.reddit.com, which is what we want.
  # But parent also sets endpoint to www.reddit.com — overwrite back.
  $self->{endpoint} = 'https://oauth.reddit.com' unless $self->{_endpoint_explicit};

  # Pre-seed token/refresh if the caller provided them (persisted state).
  if ( defined $self->{access_token} ) {
    $self->{_access_token}     = $self->{access_token};
    $self->{_token_expires_at} = $self->{token_expires_at}
      // ( time + ( $self->{expires_in} // 3600 ) );
  }
  if ( defined $self->{refresh_token} ) {
    $self->{_refresh_token} = $self->{refresh_token};
  }
}

sub new {
  my ( $class, %args ) = @_;
  my $explicit_ep = exists $args{endpoint};
  my $self = $class->SUPER::new(%args);
  $self->{_endpoint_explicit} = $explicit_ep;
  $self->{endpoint} = 'https://oauth.reddit.com' unless $explicit_ep;
  return $self;
}

sub client_id          { $_[0]->{client_id} }
sub client_secret      { $_[0]->{client_secret} }
sub grant_type         { $_[0]->{grant_type} }
sub token_url          { $_[0]->{token_url} }
sub authorize_endpoint { $_[0]->{authorize_url} }

sub access_token       { $_[0]->{_access_token} }
sub refresh_token      { $_[0]->{_refresh_token} }
sub token_expires_at   { $_[0]->{_token_expires_at} }

# MCP / host helper: snapshot the persistable bits of the auth state
# so a host application can stash them in its session store and feed
# them back to a later `new()` call.
sub token_state {
  my ( $self ) = @_;
  return {
    ( defined $self->{_access_token}
        ? ( access_token      => $self->{_access_token},
            token_expires_at  => $self->{_token_expires_at} )
        : () ),
    ( defined $self->{_refresh_token}
        ? ( refresh_token => $self->{_refresh_token} )
        : () ),
  };
}

sub _basic_auth_header {
  my ( $self ) = @_;
  my $raw = $self->client_id . ':' . $self->client_secret;
  my $b64 = encode_base64($raw, '');
  return "Basic $b64";
}

#----------------------------------------------------------------------
# Host-facing authorization-code helpers
#----------------------------------------------------------------------

# Build the URL the human should visit to authorize the app.
# Returns a plain URL string (not a Future) — no network round-trip.
sub authorize_url {
  my ( $self, %args ) = @_;
  croak "authorize_url needs 'redirect_uri'" unless defined $args{redirect_uri};
  my $scope = $args{scope};
  if ( ref $scope eq 'ARRAY' ) { $scope = join ' ', @$scope }
  $scope //= 'read';
  my $uri = URI->new( $self->authorize_endpoint );
  $uri->query_form(
    client_id     => $self->client_id,
    response_type => 'code',
    state         => $args{state} // _random_state(),
    redirect_uri  => $args{redirect_uri},
    duration      => $args{duration} // 'permanent',
    scope         => $scope,
  );
  return $uri->as_string;
}

# Exchange an authorization_code → access_token + refresh_token.
# Caller supplies the code pasted back from the redirect, plus the
# same redirect_uri that was used in authorize_url.
sub complete_authorization {
  my ( $self, %args ) = @_;
  my $http = $args{http} || $self->{_http_for_auth};
  croak "complete_authorization needs 'http' (Net::Async::HTTP) "
       ."unless the provider has been added to a loop first"
    unless $http;
  croak "complete_authorization needs 'code'"         unless defined $args{code};
  croak "complete_authorization needs 'redirect_uri'" unless defined $args{redirect_uri};

  return $self->_post_token($http, [
    grant_type   => 'authorization_code',
    code         => $args{code},
    redirect_uri => $args{redirect_uri},
  ]);
}

sub _random_state {
  my @chars = ( 'a'..'z', 'A'..'Z', 0..9 );
  join '', map { $chars[ int rand @chars ] } 1 .. 24;
}

#----------------------------------------------------------------------
# Token fetch / refresh dance
#----------------------------------------------------------------------

sub _post_token {
  my ( $self, $http, $body_ref ) = @_;
  my $req = POST( $self->token_url, $body_ref );
  $req->header( 'Authorization' => $self->_basic_auth_header );
  $req->header( 'User-Agent'    => $self->user_agent_string );
  $req->header( 'Accept'        => 'application/json' );

  return $http->do_request( request => $req )->then(sub {
    my ( $resp ) = @_;
    unless ( $resp->is_success ) {
      return Future->fail(
        $self->name.": token HTTP ".$resp->status_line, 'websearch', $self->name,
      );
    }
    my $data = eval { decode_json( $resp->decoded_content ) };
    if ( my $e = $@ ) {
      return Future->fail( $self->name.": token invalid JSON: $e", 'websearch', $self->name );
    }
    if ( !$data->{access_token} ) {
      my $err = $data->{error} // 'unknown';
      return Future->fail( $self->name.": token error: $err", 'websearch', $self->name );
    }
    $self->{_access_token}     = $data->{access_token};
    $self->{_token_expires_at} = time + ( $data->{expires_in} // 3600 );
    # Reddit only returns refresh_token on duration=permanent auth_code
    # flows. Some refresh responses include a fresh refresh_token too —
    # prefer that; otherwise keep the one we used.
    if ( defined $data->{refresh_token} ) {
      $self->{_refresh_token} = $data->{refresh_token};
    }
    if ( my $cb = $self->{on_token_refresh} ) {
      $cb->( $self, $data );
    }
    return Future->done( $self->{_access_token} );
  });
}

sub _get_token {
  my ( $self, $http ) = @_;

  # Valid cached token?
  if ( $self->{_access_token}
       && $self->{_token_expires_at}
       && time + $self->{token_margin} < $self->{_token_expires_at} ) {
    return Future->done( $self->{_access_token} );
  }

  # A refresh_token beats every other grant — it's cheap and user-context
  # is already established.
  if ( $self->{_refresh_token} ) {
    return $self->_post_token($http, [
      grant_type    => 'refresh_token',
      refresh_token => $self->{_refresh_token},
    ]);
  }

  # For authorization_code flows without a refresh_token, we can't
  # auto-fetch — the caller must drive the authorize → complete
  # dance first.
  if ( $self->grant_type eq 'authorization_code' ) {
    return Future->fail(
      $self->name.": no access_token and no refresh_token — "
        ."call authorize_url / complete_authorization first",
      'websearch', $self->name,
    );
  }

  my @body = ( grant_type => $self->grant_type );
  if ( $self->grant_type eq 'password' ) {
    push @body, username => $self->{username}, password => $self->{password};
  }
  elsif ( $self->grant_type eq 'installed' ) {
    @body = (
      grant_type => 'https://oauth.reddit.com/grants/installed_client',
      device_id  => $self->{device_id},
    );
  }

  return $self->_post_token($http, \@body);
}

sub search {
  my ( $self, $http, $query, $opts ) = @_;
  $opts ||= {};
  my $limit = $opts->{limit} || 10;

  return $self->_get_token($http)->then(sub {
    my ( $token ) = @_;

    my $sub = defined $opts->{subreddit} ? $opts->{subreddit} : $self->subreddit;
    my $path = defined $sub && length $sub ? "/r/$sub/search" : "/search";

    my $uri = URI->new( $self->endpoint . $path );
    my %q = (
      q     => $query,
      limit => $limit,
      sort  => $opts->{sort} // $self->sort,
      t     => $opts->{time} // $self->time,
      raw_json => 1,
    );
    $q{restrict_sr}     = 1   if defined $sub && length $sub;
    $q{include_over_18} = $opts->{include_nsfw} ? 'on' : 'off';
    $uri->query_form(%q);

    my $req = GET( $uri->as_string );
    $req->header( 'Authorization' => "Bearer $token" );
    $req->header( 'User-Agent'    => $self->user_agent_string );
    $req->header( 'Accept'        => 'application/json' );

    $http->do_request( request => $req )->then(sub {
      my ( $resp ) = @_;
      unless ( $resp->is_success ) {
        return Future->fail(
          $self->name.": HTTP ".$resp->status_line, 'websearch', $self->name,
        );
      }
      my $data = eval { decode_json( $resp->decoded_content ) };
      if ( my $e = $@ ) {
        return Future->fail( $self->name.": invalid JSON: $e", 'websearch', $self->name );
      }
      return Future->done( $self->_parse_listing($data, $limit) );
    });
  });
}

sub user_agent_string {
  my ( $self ) = @_;
  return $self->{user_agent} if defined $self->{user_agent};
  return $self->SUPER::user_agent_string;
}

1;

__END__