File Coverage

blib/lib/Facebook/OpenGraph.pm

Criterion	Covered	Total	%
statement	255	262	97.3
branch	89	112	79.4
condition	43	57	75.4
subroutine	58	58	100.0
pod	42	43	97.6
total	487	532	91.5

package Facebook::OpenGraph;
use strict;
use warnings;
use 5.008001;

use Facebook::OpenGraph::Response;
use HTTP::Request::Common;
use URI;
use Furl::HTTP;
use Data::Recursive::Encode;
use JSON 2 ();
use Carp qw(croak);
use Digest::SHA qw(hmac_sha256 hmac_sha256_hex);
use MIME::Base64::URLSafe qw(urlsafe_b64decode);
use Scalar::Util qw(blessed);

our $VERSION = '1.30';

sub new {
    my $class = shift;
    my $args  = shift || +{};

    return bless +{
        app_id              => $args->{app_id},
        secret              => $args->{secret},
        namespace           => $args->{namespace},
        access_token        => $args->{access_token},
        redirect_uri        => $args->{redirect_uri},
        batch_limit         => $args->{batch_limit} || 50,
        is_beta             => $args->{is_beta} || 0,
        json                => $args->{json} || JSON->new->utf8,
        use_appsecret_proof => $args->{use_appsecret_proof} || 0,
        use_post_method     => $args->{use_post_method} || 0,
        version             => $args->{version} || undef,
        ua                  => $args->{ua} || Furl::HTTP->new(
            capture_request     => 1,
            agent               => __PACKAGE__ . '/' . $VERSION,
        ),
    }, $class;
}

# accessors
sub app_id              { shift->{app_id}              }
sub secret              { shift->{secret}              }
sub ua                  { shift->{ua}                  }
sub namespace           { shift->{namespace}           }
sub access_token        { shift->{access_token}        }
sub redirect_uri        { shift->{redirect_uri}        }
sub batch_limit         { shift->{batch_limit}         }
sub is_beta             { shift->{is_beta}             }
sub json                { shift->{json}                }
sub use_appsecret_proof { shift->{use_appsecret_proof} }
sub use_post_method     { shift->{use_post_method}     }
sub version             { shift->{version}             }

sub uri {
    my $self = shift;

    my $base = $self->is_beta ? 'https://graph.beta.facebook.com/'
             :                  'https://graph.facebook.com/'
             ;

    return $self->_uri($base, @_);
}

sub video_uri {
    my $self = shift;

    my $base = $self->is_beta ? 'https://graph-video.beta.facebook.com/'
             :                  'https://graph-video.facebook.com/'
             ;

    return $self->_uri($base, @_);
}

sub site_uri {
    my $self = shift;

    my $base = $self->is_beta ? 'https://www.beta.facebook.com/'
             :                  'https://www.facebook.com/'
             ;

    return $self->_uri($base, @_);
}

sub _uri {
    my ($self, $base, $path, $param_ref) = @_;
    my $uri = URI->new_abs($path || '/', $base);
    $uri->query_form(+{
        $uri->query_form,       # when given $path is like /foo?bar=bazz
        %{ $param_ref || +{} }, # additional query parameter
    });

    return $uri;
}

# Login for Games on Facebook > Checking Login Status > Parsing the Signed Request
# https://developers.facebook.com/docs/facebook-login/using-login-with-games
sub parse_signed_request {
    my ($self, $signed_request) = @_;
    croak 'signed_request is not given' unless $signed_request;
    croak 'secret key must be set'      unless $self->secret;

    # "1. Split the signed request into two parts delineated by a '.' character
    # (eg. 238fsdfsd.oijdoifjsidf899)"
    my ($enc_sig, $payload) = split(m{ \. }xms, $signed_request);

    # "2. Decode the first part - the encoded signature - from base64url"
    my $sig = urlsafe_b64decode($enc_sig);

    # "3. Decode the second part - the 'payload' - from base64url and then
    # decode the resultant JSON object"
    my $val = $self->json->decode(urlsafe_b64decode($payload));

    # "It specifically uses HMAC-SHA256 encoding, which you can again use with
    # most programming languages."
    croak 'algorithm must be HMAC-SHA256'
        unless uc( $val->{algorithm} ) eq 'HMAC-SHA256';

    # "You can compare this encoded signature with an expected signature using
    # the payload you received as well as the app secret which is known only to
    # your and ensure that they match."
    my $expected_sig = hmac_sha256($payload, $self->secret);
    croak 'Signature does not match' unless $sig eq $expected_sig;

    return $val;
}

