Crypt-HashCash
view release on metacpan or search on metacpan
lib/Crypt/HashCash/Vault/Bitcoin.pm view on Meta::CPAN
# -*-cperl-*-
#
# Crypt::HashCash::Vault::Bitcoin - Bitcoin Vault for HashCash Digital Cash
# Copyright (c) 2017 Ashish Gulhati <crypt-hashcash at hash.neo.tc>
#
# $Id: lib/Crypt/HashCash/Vault/Bitcoin.pm v1.130 Sat Dec 22 18:42:26 PST 2018 $
package Crypt::HashCash::Vault::Bitcoin;
use 5.008001;
use warnings;
use strict;
use Crypt::HashCash qw (_dec breakamt);
use Crypt::HashCash::Mint;
use Crypt::Random qw(makerandom);
use Digest::MD5 qw(md5_hex);
use Crypt::EECDH;
use Business::Bitcoin;
use Authen::TuringImage;
use vars qw( $VERSION $AUTOLOAD );
our ( $VERSION ) = '$Revision: 1.130 $' =~ /\s+([\d\.]+)/;
sub new {
my ($class, %arg) = @_;
return unless my $bizbtc = new Business::Bitcoin
( DB => $arg{DB} || '/tmp/vault.db',
XPUB => 'xpub661MyMwAqRbcFQ9fsPhf2sW7VmLm3XqSLSGAgDRfR4BuENFerQC9pP7BW5cJG2z15dj9gQ9Zj5rSYMQy7GXMyceympLCW4p3d6195v69TxW',
Path => 'electrum',
Clobber => 0,
Create => 1 );
return unless my $mint = new Crypt::HashCash::Mint ( Create => 1, KeyDB => $arg{KeyDB}, DB => $bizbtc->db );
my @tables = $bizbtc->db->tables('%','%','transactions','TABLE');
unless ($tables[0]) {
return undef unless $bizbtc->db->do('CREATE TABLE transactions (
txid INTEGER PRIMARY KEY AUTOINCREMENT,
type TEXT,
amount INTEGER NOT NULL,
reqid INTEGER UNIQUE,
timestamp INTEGER NOT NULL,
fee INT
);');
}
@tables = $bizbtc->db->tables('%','%','turingtests','TABLE');
unless ($tables[0]) {
return undef unless $bizbtc->db->do('CREATE TABLE turingtests (
turingid INTEGER UNIQUE,
string TEXT
);');
}
@tables = $bizbtc->db->tables('%','%','exchanges','TABLE');
unless ($tables[0]) {
return undef unless $bizbtc->db->do('CREATE TABLE exchanges (
init TEXT UNIQUE,
params TEXT
);');
}
@tables = $bizbtc->db->tables('%','%','withdrawals','TABLE');
unless ($tables[0]) {
return undef unless $bizbtc->db->do('CREATE TABLE withdrawals (
id INTEGER UNIQUE,
key TEXT,
ret TEXT,
sendto TEXT,
sendamt TEXT
);');
}
bless { MINT => $mint,
BIZBTC => $bizbtc,
ELECTRUM => $arg{Electrum} || '/usr/local/bin/electrum',
DEBUG => $arg{Debug} || 0,
}, $class;
}
sub keygen {
my ($self, %arg) = @_;
my $keydb = $self->mint->keydb;
my $keydbpath = $keydb->{__Fn}; return unless $keydbpath =~ s/\/[^\/]+$//;
my $eecdh = new Crypt::EECDH;
my ($spk,$ssk) = $eecdh->signkeygen();
my $vaultid = _dec(uc(md5_hex($spk)));
return unless my $vaultcfg = new Persistence::Object::Simple ('__Fn' => "$keydbpath/$vaultid.cfg");
$self->mint->keygen; $vaultcfg->{pub} = $keydb->{pub};
$keydb->{name} = $vaultcfg->{name} = $arg{Name} || 'localhost';
$keydb->{server} = $vaultcfg->{server} = $arg{Server} || 'localhost';
$keydb->{port} = $vaultcfg->{port} = $arg{Port} || '20203';
$keydb->{sigscheme} = $vaultcfg->{sigscheme} = $self->mint->sigscheme;
my ($pk,$sk) = $eecdh->keygen(PrivateKey => $ssk, PublicKey => $spk);
$keydb->{vaultsigsec} = unpack('H*',$ssk);
$keydb->{vaultsigpub} = $vaultcfg->{vaultsigpub} = unpack('H*',$spk);
$keydb->{vaultsec} = unpack('H*',$sk);
$keydb->{vaultpub} = $vaultcfg->{vaultpub} = unpack('H*',$pk);
$keydb->{id} = $vaultcfg->{id} = "$vaultid";
$keydb->{fees} = $vaultcfg->{fees} = $arg{Fees};
$keydb->commit; $vaultcfg->commit;
}
sub turingimg {
my $self = shift;
my $turing = new Authen::TuringImage; my ($img, $string) = $turing->challenge;
my $turingid = makerandom( Size => 32, Strength => 0 );
$self->_diag("INSERT INTO turingtests values ('$turingid', '$string');");
unless ($self->bizbtc->db->do("INSERT INTO turingtests values ($turingid, '$string');")) {
$self->_diag("INSERT INTO turingtests values ('$turingid', '$string');");
# TODO: log an error and tx details
}
return ($turingid, $img);
}
sub predeposit {
my ($self, %arg) = @_;
my $query = "SELECT string from turingtests WHERE turingid='$arg{TuringID}';";
return '-ENOTURING' unless my ($string) = $self->bizbtc->db->selectrow_array($query);
$self->bizbtc->db->do("DELETE FROM turingtests WHERE turingid='$arg{TuringID}';");
return '-ETURINGMISMATCH' unless $string eq $arg{TuringString};
my $btcreq = $self->bizbtc->request(Amount => $arg{Amount});
return $btcreq->address;
}
sub initdeposit {
my ($self, %arg) = @_;
return '-ENOADDRESS' unless $arg{Address};
return '-EADDRESS' unless my $btcreq = $self->bizbtc->findreq(Address => $arg{Address});
return '-EVERIFY' unless ($arg{Offline} ? $btcreq->verify_serial : $btcreq->verify);
my @inits;
for (1..$arg{NumCoins}) {
push (@inits, $self->mint->init);
}
return \@inits;
}
sub deposit {
my ($self, %arg) = @_;
return '-ENOADDRESS' unless $arg{Address};
my $reqs = $arg{Requests};
my ($total, $btcreq, $fee, @coins);
for (@$reqs) {
$total += $_->d;
}
unless ($arg{Change}) {
return '-EADDRESS' unless $btcreq = $self->bizbtc->findreq(Address => $arg{Address});
return '-EPROCESSED' if $btcreq->status and $btcreq->status eq 'processed'; # This payment has already been processed
$btcreq->status('unverified'), $btcreq->processed(time), $btcreq->commit,
return '-EVERIFY' unless ($arg{Offline} ? $btcreq->verify_serial : $btcreq->verify);
$fee = $self->fee_mf * scalar @$reqs + int($total * $self->fee_mp);
$btcreq->status('mismatched'), $btcreq->processed(time), $btcreq->commit, return '-EMISMATCH'
unless $total + $fee == $btcreq->amount;
}
for (@$reqs) {
push @coins, $self->mint->mint_coin($_);
}
unless ($arg{Change}) {
$btcreq->status('processed'); $btcreq->processed(time); $btcreq->commit;
unless ($self->bizbtc->db->do("INSERT INTO transactions values (NULL, 'd', '" . $btcreq->amount . "', " .
$btcreq->id . ', ' . time . ", $fee);")) {
$self->_diag("INSERT INTO transactions values (NULL, 'd', '" . $btcreq->amount . "', " .
$btcreq->id . ', ' . time . ", $fee);");
# TODO: log an error and tx details
}
}
return \@coins;
}
sub initexchange {
my ($self, %arg) = @_;
my ($numcoins, $amt, $numreqs, $reqamt, $numreplaced, $replacedamt, $numchange, $changeamt, $feecointotal);
for (keys %{$arg{ExchangeDenoms}}) { $amt += $_ * $arg{ExchangeDenoms}->{$_}; $numcoins += $arg{ExchangeDenoms}->{$_} }
for (keys %{$arg{ReqDenoms}}) { $reqamt += $_ * $arg{ReqDenoms}->{$_}; $numreqs += $arg{ReqDenoms}->{$_} }
for (keys %{$arg{ReplacedDenoms}}) { $replacedamt += $_ * $arg{ReplacedDenoms}->{$_}; $numreplaced += $arg{ReplacedDenoms}->{$_} }
for (keys %{$arg{ChangeDenoms}}) { $numchange += $arg{ChangeDenoms}->{$_}; $changeamt += $_ * $arg{ChangeDenoms}->{$_} }
for (@{$arg{FeeCoins}}) { $feecointotal += $_->d }
# Check that sent fee is correct for ExchangeDenoms being changed to ReqDenoms + ReplacedDenoms
lib/Crypt/HashCash/Vault/Bitcoin.pm view on Meta::CPAN
unless ($self->bizbtc->db->do("DELETE FROM exchanges WHERE init='$reqs->[0]->{Init}';")) {
# TODO: log the error
}
unless ($self->bizbtc->db->do("INSERT INTO transactions values (NULL, 'e', '$cointotal', NULL, " . time . ", $fee);")) {
$self->_diag("INSERT INTO transactions values (NULL, 'e', '$cointotal', NULL, " . time . ", $fee);");
# TODO: log an error and tx details
}
return \@coins;
}
sub withdraw {
my ($self, %arg) = @_;
my $coins = $arg{Coins};
my $reqs = $arg{Requests} if defined $arg{Requests};
my ($reqtotal, $cointotal, $coinsspent, $ret) = (0, 0, 0);
for (@$reqs) {
$reqtotal += $_->d;
}
for (@$coins) {
$cointotal += $_->d;
}
return '-ECHANGEREQS' unless $reqtotal == $arg{Change};
my $fee = $self->fee_mf * (scalar @$reqs) + $self->fee_vf * (scalar @$coins) +
int($reqtotal * $self->fee_mp) + int($cointotal * $self->fee_vp);
return '-ECOINAMT' unless $cointotal == $arg{Amount} + $reqtotal + $fee;
my @spentcoins;
for (@$coins) {
if ($self->mint->spend_coin($_)) {
$coinsspent += $_->d;
push (@spentcoins, $_);
}
else { # Spend error, roll back entire transaction
for (@spentcoins) {
$self->mint->unspend_coin($_);
}
last;
}
}
return '-ECOINSPEND' unless $coinsspent == $cointotal;
$self->_diag("Sending $arg{Amount} Satoshi to BTC address $arg{Address}\n");
if ($arg{Change}) { # TODO: Handle error if unable to mint coins
$ret = $self->deposit( Requests => $arg{Requests}, Change => 1 )
}
else {
$ret = 'OK';
}
unless ($self->bizbtc->db->do("INSERT INTO transactions values (NULL, 'w', '$cointotal', NULL, " . time . ", $fee);")) {
$self->_diag("INSERT INTO transactions values (NULL, 'e', '$cointotal', NULL, " . time . ", $fee);");
# TODO: log an error and tx details
}
return $ret;
}
sub process_request { # Hande a request from a client
my ($self, $ret, $preret, $sendto, $sendamt) = (shift);
$_ = shift; my $offline = shift;
if (/^ping$/) { # Ping
$ret = 'pong';
}
elsif (/^hi$/) { # Handshake to begin Deposit ( BTC > [#] ) - Send Turing Image
my ($turingid, $turingimg) = $self->turingimg;
$ret = $turingid . ' ' . (unpack 'H*',$turingimg->png);
}
elsif (/^dt (\d+)$/) {
$ret = $self->predeposit(TuringID => $1, TuringString => '');
}
elsif (/^id (\d+) (\S+) (\d+) (\d+)$/) { # Pre-Init Deposit ( BTC > [#] ) - Check Turing string, send BTC address
$ret = $self->predeposit(TuringID => $1, TuringString => $2, Amount => $3, NumCoins => $4);
}
elsif (/^id (\S+) (\d+) (\d+)$/) { # Initialise Deposit - Check deposit, send init vectors
if (my $inits = $self->initdeposit(Address => $1, Amount => $2, NumCoins => $3, Offline => $offline)) {
$ret = $inits =~ /^-E/ ? $inits : "@$inits";
}
else {
$ret = '';
}
}
elsif (/^ie (\S+) (\S+) (\S+) (\S+) (.+)$/) { # Initialize Exchange ( [#] > [#] )
my $inits = $self->initexchange( ExchangeDenoms => { split /[,:]/, $1 },
ReqDenoms => { split /[,:]/, $2 },
ChangeDenoms => { split /[,:]/, $3 },
ReplacedDenoms => { split /[,:]/, $4 },
FeeCoins => [ map { Crypt::HashCash::Coin->from_string($_) } split / /,$5 ],
);
$ret = ref $inits eq 'ARRAY' ? "@$inits" : $inits;
}
elsif (/^d (\S+) (.+)$/) { # Deposit ( BTC > [#] )
if (my $bcoins = $self->deposit( Address => $1,
Offline => $offline,
Requests => [ map { Crypt::HashCash::CoinRequest->from_string($_) } split / /,$2 ])) {
if ($bcoins =~ /^-E/) {
$ret = $bcoins;
}
else {
my @bcoins = map { $_->as_string } @$bcoins;
$ret = "@bcoins";
}
}
else {
$ret = '';
}
}
elsif (/^w (\S+) (\d+) (\d+) (\S+) (.+) d (.+)$/) { # Withdraw ( [#] > BTC ), with change request(s)
my $bcoins = $self->withdraw(Address => $1, Amount => $2, BTCFee => $3, Change => -$4,
Coins => [ map { Crypt::HashCash::Coin->from_string($_) } split / /,$5 ],
Requests => [ map { Crypt::HashCash::CoinRequest->from_string($_) } split / /,$6 ]);
my @bcoins = map { $_->as_string } @$bcoins;
$preret = "ep $1 $2 $3"; $sendto = $1; $sendamt = $2;
$ret = "@bcoins";
}
elsif (/^w (\S+) (\d+) (\d+) (\S+) (.+)$/) { # Withdraw ( [#] > BTC ), no change request(s)
my $r = $self->withdraw(Address => $1, Amount => $2, BTCFee => $3, Change => $4,
Coins => [ map { Crypt::HashCash::Coin->from_string($_) } split / /,$5 ]);
if ($r eq 'OK') {
if ($offline) { # Save payment details for processing by online machine
$preret = "ep $1 $2 $3"; $sendto = $1; $sendamt = $2; $ret ='OK';
}
else {
$sendto = $1;
$sendamt = sprintf("%f",$2 / 100000000); my $feeamt = sprintf("%f",$3 / 100000000);
my $electrum = $self->electrum;
my $balance = `$electrum getbalance`;
( run in 0.710 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )