perl-Gogs/lib/Gogs.pm

package Gogs;

# ABSTRACT: Subclass of Pithub
use strict;
use warnings;

use Moo;
use Mime::Base64;

extends 'Pithub';

=head1 DESCRIPTION

L<Pithub> is an acceptable API client for Gogs, since their APIs are compatible.

However the two have a number of differences, so they must be accounted for.

The most important of which being that all requests require an API token.

=head1 SUBROUTINES

=head2 get_token(%options)

Gogs has no user-facing means of creating tokens like github does.
You have to POST against the API using HTTP simple auth to acquire them.

Requires that the object is instantiated with a username,
that you pass a password, and that the api_uri is secure unless you pass the 'insecure' option.

Will either fetch (if it exists) or create the named token.

=cut

# All API access requires a token on Gogs EXCEPT users/$user/tokens.
# As such, I'm restricting every call not ending in /tokens
my @TOKEN_REQUIRED_REGEXP = (qr{(?!/tokens$)});

sub get_token {
    my ($self, %options) = @_;

    die "Must instantiate with username" unless $self->user;
    die "Must pass token name" unless $options{name};
    die "Refuse to operate over insecure connections" if !$options{insecure} && _insecure($uri);
    die "Must provide password to fetch tokens" unless $options{password};

    my %auth_headers = (
        'Authorization' => "Basic ".encode_base64("$self->user:$options{password}"),
        'Content-type'  => "application/json",
    );

    my $token_endpoint = "/api/v1/users/$self->user/tokens";
    my %req = (
         method  => 'GET',
        path    => $tokens_endpoint,
        headers => \%auth_headers,
    );
    my $result = $self->request(%req);
    my $content = $result->content();
    die "Got bad response from server" unless ref $content eq "ARRAY";

    my $token_actual;
    foreach my $token (@$content) {
        next unless $token->{name} eq $options{name};
        return $token->{sha1};
    }

    # No such token named, so let's just make one.
    $req{method} = 'POST';
    my $result = $self->request(%req);
    my $content = $result->content();
    die "Got bad response from server" unless ref $content eq "HASH";
    return $content->{sha1};
}

sub _insecure {
    my $uri = shift;
    return m/^http:\/\//;
}

1;