# Detailed flow is described here.
# Manually Build a Login Flow > Logging people in > Invoking the login dialog
# https://developers.facebook.com/docs/facebook-login/manually-build-a-login-flow/
#
# Parameters for login dialog are shown here.
# Login Dialog > Parameters
# https://developers.facebook.com/docs/reference/dialogs/oauth/
sub auth_uri {
    my ($self, $param_ref) = @_;
    $param_ref ||= +{};
    croak 'redirect_uri and app_id must be set'
        unless $self->redirect_uri && $self->app_id;

    # "A comma separated list of permission names which you would like people
    # to grant your app."
    if (my $scope_ref = ref $param_ref->{scope}) {
        croak 'scope must be string or array ref' unless $scope_ref eq 'ARRAY';
        $param_ref->{scope} = join q{,}, @{ $param_ref->{scope} };
    }

    # "The URL to redirect to after a button is clicked or tapped in the
    # dialog."
    $param_ref->{redirect_uri} = $self->redirect_uri;

    # "Your App ID. This is called client_id instead of app_id for this
    # particular method in order to be compliant with the OAuth 2.0
    # specification."
    $param_ref->{client_id} = $self->app_id;

    # "If you are using the URL redirect dialog implementation, then this will
    # be a full page display, shown within Facebook.com. This display type is
    # called page."
    $param_ref->{display} ||= 'page';

    # "Response data is included as URL parameters and contains code parameter
    # (an encrypted string unique to each login request). This is the default
    # behaviour if this parameter is not specified."
    $param_ref->{response_type} ||= 'code';

    my $uri = $self->site_uri('/dialog/oauth', $param_ref);

    # Platform Versioning > Making Versioned Requests > Dialogs.
    # https://developers.facebook.com/docs/apps/versions#dialogs
    $uri->path( $self->gen_versioned_path($uri->path) );

    return $uri->as_string;
}

sub set_access_token {
    my ($self, $token) = @_;
    $self->{access_token} = $token;
}

# Access Tokens > App Tokens
# https://developers.facebook.com/docs/facebook-login/access-tokens/#apptokens
sub get_app_token {
    my $self = shift;

    # Document does not mention what grant_type is all about or what values can
    # be set, but RFC 6749 covers the basic idea of grant types and its Section
    # 4.4 describes Client Credentials Grant.
    # http://tools.ietf.org/html/rfc6749#section-4.4
    return $self->_get_token(+{grant_type => 'client_credentials'});
}

# Manually Build a Login Flow > Confirming identity > Exchanging code for an access token
# https://developers.facebook.com/docs/facebook-login/manually-build-a-login-flow
sub get_user_token_by_code {
    my ($self, $code) = @_;

    croak 'code is not given'        unless $code;
    croak 'redirect_uri must be set' unless $self->redirect_uri;

    my $query_ref = +{
        redirect_uri => $self->redirect_uri,
        code         => $code,
    };
    return $self->_get_token($query_ref);
}

sub get_user_token_by_cookie {
    my ($self, $cookie_value) = @_;

    croak 'cookie value is not given' unless $cookie_value;

    my $parsed_signed_request = $self->parse_signed_request($cookie_value);

    # https://github.com/oklahomer/p5-Facebook-OpenGraph/issues/1#issuecomment-41065480
    # parsed content should be something like below.
    # {
    #     algorithm => "HMAC-SHA256",
    #     issued_at => 1398180151,
    #     code      => "SOME_OPAQUE_STRING",
    #     user_id   => 44007581,
    # };
    croak q{"code" is not contained in cookie value: } . $cookie_value
        unless $parsed_signed_request->{code};

    # Redirect_uri MUST be empty string in this case.
    # That's why I didn't use get_user_token_by_code().
    my $query_ref = +{
        code         => $parsed_signed_request->{code},
        redirect_uri => '',
    };
    return $self->_get_token($query_ref);
}

