view release on metacpan or  search on metacpan

lib/Bitcoin/Crypto/Helpers.pm  view on Meta::CPAN

package Bitcoin::Crypto::Helpers;
$Bitcoin::Crypto::Helpers::VERSION = '4.005';
use v5.14;
use warnings;
use Exporter qw(import);
use Carp qw(croak carp);
use MIME::Base64;
use Bitcoin::Secp256k1;

use Bitcoin::Crypto::Constants qw(USE_BIGINTS);
use Bitcoin::Crypto::Exception;

BEGIN {
	require Math::BigInt;

	# Version 1.6003 of optional GMP is required for the from_bytes / to_bytes implementations
	if (eval { require Math::BigInt::GMP; Math::BigInt::GMP->VERSION('1.6003'); 1 }) {
		Math::BigInt->import(try => 'GMP,LTM');
	}
	else {
		Math::BigInt->import(try => 'LTM');
	}
}

our @EXPORT_OK = qw(
	pad_hex
	ensure_length
	encode_64bit
	decode_64bit
	carp_once
	parse_formatdesc
	ecc
	standard_push
	check_strict_public_key
	check_strict_der_signature
	make_strict_der_signature
	die_no_trace
);

our @CARP_NOT;
my %warned;

sub carp_once
{
	my ($msg) = @_;

	return if $warned{$msg};
	$warned{$msg} = 1;
	local @CARP_NOT = ((caller)[0]);
	carp($msg);
}

sub pad_hex
{
	my ($hex) = @_;
	$hex =~ s/\A0x//;
	$hex =~ tr/0-9a-fA-F//cd;
	return '0' x (length($hex) % 2) . $hex;
}

sub ensure_length
{
	my ($packed, $bytelen) = @_;
	my $missing = $bytelen - length $packed;

	Bitcoin::Crypto::Exception->raise(
		"packed string exceeds maximum number of bytes allowed ($bytelen)"
	) if $missing < 0;

	return pack("x$missing") . $packed;
}

sub encode_64bit
{
	my $value = shift;

	if (USE_BIGINTS) {
		return scalar reverse ensure_length $value->as_bytes, 8;
	}
	else {
		return pack 'VV', $value & 0xffffffff, $value >> 32;
	}
}

sub decode_64bit
{
	my $bytes = shift;

	if (USE_BIGINTS) {
		return Math::BigInt->from_bytes(scalar reverse $bytes);
	}
	else {
		my ($lower, $upper) = unpack 'VV', $bytes;
		return ($upper << 32) + $lower;
	}
}

# default operation is to decode based on formatdesc
# passing $reverse makes it encode instead
sub parse_formatdesc
{
	my ($type, $data, $reverse) = @_;

	if ($type eq 'hex') {
		$data = $reverse
			? unpack 'H*', $data
			: pack 'H*', pad_hex $data
			;
	}