Topic: Perl script to reward of voting... (Read 10326 times)

ifinta · « **on:** October 11, 2015, 10:03:05 pm »

GIT repository: https://github.com/ifinta/rewardPollVotes

#!/usr/bin/perl -w

use strict;
use JSON -support_by_pp;
use JSON::RPC::Client;
use warnings;
use LWP::Simple;
use LWP::UserAgent;
use Data::Dumper;
use Term::ReadKey;
use Scalar::Util qw(looks_like_number);

$| = 1;

my $port = '7876';

my $lwp = LWP::UserAgent->new;
$lwp->agent("perl $]");
my $json = new JSON;

my $client = new JSON::RPC::Client;

print 'Poll id?:';
my $poll = <STDIN>;
chomp($poll);

my $pollinfo = getPoll($poll);

print 'Account RS?:';
my $account = <STDIN>;
chomp($account);

ReadMode ('noecho');
print 'Account secret phrase?:';
my $secret = <STDIN>;
chomp($secret);
print "\n";
ReadMode ('restore');

print 'Asset id (for NXT type "NXT")?:';
my $asset = <STDIN>;
chomp($asset);

my $assetinfo = getAsset($asset);

print 'Amount?:';
my $menge = <STDIN>;
chomp($menge);

print 'How much confirmation of vote do you suggest till reward? (Enter a number - max. 720 - or press enter for not checking it):';
my $confirmations = <STDIN>;
chomp($confirmations);

if(looks_like_number($confirmations) && $confirmations > 720)
{
	$confirmations = 720;
}

my $mengeqnt;

print "\n\n\n";
print 'Poll :'.$pollinfo->{name}."\n";
print 'Account RS :'.$account."\n";
if($asset eq 'NXT')
{
	print 'Transmitting '.$menge." NXT pro vote...\n";
	$mengeqnt = (10**8)*$menge;
	print "amount in NQT:".$mengeqnt."\n";
}
else
{
	print 'Transmitting '.$menge.' '.$assetinfo->{name}." pro vote...\n";
	$mengeqnt = (10**($assetinfo->{decimals}))*$menge;
	print "amount in QNT:".$mengeqnt."\n";
}

if(looks_like_number($confirmations))
{
	print 'Rewards will be sent only after '.$confirmations." confirmation of vote.\n" ;	
}
else
{
	print "Rewards will be sent as soon as possible after voting. Confirmations of vote will be not checked.\n";
}

print "\nOk?[Y/n]:";
my $feedback = <STDIN>;
chomp($feedback);

die 'Aborted...' unless $feedback eq '' || $feedback eq 'Y' || $feedback eq 'y' || $feedback eq 'yes';

while (1) {
  doit();
  if($pollinfo->{finished})
  {
	print "The poll has been finished...\n";
	exit(0);
  }
  sleep(30);
  $pollinfo = getPoll($poll);
}

sub doit
{
  eval{
	my $pollvotes = getPollVotes($poll);

	#print Dumper($pollvotes);

	# first: get unconfirmed txs. 
	# second: get confirmed txs.
	# so there is no lost transactions, perhaps doubling...
	my $unconftxs = getAllUnconfTx($account);

	#print Dumper($unconftxs);

	my $transactions = getAllTxWithMessage($account);

	#print Dumper($transactions);

	my @voters = getVotersWithoutReward($transactions, $unconftxs, $pollvotes);
	my $voter;

	foreach $voter (@voters) 
	{
		my $sendresp = sendReward($voter, $mengeqnt, 'Thank you for voting... (Poll:'.$poll.'; '.$pollinfo->{name}.')');
		print $voter." - reward sent...\n";
		#print Dumper($sendresp);
	}
  };
  # catch crashes:
  if($@){
    print " ERR $@\n";
  }
}

sub getJSON {
        my ($raw) = shift;

        my $res = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($raw->content);

        return $res;
};

sub getPollVotes {
	my ($pl) = shift;
        my $req = HTTP::Request->new(GET => 'http://localhost:'.$port.'/nxt?requestType=getPollVotes&includeWeights=true&poll='.$pl);
        my $res = $lwp->request($req);

        my $json_res = getJSON($res);

	return $json_res;
};

