You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
532 lines
17 KiB
532 lines
17 KiB
package Hush::List;
|
|
use strict;
|
|
use warnings;
|
|
use Hush::RPC;
|
|
use Try::Tiny;
|
|
use File::Spec::Functions;
|
|
use Hush::Util qw/barf is_valid_zaddr/;
|
|
use File::Slurp;
|
|
use Hush::Memo;
|
|
use Hush::Logger qw/debug/;
|
|
use Hush::Contact;
|
|
use Data::Dumper;
|
|
use JSON;
|
|
|
|
my $VERSION = '0.02';
|
|
|
|
=head1 NAME
|
|
|
|
Hush::List - HushList Protocol Reference Implementation
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
HushList
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
# API access
|
|
use Hush::List;
|
|
|
|
# CLI
|
|
hushlist subscribe 'hushlist://SKxqPjNKvcfpmBpR8daQHNj4DoMfKmaPiVcT3A3YPynZNYXoDoaq?height=215683'
|
|
|
|
=head1 AUTHOR
|
|
|
|
Duke Leto <duke@leto.net>
|
|
|
|
=head1 SUPPORT THIS WORK
|
|
|
|
If you would like to support this work, because it helped you out
|
|
and your life is now amazing, feel free to send some donations to
|
|
the developer via the blockchain :
|
|
|
|
HUSH: zcB3LvCwYPdvVmNmTvEFdFGwb4teocrPnVD8wvBgMn8ZKo5Vq9ypJLpAuqUM31hEbBnSHCjCpax5mjUi2HEM6NB8x7vfKrV
|
|
|
|
ZEC: zcZLVdeNHvbw58ch56RWi92ws8hweLHyxhoT6jniFKd8kkBPXPR5E46YXzAqXhrfagtwRojAtumg4M3kmrHfZPU6m63Rj5z
|
|
|
|
|
|
Cryptocoins make the world go round and round.
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2017-2018 by Duke Leto <duke@leto.net>. All rights reserved.
|
|
|
|
=head1 LICENSE AGREEMENT
|
|
|
|
This package is free software; you can redistribute it and/or
|
|
modify it under the GNU Public License Version 3.
|
|
|
|
=cut
|
|
|
|
# as per z_sendmany rpc docs
|
|
my $MAX_RECIPIENTS = 54;
|
|
my $HUSH_CONFIG_DIR = $ENV{HUSH_CONFIG_DIR} || catdir($ENV{HOME},'.hush');
|
|
my $HUSHLIST_CONFIG_DIR = $ENV{HUSH_CONFIG_DIR} || catdir($HUSH_CONFIG_DIR, 'list');
|
|
our $VERSION = 20171031;
|
|
my $rpc = Hush::RPC->new;
|
|
|
|
sub _sanity_checks {
|
|
if (!-e $HUSH_CONFIG_DIR ) {
|
|
barf "Hush config directory $HUSH_CONFIG_DIR not found! You can set the HUSH_CONFIG_DIR environment variable if it is not ~/.hush";
|
|
}
|
|
|
|
my $list_conf = catfile($HUSHLIST_CONFIG_DIR, 'list.conf');
|
|
|
|
if (!-e $HUSHLIST_CONFIG_DIR) {
|
|
print "No Hush List config directory found, creating one...\n";
|
|
if (mkdir $HUSHLIST_CONFIG_DIR) {
|
|
print "Created $HUSHLIST_CONFIG_DIR\n";
|
|
} else {
|
|
barf "Could not create $HUSHLIST_CONFIG_DIR, bailing out";
|
|
}
|
|
create_default_conf($rpc,$list_conf);
|
|
|
|
if (mkdir catdir($HUSHLIST_CONFIG_DIR,'contacts')) {
|
|
print "Created $HUSHLIST_CONFIG_DIR/contacts\n";
|
|
} else {
|
|
barf "Could not create $HUSHLIST_CONFIG_DIR/contacts, bailing out";
|
|
}
|
|
|
|
} else {
|
|
# directory exists, does the conf file?
|
|
if (-e $list_conf) {
|
|
# conf file already exists, DO NOTHING
|
|
debug("detected existing $list_conf");
|
|
} else {
|
|
# no config file found, generate one
|
|
create_default_conf($rpc,$list_conf);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub create_default_conf {
|
|
my ($rpc,$list_conf) = @_;
|
|
|
|
# when we create a brand new conf, we create brand new funding+nym addrs
|
|
my $funding_zaddr = $rpc->z_getnewaddress;
|
|
barf "Unable to create funding zaddr" unless $funding_zaddr;
|
|
|
|
my $pseudonym_taddr = $rpc->getnewaddress;
|
|
barf "Unable to create pseudonym taddr" unless $pseudonym_taddr;
|
|
|
|
debug("setting funding_zaddr=$funding_zaddr, pseudonym_taddr=$pseudonym_taddr");
|
|
|
|
my $time = time;
|
|
# this will overwrite an existing conf!!! should we back up last version?
|
|
open my $fh, ">", $list_conf or barf "Could not write file $list_conf ! : $!";
|
|
print $fh "# hushlist config v$Hush::List::VERSION\n";
|
|
print $fh "funding_zaddr=$funding_zaddr\n";
|
|
print $fh "pseudonym_taddr=$pseudonym_taddr\n";
|
|
print $fh "generated=$time\n";
|
|
close $fh;
|
|
|
|
debug("created new config file $list_conf");
|
|
}
|
|
|
|
sub new {
|
|
my ($rpc,$options) = @_;
|
|
my $hush_list = {};
|
|
|
|
# we only need a single RPC connection
|
|
$hush_list->{rpc} = $rpc;
|
|
$hush_list->{lists} = {};
|
|
|
|
_sanity_checks();
|
|
|
|
return bless $hush_list, 'Hush::List';
|
|
}
|
|
|
|
sub list_members {
|
|
}
|
|
|
|
# show overview of current hushlists
|
|
sub global_status {
|
|
my ($self) = @_;
|
|
my @hushlists = map { -d $_ && $_ } glob catdir($HUSHLIST_CONFIG_DIR,'*');
|
|
print "Hushlists:\n";
|
|
for my $hushlist (@hushlists) {
|
|
my $members_file = catfile($hushlist,'members.txt');
|
|
if (-e $members_file) {
|
|
my @members = read_file($members_file);
|
|
print "\t- $hushlist: " . scalar(@members) . " members \n";
|
|
}
|
|
}
|
|
|
|
print "Hushlist contacts:\n ";
|
|
|
|
# other possibilties: KMD, ZEN, others?
|
|
my @chains = qw/hush tush zec taz/;
|
|
|
|
for my $chain (@chains) {
|
|
my $contacts_file = catdir($HUSHLIST_CONFIG_DIR,"$chain-contacts.txt");
|
|
if (-e $contacts_file) {
|
|
my @contacts = read_file($contacts_file);
|
|
my $uchain = uc($chain);
|
|
print "\t- " . scalar(@contacts) . " $uchain contacts\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub _hushlist_exists {
|
|
my ($name) = @_;
|
|
my $list_dir = catdir($HUSHLIST_CONFIG_DIR,$name);
|
|
return (-e $list_dir) ? 1 : 0;
|
|
}
|
|
|
|
sub exit_unless_hushlist_exists {
|
|
my ($name) = @_;
|
|
if (!_hushlist_exists($name)) {
|
|
print "Hushlist $name does not exist!\n";
|
|
exit(1);
|
|
};
|
|
}
|
|
|
|
# show details about a particular (hushlist,addr) pair
|
|
# NOTE: We assume that we only use one addr per hushlist for
|
|
# maximim metadata privacy, that is what we do, but other/custom software
|
|
# could break that assumption. The user is encouraged to create 2 local
|
|
# hushlists, with the same contacts, but different sending address (perhaps one
|
|
# taddr and one zaddr) if they want to send from multiple addresses
|
|
sub show {
|
|
my ($self,$name) = @_;
|
|
|
|
exit_unless_hushlist_exists($name);
|
|
|
|
my $list_specific_conf = catfile($HUSHLIST_CONFIG_DIR,$name,'list.conf');
|
|
my %list_conf = read_file( $list_specific_conf ) =~ /^(\w+)=(.*)$/mg ;
|
|
#TODO: write out new keys zfrom/tfrom
|
|
my $sending_zaddr = $list_conf{zfrom} || $list_conf{tfrom} || $list_conf{sending_zaddr};
|
|
|
|
# todo: validate
|
|
#barf "Invalid sending_zaddr: '$sending_zaddr' found for Hushlist $name!" unless is_valid_zaddr($sending_zaddr);
|
|
|
|
print "Hushlist: $name\n";
|
|
print "Recents memos:\n";
|
|
# show the last 10 memos with env var over-ride
|
|
my $N = $ENV{HUSHLIST_NUM_MEMOS} || 10;
|
|
|
|
# TODO: detect the last N memos to our zaddr for this list
|
|
# 1) look for xtns to zaddr via RPC
|
|
# 2) any xtns TO this zaddr are Hushlist memos
|
|
# 3) iterate over these and grab memo field (only available locally on the
|
|
# full node which has the xtn, unles txindex=1 on hush full node!)
|
|
#TODO: sometimes you can send from a taddr
|
|
my @memos = find_memos($name, $sending_zaddr);
|
|
|
|
if (@memos) {
|
|
print "Found memos!\n";
|
|
} else {
|
|
print "No memos found!\n";
|
|
}
|
|
}
|
|
|
|
sub find_memos {
|
|
my ($name,$zaddr) = @_;
|
|
|
|
#warn "looking up xtns for $zaddr";
|
|
my @xtns = $rpc->z_listreceivedbyaddress($zaddr);
|
|
|
|
if (@xtns) {
|
|
# TODO: need local shielded balance to get data => need (t,z) xtn
|
|
|
|
my @memos = map { Hush::Memo->new($rpc, $_) } @xtns;
|
|
|
|
# debugging
|
|
for my $xtn (map { $_->[0] } @xtns) {
|
|
#printf "txid=%s memo=%s\n", $xtn->{txid}, $xtn->{memo};
|
|
my $txid = $xtn->{txid};
|
|
my $memo = pack('h*', $xtn->{memo});
|
|
printf "=" x 80;
|
|
print "\n";
|
|
printf <<HEAD;
|
|
Hushlist '$name' Memo
|
|
txid=$txid
|
|
---
|
|
|
|
HEAD
|
|
printf "$memo\n";
|
|
printf "=" x 80;
|
|
print "\n";
|
|
}
|
|
return @memos;
|
|
} else {
|
|
debug("find_memos: No memos found for $name + $zaddr");
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
# show details about a particular hushlist
|
|
sub status {
|
|
my ($self,$name) = @_;
|
|
|
|
exit_unless_hushlist_exists($name);
|
|
|
|
my $list_specific_conf = catfile($HUSHLIST_CONFIG_DIR,$name,'list.conf');
|
|
my %list_conf = read_file( $list_specific_conf ) =~ /^(\w+)=(.*)$/mg ;
|
|
my $member_list = catfile($HUSHLIST_CONFIG_DIR,$name,'members.txt');
|
|
my @members = read_file($member_list);
|
|
my @nicknames = map { m/^[^ ]+(.*)/ } @members;
|
|
my $num_members = @members;
|
|
print "Hushlist '$name' has $num_members members, generated at $list_conf{generated}\n";
|
|
#map { print "\t - $_\n" } @nicknames;
|
|
map { print "\t - $_" } @members;
|
|
}
|
|
|
|
sub new_list {
|
|
my ($self,$name) = @_;
|
|
my $lists = $self->{lists};
|
|
# a list is simply a list of addresses, which can be looked up by name, and maybe some other metadata
|
|
$lists->{$name} = { recipients => {} };
|
|
|
|
my $list_dir = catdir($HUSHLIST_CONFIG_DIR,$name);
|
|
if (!-e $list_dir) {
|
|
# create the config dir for the list for the first time
|
|
mkdir $list_dir;
|
|
if (!-e $list_dir) {
|
|
barf "Could not create directory $list_dir !";
|
|
}
|
|
} else {
|
|
barf "Hushlist $name already exists!";
|
|
}
|
|
my $list_specific_conf = catfile($HUSHLIST_CONFIG_DIR,$name,'list.conf');
|
|
my $member_list = catfile($HUSHLIST_CONFIG_DIR,$name,'members.txt');
|
|
my $time = time;
|
|
my $sending_zaddr = $rpc->z_getnewaddress;
|
|
|
|
{
|
|
open my $fh, '>', $list_specific_conf or barf "Could not open $list_specific_conf for writing";
|
|
print $fh "# hushlist $name config v$Hush::List::VERSION\n";
|
|
# every list has a unique sending zaddr, so there is no metadata leaked
|
|
# across one user sending messages to multiple hushlists
|
|
print $fh "sending_zaddr=$sending_zaddr\n";
|
|
print $fh "generated=$time\n";
|
|
# default chain is hush for now
|
|
# changing the chain of an existing list means that the subset
|
|
# of members that have addresses in the local contact list for the
|
|
# new chain will receive message, or operation aborts if no valid
|
|
# contacts on new chain
|
|
print $fh "chain=hush\n";
|
|
close $fh;
|
|
}
|
|
|
|
{
|
|
open my $fh, '>', $member_list or barf "Could not open $member_list for writing";
|
|
print $fh "";
|
|
close $fh;
|
|
}
|
|
|
|
# We consider members.txt the oracle, so users can simply maintain a simple
|
|
# text file of one item per line, and other files serialized version
|
|
# ~/.hush/list/LIST_NAME/
|
|
# ~/.hush/list/LIST_NAME/list.conf - list-specific config items
|
|
# ~/.hush/list/LIST_NAME/members.txt - list member zaddrs, one per line
|
|
# ~/.hush/list/LIST_NAME/list.json - list data, in JSON
|
|
# ~/.hush/list/LIST_NAME/list.png - user-specified image for list
|
|
return $self;
|
|
}
|
|
|
|
# make a local hushlist PUBLIC by publishing its PRIVKEY
|
|
# to the blockchain via OP_RETURN. This is a ONE WAY PROCESS!!!
|
|
# You can not make a public hushlist private again, it's privkey is in the wild,
|
|
# but we CAN make
|
|
sub public {
|
|
my ($self,$name) = @_;
|
|
}
|
|
|
|
# hushlist://SKxqPjNKvcfpmBpR8daQHNj4DoMfKmaPiVcT3A3YPynZNYXoDoaq?height=215683
|
|
sub subscribe {
|
|
my ($self,@hushlist) = @_;
|
|
my ($chain, $net, $key, $height) = @hushlist;
|
|
#warn Dumper [ @hushlist ];
|
|
|
|
my $rescan = "whenkeyisnew";
|
|
$rpc->z_importkey($key, $rescan, $height + 0);
|
|
print "Successfully subscribed to hushlist://$key !\n";
|
|
return $self;
|
|
}
|
|
|
|
sub add_contact {
|
|
my ($self,$name,$contact) = @_;
|
|
|
|
#TODO validate
|
|
$name ||= '';
|
|
barf "Invalid Hushlist list name!" unless $name;
|
|
|
|
$contact||= '';
|
|
barf "Invalid Hushlist contact=$contact" unless $contact;
|
|
|
|
#barf "Hush list $list does not exist" unless $list;
|
|
|
|
# TODO: does contact exist already?
|
|
my $member_list = catfile($HUSHLIST_CONFIG_DIR,$name,'members.txt');
|
|
open my $fh, '>>', $member_list or barf "Could not open $member_list for writing";
|
|
print $fh $contact . "\n";
|
|
close $fh;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub remove_zaddr {
|
|
my ($self,$name,$zaddr) = @_;
|
|
barf "Invalid zaddr=$zaddr" unless $zaddr;
|
|
|
|
my $lists = $self->{lists};
|
|
my $list = $lists->{$name};
|
|
|
|
barf "Hush list $list does not exist" unless $list;
|
|
|
|
delete $list->{recipients}->{$zaddr};
|
|
|
|
return $self;
|
|
}
|
|
|
|
# send a memo to a Hush List, weeeeee!
|
|
sub send_memo {
|
|
my ($self,$rpc,$name,$memo) = @_;
|
|
|
|
# TODO: better validation
|
|
barf "Invalid Hush list name" unless $name =~ m/^([a-z0-9]+)$/i;
|
|
barf "Hush memo cannot be empty" unless $memo;
|
|
|
|
my $MAX_MEMO = 512;
|
|
my $length = length($memo);
|
|
|
|
barf("Hushlist memo too large! $length > $MAX_MEMO") if ($length > $MAX_MEMO);
|
|
|
|
#my $debug = sub { debug("send_memo: @_") };
|
|
my $debug = sub { warn "send_memo: @_" };
|
|
|
|
# each hush list has a sending_zaddr defined at time of creation
|
|
# which is used to send to this list
|
|
my $list_specific_conf = catfile($HUSHLIST_CONFIG_DIR,$name,'list.conf');
|
|
unless (-e $list_specific_conf) {
|
|
barf "Hushlist config for $name list not found!";
|
|
}
|
|
|
|
my %list_conf = read_file( $list_specific_conf ) =~ /^(\w+)=(.*)$/mg ;
|
|
my $from = $list_conf{zfrom} || $list_conf{tfrom} || $list_conf{sending_zaddr};
|
|
# default should probably be TUSH, but meh...
|
|
my $chain = $list_conf{chain} || 'hush';
|
|
|
|
#barf "Invalid Hushlist chain! $chain" unless $chain =~ m/$(tush|hush)$/i;
|
|
barf "Invalid Hush from address! $from" unless $from;
|
|
|
|
my $list_members_file = catfile($HUSHLIST_CONFIG_DIR,$name,'members.txt');
|
|
unless (-e $list_members_file) {
|
|
barf "No members file found for Hushlist $name!";
|
|
}
|
|
my @list_members = read_file( $list_members_file );
|
|
# we sometimes get a trailing newline, sigh
|
|
chomp @list_members;
|
|
my %list_members = map { $_ => 1 } @list_members;
|
|
#$debug->("list_members=" . join(",",@list_members));
|
|
warn Dumper [ @list_members ];
|
|
|
|
# Now that we have all the list member pseudonyms, look them
|
|
# up in the appropriate chain
|
|
|
|
my $contacts_file = catdir($HUSHLIST_CONFIG_DIR,"$chain-contacts.txt");
|
|
unless (-e $contacts_file) {
|
|
barf "Could not find Hushlist contacts for chain $chain!";
|
|
}
|
|
|
|
# grab all contacts
|
|
# TODO: serialize/make more effiecient/etc
|
|
my %contacts = read_file( $contacts_file ) =~ /^([a-z0-9]+) (.*)$/mgi ;
|
|
$debug->("contacts=" . join(",",keys %contacts));
|
|
# this is the subset of contacts that we are sending to on this hushlist
|
|
# with proper amount/memo keys to appease the z_sendmany gods
|
|
my $list_addrs = { };
|
|
|
|
# This must be a string to make JSON elder gods happy
|
|
my $amount = "0.00"; # amount is hidden in (z,z) xtns, so it does not identify list messages via metadata
|
|
|
|
# override default amount with the amount key in this lists config file
|
|
if ($list_conf{amount}) {
|
|
$amount = $list_conf{amount} . "";
|
|
}
|
|
|
|
my $raw_memo = unpack("h*",$memo); # backend wants hex-encoded memo-field
|
|
$debug->("memo=$memo");
|
|
$debug->("raw_memo=$memo");
|
|
|
|
while (my ($addr, $contact) = each %contacts) {
|
|
print "contact $contact has $addr\n";
|
|
|
|
# if this contact exists on this list, add them to recipient list for z_sendmany
|
|
if ($list_members{$contact}) {
|
|
$debug->("adding $contact => $addr to recipients");
|
|
$list_addrs->{$contact} = {
|
|
address => $addr,
|
|
amount => $amount,
|
|
memo => $raw_memo,
|
|
};
|
|
}
|
|
}
|
|
warn Dumper [ $list_addrs ];
|
|
|
|
barf "Max recipients of $MAX_RECIPIENTS exceeded" if (keys %contacts > $MAX_RECIPIENTS);
|
|
|
|
$debug->("initiating z_sendmany");
|
|
|
|
my $default_fee = 1e-4;
|
|
my $CURR = "HUSH";
|
|
my $fee = defined $ENV{HUSHLIST_FEE} ? sprintf "%.8f", $ENV{HUSHLIST_FEE} : $default_fee;
|
|
my $balance = $rpc->z_gettotalbalance;
|
|
my $zbalance = $balance->{private};
|
|
my $tbalance = $balance->{transparent};
|
|
my $recipients = (keys %$list_addrs);
|
|
|
|
# this is the total cost to send the current Hush
|
|
# transaction to N recipients each with $fee
|
|
my $total_cost = $fee * $recipients;
|
|
$debug->("calculated total_cost=$total_cost $CURR for $recipients recipients");
|
|
|
|
# decide on which balance to look at
|
|
my $available_balance = ($from =~ m/^zc/) ? $zbalance : $tbalance;
|
|
|
|
if ($available_balance < $fee) {
|
|
$debug->("Insufficient balance to pay even one fee=$fee");
|
|
return;
|
|
}elsif ($available_balance < $total_cost) {
|
|
$debug->("Insufficient balance to pay full xtn fee=$total_cost to $recipients recipients with balance=$available_balance");
|
|
return;
|
|
}
|
|
|
|
# z_sendmany
|
|
# Arguments:
|
|
# 1. "fromaddress" (string, required) The taddr or zaddr to send the funds from.
|
|
# 2. "amounts" (array, required) An array of json objects representing the amounts to send.
|
|
# [{
|
|
# "address":address (string, required) The address is a taddr or zaddr
|
|
# "amount":amount (numeric, required) The numeric amount in ZEC is the value
|
|
# "memo":memo (string, optional) If the address is a zaddr, raw data represented in hexadecimal string format
|
|
# }, ... ]
|
|
# 3. minconf (numeric, optional, default=1) Only use funds confirmed at least this many times.
|
|
# 4. fee (numeric, optional, default=0.0001) The fee amount to attach to this transaction.
|
|
|
|
my $minconf = 1;
|
|
my $opid = $rpc->z_sendmany($from, [values $list_addrs], $minconf, $fee);
|
|
|
|
if (defined $opid) {
|
|
$debug->("z_sendmany opid=$opid from $from");
|
|
# omg we got an opid, lets see what is up
|
|
my @opids = ( $opid );
|
|
my $status = $rpc->z_getoperationstatus([@opids]);
|
|
if ($status) {
|
|
$debug->("$opid has status=$status");
|
|
} else {
|
|
$debug->("no status for opid=$opid");
|
|
}
|
|
} else {
|
|
$debug->("z_sendmany failed!");
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub new_taddr {}
|
|
sub new_zaddr {}
|
|
|
|
1;
|
|
|