Nxt Forum

Please login or register.

Login with username, password and session length
Advanced search  

News:

Latest Nxt Client 1.11.9 - NEW RELEASE: Ardor 2.0.3e TestNet IS LAUNCHED! - The Ignis ICO is currently ongoing!!

Pages: [1]

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

ifinta

  • Jr. Member
  • **
  • Offline Offline
  • Posts: 77
    • View Profile
  • Karma: +18/-0
Perl script to reward of voting...
October 11, 2015, 10:03:05 pm

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

Code: [Select]
#!/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 :)
« Last Edit: October 13, 2015, 01:44:24 pm by ifinta »

Riker

  • Core Dev
  • Hero Member
  • *****
  • Offline Offline
  • Posts: 1715
    • View Profile
  • Karma: +430/-42
Re: Perl script to reward of voting...
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.
NXT Core Dev
Account: NXT-HBFW-X8TE-WXPW-DZFAG
Public Key: D8311651 Key fingerprint: 0560 443B 035C EE08 0EC0  D2DD 275E 94A7 D831 1651

ifinta

  • Jr. Member
  • **
  • Offline Offline
  • Posts: 77
    • View Profile
  • Karma: +18/-0
Re: Perl script to reward of voting...
October 12, 2015, 08:09:25 am

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

Thank you for review and comment.

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.

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.

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

  • Jr. Member
  • **
  • Offline Offline
  • Posts: 77
    • View Profile
  • Karma: +18/-0
Re: Perl script to reward of voting...
October 12, 2015, 02:13:03 pm

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

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

  • Core Dev
  • Hero Member
  • *****
  • Offline Offline
  • Posts: 1715
    • View Profile
  • Karma: +430/-42
Re: Perl script to reward of voting...
October 12, 2015, 02:20:07 pm

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

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.
NXT Core Dev
Account: NXT-HBFW-X8TE-WXPW-DZFAG
Public Key: D8311651 Key fingerprint: 0560 443B 035C EE08 0EC0  D2DD 275E 94A7 D831 1651

Jean-Luc

  • Core Dev
  • Hero Member
  • *****
  • Offline Offline
  • Posts: 1610
    • View Profile
  • Karma: +816/-81
Re: Perl script to reward of voting...
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.
GPG key fingerprint: 263A 9EB0 29CF C77A 3D06  FD13 811D 6940 E1E4 240C
NXT-X4LF-9A4G-WN9Z-2R322

ifinta

  • Jr. Member
  • **
  • Offline Offline
  • Posts: 77
    • View Profile
  • Karma: +18/-0
Re: Perl script to reward of voting...
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

  • Jr. Member
  • **
  • Offline Offline
  • Posts: 77
    • View Profile
  • Karma: +18/-0
Re: Perl script to reward of voting...
October 12, 2015, 08:10:47 pm

Implemented.
The first post was corrected.

ifinta

  • Jr. Member
  • **
  • Offline Offline
  • Posts: 77
    • View Profile
  • Karma: +18/-0
Re: Perl script to reward of voting...
October 13, 2015, 01:45:29 pm

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

Nextshares

  • Full Member
  • ***
  • Offline Offline
  • Posts: 152
    • View Profile
  • Karma: +6/-1
Re: Perl script to reward of voting...
June 10, 2016, 05:15:34 pm

Like your script.
Pages: [1]