#!/usr/bin/env perl
our $VERSION = '0.029';
# ABSTRACT: An API from the legacy Metabase::Web to the local database

#pod =head1 SYNOPSIS
#pod
#pod =head1 DESCRIPTION
#pod
#pod =head1 SEE ALSO
#pod
#pod =cut

package CPANTesters::Web::Legacy::Metabase;
use v5.24;
use Mojo::Base '-base';
use Mojo::File 'path';
use Mojolicious::Lite;
use experimental qw( signatures postderef );
use Metabase::Fact;
use Metabase::User::Profile;
use Metabase::User::Secret;
use CPAN::Testers::Report;
use FindBin ();
use CPAN::Testers::Schema;
use Mojo::Util qw( b64_decode );
use Beam::Minion;
use Data::Dumper;

#pod =head1 CONFIG
#pod
#pod The configuration file is set by the C<MOJO_CONFIG> environment
#pod variable, or found in the C<etc/> directory and named C<metabase.conf>
#pod or C<metabase.$mode.conf>. The configuration is a hashref with the
#pod following keys:
#pod
#pod =head2 db
#pod
#pod The C<db> hashref contains the C<dsn>, C<user>, and C<pass> to connect
#pod to the database.
#pod
#pod To create a database for local testing (C<-m local>), install the latest
#pod CPAN Testers schema using: C<< cpantesters-schema install dbi:SQLite:local.db >>.
#pod
#pod =cut

app->log( Mojo::Log->new ); # Log only to STDERR
app->home( path( $FindBin::Bin )->dirname ) unless $ENV{MOJO_HOME};
app->moniker( 'metabase' );
my $root_conf = app->home->child( sprintf 'etc/%s.conf', app->moniker );
plugin Config => (
    file => $ENV{MOJO_CONFIG} || $root_conf,
);

get '/' => 'index';

#pod =attr schema
#pod
#pod The schema to write reports to. Defaults to a new L<CPAN::Testers::Schema>
#pod object.
#pod
#pod =cut

helper schema => sub {
    my ( $c, $new_schema ) = @_;
    state $schema = $new_schema || CPAN::Testers::Schema->connect( $c->app->config->{db}->@{qw( dsn user pass args )} );
    $schema = $new_schema if $new_schema;
    return $schema;
};

#pod =route /beta/submit/CPAN-Testers-Metabase
#pod
#pod =route /api/v1/submit/CPAN-Testers-Metabase
#pod
#pod This route submits a new report into the local copy of the Metabase.
#pod This is a shim that will remain in-place until all the CPAN Testers clients
#pod are updated to submit reports via the new API (so, forever).
#pod
#pod =cut

# This code was derived from CPAN::Testers::Data::Generator sub cache_report
# Once this is working, we can force CPAN::Testers::Data::Generator to
# ignore the Amazon SimpleDB Metabase by making the localonly flag
# always set to true.

# We are also mimicking parts of Metabase::Web and Metabase::Gateway

sub handle_post {
    my ( $c ) = @_;
    #$c->app->log->debug( "Got: " . $c->req->body );

    # Validate the user
    my ( undef, $auth ) = split / /, $c->req->headers->authorization;
    my ( $guid, $secret ) = split /:/, b64_decode( $auth );
    my $user = $c->schema->resultset( 'MetabaseUser' )->search( { resource => 'metabase:user:' . $guid } )->single;
    if ( !$user ) {
        $c->app->log->info( 'Unregistered user ' . $guid );
        return $c->render(
            status => 401,
            json => {
                error => 'User ' . $guid . ' unrecognized',
            },
        );
    }

    my $fact = Metabase::Fact->from_json( $c->req->body );
    my $row = $c->schema->resultset( 'TestReport' )->insert_metabase_fact( $fact );
    $c->app->log->info(
        sprintf 'Wrote report %s from %s (%s)', $row->id, $user->fullname, $user->email,
    );

    # Each attempts will try again after a number of seconds increasing
    # via the fibonnacci sequence. So, 30 attempts reaches about 50,000
    # seconds (by which point it will have waited almost 2 days for
    # whatever problem, likely the `uploads` row missing, to resolve)
    Beam::Minion->enqueue( report => 'queue', [ $row->id ], { attempts => 30 } );

    my $url = $c->req->url->clone;
    my $path = $url->path;
    splice $path->@*, -2, 2, 'guid', $row->id;
    $c->res->headers->location( $url );

    return $c->render(
        status => 201,
        json => { guid => $row->id },
    );
};

