Hamna

Writing a Web Application in Perl 6

Brian Duggan
promptworks

Introduction

Frameworks? Toolkits? Libraries? Language?
Web frameworks on modules.perl6.org: Crust (Frinfron), Bailador, Web::App::Ballet, Web::App::MVC, Lumberjack.
Tools: clients, servers, grammars.
Let's design an application and pull in only what we need.
Hamna

The Application

Architecture

react.js

Requirements

HTTP Server
HTTP Parser
- GET HTML, JSON
- POST JSON
Rendering HTTP Responses
- HTML (static and templates)
- JSON
- Routing
Postgres connectivity
Test Driven Development
- HTTP Client (for testing)
- Continuous Integration Testing
- HTTP testing idioms

HTTP Server

ecosystem

modules.perl6.org

HTTP::Server (role) HTTP::Server::Async HTTP::Server::Threaded
HTTP::Server::Simple
HTTP::Server::Tiny

Much work in progress.
Namespace conflicts (HTTP::Request with clients)
Logging, error handling, application testing: WIP
We need: HTML, JSON, a good test environment.

IO::Socket::INET

http://doc.perl6.org/type/IO::Socket::INET


use v6;

my $listen = IO::Socket::INET.new(:listen, :localport(3333));
loop {
    my $conn = $listen.accept;
    while my $buf = $conn.recv(:bin) {
        $conn.write: $buf;
    }
    $conn.close;
}

IO::Socket::INET

web.p6
use v6;

my $response = ...valid HTTP response...
my $listen = IO::Socket::INET.new(:listen, :localport(3333));
loop {
    my $conn = $listen.accept;
    while my $buf = $conn.recv(:bin) {
        $conn.write: $response;
    }
    $conn.close;
}


$ wrk http://localhost:3333
Running 10s test @ http://localhost:3333
  2 threads and 10 connections
  Thread Stats   Avg      Stdev     Max   +/- Stdev
    Latency     7.25ms    5.29ms  28.58ms   84.73%
    Req/Sec   789.13     83.95     1.02k    68.00%
  15853 requests in 10.09s, 1.25MB read
Requests/sec:   1570.58
Transfer/sec:    127.30KB

IO::Socket::Async

http://doc.perl6.org/type/IO::Socket::Async


use v6;

react {
    whenever IO::Socket::Async.listen('localhost',3333) -> $conn {
        whenever $conn.Supply(:bin) -> $buf {
            await $conn.write: $buf
        }
    }
}

IO::Socket::Async

web.p6

use v6;

my $response = ...valid http response...
react {
    whenever IO::Socket::Async.listen('localhost',3333) -> $conn {
        whenever $conn.Supply(:bin) -> $buf {
            await $conn.write: $response
        }
    }
}


$ wrk -t 5 http://localhost:3333
Running 10s test @ http://localhost:3333
  5 threads and 10 connections
  Thread Stats   Avg      Stdev     Max   +/- Stdev
    Latency   136.11ms  248.76ms   1.30s    85.47%
    Req/Sec    92.86     40.93   217.00     69.28%
  3128 requests in 10.09s, 253.54KB read
Requests/sec:    309.93
Transfer/sec:     25.12KB

HTTP Parser

ecosystem

Grammar::HTTP	over 14 RFCS
HTTP::Parser	Request (path, headers)
HTTP::MultiPartParser	forms
HTTP::ParseParams	Cookies, POST data, query strings
HTTP::Headers	Validates header names

Our needs:

No query strings or cookies.
No POST data other than JSON

Hamna::RequestLine

Hamna::RequestLine
my grammar parser {
     rule TOP {
        <verb> <path> "HTTP/1.1"
     }
     token verb {
         GET | POST | PUT | HEAD | DELETE
     }
     token path {
         '/' <segment>* %% '/'
     }
     token segment {
         [ <alpha> | <digit> | '+' | '-' | '.' | ':' ]*
     }
}

Hamna::Headers


my grammar parser {
     rule TOP { [ <header> \n ]* }
     rule header { <field-name> ':' <field-value> }
     token field-name { <-[:]>+ }
     token field-value { <-[\n\r]>+ }
}

Hamna::Headers

docs.perl6.org/language/subscripts#Custom_type_example


class HTTP::Header does Associative is Iterable {
    subset StrOrArrayOfStr where Str | ( Array & {.all ~~ Str} );

