Added rudimentary HTTP interface

TrsrDB/Credit.pm

@@ -18,8 +18,7 @@ __PACKAGE__->belongs_to(
 );
 
 __PACKAGE__->has_many(
-    outgoings => 'TrsrDB::Transfer',
-    { 'foreign.fromCredit' => 'self.credId' }
+    outgoings => 'TrsrDB::Transfer', 'credId'
 );
 
 __PACKAGE__->has_many(

TrsrDB/Debit.pm

@@ -6,12 +6,12 @@ use base qw/DBIx::Class::Core/;
 __PACKAGE__->table('Debit');
 __PACKAGE__->add_column("billId");
 __PACKAGE__->add_column("debtor");
-__PACKAGE__->add_column("targetCredit" => { data_type => 'INTEGER' });
 __PACKAGE__->add_column("date" => { data_type => 'DATE' });
 __PACKAGE__->add_column("purpose");
 __PACKAGE__->add_column("value" => { data_type => 'INTEGER' });
 __PACKAGE__->add_column("paid" => { data_type => 'INTEGER', default => 0 });
 __PACKAGE__->set_primary_key("billId");
+__PACKAGE__->add_column("targetCredit" => { data_type => 'INTEGER' });
 
 __PACKAGE__->belongs_to(
     account => 'TrsrDB::Account',

TrsrDB/Error.pm

@@ -0,0 +1,52 @@
+use 5.014;
+
+package TrsrDB::Error {
+use Moose;
+extends 'Throwable::Error';
+
+use overload eq => sub { ref($_[0]) eq $_[1] };
+
+has http_status => (
+    is => 'rw',
+    isa => 'Num',
+);
+
+has _remote_stack_trace => (
+    is => 'ro', isa => 'Str'
+);
+
+sub dump {
+    my ($self, $with_internals) = @_;
+    my $stack_trace = $self->stack_trace;
+    my (@frames);
+    while ( my $next = $stack_trace->next_frame ) {
+        last if $next->package eq 'FTM::User::Interface'
+             && $next->subroutine eq 'Try::Tiny::try';
+        push @frames, $next;
+    }
+    return {
+        (map { $_ => $self->$_ } qw(message user_seqno http_status)),
+        $with_internals // 1 ? (
+            _is_ftm_error => ref $self,
+            _remote_stack_trace => join(
+                "", map { $_->as_string . "\n" } @frames
+            )
+        ) : (),
+        inner(),
+    };
+}
+
+override as_string => sub {
+    my $self = shift;
+    if ( defined(my $rst = $self->_remote_stack_trace) ) {
+        $rst =~ s{^}{[BACKEND] }mg;
+        return $self->message.$rst;
+    }    
+    else { super(); }
+};
+
+__PACKAGE__->meta->make_immutable;
+
+}
+
+1;

TrsrDB/HTTP.pm

@@ -0,0 +1,259 @@
+use strict;
+
+package TrsrDB::HTTP;
+use TrsrDB::Error;
+use Mojolicious 6.0;
+use Mojolicious::Sessions;
+use Mojo::Base 'Mojolicious';
+use POSIX qw(strftime);
+
+has db => sub {
+    my $db;
+    eval q{use TrsrDB \$db} or $@ && die $@;
+    return $db;
+};
+
+# This method will run once at server start
+sub startup {
+  my $self = shift;
+
+  $self->secrets([rand]);
+  $self->sessions->cookie_name('TrsrDB');
+
+  $self->config(
+      hypnotoad => {
+          listen => [ $ENV{MOJO_LISTEN} ],
+          pid_file => $ENV{PIDFILE},
+          workers => 2,
+  });
+
+  $self->defaults(
+      layout => 'default',
+      user => undef,
+  );
+
+
+  if ( my $l = $ENV{LOG} ) {
+      use Mojo::Log;
+      open my $fh, '>', $l or die "Could not open logfile $l to write: $!";
+      $self->log( Mojo::Log->new( handle => $fh, level => 'warn' ) );
+  }
+
+  unshift @{$self->static->paths}, $self->home->rel_dir('site');
+
+  $self->helper( 'reply.client_error' => \&prepare_client_error );
+
+  $self->hook( before_render => \&restapi_reply_jsonifier );
+
+  # Router
+  my $r = $self->routes->under(\&initialize_stash);
+  $r->any( [qw/GET POST/] => "/login" )->to("user#login", retry_msg => 0 );
+
+  my $auth = $r->under(\&require_user_otherwise_login_or_fail);
+
+  $auth->get( '/logout' )->to("user#logout");
+
+  my $admin = $auth->under(sub { shift->stash('grade') > 1 });
+  $admin->any('/admin')->to('admin#dash');
+  $admin->post('/:account/in')->to('credit#upsert');
+  $admin->post('/:account/out')->to('debit#upsert');
+  $admin->get('/:account/credits')->to('credit#list');
+  $admin->get('/:account/debits')->to('debit#list');
+  $admin->post('/:account/transfer')->to('account#transfer');
+  $admin->any( [qw/GET POST PATCH/] => '/credit/:id' )->to('credit#upsert');
+  $admin->post('/credit')->to('credit#upsert');
+  $admin->any( [qw/GET POST PATCH/] => '/debit/*id' )->to('debit#upsert');
+  $admin->post('/debit')->to('debit#upsert');
+  $admin->get('/:action')->to(controller => 'admin');
+
+  $auth->get('/')->to('account#list')->name('home');
+
+  my $check = $auth->under(sub { shift->stash('grade') })->get('/');
+  $check->get('/bankStatement')->to(sub {
+      my $c = shift;
+      $c->stash( records => $c->app->db->resultset("ReconstructedBankStatement") );
+      $c->render('bankStatement');
+  });
+
+  my $account = $auth->get('/:account')->under(sub {
+      my $c = shift;
+
+      my $account = $c->stash('account');
+      if ( my $acc = $c->app->db->resultset('Account')->find($account) ) {
+          $c->stash( account => $acc );
+          $account = $acc;
+      }
+      else {
+          $c->reply->not_found;
+          return;
+      }
+
+      return $account->type ? $c->stash('grade') : 1;
+
+  });
+  $account->get('/in')->to("credit#upsert");
+  $account->get('/out')->to("debit#upsert");
+  $account->get('/:action')->to('account#');
+
+}
+
+my $started_time;
+BEGIN { $started_time = scalar localtime(); }
+sub get_started_time { $started_time; }
+
+sub initialize_stash {
+    my $c = shift;
+
+    my $ct = $c->req->headers->content_type;
+
+    $c->stash(
+        is_restapi_req => $c->accepts('', 'json' )
+                       || $ct && $ct ne 'application/x-www-form-urlencoded',
+        current_time => strftime('%Y-%m-%d %H:%M:%S', localtime time),
+    );
+
+    return 1;
+
+}
+
+sub require_user_otherwise_login_or_fail {
+    my $c = shift;
+
+    my $is_restapi_req = $c->stash('is_restapi_req');
+
+    if ( my $u = authenticate_user($c) ) {
+        $c->stash( user => $u );
+        $c->stash( grade => $u->grade );
+        return 1;
+    }
+
+    elsif ( !$is_restapi_req && $c->req->method eq "GET" ) {
+        $c->redirect_to("/login");
+    }
+
+    else {
+        $c->res->code(401);
+    }
+
+    return undef;
+
+}
+# Rely on Mojolicious in that the session cookie be cryptographically
+# protected against manipulation (HMAC-SHA1 signature). Hence, if the
+# user id is defined, the user has certainly logged in properly.
+# Refer to `perldoc Mojolicious::Controller` if interested.
+# If the REST application programing interface is used, there is no
+# cookie. To stay "RESTful", we rely on HTTP header "Authentification".
+      
+sub authenticate_user {
+    my $c = shift;
+
+    my ($user, my $password)
+        = split /:/, ( $c->req->url->to_abs->userinfo // q{} ), 2;
+
+    my $further_check;
+
+    if ( $user ) { $further_check = 1 }
+    elsif ( $user = $c->session('user_id') ) {}
+    
+    $user &&= $c->app->db->user($user) or return; 
+
+    if ( $further_check ) {
+        $user->password_equals($password) or return;
+        $c->stash("user" => $user);
+    }
+
+    return $user;
+
+}
+
+sub prepare_client_error {
+    my $c = shift;
+    my $x = @_ > 1 ? { @_ } : shift;
+    my %args;
+
+    # Case 1: We have got a genuine application error object of
+    #         which we know the interface.
+    if ( (my $xclass = ref $x) =~ s{^TrsrDB::Error\b}{} ) {
+        # consider rather Scalar::Util::blessed ... Yes, I did
+        $xclass =~ s{^::}{};
+        %args = (
+            %{ $x->dump(0) },
+            error => $xclass || "General error",
+        );
+    }
+
+    # Case 2: We have got a plain hash of arguments to use directly
+    elsif ( ref $x eq 'HASH' ) {
+        %args = ( (map { $_ => undef } qw(message error)), %$x);
+    }
+
+    # Otherwise, we have got an exception thrown from other, third-party 
+    # code. You should design your production-mode exception template so
+    # that it displays only $error and $message, not $exception, because
+    # this might allow potential attackers to examine your server's
+    # vulnerabilities.
+    else {
+        my $u = $c->stash("user");
+        $c->stash(
+            error => "Internal server error",
+            message => $u && $u->can_admin ? (ref $x ? "$x" : $x)
+                     : "Oops, something went wrong. (A more detailed "
+                     . "error message logged server-side. Ask the admin.)"
+                     ,
+        );
+        return;
+    }
+
+    $c->res->code( delete $args{http_status} // 500 );
+    return $c->render( template => 'exception.production', %args );
+
+}
+
+sub restapi_reply_jsonifier {
+    my ($c, $args) = @_;
+
+    return if !$c->stash('is_restapi_req')
+           || $args->{json};
+
+    my %stash = ( %{ $c->stash }, %$args );
+    delete @stash{ # general slots of internal interest ...
+        qw(snapshot user template is_restapi_req layout
+           hoster_info cb action controller
+        ),
+        grep { /^mojo\./ } keys %stash
+    };
+
+    $args->{json} = \%stash;
+
+}
+
+sub render_online_help {
+    require Text::Markdown;
+    my $c = shift;
+
+    my $file = $c->stash("file");
+
+    if ( $file =~ m{(^|\/)\.} ) {
+        return $c->reply->not_found;
+    }
+    elsif ( $file =~ m{\.(\w{3,4})$} ) {
+        return $c->reply->static( "../doc/online-help/" . $file );
+    }
+
+    $file = $c->app->home->rel_file(
+        "doc/online-help/" . ( $file || "faq" ) . ".md"
+    );
+
+    open my $fh, '<', $file or return $c->reply->not_found;
+    binmode $fh, ':utf8';
+
+    $c->stash( layout => undef ) if $c->param('bare');
+    $c->render( template => 'online_help', file => $file );
+
+}
+
+1;
+
+__END__
+  

TrsrDB/HTTP/Account.pm

@@ -0,0 +1,51 @@
+use strict;
+
+package TrsrDB::HTTP::Account;
+use Mojo::Base 'Mojolicious::Controller';
+use Carp qw(croak);
+
+sub list {
+    my $self = shift;
+
+    my $accounts = $self->app->db->resultset("Account");
+
+    my %args = $self->stash("user")->grade ? () : ( type => undef );
+    $accounts = $accounts->search(\%args, { order_by => { -asc => [qw/type ID/] } });
+
+    $self->stash( accounts => $accounts );
+
+    return;
+
+}
+
+sub history {
+    my $self = shift;
+    my $history = $self->app->db->resultset("History")->search({
+        account => $self->stash("account")
+    }, { order_by => { -desc => [qw/date/] } });
+    $self->stash( history => $history );
+}
+
+sub transfer {
+    my $self = shift;
+    my $db = $self->app->db;
+    my $account = $db->resultset("Account")->find( $self->stash("account") );
+    
+    if ( $self->req->method eq 'GET' ) {
+        $self->stash(
+            credits => $account->available_credits_rs,
+            arrears => $account->current_arrears_rs,
+        );
+        return;
+    }
+
+    $db->make_transfers(
+        $self->every_param('credits')
+     => $self->every_param('debits')
+    );
+
+    return;
+
+}
+1;
+

TrsrDB/HTTP/Credit.pm

@@ -0,0 +1,66 @@
+use strict;
+
+package TrsrDB::HTTP::Credit;
+use Mojo::Base 'Mojolicious::Controller';
+use Carp qw(croak);
+
+sub list {
+    my $self = shift;
+
+    my $accounts = $self->app->db->resultset("Account");
+
+    my %args = $self->stash("user")->grade ? () : ( type => undef );
+    $args{ID} = $self->stash("account");
+    my $account = $accounts->find(\%args);
+
+    if ( !$account ) {
+        $self->reply->not_found;
+        return;
+    }
+
+    $self->stash( credits => $account->credits_rs );
+
+    return;
+
+}
+
+sub upsert {
+    my $self = shift;
+    
+    my $db = $self->app->db;
+    my $id = $self->stash("id");
+    my $method = $id ? 'find_or_new' : 'new';
+    my $credit = $db->resultset("Credit")->$method(
+        { $id ? (credId => $id) : (), account => $self->stash("account") }
+    );
+    $self->stash( credit => $credit );
+
+    if ( $self->req->method eq 'GET' ) {
+        return;
+    }
+
+    for my $field ( qw/account date purpose value/ ) {
+        my $value = $self->param($field);
+        $credit->$field($value);
+    }
+    $credit->update_or_insert();
+
+    my $to_revoke = $self->every_param("revoke");
+    if ( @$to_revoke ) {
+        $db->resultset("Transfer")->search({
+            billId => $to_revoke, credId => $id
+        })->delete;
+    }
+
+    my $to_spend_for = $self->every_param("spendFor");
+    if ( @$to_spend_for ) {
+        $db->make_transfers( $self->param("billId") => $to_spend_for);
+    }                  
+
+    $self->redirect_to('home');
+
+
+}
+
+1;
+

TrsrDB/HTTP/Debit.pm

@@ -0,0 +1,78 @@
+use strict;
+
+package TrsrDB::HTTP::Debit;
+use Mojo::Base 'Mojolicious::Controller';
+use Carp qw(croak);
+
+sub list {
+    my $self = shift;
+
+    my $accounts = $self->app->db->resultset("Account");
+
+    my %args = $self->stash("user")->grade ? () : ( type => undef );
+    $args{ID} = $self->stash("account");
+    my $account = $accounts->find(\%args);
+
+    if ( !$account ) {
+        $self->reply->not_found;
+        return;
+    }
+
+    $self->stash( debits => $account->debits_rs );
+
+    return;
+
+}
+
+sub upsert {
+    my $self = shift;
+    
+    my $db = $self->app->db;
+    my $id = $self->stash("id");
+    my $account = $self->stash("account");
+    my $method = $id ? 'find_or_new' : 'new';
+    my $debit = $db->resultset("Debit")->$method(
+        { $id ? (billId => $id) : (), debtor => $account }
+    );
+
+    $self->stash( debit => $debit );
+
+    if ( $self->req->method eq 'GET' ) {
+        my $targets
+          = $db->resultset("Credit")->search({ account => { '!=' => $account } },
+                { join => 'income',
+                  '+select' => [ { count => 'income.targetCredit', -as => 'targetted_by' } ],
+                  group_by => ['income.targetCredit'], 
+                  having   => \[ 'ifnull(sum(income.paid),0) = me.value' ],
+                  order_by => { -asc => [qw/account/] },
+                }
+            );
+        my @targets = map { [ $_->credId, $_->account->ID, $_->purpose ] } $targets->all;
+        $self->stash( targets => \@targets, targets_count => $targets->count );
+        return;
+    }
+
+    for my $field ( qw/billId debtor date purpose value targetCredit/ ) {
+        my $value = $self->param($field);
+        $debit->$field($value);
+    }
+    $debit->update_or_insert();
+
+    my $to_revoke = $self->every_param("revoke");
+    if ( @$to_revoke ) {
+        $db->resultset("Transfer")->search({
+            billId => $id, credId => $to_revoke
+        })->delete;
+    }
+
+    my $to_pay_with = $self->every_param("payWith");
+    if ( @$to_pay_with ) {
+        $db->make_transfers( $to_pay_with => $self->param("billId") );
+    }                  
+
+    $self->redirect_to('home');
+
+}
+
+1;
+

TrsrDB/HTTP/User.pm

@@ -0,0 +1,41 @@
+use strict;
+
+package TrsrDB::HTTP::User;
+use Mojo::Base 'Mojolicious::Controller';
+#use Carp qw(croak);
+
+sub login {
+    my $self = shift;
+    my $user_id = $self->param('user') // return;
+    my $db      = $self->app->db;
+
+    my $password        = $self->param('password');
+    my $user = $db->resultset("User")->find(
+        $user_id =~ m{@} ? { email => $user_id } : $user_id
+    );
+    
+    if ( !$user ) {
+        $self->render( retry_msg => 'authfailure' );
+        return;
+    }
+    elsif ( $password && $user->password_equals($password) ) {
+        $self->session("user_id" => $user_id );
+        $self->redirect_to("home");
+    }
+    else {
+        $self->render( $password ? (retry_msg => 'authfailure') : () );
+    }
+
+}
+
+sub logout {
+    my ($self) = @_;
+
+    $self->session(expires => 1);
+
+    # $self->stash( retry_msg => 'loggedOut' );
+
+}
+
+1;
+

TrsrDB/History.pm

@@ -4,11 +4,21 @@ package TrsrDB::History;
 use base qw/DBIx::Class::Core/;
 
 __PACKAGE__->table('History');
-__PACKAGE__->add_columns(qw/date purpose account credit debit contra billId/);
+__PACKAGE__->add_columns(qw/date purpose account credId credit debit contra billId note/);
 
 __PACKAGE__->belongs_to(
    account => 'TrsrDB::Account',
    { 'foreign.ID' => 'self.account' }
 );
 
+__PACKAGE__->belongs_to(
+   this_credit => 'TrsrDB::Credit',
+   { 'foreign.credId' => 'self.credId' }
+);
+
+__PACKAGE__->belongs_to(
+   that_credit => 'TrsrDB::Credit',
+   { 'foreign.credId' => 'self.contra' }
+);
+
 1;

TrsrDB/Report.pm

@@ -0,0 +1,18 @@
+use strict;
+
+package TrsrDB::Report;
+use base qw/DBIx::Class::Core/;
+
+__PACKAGE__->table('Report');
+__PACKAGE__->add_column("account");
+__PACKAGE__->add_column("credId" => { data_type => 'INTEGER' });
+__PACKAGE__->add_column("date" => { data_type => 'DATE' });
+__PACKAGE__->add_column("purpose");
+__PACKAGE__->add_column("value" => { data_type => 'INTEGER' });
+
+__PACKAGE__->belongs_to(
+    account => 'TrsrDB::Account',
+    { 'foreign.ID' => 'self.account' }
+);
+
+1;

TrsrDB/Transfer.pm

@@ -16,7 +16,7 @@ __PACKAGE__->belongs_to(
 );
 
 __PACKAGE__->belongs_to(
-   debit => 'TrsrDB::Credit', 'billId'
+   debit => 'TrsrDB::Debit', 'billId'
 );
 
 1;

TrsrDB/User.pm

@@ -0,0 +1,61 @@
+use strict;
+
+package TrsrDB::User;
+use Digest::SHA qw(hmac_sha256_hex);
+use Moose;
+use Carp qw(croak);
+extends 'DBIx::Class::Core';
+
+__PACKAGE__->table('web_auth');
+__PACKAGE__->add_columns(qw/
+    user_id  password
+/);
+
+__PACKAGE__->add_column(grade => {
+    data_type => 'TINYINT',
+    default_value => 0,
+});
+
+__PACKAGE__->add_column($_ => {
+    is_nullable => 1
+}) for qw/username email/;
+
+__PACKAGE__->set_primary_key('user_id');
+
+sub salted_password {
+    my ($self, $password) = @_;
+    if ( exists $_[1] ) {
+        my $random_string = _randomstring(8);
+        return $self->password(
+            $random_string."//".hmac_sha256_hex($password, $random_string)
+        );
+    }
+    else {
+         my @ret = reverse split m{//}, $self->password;
+         $ret[1] //= undef;
+         return reverse @ret;
+    }
+}
+
+sub password_equals {
+    my ($self, $password) = @_;
+    my ($salt, $stored_password) = split m{//}, $self->password, 2;
+    return hmac_sha256_hex($password, $salt) eq $stored_password;
+}
+
+sub sqlt_deploy_hook {
+   my ($self, $sqlt_table) = @_;
+
+   $sqlt_table->add_index(
+        name => 'unique_mail',
+        fields => ['email'],
+        type => 'unique'
+   );
+
+}
+
+my @chars = ( 0..9, "a".."z", "A".."Z" );
+sub _randomstring {
+    my ($length) = @_;
+    return join q{}, map { $chars[ int rand(62) ] } 1 .. $length;
+}