# -*-cperl-*-
#
# Business::Bitcoin::Request - Bitcoin payment request
# Copyright (c) 2016-2017 Ashish Gulhati <biz-btc at hash dot neomailbox.ch>
#
# $Id: lib/Business/Bitcoin/Request.pm v1.036 Sun Apr  2 10:12:41 PDT 2017 $

use warnings;
use strict;

package Business::Bitcoin::Request;

use DBI;
use LWP::UserAgent;
use HTTP::Request;
use Math::EllipticCurve::Prime;
use Math::EllipticCurve::Prime::Point;
use Digest::SHA qw(sha256 sha256_hex hmac_sha512_hex);
use Encode::Base58::BigInt;
use Crypt::RIPEMD160;

use vars qw( $VERSION $AUTOLOAD );

our ( $VERSION ) = '$Revision: 1.036 $' =~ /\s+([\d\.]+)/;

sub new {
  my ($class, %args) = @_;
  return undef if $args{Amount} !~ /^\d+$/; return undef if $args{StartIndex} and $args{StartIndex} =~ /\D/;
  my $db = $args{_BizBTC}->db; my $xpub = $args{_BizBTC}->xpub;
  my $timestamp = time;
  my $index = defined $args{StartIndex} ? $args{StartIndex} : 'NULL';
  my $refid = defined $args{Reference} ? "'$args{Reference}'" : 'NULL';
  return undef unless $db->do("INSERT INTO requests values ($index, '$args{Amount}', NULL, $refid, '$timestamp', NULL, NULL);");
  $index = $db->last_insert_id('%', '%', 'requests', 'reqid');
  $ENV{PATH} = undef;
  return undef unless my $address = _getaddress($args{_BizBTC}->xpub, $index);
  my $rows = $db->do("UPDATE requests set address='$address' where reqid='$index';");
  bless { Address => $address,
	  ID => $index,
	  Amount => $args{Amount},
	  DB => $db,
	  Reference => $args{Reference},
	  Confirmations => defined $args{Confirmations} ? $args{Confirmations} : 5,
	  Created => $timestamp }, $class;
}

sub verify {
  my $self = shift;
  my $ua = new LWP::UserAgent;
  my $req = HTTP::Request->new(GET => 'https://blockchain.info/q/addressbalance/' . $self->address . '?confirmations=' . $self->confirmations);
  my $res = $ua->request($req);
  $res->content == $self->amount;
}

sub _find {
  my ($class, %args) = @_;
  return unless defined $args{Address} or defined $args{Reference};
  return if defined $args{Address} and defined $args{Reference};
  return unless defined $args{_BizBTC} and $args{_BizBTC}->db->ping;

  my $query = 'SELECT reqid,address,amount,refid,created,processed,status from requests WHERE ' .
    (defined $args{Address} ? "address='$args{Address}';" : "refid='$args{Reference}';");
  my ($reqid, $address, $amount, $refid, $created, $processed, $status) = $args{_BizBTC}->db->selectrow_array($query);
  bless { Address => $address,
	  Amount => $amount,
	  Reference => $refid,
	  ID => $reqid,
	  DB => $args{_BizBTC}->db,,
	  Confirmations => defined $args{Confirmations} ? $args{Confirmations} : 5,
	  Created => $created,
	  Processed => $processed,
	  Status => $status
	}, $class;
}

sub commit {
  my $self = shift;
  my $processed = $self->processed;
  my $status = $self->status;
  my @updates;
  push @updates, "processed = '" . $processed . "'" if $processed;
  push @updates, "status = '" . $status . "'" if $status;
  return 1 unless my $updates = join ',',@updates;
  return undef unless $self->db->do("UPDATE requests SET $updates;");
  return 1;
}

sub _getaddress {
  my ($xpub, $index) = @_;
  my $curve = Math::EllipticCurve::Prime->from_name('secp256k1');
  my $xpubdata =  Math::BigInt->new(_decode58($xpub))->as_hex;
  $xpubdata =~ /.(.{8})(..)(.{8})(.{8})(.{64})(.{66})(.*)/;
  my ($ver, $depth, $fp, $i, $c, $Kc) = ($1, $2, $3, $4, $5, $6);
  my $K = Math::EllipticCurve::Prime::Point->from_hex(_decompress($Kc));
  # m/0
  my ($Ki, $ci) = _CKDpub($K, $c, 0);
  # m/0/$index
  my ($Ki2, $ci2) = _CKDpub($Ki, $ci, $index);
  return _address(_compress($Ki2));
}

sub _CKDpub {
  my ($K, $c, $i) = @_;
  my $curve = Math::EllipticCurve::Prime->from_name('secp256k1');
  my $data = pack('H*', _compress($K)) . pack ('L>', $i);
  my $hmac = hmac_sha512_hex($data, pack('H*', $c)); $hmac =~ /(.{64})(.{64})/;
  my ($Il, $ci) = ($1, $2);
  my $Ki = $curve->g->multiply(Math::BigInt->from_hex($Il))->add($K);
  return ($Ki, $ci);
}

