Initial commit

.dockerignore

+.git
+.gitignore
+.dockerignore
+_work
+docker-compose.yaml
+Dockerfile

.gitignore

+_work
+docker-compose.yaml

.gitlab-ci.yml

+image: docker:20.10.9
+
+variables:
+  DOCKER_TLS_CERTDIR: "/certs"
+
+services:
+  - docker:20.10.9-dind
+
+before_script:
+  - docker login -u $CI_REGISTRY_USER -p $CI_REGISTRY_PASSWORD $CI_REGISTRY
+
+build:
+  stage: build
+  script:
+    - VERSION=`cat VERSION`
+    - docker pull $CI_REGISTRY_IMAGE:latest || true
+    - docker build --cache-from $CI_REGISTRY_IMAGE:latest --tag $CI_REGISTRY_IMAGE:$VERSION --tag $CI_REGISTRY_IMAGE:latest .
+    - docker push $CI_REGISTRY_IMAGE:$VERSION
+    - docker push $CI_REGISTRY_IMAGE:latest

Dockerfile

+FROM debian:bullseye-slim
+
+RUN apt-get update && apt-get install -y \
+    wget make gcc libc-dev libpng-dev \
+    cpanminus \
+    build-essential \
+    libxml2-dev \
+    libcrypt-openssl-rsa-perl \
+    libcrypt-openssl-x509-perl \
+    libdata-guid-perl \
+    libdata-random-perl \
+    libdata-validate-uri-perl \
+    libdbix-class-perl \
+    libdbd-pg-perl \
+    libdbd-sqlite3-perl \
+    libdbi-perl \
+    libio-socket-ssl-perl \
+    libmodule-build-perl \
+    libnet-oauth2-perl \
+    libnet-ssleay-perl \
+    libredis-perl \
+    libyaml-dev
+
+RUN cpanm \
+    Image::PNG::QRCode \
+    Mojolicious \
+    Mojo::Pg \
+    Mojo::Redis \
+    Mojo::JWT \
+    Mojolicious::Plugin::Authentication
+#    Mojolicious::Plugin::Template::Mustache
+
+ADD . /opt/PZ
+WORKDIR /opt/PZ
+
+USER nobody
+EXPOSE 3000
+CMD /opt/PZ/script/pz daemon

TODO

+- custom url
+- 302 nebo informacni stranka
+- statistika
+- smazani

VERSION

+0.1.0

lib/PZ.pm

+package PZ;
+
+use Mojo::Base 'Mojolicious';
+use Mojo::Pg;
+use Mojo::Redis;
+use Mojolicious::Plugin::Authentication;
+use Net::OAuth2::Profile::WebServer;
+use PZ::Schema;
+
+sub startup {
+    my $self = shift;
+
+    # Nacteni konfigurace
+    my $cfg = $self->plugin('Config');
+    $self->helper( cfg => sub { return $cfg; } );
+
+    # Podpis pro cookies
+    $self->secrets($cfg->{session}{secrets});
+
+    # Delka session
+    $self->sessions->default_expiration($cfg->{session}{lifetime});
+
+    # Template engine
+#    $self->plugin('Template::Mustache');
+
+    $self->plugin('PZ::Helpers::OIDC');
+
+    my $redis = Mojo::Redis->new( 'redis://' . $cfg->{redis}{server} );
+    $self->helper( redis => sub { return $redis; } );
+
+    # migrace schematu
+    my $pg = Mojo::Pg->new
+        ->dsn($cfg->{database}{dsn})
+        ->username($cfg->{database}{user})
+        ->password($cfg->{database}{password})
+    ;
+    $pg->migrations->from_file($self->home . '/sql/migrations.sql');
+    $pg->migrations->migrate();
+    $self->helper( pg => sub { return $pg; } );
+
+    # Spojeni s databazi
+    my $schema = PZ::Schema->connect($cfg->{database});
+    $self->helper( schema => sub { return $schema; } );
+
+    $self->plugin('authentication', {
+        autoload_user => 1,
+        load_user => sub {
+            my $c = shift;
+            return $c->session->{user};
+        },
+        validate_user => sub {
+            my $c = shift;
+            return undef if ! $c->session->{user};
+            return $c->session->{user}{id};
+        },
+    });
+
+    # defautni globalni promenne ve stash
+    $self->defaults();
+
+    # vypnuti cache templatu pri vyvoji
+    $self->renderer->cache->max_keys(0) if $cfg->{dev_mode};
+
+    # router
+    my $r = $self->routes;
+
+    $r->get('/')->to(cb => sub { shift->render('index'); });
+    $r->post('/')->to('Shortcut#create');
+
+    $r->get('/login')->to('OIDC#callback');
+    $r->get('/logout')->to('OIDC#do_logout');
+
+    $r->get('/:shortcut')->to('Shortcut#redirect');
+    $r->get('/:shortcut/qr.png')->to('Shortcut#qr');
+
+}
+
+1;

