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