package Bitcoin::Crypto::Script;
$Bitcoin::Crypto::Script::VERSION = '3.999_1'; # TRIAL
$Bitcoin::Crypto::Script::VERSION = '3.9991';
use v5.10;
use strict;
use warnings;
use Moo;
use Crypt::Digest::SHA256 qw(sha256);
use Mooish::AttributeBuilder -standard;
use Scalar::Util qw(blessed);
use List::Util qw(any);
use Types::Common -sigs, -types;
use Carp qw(carp);

use Bitcoin::Crypto::Constants;
use Bitcoin::Crypto::Base58 qw(encode_base58check decode_base58check);
use Bitcoin::Crypto::Bech32 qw(encode_segwit decode_segwit get_hrp);
use Bitcoin::Crypto::Constants;
use Bitcoin::Crypto::Util 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::Common;
use Bitcoin::Crypto::Script::Recognition;

use namespace::clean;

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

has field 'type' => (
	isa => Maybe [ScriptType],
	lazy => 1,
);

has field '_address' => (
	isa => Maybe [ByteStr],
	lazy => 1,
);

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

sub _build_type
{
	my ($self) = @_;

	my $rec = Bitcoin::Crypto::Script::Recognition->new(script => $self);
	return $rec->get_type;
}

sub _build_address
{
	my ($self) = @_;

	my $rec = Bitcoin::Crypto::Script::Recognition->new(script => $self);
	return $rec->get_address;
}

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);

				foreach my $pubkey (@pubkeys) {
					$self->push($pubkey);
				}

				$self
					->push(chr scalar @pubkeys)
					->add('OP_CHECKMULTISIG');
			},

			P2WPKH => sub {
				$witness->(@_, 'P2WPKH', 0, 20);
			},

			P2WSH => sub {
				$witness->(@_, 'P2WSH', 0, 32);
			},

			P2TR => sub {
				$witness->(@_, 'P2TR', 1, 32);
			},

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

				$self
					->add('OP_RETURN')
					->push($data);
			},
		};
	};

	Bitcoin::Crypto::Exception::ScriptType->raise(
		"unknown standard script type $type"
	) if !$types->{$type};

	$types->{$type}->($self, $address);
	return;
}

sub opcode_class
{
	return 'Bitcoin::Crypto::Script::Opcode';
}

sub BUILD
{
	my ($self, $args) = @_;

	if ($args->{type}) {
		Bitcoin::Crypto::Exception::ScriptPush->raise(
			'script with a "type" also requires an "address"'
		) unless $args->{address};

		$self->_build($args->{type}, $args->{address});
	}
}

signature_for is_pushes_only => (
	method => Object,
	positional => [],
);

sub is_pushes_only
{
	my ($self) = @_;

	foreach my $op (@{$self->operations}) {
		return !!0 unless $op->[0]->pushes;
	}

	return !!1;
}

signature_for add_raw => (
	method => Object,
	positional => [ByteStr],
);

sub add_raw
{
	my ($self, $bytes) = @_;

	$self->_set_serialized($self->_serialized . $bytes);
	return $self;
}

signature_for add_operation => (
	method => Object,
	positional => [Str],
);

sub add_operation
{
	my ($self, $name) = @_;

	my $opcode = $self->opcode_class->get_opcode_by_name($name);
	$self->add_raw(chr $opcode->code);

	return $self;
}

sub add
{
	goto \&add_operation;
}

signature_for push_bytes => (
	method => Object,
	positional => [ByteStr],
);

sub push_bytes
{
	my ($self, $bytes) = @_;

	my $len = length $bytes;

	if ($len == 0) {
		$self->add_operation('OP_0');
	}
	elsif ($len == 1 && ord($bytes) <= 0x10) {
		$self->add_operation('OP_' . ord($bytes));
	}
	elsif ($len <= 75) {
		$self
			->add_raw(pack 'C', $len)
			->add_raw($bytes);
	}
	elsif ($len < (1 << 8)) {
		$self
			->add_operation('OP_PUSHDATA1')
			->add_raw(pack 'C', $len)
			->add_raw($bytes);
	}
	elsif ($len < (1 << 16)) {
		$self
			->add_operation('OP_PUSHDATA2')
			->add_raw(pack 'v', $len)
			->add_raw($bytes);
	}
	elsif (Bitcoin::Crypto::Constants::is_32bit || $len < (1 << 32)) {
		$self
			->add_operation('OP_PUSHDATA4')
			->add_raw(pack 'V', $len)
			->add_raw($bytes);
	}
	else {
		Bitcoin::Crypto::Exception::ScriptPush->raise(
			'too much data to push onto stack in one operation'
		);
	}

	return $self;
}

