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

use 5.010;
use strict;
use warnings;

use DBI;
use File::Slurp::Tiny qw(read_file);
use File::Write::Rotate;
use JSON;
use Perinci::Access::Base::Patch::PeriAHS;
use Plack::Builder;
use Plack::Util::PeriAHS qw(errpage);
use CPANLists::Server;

my $json = JSON->new->allow_nonref;
my $home = (getpwuid($>))[7];  # $ENV{HOME} is empty if via fcgi
my $conf = $json->decode(~~read_file("$home/cpanlists-server.conf.json"));
my $dbh  = DBI->connect($conf->{dbdsn} ? $conf->{dbdsn} :
                            "dbi:Pg:dbname=$conf->{dbname};host=localhost",
                        $conf->{dbuser}, $conf->{dbpass}, {RaiseError=>0});
CPANLists::Server::__dbh($dbh);
CPANLists::Server::__init_db();
CPANLists::Server::__conf($conf); # XXX for security, in the future it's better to not let webapp see db credentials

my $fwr = File::Write::Rotate->new(
    dir       => $conf->{riap_access_log_dir},
    prefix    => $conf->{riap_access_log_prefix},
    size      => $conf->{riap_access_log_size},
    histories => $conf->{riap_access_log_histories},
);

my $app = builder {
    enable(
        "PeriAHS::LogAccess",
        dest => $fwr,
    );

    #enable "PeriAHS::CheckAccess";

    enable(
        "PeriAHS::ParseRequest",
        #parse_path_info => $args{parse_path_info},
        #parse_form      => $args{parse_form},
        #parse_reform    => $args{parse_reform},
        riap_uri_prefix  => '/CPANLists/Server',
    );

    enable_if(
        sub {
            my $env = shift;
            my $rreq = $env->{'riap.request'};
            my $action = $rreq->{action};
            my ($mod, $func) = $rreq->{uri} =~ m!\A(?:pl:)?/(.+)/(.+)!;
            $mod //= ""; $func //= "";

            # public actions that need not authentication
            if ($action =~ /^(meta|info|actions|list|child_metas)$/ ||
                    $action eq 'call' && $mod eq 'CPANLists/Server' && $func =~ /\A(get_bitcard_signin_url|verify_bitcard_signin|get_list|list_lists|list_items|get_list_comment|list_list_comments)\z/) {
                $env->{"app.needs_auth"} = 0;
                return 0;
            } else {
                $env->{"app.needs_auth"} = 1;
                return 1;
            }
        },
        "Auth::Basic",
        authenticator => sub {
            my ($user, $pass, $env) = @_;

            #my $role;
            #my $res = CPANLists::Server::auth_user(
            #    username => $user, password=>$pass);
            my $res = CPANLists::Server::check_session(
                username => $user, id => $pass);
            if ($res->[0] == 200) {
                $env->{"REMOTE_USER"} = $user; # isn't this already done by webserver?
                $env->{"app.user_id"} = $res->[2]{userid};
                return 1;
            }
            return 0;
        }
    );

    enable(
        sub {
            my $app = shift;
            sub {
                my $env = shift;
                my $rreq = $env->{'riap.request'};

                $rreq->{uri} =~ s!\Apl:/api/!pl:/!;

                my ($mod, $func) = $rreq->{uri} =~ m!\A(?:pl:)?/(.+)/(.+)!;
                $mod =~ s!/!::!g;

                # authz
                {
                    last unless $env->{"app.needs_auth"};

                    my $uid  = $env->{"app.user_id"};
                    my $user = $env->{REMOTE_USER};
                    #my $role = $env->{"app.user_role"};

                    # everybody can create/comment/like/unlike lists
                    last if $func =~ /^(create_list|add_list_comment|like_list|unlike_list)$/;

                    # user can add item/update/delete item of lists he created
                    if ($func =~ /^(delete_list|update_list|add_item|delete_item|update_item)$/) {
                        my $lid = $func =~ /^(delete_list|update_list)$/ ? $rreq->{args}{id} : $rreq->{args}{list_id};
                        my $res = CPANLists::Server::get_list(id => $lid, items=>0);
                        return errpage($env, $res) if $res->[0] != 200;
                        return errpage($env, [403, "List is not yours"])
                            unless $res->[2]{creator} eq $user;
                        last;
                    }

                    # user can update/delete his own list comments
                    if ($func =~ /^(delete_list_comment|update_list_comment)$/) {
                        my $cid = $rreq->{args}{id};
                        my $res = CPANLists::Server::get_list_comment(id => $cid);
                        return errpage($env, $res) if $res->[0] != 200;
                        return errpage($env, [403, "List comment is not yours"])
                            unless $res->[2]{creator} eq $user;
                        last;
                    }

                    # no other functions are available
                    return errpage($env, [403, "Unauthorized"]);
                }

                CPANLists::Server::__env($env);
                $app->($env);
            };
        },
    );

    enable "PeriAHS::Respond";
};

=head1 SYNOPSIS

To deploy as FastCGI script, see INSTALL.org. This will require a restart
(killing the FCGI process) whenever we modify the application.

For testing, you can run:

 % plackup api.psgi

To test the app:

 # first sign in via bitcard
 % curl http://localhost:5000/api/get_bitcard_signin_url
 https://www.bitcard.org/...

 # follow the URL in the browser
 % curl https://www.bitcard.org/...

 # you will be returned to https://cpanlists.org/api/verify_bitcard_signin?...
 # replace the host with the test host and follow it
 % curl http://localhost:5000/api/verify_bitcard_signin?...

 # you will retrieve session ID (SESSID) which will be required to perform
 # functions that need authentication.

 % curl http://localhost:5000/api/list_lists
 % curl -u USER:SESSID 'http://localhost:5000/api/like_list?id=1'
 % curl -u USER:SESSID 'http://localhost:5000/api/unlike_list?id=1'


=head1 DESCRIPTION

=cut