sub _address {
  my $sha256 = sha256(pack('H*', shift));
  my $id = '00' . Crypt::RIPEMD160->hexhash($sha256); $id =~ s/\s//g;
  my $checksum = substr(sha256_hex(sha256(pack('H*', $id))), 0, 8);
  return '1' . _encode58(Math::BigInt->from_hex($id . $checksum));
}

sub _decompress {
  my $Kc = shift; $Kc =~ /^(..)(.*)/;
  my $i = $1; my $K = '04' . '0' x (64 - length($2)) . $2; my $x = Math::BigInt->from_hex($2);
  my $curve = Math::EllipticCurve::Prime->from_name('secp256k1');
  my ($p, $a, $b) = ($curve->p, $curve->a, $curve->b);
  my $y = ($x->bmodpow(3,$p)+$a*$x+$b)->bmodpow(($p+1)/4,$p);
  $y = $p - $y if $i%2 ne $y%2;
  my $yhex = $y->as_hex; $yhex =~ s/^0x//;
  $K .= '0' x (64 - length($yhex)) . $yhex;
  return $K;
}

sub _compress {
  my $K = shift;
  my $Kc = $K->x->as_hex; $Kc =~ s/^0x//;
  $Kc = ($K->y % 2 ? '03' : '02') . $Kc;
}

sub _decode58 {
  my $todecode = shift;
  $todecode =~ tr/A-HJ-NP-Za-km-z/a-km-zA-HJ-NP-Z/;
  my $decoded = decode_base58($todecode);
}

sub _encode58 {
  my $encoded = encode_base58(shift);
  $encoded =~ tr/a-km-zA-HJ-NP-Z/A-HJ-NP-Za-km-z/;
  return $encoded;
}

sub AUTOLOAD {
  my $self = shift; (my $auto = $AUTOLOAD) =~ s/.*:://;
  return if $auto eq 'DESTROY';
  if ($auto =~ /^(confirmations|processed|status)$/x and defined $_[0]) {
    $self->{"\u$auto"} = shift;
  }
  if ($auto =~ /^(reqid|amount|address|reference|version|created|confirmations|processed|status)$/x) {
    return $self->{"\u$auto"};
  }
  if ($auto =~ /^(db|id)$/x) {
    return $self->{"\U$auto"};
  }
  else {
    die "Could not AUTOLOAD method $auto.";
  }
}

1; # End of Business::Bitcoin::Request

=head1 NAME

Business::Bitcoin::Request - Bitcoin payment request

=head1 VERSION

 $Revision: 1.036 $
 $Date: Sun Apr  2 10:12:41 PDT 2017 $

=head1 SYNOPSIS

Business::Bitcoin::Request objects represent Bitcoin payment requests
generated by Business::Bitcoin.

    use Business::Bitcoin;

    my $bizbtc = new Business::Bitcoin (DB => '/tmp/bizbtc.db',
                                        XPUB => 'xpub...');

    my $request = $bizbtc->request(Amount => 4200);

    print ($request->verify ? "Verified\n" : "Verification failed\n");

=head1 METHODS

=head2 new

Not intended to be called directly. Business::Bitcoin::Request objects
should be created by calling the request method on a Business::Bitcoin
object.

=head2 commit

Commit the Request object to the requests database. Only the
'processed' and 'status' fields are updated in the database.

=head2 verify

Verify that the request has been paid. Returns true if the request has
been paid, false otherwise. The number of confirmations required to
consider a payment valid can be set via the confirmations accessor.

=head1 ACCESSORS

Accessors can be called with no arguments to query the value of an
object property, or with a single argument, to set the property to a
specific value (unless the property is read only).

=head2 confirmations

The number of confirmations needed to consider a payment valid.

=head2 amount

The amount of the payment request, in Satoshi. Read only.

=head2 address

The Bitcoin receiving address for the payment request. Read only.

=head2 created

The timestamp of when the request was created. Stored as an int in the
requests database. Read only.

=head2 reference

An optional reference ID for the request, to facilitate integration
with existing order systems. Stored as a text field in the requests
database. Read only.

=head2 processed

An optional property for applications to record the timestamp of when
the transaction was processed. Stored as an int in the requests
database. Read/write.

=head2 status

An optional property that can be used to record the status of the
transaction ('processed', 'shipped', 'refunded', etc.). Stored as a
text field in the requests database. Read/write.

=head2 version

The version number of this module. Read only.

=head1 AUTHOR

Ashish Gulhati, C<< <biz-btc at hash dot neomailbox.ch> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-business-bitcoin at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Business-Bitcoin>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Business::Bitcoin::Request

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Business-Bitcoin>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Business-Bitcoin>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Business-Bitcoin>

=item * Search CPAN

L<http://search.cpan.org/dist/Business-Bitcoin/>

=back

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2016-2017 Ashish Gulhati.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.
