#!perl
use List::Util;
use RevBank::Products;

HELP void => "Destroy deposit tokens";

my $ttl = 100 * 86400;  # expiry time in seconds
my $filename = "revbank.statiegeld";

# Token format: token_type,time,expiry_time,product_id,transaction_id,seq
# - token_type (also just "type") is the id of the product addon.
# - expiry_time < 0 means the token does not expire.
# - time and product_id is recorded but only used for debugging.
# - seq is a 0 based counter per transaction to make tokens unique,
#   although the uniqueness of tokens is currently neither used nor enforced.
#
# Tokens are spent in FIFO order, by type rather than product_id. This
# effectively extends the TTL for active consumers. The product_ids of
# a user's remaining tokens may not correspond to those of the empty containers
# in their possession.

sub _addon_accounts {
	my @accounts = @RevBank::Plugin::statiegeld::addon_accounts
		or die "statiegeld_tokens plugin requires statiegeld plugin";
	return @accounts;
}

sub _time_is_reliable() {
	state $cache;
	state $cached_at;
	undef $cache if defined $cached_at and $cached_at <= (time() - 10);

	return $cache if defined $cache;

	$cache = sub {
		return 1 if system('ntpstat >/dev/null 2>/dev/null') == 0;
		return 1 if `timedatectl show -p NTPSynchronized 2>/dev/null` =~ /=yes/;

		warn "Time/NTP status unknown or bad; deposit tokens will not expire.\n";
		return 0;
	}->();
	$cached_at = time;

	return $cache;
}

sub _read {
	spurt $filename if not -e $filename;

	my %users_tokens;
	for (slurp $filename) {
		/\S/ or next;

		my ($username, @tokens) = split " ", $_;
		if (exists $users_tokens{lc $username}) {
			die "Corrupt data file $filename, $username listed twice";
		}

		my %by_type;
		for my $token (@tokens) {
			my ($token_type) = (split /,/, $token)[0];
			push @{ $by_type{$token_type} }, $token;
		}

		$users_tokens{lc $username} = \%by_type;
	}
	return \%users_tokens;
}

sub _expire_tokens($line, $time) {
	$time > 0     or return $line;
	defined $line or return $line;
	$line =~ / /  or return $line;

	my ($username, @tokens) = split " ", $line;

	# Rewrite line with only non-tokens, invalid tokens, and non-expired tokens
	my @keep;
	my @expired;
	for my $token (@tokens) {
		my ($type, undef, $expiry) = split /,/, $token;

		my $expired = defined($expiry) && $expiry > 0 && $expiry < $time;
		push @{ $expired ? \@expired : \@keep }, $token;
	}

	call_hooks(
		"log_info",
		"statiegeld_tokens: ${\scalar @expired} expired for $username: @expired"
	) if @expired;

	return join(" ", $username, @keep) . "\n";
}

sub _write($username, $tokens_by_type, $create) {
	my @tokens = map @{ $tokens_by_type->{$_} }, sort keys %$tokens_by_type;
	my $new_line = @tokens == 0 ? undef : join(" ", $username, @tokens) . "\n";

	my $time = _time_is_reliable ? time() : -1;
	
	if ($create) {
		append $filename, $new_line if defined $new_line;
	} else {
		rewrite $filename, sub ($old_line) {
			$old_line =~ /\S/ or return $old_line;  # keep whitespace-only lines

			# removes line from file if $new_line is undef
			my $line = /(\S+)/ && lc($1) eq lc($username) ? $new_line : $old_line;
			return _expire_tokens($line, $time);
		};
	}
}

sub _warn($message) {
	warn "\e[31;1mSorry,\e[0m $message\n";
}

sub hook_undo($class, $cart) {
	# Undoing properly is hard. We can easily void tokens, but we can't restore
	# them. That would requires duplicating all of the undo logic that exists
	# for account balances, but for tokens. Too much work for something that I
	# suspect would hardly be used anyway, so instead we'll just prohibit
	# undoing refunds.
	for my $entry ($cart->entries) {
		# Undo deposit refund: prohibit
		for my $contra ($entry->contras) {
			next if $contra->{amount} < 0;
			next if List::Util::none { $contra->{user} eq $_ } _addon_accounts;

			return ABORT, "Sorry, deposit refunds cannot be undone.";
		}
	}
}

sub _handle_undo($cart) {
	for my $entry ($cart->entries) {
		# Undo buying: void specific tokens
		my $undo_tid = $entry->attribute('undo_transaction_id')
			or die "Plugin error: broken '-undo' transaction";

		rewrite $filename, sub ($line) {
			my ($username, @tokens) = split " ", $line;
			@tokens = grep {
				my ($token_type, undef, undef, undef, $tid) = split /,/, $_;

				$tid ne $undo_tid
			} @tokens;

			return @tokens ? join(" ", $username, @tokens) . "\n" : undef;
		};
	}
}

