current status

cpanfile

@@ -0,0 +1,11 @@
+requires 'Mojolicious';
+requires 'DBD::SQLite';
+requires 'Rose';
+requires 'URI';
+requires 'Digest::Adler32';
+
+on test => sub {
+    requires 'Test::More';
+    requires 'Test::Deep';
+    requires 'Test::MonkeyMock';
+};

examples/etc/systemd/system/shrl_be.service

@@ -0,0 +1,15 @@
+[Unit]
+Description=Shrl.be url shortener service
+
+Wants=network.target
+After=syslog.target network-online.target
+
+[Service]
+Type=simple
+ExecStart=/srv/shrl.be/start.sh
+Restart=on-failure
+RestartSec=10
+KillMode=mixed
+
+[Install]
+WantedBy=multi-user.target

examples/nginx/shrl.be

@@ -0,0 +1,36 @@
+server {
+    listen 443 ssl;
+
+    ssl on;
+    ssl_stapling on;
+
+    server_name shrl.be;
+
+    client_max_body_size 32m;
+
+    ssl_certificate     /etc/letsencrypt/live/shrl.be/fullchain.pem;
+    ssl_certificate_key /etc/letsencrypt/live/shrl.be/privkey.pem;
+
+    ssl_ciphers 'ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-AES256-GCM-SHA384:DHE-RSA-AES128-GCM-SHA256:DHE-DSS-AES128-GCM-SHA256:kEDH+AESGCM:ECDHE-RSA-AES128-SHA256:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA:ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA:ECDHE-ECDSA-AES256-SHA:DHE-RSA-AES128-SHA256:DHE-RSA-AES128-SHA:DHE-DSS-AES128-SHA256:DHE-RSA-AES256-SHA256:DHE-DSS-AES256-SHA:DHE-RSA-AES256-SHA:AES128-GCM-SHA256:AES256-GCM-SHA384:AES128-SHA256:AES256-SHA256:AES128-SHA:AES256-SHA:AES:CAMELLIA:DES-CBC3-SHA:!aNULL:!eNULL:!EXPORT:!DES:!RC4:!MD5:!PSK:!aECDH:!EDH-DSS-DES-CBC3-SHA:!EDH-RSA-DES-CBC3-SHA:!KRB5-DES-CBC3-SHA';
+    ssl_prefer_server_ciphers on;
+
+	include /etc/nginx/conf.d/ssl_params.conf;
+
+    error_log  /var/log/nginx/shrl.be.error.log error;
+
+    location / {
+        proxy_pass      http://127.0.0.1:3002;
+        access_log     /var/log/nginx/shrl.be.log combined;
+	proxy_http_version 1.1;
+	proxy_set_header Upgrade $http_upgrade;
+	proxy_set_header Connection "upgrade";
+
+	# Enable Convos to construct correct URLs by passing on custom
+	# headers. X-Request-Base is only required if "location" above
+	# is not "/".
+	proxy_set_header Host $host;
+	proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for;
+    	proxy_set_header X-Forwarded-Proto $scheme;
+    }
+}
+

lib/Shrlbe.pm

@@ -0,0 +1,35 @@
+package Shrlbe;
+use Mojo::Base 'Mojolicious', -signatures;
+
+use Shrlbe::Utils;
+
+my $SITE_NAME = 'shrl.be';
+
+my $db_file = 'shrl.db';
+
+# This method will run once at server start
+sub startup ($self) {
+
+  # Load configuration from config file
+  my $config = $self->plugin('NotYAMLConfig');
+
+  # Configure the application
+  $self->secrets($config->{secrets});
+
+  my $utils = Shrlbe::Utils->new();
+
+  $self->helper(site_name => sub { return $SITE_NAME });
+  $self->helper(db_file => sub { return $db_file });
+  $self->helper(sh_utils => sub { return $utils });
+
+  # Router
+  my $r = $self->routes;
+
+  # Normal route to controller
+  $r->get('/')->to('main#index');
+  $r->get('/s/*url')->to('main#short_api');
+  $r->post('/')->to('main#short');
+  $r->get('/:shorten_path')->to('main#get_shorten');
+}
+
+1;

lib/Shrlbe/Controller/Main.pm

