From 6f19437901581c01d9f674532529129be48317f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Florian=20=22flowdy=22=20He=C3=9F?= Date: Sat, 28 Jan 2017 14:00:20 +0100 Subject: [PATCH] Optimized look and user experience; fixed errors --- TrsrDB.pm | 10 +- TrsrDB/Debit.pm | 7 +- TrsrDB/HTTP.pm | 62 +- TrsrDB/HTTP/Account.pm | 11 +- TrsrDB/HTTP/Credit.pm | 9 +- TrsrDB/HTTP/Debit.pm | 21 +- TrsrDB/HTTP/User.pm | 16 + TrsrDB/User.pm | 4 +- httpuser | 47 ++ schema/triggers/enforceImmutableTransfer.sql | 2 +- server | 12 + site/add-credit.svg | 187 ++++++ site/add-debit.svg | 101 +++ site/even.svg | 63 ++ site/list.svg | 68 ++ site/style.css | 29 + site/transfer.svg | 665 +++++++++++++++++++ site/wait.svg | 66 ++ templates/account/list.html.ep | 21 +- templates/account/upsert.html.ep | 35 + templates/debit/upsert.html.ep | 3 +- templates/layouts/default.html.ep | 33 +- templates/user/login.html.ep | 6 +- 23 files changed, 1434 insertions(+), 44 deletions(-) create mode 100644 httpuser create mode 100755 server create mode 100644 site/add-credit.svg create mode 100644 site/add-debit.svg create mode 100644 site/even.svg create mode 100644 site/list.svg create mode 100644 site/transfer.svg create mode 100644 site/wait.svg create mode 100644 templates/account/upsert.html.ep diff --git a/TrsrDB.pm b/TrsrDB.pm index d3af68f..a70b8ee 100644 --- a/TrsrDB.pm +++ b/TrsrDB.pm @@ -13,8 +13,16 @@ sub import { my ($class, $dbh_ref, $filename) = @_; return if @_ == 1; croak "use TrsrDB \$your_db_handle missing" if !defined $dbh_ref; + my $filename //= $ENV{TRSRDB_SQLITE_FILE} + // croak "No database to open: TRSRDB_SQLITE_FILE environment variable not set, " + . "and no filename passed to ".__PACKAGE__."::import() / use"; + if ( !(-f $filename && -r $filename) ) { + croak "Cannot read database file $filename"; + } + $$dbh_ref = $class->connect( - "DBI:SQLite:" . ($filename // $ENV{TRSRDB_SQLITE_FILE} // ":memory:"), + "DBI:SQLite:" . ($filename // $ENV{TRSRDB_SQLITE_FILE} + // die "No database to open: TRSRDB_SQLITE_FILE environment variable not set\n"), "", "", { sqlite_unicode => 1, on_connect_call => 'use_foreign_keys', diff --git a/TrsrDB/Debit.pm b/TrsrDB/Debit.pm index 2f551d6..81da591 100644 --- a/TrsrDB/Debit.pm +++ b/TrsrDB/Debit.pm @@ -11,14 +11,17 @@ __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__->add_column("targetCredit" => { + data_type => 'INTEGER', + is_nullable => 1 +}); __PACKAGE__->belongs_to( account => 'TrsrDB::Account', { 'foreign.ID' => 'self.debtor' } ); -__PACKAGE__->might_have( +__PACKAGE__->belongs_to( target => 'TrsrDB::Credit', { 'foreign.credId' => 'self.targetCredit' } ); diff --git a/TrsrDB/HTTP.pm b/TrsrDB/HTTP.pm index 8c7ae28..dc02dd6 100644 --- a/TrsrDB/HTTP.pm +++ b/TrsrDB/HTTP.pm @@ -7,11 +7,22 @@ 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; -}; +{ my $sql_trace; + open my $dfh, '>', \$sql_trace; + sub get_trace () { + my $t = $sql_trace; + $sql_trace = q{}; + seek $dfh, 0, 0; + return \$t; + } + has db => sub { + my $db; + eval q{use TrsrDB \$db} or $@ && die $@; + $db->storage->debugfh($dfh); + return $db; + }; +} + # This method will run once at server start sub startup { @@ -43,6 +54,16 @@ sub startup { pop =~ s{\n}{
}grms; }); + if ( $ENV{DBIC_TRACE} ) { + $self->helper(sql_trace => \&get_trace); + } + else { + $self->helper(sql_trace => sub { + return "No SQL trace shown here, because environment variable " + . "DBIC_TRACE is not set." + }); + } + if ( my $l = $ENV{LOG} ) { use Mojo::Log; open my $fh, '>', $l or die "Could not open logfile $l to write: $!"; @@ -63,21 +84,25 @@ sub startup { $auth->get( '/logout' )->to("user#logout"); - my $check = $auth->under(sub { shift->stash('grade') })->get('/'); + my $check = $auth->under(sub { + my $c = shift; + return $c->stash('grade') || undef; + })->get('/'); $check->get('/bankStatement' => sub { my $c = shift; $c->stash( records => $c->app->db->resultset("ReconstructedBankStatement") ); $c->render('bankStatement'); }); - my $admin = $auth->under(sub { shift->stash('grade') > 1 }); + my $admin = $auth->under(sub { + my $c = shift; + return $c->stash('grade') > 1 || undef; + }); $admin->any('/admin')->to('admin#dash'); $admin->any( [qw/GET POST/] => '/account/:account' => { account => undef }) ->to('account#upsert'); - $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->any( [qw/GET POST/] => '/:account/in')->to('credit#upsert'); + $admin->any( [qw/GET POST/] => '/:account/out')->to('debit#upsert'); $admin->post('/:account/transfer')->to('account#transfer'); $admin->any( [qw/GET POST PATCH/] => '/credit/:id' )->to('credit#upsert'); $admin->any( [qw/GET POST/] => '/credit')->to('credit#upsert'); @@ -90,6 +115,8 @@ sub startup { my $account = $auth->get('/:account')->under(sub { my $c = shift; + return 1 if $c->stash('grade'); + my $account = $c->stash('account'); if ( my $acc = $c->app->db->resultset('Account')->find($account) ) { $c->stash( account => $acc ); @@ -100,13 +127,20 @@ sub startup { return; } - return $account->type ? $c->stash('grade') : 1; + return 1 if !$account->type; + + return $account->ID eq $c->stash("user")->user_id || undef; }); - $account->get('/in')->to("credit#upsert"); - $account->get('/out')->to("debit#upsert"); + $account->get('/credits')->to("credit#list"); + $account->get('/debits')->to("debit#list"); $account->get('/:action')->to('account#'); + $r->any('/*whatever' => {whatever => ''} => sub { + my $c = shift; + my $whatever = $c->param('whatever'); + $c->render(text => "/$whatever did not match.", status => 404); + }); } my $started_time; diff --git a/TrsrDB/HTTP/Account.pm b/TrsrDB/HTTP/Account.pm index 4de2247..b482723 100644 --- a/TrsrDB/HTTP/Account.pm +++ b/TrsrDB/HTTP/Account.pm @@ -8,9 +8,14 @@ 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/] } }); + my $user = $self->stash("user"); + my %args = $user->grade ? () + : $accounts->find( $user->user_id ) ? ( 'me.ID' => $user->user_id ) + : ( type => q{} ); + $accounts = $accounts->search(\%args, { + order_by => { -asc => [qw/type balance.even_until me.ID/] }, + prefetch => 'balance' + }); $self->stash( accounts => $accounts ); diff --git a/TrsrDB/HTTP/Credit.pm b/TrsrDB/HTTP/Credit.pm index 1ca167d..425208d 100644 --- a/TrsrDB/HTTP/Credit.pm +++ b/TrsrDB/HTTP/Credit.pm @@ -3,6 +3,7 @@ use strict; package TrsrDB::HTTP::Credit; use Mojo::Base 'Mojolicious::Controller'; use Carp qw(croak); +use POSIX qw(strftime); sub list { my $self = shift; @@ -33,9 +34,11 @@ sub upsert { 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") } - ); + my $credit = $db->resultset("Credit")->$method({ + $id ? (credId => $id) : (), + account => $self->stash("account"), + date => strftime("%Y-%m-%d", localtime) + }); $self->stash( credit => $credit ); if ( $self->req->method eq 'GET' ) { diff --git a/TrsrDB/HTTP/Debit.pm b/TrsrDB/HTTP/Debit.pm index ec6c9cd..1ba1bbb 100644 --- a/TrsrDB/HTTP/Debit.pm +++ b/TrsrDB/HTTP/Debit.pm @@ -3,6 +3,7 @@ use strict; package TrsrDB::HTTP::Debit; use Mojo::Base 'Mojolicious::Controller'; use Carp qw(croak); +use POSIX qw(strftime); sub list { my $self = shift; @@ -42,6 +43,7 @@ sub upsert { while ( my $m = $group_members->next ) { my %props = map { $_ => $self->param($_) } @FIELDS; + $props{targetCredit} ||= undef; for ( $props{billId} ) { s{\%u}{ $m->ID }e or $_ .= "-" . $m->ID; } @@ -53,9 +55,11 @@ sub upsert { } my $method = $id ? 'find_or_new' : 'new'; - my $debit = $db->resultset("Debit")->$method( - { $id ? (billId => $id) : (), debtor => $debtor } - ); + my $debit = $db->resultset("Debit")->$method({ + $id ? (billId => $id) : (), + debtor => $debtor, + date => strftime("%Y-%m-%d", localtime) + }); $self->stash( debit => $debit ); @@ -76,6 +80,7 @@ sub upsert { for my $field ( @FIELDS ) { my $value = $self->param($field); + $value = undef if !length $value; $debit->$field($value); } $debit->update_or_insert(); @@ -89,7 +94,15 @@ sub upsert { my $to_pay_with = $self->every_param("payWith"); if ( @$to_pay_with ) { - $db->make_transfers( $to_pay_with => $self->param("billId") ); + my $billId = $self->param("billId"); + $db->make_transfers( $to_pay_with => $billId ); + for my $param ( grep { /^note\[/ } @{ $self->req->params->names } ) { + my $note = $self->param($param) || next; + s{^note\[}{} && s{\]$}{} for $param; + $db->resultset("Transfer")->find({ + billId => $self->param("billId"), credId => $param + })->update({ note => $note }); + } } $self->redirect_to('home'); diff --git a/TrsrDB/HTTP/User.pm b/TrsrDB/HTTP/User.pm index 27597f0..71ee064 100644 --- a/TrsrDB/HTTP/User.pm +++ b/TrsrDB/HTTP/User.pm @@ -18,6 +18,21 @@ sub login { $self->render( retry_msg => 'authfailure' ); return; } + elsif ( my $token = $self->param('token') ) { + my $pw = $self->param("password") // q{}; + if ( ($user->password//q{}) ne $token ) { + $self->render( retry_msg => 'authfailure' ); + return; + } + elsif ( $pw ne ($self->param("samepassword") // q{}) ) { + $self->render( retry_msg => "Passwords are different" ); + return; + } + $self->session("user_id" => $user_id ); + $user->salted_password($pw); + $user->update(); + $self->redirect_to("home"); + } elsif ( $password && $user->password_equals($password) ) { $self->session("user_id" => $user_id ); $self->redirect_to("home"); @@ -33,6 +48,7 @@ sub logout { $self->session(expires => 1); + $self->redirect_to('home'); # $self->stash( retry_msg => 'loggedOut' ); } diff --git a/TrsrDB/User.pm b/TrsrDB/User.pm index 94b5b9f..b6c1ed6 100644 --- a/TrsrDB/User.pm +++ b/TrsrDB/User.pm @@ -25,7 +25,7 @@ __PACKAGE__->set_primary_key('user_id'); sub salted_password { my ($self, $password) = @_; if ( exists $_[1] ) { - my $random_string = _randomstring(8); + my $random_string = randomstring(8); return $self->password( $random_string."//".hmac_sha256_hex($password, $random_string) ); @@ -55,7 +55,7 @@ sub sqlt_deploy_hook { } my @chars = ( 0..9, "a".."z", "A".."Z" ); -sub _randomstring { +sub randomstring { my ($length) = @_; return join q{}, map { $chars[ int rand(62) ] } 1 .. $length; } diff --git a/httpuser b/httpuser new file mode 100644 index 0000000..15c3ae0 --- /dev/null +++ b/httpuser @@ -0,0 +1,47 @@ +#!/usr/bin/env perl +use strict; + +my $db; +use TrsrDB \$db; + +use Getopt::Long; + +my %OPTS; +GetOptions( \%OPTS, 'add|a', 'reset|r', 'grade|g:i', 'email|m:s', 'username|name|n:s' ); + +my $user = shift; +if ( !$user ) { + die 'No user_id given. Usage: httpuser [-a|-r] $USERNAME [-g 0|1|2] [-m $MAILADDR] [-n $FULL_NAME]', "\n"; +} + +if ( $OPTS{add} ) { + die "--add/-a and --reset/-r (reset password of existing account) contradict" if $OPTS{reset}; + $user = $db->resultset("User")->create({ user_id => $user, grade => delete $OPTS{grade} }); +} +else { + $user = $db->resultset("User")->find($user) + // die "No user $user found"; +} + +if ( delete $OPTS{add} || delete $OPTS{reset} ) { + my $random_string = TrsrDB::User::randomstring(50); + print "Load or send someone following link:\n", + "------------------------------------\n", + "/login?token=".$random_string."\n\n"; + $user->password($random_string); +} + +$user->update(\%OPTS); + +print "User data:\n", + "----------\n", + "ID: ", $user->user_id, "\n", + "Grade: ", [ + "0 - can read main accounts, or his own only when its ID equals his", + "1 - can read all accounts and bank statement, but cannot add or change data", + "2 - can read and update the database" + ]->[ $OPTS{grade} // $user->grade ]."\n" // die "Unsupported level: $OPTS{grade}", + "E-Mail: ", $OPTS{email} // $user->email // "(none)", + "Name: ", $OPTS{username} // $user->username // "(none)" + ; + diff --git a/schema/triggers/enforceImmutableTransfer.sql b/schema/triggers/enforceImmutableTransfer.sql index 1fbe5de..ac2cebf 100644 --- a/schema/triggers/enforceImmutableTransfer.sql +++ b/schema/triggers/enforceImmutableTransfer.sql @@ -1,5 +1,5 @@ CREATE TRIGGER enforceImmutableTransfer - BEFORE UPDATE ON Transfer + BEFORE UPDATE OF timestamp, credId, billId, amount ON Transfer -- Allow update of note WHEN OLD.amount IS NOT NULL AND NOT EXISTS (SELECT * FROM __INTERNAL_TRIGGER_STACK) BEGIN diff --git a/server b/server new file mode 100755 index 0000000..263fcf2 --- /dev/null +++ b/server @@ -0,0 +1,12 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin"; + +$ENV{MOJO_LISTEN} //= "http://127.0.0.1:3000"; + +# Start command line interface for application +require Mojolicious::Commands; +my $app = Mojolicious::Commands->start_app("TrsrDB::HTTP"); diff --git a/site/add-credit.svg b/site/add-credit.svg new file mode 100644 index 0000000..d1f1ad0 --- /dev/null +++ b/site/add-credit.svg @@ -0,0 +1,187 @@ + + + +image/svg+xml \ No newline at end of file diff --git a/site/add-debit.svg b/site/add-debit.svg new file mode 100644 index 0000000..c4f1ffd --- /dev/null +++ b/site/add-debit.svg @@ -0,0 +1,101 @@ + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + diff --git a/site/even.svg b/site/even.svg new file mode 100644 index 0000000..287b11e --- /dev/null +++ b/site/even.svg @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + + + Rodney Dawes + + + + + Jakub Steiner, Garrett LeSage + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/site/list.svg b/site/list.svg new file mode 100644 index 0000000..5e3f3e4 --- /dev/null +++ b/site/list.svg @@ -0,0 +1,68 @@ + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + + diff --git a/site/style.css b/site/style.css index 504c1d3..16accc3 100644 --- a/site/style.css +++ b/site/style.css @@ -13,6 +13,14 @@ h1 { border-bottom: 5px double grey; } +table { + border-collapse: collapse; +} + +table td, table th { + border: 1px solid darkgrey; +} + table tr:nth-child(even) { background-color: #eee; } @@ -68,3 +76,24 @@ select { color: lightgrey; font-size: .8em; } + +img.icon { + vertical-align:middle; + height: 1.2em; +} + +.targettable { display:none } +.targettable:target { display: block; } + +#bottommenu { + font-size:smaller; + background-color: #eee; + border-top: 5px double grey; + text-align:center; +} + +#footer { + font-size:smaller; + color: darkgrey; + text-align: center; +} diff --git a/site/transfer.svg b/site/transfer.svg new file mode 100644 index 0000000..f605247 --- /dev/null +++ b/site/transfer.svg @@ -0,0 +1,665 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + + + Rodney Dawes + + + + + Jakub Steiner, Garrett LeSage + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/site/wait.svg b/site/wait.svg new file mode 100644 index 0000000..ae5059b --- /dev/null +++ b/site/wait.svg @@ -0,0 +1,66 @@ + + + + + + + + + + + + + + + + + + + diff --git a/templates/account/list.html.ep b/templates/account/list.html.ep index 01e5cc9..b51eaa1 100644 --- a/templates/account/list.html.ep +++ b/templates/account/list.html.ep @@ -7,7 +7,7 @@ % my $inter_header = begin % my $group = shift; <%= $group || 'Club management accounts' %> -Charge'm all +Chargeall % end % while ( my $account = $accounts->next ) { % my $bal = $account->balance; @@ -18,24 +18,26 @@ % } % my $u = $account->ID; <%= $u %> - <%= $bal->even_until // "never" %><%== money $bal->arrears %>listCharge + <%= $bal->even_until // "never" %><%== money $bal->arrears %>ListCharge % my $which = ($bal->arrears && 1) + ($bal->available && 1); % if ( $which == 2 ) { - C⇔D! + › ‹ % } % elsif ( $which ) { -  N/A  + <%== $bal->arrears ? q{›} : q{ } %> + + <%== $bal->available ? q{‹} : q{ } %> % } % else { -  N/A  + % } - <%== money $bal->available %>listCredit<%== money $bal->earned %><%== money $bal->promised %>HistoryReport + <%== money $bal->available %>ListCredit<%== money $bal->earned %><%== money $bal->promised %>HistoryReport % } # while -

Create account ⋅ Reconstructed bank statement

-
+% stash links => [ '/account' => "Create account", '/bankStatement' => "Reconstructed bank statement" ]; +% my $help = begin

Column explanation

Even till:
@@ -51,4 +53,5 @@
Promised:

Unpaid or not fully paid debits targetting credits of that account.

-
+% end +% stash help => $help; diff --git a/templates/account/upsert.html.ep b/templates/account/upsert.html.ep new file mode 100644 index 0000000..9a2cd0c --- /dev/null +++ b/templates/account/upsert.html.ep @@ -0,0 +1,35 @@ +% title $name ? "Account $name" : "Create account"; + +% my %r; +% $r{ID} = begin + +% end +% $r{type} = begin + (<%= join(", ", @$types) %> or a new?) +% end +% $r{altId} = begin + +% end +% $r{IBAN} = begin + +% end + +
+ +
+% for my $f ( $account->result_source->columns ) { +% my $renderer = $r{$f} // do { +% my $value = $account->$f // next; +% begin + <%= $value %> +% end +% }; +
+
<%= $renderer->() %>
+% } +
+ + +
+ + diff --git a/templates/debit/upsert.html.ep b/templates/debit/upsert.html.ep index 1858466..78096bd 100644 --- a/templates/debit/upsert.html.ep +++ b/templates/debit/upsert.html.ep @@ -90,12 +90,13 @@ oops % if ( $credits->count() ) {

Check credits you want to pay this debit with.

- + % while ( my $d = $credits->next ) { + % }
Sdatepurposeto spend
Sdatepurposeto spendnote
<%= $d->date %> <%== nl2br $d->purpose %> <%== money $d->difference %>
diff --git a/templates/layouts/default.html.ep b/templates/layouts/default.html.ep index 0f133c9..019d218 100644 --- a/templates/layouts/default.html.ep +++ b/templates/layouts/default.html.ep @@ -17,6 +17,33 @@ % } <%= content %> -

">Back home – Account List

- - +

">Overview +% if ( my $links = stash 'links' ) { +% while ( my ($link, $text) = splice @$links, 0, 2 ) { +| <%= $text %> +% } +% } +% my $help = stash 'help'; +% if ( defined $help ) { +| Help +% } +% my $sql = sql_trace; +% if ( defined $$sql ) { +| SQL +% } +

+% if ( defined $help ) { +
+%== $help->() +
+% } +% if ( defined $sql ) { +
+

In case you are interested, this is what is executed in the database in order to process your request and to render this page. All essential logic and consistency checking is done on database level via triggers and views, so you could execute these SQL statements e.g. in the console and would get the same results. Note that, if any POST requests redirected here, SQL commands of those come first:

+
+% } + + + diff --git a/templates/user/login.html.ep b/templates/user/login.html.ep index f22f8d4..8611311 100644 --- a/templates/user/login.html.ep +++ b/templates/user/login.html.ep @@ -14,6 +14,10 @@ User id:
Password:
- +% if ( my $token = param 'token' ) { + Repeat:
+
+% } +