Merge pull request #58 from isucon/perl

.github/workflows/perl.yml

@@ -0,0 +1,85 @@
+name: Perl CI
+on:
+  push:
+    branches: [main]
+    paths:
+      - bench/**/*
+      - webapp/perl/**/*
+      - webapp/sql/**/*
+      - webapp/pdns/**/*
+      - development/docker-compose-common.yml
+      - development/docker-compose-perl.yml
+      - development/Makefile
+      - .github/workflows/perl.yml
+  pull_request:
+    paths:
+      - bench/**/*
+      - webapp/perl/**/*
+      - webapp/sql/**/*
+      - webapp/pdns/**/*
+      - development/docker-compose-common.yml
+      - development/docker-compose-perl.yml
+      - development/Makefile
+      - .github/workflows/perl.yml
+  workflow_dispatch:
+jobs:
+  test:
+    runs-on: [isucon13-ci-03]
+    steps:
+      - name: Check out code into the Go module directory
+        uses: actions/checkout@v4
+
+      - name: Setup Go
+        uses: actions/setup-go@v4
+        with:
+          go-version: 1.21.1
+
+      - uses: actions/setup-node@v4
+        with:
+          node-version: 20
+      - run: corepack enable yarn
+
+      # to avoid error: Deleting the contents of '/home/ubuntu/actions-runner/_work/isucon13/isucon13'
+      #                 Error: File was unable to be removed Error: EACCES: permission denied, rmdir
+      # https://github.com/actions/checkout/issues/211
+      - name: chown workdir
+        run:
+          sudo chown -R $USER:$USER $GITHUB_WORKSPACE
+
+      # containers
+      - name: "setup containers"
+        working-directory: ./development
+        run: |
+          make down/perl
+          make up/perl
+
+      - name: "[frontend] build"
+        working-directory: ./frontend
+        run: make
+
+      # bench
+      - name: "[bench] Get deps"
+        working-directory: ./bench
+        env:
+          TZ: Asia/Tokyo
+        run: |
+          go get -v -t -d ./...
+
+      - name: "run bench"
+        working-directory: ./bench
+        run: |
+          make bench
+
+      - name: Show webapp logs
+        if: ${{ always() }}
+        working-directory: ./development
+        run: sudo docker compose -f docker-compose-common.yml -f docker-compose-perl.yml logs webapp
+
+      - name: "[bench] Test"
+        working-directory: ./bench
+        env:
+          TZ: Asia/Tokyo
+        run: |
+          go clean -testcache
+          go test -p=1 -v ./...
+

development/docker-compose-perl.yml

@@ -0,0 +1,27 @@
+version: '3.0'
+
+services:
+  webapp:
+    cpus: 2
+    mem_limit: 4g
+    build:
+      context: ../webapp/perl
+    init: true
+    working_dir: /home/isucon/webapp/perl
+    container_name: webapp
+    volumes:
+      - ../webapp/sql:/home/isucon/webapp/sql
+      - ../webapp/pdns:/home/isucon/webapp/pdns
+      - ../provisioning/ansible/roles/powerdns/files/pdns.conf:/etc/powerdns/pdns.conf:ro
+      - ../provisioning/ansible/roles/powerdns/files/pdns.d/docker.conf:/etc/powerdns/pdns.d/docker.conf:ro
+      - ../webapp/img:/home/isucon/webapp/img
+    environment:
+      ISUCON13_MYSQL_DIALCONFIG_ADDRESS: mysql
+      ISUCON13_POWERDNS_HOST: powerdns
+      ISUCON13_POWERDNS_SUBDOMAIN_ADDRESS: 127.0.0.1
+      ISUCON13_POWERDNS_DISABLED: true
+    ports:
+      - "127.0.0.1:8080:8080"
+    depends_on:
+      mysql:
+        condition: service_healthy

webapp/perl/.gitignore

@@ -0,0 +1 @@
+/local

webapp/perl/Dockerfile

@@ -0,0 +1,36 @@
+FROM perl:5.38.0-bookworm
+
+WORKDIR /tmp
+ENV DEBIAN_FRONTEND=noninteractive
+RUN apt-get update && \
+    apt-get -y upgrade && \
+    apt-get install -y curl wget gcc g++ make sqlite3 locales locales-all && \
+    wget -q https://dev.mysql.com/get/mysql-apt-config_0.8.22-1_all.deb && \
+    apt-get -y install ./mysql-apt-config_0.8.22-1_all.deb && \
+    apt-get -y update && \
+    apt-get -y install default-mysql-client pdns-server pdns-backend-mysql
+
+RUN rm -f /etc/powerdns/pdns.d/bind.conf
+
+RUN locale-gen en_US.UTF-8
+RUN useradd --uid=1001 --create-home isucon
+USER isucon
+
+RUN mkdir -p /home/isucon/webapp/perl
+WORKDIR /home/isucon/webapp/perl
+
+COPY cpanfile ./
+RUN cpm install --show-build-log-on-failure
+
+COPY --chown=isucon:isucon ./ /home/isucon/webapp/perl/
+ENV PERL5LIB=/home/isucon/webapp/perl/local/lib/perl5
+ENV PATH=/home/isucon/webapp/perl/local/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin
+
+ENV LANG en_US.UTF-8
+ENV LANGUAGE en_US:en
+ENV LC_ALL en_US.UTF-8
+
+ENV TZ utc
+
+EXPOSE 8080
+CMD ["./local/bin/plackup", "-s", "Starlet", "-p", "8080", "-Ilib", "app.psgi"]

