abonbot/abonbot.pl

#!/usr/bin/perl

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

use Modern::Perl;
use utf8;

use EV;
use Mojo::Base -strict, -signatures;
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 Mojo::Promise;
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 fsa;
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;

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");

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;
our $commands;

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

our $kb_menu = [[
  map { _($_->{name}) } grep {!$_->{hide_in_kb}} @$commands,
]];

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

=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" => 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 ($from, $chatid, $cmd);
  
  if (my $m = $body->{message} || $body->{edited_message})
  {
    $from = $m->{from};
    $chatid = $from->{id};
    $cmd = $m->{text};
    $from->{msgid} = $m->{message_id};
  }
  elsif ($m = $body->{callback_query})
  {
    $from = $m->{from};
    $chatid = $from->{id};
    $cmd = $m->{data};
    $from->{msgid} = $m->{message}->{message_id};
  }
  else
  {
    return $log->error("Unknown message type");
  }
  
say ">>> $cmd";
  restore_fsa_state($chatid, $from);
  process_input($cmd, $chatid, $from);
  save_fsa_state($chatid);
};

=cut
$VAR1 = {
          'callback_query' => {
                              'data' => '32320/set-credit',
                              'from' => {
                                        'id' => 311683401,
                                        'username' => 'AntonMetelkin2',
                                        'first_name' => "\x{410}\x{43d}\x{442}\x{43e}\x{43d}",
                                        'language_code' => 'ru',
                                        'last_name' => "\x{41c}\x{435}\x{442}\x{451}\x{43b}\x{43a}\x{438}\x{43d}",
                                        'is_bot' => bless( do{\(my $o = 0)}, 'JSON::PP::Boolean' )
                                      },
                              'chat_instance' => '4165635351277858977',
                              'id' => '1338670018114168009',
                              'message' => {
                                           'reply_markup' => {
                                                             'inline_keyboard' => [
                                                                                  [
                                                                                    {
                                                                                      'callback_data' => '32320/set-credit',
                                                                                      'text' => "\x{42f} \x{441}\x{43e}\x{433}\x{43b}\x{430}\x{441}\x{435}\x{43d} \x{441} \x{443}\x{441}\x{43b}\x{43e}\x{432}\x{438}\x{44f}\x{43c}\x{438}"
                                                                                    }
                                                                                  ]
                                                                                ]
                                                           },
                                           'text' => "\x{412}\x{44b} \x{43c}\x{43e}\x{436}\x{435}\x{442}\x{435} \x{441}\x{430}\x{43c}\x{43e}\x{441}\x{442}\x{43e}\x{44f}\x{442}\x{435}\x{43b}\x{44c}\x{43d}\x{43e} \x{443}\x{441}\x{442}\x{430}\x{43d}\x{43e}\x{432}\x{438}\x{442}\x{44c} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{43d}\x{430} \x{434}\x{432}\x{430} \x{434}\x{43d}\x{44f}
\x{41e}\x{433}\x{440}\x{430}\x{43d}\x{438}\x{447}\x{435}\x{43d}\x{438}\x{44f}: \x{442}\x{43e}\x{43b}\x{44c}\x{43a}\x{43e} \x{434}\x{43b}\x{44f} \x{444}\x{438}\x{437}\x{438}\x{447}\x{435}\x{441}\x{43a}\x{438}\x{445} \x{43b}\x{438}\x{446}, \x{43f}\x{440}\x{43e}\x{434}\x{43b}\x{435}\x{432}\x{430}\x{442}\x{44c} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{43f}\x{43e}\x{432}\x{442}\x{43e}\x{440}\x{43d}\x{43e} \x{434}\x{43e} \x{43e}\x{43f}\x{43b}\x{430}\x{442}\x{44b} \x{43d}\x{435}\x{43b}\x{44c}\x{437}\x{44f}. \x{41f}\x{440}\x{438} \x{441}\x{43b}\x{435}\x{434}\x{443}\x{44e}\x{449}\x{435}\x{439} \x{43e}\x{43f}\x{43b}\x{430}\x{442}\x{435} \x{43a}\x{440}\x{435}\x{434}\x{438}\x{442} \x{431}\x{443}\x{434}\x{435}\x{442} \x{43f}\x{43e}\x{433}\x{430}\x{448}\x{435}\x{43d}",
                                           'entities' => [
                                                         {
                                                           'type' => 'bold',
                                                           'offset' => 54,
                                                           'length' => 11
                                                         }
                                                       ],
                                           'message_id' => 995,
                                           'chat' => {
                                                     'last_name' => "\x{41c}\x{435}\x{442}\x{451}\x{43b}\x{43a}\x{438}\x{43d}",
                                                     'id' => 311683401,
                                                     'type' => 'private',
                                                     'username' => 'AntonMetelkin2',
                                                     'first_name' => "\x{410}\x{43d}\x{442}\x{43e}\x{43d}"
                                                   },
                                           'from' => {
                                                     'is_bot' => bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ),
                                                     'first_name' => "\x{41c}\x{430}\x{43a}\x{435}\x{435}\x{432}\x{43a}\x{430}-\x{41e}\x{43d}\x{43b}\x{430}\x{439}\x{43d}",
                                                     'id' => 7443432620,
                                                     'username' => 'MolAbonBot'
                                                   },
                                           'date' => 1723730668
                                         }
                            },
          'update_id' => 292858034
        };

=cut


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

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
{
  my $chatid = shift;
  my $message = shift;
  my $rest = shift || {};

  my $params = {
    chat_id => $chatid,
    text => $message,
    disable_web_page_preview => 1,
  };

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

  if ($rest->{menu})
  {
    $params->{reply_markup} = { keyboard => $rest->{menu} };
    $params->{resize_keyboard} = Mojo::JSON->true;
  }

  if ($rest->{inline_menu})
  {
    $params->{reply_markup} = { inline_keyboard => $rest->{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($rec, @lines)
{
  return notify($rec->{id}, join("\n", @lines), {reply_to=>$rec->{msgid}});
}

sub reply_with($rec, $params, @lines)
{
  $params->{reply_to} = $rec->{msgid};
  return notify($rec->{id}, join("\n", @lines), $params);
}

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

sub do_command
{
  my $cmd = shift;
  my $chatid = shift;
  my $rest = shift;

  local($Data::Dumper::Terse) = 1;

  my ($c,@args) = split(/\s+/,$cmd);
  $c =~ s|^/||;
  $c =~ s/\@MolAbonbotBot$//;
  
  if ($chatid<0)
  {
    return notify($chatid, _("Этот бот не работает в чатах"), $rest);
  }

  my $sub = refpath("command_$c");

  unless ($sub)
  {
    return notify($chatid, _("Неизвестная команда"), $rest);
  }

  my $state;
  eval {
    my $res = $sub->($chatid, $fsa->notes("uid"), $rest);
    if (ref $res eq "Mojo::Promise")
    {
      $res->catch(sub($err)
      {
        $log->error(Dumper $err);
      });
    }
  };

  if ($@)
  {
    my $msg = ref $@ eq "HASH" ? Dumper($@) : $@;
    $log->error("$cmd from $chatid: $msg");
    notify($chatid, "Ошибка при выполнении команды $cmd: $msg");
    return;
  }
}

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

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

sub make_key($id, $type)
{
  return "ab-$id-$type";
}

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

sub _($str)
{
  return _loc($fsa->notes("lang") || "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_time($str)
{
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(parse_time($str));
  return sprintf("%2d.%02d.%d %2d:%02d", $mday, $mon+1, $year+1900, $hour, $min);
}

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;