package WWW::Telegram::BotAPI;
use strict;
use warnings;
use warnings::register;
use Carp ();
use Encode ();
use JSON::MaybeXS ();
use constant DEBUG => $ENV{TELEGRAM_BOTAPI_DEBUG} || 0;

our $VERSION = "0.12";
my $json; # for debugging purposes, only defined when DEBUG = 1

BEGIN {
    eval "require Mojo::UserAgent; 1" or
        eval "require LWP::UserAgent; 1" or
        die "Either Mojo::UserAgent or LWP::UserAgent is required.\n$@";
    $json = JSON::MaybeXS->new (pretty => 1, utf8 => 1) if DEBUG;
}

# Debugging functions (only used when DEBUG is true)
sub _dprintf { printf "-T- $_[0]\n", splice @_, 1 }
sub _ddump
{
    my ($varname, $to_dump) = splice @_, -2;
    _dprintf @_ if @_;
    printf "%s = %s", $varname, defined $to_dump ? $json->encode ($to_dump) : "undefined\n";
}

# %settings = (
#     async     => Bool,
#     token     => String,
#     api_url   => "http://something/%s/%s", # 1st %s = tok, 2nd %s = method
#     force_lwp => Bool
# )
sub new
{
    my ($class, %settings) = @_;
    exists $settings{token}
        or Carp::croak "ERROR: missing 'token' from \%settings.";
    # When DEBUG is enabled, and Mojo::UserAgent is used, Mojolicious must be at
    # least version 6.22 (https://github.com/kraih/mojo/blob/v6.22/Changes). This is because
    # Mojo::JSON used incompatible JSON boolean constants which led JSON::MaybeXS to crash
    # with a mysterious error message. To prevent this, we force LWP in this case.
    if (DEBUG && Mojo::JSON->can ("true") && ref Mojo::JSON->true ne "JSON::PP::Boolean")
    {
        warnings::warnif (
            "WARNING: Enabling DEBUG with Mojolicious versions < 6.22 won't work. Forcing " .
            "LWP::UserAgent. (update Mojolicious or disable DEBUG to fix)"
        );
        ++$settings{force_lwp};
    }
    # Ensure that LWP is loaded if "force_lwp" is specified.
    $settings{force_lwp}
        and require LWP::UserAgent;
    # Instantiate the correct user-agent. This automatically detects whether Mojo::UserAgent is
    # available or not.
    if ($settings{force_lwp} or !Mojo::UserAgent->can ("new"))
    {
        $settings{_agent} = LWP::UserAgent->new;
    } else {
        $settings{_agent} = Mojo::UserAgent->new;
        # Setup an handler to print detailed information in case of proxy connection failure.
        DEBUG and $settings{_agent}->on (start => sub {
            my (undef, $tx) = @_;
            # Skip all requests which are not proxy-related.
            return unless $tx->req->method eq "CONNECT";
            # Add an handler on completion.
            $tx->on (finish => sub {
                my $tx = shift;
                _dprintf "ERROR: Got error from proxy server: %s", _mojo_error_to_string ($tx)
                    if $tx->error;
            });
        })
    }
    ($settings{async}  ||= 0) and $settings{_agent}->isa ("LWP::UserAgent")
        and Carp::croak "ERROR: Mojo::UserAgent is required to use 'async'.";
    $settings{api_url} ||= "https://api.telegram.org/bot%s/%s";
    DEBUG && _dprintf "WWW::Telegram::BotAPI initialized (v%s), using agent %s %ssynchronously.",
        $VERSION, ref $settings{_agent}, $settings{async} ? "a" : "";
    bless \%settings, $class
}

# Don't let old Perl versions call AUTOLOAD when DESTROYing our class.
sub DESTROY {}

# Magically provide methods named as the Telegram API ones, such as $o->sendMessage.
sub AUTOLOAD
{
    my $self = shift;
    our $AUTOLOAD;
    (my $method = $AUTOLOAD) =~ s/.*:://; # removes the package name at the beginning
    $self->api_request ($method, @_);
}

