forked from onryo/siona
Extremely Private HUSH and HAC explorer
https://explorer.hush.is
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.
414 lines
14 KiB
414 lines
14 KiB
#!/usr/bin/env perl
|
|
use strict;
|
|
use warnings;
|
|
use JSON::Any;
|
|
use Data::Dumper;
|
|
use Redis;
|
|
use 5.014;
|
|
my $STATS = {};
|
|
$|=1;
|
|
|
|
my $TX = {};
|
|
my $r = Redis->new;
|
|
my $j = JSON::Any->new;
|
|
|
|
#sleep 10;
|
|
|
|
# While Siona swims, we pave with bricks on the road she will run on...
|
|
my $acname = $ENV{SIONA_ACNAME} || 'HUSH';
|
|
my $ticker = $acname eq 'HUSH3' ? 'HUSH' : $acname;
|
|
my $domain = $ENV{SIONA_DOMAIN} || 'explorer.hush.land';
|
|
my $root = "/var/www/$domain";
|
|
my $basedir = "/var/www/$domain/var/www/$domain";
|
|
my $dir = shift || "$basedir/api";
|
|
my $cli = $ENV{SIONA_CLI} || "/home/hush/git/hush3/src/hush-cli";
|
|
my $getinfo = readfile("$dir/getinfo.json");
|
|
my $mining = readfile("$dir/getmininginfo.json");
|
|
my $blocksdir = "$basedir/blocks";
|
|
my $template = readfile("$blocksdir/template.html");
|
|
if($getinfo =~ m/"blocks": (\d+)/){ $STATS->{BLOCKS} ||= $1; }
|
|
if($getinfo =~ m/"tls_connections": (\d+)/){ $STATS->{TLS_CONNECTIONS} ||= $1; }
|
|
if($getinfo =~ m/"connections": (\d+)/){ $STATS->{CONNECTIONS} ||= $1; }
|
|
if($getinfo =~ m/"protocolversion": (\d+)/){ $STATS->{PROTOCOLVERSION} ||= $1; }
|
|
|
|
my @symbols = qw/
|
|
TX_TABLE BLOCKS_TABLE TLS_CONNECTIONS CONNECTIONS PROTOCOLVERSION
|
|
/;
|
|
my @blocks = ();
|
|
my $height = $STATS->{BLOCKS} || 0;
|
|
$STATS->{BLOCKS_TABLE} = "";
|
|
$STATS->{TX_TABLE} = "";
|
|
|
|
my $mineraddress = "";
|
|
for my $h ($height-80 .. $height) {
|
|
#for my $h (910265 .. 910270) {
|
|
#last if($h < 0);
|
|
my $thisminer = "";
|
|
# TODO: actually look at the block reward for this height via
|
|
# the tx data from the very first txid in this block
|
|
my $reward = $h > 340000 ? "3.125 $ticker" : "12.5 $ticker";
|
|
my $block = get_block($h);
|
|
#die Dumper $block;
|
|
my $time = $block->{time};
|
|
die Dumper [ $block ] unless $block->{time} and $block->{tx};
|
|
my @txs = @{ $block->{tx} };
|
|
my $numtx = @txs;
|
|
# TODO: look on filesystem first? redis cache?
|
|
my $hash = qx!$cli getblockhash $h!;
|
|
chomp $hash;
|
|
|
|
my $blockdir = "$root/var/www/$domain/block/$hash";
|
|
if (!-e "$root/block/$h") {
|
|
# make /block/HEIGHT work
|
|
my $cmd = "ln -s $blockdir $root/var/www/$domain/block/$h";
|
|
qx{$cmd};
|
|
warn $cmd;
|
|
}
|
|
if (!-d $blockdir) {
|
|
# so explorer.hush.is/block/HASH works
|
|
my $cmd = "mkdir -p $blockdir";
|
|
qx{$cmd};
|
|
warn $cmd;
|
|
my $block_template_file = "$basedir/block/template.html";
|
|
my $new_block_file = "$blockdir/index.html";
|
|
# TODO: process template with block details
|
|
my $block_template = readfile($block_template_file);
|
|
$block_template =~ s/#BLOCKS#/$h/g;
|
|
$block_template =~ s/#BLOCKHASH#/$hash/g;
|
|
$block_template =~ s/#PREVIOUSBLOCKHASH#/$block->{previousblockhash}/ge;
|
|
$block_template =~ s/#BLOCKTIME#/$time/g;
|
|
$block_template =~ s/#ANCHOR#/$block->{anchor}/ge;
|
|
$block_template =~ s/#VERSION#/$block->{version}/ge;
|
|
$block_template =~ s/#BITS#/$block->{bits}/ge;
|
|
$block_template =~ s/#BLOCKSIZE#/$block->{size}/ge;
|
|
$block_template =~ s/#CHAINWORK#/$block->{chainwork}/ge;
|
|
$block_template =~ s/#MERKLEROOT#/$block->{merkleroot}/ge;
|
|
$block_template =~ s/#FINALSAPLINGROOT#/$block->{finalsaplingroot}/ge;
|
|
# TODO: fix block reward
|
|
my $blockreward = "3.125 $ticker";
|
|
$block_template =~ s/#BLOCKREWARD#/$blockreward/g;
|
|
$block_template =~ s/#BLOCKNONCE#/$block->{nonce}/ge;
|
|
$block_template =~ s/#DIFFICULTY#/$block->{difficulty}/ge;
|
|
$block_template =~ s/#NUM_TXS#/$numtx/g;
|
|
|
|
my $txtype = "";
|
|
# generate tx list table
|
|
$STATS->{TX_TABLE}=<<HTML;
|
|
|
|
|
|
HTML
|
|
|
|
my $txi = 0;
|
|
for my $tx (@txs) {
|
|
my $json = qx!$cli getrawtransaction $tx 1!;
|
|
# "vout": 0,
|
|
# "address": "RBHHGTQoULWb8gPD6Nj4fix6ov46hzzQMj",
|
|
# address is duplicated in the JSON of getrawtransaction !! fuck.
|
|
# KMD or ZEC upstream bug?
|
|
$json =~ s/"vout": 0,\w*"address": "([a-z0-9]+)",/"vout": 0,/mg;
|
|
|
|
# Satoshi Forgive Me
|
|
$json =~ s/"address":\w+"([a-z0-9]+)"(.+)"address":\w+"\g1"(.+)/"address": "$1"$2/mg;
|
|
|
|
warn "decoding tx=$tx"; # with json=$json";
|
|
# add tx json to Redis, indexed by txid
|
|
$r->set("tx:$tx", $json);
|
|
|
|
my $j = JSON::Any->new;
|
|
my $o;
|
|
eval {
|
|
$o = $j->decode($json);
|
|
};
|
|
next if $@;
|
|
|
|
$TX->{$tx} = $o;
|
|
my $tx_dir = "$root/var/www/$domain/tx/$tx";
|
|
my $tx_file = "$root/var/www/$domain/tx/$tx/index.html";
|
|
my $tx_template_file = "$root/var/www/$domain/tx/template.html";
|
|
my $tx_template = readfile($tx_template_file);
|
|
my $txtime = localtime($o->{time});
|
|
#my $txsize = $o->{size} . " bytes";
|
|
$tx_template =~ s/#TXID#/$tx/ge;
|
|
$tx_template =~ s/#TXTIME#/$txtime/ge;
|
|
#$tx_template =~ s/#TXSIZE#/$txsize/g;
|
|
$tx_template =~ s/#BLOCKHEIGHT#/$h/ge;
|
|
$tx_template =~ s/#BLOCKHASH#/$hash/ge;
|
|
my ($vin,$vout,$zin,$zout) = ($o->{vin},$o->{vout},$o->{vShieldedSpend},$o->{vShieldedOutput});
|
|
my $expiryheight = $o->{expiryheight} == 0 ? "Default" : $o->{expiryheight};
|
|
my $locktime = localtime($o->{locktime});
|
|
my $valueBalance = $o->{valueBalance} || "?";
|
|
my $valueBalanceSecond = $o->{valueBalance};
|
|
my $valueBalanceThird = abs($valueBalanceSecond);
|
|
# "vShieldedOutput": [
|
|
# {
|
|
# "cv": "61e0fed3b97e08e442408c7efc4058a9116695e6e28a22c0fbf0987fdfbcdd27",
|
|
# "cmu": "25245041af3bbc5a03da1cd6d60665f7659cbb3bab1080a6e003f856d45998fc",
|
|
# "ephemeralKey": "bffefb4f55679610bbdbd43bfba64308842348ba70bb999fad00c67356eab998",
|
|
# "encCiphertext": "b685c9d4f6164102999e88e3e30fcca37d9c402fc72533185d495a9d64f1fca277ead03aefe960eeaf102c0c92686a75c792ae8662f40601287ff19635581279d9c9940ba3c29af36166620422c6
|
|
#49c4a7ca938734ceecb93a3abc8753ff3535950662ef46d8ed3a0608a61c65be5d0bdb1c262bd63fde759040eef74d4d81619ee154bbabe4fc0e27d82b19c6ed0d4cd806d5bc75ebbb13370ff3f19979ab3b74e859d9b88d3802
|
|
#bc7a2ce7ae4305c6beec2146b374bda7234395d0aa390337e69ef5d04eddef0087244292f358b46eeb3c2a5a6d3bd1c89aaa4ebfd8bab58d2d4771b1d106db1a5dcead3b09cfc9fc38b972ce98c53d3cd658b02e58b087c7c73e
|
|
#0bd7cb093f2b15ab397094be5bc98f5865045d1845e548249fc811545db1645beb2f044366ba9ae584074e6fa5c03d786757c88ed8eff2d81570d15e64f192707d7393ce40b0f2f767cfbeaa5f05a634fe527da982241c92c4c2
|
|
#9642f633115d34fe6791f00c8867e2242485de5f0bb87a8d4e6b375f557db6968f5ecc4f07b838b2dd85dd54e4e9ae2a28e9305bd1a6ae71adf75335d5f44cc046194fdbc91fb80202f06af9431716dc6627b2aa4723b0b8e4bb
|
|
#504649b6350ba9f020106d71248227ed8d7a10e2fbcbf64824c8923149822970b3c574614a8c32602106132c1209917974566b2990cf106666f985a2fa1f1409efdc457404700da210906b0f19be61c70d70eddc2f1cbffd94bb
|
|
#4c154a332fdd345ad06bd2ac86a339a93eae25db5eb3b4c6090d8483a8e5dd642231d17f3011b2f4b629ef72c08df1eeb6e7d06e",
|
|
# "outCiphertext": "53e3865f52101faf3218b60b7d58b9c426dc7c6cff009a8ceddd58031afe9802cae0f423a1085c2b36c776db29b57db8041e9bac42d6b445a0d69eb5a2f0ef61b4790595a68750c60889ff811dce
|
|
#8fbb",
|
|
# "proof": "82eda0f7de0936f6ca8208e63bda8db9970feb232ae64635e5bea67f16fdbe1b5e5e3a6bb7b7d2f0127c0d17de494834a82e899e8eecdfc71a59de8d1808a53df2989762bd54a855dadc535f2c5107d7b6da
|
|
#a732153c4dda4ac965be79ba2ecc030bd58e4c05d5ac7be283b3dc68af8a39231a31cccb54eae65c676760182bd22965f2e1c3685de44c0b93d84519bf138c7942222795dfdd0f683474b7c75221c9355109258805cc038ca43b
|
|
#26d5770bf25882326f4f508731b36a8632bc0012"
|
|
# }
|
|
# ],
|
|
|
|
my $vins = @$vin;
|
|
my $vouts = @$vout;
|
|
my $zins = @$zin;
|
|
my $zouts = @$zout;
|
|
my $coinbase = $vin->[0] ? $vin->[0]->{coinbase}." with sequence ".$vin->[0]->{sequence} : "False"; #($vin->[0] && $vin->[0]->{coinbase}) ? $vin->[0]{coinbase} . " with sequence " . $vin->{sequence} : "False";
|
|
|
|
# coinbase does not count as a transparent input
|
|
$vins-- if ($vin->[0] && $vin->[0]->{coinbase});
|
|
|
|
my $tx_data =<<DATA;
|
|
<tr>
|
|
<td style="font-size: 14px; width: 50%">Coinbase: $coinbase</td>
|
|
<td style="font-size: 14px; width: 50%">Locktime: $locktime</td>
|
|
</tr>
|
|
</table>
|
|
<table>
|
|
<tr>
|
|
<td style="font-size: 14px; width: 50%">Transparent Inputs: $vins </td>
|
|
<td style="font-size: 14px; width: 50%">Transparent Outputs: $vouts </td>
|
|
</tr>
|
|
<tr>
|
|
<td style="font-size: 14px; width: 50%">Shielded Inputs: $zins </td>
|
|
<td style="font-size: 14px; width: 50%">Shielded Outputs: $zouts </td>
|
|
</tr>
|
|
DATA
|
|
$tx_template =~ s/#TX_DATA#/$tx_data/g;
|
|
|
|
my $cmd = "mkdir -p $tx_dir";
|
|
warn $cmd;
|
|
## create tx dir + page
|
|
qx{$cmd};
|
|
|
|
open(my $fh, '>', $tx_file) or die "$tx_file: $!";
|
|
print $fh $tx_template;
|
|
close $fh or die $!;
|
|
|
|
## create tx view on block page
|
|
my $from = $o->{vin}->[0] ? $o->{vin}->[0]->{address} : "zs1???";
|
|
#my $to = $o->{vout}->[0] ? $o->{vout}->[0]->{scriptPubKey}->{addresses}->[0] : "zs1???";
|
|
my $to2 = "";
|
|
my $to3 = "";
|
|
# only look at coinbase tx's
|
|
if($txi == 0) {
|
|
# LEXICAL SCOPING BUG, MAN!
|
|
$mineraddress = $o->{vout}->[0] ? $o->{vout}->[0]->{scriptPubKey}->{addresses}->[0] : "";
|
|
$thisminer = $mineraddress;
|
|
}
|
|
# say "<!-- miner for $tx is $mineraddress -->";
|
|
my $to = $mineraddress ? $mineraddress : "zs1???";
|
|
if($o->{vout}->[1]) {
|
|
$to2 = $o->{vout}->[1]->{scriptPubKey}->{addresses}->[0];
|
|
}
|
|
if($o->{vout}->[0]) {
|
|
$to3 = $o->{vout}->[0]->{scriptPubKey}->{addresses}->[0];
|
|
}
|
|
$valueBalance = ($o->{vout}->[0]->{value} || 0) + ($o->{vout}->[1]->{value} || 0);
|
|
$valueBalance ||= "?";
|
|
$from ||= "";
|
|
|
|
$txtype = "Mining";
|
|
if($zins+$zouts>0) {
|
|
$txtype = "Shielded";
|
|
if($zins==0 && $zouts>0) { $txtype = "Shielding"; }
|
|
if($vins==0 && $vouts==1 && $zins==1 && $zouts==8){ $txtype = "Notary" }
|
|
if($vins==1 && $vouts==14 && $zins==0 && $zouts==0){ $txtype = "dPoW" }
|
|
if($vins==0 && $vouts==0){ $txtype = "Fully Shielded" }
|
|
# this is prevented by consensus rule on HUSH mainnet
|
|
# but if we see it, ring the bell, lulz
|
|
if($zins>0 && $zouts==0) { $txtype = "De-Shielding!"; }
|
|
}
|
|
#if($vouts>0) { $txtype = "DPoW"; }
|
|
my $stuff;
|
|
|
|
if ($txtype eq "Mining") {
|
|
$stuff =<<STUFF;
|
|
|
|
=> $to (miner)
|
|
<br>
|
|
=> $to2 (FR address)
|
|
STUFF
|
|
} elsif ($txtype eq "Shielding") {
|
|
$stuff =<<STUFF;
|
|
|
|
$from ($valueBalanceThird $ticker) => zs1??? (shielding)
|
|
|
|
STUFF
|
|
} elsif ($txtype eq "Notary") {
|
|
$stuff =<<STUFF;
|
|
|
|
zs1??? => $to3 (notary)
|
|
<br>
|
|
zs1??? => zs1??? (shielded change)
|
|
|
|
STUFF
|
|
} elsif ($txtype eq "dPoW") {
|
|
$stuff =<<STUFF;
|
|
|
|
=> $to2 (FR address)
|
|
<br>
|
|
=> $to2 (notary)
|
|
|
|
STUFF
|
|
} else {
|
|
$stuff =<<STUFF;
|
|
|
|
$from => zs1??? (fully shielded)
|
|
|
|
STUFF
|
|
}
|
|
|
|
my $tx_table = <<HTML;
|
|
<table>
|
|
<tr>
|
|
<td style="font-size: 14px"><a href="/tx/$tx" class="mainlinkexplorer">$tx</a></td>
|
|
<td style="font-size: 14px">vins: $vins, vouts: $vouts</td>
|
|
<td style="font-size: 14px">zins: $zins, zouts: $zouts</td>
|
|
</tr>
|
|
<tr>
|
|
<td style="font-size: 14px">$stuff</td>
|
|
<td style="font-size: 14px">$txtime</td>
|
|
<td style="font-size: 14px">$valueBalance $ticker</td>
|
|
</tr>
|
|
</table>
|
|
HTML
|
|
$STATS->{TX_TABLE} .= $tx_table;
|
|
$txi++;
|
|
}
|
|
|
|
# $STATS->{TX_TABLE} .= "</table>";
|
|
# $STATS->{TX_TABLE} .= "<pre>" . Dumper [ $vin ];''
|
|
|
|
$block_template =~ s/#TX_TABLE#/$STATS->{TX_TABLE}/ge;
|
|
|
|
# > ?
|
|
open(my $fh, '>>', $new_block_file) or die "$new_block_file: $!";
|
|
print $fh $block_template;
|
|
close $fh or die $!;
|
|
warn "wrote to $new_block_file ";
|
|
} else {
|
|
warn "block exists on disk, looking info up";
|
|
#TODO: error-checking for corrupt data
|
|
#warn Dumper $block;
|
|
my $lookuptx = $block->{tx}->[0];
|
|
my $o = get_raw($lookuptx);
|
|
$thisminer = $o->{vout}->[0]->{scriptPubKey}->{addresses}->[0];
|
|
warn "thisminer=$thisminer";
|
|
}
|
|
|
|
my $blockduration = 0;
|
|
if($#blocks >= 0) {
|
|
$blockduration = $time - $blocks[$#blocks]->[3];
|
|
}
|
|
# give data to blocks after we have processed everything
|
|
my $b = [ $h, $hash, $reward,$time,$numtx,$thisminer, $blockduration ];
|
|
#warn Dumper $b;
|
|
push @blocks, $b;
|
|
;
|
|
}
|
|
|
|
sub get_raw {
|
|
my $tx = shift;
|
|
my $cmd = "$cli getrawtransaction $tx 1";
|
|
warn $cmd;
|
|
my $json = qx!$cmd!;
|
|
# "vout": 0,
|
|
# "address": "RBHHGTQoULWb8gPD6Nj4fix6ov46hzzQMj",
|
|
# address is duplicated in the JSON of getrawtransaction !! fuck.
|
|
# KMD or ZEC upstream bug?
|
|
$json =~ s/"vout": 0,\w*"address": "([a-z0-9]+)",/"vout": 0,/mg;
|
|
# Satoshi Forgive Me
|
|
$json =~ s/"address":\w+"([a-z0-9]+)"(.+)"address":\w+"\g1"(.+)/"address": "$1"$2/mg;
|
|
warn "decoding tx=$tx"; # with json=$json";
|
|
my $j = JSON::Any->new;
|
|
my $o = $j->decode($json);
|
|
return $o;
|
|
}
|
|
|
|
# render data
|
|
for my $b (reverse @blocks) {
|
|
my ($height,$hash,$reward,$time,$txs,$miner,$duration) = @$b;
|
|
|
|
$time = localtime($time);
|
|
|
|
# we can't calc the duration of the first block we look at, yet
|
|
$duration = "--" unless $duration;
|
|
|
|
$STATS->{BLOCKS_TABLE} .= <<"FUCK";
|
|
<table>
|
|
<tr>
|
|
<td style="font-size: 14px"><a href="/block/$height/" class="mainlinkexplorer">$height</a></td>
|
|
<td style="font-size: 14px"><a href="/block/$hash/" class="mainlinkexplorer">$hash</a></td>
|
|
<td style="font-size: 14px">$time</td>
|
|
</tr>
|
|
<tr>
|
|
<td style="font-size: 14px">${duration}s</td>
|
|
<td style="font-size: 14px">$miner + $reward</td>
|
|
<td style="font-size: 14px">Transactions: $txs</td>
|
|
</tr>
|
|
</table>
|
|
FUCK
|
|
}
|
|
|
|
|
|
|
|
for my $s (@symbols) {
|
|
if($s && $STATS->{$s}) { $template =~ s/#$s#/$STATS->{$s}/ge }
|
|
}
|
|
|
|
# derived stat
|
|
#my $zpct = sprintf "%.3f", $STATS->{SUPPLY} > 0 ? 100*($STATS->{ZFUNDS}/$STATS->{SUPPLY}) : "0.000";
|
|
#$template =~ s/#ZFUNDS_PERCENT#/$zpct/ge;
|
|
|
|
say $template;
|
|
|
|
###### functions
|
|
|
|
# get block at given height
|
|
sub get_block {
|
|
my $height = shift;
|
|
return if $height < 0;
|
|
my $block = $r->get("block:$height") || '';
|
|
|
|
# create data if it's not there
|
|
if( $block =~ m/^HASH/ || length($block) == 0 ) {
|
|
my $cmd = "$cli getblock $height";
|
|
warn $cmd;
|
|
$block = qx/$cmd/;
|
|
}
|
|
my $json = $block;
|
|
if($json) {
|
|
$block = $j->decode($json);
|
|
# cache in Redis
|
|
warn Dumper [ "redis set block:$height =>", $json ];
|
|
$r->set("block:$height",$json);
|
|
} else {
|
|
warn "empty block $height!!" unless $json;
|
|
warn Dumper [$json];
|
|
}
|
|
|
|
return $block;
|
|
}
|
|
|
|
sub readfile {
|
|
my $file = shift;
|
|
my $data = "";
|
|
open(my $fh, '<', $file) or die "$file: $!";
|
|
my $txlist = 0;
|
|
while(<$fh>){
|
|
$data.=$_
|
|
}
|
|
close($fh);
|
|
return $data;
|
|
}
|
|
|