| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Bitcoin::Crypto::Role::ExtendedKey; | 
| 2 |  |  |  |  |  |  | $Bitcoin::Crypto::Role::ExtendedKey::VERSION = '1.008'; | 
| 3 | 8 |  |  | 8 |  | 60390 | use v5.10; | 
|  | 8 |  |  |  |  | 38 |  | 
| 4 | 8 |  |  | 8 |  | 90 | use strict; | 
|  | 8 |  |  |  |  | 24 |  | 
|  | 8 |  |  |  |  | 202 |  | 
| 5 | 8 |  |  | 8 |  | 56 | use warnings; | 
|  | 8 |  |  |  |  | 19 |  | 
|  | 8 |  |  |  |  | 234 |  | 
| 6 | 8 |  |  | 8 |  | 78 | use List::Util qw(first); | 
|  | 8 |  |  |  |  | 20 |  | 
|  | 8 |  |  |  |  | 562 |  | 
| 7 | 8 |  |  | 8 |  | 59 | use Types::Standard qw(Str); | 
|  | 8 |  |  |  |  | 20 |  | 
|  | 8 |  |  |  |  | 103 |  | 
| 8 | 8 |  |  | 8 |  | 18903 | use Scalar::Util qw(blessed); | 
|  | 8 |  |  |  |  | 21 |  | 
|  | 8 |  |  |  |  | 379 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 8 |  |  | 8 |  | 3283 | use Bitcoin::Crypto::Key::Private; | 
|  | 8 |  |  |  |  | 31 |  | 
|  | 8 |  |  |  |  | 250 |  | 
| 11 | 8 |  |  | 8 |  | 56 | use Bitcoin::Crypto::Key::Public; | 
|  | 8 |  |  |  |  | 24 |  | 
|  | 8 |  |  |  |  | 157 |  | 
| 12 | 8 |  |  | 8 |  | 38 | use Bitcoin::Crypto::Config; | 
|  | 8 |  |  |  |  | 23 |  | 
|  | 8 |  |  |  |  | 261 |  | 
| 13 | 8 |  |  | 8 |  | 48 | use Bitcoin::Crypto::Types qw(IntMaxBits); | 
|  | 8 |  |  |  |  | 36 |  | 
|  | 8 |  |  |  |  | 67 |  | 
| 14 | 8 |  |  | 8 |  | 3993 | use Bitcoin::Crypto::Util qw(get_path_info); | 
|  | 8 |  |  |  |  | 32 |  | 
|  | 8 |  |  |  |  | 368 |  | 
| 15 | 8 |  |  | 8 |  | 53 | use Bitcoin::Crypto::Helpers qw(pad_hex ensure_length hash160 verify_bytestring); | 
|  | 8 |  |  |  |  | 17 |  | 
|  | 8 |  |  |  |  | 398 |  | 
| 16 | 8 |  |  | 8 |  | 45 | use Bitcoin::Crypto::Network; | 
|  | 8 |  |  |  |  | 21 |  | 
|  | 8 |  |  |  |  | 167 |  | 
| 17 | 8 |  |  | 8 |  | 41 | use Bitcoin::Crypto::Base58 qw(encode_base58check decode_base58check); | 
|  | 8 |  |  |  |  | 28 |  | 
|  | 8 |  |  |  |  | 312 |  | 
| 18 | 8 |  |  | 8 |  | 53 | use Bitcoin::Crypto::Exception; | 
|  | 8 |  |  |  |  | 25 |  | 
|  | 8 |  |  |  |  | 144 |  | 
| 19 | 8 |  |  | 8 |  | 45 | use Moo::Role; | 
|  | 8 |  |  |  |  | 16 |  | 
|  | 8 |  |  |  |  | 41 |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | with "Bitcoin::Crypto::Role::Key"; | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | has "depth" => ( | 
| 24 |  |  |  |  |  |  | is => "ro", | 
| 25 |  |  |  |  |  |  | isa => IntMaxBits [8], | 
| 26 |  |  |  |  |  |  | coerce => 1, | 
| 27 |  |  |  |  |  |  | default => 0 | 
| 28 |  |  |  |  |  |  | ); | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | has "parent_fingerprint" => ( | 
| 31 |  |  |  |  |  |  | is => "ro", | 
| 32 |  |  |  |  |  |  | isa => Str->where(q{ length $_ == 4 }), | 
| 33 |  |  |  |  |  |  | default => sub { pack "x4" } | 
| 34 |  |  |  |  |  |  | ); | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  | has "child_number" => ( | 
| 37 |  |  |  |  |  |  | is => "ro", | 
| 38 |  |  |  |  |  |  | isa => IntMaxBits [32], | 
| 39 |  |  |  |  |  |  | coerce => 1, | 
| 40 |  |  |  |  |  |  | default => 0 | 
| 41 |  |  |  |  |  |  | ); | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | has "chain_code" => ( | 
| 44 |  |  |  |  |  |  | is => "ro", | 
| 45 |  |  |  |  |  |  | isa => Str->where(q{ length $_ == 32 }), | 
| 46 |  |  |  |  |  |  | required => 1, | 
| 47 |  |  |  |  |  |  | ); | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | sub _build_args | 
| 50 |  |  |  |  |  |  | { | 
| 51 | 415 |  |  | 415 |  | 1328 | my ($class, @params) = @_; | 
| 52 |  |  |  |  |  |  |  | 
| 53 | 415 | 50 | 33 |  |  | 2079 | Bitcoin::Crypto::Exception::KeyCreate->raise( | 
| 54 |  |  |  |  |  |  | "invalid arguments passed to key constructor" | 
| 55 |  |  |  |  |  |  | ) if @params < 2 || @params > 5; | 
| 56 |  |  |  |  |  |  |  | 
| 57 | 415 |  |  |  |  | 1437 | my %ret = ( | 
| 58 |  |  |  |  |  |  | key_instance => $class->_create_key($params[0]), | 
| 59 |  |  |  |  |  |  | chain_code => $params[1], | 
| 60 |  |  |  |  |  |  | ); | 
| 61 |  |  |  |  |  |  |  | 
| 62 | 415 | 100 |  |  |  | 1575 | $ret{child_number} = $params[2] | 
| 63 |  |  |  |  |  |  | if @params >= 3; | 
| 64 | 415 | 100 |  |  |  | 1161 | $ret{parent_fingerprint} = $params[3] | 
| 65 |  |  |  |  |  |  | if @params >= 4; | 
| 66 | 415 | 100 |  |  |  | 1161 | $ret{depth} = $params[4] | 
| 67 |  |  |  |  |  |  | if @params >= 5; | 
| 68 |  |  |  |  |  |  |  | 
| 69 | 415 |  |  |  |  | 2829 | return %ret; | 
| 70 |  |  |  |  |  |  | } | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | sub _get_network_extkey_version | 
| 73 |  |  |  |  |  |  | { | 
| 74 | 293 |  |  | 293 |  | 584 | my ($self, $network, $purpose) = @_; | 
| 75 | 293 |  | 66 |  |  | 1101 | $network //= $self->network; | 
| 76 | 293 |  | 100 |  |  | 861 | $purpose //= $self->purpose; | 
| 77 |  |  |  |  |  |  |  | 
| 78 | 293 |  |  |  |  | 466 | my $name = 'ext'; | 
| 79 | 293 | 100 |  |  |  | 728 | $name .= $self->_is_private ? 'prv' : 'pub'; | 
| 80 | 293 | 100 | 100 |  |  | 942 | $name .= '_compat' if $purpose && $purpose eq 49; | 
| 81 | 293 | 100 | 100 |  |  | 866 | $name .= '_segwit' if $purpose && $purpose eq 84; | 
| 82 | 293 |  |  |  |  | 427 | $name .= '_version'; | 
| 83 |  |  |  |  |  |  |  | 
| 84 | 293 |  |  |  |  | 1323 | return $network->$name; | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | sub to_serialized | 
| 88 |  |  |  |  |  |  | { | 
| 89 | 117 |  |  | 117 | 0 | 2468 | my ($self) = @_; | 
| 90 |  |  |  |  |  |  |  | 
| 91 | 117 |  |  |  |  | 307 | my $version = $self->_get_network_extkey_version; | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | # network field is not required, lazy check for completeness | 
| 94 | 117 | 50 |  |  |  | 296 | Bitcoin::Crypto::Exception::NetworkConfig->raise( | 
| 95 |  |  |  |  |  |  | "no extended key version found in network configuration" | 
| 96 |  |  |  |  |  |  | ) unless defined $version; | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | # version number (4B) | 
| 99 | 117 |  |  |  |  | 609 | my $serialized = ensure_length pack("N", $version), 4; | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | # depth (1B) | 
| 102 | 117 |  |  |  |  | 687 | $serialized .= ensure_length pack("C", $self->depth), 1; | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | # parent's fingerprint (4B) - ensured | 
| 105 | 117 |  |  |  |  | 465 | $serialized .= $self->parent_fingerprint; | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | # child number (4B) | 
| 108 | 117 |  |  |  |  | 472 | $serialized .= ensure_length pack("N", $self->child_number), 4; | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | # chain code (32B) - ensured | 
| 111 | 117 |  |  |  |  | 462 | $serialized .= $self->chain_code; | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | # key entropy (1 + 32B or 33B) | 
| 114 | 117 |  |  |  |  | 381 | $serialized .= ensure_length $self->raw_key, Bitcoin::Crypto::Config::key_max_length + 1; | 
| 115 |  |  |  |  |  |  |  | 
| 116 | 117 |  |  |  |  | 400 | return $serialized; | 
| 117 |  |  |  |  |  |  | } | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | sub from_serialized | 
| 120 |  |  |  |  |  |  | { | 
| 121 | 32 |  |  | 32 | 0 | 103 | my ($class, $serialized, $network) = @_; | 
| 122 | 32 |  |  |  |  | 125 | verify_bytestring($serialized); | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | # expected length is 78 | 
| 125 | 32 | 50 | 33 |  |  | 282 | if (defined $serialized && length $serialized == 78) { | 
| 126 | 32 |  |  |  |  | 77 | my $format = "a4aa4a4a32a33"; | 
| 127 | 32 |  |  |  |  | 161 | my ($version, $depth, $fingerprint, $number, $chain_code, $data) = | 
| 128 |  |  |  |  |  |  | unpack($format, $serialized); | 
| 129 |  |  |  |  |  |  |  | 
| 130 | 32 |  |  |  |  | 106 | my $is_private = pack("x") eq substr $data, 0, 1; | 
| 131 |  |  |  |  |  |  |  | 
| 132 | 32 | 0 |  |  |  | 124 | Bitcoin::Crypto::Exception::KeyCreate->raise( | 
|  |  | 50 |  |  |  |  |  | 
| 133 |  |  |  |  |  |  | "invalid class used, key is " . ($is_private ? "private" : "public") | 
| 134 |  |  |  |  |  |  | ) if $is_private != $class->_is_private; | 
| 135 |  |  |  |  |  |  |  | 
| 136 | 32 | 100 |  |  |  | 133 | $data = substr $data, 1, Bitcoin::Crypto::Config::key_max_length | 
| 137 |  |  |  |  |  |  | if $is_private; | 
| 138 |  |  |  |  |  |  |  | 
| 139 | 32 |  |  |  |  | 103 | $version = unpack "N", $version; | 
| 140 |  |  |  |  |  |  |  | 
| 141 | 32 |  |  |  |  | 69 | my $purpose; | 
| 142 |  |  |  |  |  |  | my @found_networks; | 
| 143 |  |  |  |  |  |  |  | 
| 144 | 32 |  |  |  |  | 85 | for my $check_purpose (qw(44 49 84)) { | 
| 145 | 44 |  |  |  |  | 78 | $purpose = $check_purpose; | 
| 146 |  |  |  |  |  |  |  | 
| 147 |  |  |  |  |  |  | @found_networks = Bitcoin::Crypto::Network->find( | 
| 148 |  |  |  |  |  |  | sub { | 
| 149 | 176 |  |  | 176 |  | 336 | my ($inst) = @_; | 
| 150 | 176 |  |  |  |  | 332 | my $this_version = $class->_get_network_extkey_version($inst, $purpose); | 
| 151 | 176 |  | 100 |  |  | 753 | return $this_version && $this_version eq $version; | 
| 152 |  |  |  |  |  |  | } | 
| 153 | 44 |  |  |  |  | 330 | ); | 
| 154 | 44 | 50 |  | 0 |  | 220 | @found_networks = first { $_ eq $network } @found_networks if defined $network; | 
|  | 0 |  |  |  |  | 0 |  | 
| 155 |  |  |  |  |  |  |  | 
| 156 | 44 | 100 |  |  |  | 128 | last if @found_networks > 0; | 
| 157 |  |  |  |  |  |  | } | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | Bitcoin::Crypto::Exception::KeyCreate->raise( | 
| 160 | 32 | 50 |  |  |  | 130 | "found multiple networks possible for given serialized key" | 
| 161 |  |  |  |  |  |  | ) if @found_networks > 1; | 
| 162 |  |  |  |  |  |  |  | 
| 163 | 32 | 50 | 33 |  |  | 103 | Bitcoin::Crypto::Exception::KeyCreate->raise( | 
| 164 |  |  |  |  |  |  | "network name $network cannot be used for given serialized key" | 
| 165 |  |  |  |  |  |  | ) if @found_networks == 0 && defined $network; | 
| 166 |  |  |  |  |  |  |  | 
| 167 | 32 | 50 |  |  |  | 79 | Bitcoin::Crypto::Exception::NetworkConfig->raise( | 
| 168 |  |  |  |  |  |  | "couldn't find network for serialized key version $version" | 
| 169 |  |  |  |  |  |  | ) if @found_networks == 0; | 
| 170 |  |  |  |  |  |  |  | 
| 171 | 32 |  |  |  |  | 787 | my $key = $class->new( | 
| 172 |  |  |  |  |  |  | $data, | 
| 173 |  |  |  |  |  |  | $chain_code, | 
| 174 |  |  |  |  |  |  | unpack("N", $number), | 
| 175 |  |  |  |  |  |  | $fingerprint, | 
| 176 |  |  |  |  |  |  | unpack("C", $depth) | 
| 177 |  |  |  |  |  |  | ); | 
| 178 |  |  |  |  |  |  |  | 
| 179 | 32 |  |  |  |  | 1779 | $key->set_network(@found_networks); | 
| 180 | 32 |  |  |  |  | 135 | $key->set_purpose($purpose); | 
| 181 |  |  |  |  |  |  |  | 
| 182 | 32 |  |  |  |  | 1045 | return $key; | 
| 183 |  |  |  |  |  |  | } | 
| 184 |  |  |  |  |  |  | else { | 
| 185 | 0 |  |  |  |  | 0 | Bitcoin::Crypto::Exception::KeyCreate->raise( | 
| 186 |  |  |  |  |  |  | "input data does not look like a valid serialized extended key" | 
| 187 |  |  |  |  |  |  | ); | 
| 188 |  |  |  |  |  |  | } | 
| 189 |  |  |  |  |  |  | } | 
| 190 |  |  |  |  |  |  |  | 
| 191 |  |  |  |  |  |  | sub to_serialized_base58 | 
| 192 |  |  |  |  |  |  | { | 
| 193 | 96 |  |  | 96 | 0 | 30214 | my ($self) = @_; | 
| 194 | 96 |  |  |  |  | 282 | my $serialized = $self->to_serialized(); | 
| 195 | 96 |  |  |  |  | 404 | return encode_base58check $serialized; | 
| 196 |  |  |  |  |  |  | } | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | sub from_serialized_base58 | 
| 199 |  |  |  |  |  |  | { | 
| 200 | 34 |  |  | 34 | 0 | 23052 | my ($class, $base58, $network) = @_; | 
| 201 | 34 |  |  |  |  | 140 | return $class->from_serialized(decode_base58check($base58), $network); | 
| 202 |  |  |  |  |  |  | } | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | sub get_basic_key | 
| 205 |  |  |  |  |  |  | { | 
| 206 | 60 |  |  | 60 | 0 | 5342 | my ($self) = @_; | 
| 207 | 60 | 100 |  |  |  | 173 | my $base_class = "Bitcoin::Crypto::Key::" . ($self->_is_private ? "Private" : "Public"); | 
| 208 | 60 |  |  |  |  | 1191 | my $basic_key = $base_class->new($self->key_instance); | 
| 209 | 60 |  |  |  |  | 2065 | $basic_key->set_network($self->network); | 
| 210 | 60 |  |  |  |  | 415 | $basic_key->set_purpose($self->purpose); | 
| 211 |  |  |  |  |  |  |  | 
| 212 | 60 |  |  |  |  | 1119 | return $basic_key; | 
| 213 |  |  |  |  |  |  | } | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | sub get_fingerprint | 
| 216 |  |  |  |  |  |  | { | 
| 217 | 276 |  |  | 276 | 0 | 7915 | my ($self, $len) = @_; | 
| 218 | 276 |  | 50 |  |  | 1374 | $len //= 4; | 
| 219 |  |  |  |  |  |  |  | 
| 220 | 276 |  |  |  |  | 802 | my $pubkey = $self->raw_key("public_compressed"); | 
| 221 | 276 |  |  |  |  | 957 | my $identifier = hash160($pubkey); | 
| 222 | 276 |  |  |  |  | 5332 | return substr $identifier, 0, 4; | 
| 223 |  |  |  |  |  |  | } | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | sub _get_purpose_from_BIP44 | 
| 226 |  |  |  |  |  |  | { | 
| 227 | 87 |  |  | 87 |  | 218 | my ($self, $path) = @_; | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | # NOTE: only handles BIP44 correctly when it is constructed with Bitcoin::Crypto::BIP44 | 
| 230 |  |  |  |  |  |  | # NOTE: when deriving new keys, we do not care about previous state: | 
| 231 |  |  |  |  |  |  | # - if BIP44 is further derived, it is not BIP44 anymore | 
| 232 |  |  |  |  |  |  | # - if BI44 is derived as a new BIP44, the old one is like the new master key | 
| 233 |  |  |  |  |  |  | # because of that, set purpose to undef if path is not BIP44 | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | return undef | 
| 236 | 87 | 100 | 66 |  |  | 662 | unless blessed $path && $path->isa('Bitcoin::Crypto::BIP44'); | 
| 237 |  |  |  |  |  |  |  | 
| 238 | 24 | 100 |  |  |  | 149 | return $self->purpose | 
| 239 |  |  |  |  |  |  | if $path->get_from_account; | 
| 240 |  |  |  |  |  |  |  | 
| 241 | 14 |  |  |  |  | 93 | return $path->purpose; | 
| 242 |  |  |  |  |  |  | } | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | sub derive_key | 
| 245 |  |  |  |  |  |  | { | 
| 246 | 90 |  |  | 90 | 0 | 36065 | my ($self, $path) = @_; | 
| 247 | 90 |  |  |  |  | 355 | my $path_info = get_path_info $path; | 
| 248 |  |  |  |  |  |  |  | 
| 249 | 90 | 100 |  |  |  | 426 | Bitcoin::Crypto::Exception::KeyDerive->raise( | 
| 250 |  |  |  |  |  |  | "invalid key derivation path supplied" | 
| 251 |  |  |  |  |  |  | ) unless defined $path_info; | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | Bitcoin::Crypto::Exception::KeyDerive->raise( | 
| 254 |  |  |  |  |  |  | "cannot derive private key from public key" | 
| 255 | 88 | 100 | 100 |  |  | 321 | ) if !$self->_is_private && $path_info->{private}; | 
| 256 |  |  |  |  |  |  |  | 
| 257 | 87 |  |  |  |  | 266 | my $key = $self; | 
| 258 | 87 |  |  |  |  | 161 | for my $child_num (@{$path_info->{path}}) { | 
|  | 87 |  |  |  |  | 242 |  | 
| 259 | 276 |  |  |  |  | 12464 | my $hardened = $child_num >= Bitcoin::Crypto::Config::max_child_keys; | 
| 260 |  |  |  |  |  |  |  | 
| 261 |  |  |  |  |  |  | # dies if hardened-from-public requested | 
| 262 |  |  |  |  |  |  | # dies if key is invalid | 
| 263 | 276 |  |  |  |  | 977 | $key = $key->_derive_key_partial($child_num, $hardened); | 
| 264 |  |  |  |  |  |  | } | 
| 265 |  |  |  |  |  |  |  | 
| 266 | 87 |  |  |  |  | 5256 | $key->set_network($self->network); | 
| 267 | 87 |  |  |  |  | 341 | $key->set_purpose($self->_get_purpose_from_BIP44($path)); | 
| 268 |  |  |  |  |  |  |  | 
| 269 |  |  |  |  |  |  | $key = $key->get_public_key() | 
| 270 | 87 | 100 | 100 |  |  | 987 | if $self->_is_private && !$path_info->{private}; | 
| 271 |  |  |  |  |  |  |  | 
| 272 | 87 |  |  |  |  | 613 | return $key; | 
| 273 |  |  |  |  |  |  | } | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | 1; | 
| 276 |  |  |  |  |  |  |  |