[gruntmaster-page.git] / lib / Plack / App / Gruntmaster.pm

package Plack::App::Gruntmaster;

use 5.014000;
use strict;
our $VERSION = '5999.000_001';

use Encode qw/encode decode/;
use File::Slurp qw/read_file/;
use JSON::MaybeXS qw/encode_json/;
use PerlX::Maybe;
use Scope::Upper qw/unwind SUB UP/;
use Web::Simple;

use Gruntmaster::Data;
use Plack::App::Gruntmaster::HTML;

use warnings NONFATAL => 'all';
no warnings 'illegalproto';

##################################################

use constant USER_REGEX => qr/^\w{2,20}$/a;

use constant FORMAT_EXTENSION => {
	C => 'c',
	CPP => 'cpp',
	GCCGO => 'go',
	GOLANG => 'go',
	GOLFSCRIPT => 'gs',
	HASKELL => 'hs',
	MONO => 'cs',
	JAVA => 'java',
	PASCAL => 'pas',
	PERL => 'pl',
	PYTHON => 'py',
	RUBY => 'rb',
	SBCL => 'l',
};

use constant NOT_FOUND => [404, ['X-Forever' => 1, 'Content-Type' => 'text/plain'], ['Not found']];

my ($env, $privacy);

sub remote_user {
	unless ($env->{'gruntmaster.user'}) {
		my $user = $env->{REMOTE_USER};
		$user &&= user_entry $user;
		$env->{'gruntmaster.user'} = $user;
	}
	$env->{'gruntmaster.user'}
}

sub admin   { remote_user && remote_user->{admin} }