# The real stuff!
sub api_request
{
    my ($self, $method) = splice @_, 0, 2;
    # Detect if the user provided a callback to use for async requests.
    # The only parameter whose order matters is $method. The callback and the request parameters
    # can be put in any order, like this: $o->api_request ($method, sub {}, { a => 1 }) or
    # $o->api_request ($method, { a => 1 }, sub {}), or even
    # $o->api_request ($method, "LOL", "DONGS", sub {}, { a => 1 }).
    my ($postdata, $async_cb);
    for my $arg (@_)
    {
        # Poor man's switch block
        for (ref $arg)
        {
            # Ensure that we don't get async callbacks when we aren't in async mode.
            ($async_cb = $arg, last) if $_ eq "CODE" and $self->{async};
            ($postdata = $arg, last) if $_ eq "HASH";
        }
        last if defined $async_cb and defined $postdata;
    }
    # Prepare the request method parameters.
    my @request;
    my $is_lwp = $self->_is_lwp;
    # Push the request URI (this is the same in LWP and Mojo)
    push @request, sprintf ($self->{api_url}, $self->{token}, $method);
    if (defined $postdata)
    {
        # POST arguments which are array/hash references need to be handled as follows:
        # - if no file upload exists, use application/json and encode everything with JSON::MaybeXS
        #   or let Mojo::UserAgent handle everything, when available.
        # - whenever a file upload exists, the MIME type is switched to multipart/form-data.
        #   Other refs which are not file uploads are then encoded with JSON::MaybeXS.
        my @fixable_keys; # This array holds keys found before file uploads which have to be fixed.
        my @utf8_keys; # This array holds keys found before file uploads which have to be encoded.
        my $has_file_upload;
        # Traverse the post arguments.
        for my $k (keys %$postdata)
        {
            # Ensure we pass octets to LWP with multipart/form-data and that we deal only with
            # references.
            ($is_lwp
                ? $has_file_upload ? $postdata->{$k} = Encode::encode ("utf-8", $postdata->{$k})
                                   : push @utf8_keys, $k
                : ()), next unless my $ref = ref $postdata->{$k};
            # Process file uploads.
            if ($ref eq "HASH" and
                (exists $postdata->{$k}{file} or exists $postdata->{$k}{content}))
            {
                # WARNING: using file uploads implies switching to the MIME type
                # multipart/form-data, which needs a JSON stringification for every complex object.
                ++$has_file_upload;
                # No particular treatment is needed for file uploads when using Mojo.
                next unless $is_lwp;
                # The structure of the hash must be:
                # { content => 'file content' } or { file => 'path to file' }
                # With an optional key "filename" and optional headers to be merged into the
                # multipart/form-data stuff.
                # See https://metacpan.org/pod/Mojo::UserAgent::Transactor#tx
                # HTTP::Request::Common uses this syntax instead:
                # [ $file, $filename, SomeHeader => 'bla bla', Content => 'fileContent' ]
                # See p3rl.org/HTTP::Request::Common#POST-url-Header-Value-...-Content-content
                my $new_val = [];
                # Push and remove the keys 'file' and 'filename' (if defined) to $new_val.
                push @$new_val, delete $postdata->{$k}{file},
                                delete $postdata->{$k}{filename};
                # Push 'Content' (note the uppercase 'C')
                exists $postdata->{$k}{content}
                    and push @$new_val, Content => delete $postdata->{$k}{content};
                # Push the other headers.
                push @$new_val, %{$postdata->{$k}};
                # Finalize the changes.
                $postdata->{$k} = $new_val;
            }
            else
            {
                $postdata->{$k} = JSON::MaybeXS::encode_json ($postdata->{$k}), next
                    if $has_file_upload;
                push @fixable_keys, $k;
            }
        }
        if ($has_file_upload)
        {
            # Fix keys found before the file upload.
            $postdata->{$_} = JSON::MaybeXS::encode_json ($postdata->{$_}) for @fixable_keys;
            $postdata->{$_} = Encode::encode ("utf-8", $postdata->{$_})  for @utf8_keys;
            $is_lwp
                and push @request, Content      => $postdata,
                                   Content_Type => "form-data"
                or  push @request, form         => $postdata;
        }
        else
        {
            $is_lwp
                and push @request, DEBUG ? (DBG => $postdata) : (), # handled in _fix_request_args
                                   Content      => JSON::MaybeXS::encode_json ($postdata),
                                   Content_Type => "application/json"
                or  push @request, json         => $postdata;
        }
    }
    # Protip (also mentioned in the doc): if you are using non-blocking requests with
    # Mojo::UserAgent, remember to start the event loop with Mojo::IOLoop->start.
    # This is superfluous when using this module in a Mojolicious app.
    push @request, $async_cb if $async_cb;
    # Stop here if this is a test - specified using the (internal) "_dry_run" flag.
    return 1 if $self->{_dry_run};
    DEBUG and _ddump "BEGIN REQUEST to /%s :: %s", $method, scalar localtime,
        PAYLOAD => _fix_request_args ($self, \@request);
    # Perform the request.
    my $tx = $self->agent->post (@request);
    DEBUG and $async_cb and
        _dprintf "END REQUEST to /%s (async) :: %s", $method, scalar localtime;
    # We're done if the request is asynchronous.
    return $tx if $async_cb;
    # Pre-decode the response to provide, if possible, an error message.
    my $response = $is_lwp ?
        eval { JSON::MaybeXS::decode_json ($tx->decoded_content) } || undef :
        $tx->res->json;
    # Dump it in debug mode.
    DEBUG and _ddump RESPONSE => $response;
    # If we (or the server) f****d up... die horribly.
    unless (($is_lwp ? $tx->is_success : !$tx->error) && $response && $response->{ok})
    {
        $response ||= {};
        my $error = $response->{description} || (
            $is_lwp ? $tx->status_line : _mojo_error_to_string ($tx)
        );
        # Print either the error returned by the API or the HTTP status line.
        Carp::confess
            "ERROR: ", ($response->{error_code} ? "code " . $response->{error_code} . ": " : ""),
            $error || "something went wrong!";
    }
    DEBUG and _dprintf "END REQUEST to /%s :: %s", $method, scalar localtime;
    $response
}

