package Verotel::FlexPay;

use strict;
use warnings;
use base 'Exporter';

use Digest::SHA1 qw( sha1_hex );
use Params::Validate qw(:all);
use URI;
use Carp;
use utf8;

our $VERSION = '3.4';

our @EXPORT_OK = qw(
    get_signature
    get_status_URL
    get_purchase_URL
    get_subscription_URL
    get_upgrade_subscription_URL
    get_cancel_subscription_URL
    validate_signature
);

my $STATUS_URL = 'https://secure.verotel.com/salestatus';
my $FLEXPAY_URL = 'https://secure.verotel.com/startorder';
my $CANCEL_URL = 'https://secure.verotel.com/cancel-subscription';
my $PROTOCOL_VERSION = $VERSION;

=head2 get_signature($secret, %params)

Returns sha1_hex signature for the given parameters using L<$secret>.

Signature is an SHA-1 hash as hexadecimal number generated from L<$secret>
followed by the parameters joined with colon (:). Parameters ("$key=$value")
are alphabeticaly orderered by their keys. Only the following parameters are
considered for signing:

=over 2

version,
shopID, saleID, referenceID,
priceAmount, priceCurrency,
description, name
custom1, custom2, custom3
subscriptionType
period
trialAmount, trialPeriod
cancelDiscountPercentage

=back

=head3 Example:

    get_signature('aaB',
        shopID => '123',
        custom1 => 'xyz',
        custom2 => undef ,
        ignored => 'bla'
    );

returns the SHA-1 string for "aaB:custom1=xyz:custom2=:shopID=123" converted to lowercase.

=cut

sub get_signature {
    my $secret = shift;
    my %params = @_;
    %params = filter_params( %params );
    return signature($secret, %params);
}


=head2 validate_signature($secret, %params)

Returns true if the signature passed in the parameters match the signature computed from B<all> parameters (except for the signature itself).

=head3 Example:

    validate_signature('aaB',
        shopID => 123,
        saleID => 345,
        signature => '30a671fd2ab5a7580c3ecc279e092eef35a97ff1'
    );

returns true as the signature passed as the parameter is the same as the signature computed for "aaB:saleID=345:shopID=123"

=cut

sub validate_signature {
    my ($secret, %params) = @_;
    my $sign1  = lc(delete $params{signature});
    my $sign2  = signature($secret, %params);
    return ($sign1 eq $sign2) ? 1 : 0;
}


=head2 get_purchase_URL($secret, %params)

Return URL for purchase with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_purchase_URL('mySecret', shopID => 65147, priceAmount => '6.99', priceCurrency  => 'USD');

returns

    "https://secure.verotel.com/startorder?priceAmount=6.99&priceCurrency=USD&shopID=65147&type=purchase&version=3&signature=419265a47644c7852c4a595385b867a4ce87da7b"

=cut

sub get_purchase_URL {
    my ($secret, %params) = @_;
    return generate_URL($FLEXPAY_URL, $secret, 'purchase',  %params);
}

=head2 get_subscription_URL($secret, %params)

Return URL for subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_subscription_URL('mySecret', shopID => 65147, subscriptionType => 'recurring', period => 'P1M');

returns

    "https://secure.verotel.com/startorder?period=P1M&shopID=65147&subscriptionType=recurring&type=subscription&version=3&signature=602c185d1ab001b84b8e5248b67539aae94aa7fb"

=cut

sub get_subscription_URL {
    my ($secret, %params) = @_;
    return generate_URL($FLEXPAY_URL, $secret, 'subscription', %params);
}

=head2 get_subscription_URL($secret, %params)

Return URL for upgrade subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_upgrade_subscription_URL('mySecret', shopID => 65147, subscriptionType => 'recurring', period => 'P1M');

returns

    "https://secure.verotel.com/startorder?period=P1M&shopID=65147&subscriptionType=recurring&type=upgradesubscription&version=3.4&signature=602c185d1ab001b84b8e5248b67539aae94aa7fb"

=cut

sub get_upgrade_subscription_URL {
    my ($secret, %params) = @_;
    return generate_URL($FLEXPAY_URL, $secret, 'upgradesubscription', %params);
}


=head2 get_status_URL($secret, %params)

Return URL for status with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_status_URL('mySecret', shopID => '65147', saleID => '1485');

returns

    "https://secure.verotel.com/salestatus?saleID=1485&shopID=65147&version=3&signature=c6f7c22553ba51e6171b34918652cf5099320f77"

=cut

sub get_status_URL {
    my ($secret, %params) = @_;
    return generate_URL($STATUS_URL, $secret, undef, %params);
}


=head2 get_cancel_subscription_URL($secret, %params)

Return URL for cancel subscription with signed parameters (only the parameters listed in the description of get_signature() are considered for signing).

=head3 Example:

    get_cancel_subscription_URL('mySecret', shopID => '65147', saleID => '1485');

returns

    "https://secure.verotel.com/cancel-subscription?saleID=1485&shopID=65147&version=3&signature=c6f7c22553ba51e6171b34918652cf5099320f77"

=cut

sub get_cancel_subscription_URL {
    my ($secret, %params) = @_;
    return generate_URL($CANCEL_URL, $secret, undef, %params);
}


################ PRIVATE METHODS ##########################


sub generate_URL {
    my ($baseURL, $secret, $type, %params) = (@_);

    if (!$secret) {croak "no secret given"};
    if (!%params) {croak "no params given"};

    $params{version} = $PROTOCOL_VERSION;
    if (defined $type) {
        $params{type} = $type;
    }

    # remove empty values:
    my @sorted_params = map { (defined($params{$_}) && $params{$_} ne '')
                            ? ($_ => $params{$_})
                            : ()
                    } sort keys %params;

    my $url         = new URI($baseURL);
    my $signature   = get_signature($secret, @sorted_params);

    $url->query_form(@sorted_params, signature => $signature);

    return $url->as_string();
}

sub signature {
    my ($secret, %params) = @_;
    my @values = map { $_.'='.(defined $params{$_} ? $params{$_} : "") }
                        sort keys %params;
    my $encString = join(":", $secret, @values);
    utf8::encode($encString);

    return lc(sha1_hex($encString));
}

sub filter_params {
    my (%params) = @_;

    my @keys = grep { m/ ^(
                            version
                            | shopID
                            | price(Amount|Currency)
                            | paymentMethod
                            | description
                            | referenceID
                            | saleID
                            | custom[123]
                            | subscriptionType
                            | period
                            | name
                            | trialAmount
                            | trialPeriod
                            | cancelDiscountPercentage
                            | type
                            | backURL
                            | declineURL
                            | precedingSaleID
                            | upgradeOption
                        )$
                    /x } keys %params;

    my %filtered = map { $_ => $params{$_} } @keys;

    return %filtered;
}

1;