Commit eac15246 authored by Mike Jones's avatar Mike Jones 🌶

Backfill test suite

parent b58302ea
---
kind: pipeline
name: default
platform:
os: linux
arch: amd64
workspace:
base: /opt
path: WebService-Mattermost
steps:
- name: build
pull: default
image: poum/distzilla
commands:
- "dzil authordeps | xargs -n 5 -P 10 cpanm --verbose --notest --quiet"
- "dzil listdeps --author | xargs -n 5 -P 10 cpanm --verbose --no-interactive --notest --quiet"
- dzil smoke
...
image: poum/distzilla
stages:
- test
before_script:
- dzil authordeps --missing | xargs -n 5 -P 10 cpanm --no-interactive --notest --quiet
- dzil listdeps --missing --author | xargs -n 5 -P 10 cpanm --no-interactive --notest --quiet
test:
stage: test
script:
- dzil cover
only:
refs:
- master
- merge_requests
changes:
- '**/*.pm'
- '**/*.t'
\ No newline at end of file
......@@ -121,6 +121,12 @@ The available events are the same:
* `gw_ws_finished`
* `gw_ws_started`
## Running the test suite
```
% prove -lv t/**/*.t
```
## License
MIT. See LICENSE.txt.
\ No newline at end of file
......@@ -4,7 +4,7 @@ license = MIT
copyright_holder = Mike Jones
copyright_year = 2019
version = 0.100
version = 0.110
[TestRelease]
[ConfirmRelease]
......@@ -24,7 +24,10 @@ Role::EventEmitter = 0
Types::Standard = 0
[Prereqs / TestRequires]
Dist::Zilla::App::Command::cover = 0
Test::Compile = 0
Test::Exception = 0
Test::Most = 0
Test::Pod = 0
Test::Compile = 0
Test::Spec = 0.54
......@@ -5,9 +5,7 @@ use Types::Standard qw(Bool Int Object Str);
use WebService::Mattermost::V4::API;
our $VERSION = 0.100;
with 'WebService::Mattermost::Role::Logger';
our $VERSION = 0.110;
################################################################################
......@@ -17,7 +15,7 @@ has api_version => (is => 'ro', isa => Int, default => 4);
has [ qw(authenticate debug) ] => (is => 'rw', isa => Bool, default => 0);
has [ qw(auth_token user_id) ] => (is => 'rw', isa => Str, default => '');
has api => (is => 'ro', isa => Object, lazy => 1, builder => 1);
has api => (is => 'ro', isa => Object, lazy => 1, builder => 1, clearer => 1);
################################################################################
......@@ -45,11 +43,12 @@ sub _try_authentication {
$self->auth_token($ret->headers->header('Token'));
$self->user_id($ret->content->{id});
$self->_set_resource_auth_token();
$self->clear_api; # Force the API to be rebuilt with the new token
} else {
$self->logger->fatal($ret->message);
die $ret->message;
}
} elsif ($self->authenticate && !($self->username && $self->password)) {
$self->logger->logdie('"username" and "password" are required attributes for authentication');
die '"username" and "password" are required attributes for authentication';
} elsif ($self->auth_token) {
$self->_set_resource_auth_token();
}
......
......@@ -94,4 +94,3 @@ Format text as tables for Mattermost.
=head1 AUTHOR
Mike Jones L<email:mike@netsplit.org.uk>
......@@ -18,6 +18,7 @@ use WebService::Mattermost::V4::API::Request;
use WebService::Mattermost::V4::API::Response;
with qw(
WebService::Mattermost::Role::Logger
WebService::Mattermost::Role::Returns
WebService::Mattermost::Role::UserAgent
WebService::Mattermost::V4::API::Role::RequireID
......@@ -173,6 +174,10 @@ sub _as_response {
$view_name = $args->{view};
}
if ($res->is_error && $self->debug) {
$self->logger->warnf('An API error occurred: %s', $res->message);
}
return WebService::Mattermost::V4::API::Response->new({
auth_token => $self->auth_token,
base_url => $self->base_url,
......
......@@ -46,7 +46,6 @@ sub BUILD {
my $self = shift;
$self->authenticate(1);
$self->_try_authentication();
# Set up expected subroutines for a child class to catch. The events can
# also be caught raw in a script.
......
#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use Test::Most tests => 3;
use lib "$FindBin::RealBin/../lib";
use WebService::Mattermost::Helper::Alias qw(v4 view util);
is util('Hello'), 'WebService::Mattermost::Util::Hello', 'Util alias helper success';
is v4('Hello'), 'WebService::Mattermost::V4::API::Resource::Hello', 'v4 alias helper success';
is view('Hello'), 'WebService::Mattermost::V4::API::Object::Hello', 'View alias helper success';
__END__
=head1 NAME
t/010-alias_helper.t
=head1 DESCRIPTION
Check aliases exported by WebService::Mattermost::Helper::Alias build correctly.
=head1 AUTHOR
Mike Jones L<email:mike@netsplit.org.uk>
#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use Test::Most tests => 5;
use Test::Exception;
use lib "$FindBin::RealBin/../lib";
use WebService::Mattermost::Helper::Table;
ok my $helper = WebService::Mattermost::Helper::Table->new({
alignment => [ qw(l c r) ],
headers => [ qw(first second third) ],
values => [
[ qw(r1-col1 r1-col2 r1-col3) ],
[ qw(r2-col1 r2-col2 r2-col3) ],
],
}), 'Constructing a table...';
my $expected_table = <<'TBL';
| first| second| third|
|:----|:---:|----:|
|r1-col1|r1-col2|r1-col3|
|r2-col1|r2-col2|r2-col3|
TBL
is $helper->table, $expected_table, 'Table set up correctly';
ok $helper = WebService::Mattermost::Helper::Table->new({
headers => [ qw(first second third) ],
values => [
[ qw(r1-col1 r1-col2 r1-col3) ],
[ qw(r2-col1 r2-col2 r2-col3) ],
],
}), 'Constructing another table...';
$expected_table = <<'TBL';
| first| second| third|
|:----|:----|:----|
|r1-col1|r1-col2|r1-col3|
|r2-col1|r2-col2|r2-col3|
TBL
is $helper->table, $expected_table, 'Table set up correctly';
dies_ok {
$helper = WebService::Mattermost::Helper::Table->new({
alignment => [ qw(bad col alignment) ],
headers => [ qw(first second third) ],
values => [
[ qw(r1-col1 r1-col2 r1-col3) ],
[ qw(r2-col1 r2-col2 r2-col3) ],
],
})
} 'Passed bad names to alignment enum';
__END__
=head1 NAME
t/011-table_helper.t
=head1 DESCRIPTION
Unit test for the table helper.
=head1 AUTHOR
Mike Jones L<email:mike@netsplit.org.uk>
#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use Test::Most;
use lib "$FindBin::RealBin/../lib";
use WebService::Mattermost;
my $api = WebService::Mattermost->new({
base_url => '...',
username => '...',
password => '...',
})->api;
foreach my $name ($api->meta->get_attribute_list) {
my $attr = $api->meta->get_attribute($name);
if ($attr->has_builder) {
can_ok $api, $name;
my $cref = $api->can($name);
next unless $cref;
ok $api->$cref, "Built ${name}";
}
}
done_testing();
#!/usr/bin/env perl
use FindBin;
use Mojo::URL;
use Test::Spec;
use WebService::Mattermost;
use lib "$FindBin::RealBin/..";
require 'test_helper.pl';
describe 'API queries' => sub {
share my %vars;
before each => sub {
user_resource_expects_login(response());
delete $vars{app};
};
describe 'an unsuccessful API query' => sub {
before each => sub {
Mojo::UserAgent
->expects('post')
->with_deep(
Mojo::URL->new('https://my-mattermost-server.com/api/v4/posts') => {
'Authorization' => 'Bearer whatever',
'Keep-Alive' => 1,
},
json => {
message => 'Hello, world',
channel_id => 'my-channel-1',
},
)
->returns(
Mojo::Transaction::HTTP->new(
res => Mojo::Message::Response->new(
message => 'foo',
code => 500,
),
)
);
};
describe 'with debugging enabled' => sub {
before all => sub {
$vars{app} = WebService::Mattermost->new(client_arguments({ debug => 1 }));
};
it 'should log a warning' => sub {
$vars{app}->api->posts->logger
->expects('warn')
->with('An API error occurred: foo')
->once;
ok $vars{app}->api->posts->create({
message => 'Hello, world',
channel_id => 'my-channel-1',
});
};
};
describe 'with debugging disabled' => sub {
before all => sub {
$vars{app} = WebService::Mattermost->new(client_arguments({ debug => 0 }));
};
it 'should not log a warning' => sub {
$vars{app}->api->posts->logger
->expects('warn')
->with('An API error occurred: foo')
->never;
ok $vars{app}->api->posts->create({
message => 'Hello, world',
channel_id => 'my-channel-1',
});
};
};
};
};
runtests unless caller;
#!/usr/bin/env perl
use strict;
use warnings;
use Test::Most;
use WebService::Mattermost::V4::API::Resource::Users;
use WebService::Mattermost::V4::API::Response;
sub base_url { 'https://my-mattermost-server.com/api/v4/' }
sub client_arguments {
my $extra = shift || {};
return {
authenticate => 1,
base_url => base_url(),
password => 'mypassword',
username => 'myusername',
%{$extra},
};
}
sub response {
my $args = shift || {};
my $headers = Mojo::Headers->new();
$headers->add(token => 'whatever');
return WebService::Mattermost::V4::API::Response->new({
content => { id => 'asd1234' },
base_url => 'wherever',
auth_token => 'whatever',
code => 200,
headers => $headers,
prev => Mojo::Message::Response->new(),
%{$args},
});
}
sub user_resource_expects_login {
my $responds_with = shift;
my $args = client_arguments();
WebService::Mattermost::V4::API::Resource::Users
->stubs('login')
->with($args->{username}, $args->{password})
->once
->returns($responds_with);
}
1;
#!/usr/bin/env perl
use FindBin;
use Mojo::Headers;
use Test::Exception;
use Test::Spec;
use WebService::Mattermost;
use WebService::Mattermost::V4::API::Resource::Users;
use WebService::Mattermost::V4::API::Response;
use lib "$FindBin::RealBin/../../";
require 'test_helper.pl';
describe 'WebService::Mattermost' => sub {
share my %vars;
before each => sub {
$vars{base_url} = base_url();
$vars{init_args} = client_arguments();
delete $vars{app};
};
describe 'with an auth_token' => sub {
before each => sub {
$vars{app} = WebService::Mattermost->new({
%{$vars{init_args}},
auth_token => 'helloworld',
});
};
it 'should not attempt to log into Mattermost' => sub {
WebService::Mattermost::V4::API::Resource::Users->expects('login')->never;
is 'helloworld', $vars{app}->auth_token;
};
it 'should set the token on the API resource classes' => sub {
test_auth_token_was_set_on_resources($vars{app}, 'helloworld');
};
it 'should set up an API client with the token' => sub {
test_api_client($vars{app}, 'helloworld');
};
};
describe 'with missing password' => sub {
it 'should die' => sub {
test_throws_credential_error({
authenticate => 1,
base_url => $vars{base_url},
password => '',
username => 'foo',
});
};
};
describe 'with missing username' => sub {
it 'should die' => sub {
test_throws_credential_error({
authenticate => 1,
base_url => $vars{base_url},
password => 'foo',
username => '',
});
};
};
describe 'without an auth_token' => sub {
describe 'login success' => sub {
before each => sub {
user_resource_expects_login(response());
$vars{app} = WebService::Mattermost->new($vars{init_args});
};
it 'should set the auth token' => sub {
is 'whatever', $vars{app}->auth_token;
};
it 'should set the token on the API resource classes' => sub {
test_auth_token_was_set_on_resources($vars{app}, 'whatever');
};
it 'should set up an API client with the token' => sub {
test_api_client($vars{app}, 'whatever');
};
};
describe 'login failure' => sub {
it 'should die' => sub {
user_resource_expects_login(response({
is_success => 0,
message => 'Unauthorized',
}));
dies_ok { WebService::Mattermost->new($vars{init_args}) } 'Died';
like $@, qr{^Unauthorized at};
};
};
};
};
runtests unless caller;
sub test_throws_credential_error {
my $args = shift;
dies_ok { WebService::Mattermost->new($args) } 'Died';
like $@, qr{^"username" and "password" are required attributes for authentication};
return 1;
}
sub test_auth_token_was_set_on_resources {
my $object = shift;
my $token = shift;
my $was_set = 1;
foreach my $resource (@{$object->api->resources}) {
$was_set = 0 unless $resource->auth_token eq $token;
}
ok $was_set;
return 1;
}
sub test_api_client {
my $object = shift;
my $token = shift;
ok $object->api->isa('WebService::Mattermost::V4::API');
is $token, $object->api->auth_token;
my $did_build = 1;
foreach my $name ($object->api->meta->get_attribute_list) {
my $attr = $object->api->meta->get_attribute($name);
if ($attr->has_builder) {
$did_build = 0 unless $object->api->can($name);
}
}
ok $did_build, 'Built API resource classes';
return 1;
}
#!/usr/bin/env perl -T
use Test::Spec;
use WebService::Mattermost::Helper::Alias qw(v4 view util);
describe 'WebService::Mattermost::Helper::Alias' => sub {
describe 'util' => sub {
it 'should add the util namespace' => sub {
is 'WebService::Mattermost::Util::Hello', util('Hello');
};
};
describe 'v4' => sub {
it 'should add the API v4 namespace' => sub {
is 'WebService::Mattermost::V4::API::Resource::Hello', v4('Hello');
};
};
describe 'view' => sub {
it 'should add the API v4 view namespace' => sub {
is 'WebService::Mattermost::V4::API::Object::Hello', view('Hello');
};
};
};
runtests unless caller;
#!/usr/bin/env perl -T
use Test::Exception;
use Test::Spec;
use WebService::Mattermost::Helper::Table;
describe 'WebService::Mattermost::Helper::Table' => sub {
share my %vars;
before each => sub { delete $vars{app} };
describe 'with no alignment settings' => sub {
before each => sub {
$vars{app} = WebService::Mattermost::Helper::Table->new({
headers => [ qw(first second third) ],
values => [
[ qw(r1-col1 r1-col2 r1-col3) ],
[ qw(r2-col1 r2-col2 r2-col3) ],
[ qw(r3-col1 r3-col2 r3-col3) ],
[ qw(r4-col1 r4-col2 r4-col3) ],
]
});
};
it 'should convert the table to markdown with left aligned columns' => sub {
my $expected = <<'TBL';
| first| second| third|
|:----|:----|:----|
|r1-col1|r1-col2|r1-col3|
|r2-col1|r2-col2|r2-col3|
|r3-col1|r3-col2|r3-col3|
|r4-col1|r4-col2|r4-col3|
TBL
is $expected, $vars{app}->table;
};
};
describe 'with alignment settings' => sub {
before each => sub {
$vars{app} = WebService::Mattermost::Helper::Table->new({
alignment => [ qw(l c r) ],
headers => [ qw(first second third) ],
values => [
[ qw(r1-col1 r1-col2 r1-col3) ],
[ qw(r2-col1 r2-col2 r2-col3) ],
[ qw(r3-col1 r3-col2 r3-col3) ],
[ qw(r4-col1 r4-col2 r4-col3) ],
]
});
};
it 'should convert the table to markdown with specified alignment' => sub {
my $expected = <<'TBL';
| first| second| third|
|:----|:---:|----:|
|r1-col1|r1-col2|r1-col3|
|r2-col1|r2-col2|r2-col3|
|r3-col1|r3-col2|r3-col3|
|r4-col1|r4-col2|r4-col3|
TBL
is $expected, $vars{app}->table;
};
};
describe 'with bad alignment settings' => sub {
it 'should die' => sub {
dies_ok {
WebService::Mattermost::Helper::Table->new({
alignment => [ qw(bad column alignment) ],
headers => [ qw(first second third) ],
values => [
[ qw(r1-col1 r1-col2 r1-col3) ],