@@ -0,0 +1,77 @@
+package Shrlbe::Controller::Main;
+use Mojo::Base 'Mojolicious::Controller', -signatures;
+
+use Shrlbe::Model::Url;
+use Shrlbe::Model::Url::Manager;
+
+
+sub index($self)
+{
+    $self->render(template => 'index', page_data => {});
+}
+
+sub short_api ($self)
+{
+    my $original_url = $self->param('url');
+
+    my $shorten_url = $self->_saveShortUrl($original_url);
+
+    $self->render(text => $shorten_url);
+}
+
+sub short($self)
+{
+    my $original_url = $self->param('url');
+
+    my $shorten_url = $self->_saveShortUrl($original_url);
+
+    $self->render(template => 'index', page_data => {url => $original_url, shorten_url => $shorten_url});
+}
+
+sub get_shorten($self)
+{
+    my $path = $self->param('shorten_path');
+
+    my $url = Shrlbe::Model::Url->new(hash => $path);
+    if ($url->load(speculative => 1)) {
+        $self->res->code(307);
+        $self->redirect_to($url->original_url());
+    }
+    else {
+        $self->render(status => 404, text => 'Page not found :(');
+    }
+}
+
+sub _saveShortUrl($self, $original_url)
+{
+    my $hash;
+
+    my $normalized_url = $self->sh_utils()->normalizeUrl($original_url);
+
+    my $url = $self->_loadUrl($normalized_url);
+
+    if (!$url) {
+        $hash = $self->sh_utils()->hashUrl($normalized_url);
+
+        $url = Shrlbe::Model::Url->new(hash => $hash, normalized_url => $normalized_url, original_url => $original_url)->save();
+    }
+    else {
+        $hash = $url->hash();
+    }
+
+    return sprintf('%s/%s', $self->site_name(), $hash);
+}
+
+sub _loadUrl($self, $normalized_url)
+{
+    my $urls = Shrlbe::Model::Url::Manager->get_urls(
+        query => [
+            normalized_url => $normalized_url
+        ],
+        limit => 1,
+    );
+
+    return $urls->[0];
+}
+
+1;

lib/Shrlbe/DB.pm

@@ -0,0 +1,19 @@
+package Shrlbe::DB;
+use strict;
+use warnings;
+use parent qw(Rose::DB);
+
+
+__PACKAGE__->use_private_registry;
+
+__PACKAGE__->register_db(
+    domain   => 'production',
+    type     => 'main',
+    driver   => 'sqlite',
+    database => '/home/alpha6/projects/shrl.be/shrl.db',
+);
+
+Rose::DB->default_domain('production');
+Rose::DB->default_type('main');
+
+1;

lib/Shrlbe/Model/Base.pm

@@ -0,0 +1,11 @@
+package Shrlbe::Model::Base;
+use strict;
+use warnings FATAL => 'all';
+use parent qw(Rose::DB::Object);
+
+use Shrlbe::DB;
+
+
+sub init_db { Shrlbe::DB->new() }
+
+1;

lib/Shrlbe/Model/Url.pm

@@ -0,0 +1,18 @@
+package Shrlbe::Model::Url;
+use strict;
+use warnings;
+use parent qw(Shrlbe::Model::Base);
+
+
+__PACKAGE__->meta->setup
+(
+    table      => 'url',
+    columns    => [
+        id   => { type => 'serial', primary_key => 1, not_null => 1 },
+        hash => { type => 'varchar', length => 255, not_null => 1 },
+        qw(shard normalized_url original_url)
+    ],
+    unique_key => 'hash',
+);
+
+1;

lib/Shrlbe/Model/Url/Manager.pm

@@ -0,0 +1,11 @@
+package Shrlbe::Model::Url::Manager;
+use strict;
+use warnings;
+use base qw(Rose::DB::Object::Manager);
+
+
+sub object_class { 'Shrlbe::Model::Url' }
+
+__PACKAGE__->make_manager_methods('urls');
+
+1;

lib/Shrlbe/Utils.pm

@@ -0,0 +1,50 @@
+package Shrlbe::Utils;
+use strict;
+use warnings;
+
+use Digest::Adler32;
+use URI;
+
+
+sub new
+{
+    my $class = shift;
+    my (%params) = @_;
+
+    my $self = {%params};
+
+    bless $self, $class;
+
+    return $self;
+}
+
+sub hashUrl
+{
+    my $self = shift;
+    my ($url) = @_;
+
+    my $digest = $self->_buildDigest();
+
+    $digest->add($url);
+
+    return $digest->hexdigest();
+}
+
+sub normalizeUrl
+{
+    my ($self) = shift;
+    my ($url) = @_;
+
+    my $uri = URI->new($url);
+
+    $uri = URI->new(sprintf('http://%s', $url )) unless $uri->scheme();
+
+    return $uri->as_string;
+}
+
+sub _buildDigest
+{
+    return Digest::Adler32->new();
+}
+
+1;

script/shrlbe

@@ -0,0 +1,13 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use lib 'lib';
+use local::lib 'local';
+
+use Mojo::File qw(curfile);
+use lib curfile->dirname->sibling('lib')->to_string;
+use Mojolicious::Commands;
+
+# Start command line interface for application
+Mojolicious::Commands->start_app('Shrlbe');

shrlbe.pl