post '/api/v1/submit/CPAN-Testers-Report' => \&handle_post;
post '/beta/submit/CPAN-Testers-Report' => \&handle_post;

#pod =route /api/v1/register
#pod
#pod =route /beta/register
#pod
#pod Register a new Metabase user. This does not appear to be used by any
#pod CPAN Testers reporter client, but if it is, we can add the user to the
#pod C<metabase_user> table (the
#pod L<CPAN::Testers::Schema::Result::MetabaseUser> result class).
#pod
#pod =cut

sub handle_register( $c ) {
    #$c->app->log->debug( $c->req->body );
    my @things = ref $c->req->json eq 'ARRAY' ? $c->req->json->@* : ( $c->req->json );
    for my $body ( @things ) {
        my $fact = Metabase::Fact->class_from_type( $body->{metadata}{core}{type} )
            ->from_struct( $body );
        $c->app->log->debug( sprintf 'Got %s object during registration', ref $fact );

        if ( ref $fact->content ne 'ARRAY' ) {
            $c->app->log->warn( 'Registration fact object content is not an array. Skipping!' );
            $c->app->log->debug( sprintf 'Fact object content %s', Dumper $fact->content );
            next;
        }

        my ( $fullname ) = grep { $_->isa( 'Metabase::User::FullName' ) } $fact->content->@*;
        my ( $email ) = grep { $_->isa( 'Metabase::User::EmailAddress' ) } $fact->content->@*;

        my $row = $c->schema->resultset( 'MetabaseUser' )->update_or_create({
            resource => $fact->resource,
            fullname => $fullname->content,
            email => $email->content,
        });

        $c->app->log->info(
            sprintf 'Registered user ID %s named "%s" (email: %s)', $row->resource, $row->fullname, $row->email,
        );
    }

    return $c->render(
        status => 200,
        json => { message => 'accepted' },
    );
}

post '/api/v1/register' => \&handle_register;
post '/beta/register' => \&handle_register;

#pod =route /api/v1/guid/:guid
#pod
#pod =route /beta/guid/:guid
#pod
#pod This is necessary during the registration as a pre-flight check before
#pod submitting the user registration, for some reason...
#pod
#pod =cut

sub handle_guid( $c ) {
    my $guid = $c->stash( 'guid' );
    my $user = $c->schema->resultset( 'MetabaseUser' )->search( { resource => 'metabase:user:' . $guid } )->single;
    if ( !$user ) {
        $c->app->log->info( 'Unregistered user ' . $guid );
        return $c->render(
            status => 404,
            json => {
                error => $guid . ' not found',
            },
        );
    }
};

get '/api/v1/guid/:guid' => \&handle_guid;
get '/beta/guid/:guid' => \&handle_guid;

#pod =route /tail/log.txt
#pod
#pod See a log of the last view CPAN Testers reports.
#pod
#pod =cut

get '/tail/log' => [ format => [qw( txt )] ], sub( $c ) {
    my $file = app->home->child( 'tail.log' );
    my $age = time - [stat $file]->[9];
    my $expires_in = $age < 300 ? 300 - $age : 0;
    $c->res->headers->cache_control( 'max-age=' . $expires_in . ', must-revalidate' ); # Cache for 300 seconds
    $c->res->headers->content_type( 'text/plain' );
    my $asset = Mojo::Asset::File->new( path => $file );
    return $c->reply->asset( $asset );
};

helper refresh_tail_log => sub {
    my $file = app->home->child( 'tail.log' );
    my $rs = app->schema->resultset( 'TestReport' )->search(
        { 'report' => \'->>"$.environment.language.name" = "Perl 5"' },
        { order_by => { -desc => 'created' }, rows => 1000 },
    );
    my @reports = $rs->all;
    $file->spew(
        app->build_controller->render_to_string( 'tail/log', format => 'txt', reports => \@reports )
    );
};

app->start;

=pod

=head1 NAME

CPANTesters::Web::Legacy::Metabase - An API from the legacy Metabase::Web to the local database

=head1 VERSION

version 0.029

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 ATTRIBUTES

=head2 schema

The schema to write reports to. Defaults to a new L<CPAN::Testers::Schema>
object.

=head1 SEE ALSO

=head1 CONFIG