sub parse_error
{
    my $r = { type => "unknown", msg => $_[1] || $@ };
    # The following regexp matches the error code to the first group and the error message to the
    # second.
    # Issue #19: match only `at ...` messages separated by at least one space. See t/02-exceptions
    return $r unless $r->{msg} =~ /ERROR: (?:code ([0-9]+): )?(.+?)(?:\s+at .+)?$/m;
    # Find and save the error code and message.
    $r->{code} = $1 if $1;
    $r->{msg}  = $2;
    # If the error message has a code, then it comes from the BotAPI. Otherwise, it's our agent
    # telling us something went wrong.
    $r->{type} = exists $r->{code} ? "api" : "agent" if $r->{msg} ne "something went wrong!";
    $r
}

sub agent
{
    shift->{_agent}
}

# Hides the bot's token from the request arguments and improves debugging output.
sub _fix_request_args
{
    my ($self, $args) = @_;
    my $args_cpy = [ @$args ];
    $args_cpy->[0] =~ s/\Q$self->{token}\E/XXXXXXXXX/g;
    # Note for the careful reader: you may remember that the position of Perl's hash keys is
    # undeterminate - that is, an hash has no particular order. This is true, however we are
    # dealing with an array which has a fixed order, so no particular problem arises here.
    # Addendum: the original reference of $args is used here to get rid of `DBG => $postdata`.
    if (@$args > 1 and $args->[1] eq "DBG")
    {
        my (undef, $data) = splice @$args, 1, 2;
        # Be sure to get rid of the `DBG` key in our copy too.
        splice @$args_cpy, 1, 2;
        # In the debug output, substitute the JSON-encoded data (which is not human readable) with
        # the raw POST arguments.
        $args_cpy->[2] = $data;
    }
    # Ensure that we do NOT try display async subroutines!
    pop @$args_cpy if ref $args_cpy->[-1] eq "CODE";
    $args_cpy
}

sub _is_lwp
{
    shift->agent->isa ("LWP::UserAgent")
}