sub getPoll {
	my ($pl) = shift;
        my $req = HTTP::Request->new(GET => 'http://localhost:'.$port.'/nxt?requestType=getPoll&poll='.$pl);
        my $res = $lwp->request($req);

        my $json_res = getJSON($res);

	return $json_res;
};

sub getAsset {
	my ($ast) = shift;
        my $req = HTTP::Request->new(GET => 'http://localhost:'.$port.'/nxt?requestType=getAsset&asset='.$ast);
        my $res = $lwp->request($req);

        my $json_res = getJSON($res);

	return $json_res;
};

sub getAllTxWithMessage {
	my ($acc) = shift;
        my $req = HTTP::Request->new(GET => 'http://localhost:'.$port.'/nxt?requestType=getBlockchainTransactions&withMessage=true&account='.$acc);
        my $res = $lwp->request($req);

        my $json_res = getJSON($res);

	return $json_res;
};

sub getAllUnconfTx {
	my ($acc) = shift;
        my $req = HTTP::Request->new(GET => 'http://localhost:'.$port.'/nxt?requestType=getUnconfirmedTransactions&account='.$acc);
        my $res = $lwp->request($req);

        my $json_res = getJSON($res);

	return $json_res;
};

sub sendReward {
        my ($rec, $men, $msg) = @_;

        my $req = HTTP::Request->new(POST => 'http://localhost:'.$port.'/nxt');
        $req->content_type('application/x-www-form-urlencoded');

	if($asset eq 'NXT')
	{
        	$req->content("requestType=sendMoney&recipient=".$rec."&message=".$msg."&messageIsPrunable=true&amountNQT=".$men."&secretPhrase=".$secret."&feeNQT=100000000&deadline=1440");
	}
	else
	{
        	$req->content("requestType=transferAsset&recipient=".$rec."&asset=".$asset."&message=".$msg."&messageIsPrunable=true&quantityQNT=".$men."&secretPhrase=".$secret."&feeNQT=100000000&deadline=1440");
	}

        my $res = $lwp->request($req);

	#print Dumper($res);

        die "Request failed!" unless $res->is_success;

        my $json_res = getJSON($res);

	#print Dumper($json_res);

        return $json_res;
};

sub getVotersWithoutReward {
	my ($txs, $utxs, $plvts) = @_;
	
	my @allvtrs = getAllVoters($plvts);
	my @alltxsr = getAllTxsRecipient($txs, $utxs);

	my %in_alltxsr = map {$_ => 1} @alltxsr;
	my @vts  = grep {not $in_alltxsr{$_}} @allvtrs;	

	return @vts;
}

sub getTransaction {
	my ($id) = shift;
        my $req = HTTP::Request->new(GET => 'http://localhost:'.$port.'/nxt?requestType=getTransaction&transaction='.$id);
        my $res = $lwp->request($req);

        my $json_res = getJSON($res);

	return $json_res;
}

sub checkTransaction {
	my ($tx) = shift;
	my $res = 1;

	if(looks_like_number($confirmations) && $tx->{confirmations} < $confirmations)
	{
		$res = 0;
	}

	return $res;
}

sub checkVote {
	my ($vt) = shift;
	my $res = 0;

	#print Dumper($vt);

	if($pollinfo->{finished})
	{
		$res = 1;
	}
	else
	{
		my $wg = $vt->{weight};	
		my $tx = getTransaction($vt->{transaction});
	
		#print Dumper($tx);

		if(defined $wg)
		{
			if($wg > 0)
			{
				$res = checkTransaction($tx);
			}
		}

		# "old" transactionen filtern (I hope - it was rewarded soon)
		my $con = looks_like_number($confirmations) ? $confirmations : 0;
		my $txcon = $tx->{confirmations};
		if((!defined $txcon) || $txcon > $con + 720)
		{
			$res = 0;
		}		
	}

	return $res;
}

sub getAllVoters {
	my ($vtrs) = shift;
	my $vtr;
	my @res;

	my $tmp = $vtrs->{votes};

	foreach $vtr (@$tmp)
	{
		if(checkVote($vtr))
		{
			push(@res, $vtr->{voterRS});
		}
	}

	return @res;
}