# Access Tokens > Expiration and Extending Tokens
# https://developers.facebook.com/docs/facebook-login/access-tokens/
sub exchange_token {
    my ($self, $short_term_token) = @_;

    croak 'short term token is not given' unless $short_term_token;

    my $query_ref = +{
        grant_type        => 'fb_exchange_token',
        fb_exchange_token => $short_term_token,
    };
    return $self->_get_token($query_ref);
}

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

    croak 'app_id and secret must be set' unless $self->app_id && $self->secret;

    $param_ref = +{
        %$param_ref,
        client_id     => $self->app_id,
        client_secret => $self->secret,
    };

    my $response = $self->request('GET', '/oauth/access_token', $param_ref);
    # Document describes as follows:
    # "The response you will receive from this endpoint, if successful, is
    # access_token={access-token}&expires={seconds-til-expiration}
    # If it is not successful, you'll receive an explanatory error message."
    #
    # It, however, returnes no "expires" parameter on some edge cases.
    # e.g. Your app requests manage_pages permission.
    # https://developers.facebook.com/bugs/597779113651383/
    if ($response->is_api_version_eq_or_later_than('v2.3')) {
        # As of v2.3, to be compliant with RFC 6749, response is JSON formatted
        # as described below.
        # {"access_token": , "token_type":, "expires_in":}
        # https://developers.facebook.com/docs/facebook-login/manually-build-a-login-flow/v2.3#confirm
        return $response->as_hashref;
    }

    my $res_content = $response->content;
    my $token_ref = +{ URI->new("?$res_content")->query_form };
    croak "can't get access_token properly: $res_content"
        unless $token_ref->{access_token};

    return $token_ref;
}

sub get {
    return shift->request('GET', @_)->as_hashref;
}

sub post {
    return shift->request('POST', @_)->as_hashref;
}

# Deleting > Objects
# https://developers.facebook.com/docs/reference/api/deleting/
sub delete {
    return shift->request('DELETE', @_)->as_hashref;
}

# For those who got used to Facebook::Graph
*fetch   = \&get;
*publish = \&post;

# Using ETags
# https://developers.facebook.com/docs/reference/ads-api/etags-reference/
sub fetch_with_etag {
    my ($self, $uri, $param_ref, $etag) = @_;

    # Attach ETag value to header
    # Returns status 304 without contnet, or status 200 with modified content
    my $header   = ['IF-None-Match' => $etag];
    my $response = $self->request('GET', $uri, $param_ref, $header);

    return $response->is_modified ? $response->as_hashref : undef;
}

sub bulk_fetch {
    my ($self, $paths_ref) = @_;

    my @queries = map {
        +{
            method       => 'GET',
            relative_url => $_,
        }
    } @$paths_ref;

    return $self->batch(\@queries);
}

# Making Multiple API Requests > Making a simple batched request
# https://developers.facebook.com/docs/graph-api/making-multiple-requests
sub batch {
    my $self  = shift;

    my $responses_ref = $self->batch_fast(@_);

    # Devide response content and create response objects that correspond to
    # each request
    my @data = ();
    for my $r (@$responses_ref) {
        for my $res_ref (@$r) {
            my $response = $self->create_response(
                $res_ref->{code},
                $res_ref->{message},
                [ map { $_->{name} => $_->{value} } @{ $res_ref->{headers} } ],
                $res_ref->{body},
            );
            croak $response->error_string unless $response->is_success;

            push @data, $response->as_hashref;
        }
    }

    return \@data;
}

# doesn't create F::OG::Response object for each response
sub batch_fast {
    my $self  = shift;
    my $batch = shift;

    # Other than HTTP header, you need to set access_token as top level
    # parameter. You can specify individual token for each request so you can
    # act as several other users and pages.
    croak 'Top level access_token must be set' unless $self->access_token;

    # "We currently limit the number of requests which can be in a batch to 50"
    my @responses = ();
    while(my @queries = splice @$batch, 0, $self->batch_limit) {

        for my $q (@queries) {
            if ($q->{method} eq 'POST' && $q->{body}) {
                my $body_ref = $self->prep_param($q->{body});
                my $uri = URI->new;
                $uri->query_form(%$body_ref);
                $q->{body} = $uri->query;
            }
        }

        my @req = (
            '/',
            +{
                access_token => $self->access_token,
                batch        => $self->json->encode(\@queries),
            },
            @_,
        );

        push @responses, $self->post(@req);
    }

    return \@responses;
}

# Facebook Query Language (FQL) Overview
# https://developers.facebook.com/docs/technical-guides/fql/
sub fql {
    my $self  = shift;
    my $query = shift;
    return $self->get('/fql', +{q => $query}, @_);
}

# Facebook Query Language (FQL) Overview: Multi-query
# https://developers.facebook.com/docs/technical-guides/fql/#multi
sub bulk_fql {
    my $self  = shift;
    my $batch = shift;
    return $self->fql($self->json->encode($batch), @_);
}