# Extracts an error message returned from Mojo::UserAgent in a way that's compatible for all
# Mojolicious versions: in some conditions, `$tx->error` returned a string instead of the
# expected hash reference. See issue #16.
sub _mojo_error_to_string {
    my $tx = shift;
    ((ref ($tx->error || {}) ? $tx->error : { message => $tx->error }) || {})->{message}
}

1;

=encoding utf8

=head1 NAME

WWW::Telegram::BotAPI - Perl implementation of the Telegram Bot API

=head1 SYNOPSIS

    use WWW::Telegram::BotAPI;
    my $api = WWW::Telegram::BotAPI->new (
        token => 'my_token'
    );
    # The API methods die when an error occurs.
    say $api->getMe->{result}{username};
    # ... but error handling is available as well.
    my $result = eval { $api->getMe }
        or die 'Got error message: ', $api->parse_error->{msg};
    # Uploading files is easier than ever.
    $api->sendPhoto ({
        chat_id => 123456,
        photo   => {
            file => '/home/me/cool_pic.png'
        },
        caption => 'Look at my cool photo!'
    });
    # Complex objects are as easy as writing a Perl object.
    $api->sendMessage ({
        chat_id      => 123456,
        # Object: ReplyKeyboardMarkup
        reply_markup => {
            resize_keyboard => \1, # \1 = true when JSONified, \0 = false
            keyboard => [
                # Keyboard: row 1
                [
                    # Keyboard: button 1
                    'Hello world!',
                    # Keyboard: button 2
                    {
                        text => 'Give me your phone number!',
                        request_contact => \1
                    }
                ]
            ]
        }
    });
    # Asynchronous request are supported with Mojo::UserAgent.
    $api = WWW::Telegram::BotAPI->new (
        token => 'my_token',
        async => 1 # WARNING: may fail if Mojo::UserAgent is not available!
    );
    $api->sendMessage ({
        chat_id => 123456,
        text    => 'Hello world!'
    }, sub {
        my ($ua, $tx) = @_;
        die 'Something bad happened!' if $tx->error;
        say $tx->res->json->{ok} ? 'YAY!' : ':('; # Not production ready!
    });
    Mojo::IOLoop->start;

=head1 DESCRIPTION

This module provides an easy to use interface for the
L<Telegram Bot API|https://core.telegram.org/bots/api>. It also supports async requests out of the
box using L<Mojo::UserAgent>, which makes this module easy to integrate with an existing
L<Mojolicious> application.

=head1 METHODS

L<WWW::Telegram::BotAPI> implements the following methods.

=head2 new

    my $api = WWW::Telegram::BotAPI->new (%options);

Creates a new L<WWW::Telegram::BotAPI> instance.

B<WARNING:> you should only create one instance of this module and reuse it when needed. Calling
C<new> each time you run an async request causes unexpected behavior with L<Mojo::UserAgent> and
won't work correctly. See also
L<issue #13 on GitHub|https://github.com/Robertof/perl-www-telegram-botapi/issues/13>.

C<%options> may contain the following:

=over 4

=item * C<< token => 'my_token' >>

The token that will be used to authenticate the bot.

B<This is required! The method will croak if this option is not specified.>

=item * C<< api_url => 'https://api.example.com/token/%s/method/%s' >>

A format string that will be used to create the final API URL. The first parameter specifies
the token, the second one specifies the method.

Defaults to C<https://api.telegram.org/bot%s/%s>.

=item * C<< async => 1 >>

Enables asynchronous requests.

B<This requires L<Mojo::UserAgent>, and the method will croak if it isn't found.>

Defaults to C<0>.

=item * C<< force_lwp => 1 >>

Forces the usage of L<LWP::UserAgent> instead of L<Mojo::UserAgent>, even if the latter is
available.

By default, the module tries to load L<Mojo::UserAgent>, and on failure it uses L<LWP::UserAgent>.

=back

=head2 AUTOLOAD

    $api->getMe;
    $api->sendMessage ({
        chat_id => 123456,
        text    => 'Hello world!'
    });
    # with async => 1 and the IOLoop already started
    $api->setWebhook ({ url => 'https://example.com/webhook' }, sub {
        my ($ua, $tx) = @_;
        die if $tx->error;
        say 'Webhook set!'
    });

