Add Oberon

[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',
	OBERON => 'm',
	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}] } 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~)                            { 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__