lib/PZ/Controller/OIDC.pm

+package PZ::Controller::OIDC;
+use Mojo::Base 'Mojolicious::Controller', -signatures;
+use YAML;
+
+sub callback ($c) {
+    my $token = $c->oidc->get_access_token($c->param("code"));
+
+    # TODO: ERROR HANDLING
+
+    my $claims  = $c->oauth_claims( $token->access_token );
+
+    $c->session->{refresh_token} = $token->refresh_token;
+
+    $c->session->{user} = {
+        uuid        => $claims->{sub},
+        displayname => $claims->{name},
+        username    => $claims->{preferred_username},
+    };
+
+    my $user = $c->schema->resultset('User')->update_or_create(
+        $c->session->{user},
+        { key => 'uuid', }
+    );
+    $user->set_token();
+
+    $c->session->{user}{id}     = $user->id;
+    $c->session->{user}{token}  = $user->token;
+
+    $c->authenticate();
+    $c->redirect_to('/');
+}
+
+sub do_logout($c) { # nesmi se jmenovat logout - rekurze
+    $c->logout;
+    delete $c->session->{user};
+    $c->redirect_to('/');
+}
+
+1;

lib/PZ/Controller/Shortcut.pm

+package PZ::Controller::Shortcut;
+use Mojo::Base 'Mojolicious::Controller', -signatures;
+
+use Data::Validate::URI qw(is_uri);
+use Image::PNG::QRCode 'qrpng';
+
+# This action will render a template
+sub create ($c) {
+    my $url = $c->param('url');
+
+    if( ! is_uri($url) ){
+        $c->render('shortcut/invalid');
+        return;
+    }
+
+    my %data = (
+        user_id => $c->current_user->{id},
+        deleted => undef,
+        url     => $url,
+    );
+
+    my $shortcut = $c->schema->resultset('Shortcut')->search(\%data)->first;
+
+    $shortcut ||= $c->schema->resultset('Shortcut')->create({
+        %data,
+        shortcut => $c->schema->resultset('Shortcut')->generate(),
+    });
+
+    $url = 'https://' . $c->config->{domain} . '/' . $shortcut->shortcut;
+
+    $c->render('shortcut/created', url => $url, shortcut => $shortcut );
+}
+
+sub redirect ($c) {
+    my $shortcut = $c->schema->resultset('Shortcut')->search({
+        shortcut  => $c->stash->{shortcut},
+        is_active => 1,
+        deleted   => undef,
+    })->first;
+
+    if ( ! $shortcut ) {
+        $c->render( status => 404, text => 'not found' );
+        return;
+    }
+
+    $c->res->code($shortcut->code);
+    $c->redirect_to($shortcut->url);
+}
+
+sub qr ($c) {
+    my $url = 'https://' . $c->config->{domain} . '/' . $c->stash->{shortcut};
+    my $png = qrpng (text => $url, level => 4);
+    $c->res->headers->content_type('image/png');
+    $c->render( data => $png );
+}
+
+1;

lib/PZ/Helpers/OIDC.pm

