File Coverage

lib/App/wsgetmail/MS365/Client.pm

Criterion	Covered	Total	%
statement	52	77	67.5
branch	8	28	28.5
condition	1	3	33.3
subroutine	13	19	68.4
pod	6	7	85.7
total	80	134	59.7

# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 2020-2022 Best Practical Solutions, LLC
#
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}

use v5.10;

package App::wsgetmail::MS365::Client;

=head1 NAME

App::wsgetmail::MS365::Client - Low-level client to the Microsoft Graph API

=cut

use Moo;
use URI::Escape;
use URI;
use JSON;
use LWP::UserAgent;
use Azure::AD::ClientCredentials;

=head1 DESCRIPTION

This class performs the actual REST requests to support
L.

=head1 ATTRIBUTES

The following attributes are received from L and have
the same meaning:

=over 4

=item * secret

=cut

has secret  => (
    is => 'ro',
    required => 0,
);

=item * client_id

=cut

has client_id => (
    is => 'ro',
    required => 1,
);

=item * tenant_id

=cut

has tenant_id => (
    is => 'ro',
    required => 1,
);

=item * username

=cut

has username => (
    is => 'ro',
    required => 0
);

=item * user_password

=cut

has user_password => (
    is => 'ro',
    required => 0
);

=item * global_access

=item * debug

=cut

has global_access => (
    is => 'ro',
    default => sub { return 0 }
);

=back

=head2 resource_url

A string with the URL for the overall API endpoint.

=cut

has resource_url => (
    is => 'ro',
    default => sub { return 'https://graph.microsoft.com/' }
);

=head2 resource_path

A string with the REST API endpoint URL path.

=cut

has resource_path => (
    is => 'ro',
    default => sub { return 'v1.0' }
);

has debug => (
    is => 'rw',
    default => sub { return 0 }
);

has _ua => (
    builder   => '_build_authorised_ua',
    is => 'ro',
    lazy => 1,
);

has _credentials => (
    is => 'ro',
    lazy => 1,
    builder => '_build__credentials',
);

has _access_token => (
    is => 'ro',
    lazy => 1,
    builder => '_build__access_token',
);

sub BUILD {
    my ($self, $args) = @_;

    if ($args->{global_access}) {
        unless ($args->{secret}) {
            die "secret is required when using global_access";
        }
    }
    else {
        unless ($args->{username} && $args->{user_password}) {
            die "username and user_password are required when not using global_access";
        }
    }
}


=head1 METHODS

=head2 build_rest_uri(@endpoint_parts)

Given a list of URL component strings, returns a complete URL string to
reach that endpoint from this object's C and C.

=cut

sub build_rest_uri {
    my ($self, @endpoint_parts) = @_;
    my $base_url = $self->resource_url . $self->resource_path;
    return join('/', $base_url, @endpoint_parts);
}

=head2 get_request($parts, $params)

Makes a GET request to the API. C<$parts> is an arrayref of URL endpoint
strings with the specific endpoint to request. C<$params> is a hashref of
query parameters to send with the request.

=cut

sub get_request {
    my ($self, $parts, $params) = @_;
    # add error handling!
    my $uri = URI->new($self->build_rest_uri(@$parts));
    warn "making GET request to url $uri" if ($self->debug);
    $uri->query_form($params) if ($params);
    return $self->_ua->get($uri);
}

=head2 get_request_by_url($url)

Makes a GET request to the URL in the C<$url> string.

=cut

sub get_request_by_url {
    my ($self, $url) = @_;
    warn "making GET request to url $url" if ($self->debug);
    return $self->_ua->get($url);
}

=head2 delete_request($parts, $params)

Makes a DELETE request to the API. C<$parts> is an arrayref of URL endpoint
strings with the specific endpoint to request. C<$params> is unused.

=cut

sub delete_request {
    my ($self, $parts, $params) = @_;
    my $url = $self->build_rest_uri(@$parts);
    warn "making DELETE request to url $url" if ($self->debug);
    return $self->_ua->delete($url);
}

=head2 post_request($path_parts, $post_data)

Makes a POST request to the API. C<$path_parts> is an arrayref of URL
endpoint strings with the specific endpoint to request. C<$post_data> is a
reference to an array or hash of data to include in the POST request body.

=cut

sub post_request {
    my ($self, $path_parts, $post_data) = @_;
    my $url = $self->build_rest_uri(@$path_parts);
    warn "making POST request to url $url" if ($self->debug);
    return $self->_ua->post($url,$post_data);
}

=head2 patch_request($path_parts, $patch_params)

Makes a PATCH request to the API. C<$path_parts> is an arrayref of URL
endpoint strings with the specific endpoint to request. C<$patch_params> is
a hashref of data to include in the PATCH request body.

=cut

sub patch_request {
     my ($self, $path_parts, $patch_params) = @_;
     my $url = $self->build_rest_uri(@$path_parts);
     warn "making PATCH request to url $url" if ($self->debug);
     return $self->_ua->patch($url,%$patch_params);
 }

######

sub _build_authorised_ua {
    my $self = shift;
    my $ua = $self->_new_useragent;
    warn "getting system access token" if ($self->debug);
    $ua->default_header( Authorization => $self->_access_token() );
    return $ua;
}

sub _build__access_token {
    my $self = shift;
    my $access_token;
    if ($self->global_access) {
        $access_token = $self->_credentials->access_token;
    }
    else {
        $access_token = $self->_get_user_access_token;
    }
    return $access_token;
}

sub _get_user_access_token {
    my $self = shift;
    my $ua = $self->_new_useragent;
    my $access_token;
    warn "getting user access token" if ($self->debug);
    my $oauth_login_url = sprintf('https://login.windows.net/%s/oauth2/token', $self->tenant_id);
    my $response = $ua->post( $oauth_login_url,
                              {
                                  resource=> $self->resource_url,
                                  client_id => $self->client_id,
                                  grant_type=>'password',
                                  username=>$self->username,
                                  password=>$self->user_password,
                                  scope=>'openid'
                              }
                          );
    my $raw_message = $response->content;
    # check details
    if ($response->is_success) {
        my $token_details = decode_json( $response->content );
        $access_token = "Bearer " . $token_details->{access_token};
    }
    else {
        # throw error
        warn "auth response from server : $raw_message" if ($self->debug);
        die sprintf('unable to get user access token for user %s request failed with status %s ', $self->username, $response->status_line);
    }
    return $access_token;
}

sub _build__credentials {
    my $self = shift;
    my $creds = Azure::AD::ClientCredentials->new(
        resource_id => $self->resource_url,
        client_id => $self->client_id,
        secret_id => $self->secret,
        tenant_id => $self->tenant_id
    );
    return $creds;
}

sub _new_useragent {
    return LWP::UserAgent->new();
}

=head1 SEE ALSO

=over 4

=item * L

=back

=head1 AUTHOR

Best Practical Solutions, LLC

=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2020 by Best Practical Solutions, LLC

This is free software, licensed under:

  The GNU General Public License, Version 2, June 1991

=cut

1;