constant-share-pool.pl

#!/usr/bin/perl
use strict;
use List::Util qw(min);

our $difficulty; #also equals the mean number of shares per round
our $block_reward=49; #50-2% pool operator fee
our $constant_fraction=0.5; #fraction of mean round shares that equals the number of latest shares that are rewarded upon round end; should be less than 1
our $cache_multiple=10; #how big should the stack be in memory, in multiples of difficulty
our @shares;
our @segments; #time periods of given difficulty
our @users;
our %users;
our $terminal_fund; #money to be distributed to stragler miners if/when the pool is shut down for good

init_pool();
simulate(); #run the simulation for typical usage!

sub init_pool{
    $difficulty=get_difficulty();
}
sub get_difficulty{
    #return `bitcoind getdifficulty`;
    return 434883;
}
sub set_difficulty{
    my @shares_copy=@shares;
    my $segment={difficulty => $difficulty, shares => \@shares_copy, num_shares => scalar @shares_copy};
    push @segments, $segment; #archive current segment, start new segment with new difficulty
    @shares=();
    $difficulty=$_[0];
}
sub push_share{
#use user id numbers instead of user name strings as stack elements, to save on memory
#a stack may contain millions of shares, but there are only thousands of users, so better this way
    my $user_id=$users{$_[0]};
    if (! defined $user_id){
    $user_id=@users;
    push @users, $_[0];
    $users{$_[0]}=$user_id;
    }
    push(@shares, $user_id);
}
sub payout{
#call this each time a block is found and round ends
#returns a hashtable with user's fractional reward
#multiply each fractional reward by block reward, e.g. 49BTC, for 50BTC reward minus 1BTC (2%) pool operator fee
    my %user_shares;
    my $constant_shares=$difficulty*$constant_fraction;
    my $pay_shares=$constant_shares;
    while ($pay_shares>0 && @shares>0){ #first, pay for shares in this round
    $user_shares{pop @shares}++;
    $pay_shares--;
    }
    while ($pay_shares>0 && @segments>0){ #next, if there is any rollover, pay for shares in previous rounds
    my $old_segment=pop @segments;
    my @old_shares=@{$old_segment->{shares}};
    my $old_difficulty=$old_segment->{difficulty};
    while ($pay_shares>0 && @old_shares>0){
        $user_shares{pop @old_shares}+= $difficulty/$old_difficulty;
        $pay_shares-= $difficulty/$old_difficulty;
    }
    if (@old_shares>0){
        $old_segment->{shares}=\@old_shares;
        $old_segment->{num_shares}=@old_shares;
        push @segments, $old_segment;
    }
    }
    if ($pay_shares>0 && $terminal_fund<$block_reward){ #if all shares are paid for but money still remains, store it in the pool terminal fund
    my $terminal_shares=min($pay_shares, $constant_shares*(1-$terminal_fund/$block_reward));
    $terminal_fund+=$terminal_shares/$constant_shares*$block_reward;
    $pay_shares-=$terminal_shares;
    }
    my $shares_distributed=$constant_shares-$pay_shares; #IF the shares stack is exhausted, and IF the fund is full, then just split the money equally
    my %user_payouts;
    foreach (keys %user_shares){
    $user_payouts{$users[$_]}=$user_shares{$_}/$shares_distributed*$block_reward; #block reward includes pool operator fee
    }

    return \%user_payouts;
}
sub terminate_pool{
    my %terminal_payouts=%{payout()};
    foreach (keys %terminal_payouts){
    $terminal_payouts{$_}*=$terminal_fund/$block_reward;
    }
    $terminal_fund=0;
    return \%terminal_payouts;
}
sub cull_cache{
    my $keep_shares=$difficulty*$cache_multiple;
    my $shares_culled=0;
    my $total_shares=@shares;
    if ($keep_shares<$total_shares){
    foreach (@segments){
        $shares_culled+=$_->{num_shares};
    }
    @segments=(); #clear all old shares
    while($keep_shares<$total_shares && @shares>0){
        shift @shares;
        $total_shares--;
        $shares_culled++;
    }
    }
    for (my $i=@segments-1; $i>=0; $i--){
    my $segment=$segments[$i];
    my $difficulty_ratio=$difficulty/$segment->{difficulty};
    $total_shares+=$segment->{num_shares}*$difficulty_ratio;
    if ($keep_shares<$total_shares){
        while ($i>0){
        $total_shares-=$segments[0]->{num_shares}*$difficulty/$segments[0]->{difficulty};
        $shares_culled+=$segments[0]->{num_shares};
        shift @segments;
        $i--;
        }
        my @segment_shares=@{$segment->{shares}};
        while ($keep_shares<$total_shares && @segment_shares>0){
        shift @segment_shares;
        $total_shares-=$difficulty_ratio;
        $shares_culled++;
        }
        $segment->{shares}=\@segment_shares;
        $segment->{num_shares}=@segment_shares;
        if (@segment_shares==0){
        shift @segments;
        }
        last;
    }
    }
    return ($shares_culled, $total_shares);
}