sub redirect { [301, ['X-Forever' => 1, 'Cache-Control' => 'public, max-age=86400', 'Location' => $_[0]], []] }
sub reply    { [200, ['Content-Type' => 'text/plain; charset=utf-8'], \@_] }
sub response {
	my ($template, $title, $params, $maxage) = @_;
	unless ($params) {
		$params = $title;
		$title = 'No title';
	}
	$params->{time} = time;
	$params->{args} = {%_};
	bless {template => $template, title => $title, params => $params, maxage => ($maxage // 3600)}, __PACKAGE__.'::Response'
}

sub forbid {
	my ($condition) = @_;
	$privacy = 'private' if $condition;
	return if !$condition || admin;
	unwind $env->{authcomplex}->unauthorized, SUB UP
}

sub dispatch_request{
	$env = $_[PSGI_ENV];
	$privacy = 'public';

	sub (GET) {
		sub (/robots.txt) { NOT_FOUND },

		sub (/src/:job) {
			my $job = db->select(jobs => '*', {id => $_{job}})->hash;
			return NOT_FOUND if !$job;
			my $isowner = remote_user && remote_user->{id} eq $job->{owner};
			my $contest = $job->{contest} && contest_entry $job->{contest};
			my $private = $job->{private} || $contest && ($contest->{started} && !$contest->{finished});
			forbid !$isowner && $private;
			my $privacy = $private ? 'private' : 'public';
			my @headers = ('X-Forever' => 1, 'Cache-Control' => "$privacy, max-age=604800", 'Content-Type' => 'text/plain');
			push @headers, (Vary => 'Authorization') if $private;
			[200, \@headers, [$job->{source}]]
		},

		sub (?:format~) {
			my $format = lc ($_{format} // '');
			response_filter {
				my ($r) = @_;
				return $r if ref $r ne 'Plack::App::Gruntmaster::Response';
				my @hdrs = ('X-Forever' => 1, 'Cache-Control' => "$privacy, max-age=$r->{maxage}");
				push @hdrs, Vary => 'Authorization' if $privacy eq 'private';
				return [200, ['Content-Type' => 'application/json; charset=utf-8', @hdrs], [encode_json $r->{params}]] if $format eq 'json';
				my $ret = render $r->{template}, 'en', title => $r->{title}, %{$r->{params}};
				[200, ['Content-Type' => 'text/html; charset=utf-8', @hdrs], [encode 'UTF-8', $ret]]
			},
		},

		sub (/st/:contest) {
			my @pb = map { [$_->{id}, $_->{name}] } @{problem_list contest => $_{contest}};
			response st => 'Standings', {problems => \@pb, st => standings $_{contest}}, 10
		},

		sub (/ed/:contest) {
			my $contest = db->select(contests => '*', {id => $_{contest}})->hash;
			forbid time < $contest->{stop};
			my $pblist = problem_list contest => $_{contest}, solution => 1;
			response ed => 'Editorial of ' . $contest->{name}, {pb => $pblist, editorial => $contest->{editorial}}
		},

		sub (/login) {
			forbid !remote_user;
			[200, ['Content-Type' => 'text/plain; charset=UTF-8', 'Cache-Control' => 'private, max-age=300', Vary => 'Authorization'], [$env->{REMOTE_USER}]]
		},

		sub (/ct/:contest/log/st) { redirect "/st/$_{contest}" },

		sub (/us/)                                        { response us => 'Users', {us => user_list} },
		sub (/ct/  + ?:owner~)                            { response ct => 'Contests', {ct => contest_list(%_)}, 300 },
		sub (/log/ + ?:contest~&:owner~&:page~&:problem~&:private~&:result~) {
			forbid $_{private};
			my ($jobs, $pageinfo) = job_list(%_);
			response log => 'Job log', {log => $jobs, %$pageinfo}, 5
		},
		sub (/pb/  + ?:owner~&:contest~&:private~)                  {
			forbid $_{private};
			my $pending = $_{contest} && !contest_entry($_{contest})->{started};
			forbid $pending;
			response pb => 'Problems', {pb => problem_list %_}
		},

		sub (/us/:user)    {
			my $user = user_entry $_{user};
			response us_entry => $user->{name}, $user
		},
		sub (/ct/:contest) {
			my $contest = contest_entry $_{contest};
			response ct_entry => $contest->{name}, $contest, 60
		},
		sub (/log/:job)    {
			my $job = job_entry $_{job};
			forbid $job->{private};
			response log_entry => "Job  $_{job}", $job, 10
		},
		sub (/pb/:problem + ?contest~) {
			my (undef, undef, $contest) = @_;
			$_{contest} = $contest;
			$contest = $contest && contest_entry $_{contest};
			return NOT_FOUND if $contest && !contest_has_problem $_{contest}, $_{problem};
			my $problem = problem_entry $_{problem}, $_{contest};
			forbid $problem->{private} && !$contest;
			if ($contest) {
				return redirect "/pb/$_{problem}" if !$contest->{started} || $contest->{finished};
				forbid !remote_user;
				$privacy = 'private';
			}
			response pb_entry => $problem->{name}, $problem, $_{contest} ? 10 : ();
		},
		sub (/sol/:problem) {
			my $problem = problem_entry $_{problem};
			forbid $problem->{private};
			response sol => 'Solution of ' . $problem->{name}, {solution => $problem->{solution}};
		},

		sub (/) { redispatch_to '/index' },
		sub (/favicon.ico) { redirect '/static/favicon.ico' },
		sub (/:article) { [200, ['Content-Type' => 'text/html; charset=utf-8', 'Cache-Control' => 'public, max-age=3600', 'X-Forever' => 1], [render_article $_{article}, 'en']] }
	},

	sub (POST) {
		sub (/action/submit + %:problem=&:contest~&:prog_format=&:source_code~ + *prog~) {
			my (undef, undef, $prog) = @_;
			forbid !remote_user;
			my $problem = problem_entry $_{problem};
			my $private = $problem->{private} ? 1 : 0;
			if ($_{contest}) {
				$private = 0;
				my $contest = contest_entry $_{contest};
				return reply 'This contest has not yet started' if !$contest->{started};
				return reply 'This contest has finished' if $contest->{finished};
				return reply 'This problem is private' if !admin && $private;
				return reply 'This problem does not belong to this contest' unless contest_has_problem $_{contest}, $_{problem};
			}
			return reply 'Maximum source size is 10KB' if ($prog ? $prog->size : length $_{source_code}) > 10 * 1024;
			return reply 'You must wait 30 seconds between jobs' if !admin && time <= remote_user->{lastjob} + 30;

			my $source = $prog ? read_file $prog->path : $_{source_code};
			unlink $prog->path if $prog;
			my $id = create_job(
				maybe contest => $_{contest},
				private => $private,
				date => time,
				extension => FORMAT_EXTENSION->{$_{prog_format}},
				format => $_{prog_format},
				problem => $_{problem},
				source => $source,
				owner => remote_user->{id},
			);

			[303, [Location => '/log/' . $id], []]
		},
	}
}


1;
__END__
Commit	Line	Data
	1	package Plack::App::Gruntmaster;
	2
	3	use 5.014000;
	4	use strict;
	5	our $VERSION = '5999.000_001';
	6
	7	use Encode qw/encode decode/;
	8	use File::Slurp qw/read_file/;
	9	use JSON::MaybeXS qw/encode_json/;
	10	use PerlX::Maybe;
	11	use Scope::Upper qw/unwind SUB UP/;
	12	use Web::Simple;
	13
	14	use Gruntmaster::Data;
	15	use Plack::App::Gruntmaster::HTML;
	16
	17	use warnings NONFATAL => 'all';
	18	no warnings 'illegalproto';
	19
	20	##################################################
	21
	22	use constant USER_REGEX => qr/^\w{2,20}$/a;
	23
	24	use constant FORMAT_EXTENSION => {
	25	C => 'c',
	26	CPP => 'cpp',
	27	GCCGO => 'go',
	28	GOLANG => 'go',
	29	GOLFSCRIPT => 'gs',
	30	HASKELL => 'hs',
	31	MONO => 'cs',
	32	JAVA => 'java',
	33	PASCAL => 'pas',
	34	PERL => 'pl',
	35	PYTHON => 'py',
	36	RUBY => 'rb',
	37	SBCL => 'l',
	38	};
	39
	40	use constant NOT_FOUND => [404, ['X-Forever' => 1, 'Content-Type' => 'text/plain'], ['Not found']];
	41
	42	my ($env, $privacy);
	43
	44	sub remote_user {
	45	unless ($env->{'gruntmaster.user'}) {
	46	my $user = $env->{REMOTE_USER};
	47	$user &&= user_entry $user;
	48	$env->{'gruntmaster.user'} = $user;
	49	}
	50	$env->{'gruntmaster.user'}
	51	}
	52
	53	sub admin { remote_user && remote_user->{admin} }
	54
	55	sub redirect { [301, ['X-Forever' => 1, 'Cache-Control' => 'public, max-age=86400', 'Location' => $_[0]], []] }
	56	sub reply { [200, ['Content-Type' => 'text/plain; charset=utf-8'], \@_] }
	57	sub response {
	58	my ($template, $title, $params, $maxage) = @_;
	59	unless ($params) {
	60	$params = $title;
	61	$title = 'No title';
	62	}
	63	$params->{time} = time;
	64	$params->{args} = {%_};
	65	bless {template => $template, title => $title, params => $params, maxage => ($maxage // 3600)}, __PACKAGE__.'::Response'
	66	}
	67
	68	sub forbid {
	69	my ($condition) = @_;
	70	$privacy = 'private' if $condition;
	71	return if !$condition \|\| admin;
	72	unwind $env->{authcomplex}->unauthorized, SUB UP
	73	}
	74
	75	sub dispatch_request{
	76	$env = $_[PSGI_ENV];
	77	$privacy = 'public';
	78
	79	sub (GET) {
	80	sub (/robots.txt) { NOT_FOUND },
	81
	82	sub (/src/:job) {
	83	my $job = db->select(jobs => '*', {id => $_{job}})->hash;
	84	return NOT_FOUND if !$job;
	85	my $isowner = remote_user && remote_user->{id} eq $job->{owner};
	86	my $contest = $job->{contest} && contest_entry $job->{contest};
	87	my $private = $job->{private} \|\| $contest && ($contest->{started} && !$contest->{finished});
	88	forbid !$isowner && $private;
	89	my $privacy = $private ? 'private' : 'public';
	90	my @headers = ('X-Forever' => 1, 'Cache-Control' => "$privacy, max-age=604800", 'Content-Type' => 'text/plain');
	91	push @headers, (Vary => 'Authorization') if $private;
	92	[200, \@headers, [$job->{source}]]
	93	},
	94
	95	sub (?:format~) {
	96	my $format = lc ($_{format} // '');
	97	response_filter {
	98	my ($r) = @_;
	99	return $r if ref $r ne 'Plack::App::Gruntmaster::Response';
	100	my @hdrs = ('X-Forever' => 1, 'Cache-Control' => "$privacy, max-age=$r->{maxage}");
	101	push @hdrs, Vary => 'Authorization' if $privacy eq 'private';
	102	return [200, ['Content-Type' => 'application/json; charset=utf-8', @hdrs], [encode_json $r->{params}]] if $format eq 'json';
	103	my $ret = render $r->{template}, 'en', title => $r->{title}, %{$r->{params}};
	104	[200, ['Content-Type' => 'text/html; charset=utf-8', @hdrs], [encode 'UTF-8', $ret]]
	105	},
	106	},
	107
	108	sub (/st/:contest) {
	109	my @pb = map { [$_->{id}, $_->{name}] } @{problem_list contest => $_{contest}};
	110	response st => 'Standings', {problems => \@pb, st => standings $_{contest}}, 10
	111	},
	112
	113	sub (/ed/:contest) {
	114	my $contest = db->select(contests => '*', {id => $_{contest}})->hash;
	115	forbid time < $contest->{stop};
	116	my $pblist = problem_list contest => $_{contest}, solution => 1;
	117	response ed => 'Editorial of ' . $contest->{name}, {pb => $pblist, editorial => $contest->{editorial}}
	118	},
	119
	120	sub (/login) {
	121	forbid !remote_user;
	122	[200, ['Content-Type' => 'text/plain; charset=UTF-8', 'Cache-Control' => 'private, max-age=300', Vary => 'Authorization'], [$env->{REMOTE_USER}]]
	123	},
	124
	125	sub (/ct/:contest/log/st) { redirect "/st/$_{contest}" },
	126
	127	sub (/us/) { response us => 'Users', {us => user_list} },
	128	sub (/ct/ + ?:owner~) { response ct => 'Contests', {ct => contest_list(%_)}, 300 },
	129	sub (/log/ + ?:contest~&:owner~&:page~&:problem~&:private~&:result~) {
	130	forbid $_{private};
	131	my ($jobs, $pageinfo) = job_list(%_);
	132	response log => 'Job log', {log => $jobs, %$pageinfo}, 5
	133	},
	134	sub (/pb/ + ?:owner~&:contest~&:private~) {
	135	forbid $_{private};
	136	my $pending = $_{contest} && !contest_entry($_{contest})->{started};
	137	forbid $pending;
	138	response pb => 'Problems', {pb => problem_list %_}
	139	},
	140
	141	sub (/us/:user) {
	142	my $user = user_entry $_{user};
	143	response us_entry => $user->{name}, $user
	144	},
	145	sub (/ct/:contest) {
	146	my $contest = contest_entry $_{contest};
	147	response ct_entry => $contest->{name}, $contest, 60
	148	},
	149	sub (/log/:job) {
	150	my $job = job_entry $_{job};
	151	forbid $job->{private};
	152	response log_entry => "Job $_{job}", $job, 10
	153	},
	154	sub (/pb/:problem + ?contest~) {
	155	my (undef, undef, $contest) = @_;
	156	$_{contest} = $contest;
	157	$contest = $contest && contest_entry $_{contest};
	158	return NOT_FOUND if $contest && !contest_has_problem $_{contest}, $_{problem};
	159	my $problem = problem_entry $_{problem}, $_{contest};
	160	forbid $problem->{private} && !$contest;
	161	if ($contest) {
	162	return redirect "/pb/$_{problem}" if !$contest->{started} \|\| $contest->{finished};
	163	forbid !remote_user;
	164	$privacy = 'private';
	165	}
	166	response pb_entry => $problem->{name}, $problem, $_{contest} ? 10 : ();
	167	},
	168	sub (/sol/:problem) {
	169	my $problem = problem_entry $_{problem};
	170	forbid $problem->{private};
	171	response sol => 'Solution of ' . $problem->{name}, {solution => $problem->{solution}};
	172	},
	173
	174	sub (/) { redispatch_to '/index' },
	175	sub (/favicon.ico) { redirect '/static/favicon.ico' },
	176	sub (/:article) { [200, ['Content-Type' => 'text/html; charset=utf-8', 'Cache-Control' => 'public, max-age=3600', 'X-Forever' => 1], [render_article $_{article}, 'en']] }
	177	},
	178
	179	sub (POST) {
	180	sub (/action/submit + %:problem=&:contest~&:prog_format=&:source_code~ + *prog~) {
	181	my (undef, undef, $prog) = @_;
	182	forbid !remote_user;
	183	my $problem = problem_entry $_{problem};
	184	my $private = $problem->{private} ? 1 : 0;
	185	if ($_{contest}) {
	186	$private = 0;
	187	my $contest = contest_entry $_{contest};
	188	return reply 'This contest has not yet started' if !$contest->{started};
	189	return reply 'This contest has finished' if $contest->{finished};
	190	return reply 'This problem is private' if !admin && $private;
	191	return reply 'This problem does not belong to this contest' unless contest_has_problem $_{contest}, $_{problem};
	192	}
	193	return reply 'Maximum source size is 10KB' if ($prog ? $prog->size : length $_{source_code}) > 10 * 1024;
	194	return reply 'You must wait 30 seconds between jobs' if !admin && time <= remote_user->{lastjob} + 30;
	195
	196	my $source = $prog ? read_file $prog->path : $_{source_code};
	197	unlink $prog->path if $prog;
	198	my $id = create_job(
	199	maybe contest => $_{contest},
	200	private => $private,
	201	date => time,
	202	extension => FORMAT_EXTENSION->{$_{prog_format}},
	203	format => $_{prog_format},
	204	problem => $_{problem},
	205	source => $source,
	206	owner => remote_user->{id},
	207	);
	208
	209	[303, [Location => '/log/' . $id], []]
	210	},
	211	}
	212	}
	213
	214
	215	1;
	216	__END__