Skip to content

Commit 435cab9

Browse files
bbrtjbbrtj
committed
Add taproot merkle root util function, include in address generation
1 parent 95f0f1b commit 435cab9

File tree

5 files changed

+153
-45
lines changed

5 files changed

+153
-45
lines changed

‎Changes

+1
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ Revision history for Perl extension Bitcoin::Crypto.
33
{{$NEXT}}
44
[Added interface]
55
- Bitcoin::Crypto::Util::merkle_root function
6+
- Bitcoin::Crypto::Util::taproot_merkle_root function
67
- Bitcoin::Crypto::Util::tagged_hash function
78

89
3.001 Tue Sep 24, 2024

‎lib/Bitcoin/Crypto/Key/Public.pm

+13-8
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ use Bitcoin::Crypto::Base58 qw(encode_base58check);
1313
use Bitcoin::Crypto::Bech32 qw(encode_segwit);
1414
use Bitcoin::Crypto::Types -types;
1515
use Bitcoin::Crypto::Constants;
16-
use Bitcoin::Crypto::Util qw(hash160 get_public_key_compressed);
16+
use Bitcoin::Crypto::Util qw(hash160 get_public_key_compressed taproot_merkle_root);
1717
use Bitcoin::Crypto::Helpers qw(ecc);
1818

1919
use namespace::clean;
@@ -65,7 +65,7 @@ sub from_serialized
6565

6666
signature_for witness_program => (
6767
method => Object,
68-
positional => [PositiveOrZeroInt, {default => 0}],
68+
positional => [PositiveOrZeroInt, {default => 0}, HashRef, {default => sub { {} }}],
6969
);
7070

7171
sub witness_program
@@ -75,11 +75,12 @@ sub witness_program
7575
return shift->get_hash;
7676
},
7777
(Bitcoin::Crypto::Constants::taproot_witness_version) => sub {
78-
return shift->taproot_tweaked_key;
78+
my ($self, $params) = @_;
79+
return shift->taproot_tweaked_key(%$params);
7980
},
8081
};
8182

82-
my ($self, $version) = @_;
83+
my ($self, $version, $source_data) = @_;
8384

8485
Bitcoin::Crypto::Exception::SegwitProgram->raise(
8586
"can't get witness program data for version $version"
@@ -88,7 +89,7 @@ sub witness_program
8889
my $program = Bitcoin::Crypto::Script->new(network => $self->network);
8990
$program
9091
->add_operation("OP_$version")
91-
->push_bytes($data_sources->{$version}->($self));
92+
->push_bytes($data_sources->{$version}->($self, $source_data));
9293

9394
return $program;
9495
}
@@ -154,12 +155,12 @@ sub get_segwit_address
154155

155156
signature_for get_taproot_address => (
156157
method => Object,
157-
positional => [],
158+
positional => [Maybe [ArrayRef], {default => undef}],
158159
);
159160

160161
sub get_taproot_address
161162
{
162-
my ($self) = @_;
163+
my ($self, $script_tree) = @_;
163164

164165
# network field is not required, lazy check for completeness
165166
Bitcoin::Crypto::Exception::NetworkConfig->raise(
@@ -170,7 +171,11 @@ sub get_taproot_address
170171
'taproot addresses can only be created with BIP44 in taproot (BIP86) mode'
171172
) unless $self->has_purpose(Bitcoin::Crypto::Constants::bip44_taproot_purpose);
172173

173-
my $taproot_program = $self->witness_program(Bitcoin::Crypto::Constants::taproot_witness_version);
174+
my $taproot_program = $self->witness_program(
175+
Bitcoin::Crypto::Constants::taproot_witness_version,
176+
defined $script_tree ? {tweak_suffix => taproot_merkle_root($script_tree)} : {}
177+
);
178+
174179
return encode_segwit($self->network->segwit_hrp, $taproot_program->run->stack_serialized);
175180
}
176181

‎lib/Bitcoin/Crypto/Util.pm

+91-1
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ our @EXPORT_OK = qw(
3636
hash160
3737
hash256
3838
merkle_root
39+
taproot_merkle_root
3940
tagged_hash
4041
);
4142