### everything below here is not part of reference implementation ###

sub print_status{
    my %accounts=%{$_[0]};
    my %payouts=%{$_[1]};
    my @sorted_users=sort {$accounts{$b} <=> $accounts{$a}} (keys %accounts);
    my $pack_format="A5AA8AA12AA12A";
    printf "top users:\n";
    printf pack $pack_format,"rank"," ","user"," ","payout"," ","balance","\n";
    for (my $i=0; $i<10; $i++){
    my $user=$sorted_users[$i];
    print pack $pack_format, $i, " ", $user, " ", sprintf("%.8f",$payouts{$user}), " ", sprintf("%.8f",$accounts{$user}), "\n";
    }
}

sub update_accounts{
    my $accounts=$_[0];
    my %rewards=%{$_[1]};
    foreach (keys %rewards){
    $accounts->{$_}=0 if (! defined $accounts->{$_});
    $accounts->{$_}+=$rewards{$_};
    }
}


sub simulate{ #run a simulation of normal pool operation with many users and difficulty changes
    my %accounts;
    my $shares_submitted=0;
    my $time=time;
    my $round_start=$time;
    $|=1;
    $SIG{'INT'}='interrupt';
    while(1){
    for (my $i=0; $i<$difficulty/600/10; $i++){ #a pool with 10% of total network hashing capacity
        my $user="user".(int(rand()*10000)); # ten thousand users
        push_share($user);
        $shares_submitted++;

        if (rand()*$difficulty<1.00){ #found a block!
        my $hours=int(($time-$round_start)/3600);
        my $minutes=int(($time-$round_start-$hours*3600)/60);
        my $hashrate=int($shares_submitted*(2**32)/($time-$round_start)/10**9);
        my $payouts=payout();
        update_accounts(\%accounts, $payouts);
        printf "\r%s\nround finished in %d:%02d hours with shares=%d, hashrate=%dGHash/s, difficulty=%d, terminal fund=%.6f\n", scalar localtime $time, $hours, $minutes, $shares_submitted, $hashrate, $difficulty, $terminal_fund;
        print_status(\%accounts, $payouts);
        my ($num_culled, $total_shares)=cull_cache();
        printf "%d shares culled, %d shares remaining in cache\n\n", $num_culled, $total_shares;
        $shares_submitted=0;
        $round_start=$time;
        }
    }
    if ($time%3600==0){
        printf "\r%s", scalar localtime $time;
    }
    if ($time%(3600*24*2)==0){
        printf "\r%s\nrescaling difficulty to %d\n", scalar localtime $time, $difficulty*1.1;
        set_difficulty($difficulty*1.1); #just as an example
    }
    $time++;
    }
    sub interrupt{
    printf "%s\nterminating pool...\n", scalar localtime $time;
    my $payouts=terminate_pool();
    update_accounts(\%accounts, $payouts);
    print_status(\%accounts, $payouts);
    exit;
    }
}