git.sesse.net Git - skvidarsync/blob - bin/ws.pl

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 no warnings qw(once);
   5 use JSON::XS;
   6 use LWP::UserAgent;
   7 use DBI;
   8 use POSIX;
   9 use AnyEvent::WebSocket::Client;
  10 use AnyEvent::Loop;
  11 binmode STDOUT, ':utf8';
  12 binmode STDERR, ':utf8';
  13 use utf8;
  14
  15 require '../include/config.pm';
  16
  17 my $ua = LWP::UserAgent->new('SKVidarLang/1.0');
  18 our $ws_disconnected;
  19
  20 sub db_connect {
  21         my $dbh = DBI->connect("dbi:Pg:dbname=$config::dbname;host=127.0.0.1", $config::dbuser, $config::dbpass, {RaiseError => 1})
  22                 or warn "Could not connect to Postgres: " . DBI->errstr;
  23         return $dbh;
  24 }
  25
  26 my $dbh;
  27 while (1) {
  28         if (!defined($dbh) || !$dbh->ping) {
  29                 $dbh = db_connect();
  30                 if (!defined($dbh)) {
  31                         sleep 1;
  32                         next;
  33                 }
  34         }
  35         $ws_disconnected = AnyEvent->condvar;
  36         my $response = $ua->post('https://slack.com/api/apps.connections.open',
  37                 Authorization => 'Bearer ' . $config::slack_app_token,
  38                 Content_type => 'application/x-www-form-urlencoded'
  39         );
  40         if (!$response->is_success) {
  41                 warn "apps.connections.open: " . $response->status_line;
  42                 sleep 1;
  43                 next;
  44         }
  45         my $msg_json = JSON::XS::decode_json($response->decoded_content);
  46         if (!defined($msg_json) || !$msg_json->{'ok'}) {
  47                 warn "Something went wrong: " . $response->decoded_content;
  48                 sleep 1;
  49                 next;
  50         }
  51
  52         my $ws_url = $msg_json->{'url'};
  53         my $ws = AnyEvent::WebSocket::Client->new;
  54         $ws->connect($ws_url)->cb(\&ws_cb);
  55         $ws_disconnected->recv;
  56         print STDERR "Disconnected; trying to reconnect.\n\n";
  57 };
  58
  59 sub ws_cb {
  60         our $connection = eval { shift->recv };
  61         if ($@) {
  62                 warn $@;
  63                 sleep 1;
  64                 $ws_disconnected->send;
  65                 return;
  66         }
  67
  68         print STDERR "Connected to the Slack WebSocket.\n";
  69
  70         $connection->on(each_message => sub {
  71                 my ($conn, $message) = @_;
  72                 my $now = [Time::HiRes::gettimeofday];
  73                 print STDERR "Message: $message->{'body'}\n";
  74                 my $json = JSON::XS::decode_json($message->{'body'});
  75                 eval {
  76                         if (exists($json->{'payload'}{'event'})) {
  77                                 if (exists($json->{'payload'}{'event'}{'event_ts'}) &&
  78                                     $json->{'payload'}{'event'}{'event_ts'} =~ /(\d+)\.(\d+)/) {
  79                                         my $elapsed = Time::HiRes::tv_interval([$1, $2], $now);
  80                                         printf STDERR "Message used %.1f ms to reach us.\n", 1e3 * $elapsed;
  81                                 }
  82                                 handle_event($json->{'payload'}{'event'});
  83                         }
  84                 };
  85                 if ($@) {
  86                         print STDERR "Error during handling: $@";
  87                         die;
  88                 } elsif (exists($json->{'envelope_id'})) {
  89                         my $ack = { envelope_id => $json->{'envelope_id'} };
  90                         print STDERR "Ack: " . JSON::XS::encode_json($ack) . "\n";
  91                         $conn->send(JSON::XS::encode_json($ack))
  92                                 or die "Error sending ack: $!";
  93                 }
  94         });
  95
  96         $connection->on(finish => sub {
  97                 my ($conn, $msg) = @_;
  98                 $msg //= '(none)';
  99                 print STDERR "Finished with message: $msg\n";
 100                 $ws_disconnected->send;
 101         });
 102 }
 103
 104 sub mark {
 105         print STDERR "Marking that a sync is needed.\n";
 106         $dbh->do('NOTIFY skvupdate');
 107 }
 108
 109 sub handle_event {
 110         my $ev = shift;
 111         if (!exists($ev->{'type'})) {
 112                 print STDERR "Has no type; ignoring.\n";
 113                 return;
 114         }
 115
 116         my $type = $ev->{'type'};
 117         my $user = $ev->{'user'};
 118
 119         if ($type eq 'message') {
 120                 my $text = $ev->{'text'} // $ev->{'message'}{'text'};
 121                 $text =~ s/<#[A-Z0-9]+|[^>]+>//g; #  Don't match dates in channel names.
 122                 if ($text =~ /(20\d{2}-\d{2}-\d{2})/) {
 123                         # TODO: What if edits happen out-of-order?
 124                         my $date = $1;
 125                         my $channel = $ev->{'channel'};
 126                         my $ts = $ev->{'message'}{'ts'} // $ev->{'ts'};
 127                         print STDERR "Matching message {$channel, $ts} to date $date\n";
 128                         $dbh->do('INSERT INTO message_sheet_link (channel, ts, sheet_title) VALUES (?,?,?) ON CONFLICT (channel,ts) DO UPDATE SET sheet_title=EXCLUDED.sheet_title', undef,
 129                                 $channel, $ts, $date);
 130                         # Blow the cache.
 131                         $dbh->do('UPDATE message_sheet_link SET tab_name=NULL, tab_id=NULL WHERE channel=?', undef, $channel);
 132                 } else {
 133                         print STDERR "No date found in message, ignoring\n";
 134                 }
 135                 return;
 136         }
 137
 138         my $reaction = $ev->{'reaction'};
 139         my $channel = $ev->{'item'}{'channel'};
 140         my $ts = $ev->{'item'}{'ts'};
 141         my $event_ts = $ev->{'event_ts'};
 142
 143         if (!defined($channel) || !defined($ts)) {
 144                 print STDERR "Not reacting to a message; ignoring.\n";
 145                 return;
 146         }
 147
 148         if ($type eq 'reaction_added' || $type eq 'reaction_removed') {
 149                 $dbh->do('INSERT INTO reaction_log (userid, channel, ts, reaction, event_type, event_ts) VALUES (?,?,?,?,?,?)', undef,
 150                         $user, $channel, $ts, $reaction, $type, $event_ts);
 151                 mark($dbh);
 152         } else {
 153                 print STDERR "Type is $type (not a reaction added or removed); ignoring.\n";
 154         }
 155 }