sub hook_checkout_prepare($class, $cart, $username, $transaction_id, @) {
	if ($username eq '-undo') {
		_handle_undo($cart);
		return;
	}

	# Read data
	my $tokens_by_type = _read->{lc $username};
	my $is_new = !defined $tokens_by_type;
	$tokens_by_type = {} if $is_new;
	my $time_is_reliable = _time_is_reliable;

	my $tokens_changed = 0;
	my @created;
	my @used;

	# Products bought: add tokens
	my $seq = 0;
	for my $entry ($cart->entries('product')) {
		my $sg = RevBank::Plugin::statiegeld::statiegeld_product($entry->attribute('product'))
			or next;

		for my $addon (@{ $sg->{statiegeld_addons} }) {
			# These should never contain spaces or commas in vanilla revbank,
			# but custom plugins may be less well behaved.
			/[\s,]/ and die "Internal error"
				for $addon->{id}, $entry->attribute('product_id'), $transaction_id;

			for (1 .. $entry->quantity) {
				my $token = join(",",
					$addon->{id},  # token_type
					time(),
					($time_is_reliable ? time() + $ttl : -1),
					$entry->attribute('product_id'),
					$transaction_id,
					$seq++,
				);
				push @created, $token;
				push @{ $tokens_by_type->{$addon->{id}} }, $token;
			}
			$tokens_changed++;
		}
	}

	# Products (containers) returned: void tokens in FIFO order
	my $cart_changed = 0;
	my %warnings_by_type;
	my %had_num_tokens_by_type = map { $_ => scalar @{ $tokens_by_type->{$_} } } keys %$tokens_by_type;

	ENTRY: for my $entry ($cart->entries('plugin')) {
		$entry->attribute('plugin') eq 'statiegeld' or next;

		my $type = $entry->attribute('addon_id');
		my $available = @{ $tokens_by_type->{$type} // [] };

		if ($available < $entry->quantity) {
			if ($available == 0) {
				$cart->delete($entry);
				$warnings_by_type{$type}++;
				next ENTRY;
			}
			$entry->quantity($available);
			$warnings_by_type{$type}++;
		}

		push @used, splice @{ $tokens_by_type->{$type} }, 0, $entry->quantity;
		$tokens_changed++;
	}
	for my $type (keys %warnings_by_type) {
		my $products = read_products;
		my $addon = $products->{"+$type"} // $products->{$type};
		my $avail = $had_num_tokens_by_type{$type} // 0;
		my $only =
			+ $avail == 0 ? "0 deposit tokens"
			: $avail == 1 ? "only 1 deposit token"
			:               "only $avail deposit tokens";

		_warn qq[you have $only of type $type.\n]
			. qq[($type = "$addon->{description}")];
	}

	# Store data
	call_hooks(
		"log_info",
		"statiegeld_tokens: ${\scalar @created } created for $username: @created"
	) if @created;

	call_hooks(
		"log_info",
		"statiegeld_tokens: ${\scalar @used } used by $username: @used"
	) if @used;

	_write $username, $tokens_by_type, $is_new if $tokens_changed;

	return ABORT if %warnings_by_type and not $cart->size;

	if (%warnings_by_type and $cart->changed(1)) {
		print "\n";  # Between warnings and transaction overview
	}

	return;
}

sub hook_user_info ($class, $username, @) {
	my $tokens_by_type = _read->{lc $username};
	my @info;
	for my $type (sort keys %$tokens_by_type) {
		my @tokens = @{ $tokens_by_type->{$type} // [] };
		push @info, sprintf("%dx %s", scalar @tokens, $type);
	}
	@info = ("none") if not @info;
	print "Deposit tokens: ", join(", ", @info), "\n";
}

sub command($self, $cart, $command, @) {
	$command eq 'void' or return NEXT;

	my $found =0;
	for my $entry ($cart->entries('plugin')) {
		next if $entry->attribute('plugin') ne 'statiegeld';
		$found++;
	}
	$found or return REJECT, "Add deposit returns first.";

	return "The tokens will be deleted irrevokably and you will NOT RECEIVE THE MONEY.\n"
		. "Type 'yes' if you are sure", \&void;
}

sub void :Tab(yes,no) ($self, $cart, $input, @) {
	if (lc $input eq 'y') {
		return REJECT, "y is not yes...";
	}
	if (lc $input ne 'yes') {
		print "Destruction cancelled.\n";
		return ACCEPT;
	}

	for my $entry ($cart->entries('plugin')) {
		next if $entry->attribute('plugin') ne 'statiegeld';
		$entry->{description} = "Void: $entry->{description}";
		$entry->amount(0);
		$entry->delete_contras;

		# Change key so subsequently added things aren't also void;
		# deduplication of tokens to be voided doesn't actually work yet.
		$entry->attribute(deduplicate => join("/", $self->id, $entry->attribute('addon_id')));
	}

	return ACCEPT;
}