#!/usr/bin/env perl
use 5.028;
use Mojolicious::Lite -signatures;
use Mojo::SQLite;
use File::Spec::Functions qw/catfile tmpdir/;
use PBKDF2::Tiny qw/derive_hex verify_hex/;
use Crypt::Random::Source qw/get_strong/;

# Run me via:
# morbo --listen=http://127.0.0.1:3000 --listen=https://127.0.0.1:4430
+ mojo_login_example.pl

#app->secrets(['A Login Example - TODO: set this string!']);
app->sessions->secure(1);

# disable template cache in development mode (e.g. under morbo):
app->renderer->cache->max_keys(0) if app->mode eq 'development';

helper sql => sub { state $sql = Mojo::SQLite->new('sqlite:'
    . catfile(tmpdir, 'test.db') ) };

app->sql->migrations->from_string(<<'END_MIGRATIONS')->migrate;
-- 1 up
CREATE TABLE Users ( Username TEXT NOT NULL PRIMARY KEY,
    Salt TEXT NOT NULL, Password TEXT NOT NULL,
    AuthAttempts INTEGER NOT NULL DEFAULT 0, DelayExpires INTEGER );
-- 1 down
DROP TABLE IF EXISTS Users;
END_MIGRATIONS
{ my $db = app->sql->db; # for testing, insert sample users:
if ( not $db->query('SELECT COUNT(*) FROM Users')->arrays->[0][0] ) {
    my $salt1 = unpack 'H*', get_strong(64);
    $db->insert('Users', { Username => 'Foo', Salt => $salt1,
        Password => derive_hex('SHA-512', 'Bar', $salt1, 5000) } );
    my $salt2 = unpack 'H*', get_strong(64);
    $db->insert('Users', { Username => 'Quz', Salt => $salt2,
        Password => derive_hex('SHA-512', 'Baz', $salt2, 5000) } );
} }

helper do_login => sub ($c) {
    my $promise = Mojo::Promise->new;
    my ($user,$pass) = ($c->param('username'), $c->param('password'));
    my $db = $c->sql->db;
    my $user_rec = eval {
        my $tx = $db->begin('exclusive');
        my $u = $db->select( Users => [qw/ Salt Password AuthAttempts
            DelayExpires /], { Username => $user } )->hashes;
        die "Username not found" unless @$u;
        $db->query('UPDATE Users SET AuthAttempts=AuthAttempts+1,'
            .'DelayExpires=? WHERE Username=?', time+60*60, $user );
        $tx->commit;
    $u->[0] } or do {
        Mojo::IOLoop->timer( 2 => sub { $promise->reject } );
        return $promise };
    Mojo::IOLoop->timer( 2 * $user_rec->{AuthAttempts} => sub {
        utf8::encode( $pass ); # needed for verify_hex
        utf8::encode( my $salt = $user_rec->{Salt} );
        if ( verify_hex( $user_rec->{Password}, 'SHA-512', $pass,
                $salt, 5000 ) ) {
            $db->query('UPDATE Users SET AuthAttempts=0,DelayExpires='
                .'NULL WHERE Username=? OR ?>DelayExpires',
                $user, time );
            $promise->resolve($user);
        }
        else { Mojo::IOLoop->timer( 2 => sub { $promise->reject } ) }
    });
    return $promise;
};

helper logged_in => sub ($c) {
    length( $c->session('username') ) ? $c->session : undef };

any '/' => sub ($c) { $c->render('index') } => 'index';

group { # everything in this group requires HTTPS b/c of this "under":
    under sub ($c) {
        return 1 if $c->req->is_secure;
        $c->redirect_to( $c->url_for->to_abs->scheme('https')
            ->port(4430) ); # this port is just for this demo
        return undef;
    };
    
    get '/login' => sub ($c) { $c->render('login') } => 'login';
    post '/login' => sub ($c) { # form handler
        return $c->render(text => 'Bad CSRF token!', status => 403)
            if $c->validation->csrf_protect->has_error('csrf_token');
        $c->render_later;
        $c->do_login->then(sub ($user) {
                $c->session( expiration => 60*60 );
                $c->session( username => $user );
                $c->redirect_to('secure');
            })->catch(sub {
                $c->flash(login_error => 'Bad username or password');
                $c->redirect_to('login');
            });
    } => 'login';
    any '/logout' => sub ($c) {
        delete $c->session->{username};
        $c->redirect_to('index');
    } => 'logout';
    
    group { # everything in this group requires login
        under sub ($c) {
            return 1 if $c->logged_in;
            $c->redirect_to('login');
            return undef;
        };
        
        any '/secure' => sub ($c) { $c->render('secure') } =>'secure';
    };
};

app->start;

__DATA__

@@ layouts/main.html.ep
<!DOCTYPE html>
<html>
<head><title><%= title %></title>
    <style>
        table { border-collapse: collapse; }
        table, th, td { border: 1px solid black; }
    </style>
</head><body>
<nav style="margin-bottom:1em;"><small>
[ <%= link_to Main => 'index' %> | <%= link_to Secure => 'secure' %> ]
% if ( my $s = logged_in ) {
    [ Logged in as <%= $s->{username} %> | <%= link_to Logout => 'logo
+ut' %> ]
% } else {
    [ <%= link_to Login => 'login' %> ]
% }
</small></nav>
<main>
<div style="margin-bottom:1em;"><table style="font-size:0.75em;">
    <tr> <th colspan="3">Debug Info</th> </tr>
    <tr> <th>User</th> <th>Attemps</th> <th>Expires</th> </tr>
% my $res = sql->db->select('Users', [qw/ Username AuthAttempts DelayE
+xpires /]);
% while ( my $row = $res->array ) {
    <tr> <% for my $f (@$row) { %> <td><%= $f %></td> <% } %> </tr>
<% } %></table></div>
<%= content %>
</main>
</body>
</html>

@@ index.html.ep
% layout 'main', title => 'Hello, World!';
<div>Hello, World!</div>

@@ login.html.ep
% layout 'main', title => 'Login';
% if ( flash 'login_error' ) {
    <div style="margin-bottom:1em;"><strong><%= flash 'login_error' %>
+</strong></div>
% }
<div>
%= form_for login => ( method => 'post' ) => begin
%= csrf_field
%= label_for username => 'Username'
%= text_field username => ( placeholder=>"Username", required=>'requir
+ed' )
%= label_for password => 'Password'
%= password_field password => ( placeholder=>"Password", required=>'re
+quired' )
%= submit_button 'Login'
%= end
</div>

@@ secure.html.ep
% layout 'main', title => 'Top Secret';
<div>Welcome <b><%= session->{username} %></b>,
    you've accessed the <b>top secret</b> area!</div>
[download]