@@ -425,6 +426,58 @@ sub merkle_root
425426
return $parts[0];
426427
}
427428

429+
# nested ArrayRef will be validated during recursive calls
430+
signature_for taproot_merkle_root => (
431+
positional => [ArrayRef [ArrayRef | HashRef]],
432+
);
433+
434+
sub taproot_merkle_root
435+
{
436+
my ($script_tree) = @_;
437+
438+
my @result;
439+
foreach my $item (@$script_tree) {
440+
if (ref $item eq 'ARRAY') {
441+
442+
# this value is the next level of the tree
443+
push @result, taproot_merkle_root($item);
444+
}
445+
else {
446+
state $precomputed_type = Dict [hash => ByteStr];
447+
state $leaf_type = Dict [leaf_version => IntMaxBits [8], script => BitcoinScript];
448+
449+
# this value is a leaf which may need calculating
450+
my $value = $precomputed_type->coerce($item);
451+
if (!$precomputed_type->check($value)) {
452+
$value = $leaf_type->assert_coerce($item);
453+
my $script = $value->{script}->to_serialized;
454+
my $script_len = pack_compactsize(length $script);
455+
456+
$value->{hash} =
457+
tagged_hash('TapLeaf', join '', pack('C', $value->{leaf_version}), $script_len, $script);
458+
}
459+
460+
push @result, $value->{hash};
461+
}
462+
}
463+
464+
if (@result == 2) {
465+
466+
# sort result so that smaller hash values come first
467+
@result = reverse @result
468+
if $result[0] gt $result[1];
469+
470+
return tagged_hash('TapBranch', join '', @result);
471+
}
472+
elsif (@result == 1) {
473+
return $result[0];
474+
}
475+
476+
Bitcoin::Crypto::Exception->raise(
477+
'invalid taproot script tree, not a binary tree'
478+
);
479+
}
480+
428481
signature_for tagged_hash => (
429482
positional => [Str, ByteStr],
430483
);
@@ -463,6 +516,7 @@ Bitcoin::Crypto::Util - General Bitcoin utilities
463516
hash160
464517
hash256
465518
merkle_root
519+
taproot_merkle_root
466520
tagged_hash
467521
);
468522
@@ -676,6 +730,43 @@ This is hash256 used by Bitcoin (C<SHA256> of C<SHA256>)
676730
Calculates a merkle root of input array reference. Leaves will be run through a
677731
double SHA256 before calculating the root.
678732
733+
=head2 taproot_merkle_root
734+
735+
$hash = taproot_merkle_root($tree_data)
736+
737+
Calculates a merkle root of taproot script tree (array ref). Unlike
738+
L</merkle_root>, this must be an actual binary tree structure:
739+
740+
my $leaf1 = {
741+
hash => [hex => $block_hash1]
742+
};
743+
744+
my $leaf2 = {
745+
hash => [hex => $block_hash2]
746+
};
747+
748+
my $leaf3 = {
749+
leaf_version => 192,
750+
script => [hex => '20c440b462ad48c7a77f94cd4532d8f2119dcebbd7c9764557e62726419b08ad4cac'],
751+
};
752+
753+
[
754+
$leaf1,
755+
[
756+
$leaf2,
757+
$leaf3,
758+
]
759+
]
760+
761+
Each level of a tree must be an array reference with up to two values in it.
762+
Each leaf must be a hash with either a prehashed value under C<hash> key
763+
(bytestring or something which can be coerced into a bytestring) or a script to
764+
be hashed represented by keys C<leaf_version> (integer up to 255) and C<script>
765+
(an instance of L<Bitcoin::Crypto::Script> or something which can be coerced
766+
into it).
767+
768+
Returns a bytestring which is the root hash of the tree.
769+
679770
=head2 tagged_hash
680771
681772
$hash = tagged_hash($tag, $message)
@@ -688,7 +779,6 @@ strings for C<$tag>, but can't detect whether it got it or not. This will only
688779
become a problem if you use non-ascii tag. If there's a possibility of
689780
non-ascii, always use utf8 and set binmodes to get decoded (wide) characters.
690781
691-
692782
=head1 SEE ALSO
693783
694784
L<https://github.com/bitcoin/bips/blob/master/bip-0039.mediawiki>

