view release on metacpan or  search on metacpan

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

use Bitcoin::Crypto::Base58 qw(encode_base58check decode_base58check);
use Bitcoin::Crypto::Bech32 qw(encode_segwit decode_segwit get_hrp);
use Bitcoin::Crypto::Constants qw(:witness);
use Bitcoin::Crypto::Util::Internal qw(hash160 hash256 get_address_type to_format);
use Bitcoin::Crypto::Exception;
use Bitcoin::Crypto::Types -types;
use Bitcoin::Crypto::Script::Opcode;
use Bitcoin::Crypto::Script::Runner;
use Bitcoin::Crypto::Script::Compiler;
use Bitcoin::Crypto::Script::Common;
use Bitcoin::Crypto::Script::Recognition;

has field '_serialized' => (
	isa => ByteStr,
	writer => 1,
	default => '',
);

has field '_recognition' => (
	isa => InstanceOf ['Bitcoin::Crypto::Script::Recognition'],
	lazy => 1,
	clearer => -hidden,
	handles => {
		get_raw_address => 'address',
		type => 'type',
		segwit_version => 'segwit_version',
	},
);

has field '_compiler' => (
	isa => InstanceOf ['Bitcoin::Crypto::Script::Compiler'],
	lazy => 1,
	clearer => -hidden,
	handles => {
		operations => 'operations',
		has_errors => 'has_errors',
		assert_valid => 'assert_valid',
	},
);

with qw(Bitcoin::Crypto::Role::Network);

sub _build_recognition
{
	return Bitcoin::Crypto::Script::Recognition->check(shift);
}

sub _build_compiler
{
	return Bitcoin::Crypto::Script::Compiler->compile(shift);
}

sub _build
{
	my ($self, $type, $address) = @_;

	state $types = do {
		my $legacy = sub {
			my ($self, $address, $type) = @_;

			my $decoded = decode_base58check($address);
			my $network_byte = substr $decoded, 0, 1, '';

			Bitcoin::Crypto::Exception::Address->raise(
				"legacy scripts should contain 20 bytes"
			) unless length $decoded == 20;

			my $byte_method = lc "p2${type}_byte";
			Bitcoin::Crypto::Exception::NetworkCheck->raise(
				"provided address $address is not P2$type on network " . $self->network->name
			) if $network_byte ne $self->network->$byte_method;

			Bitcoin::Crypto::Script::Common->fill($type => $self, $decoded);
		};

		my $witness = sub {
			my ($self, $address, $name, $version, $length) = @_;

			my $data = decode_segwit $address;
			my $this_version = substr $data, 0, 1, '';

			Bitcoin::Crypto::Exception::SegwitProgram->raise(
				"$name script only handles witness version $version"
			) unless $this_version eq chr $version;

			Bitcoin::Crypto::Exception::SegwitProgram->raise(
				"$name script should contain $length bytes"
			) unless length $data eq $length;

			Bitcoin::Crypto::Exception::NetworkCheck->raise(
				"provided address $address does not belong to network " . $self->network->name
			) if get_hrp($address) ne $self->network->segwit_hrp;

			$self
				->add("OP_$version")
				->push($data);
		};

		{
			P2PK => sub {
				my ($self, $pubkey) = @_;

				$self
					->push($pubkey)
					->add('OP_CHECKSIG');
			},

			P2PKH => sub {
				$legacy->(@_, 'PKH');
			},

			P2SH => sub {
				$legacy->(@_, 'SH');
			},

			P2MS => sub {
				my ($self, $data) = @_;

				Bitcoin::Crypto::Exception::ScriptPush->raise(
					'P2MS script argument must be an array reference'
				) unless ref $data eq 'ARRAY';

				my ($signatures_num, @pubkeys) = @$data;

				Bitcoin::Crypto::Exception::ScriptPush->raise(
					'P2MS script first element must be a number between 1 and 15'
				) unless $signatures_num >= 0 && $signatures_num <= 15;

				Bitcoin::Crypto::Exception::ScriptPush->raise(
					'P2MS script remaining elements number should be between the number of signatures and 15'
				) unless @pubkeys >= $signatures_num && @pubkeys <= 15;

				$self->push(chr $signatures_num);