This module makes use of L<perlsub/"Autoloading">. This means that B<every current and future
method of the Telegram Bot API can be used by calling its Perl equivalent>, without requiring an
update of the module.

If you'd like to avoid using C<AUTOLOAD>, then you may simply call the L</"api_request"> method
specifying the method name as the first argument.

    $api->api_request ('getMe');

This is, by the way, the exact thing the C<AUTOLOAD> method of this module does.

=head2 api_request

    # Remember: each of these samples can be aliased with
    # $api->methodName ($params).
    $api->api_request ('getMe');
    $api->api_request ('sendMessage', {
        chat_id => 123456,
        text    => 'Oh, hai'
    });
    # file upload
    $api->api_request ('sendDocument', {
        chat_id  => 123456,
        document => {
            filename => 'dump.txt',
            content  => 'secret stuff'
        }
    });
    # complex objects are supported natively since v0.04
    $api->api_request ('sendMessage', {
        chat_id      => 123456,
        reply_markup => {
            keyboard => [ [ 'Button 1', 'Button 2' ] ]
        }
    });
    # with async => 1 and the IOLoop already started
    $api->api_request ('getMe', sub {
        my ($ua, $tx) = @_;
        die if $tx->error;
        # ...
    });

This method performs an API request. The first argument must be the method name
(L<here's a list|https://core.telegram.org/bots/api#available-methods>).

Once the request is completed, the response is decoded using L<JSON::MaybeXS> and then
returned. If L<Mojo::UserAgent> is used as the user-agent, then the response is decoded
automatically using L<Mojo::JSON>.

If the request is not successful or the server tells us something isn't C<ok>, then this method
dies with the first available error message (either the error description or the status line).
You can make this method non-fatal using C<eval>:

    my $response = eval { $api->api_request ($method, $args) }
        or warn "Request failed with error '$@', but I'm still alive!";

Further processing of error messages can be obtained using L</"parse_error">.

Request parameters can be specified using an hash reference. Additionally, complex objects can be
specified like you do in JSON. See the previous examples or the example bot provided in
L</"SEE ALSO">.

File uploads can be specified using an hash reference containing the following mappings:

=over 4

=item * C<< file => '/path/to/file.ext' >>

Path to the file you want to upload.

Required only if C<content> is not specified.

=item * C<< filename => 'file_name.ext' >>

An optional filename that will be used instead of the real name of the file.

Particularly recommended when C<content> is specified.

=item * C<< content => 'Being a file is cool :-)' >>

The content of the file to send. When using this, C<file> must not be specified.

=item * C<< AnyCustom => 'Header' >>

Custom headers can be specified as hash mappings.

=back

Upload of multiple files is not supported. See L<Mojo::UserAgent::Transactor/"tx"> for more
information about file uploads.

To resend files, you don't need to perform a file upload at all. Just pass the ID as a normal
parameter.

    $api->sendPhoto ({
        chat_id => 123456,
        photo   => $photo_id
    });

When asynchronous requests are enabled, a callback can be specified as an argument.
The arguments passed to the callback are, in order, the user-agent (a L<Mojo::UserAgent> object)
and the response (a L<Mojo::Transaction::HTTP> object). More information can be found in the
documentation of L<Mojo::UserAgent> and L<Mojo::Transaction::HTTP>.

B<NOTE:> ensure that the event loop L<Mojo::IOLoop> is started when using asynchronous requests.
This is not needed when using this module inside a L<Mojolicious> app.

The order of the arguments, except of the first one, does not matter:

    $api->api_request ('sendMessage', $parameters, $callback);
    $api->api_request ('sendMessage', $callback, $parameters); # same thing!

=head2 parse_error

    unless (eval { $api->doSomething(...) }) {
        my $error = $api->parse_error;
        die "Unknown error: $error->{msg}" if $error->{type} eq 'unknown';
        # Handle error gracefully using "type", "msg" and "code" (optional)
    }
    # Or, use it with a custom error message.
    my $error = $api->parse_error ($message);

When sandboxing calls to L<WWW::Telegram::BotAPI> methods using C<eval>, it is useful to parse
error messages using this method.

B<WARNING:> up until version 0.09, this method incorrectly stopped at the first occurence of C<at>
in error messages, producing results such as C<missing ch> instead of C<missing chat>.

This method accepts an error message as its first argument, otherwise C<$@> is used.

An hash reference containing the following elements is returned:

=over 4

=item * C<< type => unknown|agent|api >>

The source of the error.

C<api> specifies an error originating from Telegram's BotAPI. When C<type> is C<api>, the key
C<code> is guaranteed to exist.

C<agent> specifies an error originating from this module's user-agent. This may indicate a network
issue, a non-200 HTTP response code or any error not related to the API.

C<unknown> specifies an error with no known source.

=item * C<< msg => ... >>

The error message.

=item * C<< code => ... >>

The error code. B<This key only exists when C<type> is C<api>>.

=back

=head2 agent

    my $user_agent = $api->agent;

Returns the instance of the user-agent used by the module. You can determine if the module is using
L<LWP::UserAgent> or L<Mojo::UserAgent> by using C<isa>:

    my $is_lwp = $user_agent->isa ('LWP::UserAgent');

=head3 USING A PROXY

Since all the painful networking stuff is delegated to one of the two supported user agents
(either L<LWP::UserAgent> or L<Mojo::UserAgent>), you can use their built-in support for proxies
by accessing the user agent object. An example of how this may look like is the following:

    my $user_agent = $api->agent;
    if ($user_agent->isa ('LWP::UserAgent')) {
      # Use LWP::Protocol::connect (for https)
      $user_agent->proxy ('https', '...');
      # Or if you prefer, load proxy settings from the environment.
      # $user_agent->env_proxy;
    } else {
      # Mojo::UserAgent (builtin)
      $user_agent->proxy->https ('...');
      # Or if you prefer, load proxy settings from the environment.
      # $user_agent->detect;
    }

B<NOTE:> Unfortunately, L<Mojo::UserAgent> returns an opaque C<Proxy connection failed> when
something goes wrong with the C<CONNECT> request made to the proxy. To alleviate this, since
version 0.12, this module prints the real reason of failure in debug mode. See L</"DEBUGGING">.
If you need to access the real error reason in your code, please see
L<issue #29 on GitHub|https://github.com/Robertof/perl-www-telegram-botapi/issues/29>.

=head1 DEBUGGING

To perform some cool troubleshooting, you can set the environment variable C<TELEGRAM_BOTAPI_DEBUG>
to a true value:

    TELEGRAM_BOTAPI_DEBUG=1 perl script.pl

This dumps the content of each request and response in a friendly, human-readable way.
It also prints the version and the configuration of the module. As a security measure, the bot's
token is automatically removed from the output of the dump.

Since version 0.12, enabling this flag also gives more details when a proxy connection fails.

B<WARNING:> using this option along with an old Mojolicious version (< 6.22) leads to a warning,
and forces L<LWP::UserAgent> instead of L<Mojo::UserAgent>. This is because L<Mojo::JSON>
used incompatible boolean values up to version 6.21, which led to an horrible death of
L<JSON::MaybeXS> when serializing the data.

=head1 CAVEATS

When asynchronous mode is enabled, no error handling is performed. You have to do it by
yourself as shown in the L</"SYNOPSIS">.

=head1 SEE ALSO

L<LWP::UserAgent>, L<Mojo::UserAgent>,
L<https://core.telegram.org/bots/api>, L<https://core.telegram.org/bots>,
L<example implementation of a Telegram bot|https://git.io/vlOK0>,
L<example implementation of an async Telegram bot|https://git.io/vDrwL>

=head1 AUTHOR

Roberto Frenna (robertof AT cpan DOT org)

=head1 BUGS

Please report any bugs or feature requests to
L<https://github.com/Robertof/perl-www-telegram-botapi>.

=head1 THANKS

Thanks to L<the authors of Mojolicious|Mojolicious> for inspiration about the license and the
documentation.

=head1 LICENSE

Copyright (C) 2015, Roberto Frenna.

This program is free software, you can redistribute it and/or modify it under the terms of the
Artistic License version 2.0.

=cut