‎t/Taproot/BIP341-script-pub-key.t

+25-34
Original file line numberDiff line numberDiff line change
@@ -26,11 +26,12 @@ my @cases = (
2626
},
2727
given => {
2828
internal_pubkey => '187791b6f712a8ea41c8ecdd0ee77fab3e85263b37e1ec18a3651926b3a6cf27',
29-
script_tree => {
30-
id => 0,
31-
leaf_version => 192,
32-
script => '20d85a959b0290bf19bb89ed43c916be835475d013da4b362117393e25a48229b8ac'
33-
}
29+
script_tree => [
30+
{
31+
leaf_version => 192,
32+
script => [hex => '20d85a959b0290bf19bb89ed43c916be835475d013da4b362117393e25a48229b8ac']
33+
}
34+
]
3435
},
3536
},
3637
{
@@ -43,11 +44,12 @@ my @cases = (
4344
},
4445
given => {
4546
internal_pubkey => '93478e9488f956df2396be2ce6c5cced75f900dfa18e7dabd2428aae78451820',
46-
script_tree => {
47-
id => 0,
48-
leaf_version => 192,
49-
script => '20b617298552a72ade070667e86ca63b8f5789a9fe8731ef91202a91c9f3459007ac'
50-
}
47+
script_tree => [
48+
{
49+
leaf_version => 192,
50+
script => [hex => '20b617298552a72ade070667e86ca63b8f5789a9fe8731ef91202a91c9f3459007ac']
51+
}
52+
]
5153
},
5254
},
5355
{
@@ -63,14 +65,12 @@ my @cases = (
6365
internal_pubkey => 'ee4fe085983462a184015d1f782d6a5f8b9c2b60130aff050ce221ecf3786592',
6466
script_tree => [
6567
{
66-
id => 0,
6768
leaf_version => 192,
68-
script => '20387671353e273264c495656e27e39ba899ea8fee3bb69fb2a680e22093447d48ac'
69+
script => [hex => '20387671353e273264c495656e27e39ba899ea8fee3bb69fb2a680e22093447d48ac']
6970
},
7071
{
71-
id => 1,
7272
leaf_version => 250,
73-
script => '06424950333431'
73+
script => [hex => '06424950333431']
7474
}
7575
]
7676
},
@@ -88,14 +88,12 @@ my @cases = (
8888
internal_pubkey => 'f9f400803e683727b14f463836e1e78e1c64417638aa066919291a225f0e8dd8',
8989
script_tree => [
9090
{
91-
id => 0,
9291
leaf_version => 192,
93-
script => '2044b178d64c32c4a05cc4f4d1407268f764c940d20ce97abfd44db5c3592b72fdac'
92+
script => [hex => '2044b178d64c32c4a05cc4f4d1407268f764c940d20ce97abfd44db5c3592b72fdac']
9493
},
9594
{
96-
id => 1,
9795
leaf_version => 192,
98-
script => '07546170726f6f74'
96+
script => [hex => '07546170726f6f74']
9997
}
10098
]
10199
},
@@ -114,20 +112,17 @@ my @cases = (
114112
internal_pubkey => 'e0dfe2300b0dd746a3f8674dfd4525623639042569d829c7f0eed9602d263e6f',
115113
script_tree => [
116114
{
117-
id => 0,
118115
leaf_version => 192,
119-
script => '2072ea6adcf1d371dea8fba1035a09f3d24ed5a059799bae114084130ee5898e69ac'
116+
script => [hex => '2072ea6adcf1d371dea8fba1035a09f3d24ed5a059799bae114084130ee5898e69ac']
120117
},
121118
[
122119
{
123-
id => 1,
124120
leaf_version => 192,
125-
script => '202352d137f2f3ab38d1eaa976758873377fa5ebb817372c71e2c542313d4abda8ac'
121+
script => [hex => '202352d137f2f3ab38d1eaa976758873377fa5ebb817372c71e2c542313d4abda8ac']
126122
},
127123
{
128-
id => 2,
129124
leaf_version => 192,
130-
script => '207337c0dd4253cb86f2c43a2351aadd82cccb12a172cd120452b9bb8324f2186aac'
125+
script => [hex => '207337c0dd4253cb86f2c43a2351aadd82cccb12a172cd120452b9bb8324f2186aac']
131126
}
132127
]
133128
]
@@ -147,20 +142,17 @@ my @cases = (
147142
internal_pubkey => '55adf4e8967fbd2e29f20ac896e60c3b0f1d5b0efa9d34941b5958c7b0a0312d',
148143
script_tree => [
149144
{
150-
id => 0,
151145
leaf_version => 192,
152-
script => '2071981521ad9fc9036687364118fb6ccd2035b96a423c59c5430e98310a11abe2ac'
146+
script => [hex => '2071981521ad9fc9036687364118fb6ccd2035b96a423c59c5430e98310a11abe2ac']
153147
},
154148
[
155149
{
156-
id => 1,
157150
leaf_version => 192,
158-
script => '20d5094d2dbe9b76e2c245a2b89b6006888952e2faa6a149ae318d69e520617748ac'
151+
script => [hex => '20d5094d2dbe9b76e2c245a2b89b6006888952e2faa6a149ae318d69e520617748ac']
159152
},
160153
{
161-
id => 2,
162154
leaf_version => 192,
163-
script => '20c440b462ad48c7a77f94cd4532d8f2119dcebbd7c9764557e62726419b08ad4cac'
155+
script => [hex => '20c440b462ad48c7a77f94cd4532d8f2119dcebbd7c9764557e62726419b08ad4cac']
164156
}
165157
]
166158
]
@@ -172,12 +164,11 @@ foreach my $case_ind (0 .. $#cases) {
172164
subtest "should pass case index $case_ind" => sub {
173165
my $case = $cases[$case_ind];
174166

175-
skip_all 'TODO: this test requires implemented taproot scripts'
176-
if $case->{given}{script_tree};
177-
178167
# TODO: not possible to import xonly pubkey at the moment
179168
my $key = btc_pub->from_serialized([hex => "02" . $case->{given}{internal_pubkey}]);
180-
is $key->get_taproot_address, $case->{expected}{bip350_address}, 'address ok';
169+
is $key->get_taproot_address($case->{given}{script_tree}), $case->{expected}{bip350_address}, 'address ok';
170+
171+
# TODO: control blocks
181172
};
182173
}
183174

‎t/Util.t

+23-2
Original file line numberDiff line numberDiff line change
@@ -291,13 +291,34 @@ subtest 'testing merkle_root' => sub {
291291
'e05048a9b8e622bda048691a47fd9de332dc1d4b6b9d289d4e12c6722076c4e7', 'block 100022 root ok';
292292
};
293293

294+
subtest 'testing taproot_merkle_root' => sub {
295+
my $tree = [
296+
{hash => [hex => 'f154e8e8e17c31d3462d7132589ed29353c6fafdb884c5a6e04ea938834f0d9d']},
297+
[
298+
{
299+
leaf_version => 192,
300+
script => [hex => '20d5094d2dbe9b76e2c245a2b89b6006888952e2faa6a149ae318d69e520617748ac']
301+
},
302+
{hash => [hex => 'd7485025fceb78b9ed667db36ed8b8dc7b1f0b307ac167fa516fe4352b9f4ef7']},
303+
]
304+
];
305+
306+
# this example is a modified test case from BIP341
307+
is(
308+
to_format [hex => taproot_merkle_root($tree)],
309+
'2f6b2c5397b6d68ca18e09a3f05161668ffe93a988582d55c6f07bd5b3329def',
310+
'merkle root ok'
311+
);
312+
313+
};
314+
294315
subtest 'testing tagged_hash' => sub {
295316
my $data = pack 'u', 'packed data...';
296317
my $tag = 'ąść';
297318

298319
is(
299-
tagged_hash($tag, $data),
300-
sha256(sha256(encode 'UTF-8', $tag) . sha256(encode 'UTF-8', $tag) . $data),
320+
to_format [hex => tagged_hash($tag, $data)],
321+
to_format [hex => sha256(sha256(encode 'UTF-8', $tag) . sha256(encode 'UTF-8', $tag) . $data)],
301322
'tagged_hash ok'
302323
);
303324
};

0 commit comments

Comments
 (0)