sub getAllRecipients {
	my ($tmp, $res) = @_;
	my $tx;

	foreach $tx (@$tmp)
	{
		my $msg = $tx->{attachment}->{message};

		if(defined $msg && $msg =~ /.*Poll:(.*); / && ($1 eq $poll))
		{
			push(@{$res}, $tx->{recipientRS});
		}
	}
}

sub getAllTxsRecipient {
	my ($txsr, $utxsr) = @_;
	my @res;

	my $tmp = $txsr->{transactions};
	getAllRecipients($tmp, \@res);
	
	$tmp = $utxsr->{unconfirmedTransactions};
	getAllRecipients($tmp, \@res);

	# do not reward the vote of poll creator and rewarding account...
	push(@res, $account);
	push(@res, $pollinfo->{accountRS});

	return @res;
}

Usage:
- Check the code.
- Install perl with modules needed.
- Start script.
- Type inputs (Poll ID, Rewarding account RS, Rewarding account secret phrase, NXT or asset ID, Amount, Minimum confirmations = n).
- Check the values.
- Press enter if you want to continue...

If somebody voting (after n, maximum 720 confirmations) the reward will be sent...

Example (I restarted it...):

Code: [Select]

ifinta@debian-imx6:~$ ./rewardPollVotes 
Poll id?:13744876112647352488
Account RS?:NXT-7MYJ-SUQ8-H782-DPHZ9
Account secret phrase?:
Asset id (for NXT type "NXT")?:649027262925057466
Amount?:0.01
How much confirmation of vote do you suggest till reward? (Enter a number - max. 720 - or press enter for not checking it):



Poll :Family budget in a month.
Account RS :NXT-7MYJ-SUQ8-H782-DPHZ9
Transmitting 0.01 FamilyFund pro vote...
amount in QNT:100
Rewards will be sent as soon as possible after voting. Confirmations of vote will be not checked.

Ok?[Y/n]:
NXT-WJYE-LXZQ-7LAQ-GHCNJ - reward sent...

This example just running online - You can try it

Riker · « **Reply #1 on:** October 12, 2015, 06:42:39 am »

Nice work. Very impressed by how simple it is to interface with NXT from Perl.

Regarding the implementation, if I understand correctly you intend to rely on a message attachments to the reward payment in order to determine which voter was already rewarded and prevent "double rewarding", this is problematic since messages are prunable, they will disappear after two weeks. Only the hash is left. You can still check the hash though.
I also think you don't need to worry about unconfirmed transactions. They will get confirmed eventually and then you'll reward them.

Why don't you just require that the poll is finished before sending the reward ? This way you don't have to worry about all this and if someone likes they can reward the voters multiple times since the list of voters is already complete at this time.

ifinta · « **Reply #2 on:** October 12, 2015, 08:09:25 am »

Quote from: lyaffe on October 12, 2015, 06:42:39 am

Nice work. Very impressed by how simple it is to interface with NXT from Perl.

Thank you for review and comment.

Quote from: lyaffe on October 12, 2015, 06:42:39 am

Regarding the implementation, if I understand correctly you intend to rely on a message attachments to the reward payment in order to determine which voter was already rewarded and prevent "double rewarding", this is problematic since messages are prunable, they will disappear after two weeks. Only the hash is left. You can still check the hash though.

Yes, I try to rely on prunable messages - this is a bug. It is simple to correct because the script sends this messages. Not prunable messages will then costs plus 1 NXT pro reward, if I right understand the API.

Quote from: lyaffe on October 12, 2015, 06:42:39 am

I also think you don't need to worry about unconfirmed transactions. They will get confirmed eventually and then you'll reward them.

I read this article - https://wiki.nxtcrypto.org/wiki/How-To:Automate_Nxt_for_your_website - and it suggests waiting for 720 confirmations for safety. At start users will be asked by script about number of confirmations.

Quote from: lyaffe on October 12, 2015, 06:42:39 am

Why don't you just require that the poll is finished before sending the reward ? This way you don't have to worry about all this and if someone likes they can reward the voters multiple times since the list of voters is already complete at this time.

I will send the reward as soon as possible - it is better for a voter. You are right - after finish poll it is more simple send the reward. Maybe it should be a script-start-question too.

I correct the script, and refresh my first first post. I will post again it if I corrected.

ifinta · « **Reply #3 on:** October 12, 2015, 02:13:03 pm »