sub request {
    my ($self, $method, $uri, $param_ref, $headers) = @_;

    $method = uc $method;
    $uri    = $self->uri($uri) unless blessed($uri) && $uri->isa('URI');
    $uri->path( $self->gen_versioned_path($uri->path) );
    $param_ref = $self->prep_param(+{
        $uri->query_form(+{}),
        %{$param_ref || +{}},
    });

    # Securing Graph API Requests > Verifying Graph API Calls with appsecret_proof
    # https://developers.facebook.com/docs/graph-api/securing-requests/
    if ($self->use_appsecret_proof) {
        $param_ref->{appsecret_proof} = $self->gen_appsecret_proof;
    }

    # Use POST as default HTTP method and add method=(POST|GET|DELETE) to query
    # parameter. Document only says we can send HTTP DELETE method or, instead,
    # HTTP POST method with ?method=delete to delete object. It does not say
    # POST with method=(get|post) parameter works, but PHP SDK always sends POST
    # with method parameter so... I just give you this option.
    # Check PHP SDK's base_facebook.php for detail.
    if ($self->{use_post_method}) {
        $param_ref->{method} = $method;
        $method              = 'POST';
    }

    $headers ||= [];

    # Document says we can pass access_token as a part of query parameter,
    # but it actually supports Authorization header to be compliant with the
    # OAuth 2.0 spec.
    # http://tools.ietf.org/html/rfc6749#section-7
    if ($self->access_token) {
        push @$headers, (
                            'Authorization',
                            sprintf('OAuth %s', $self->access_token),
                        );
    }

    my $content = q{};
    if ($method eq 'POST') {
        if ($param_ref->{source} || $param_ref->{file} || $param_ref->{upload_phase} ) {
            # post image or video file

            # https://developers.facebook.com/docs/reference/api/video/
            # When posting a video, use graph-video.facebook.com .
            # base_facebook.php has an equivalent part in isVideoPost().
            # ($method == 'POST' && preg_match("/^(\/)(.+)(\/)(videos)$/", $path))
            # For other actions, use graph.facebook.com/VIDEO_ID/CONNECTION_TYPE
            if ($uri->path =~ m{\A /.+/videos \z}xms) {
                $uri->host($self->video_uri->host);
            }

            # Content-Type should be multipart/form-data
            # https://developers.facebook.com/docs/reference/api/publishing/
            push @$headers, (Content_Type => 'form-data');

            # Furl::HTTP document says we can use multipart/form-data with
            # HTTP::Request::Common.
            my $req = POST $uri, @$headers, Content => [%$param_ref];
            $content = $req->content;
            my $req_header = $req->headers;
            $headers = +[
                map {
                    my $k = $_;
                    map { ( $k => $_ ) } $req_header->header($k);
                } $req_header->header_field_names
            ];
        }
        else {
            # Post simple parameters such as message, link, description, etc...
            # Content-Type: application/x-www-form-urlencoded will be set in
            # Furl::HTTP, and $content will be treated properly.
            $content = $param_ref;
        }
    }
    else {
        $uri->query_form($param_ref);
    }

    my ($res_minor_version, @res_elms) = $self->ua->request(
        method  => $method,
        url     => $uri,
        headers => $headers,
        content => $content,
    );

    my $res = $self->create_response(@res_elms);

    # return F::OG::Response object on success
    return $res if $res->is_success;

    # Use later version of Furl::HTTP to utilize req_headers and req_content.
    # This Should be helpful when debugging.
    my $msg = $res->error_string;
    if ($res->req_headers) {
        $msg .= "\n" . $res->req_headers . $res->req_content;
    }
    croak $msg;
}

# Securing Graph API Requests > Verifying Graph API Calls with appsecret_proof > Generating the proof
# https://developers.facebook.com/docs/graph-api/securing-requests/
sub gen_appsecret_proof {
    my $self = shift;
    croak 'app secret must be set'   unless $self->secret;
    croak 'access_token must be set' unless $self->access_token;
    return hmac_sha256_hex($self->access_token, $self->secret);
}

# Platform Versioning > Making Versioned Requests
# https://developers.facebook.com/docs/apps/versions
sub gen_versioned_path {
    my ($self, $path) = @_;

    $path = '/' unless $path;

    if ($self->version && $path !~ m{\A /v(?:\d+)\.(?:\d+)/ }x) {
        # If default platform version is set on initialisation
        # and given path doesn't contain version,
        # then prepend the default version.
        $path = sprintf('/%s%s', $self->version, $path);
    }

    return $path;
}