sub push
{
	goto \&push_bytes;
}

# this can only detect native segwit in this context, as P2SH outputs are
# indistinguishable from any other P2SH
signature_for is_native_segwit => (
	method => Object,
	positional => [],
);

sub is_native_segwit
{
	my ($self) = @_;
	my @segwit_types = qw(P2WPKH P2WSH P2TR);

	my $script_type = $self->type // '';

	return any { $script_type eq $_ } @segwit_types;
}

signature_for is_taproot => (
	method => Object,
	positional => [],
);

sub is_taproot
{
	my ($self) = @_;

	return ($self->type // '') eq 'P2TR';
}

signature_for get_hash => (
	method => Object,
	positional => [],
);

sub get_hash
{
	my ($self) = @_;
	return hash160($self->_serialized);
}

signature_for to_serialized => (
	method => Object,
	positional => [],
);

sub to_serialized
{
	my ($self) = @_;

	return $self->_serialized;
}

signature_for from_serialized => (
	method => Str,
	positional => [Any],

	# no need to validate ByteStr, as it will be passed to add_raw
);

sub from_serialized
{
	my ($class, $bytes) = @_;

	return $class->new->add_raw($bytes);
}

signature_for from_standard => (
	method => Str,
	positional => [ScriptDesc, {slurpy => !!1}],
);

sub from_standard
{
	my ($class, $desc) = @_;

	if ($desc->[0] eq 'address') {
		$desc->[0] = get_address_type($desc->[1]);
	}

	return $class->new(
		type => $desc->[0],
		address => $desc->[1],
	);
}

signature_for operations => (
	method => Object,
	positional => [],
);

sub operations
{
	my ($self) = @_;

	my $runner = Bitcoin::Crypto::Script::Runner->new();
	$runner->start($self);
	return $runner->operations;
}

signature_for run => (
	method => Object,
	positional => [ArrayRef [ByteStr], {default => []}],
);

sub run
{
	my ($self, $initial_stack) = @_;

	my $runner = Bitcoin::Crypto::Script::Runner->new();
	return $runner->execute($self, $initial_stack);
}

signature_for witness_program => (
	method => Object,
	positional => [],
);

sub witness_program
{
	my ($self) = @_;

	my $program = Bitcoin::Crypto::Script->new(network => $self->network);
	$program
		->add_operation('OP_' . Bitcoin::Crypto::Constants::segwit_witness_version)
		->push_bytes(sha256($self->to_serialized));

	return $program;
}

signature_for get_legacy_address => (
	method => Object,
	positional => [],
);

sub get_legacy_address
{
	my ($self) = @_;
	return encode_base58check($self->network->p2sh_byte . $self->get_hash);
}

signature_for get_compat_address => (
	method => Object,
	positional => [],
);

sub get_compat_address
{
	my ($self) = @_;

	# network field is not required, lazy check for completeness
	Bitcoin::Crypto::Exception::NetworkConfig->raise(
		'this network does not support segregated witness'
	) unless $self->network->supports_segwit;

	return $self->witness_program->get_legacy_address;
}

signature_for get_segwit_address => (
	method => Object,
	positional => [],
);

sub get_segwit_address
{
	my ($self) = @_;

	# network field is not required, lazy check for completeness
	Bitcoin::Crypto::Exception::NetworkConfig->raise(
		'this network does not support segregated witness'
	) unless $self->network->supports_segwit;

	return encode_segwit($self->network->segwit_hrp, $self->witness_program->run->stack_serialized);
}

signature_for get_address => (
	method => Object,
	positional => [],
);

sub get_address
{
	my ($self) = @_;
	my $address = $self->_address;

	return undef
		unless $self->has_type && defined $address;

	my $segwit = sub {
		my ($version, $address) = @_;

		# network field is not required, lazy check for completeness
		Bitcoin::Crypto::Exception::NetworkConfig->raise(
			'this network does not support segregated witness'
		) unless $self->network->supports_segwit;

		return encode_segwit($self->network->segwit_hrp, $version . $address);
	};

	if ($self->type eq 'P2TR') {
		my $version = pack 'C', Bitcoin::Crypto::Constants::taproot_witness_version;
		return $segwit->($version, $address);
	}
	elsif ($self->is_native_segwit) {
		my $version = pack 'C', Bitcoin::Crypto::Constants::segwit_witness_version;
		return $segwit->($version, $address);
	}
	elsif ($self->type eq 'P2PKH') {
		return encode_base58check($self->network->p2pkh_byte . $address);
	}
	elsif ($self->type eq 'P2SH') {
		return encode_base58check($self->network->p2sh_byte . $address);
	}
	elsif ($self->type eq 'NULLDATA') {
		return qq("$address");
	}
}

signature_for has_type => (
	method => Object,
	positional => [],
);

sub has_type
{
	my ($self) = @_;

	return defined $self->type;
}

signature_for is_empty => (
	method => Object,
	positional => [],
);

sub is_empty
{
	my ($self) = @_;

	return length $self->_serialized == 0;
}

signature_for dump => (
	method => Object,
	positional => [],
);

sub dump
{
	my ($self) = @_;

	my $ops = $self->operations;
	my $num = @$ops;
	my $type = $self->type // 'Custom';

	my @result;
	CORE::push @result, "$type script, $num ops:";
	foreach my $op (@$ops) {
		CORE::push @result, $op->[0]->name . ': ' . to_format [hex => $op->[1]];
	}

	return join "\n", @result;
}

1;

__END__
=head1 NAME

Bitcoin::Crypto::Script - Bitcoin Script instance

=head1 SYNOPSIS

	use Bitcoin::Crypto::Script;

	my $script = Bitcoin::Crypto::Script->from_standard(
		[P2WPKH => $my_segwit_address]
	);

	# getting serialized script
	my $serialized = $script->to_serialized();

	# getting P2WSH address from script
	my $sh_address = $script->get_segwit_adress();

	# getting back the address encoded in P2WPKH script
	my $address = $script->get_address();


=head1 DESCRIPTION

This class allows you to create Perl representation of a Bitcoin script.

You can use a script object to:

=over

=item * create a script from opcodes

=item * serialize a script into byte string

=item * deserialize a script into a sequence of opcodes

=item * create legacy (p2sh), compat (p2sh(p2wsh)) and segwit (p2wsh) adresses

=item * execute the script

=back

=head1 INTERFACE

=head2 Attributes

=head3 type

Contains the type of the script, if the script is standard and the type is
known. Otherwise, contains C<undef>.

I<predicate>: B<has_type>

=head3 network

Instance of L<Bitcoin::Crypto::Network> - current network for this key. Can be
coerced from network id. Default: current default network.

I<writer:> C<set_network>

=head2 Methods

=head3 new

	$script_object = $class->new()

A constructor. Returns a new empty script instance.

See L</from_serialized> if you want to import a serialized script instead.

=head3 opcode_class

	$class_name = $class->opcode_class()
	$class->opcode_class->get_opcode_by_name($opname)

Returns the name of the class used to get the proper opcodes.

=head3 add_operation, add

	$script_object = $object->add_operation($opcode)

Adds a new opcode at the end of a script. Returns the object instance for chaining.

C<add> is a shorter alias for C<add_operation>.

Throws an exception for unknown opcodes.

=head3 add_raw

	$script_object = $object->add_raw($bytes)

Adds C<$bytes> at the end of the script without processing them at all.

Returns the object instance for chaining.

=head3 push_bytes, push

	$script_object = $object->push_bytes($bytes)

Pushes C<$bytes> to the execution stack at the end of a script, using a minimal push opcode.

C<push> is a shorter alias for C<push_bytes>.

For example, running C<< $script->push_bytes("\x03") >> will have the same
effect as C<< $script->add_operation('OP_3') >>.

Throws an exception for data exceeding a 4 byte number in length.

Note that no data longer than 520 bytes can be pushed onto the stack in one
operation, but this method will not check for that.

Returns the object instance for chaining.

=head3 to_serialized

	$bytestring = $object->to_serialized()

Returns a serialized script as byte string.

=head3 from_serialized

	$script = Bitcoin::Crypto::Script->from_serialized($bytestring)

Creates a new script instance from a bytestring.

=head3 from_standard

	$object = Bitcoin::Crypto::Script->from_standard([P2PKH => '1Ehr6cNDzPCx3wQRu1sMdXWViEi2MQnFzH'])
	$object = Bitcoin::Crypto::Script->from_standard([address => '1Ehr6cNDzPCx3wQRu1sMdXWViEi2MQnFzH'])

Creates a new object of standard type with given address. The address must be
of the currently default network. In case of C<NULLDATA>, C<P2MS> and C<P2PK>
there is no address, and the second argument must be custom data (C<NULLDATA>),
public key (C<P2PK>) or an array reference with number C<N> of signatures followed
by C<M> public keys (C<N> of C<M> C<P2MS>).

The first argument can also be specified as C<address> to enable auto-detection
of script type.

=head3 get_hash

	$bytestring = $object->get_hash()

Returns a serialized script parsed with C<HASH160> (C<RIPEMD160> of C<SHA256>).

=head3 get_legacy_address

	$address = $object->get_legacy_address()

Returns string containing Base58Check encoded script hash (C<P2SH> address)

=head3 get_compat_address

	$address = $object->get_compat_address()

Returns string containing Base58Check encoded script hash containing a witness
program for compatibility purposes (C<P2SH(P2WSH)> address)

=head3 get_segwit_address

	$address = $object->get_segwit_address()

Returns string containing Bech32 encoded witness program (C<P2WSH> address)

=head3 get_address

	$address = $object->get_address()

This method does not return P2SH-type address, but instead the address encoded
in the script of standard type. For example, if the script is of type
C<P2WPKH>, then a bech32 segwit address will be returned. If the script is not
of standard type or the type does not use addresses, returns C<undef>.

Currently handles script of types C<P2PKH>, C<P2SH>, C<P2WPKH>, C<P2WSH>, C<P2TR>.

=head3 operations

	$ops_aref = $object->operations

Returns an array reference of operations contained in a script. It is the same
as getting L<Bitcoin::Crypto::Script::Runner/operations> after calling
C<compile>.

=head3 run

	$runner = $object->run(\@initial_stack)

Executes the script and returns L<Bitcoin::Crypto::Script::Runner> instance
after running the script.

This is a convenience method which constructs runner instance in the
background. This helper is only meant to run simple scripts.

=head3 is_native_segwit

	$boolean = $object->is_native_segwit

Returns true if the type of the script is either C<P2WPKH>, C<P2WSH> or C<P2TR>.

=head3 is_empty

	$boolean = $object->is_empty

Returns true if the script is completely empty (contains no opcodes).

=head3 is_pushes_only

	$boolean = $object->is_pushes_only

Returns true if the script contains only opcodes pushing to the stack.

=head3 dump

	$string = $object->dump

Returns a readable representation of the script

=head1 EXCEPTIONS

This module throws an instance of L<Bitcoin::Crypto::Exception> if it
encounters an error. It can produce the following error types from the
L<Bitcoin::Crypto::Exception> namespace:

=over

=item * ScriptOpcode - unknown opcode was specified

=item * ScriptPush - data pushed to the execution stack is invalid

=item * ScriptType - invalid standard script type name specified

=item * ScriptSyntax - script syntax is invalid

=item * ScriptRuntime - script runtime error

=item * SegwitProgram - Segregated witness address error

=item * NetworkConfig - incomplete or corrupted network configuration

=item * NetworkCheck - address does not belong to the configured network

=back

=head1 SEE ALSO

=over

=item L<Bitcoin::Crypto::Script::Runner>

=item L<Bitcoin::Crypto::Script::Opcode>

=item L<Bitcoin::Crypto::Transaction>

=back

=cut