@@ -1,96 +0,0 @@
-use strict;
-use warnings FATAL => 'all';
-use feature qw/say/;
-
-use Mojolicious::Lite -signatures;
-
-use URI;
-use DBIx::Struct qw/connector hash_ref_slice/;
-use Data::Dumper;
-
-my $SITE_NAME = 'shrl.be/';
-
-my $db_file = 'shrl.db';
-DBIx::Struct::connect(sprintf('dbi:SQLite:dbname=%s', $db_file),"","");
-
-# Render template "index.html.ep" from the DATA section
-get '/' => sub ($c) {
-    $c->render(template => 'index', page_data => {});
-};
-
-get '/s/*url' => sub ($c) {
-    my $url = normalize_source_url($c->param('url'));
-    my $shorten_path = write_url($url);
-    my $shorten_url = $SITE_NAME.$shorten_path;
-    $c->render(text => $shorten_url);
-};
-
-post '/' => sub ($c) {
-    my $url = normalize_source_url($c->param('url'));
-    my $shorten_path = write_url($url);
-    my $shorten_url = $SITE_NAME.$shorten_path;
-    $c->render(template => 'index', page_data => { url => $url, shorten_url => $shorten_url});
-};
-
-get '/:shorten_path' => sub ($c) {
-    my $path = $c->param('shorten_path');
-    my $url = get_url($path);
-    if ($url) {
-        $c->res->code(307);
-        $c->redirect_to($url);
-    } else {
-        $c->render(status => 404, text => 'Page not found :(');
-    }
-
-};
-
-app->start;
-
-
-sub rand_str() {
-    my @set = ('0' ..'9', 'A' .. 'z', 'a'..'z');
-    my $str = join '' => map $set[rand @set], 1 .. 8;
-    return $str;
-}
-
-sub normalize_source_url($source_url) {
-    my $uri = URI->new($source_url);
-    $uri = URI->new('http://'.$source_url) if !$uri->scheme;
-    return $uri->as_string;
-}
-
-sub write_url($source_url) {
-
-    #TODO: it's really stupid idea to create short url from random + db writing. Need better.
-    my $shorten_path;
-    eval {
-        my $short_row = one_row('urls',{ source_url => $source_url});
-        if (!$short_row) {
-            $shorten_path = rand_str();
-            new_row('urls' =>
-                source_url => $source_url,
-                shorten_path => $shorten_path,
-            );
-
-        } else {
-            $shorten_path = $short_row->shorten_path;
-        }
-    };
-    if ($@) { #may fall with deep recursion if no free names available
-        if ($@ =~ /urls.shorten_path inserting /) {
-            &write_url($source_url);
-        }
-        die $@;
-    }
-    return $shorten_path;
-
-}
-
-sub get_url($shorten_path) {
-    my $row = one_row('urls', { shorten_path => $shorten_path});
-
-    return $row->source_url if($row);
-
-    return;
-}
-

shrlbe.yml

@@ -0,0 +1,3 @@
+---
+secrets:
+  - d1133fbd47db034007e79033b2f5ace2ade2026c

t/basic.t

@@ -0,0 +1,22 @@
+use Mojo::Base -strict;
+
+use lib 'lib';
+use local::lib 'local';
+
+use Test::More;
+use Test::Mojo;
+
+
+my $t = Test::Mojo->new('Shrlbe');
+
+$t->get_ok('/')->status_is(200)->content_like(qr/URL Shortener/i);
+
+$t->get_ok('/s/ya.ru')->status_is(200)->content_like(qr/shrl.be\/1c570448/i);
+
+$t->post_ok('/' => form => {url => 'ya.ru'})->status_is(200)->content_like(qr/shrl.be\/1c570448/i);
+
+$t->get_ok('/1c570448')->status_is(307);
+
+$t->get_ok('/unknown_hash')->status_is(404);
+
+done_testing();

t/utils.t

@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+
+use lib 'lib';
+use local::lib 'local';
+
+use Shrlbe::Utils;
+
+
+subtest 'creates correct object' => sub {
+    my $utils = _buildUtils();
+
+    isa_ok($utils, 'Shrlbe::Utils');
+};
+
+subtest 'hashUrl' => sub {
+    my $utils = _buildUtils();
+
+    ok($utils->hashUrl('https://ya.ru/', 'Return url hash'));
+};
+
+subtest 'normalizeUrl' => sub {
+    my $utils = _buildUtils();
+
+    is($utils->normalizeUrl('ya.ru'), 'http://ya.ru', 'Add http schema by default');
+    is($utils->normalizeUrl('https://ya.ru'), 'https://ya.ru', 'Do not change original schema');
+    is($utils->normalizeUrl('gopher://ya.ru'), 'gopher://ya.ru', 'Use not http schema');
+    is(
+        $utils->normalizeUrl('stratum1+ssl://0x1994aac8e2BC4281f69C487D2dea57212b475eB5.w1080@eu1.ethermine.org:5555'),
+        'stratum1+ssl://0x1994aac8e2BC4281f69C487D2dea57212b475eB5.w1080@eu1.ethermine.org:5555',
+        'Allow stratum'
+    );
+};
+
+sub _buildUtils
+{
+    return Shrlbe::Utils->new();
+}
+
+done_testing();
+