webapp/perl/app.psgi

@@ -0,0 +1,20 @@
+use v5.38;
+
+use File::Basename;
+use Plack::Builder;
+use Isupipe::App;
+
+my $root_dir = File::Basename::dirname(__FILE__);
+
+my $app = Isupipe::App->psgi($root_dir);
+
+builder {
+    enable 'ReverseProxy';
+    enable 'Session::Cookie',
+        session_key => 'isupipe_perl',
+        domain      => 'u.isucon.dev',
+        path        => '/',
+        expires     => 3600,
+        secret      => $ENV{ISUCON13_SESSION_SECRETKEY} || 'defaultsecret';
+    $app;
+}

webapp/perl/cpanfile

@@ -0,0 +1,20 @@
+requires 'perl', '5.038';
+
+requires 'Kossy', '0.63';
+requires 'Plack::Middleware::Session', '0.33';
+requires 'HTTP::Message', '6.45';
+requires 'Cpanel::JSON::XS', '4.37';
+requires 'Starlet', '0.31';
+
+# DBD::[email protected] requires requires MySQL 8.x client libraries.
+# https://github.com/perl5-dbi/DBD-mysql/issues/378#issuecomment-1786759895
+requires 'DBD::mysql', '== 4.051';
+
+requires 'DBIx::Sunny', '0.9993';
+requires 'Log::Minimal', '0.19';
+requires 'Type::Tiny', '2.004000';
+requires 'Crypt::Eksblowfish::Bcrypt', '0.009';
+requires 'Crypt::OpenSSL::Random', '0.15';
+requires 'Data::Lock', '1.03';
+requires 'JSON::Types', '0.05';
+requires 'Digest::SHA', '6.04';

webapp/perl/lib/Isupipe/App.pm