+package PZ::Helpers::OIDC;
+
+use strict;
+use warnings;
+
+use constant KEY_FORMAT => "-----BEGIN PUBLIC KEY-----\n%s\n-----END PUBLIC KEY-----";
+
+use base 'Mojolicious::Plugin';
+use Mojo::JWT;
+use Mojo::UserAgent;
+use YAML;
+
+sub register {
+    my ($class, $self) = @_;
+
+    my ($jwt, $discovered);
+
+    my $ua  = Mojo::UserAgent->new();
+
+    # get public key
+
+    my $tx  = $ua->get( $self->cfg->{oidc}{realm_url} );
+    my $res = $tx->result;
+
+    if ($res->is_success) {
+        $jwt = Mojo::JWT->new(
+            public => sprintf( KEY_FORMAT,  $res->json->{public_key} )
+        );
+    }
+
+    # get endpoints
+
+    $tx  = $ua->get( $self->cfg->{oidc}{realm_well_known} );
+    $res = $tx->result;
+
+    if ($res->is_success) {
+        $discovered = $res->json;
+    }
+
+    my $oidc = Net::OAuth2::Profile::WebServer->new(
+       %{ $self->cfg->{oidc}},
+       authorize_url     => $discovered->{authorization_endpoint},
+       access_token_url  => $discovered->{token_endpoint},
+    );
+    $self->helper( oidc => sub { return $oidc; } );
+
+    $self->helper( oauth_claims => sub {
+        my $c     = shift;
+        my $token = shift // return undef;
+
+        return undef if ! $jwt;
+
+        my $claims;
+        eval { $claims = $jwt->decode( $token );  };
+
+        if ( $@ ) {
+            $c->app->log->warn( $@ );
+            return undef;
+        }
+
+        if ( Mojo::JWT->now() > $claims->{exp} ) {
+            $c->app->log->warn( 'Token expire' );
+            return undef;
+        }
+
+        return $claims;
+
+    });
+
+    $self->helper( oauth_roles => sub {
+        my $c      = shift;
+        my $claims = shift;
+
+        return $claims->{resource_access}{$self->cfg->{oidc}{client_id}}{roles};
+    });
+
+    $self->helper( oauth_groups => sub {
+        my $c      = shift;
+        my $claims = shift;
+
+        return $claims->{groups} // [] ;
+
+    });
+}
+
+1;
+
+__END__

lib/PZ/Schema.pm

+package PZ::Schema;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Schema';
+
+our $VERSION = 1;
+
+__PACKAGE__->load_namespaces;
+
+1;
+
+

lib/PZ/Schema/Result/Shortcut.pm

+package PZ::Schema::Result::Shortcut;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Core';
+
+use Data::Random qw(rand_chars);
+
+our $VERSION = 1;
+
+__PACKAGE__->table('shortcuts');
+
+__PACKAGE__->add_columns(
+    id => {
+        data_type         => 'integer',
+        is_auto_increment => 1,
+        is_nullable       => 0,
+        sequence          => 'uid_seq'
+    },
+    qw(
+        user_id
+        created
+        deleted
+        is_active
+        shortcut
+        url
+        code
+        title
+        description
+    ),
+);
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->add_unique_constraint(
+    'shortcut' => [qw(shortcut)]
+);
+
+1;
+

lib/PZ/Schema/Result/User.pm

+package PZ::Schema::Result::User;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Core';
+
+use Data::Random qw(rand_chars);
+
+our $VERSION = 1;
+
+__PACKAGE__->table('users');
+
+__PACKAGE__->add_columns(
+    id => {
+        data_type         => 'integer',
+        is_auto_increment => 1,
+        is_nullable       => 0,
+        sequence          => 'uid_seq'
+    },
+    qw(
+        uuid
+        created
+        deleted
+        is_active
+        username
+        displayname
+        token
+    ),
+);
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->add_unique_constraint(
+    'uuid' => [qw(uuid)]
+);
+
+__PACKAGE__->add_unique_constraint(
+    'token' => [qw(token)]
+);
+
+sub set_token {
+    my $self = shift;
+    my $new  = shift;
+
+    return if $self->token and not $new;
+
+    my $token = rand_chars( set => 'alphanumeric', size => 32 );
+
+    $self->update({
+        token => $token
+    });
+}
+
+1;

lib/PZ/Schema/ResultSet/Shortcut.pm

