The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -T

use strict;
use warnings;

use Audit::DBI;
use Config::Tiny;
use Test::Exception;
use Test::FailWarnings -allow_deps => 1;
use Test::More;

use lib 't/';
use LocalTest;


# Verify if Cache::Memcached::Fast is installed.
eval 'use Cache::Memcached::Fast';
plan( skip_all => 'Cache::Memcached::Fast required to test rate limiting.' )
	if $@;

# Verify that memcache is configured and running.
my $memcache = Cache::Memcached::Fast->new(
	{
		servers =>
		[
			'localhost:11211',
		],
	}
);

plan( skip_all => 'Memcache is not running or configured on this machine, cannot test rate limiting' )
	if !defined( $memcache) || !$memcache->set( 'test_audit_dbi_key', 1, time() + 10 );

# Memcache is ready to use, start testing.
plan( tests => 10 );

my $dbh = LocalTest::ok_database_handle();

ok(
	my $audit = Audit::DBI->new(
		database_handle => $dbh,
		memcache        => $memcache,
	),
	'Create a new Audit::DBI object.',
);

# Test data.
my $time = time();
my $test_event = 'Test audit event';
my $test_subject_type = 'test';
my $random_string = generate_random_string( 10 ) . $time;
my $limit_rate_timespan = 2;
my $limit_rate_subject_a = generate_random_string( 10 ) . $time;
my $limit_rate_subject_b = generate_random_string( 10 ) . $time;
my $limit_rate_subject_c = generate_random_string( 10 ) . $time;
my $limit_rate_unique_key = join( '_', $test_subject_type, $random_string, $time );

# Log audit event with rate-limit parameters.
lives_ok(
	sub
	{
		$audit->record(
			event                 => $test_event,
			subject_type          => $test_subject_type,
			subject_id            => $limit_rate_subject_a,
			limit_rate_timespan   => $limit_rate_timespan,
			limit_rate_unique_key => $limit_rate_unique_key,
			information           =>
			{
				test_id       => $limit_rate_subject_a,
				random_string => $random_string,
			},
			search_data           =>
			{
				test_id       => $limit_rate_subject_a,
				random_string => $random_string,
			},
		);
	},
	'Write audit event.',
);

# Log audit event again before cache expires.
lives_ok(
	sub
	{
		$audit->record(
			event                 => $test_event,
			subject_type          => $test_subject_type,
			subject_id            => $limit_rate_subject_b,
			limit_rate_timespan   => $limit_rate_timespan,
			limit_rate_unique_key => $limit_rate_unique_key,
			information           =>
			{
				test_id       => $limit_rate_subject_b,
				random_string => $random_string,
			},
			search_data           =>
			{
				test_id       => $limit_rate_subject_b,
				random_string => $random_string,
			},
		);
	},
	'Write audit event.',
);

# Wait until cache expires.
ok(
	sleep( $limit_rate_timespan + 2 ),
	'Wait until the rate-limit time allows logging this event again.',
);

# Log audit event again after cache expires.
lives_ok(
	sub
	{
		$audit->record(
			event                 => $test_event,
			subject_type          => $test_subject_type,
			subject_id            => $limit_rate_subject_c,
			limit_rate_timespan   => $limit_rate_timespan,
			limit_rate_unique_key => $limit_rate_unique_key,
			information           =>
			{
				test_id       => $limit_rate_subject_c,
				random_string => $random_string,
			},
			search_data           =>
			{
				test_id       => $limit_rate_subject_c,
				random_string => $random_string,
			},
		);
	},
	'Write audit event.',
);

# Read in audit events with matching subject_type and subject_id.
ok(
	defined(
		my $audit_events = $audit->review(
			subjects =>
			[
				{
					include => 1,
					type    => $test_subject_type,
					ids     =>
					[
						$limit_rate_subject_a,
						$limit_rate_subject_b,
						$limit_rate_subject_c,
					],
				},
			],
		)
	),
	'Retrieve audit records.',
);

is(
	scalar( @$audit_events ),
	2,
	'Find only two records matching the three unique subject IDs.',
)
||
diag(
	explain(
		{
			audit_events_retrieved => $audit_events,
			subject_a              => $limit_rate_subject_a,
			subject_b              => $limit_rate_subject_b,
			subject_c              => $limit_rate_subject_c,
		}
	)
);

# Verify that the random string for the first and last entry are found.
subtest(
	'Check that the non-rate-limited events were logged.',
	sub
	{
		plan( tests => 2 );

		is(
			scalar( grep { $_->{'subject_id'} eq $limit_rate_subject_a } @$audit_events ),
			1,
			"The subject ID >$limit_rate_subject_a< matches an event that was logged.",
		);

		is(
			scalar( grep { $_->{'subject_id'} eq $limit_rate_subject_c } @$audit_events ),
			1,
			"The subject ID >$limit_rate_subject_c< matches an event that was logged.",
		);
	},
) || diag( explain( $audit_events ) );

# Verify that the random string for the middle entry is not found.
subtest(
	'Check that the rate-limited events were not logged.',
	sub
	{
		plan( tests => 1 );

		is(
			scalar( grep { $_->{'subject_id'} eq $limit_rate_subject_b } @$audit_events ),
			0,
			"The subject ID >$limit_rate_subject_b< matches no logged event.",
		);
	},
);


sub generate_random_string
{
	my ( $length ) = @_;

	$length = 10
		unless defined( $length ) && $length > 0;

	my @char = ( 'a'..'z', 'A'..'Z', '0'..'9' );
	return join('', map { $char[ rand @char ] } ( 1 .. $length ) );
}