File Coverage

blib/lib/WebService/Mattermost/V4/Client.pm

Criterion	Covered	Total	%
statement	55	137	40.1
branch	4	30	13.3
condition	2	17	11.7
subroutine	16	27	59.2
pod	0	3	0.0
total	77	214	35.9

package WebService::Mattermost::V4::Client;
  2: 
  3: # ABSTRACT: Perl websocket client for Mattermost.  4: 
  5: use Encode 'encode';
  6: use Mojo::IOLoop;
  7: use Mojo::JSON qw(decode_json encode_json);
  8: use Moo;
  9: use MooX::HandlesVia;
 10: use Types::Standard qw(ArrayRef Bool InstanceOf Int Maybe Str);
 11: 
 12: extends 'WebService::Mattermost';
 13: with    qw(
 14:     WebService::Mattermost::Role::Logger
 15:     WebService::Mattermost::Role::UserAgent
 16:     Role::EventEmitter
 17: );
 18: 
 19: ################################################################################
 20: 
 21: has _events       => (is => 'ro', isa => ArrayRef,                      lazy => 1, builder => 1);
 22: has _ua           => (is => 'rw', isa => InstanceOf['Mojo::UserAgent'], lazy => 1, builder => 1);
 23: has ioloop        => (is => 'rw', isa => InstanceOf['Mojo::IOLoop'],    lazy => 1, builder => 1);
 24: has websocket_url => (is => 'ro', isa => Str,                           lazy => 1, builder => 1);
 25: 
 26: has ws => (is => 'rw', isa => Maybe[InstanceOf['Mojo::Base']]);
 27: 
 28: has debug                     => (is => 'ro', isa => Bool, default => 0);
 29: has ignore_self               => (is => 'ro', isa => Bool, default => 1);
 30: has ping_interval             => (is => 'ro', isa => Int,  default => 15);
 31: has reconnection_wait_time    => (is => 'ro', isa => Int,  default => 2);
 32: has reauthentication_interval => (is => 'ro', isa => Int,  default => 3600);
 33: 
 34: has last_seq => (is => 'rw', isa => Int,  default => 1,
 35:     handles_via => 'Number',
 36:     handles     => {
 37:         inc_last_seq => 'add',
 38:     });
 39: 
 40: has loops => (is => 'rw', isa => ArrayRef[InstanceOf['Mojo::IOLoop']], default => sub { [] },
 41:     handles_via => 'Array',
 42:     handles     => {
 43:         add_loop    => 'push',
 44:         clear_loops => 'clear',
 45:     });
 46: 
 47: ################################################################################
 48: 
 49: sub BUILD {
 50:     my $self = shift;
 51: 
 52:     $self->authenticate(1);
 53:     $self->next::method(@_);
 54: 
 55:     # Set up expected subroutines for a child class to catch. The events can
 56:     # also be caught raw in a script.
 57:     foreach my $emission (@{$self->_events}) {
 58:         # Values from events must be set up in child class
 59:         if ($self->can($emission)) {
 60:             $self->on($emission, sub { shift; $self->$emission(@_) });
 61:         }
 62:     }
 63: 
 64:     return 1;
 65: }
 66: 
 67: sub start {
 68:     my $self = shift;
 69: 
 70:     $self->_connect();
 71:     $self->ioloop->start unless $self->ioloop->is_running();
 72: 
 73:     return;
 74: }
 75: 
 76: sub message_has_content {
 77:     my $self = shift;
 78:     my $args = shift;
 79: 
 80:     return $args->{post_data} && $args->{post_data}->{message};
 81: }
 82: 
 83: ################################################################################
 84: 
 85: sub _connect {
 86:     my $self = shift;
 87: 
 88:     $self->_ua->on(start => sub { $self->_on_start(@_) });
 89: 
 90:     $self->_ua->websocket($self->websocket_url => sub {
 91:         my ($ua, $tx) = @_;
 92: 
 93:         $self->ws($tx);
 94: 
 95:         unless ($tx->is_websocket) {
 96:             $self->logger->fatal('WebSocket handshake failed');
 97:         }
 98: 
 99:         $self->emit(gw_ws_started => {});
100: 
101:         $self->logger->debug('Adding ping loop');
102: 
103:         $self->add_loop($self->ioloop->recurring(15 => sub { $self->_ping($tx) }));
104:         $self->add_loop($self->ioloop->recurring($self->reauthentication_interval => sub { $self->_reauthenticate() }));
105: 
106:         $tx->on(error   => sub { $self->_on_error(@_)   });
107:         $tx->on(finish  => sub { $self->_on_finish(@_)  });
108:         $tx->on(message => sub { $self->_on_message(@_) });
109:     });
110: 
111:     return 1;
112: }
113: 
114: sub _ping {
115:     my $self = shift;
116:     my $tx   = shift;
117: 
118:     if ($self->debug) {
119:         $self->logger->debugf('[Seq: %d] Sending ping', $self->last_seq);
120:     }
121: 
122:     return $tx->send(encode_json({
123:         seq    => $self->last_seq,
124:         action => 'ping',
125:     }));
126: }
127: 
128: sub _on_start {
129:     my $self = shift;
130:     my $ua   = shift;
131:     my $tx   = shift;
132: 
133:     if ($self->debug) {
134:         $self->logger->debugf('UserAgent connected to %s', $tx->req->url->to_string);
135:         $self->logger->debugf('Auth token: %s', $self->auth_token);
136:     }
137: 
138:     # The methods here are from the UserAgent role
139:     $tx->req->headers->header('Cookie'        => $self->mmauthtoken($self->auth_token));
140:     $tx->req->headers->header('Authorization' => $self->bearer($self->auth_token));
141:     $tx->req->headers->header('Keep-Alive'    => 1);
142: 
143:     return 1;
144: }
145: 
146: sub _on_finish {
147:     my $self   = shift;
148:     my $tx     = shift;
149:     my $code   = shift;
150:     my $reason = shift || 'Unknown';
151: 
152:     $self->logger->infof('WebSocket connection closed: [%d] %s', $code, $reason);
153:     $self->logger->infof('Reconnecting in %d seconds...', $self->reconnection_wait_time);
154: 
155:     $self->ws->finish;
156:     $self->emit(gw_ws_finished => { code => $code, reason => $reason });
157: 
158:     # Delay the reconnection a little
159:     Mojo::IOLoop->timer($self->reconnection_wait_time => sub {
160:         return $self->_reconnect();
161:     });
162: }
163: 
164: sub _on_message {
165:     my $self    = shift;
166:     my $tx      = shift;
167:     my $input   = shift;
168: 
169:     return unless $input;
170: 
171:     my $message = decode_json(encode('utf8', $input));
172: 
173:     if ($message->{seq}) {
174:         $self->logger->debugf('[Seq: %d]', $message->{seq}) if $self->debug;
175:         $self->last_seq($message->{seq});
176:     }
177: 
178:     return $self->_on_non_event($message) unless $message && $message->{event};
179: 
180:     my $message_args = { message => $message };
181: 
182:     if ($message->{data}->{post}) {
183:         my $post_data = decode_json(encode('utf8', $message->{data}->{post}));
184: 
185:         # Early return if the message is from the bot's own user ID (to halt
186:         # recursion)
187:         return if $self->ignore_self && $post_data->{user_id} eq $self->user_id;
188: 
189:         $message_args->{post_data} = $post_data;
190:     }
191: 
192:     $self->emit(gw_message => $message_args);
193: 
194:     if ($message->{event} eq 'hello') {
195:         if ($self->debug) {
196:             $self->logger->debug('Received "hello" event, sending authentication challenge');
197:         }
198: 
199:         $tx->send(encode_json({
200:             seq    => 1,
201:             action => 'authentication_challenge',
202:             data   => { token => $self->auth_token },
203:         }));
204:     }
205: 
206:     return 1;
207: }
208: 
209: sub _on_non_event {
210:     my $self    = shift;
211:     my $message = shift;
212: 
213:     if ($self->debug && $message->{data} && $message->{data}->{text}) {
214:         $self->logger->debugf('[Seq: %d] Received %s', $self->last_seq, $message->{data}->{text});
215:     }
216: 
217:     return $self->emit(gw_message_no_event => $message);
218: }
219: 
220: sub _on_error {
221:     my $self    = shift;
222:     my $ws      = shift;
223:     my $message = shift;
224: 
225:     $self->emit(gw_ws_error => { message => $message });
226: 
227:     return $ws->finish($message);
228: }
229: 
230: sub _reauthenticate {
231:     my $self = shift;
232: 
233:     # Mattermost authentication tokens expire after a given (and unknown) amount
234:     # of time. By default, the client will reconnect every hour in order to
235:     # refresh the token.
236:     $self->authenticate(1);
237:     $self->_try_authentication();
238: 
239:     return 1;
240: }
241: 
242: sub _reconnect {
243:     my $self = shift;
244: 
245:     # Reset things which have been altered during the course of the last
246:     # connection
247:     $self->last_seq(1);
248:     $self->_try_authentication();
249:     $self->_clean_up_loops();
250:     $self->ws(undef);
251:     $self->_ua($self->_build__ua);
252: 
253:     return $self->_connect();
254: }
255: 
256: sub _clean_up_loops {
257:     my $self = shift;
258: 
259:     foreach my $loop (@{$self->loops}) {
260:         $self->ioloop->remove($loop);
261:     }
262: 
263:     return $self->clear_loops();
264: }
265: 
266: ################################################################################
267: 
268: sub _build__events {
269:     return [ qw(
270:         gw_ws_error
271:         gw_ws_finished
272:         gw_ws_started
273:         gw_message
274:         gw_message_no_event
275:     ) ];
276: }
277: 
278: sub _build__ua { Mojo::UserAgent->new }
279: 
280: sub _build_ioloop { Mojo::IOLoop->singleton }
281: 
282: sub _build_websocket_url {
283:     my $self = shift;
284: 
285:     # Convert the API URL to the WebSocket URL
286:     my $ws_url = $self->base_url;
287: 
288:     if ($ws_url !~ /\/$/) {
289:         $ws_url .= '/';
290:     }
291: 
292:     $ws_url .= 'websocket';
293:     $ws_url =~ s/^http(?:s)?/wss/s;
294: 
295:     return $ws_url;
296: }
297: 
298: ################################################################################
299: 
300: 1;
301: 
302: __END__
303: 
304: =pod
305: 
306: =encoding UTF-8
307: 
308: =head1 NAME
309: 
310: WebService::Mattermost::V4::Client - Perl websocket client for Mattermost.
311: 
312: =head1 VERSION
313: 
314: version 0.28
315: 
316: =head1 DESCRIPTION
317: 
318: This class connects to Mattermost via the WebSocket gateway and can either be
319: extended in a child class, or used in a script.
320: 
321: =head2 USAGE
322: 
323: =head3 FROM A SCRIPT
324: 
325:     use WebService::Mattermost::V4::Client;
326: 
327:     my $bot = WebService::Mattermost::V4::Client->new({
328:         username => 'usernamehere',
329:         password => 'password',
330:         base_url => 'https://mattermost.server.com/api/v4/',
331: 
332:         # Optional arguments
333:         debug       => 1, # Show extra connection information
334:         ignore_self => 0, # May cause recursion!
335:     });
336: 
337:     $bot->on(message => sub {
338:         my ($bot, $args) = @_;
339: 
340:         # $args contains the decoded message content
341:     });
342: 
343:     $bot->start(); # Add me last
344: 
345: =head3 EXTENSION
346: 
347: See L<WebService::Mattermost::V4::Example::Bot>.
348: 
349: =head2 EVENTS
350: 
351: Events are either available to be caught with C<on> in scripts, or have methods
352: which can be overridden in child classes.
353: 
354: =over 4
355: 
356: =item C<gw_ws_started>
357: 
358: The bot connected to the Mattermost gateway. Can be overridden as
359: C<gw_ws_started()>.
360: 
361: =item C<gw_ws_finished>
362: 
363: The bot disconnected from the Mattermost gateway. Can be overridden as
364: C<gw_ws_finished()>.
365: 
366: =item C<gw_message>
367: 
368: The bot received a message. Can be overridden as C<gw_message()>.
369: 
370: =item C<gw_ws_error>
371: 
372: The bot received an error. Can be overridden as C<gw_error()>.
373: 
374: =item C<gw_message_no_event>
375: 
376: The bot received a message without an event (which is usually a "ping" item).
377: Can be overridden as C<gw_message_no_event()>.
378: 
379: =back
380: 
381: =head1 AUTHOR
382: 
383: Mike Jones <[e-mail]>
384: 
385: =head1 COPYRIGHT AND LICENSE
386: 
387: This software is Copyright (c) 2020 by Mike Jones.
388: 
389: This is free software, licensed under:
390: 
391:   The MIT (X11) License
392: 
393: =cut
394: