abonbot/abonbot.pl

#!/usr/bin/perl

# Бот для абонентов
# Ю. Жиловец, 29 мая 2024 года

use Modern::Perl;
use utf8;

use EV;
use Mojo::Base -strict, -signatures, -async_await;
use Mojolicious::Lite;
use Mojo::UserAgent;
use Data::Dumper;
use Mojo::Promise;
use Mojo::JSON qw/j/;
use NetAddr::IP;
use HTML::Restrict;
use Redis;
use Time::timegm qw/timegm/;
use POSIX::strptime;

use experimental qw/signatures/;

use FindBin qw/$Bin/;
use lib "$Bin/lib";
use lib "$Bin/modules";

use darsan_auth;
use darsan_client;
use rabbit_async_rec;
use commands;
use rules;
use abon_client;
use localization;

my $NAME = "abonbot";

my $confdir = app->home.'/config/'.app->mode;

plugin yaml_config => {
  file      => "$confdir/$NAME.cfg",
  stash_key => 'config',
};

our $config = app->config;
our $commands;

app->secrets(["Marsz, Marsz, Dabrowski"]);

# https://core.telegram.org/bots/api#formatting-options
my $html_strip = HTML::Restrict->new(rules => {
  b   => [],
  strong => [],
  i => [],
  em => [],
  u => [],
  ins => [],
  s => [],
  strike => [],
  del => [],
  a => [qw/href/],
  code => [qw/class/],
  pre => [],
});

my $auth   = darsan_auth->as_server($config->{darsan}->{auth}, "system", "$confdir/system.private");
our $client = darsan_client->new($auth, $config->{darsan}->{servers});
$client->map($config->{darsan_map}) if $config->{darsan_map};

our $redis = Redis->new(server => $config->{redis}, name=>"abonbot");
$redis->client_setname($NAME);

my $args = $config->{rabbit};
$args->{product} = $NAME;

my $rabbit; $rabbit = new rabbit_async_rec($args, sub
{
  foreach (@{$config->{listen}})
  {
    $rabbit->listen_queue($_->{queue}, $_->{bind}, \&incoming_message);
  }
});

our $abon_client = abon_client->new;

my $term;
my $int;
my $hup;

my $log = new Mojo::Log;

Mojo::IOLoop->next_tick(sub
{
  $term = AnyEvent->signal(signal => "TERM", cb => \&terminate);
  $int = AnyEvent->signal(signal => "INT", cb => \&terminate);
  $hup = AnyEvent->signal(signal => "HUP", cb => \&terminate);
});

##########################

my $ua = new Mojo::UserAgent;
$ua->max_redirects(5);

our $fsa;

my $locale_dir = "$Bin/locale";
my $locales = localization::available_locales($locale_dir);
my $locale_handles = localization->add_mo($locale_dir, $locales);

my @list = ();
my @commlist = map { {text=>"$_->{icon}\x{2003}$_->{name}"} } grep {$_->{main}} @$commands;
push @list, [ splice @commlist, 0, 2 ] while @commlist;
our $button_menu = \@list;

##########################

=cut
hook before_dispatch => sub
{
  my $c = shift;
  say $c->req->to_string;
};

hook after_dispatch => sub
{
  my $c = shift;
  say $c->res->to_string;
};
=cut

###############################################

get "/health" => sub
{
  shift->render(text => "Abonbot OK");
};

post "/:token" => async sub
{
  my $c = shift;

  unless ($c->param("token") eq $config->{token})
  {
    return $c->render(status=>401, text=>"Request from unknown URL");
  }
  
  $c->render(text=>"ok");

  my $body = j($c->req->body);
# say Dumper $body;

  my ($chatid, $line, $from);
  
  if (my $m = $body->{message} || $body->{edited_message})
  {
    $from = $m->{from};
    $chatid = $from->{id};
    $line = $m->{text};
    $from->{msgid} = $m->{message_id};
  }
  elsif ($m = $body->{callback_query})
  {
    $from = $m->{from};
    $chatid = $from->{id};
    $line = $m->{data};
    $from->{msgid} = $m->{message}->{message_id};
  }
  else
  {
    return $log->error("Unknown message type");
  }
  
  say ">>> $line";
  
  my $fsa = make_fsa($chatid, $from);
  say "*** restore fsa: ", $fsa->state;

  if ($body->{edited_message} && (my $if_edited = $fsa->note("if_edited")))
  {
    my ($target_msg, $var) = split("/", $if_edited);
    $fsa->note($var => $line) if $from->{msgid} == $target_msg;
  }
  else
  {
     eval {
      say "*** current state = ", $fsa->state, Dumper $fsa->notes;;
      my $new_state = await $fsa->switch($line, $from);
      say "*** switched to ", $new_state, Dumper $fsa->notes;
    };
    report($from, $@) if $@;
  }

  save_fsa($fsa, $chatid);
};

sub report($info, $err)
{
  if (ref $err eq "Mojo::Exception")
  {
    return secret_error($info, $err->message . Dumper $err->line);
  }
  
  if (ref $err eq "HASH" && exists $err->{code} && $err->{code}>=400 && $err->{code}<500 && ref $err->{body} eq "HASH")
  {
    reply($info, $err->{body}->{text_ru} || $err->{body}->{text});
  }
  else
  {
    secret_error($info, Dumper $err);
  }
}

sub secret_error($info, $str)
{
  my $code = int(rand(10000));
  $log->error("====== $code");
  $log->error($str);
  reply($info, _("Произошла ошибка. Сообщите в службу технической поддержки код") . " $code");
}

##################################

sub incoming_message
{
  my $m = shift;

  my $body = $m->{content};
  $log->debug($m->{routing_key}." ".Dumper($m->{content})) if $config->{debug};

  my $rk = $m->{routing_key};
  $rk =~ s/\./_/g;
  $rk =~ s/-/_/g;
  my $sub = reference("rabbit::$rk");

  unless ($sub)
  {
    $log->error("Unknown message: ".$m->{routing_key});
    $rabbit->reject($m);
    return;
  }

  my $res = eval { $sub->($body,$m) };

  if ($@)
  {
    $log->error($m->{routing_key} . " " . Dumper($m->{content}) . " " . Dumper($@));
    
    my $err = $@;
    
    if (ref $err && ref $err eq "HASH")
    {
      $err->{error} = 1;
    }
    else
    {
      $err = {error=>1, text=>$@};
    }
    
    $rabbit->reply($m, $err) if $m->{header}->{reply_to};
    $rabbit->reject($m);
  }
  else
  {
    $rabbit->ack($m);
    $log->debug("acknowledged") if $config->{debug};

    if (ref $res && $res->can("then"))
    {
      $res->then(sub 
      {
        my $r = shift;
        $rabbit->reply($m, $r) if $m->{header}->{reply_to};
      }, sub 
      {
        my $err = shift;
        my $rec = {error=>1, text=>$err};
        $rabbit->reply($m, $rec) if $m->{header}->{reply_to};
      });
    }
    else
    {
      # не обещание, обычный результат
      $rabbit->reply($m, $res) if $m->{header}->{reply_to};
    }
  }
}

sub rabbit::notify_abonbot_send($body, $=)
{
  my $to = $body->{to};
  $to = [ $to ] unless ref $to;
  
  notify({id=>$_}, $body->{message}) for @$to;
}

##################################

sub terminate
{
  request("setWebhook", {url=>""})->then(sub
  {
    exit(0);
  })->catch(sub
  {
    $log->error(Dumper @_);
  });
}

sub request
{
  my $action = shift;
  my $params = shift;

  $ua->post_p("https://api.telegram.org/bot$config->{token}/$action" => json => $params)
  ->then(sub
  {
    my $tx = shift;
    my $resp = $tx->result;

    if ($resp->is_error)
    {
       my $err = {};
       $err->{code} = $resp->code;
       $err->{url} = $tx->req->url->to_string;
       $err->{body} = $resp->body;
       $err->{body} = j($err->{body}) if $resp->headers->content_type eq "application/json";
       $log->error(Dumper $err);
     }
     else
     {
       my $body = $resp->body;
       $body = j($body) if $resp->headers->content_type eq "application/json";
       $body;
     }
   })
   ->catch(sub 
   {
     my $tx = shift;
     my $resp = $tx->result;
 
     my $err = {};
     $err->{code} = $resp->code;
     $err->{url} = $tx->req->url->to_string;
     $err->{body} = $resp->body;
     $err->{body} = j($err->{body}) if $resp->headers->content_type eq "application/json";
     $log->error(Dumper $err);
   });
}

sub notify($info, $message, $args={})
{
  my $params = {
    chat_id => $info->{id},
    text => $message,
    disable_web_page_preview => 1,
  };

  $params->{parse_mode} ||= "HTML";
  $params->{reply_to} = $args->{reply_to} if $args->{reply_to};
  $params->{disable_notification} = 1 if $args->{silent};
  $params->{reply_to} = $args->{msgid};

  if ($args->{menu})
  {
    $params->{reply_markup} = { keyboard => $args->{menu} };
    $params->{resize_keyboard} = Mojo::JSON->true;
    $params->{is_persistent} = Mojo::JSON->true;
  }
  
  if ($args->{remove_menu})
  {
    $params->{reply_markup} = {remove_keyboard => Mojo::JSON->true };
  }

  if ($args->{inline_menu})
  {
    $params->{reply_markup} = { inline_keyboard => $args->{inline_menu} };
  }

  my $disable_error_handler = delete $params->{disable_error_handler};

  if ($params->{parse_mode} eq "HTML")
  {
    $params->{text} = $html_strip->process($params->{text});
  }

  my $promise = request("sendMessage", $params);
  unless ($disable_error_handler)
  {
    $promise = $promise->catch(sub
    {
      $log->error(Dumper $params,@_);
    });
  }

  return $promise;
}

sub reply($info, @lines)
{
  return notify($info, join("\n", @lines), {});
}

sub reply_with($info, $params, @lines)
{
  if (exists $params->{button_menu})
  {
    if (delete $params->{button_menu})
    {
      $params->{menu} = $button_menu;
    }
    else
    {
      delete $params->{menu};
      $params->{remove_menu} = 1;
    }
  }
  
  return notify($info, join("\n", @lines), $params);
}

#################################

async sub do_command
{
  my ($fsa, $cmd, $info) = @_;

  return reply($info, _("Этот бот не работает в чатах")) if $info->{id} < 0;
  
  my ($sub, $args, $to_clean) = find_command($cmd);
  return reply($info, _("Неизвестная команда")) unless $sub;

  $fsa->delete_temp if $to_clean;
  await $sub->($fsa, $info, @$args);
}

sub find_command
{
  my $cmd = shift;
  my ($c, @args) = split(/\x20+/,$cmd);
  $c =~ s/\@MolAbonbotBot$//;
  
  my $prefix = "command";
  my $to_clean = 1;

  if (substr($c, 0, 1) eq "/")
  {
  }
  elsif (substr($c, 0, 1) eq "\x00")
  {
    $prefix = "callback";
    undef $to_clean;
  }
  else
  {
    my @found = grep { $_->{main} && index($cmd, "$_->{icon}\x{2003}$_->{name}")==0 } @$commands;
    return undef unless @found;
    $c = $found[0]->{command};
  }

  $c =~ s|^\x00||;
  $c =~ s|^/||;
  
  return refpath("${prefix}_$c"), \@args, $to_clean;
}

sub refpath
{
  my $name = shift;
  $name =~ tr/.-/_/;
  $name =~ s|/|::|g;
  return reference($name);
}

sub reference
{
  my $name = shift;
  return exists(&{$name}) ? \&{$name} : undef;
}

sub _loc($lang, $str)
{
  return $str unless exists $locale_handles->{$lang};
  return $locale_handles->{$lang}->maketext($str);
}

sub _($str)
{
  return _loc($config->{locale} || "ru", $str);
}

sub parse_time 
{
  no warnings;
  my $s           = shift;
  my $time_format = "%Y-%m-%d %H:%M:%S%z";

  $s =~ /([+-])(\d{4})$/;
  my $tz_sign = $1;
  my $tz      = $2;
  $s =~ s/[+-]\d{4}$//;

  my $time = timegm(POSIX::strptime($s, $time_format));

  if ($tz) {
    my $h      = substr($tz, 0, 2);
    my $s      = substr($tz, 2, 2);
    my $offset = ($h * 60 + $s) * 60;
    $offset    = -$offset if $tz_sign eq "+";
    $time      += $offset;
  }

  return $time;
}

sub format_timestamp($ts)
{
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ts);
  return sprintf("%2d.%02d.%d %2d:%02d", $mday, $mon+1, $year+1900, $hour, $min);
}

sub format_time($str)
{
  return format_timestamp(parse_time($str));
}

sub format_date($str)
{
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(parse_time($str));
  return sprintf("%2d.%02d.%d", $mday, $mon+1, $year+1900);
}

######################################

$log->info("Started (".app->mode.")");

request("setWebhook",{url=>""})->then(sub
{
  $log->info("Webhook to $config->{webhook}");
  return request("setWebhook", {url=>"$config->{webhook}/$config->{token}"});
})
->then(sub
{
  my $list = [ map { {command=>$_->{command}, description=>$_->{description}} } @$commands ];
  return request("setMyCommands", {language_code=>"ru", commands=>$list });  
})
->then(sub
{
  my @promises = map {
    my $locale = $_;
    my $list = [ map { {command=>$_->{command}, description=>_loc($locale, $_->{description})} } @$commands ];
    request("setMyCommands", {language_code=>$_, commands=>$list })
  } @$locales;
  
  return Mojo::Promise->all(@promises);
})
->catch(sub
{
  $log->error(Dumper @_);
});

app->start;