The configuration file is set by the C<MOJO_CONFIG> environment
variable, or found in the C<etc/> directory and named C<metabase.conf>
or C<metabase.$mode.conf>. The configuration is a hashref with the
following keys:

=head2 db

The C<db> hashref contains the C<dsn>, C<user>, and C<pass> to connect
to the database.

To create a database for local testing (C<-m local>), install the latest
CPAN Testers schema using: C<< cpantesters-schema install dbi:SQLite:local.db >>.

=route /beta/submit/CPAN-Testers-Metabase

=route /api/v1/submit/CPAN-Testers-Metabase

This route submits a new report into the local copy of the Metabase.
This is a shim that will remain in-place until all the CPAN Testers clients
are updated to submit reports via the new API (so, forever).

=route /api/v1/register

=route /beta/register

Register a new Metabase user. This does not appear to be used by any
CPAN Testers reporter client, but if it is, we can add the user to the
C<metabase_user> table (the
L<CPAN::Testers::Schema::Result::MetabaseUser> result class).

=route /api/v1/guid/:guid

=route /beta/guid/:guid

This is necessary during the registration as a pre-flight check before
submitting the user registration, for some reason...

=route /tail/log.txt

See a log of the last view CPAN Testers reports.

=head1 AUTHOR

Doug Bell <preaction@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2018 by Doug Bell.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__DATA__
@@ index.html.ep
<!DOCTYPE html>
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha384-BVYiiSIFeK1dGmJRAkycuHAHRg32OmUcww7on3RYdg4Va+PmSTsz/K68vbdEjh4u" crossorigin="anonymous">
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap-theme.min.css" integrity="sha384-rHyoN1iRsVXV4nD0JutlnGaslCJuC7uwjduW9SVrLvRYooPp2bWYgmgJQIXwl/Sp" crossorigin="anonymous">
<script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha384-Tc5IQib027qvyjSMfHjOMaLkfuWVxZxUPnCJA7l2mCWNIpG9mGCD8wGNIcPD7Txa" crossorigin="anonymous"></script>
<style>body { margin-top: 40px }</style>
<title>Metabase - CPAN Testers</title>
<nav class="navbar navbar-default navbar-fixed-top" role="navigation">
    <div class="container-fluid">
        <div class="navbar-header">
            <button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false" aria-controls="navbar">
                <span class="sr-only">Toggle navigation</span>
                <span class="icon-bar"></span>
                <span class="icon-bar"></span>
                <span class="icon-bar"></span>
            </button>
            <div class="navbar-brand">
                <a href="http://api.cpantesters.org">
                    <strong>CPAN Testers API</strong>
                </a>
            </div>
        </div>

        <div class="navbar-collapse collapse">
            <ul class="nav navbar-nav navbar-left">
                <li><a href="http://cpantesters.org">Reports</a></li>
                <li><a href="http://api.cpantesters.org">API</a></li>
                <li><a href="http://blog.cpantesters.org">Blog</a></li>
                <li><a href="http://github.com/cpan-testers">Github</a></li>
            </ul>
        </div>
    </div>
</nav>


<div class="container">
    <h1>CPAN Testers Metabase</h1>
    <p>The <strong>Metabase</strong> was the main repository of CPAN Testers reports. It has been replaced
    with a <a href="http://api.cpantesters.org/docs/?url=/v3#!/Report/v3_report_post">new test report API</a>
    being stored in the local <a href="http://mysql.org">MySQL database</a>.</p>

    <p>This site is a shim API to support legacy Metabase clients and translate their reports
    to the new test report format. Metabase clients will continue to work, but will not gain the
    benefit of the new test report's additional data fields.</p>
</div>

@@ tail/log.txt.ep
% use v5.24;
% use DateTime;
% my @reports = stash( 'reports' )->@*;
The last <%= scalar @reports %> reports as of <%= DateTime->now %>Z:
% for my $row ( @reports ) {
% my $report = $row->report;
% my $grade = $report->{result}{grade};
% my $name = $report->{reporter}{name};
% my $upload = $row->upload;
% my $file = $upload ? join "/", $upload->author, $upload->filename : '';
% my ( $arch, $perl_version ) = $report->{environment}{language}->@{qw(archname version )};
[<%== $row->created %>Z] [<%== $name %>] [<%== $grade %>] [<%== $file %>] [<%== $arch %>] [perl-v<%== $perl_version %>] [<%== $row->id %>] [<%== $row->created %>Z]
% }