sub js_cookie_name {
    my $self = shift;
    croak 'app_id must be set' unless $self->app_id;

    # Cookie is set by JS SDK with a name of fbsr_{app_id}. Official document
    # is not provided for more than 3 yaers so I quote from PHP SDK's code.
    # "Constructs and returns the name of the cookie that potentially houses
    # the signed request for the app user. The cookie is not set by the
    # BaseFacebook class, but it may be set by the JavaScript SDK."
    # The cookie value can be parsed as signed request and it contains 'code'
    # to exchange for access toekn.
    return sprintf('fbsr_%d', $self->app_id);
}

sub create_response {
    my $self = shift;
    return Facebook::OpenGraph::Response->new(+{
        json => $self->json,
        map {
            $_ => shift
        } qw/code message headers content req_headers req_content/,
    });
}

sub prep_param {
    my ($self, $param_ref) = @_;

    $param_ref = Data::Recursive::Encode->encode_utf8($param_ref || +{});

    # /?ids=4,http://facebook-docs.oklahome.net
    if (my $ids = $param_ref->{ids}) {
        $param_ref->{ids} = ref $ids ? join q{,}, @$ids : $ids;
    }

    # mostly for /APP_ID/accounts/test-users
    if (my $perms = $param_ref->{permissions}) {
        $param_ref->{permissions} = ref $perms ? join q{,}, @$perms : $perms;
    }

    # Source, file and video_file_chunk parameter contains file path.
    # It must be an array ref to work with HTTP::Request::Common.
    if (my $path = $param_ref->{source}) {
        $param_ref->{source} = ref $path ? $path : [$path];
    }
    if (my $path = $param_ref->{file}) {
        $param_ref->{file} = ref $path ? $path : [$path];
    }
    if (my $path = $param_ref->{video_file_chunk}) {
        $param_ref->{video_file_chunk} = ref $path ? $path : [$path];
    }

    # use Field Expansion
    if (my $field_ref = $param_ref->{fields}) {
        $param_ref->{fields} = $self->prep_fields_recursive($field_ref);
    }

    # Using Objects: Using the Object API
    # https://developers.facebook.com/docs/opengraph/using-objects/#objectapi
    my $object = $param_ref->{object};
    if ($object && ref $object eq 'HASH') {
        $param_ref->{object} = $self->json->encode($object);
    }

    return $param_ref;
}

# Using the Graph API: Reading > Choosing Fields > Making Nested Requests
# https://developers.facebook.com/docs/graph-api/using-graph-api/
sub prep_fields_recursive {
    my ($self, $val) = @_;

    my $ref = ref $val;
    if (!$ref) {
        return $val;
    }
    elsif ($ref eq 'ARRAY') {
        return join q{,}, map { $self->prep_fields_recursive($_) } @$val;
    }
    elsif ($ref eq 'HASH') {
        my @strs = ();
        while (my ($k, $v) = each %$val) {
            my $r = ref $v;
            my $pattern = $r && $r eq 'HASH' ? '%s.%s' : '%s(%s)';
            push @strs, sprintf($pattern, $k, $self->prep_fields_recursive($v));
        }
        return join q{.}, @strs;
    }
}

# Using Actions > Publishing Actions
# https://developers.facebook.com/docs/opengraph/using-actions/#publish
sub publish_action {
    my $self   = shift;
    my $action = shift;
    croak 'namespace is not set' unless $self->namespace;
    return $self->post(sprintf('/me/%s:%s', $self->namespace, $action), @_);
}

# Using Objects > Using the Object API > Images with the Object API
# https://developers.facebook.com/docs/opengraph/using-objects/
sub publish_staging_resource {
    my $self = shift;
    my $file = shift;
    return $self->post('/me/staging_resources', +{file => $file}, @_);
}

# Test Users: Creating
# https://developers.facebook.com/docs/test_users/
sub create_test_users {
    my $self         = shift;
    my $settings_ref = shift;

    if (ref $settings_ref ne 'ARRAY') {
        $settings_ref = [$settings_ref];
    }

    my @settings = ();
    my $relative_url = sprintf('/%s/accounts/test-users', $self->app_id);
    for my $setting (@$settings_ref) {
        push @settings, +{
                            method       => 'POST',
                            relative_url => $relative_url,
                            body         => $setting,
                        };
    }

    return $self->batch(\@settings);
}

# Using Objects > Using Self-Hosted Objects > Updating Objects
# https://developers.facebook.com/docs/opengraph/using-objects/
sub check_object {
    my ($self, $target) = @_;
    my $param_ref = +{
        id     => $target, # $target is object url or open graph object id
        scrape => 'true',
    };
    return $self->post(q{}, $param_ref);
}

1;
__END__