    has %!fields of StrOrArrayOfStr
                 handles <AT-KEY EXISTS-KEY DELETE-KEY push
                          iterator list kv keys values>;

    method Str { ... }
}


method AT-KEY     ($key) is rw { %!fields{normalize-key $key}        }
method EXISTS-KEY ($key)       { %!fields{normalize-key $key}:exists }
method DELETE-KEY ($key)       { %!fields{normalize-key $key}:delete }

sub normalize-key ($key) { $key.subst(/\w+/, *.tc, :g) }

JSON (body)

JSON::Fast

JSON::Pretty

JSON::Tiny

JSON::Fast is included with panda.

HTTP Responses

Static files ✓
JSON ✓
Templates for HTML
Routing

Templates

Templates are just inside-out strings.


Hello.
% for 1..2 {
Hello, again.
% }


sub render {
  my $output = "";
  $output ~= "Hello.\n";
  for 1..2 {
    $output ~= "Hello again.\n";
  }
  return $output;
}

Hamna::Template

grammar parser {
   rule TOP {
     [ statement | text ] *
   }
   token statement {
     '%' <code>
   }
   regex text {
     ^<!after '%'>
   }
   ...

Templates

Signatures, cute unicode delimiters, helpers.


%| Str :$name, Int:D $number where * > 0
Hello.
▶ for 1..2 {
Hello, <%= $name %>
▶ }
▶= include 'footer';


sub render(Str :$name, Int $number where * > 0) {
  my $output = "";
  $output ~= "Hello.\n";
  for 1..$number {
    $output ~= "Hello ";
    $output ~= html-escape($name);
  }
  $output ~= include 'footer';
  return $output;
}

Routing

HTTP::Server::Async::Plugins::Router::Simple
Path::Router
Router::Boost
Web::RF

Requirements: a few patterns mapped to rendering functions

Routing

template -> Hamna::Template -> subroutine
pattern -> Hamna::Router -> regular expression

Routing

'/name/:first'

'/' name '/'  <first=placeholder>

Hamna::Pattern

my grammar parser {
    token TOP          { '/' <part> *%% '/' }
    token part         { <literal> || <placeholder> }
    token literal      { ... }
    token placeholder  { ':' ... }
    ...

Routing

/name/:first

'/' name '/'  <first=placeholder>

/date/Δwhen

'/' date '/'  <when=placeholder_date>

/wiki/∙page

'/' name '/'  <page=placeholder_lc>

Routing

Building a dispatch table:

Hamna::App::Pim

self.router.get('/cal/:date', sub ($req, $res, $/) {
    self.render($res, 'template', {
      data => ...something with $...
    })
};

Routing

Building a dispatch table:

Hamna::App::Pim

.get: '/cal/:date', -> $req, $res, $/ {
    self.render: $res, 'template', {
      data => ...something with $<date>...
    )

Testing


t/000-perl.t
t/001-request.t
t/002-requests.t
t/003-server.t
t/004-db.t
t/005-db-hamna.t
t/006-web.t
t/007-getset.t
t/008-route.t
t/009-pattern.t
t/010-log.t
t/010-template.t
t/011-app.t
t/012-app-templates.t

HTTP client

HTTP::Tinyish ✓

HTTP::Client

HTTP::UserAgent

Web::Scraper

Continuous Integration Testing

.travis.yml, circle.yml
explicit create a database
explicitly cache directory with perl6
explicit dependencies (notests for DBIish)
install.sh

Testing Idioms

Test suite -> webserver -> application -> database and back.

t/007-getset.t

my $app = Hamna::App::Getset.new;
my $t = Hamna::Test.new.start($app);

$t.post-ok("/set/foo", json => { abc => 123 } )
  .status-is(200)
  .json-is( { status => 'ok' } );

$t.get-ok("/get/foo")
  .status-is(200)
  .json-is({abc => 123});

Summary

Ugly
- install.sh
- .precomp
- installing dependencies makes filenames with SHA1's
Bad
- little unexpected failures (dates in log string? append to a native?)
- restart build, clear cache, upgrade
- gaps in docs, works in progress (leave, whenever)
- Addictive
Good
- Fun
- Responsive community (above item fixed and released)
- Helpful errors
- Gradual typing, Grammars, Async primitives, Channels, Unicode
- Wow, Perl 6!

Live demo!

✓ Wiki
- Calendar
- Address book

http://utiaji.org
http://github.com/bduggan/hamna