+package PZ::Schema::ResultSet::Shortcut;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::ResultSet';
+
+use Data::Random qw(rand_chars);
+
+use constant SIZE => 4;
+
+sub generate {
+    my $class = shift;
+
+    my $shortcut;
+
+    while ( 1 ) {
+        $shortcut = rand_chars( set => 'loweralpha', size => SIZE );
+
+        my $exists = $class->search({
+            shortcut => $shortcut
+        })->count;
+
+        last if ! $exists;
+    }
+
+    return $shortcut;
+
+}
+
+1;

p_z.conf

+{
+  name => 'Pirátský zkracovač',
+  description => 'Pirátský zkracovač',
+  styleguide => $ENV{STYLEGUIDE},
+  session => {
+    secrets  => [$ENV{SECRET}],
+    lifetime => 24 * 3600,
+  },
+  database => {
+    dsn            => $ENV{DB_DSN},
+    user           => $ENV{DB_USERNAME},
+    password       => $ENV{DB_PASSWORD},
+    AutoCommit     => 1,
+    quote_char     => '"',
+    name_sep       => '.',
+    pg_enable_utf8 => 1,
+    on_connect_do  => [
+        "set timezone to 'Europe/Prague'",
+    ],
+  },
+  oidc => {
+    name              => 'SSO',
+    scope             => 'profile',
+    client_id         => $ENV{OIDC_CLIENT_ID},
+    client_secret     => $ENV{OIDC_CLIENT_SECRET},
+    redirect_uri      => $ENV{BASE_URL} . '/login',
+    realm_url         => $ENV{OIDC_REALM_URL},
+    realm_well_known  => $ENV{OIDC_REALM_URL} . '/.well-known/openid-configuration',
+  },
+  redis => {
+    server => $ENV{REDIS_SERVER},
+  },
+  base_url          => $ENV{BASE_URL},
+  piratar           => 'https://a.pirati.cz/piratar/100/',
+  domain            => $ENV{DOMAIN},
+  dev_mode          => ( $ENV{MOJO_MODE} eq 'development'),
+};

script/pz

+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+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('PZ');

sql/migrations.sql

+-- 1 up
+create sequence "uid_seq" start 100000;
+
+create table "users" (
+    "id" integer not null default nextval('uid_seq'),
+    "uuid" varchar(36) not null,
+    "created" timestamp(0) not null default now(),
+    "deleted" timestamp(0),
+    "is_active" boolean not null default true,
+    "username" text,
+    "displayname" text,
+    "token" text,
+    primary key("id"),
+    unique("uuid"),
+    unique("token")
+);
+
+create table "shortcuts" (
+    "id" integer not null default nextval('uid_seq'),
+    "user_id" integer not null,
+    "created" timestamp(0) not null default now(),
+    "deleted" timestamp(0),
+    "is_active" boolean not null default true,
+    "shortcut" varchar(8) not null,
+    "url" text,
+    "code" integer not null default 301,
+    "title" text,
+    "description" text,
+    primary key("id"),
+    foreign key("user_id") references "users" ("id") on update cascade on delete restrict,
+    unique("shortcut")
+);
+
+create table "log" (
+    "id" integer not null default nextval('uid_seq'),
+    "time" timestamp(0) not null default now(),
+    "shortcut_id" integer not null,
+    "ip" inet,
+    primary key("id"),
+    foreign key("shortcut_id") references "shortcuts" ("id") on update cascade on delete restrict
+);

t/basic.t

+use Mojo::Base -strict;
+
+use Test::More;
+use Test::Mojo;
+
+my $t = Test::Mojo->new('PZ');
+$t->get_ok('/')->status_is(200)->content_like(qr/Mojolicious/i);
+
+done_testing();

templates/includes/form.html.ep

+<p>
+<div class="card elevation-4">
+  <div class="card__body">
+<form hx-post="/" hx-target="#response" hx-params="*">
+
+<div class="form-field">
+  <label class="form-field__label" for="field">URL</label>
+  <div class="form-field__wrapper form-field__wrapper--shadowed">
+    <input type="text" name="url" class="text-input form-field__control" value="" placeholder="https://www.pirati.cz/program/dlouhodoby/psychotropni-latky/" required="required" />
+
+    <button class="btn btn--grey-125 btn--hoveractive">
+        <div class="btn__body">Zkrátit</div>
+    </button>
+
+  </div>
+</div>
+
+</form>
+  </div>
+</div>
+</p>
+
+<div id="response"></div>