Nonetheless it was not a bug. The script sends not prunable messages. See the quote below.

Quote from: Jean-Luc on June 07, 2015, 11:42:28 pm

Quote from: jl777 on June 07, 2015, 08:17:01 pm
what is the size limit for "message" attachment that wont get pruned?
The limit for non-prunable messages has not changed, it is still 1000 bytes. Messages are pruned not based on size, but only if they have been created as prunable, i.e. messageIsPrunable=true parameter has been added. For prunable, the limit is 42 kbytes.

For 1.6 we should either reduce the size limit for non-prunable, or make them more expensive, to encourage the use of prunable messages instead.

Changes:
- I added an input for number of confirmations.
- Script exits after finish of poll.
- messageIsPrunable=false is explicite in API call yet. (but it is the default...)

Riker · « **Reply #4 on:** October 12, 2015, 02:20:07 pm »

Quote from: ifinta on October 12, 2015, 02:13:03 pm

Nonetheless it was not a bug. The script sends not prunable messages. See the quote below.

Quote from: Jean-Luc on June 07, 2015, 11:42:28 pm
Quote from: jl777 on June 07, 2015, 08:17:01 pm
what is the size limit for "message" attachment that wont get pruned?
The limit for non-prunable messages has not changed, it is still 1000 bytes. Messages are pruned not based on size, but only if they have been created as prunable, i.e. messageIsPrunable=true parameter has been added. For prunable, the limit is 42 kbytes.

For 1.6 we should either reduce the size limit for non-prunable, or make them more expensive, to encourage the use of prunable messages instead.

Changes:
- I added an input for number of confirmations.
- Script exits after finish of poll.
- messageIsPrunable=false is explicite in API call yet. (but it is the default...)

As a best practice, don't misuse messages to spam the blockchain since even if it doesn't cost fees now, rest assured it will cost fees in the future. Store only what you really need, for example remove the "Thank you for voting..." prefix.

Jean-Luc · « **Reply #5 on:** October 12, 2015, 03:51:15 pm »

About prunable vs non-prunable messages, the rule of thumb should be to make non-prunable only data that will still be needed by every single node (not just the one on which your script is running), for more than 2 weeks. Now that we have 1.6 nodes running, with the archival feature enabled, you can assume your node can retrieved expired prunable data from the archival nodes even after longer than 2 weeks, you just can't assume other nodes will be willing to do that.

Even the core in 1.7 uses prunable parts for data that are no longer needed after certain time, for example in shuffling. All encrypted data that shuffle participants exchange with each other is actually prunable, because it can only be decrypted by its intended recipient, and is not needed after the shuffle is complete. It would be a waste to force every node to permanently store this encrypted shuffling data. And a shuffle completion is guaranteed to take less than 2 weeks.

ifinta · « **Reply #6 on:** October 12, 2015, 05:59:23 pm »

Thanks for your reviews and comments.
I understood the use of non prunable messages here is an unnecessary load for the blockchain.
Here is my new plan:

I think my script will be used in two different ways:
A.) continuously from start of the poll.
B.) one run after the poll finish.

In case A: I will use prunable messages, and do not reward very old transactions. (I hope - it was rewarded soon)
In case B: only one run - prunable messages are no problem.

I will implement it, then I will refresh my first post.

ifinta · « **Reply #7 on:** October 12, 2015, 08:10:47 pm »

Implemented.
The first post was corrected.

ifinta · « **Reply #8 on:** October 13, 2015, 01:45:29 pm »

GIT repository added... ( https://github.com/ifinta/rewardPollVotes )

Nextshares · « **Reply #9 on:** June 10, 2016, 05:15:34 pm »

Like your script.

Switch to ArdorForum

News:

Author Topic: Perl script to reward of voting... (Read 10326 times)

ifinta

Perl script to reward of voting...

Riker

Re: Perl script to reward of voting...

ifinta

Re: Perl script to reward of voting...

ifinta

Re: Perl script to reward of voting...

Riker

Re: Perl script to reward of voting...

Jean-Luc

Re: Perl script to reward of voting...

ifinta

Re: Perl script to reward of voting...

ifinta

Re: Perl script to reward of voting...

ifinta

Re: Perl script to reward of voting...

Nextshares

Re: Perl script to reward of voting...