@@ -0,0 +1,152 @@
+package Isupipe::App;
+use v5.38;
+use utf8;
+use experimental qw(try);
+
+use Kossy;
+use HTTP::Status qw(:constants);
+use DBIx::Sunny;
+
+$Kossy::JSON_SERIALIZER = Cpanel::JSON::XS->new()->ascii(0)->utf8->convert_blessed;
+
+use Isupipe::Log;
+use Isupipe::Handler::LivecommentHandler;
+use Isupipe::Handler::LivestreamHandler;
+use Isupipe::Handler::PaymentHandler;
+use Isupipe::Handler::ReactionHandler;
+use Isupipe::Handler::StatsHandler;
+use Isupipe::Handler::TopHandler;
+use Isupipe::Handler::UserHandler;
+
+sub connect_db() {
+    my $host     = $ENV{ISUCON13_MYSQL_DIALCONFIG_ADDRESS}    || '127.0.0.1';
+    my $port     = $ENV{ISUCON13_MYSQL_DIALCONFIG_PORT}       || '3306';
+    my $user     = $ENV{ISUCON13_MYSQL_DIALCONFIG_USER}       || 'isucon';
+    my $password = $ENV{ISUCON13_MYSQL_DIALCONFIG_PASSWORD}   || 'isucon';
+    my $dbname   = $ENV{ISUCON13_MYSQL_DIALCONFIG_DATABASE}   || 'isupipe';
+
+    my $dsn = "dbi:mysql:database=$dbname;host=$host;port=$port";
+    my $dbh = DBIx::Sunny->connect($dsn, $user, $password, {
+        mysql_enable_utf8mb4 => 1,
+        mysql_auto_reconnect => 1,
+    });
+    return $dbh;
+}
+
+sub dbh($self) {
+    $self->{_dbh} //= connect_db();
+}
+
+sub initialize_handler($self, $c) {
+    my $e = system($self->root_dir . "/../sql/init.sh");
+    if ($e) {
+        warnf("init.sh failed with err=%s", $e);
+        $c->halt(HTTP_INTERNAL_SERVER_ERROR, "faild to initialize: $e");
+    }
+
+    return $c->render_json({
+        advertise_level => 10,
+        language        => 'perl',
+    });
+}
+
+sub h($klass, $name) {
+    my $handler_class = "Isupipe::Handler::$klass";
+    my $handler = $handler_class->can($name);
+    unless ($handler) {
+        local $Log::Minimal::TRACE_LEVEL = $Log::Minimal::TRACE_LEVEL + 1;
+        croakf("handler `%s` not found in %s", $name, $handler_class);
+    }
+    return sub ($app, $c) {
+        try {
+            my $response = $handler->($app, $c);
+            return $response;
+        } catch ($error) {
+            error_response_handler($error, $app, $c);
+        }
+    }
+}
+
+# 初期化
+post '/api/initialize', \&initialize_handler;
+
+# top
+get '/api/tag', h(TopHandler => 'get_tag_handler');
+
+# livestream
+# reserve livestream
+post '/api/livestream/reservation', h(LivestreamHandler => 'reserve_livestream_handler');
+# list livestream
+get '/api/livestream/search', h(LivestreamHandler => 'search_livestreams_handler');
+get '/api/livestream', h(LivestreamHandler => 'get_my_livestreams_handler');
+
+# get livestream
+get '/api/livestream/{livestream_id:[0-9]+}', h(LivestreamHandler => 'get_livestream_handler');
+
+# get polling livecomment timeline
+get '/api/livestream/{livestream_id:[0-9]+}/livecomment', h(LivecommentHandler => 'get_livecomments_handler');
+# ライブコメント投稿
+post '/api/livestream/{livestream_id:[0-9]+}/livecomment', h(LivecommentHandler => 'post_livecomment_handler');
+post '/api/livestream/{livestream_id:[0-9]+}/reaction', h(ReactionHandler => 'post_reaction_handler');
+get  '/api/livestream/{livestream_id:[0-9]+}/reaction', h(ReactionHandler => 'get_reactions_handler');
+
+# (配信者向け)ライブコメント一覧取得API
+get '/api/livestream/{livestream_id:[0-9]+}/report', h(LivestreamHandler => 'get_livecomment_reports_handler');
+get '/api/livestream/{livestream_id:[0-9]+}/ngwords', h(LivecommentHandler => 'get_ngwords_handler');
+
+# ライブコメント報告
+post '/api/livestream/{livestream_id:[0-9]+}/livecomment/:livecomment_id/report',  h(LivecommentHandler => 'report_livecomment_handler');
+# 配信者によるモデレーション (NGワード登録)
+post '/api/livestream/{livestream_id:[0-9]+}/moderate', h(LivecommentHandler => 'moderate_handler');
+
+# livestream_viewersにINSERTするため必要
+# ユーザ視聴開始 (viewer)
+post '/api/livestream/{livestream_id:[0-9]+}/enter', h(LivestreamHandler => 'enter_livestream_handler');
+# ユーザ視聴終了 (viewer)
+router 'DELETE' => '/api/livestream/{livestream_id:[0-9]+}/exit',  h(LivestreamHandler => 'exit_livestream_handler');
+
+# user
+post '/api/register', h(UserHandler => 'register_handler');
+post '/api/login', h(UserHandler => 'login_handler');
+get '/api/user/me',  h(UserHandler => 'get_me_handler');
+
+# フロントエンドで、配信予約のコラボレーターを指定する際に必要
+get '/api/user/:username',  h(UserHandler => 'get_user_handler');
+get '/api/user/:username/livestream', h(LivestreamHandler => 'get_user_livestreams_handler');
+get '/api/user/:username/theme', h(TopHandler => 'get_streamer_theme_handler');
+get '/api/user/:username/statistics',  h(StatsHandler => 'get_user_statistics_handler');
+get '/api/user/:username/icon',  h(UserHandler => 'get_icon_handler');
+post '/api/icon',  h(UserHandler => 'post_icon_handler');
+
+# stats
+# ライブ配信統計情報
+get '/api/livestream/{livestream_id:[0-9]+}/statistics', h(StatsHandler => 'get_livestream_statistics_handler');
+
+# 課金情報
+get '/api/payment', h(PaymentHandler => 'get_payment_result');
+
+
+sub error_response_handler($error, $app, $c) {
+    if ($error isa Kossy::Exception) {
+        if ($error->{response}) {
+            die $error; # rethrow
+        }
+
+        # JSON にして投げ直し
+        debugf("(Kossy::Exception) %s %s%s : %s %s", $c->req->method, $c->env->{HTTP_HOST}, $c->req->path, $error->{code}, $error->{message});
+
+        my $res = $c->render_json({
+            error => $error->{message},
+        });
+        $res->status($error->{code});
+        return $res;
+    }
+
+    warnf("error at %s: %s", $c->req->path, $error);
+
+    my $res = $c->render_json({
+        error => Isupipe::Log::ddf($error),
+    });
+    $res->status(HTTP_INTERNAL_SERVER_ERROR);
+    return $res;
+}

webapp/perl/lib/Isupipe/Assert.pm

@@ -0,0 +1,25 @@
+package Isupipe::Assert;
+use v5.38;
+
+use Exporter 'import';
+
+our @EXPORT = qw(
+    ASSERT
+    assert_field
+);
+
+use Carp qw(croak);
+
+# 本番環境ではassertしない
+# 下記のassert_field以外にも、Isupipe::Util#check_paramsでも利用
+use constant ASSERT => ($ENV{PLACK_ENV}||'') ne 'production';
+
+# 開発環境では、型チェックをしてあげる
+sub assert_field($type, $value, $field_name) {
+    if (ASSERT && defined $value) {
+        unless ($type->check($value)) {
+            croak "Invalid field `$field_name`: " . $type->get_message($value);
+        }
+    }
+}
+