summaryrefslogtreecommitdiff
path: root/lib/VNWeb
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-09-25 18:37:29 +0200
committerYorhel <git@yorhel.nl>2019-09-25 18:49:19 +0200
commitd735e66d7d9b2d8c9a965ec96753864ff8c306c2 (patch)
treece0214b9e3cc819252b9192e7518f7768e568c77 /lib/VNWeb
parentc7642c03d99ed0255614a43fb82e55a1dde66753 (diff)
v2rw: Add Elm & db_edit framework + Convert doc page editing
Most of this is copied from v3. I did improve on a few aspects: - db_edit() and db_entry() use VNDB::Schema rather than dynamically querying the DB. This has the minor advantage of a faster startup. - The Elm code generator now writes to multiple files, this avoids the namespace pollution seen in v3's Lib.Gen and makes the dependency graph a bit more lean (i.e. faster incremental builds). - The Elm code generator doesn't update the timestamp of files that haven't been modified. This also speeds up incremental builds, the elm compiler can now skip rebuilding unmodified files. - The Elm API response generator code now uses plain functions rather than code references and all possible responses are now defined in Elm.pm. Turns out most API responses were used from more than a single place, so it makes sense to have them centrally defined. The doc page preview function is also much nicer; I'd like to apply this to all BBCode textareas as well. (Elm.pm itself is ugly as hell though. And we will prolly need some HTML form generation functions in Elm to make that part less verbose)
Diffstat (limited to 'lib/VNWeb')
-rw-r--r--lib/VNWeb/DB.pm51
-rw-r--r--lib/VNWeb/Docs/Edit.pm57
-rw-r--r--lib/VNWeb/Elm.pm236
-rw-r--r--lib/VNWeb/HTML.pm16
-rw-r--r--lib/VNWeb/Prelude.pm47
-rw-r--r--lib/VNWeb/Validation.pm66
6 files changed, 469 insertions, 4 deletions
diff --git a/lib/VNWeb/DB.pm b/lib/VNWeb/DB.pm
index b839baf3..7ef2e161 100644
--- a/lib/VNWeb/DB.pm
+++ b/lib/VNWeb/DB.pm
@@ -12,7 +12,7 @@ our @EXPORT = qw/
sql
sql_join sql_comma sql_and sql_array sql_func sql_fromhex sql_tohex sql_fromtime sql_totime
enrich enrich_merge enrich_flatten
- db_entry
+ db_entry db_edit
/;
@@ -222,6 +222,7 @@ my $entry_types = do {
# TODO:
# - Use non _hist tables if $maxrev == $rev (should be faster)
# - Combine the enrich_merge() calls into a single query.
+# - Fixed ordering of arrays (use primary keys)
sub db_entry {
my($type, $id, $rev) = @_;
my $t = $entry_types->{$type}||die;
@@ -261,4 +262,52 @@ sub db_entry {
$entry
}
+
+# Edit or create an entry, usage:
+# ($id, $chid, $rev) = db_edit $type, $id, $data, $uid;
+#
+# $id should be undef to create a new entry.
+# $uid should be undef to use the currently logged in user.
+# $data should have the same format as returned by db_entry(), but instead with
+# the following additional keys in the top-level hash:
+#
+# hidden, locked, editsum
+sub db_edit {
+ my($type, $id, $data, $uid) = @_;
+ $id ||= undef;
+ my $t = $entry_types->{$type}||die;
+
+ tuwf->dbExeci("SELECT edit_${type}_init(", \$id, ', (SELECT MAX(rev) FROM changes WHERE type = ', \$type, ' AND itemid = ', \$id, '))');
+ tuwf->dbExeci('UPDATE edit_revision SET', {
+ requester => $uid // scalar VNWeb::Auth::auth()->uid(),
+ ip => scalar tuwf->reqIP(),
+ comments => $data->{editsum},
+ ihid => $data->{hidden},
+ ilock => $data->{locked},
+ });
+
+ {
+ my $base = $t->{base}{name} =~ s/_hist$//r;
+ tuwf->dbExeci("UPDATE edit_${base} SET ", sql_comma(
+ map sql("\"$_->{name}\"", ' = ', \$data->{$_->{name}}),
+ grep exists $data->{$_->{name}}, $t->{base}{cols}->@*
+ ));
+ }
+
+ while(my($name, $tbl) = each $t->{tables}->%*) {
+ my $base = $tbl->{name} =~ s/_hist$//r;
+ my @cols = map sql_comma(map "\"$_->{name}\""), $tbl->{cols}->$@;
+ my @rows = map {
+ my $d = $_;
+ sql '(', sql_comma(map \$d, $tbl->{cols}->@*), ')'
+ } $data->{$name}->@*;
+
+ tuwf->dbExeci("DELETE FROM edit_${base}");
+ tuwf->dbExeci("INSERT INTO edit_${base} (", @cols, ') VALUES ', sql_comma @rows) if @rows;
+ }
+
+ my $r = tuwf->dbRow("SELECT * FROM edit_${type}_commit()");
+ ($r->{itemid}, $r->{chid}, $r->{rev})
+}
+
1;
diff --git a/lib/VNWeb/Docs/Edit.pm b/lib/VNWeb/Docs/Edit.pm
new file mode 100644
index 00000000..ad3af9ec
--- /dev/null
+++ b/lib/VNWeb/Docs/Edit.pm
@@ -0,0 +1,57 @@
+package VNWeb::Docs::Edit;
+
+use VNWeb::Prelude;
+use VNWeb::Docs::Lib;
+
+
+my $FORM = {
+ title => { maxlength => 200 },
+ content => { required => 0, default => '' },
+ hidden => { anybool => 1 },
+ locked => { anybool => 1 },
+
+ editsum => { _when => 'in out', editsum => 1 },
+ id => { _when => 'out', id => 1 },
+};
+
+my $FORM_OUT = form_compile out => $FORM;
+my $FORM_IN = form_compile in => $FORM;
+my $FORM_CMP = form_compile cmp => $FORM;
+
+elm_form DocEdit => $FORM_OUT, $FORM_IN;
+
+
+TUWF::get qr{/$RE{drev}/edit} => sub {
+ my $d = db_entry d => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
+ return tuwf->resDenied if !can_edit d => $d;
+
+ $d->{editsum} = $d->{chrev} == $d->{maxrev} ? '' : "Reverted to revision d$d->{id}.$d->{chrev}";
+
+ framework_ title => "Edit $d->{title}", index => 0, type => 'd', dbobj => $d, tab => 'edit',
+ sub {
+ elm_ DocEdit => $FORM_OUT, $d;
+ };
+};
+
+
+json_api qr{/$RE{drev}/edit}, $FORM_IN, sub {
+ my $data = shift;
+ my $doc = db_entry d => tuwf->capture('id') or return tuwf->resNotFound;
+
+ return elm_Unauth if !can_edit d => $doc;
+ return elm_Unchanged if !form_changed $FORM_CMP, $data, $doc;
+
+ my($id,undef,$rev) = db_edit d => $doc->{id}, $data;
+ elm_Changed $id, $rev;
+};
+
+
+json_api '/js/markdown.json', {
+ content => { required => 0, default => '' }
+}, sub {
+ return elm_Unauth if !auth->permDbmod;
+ elm_Content md2html shift->{content};
+};
+
+
+1;
diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm
new file mode 100644
index 00000000..ea181e3c
--- /dev/null
+++ b/lib/VNWeb/Elm.pm
@@ -0,0 +1,236 @@
+# This module is responsible for generating elm/Gen/*.
+#
+# It exports an `elm_form` function to generate type definitions, a JSON
+# encoder and HTML5 validation attributes to simplify and synchronize forms.
+#
+# It also exports an `elm_Response` function for each possible API response
+# (see %apis below).
+
+package VNWeb::Elm;
+
+use strict;
+use warnings;
+use TUWF;
+use Exporter 'import';
+use List::Util 'max';
+use VNDB::Config;
+use VNDB::Types;
+use VNWeb::Auth;
+
+our @EXPORT = qw/
+ elm_form
+/;
+
+
+# API response types and arguments. To generate an API response from Perl, call
+# elm_ResponseName(@args), e.g.:
+#
+# elm_Changed $id, $revision;
+#
+# These API responses are available in Elm in the `Gen.Api.Response` union type.
+my %apis = (
+ Unauth => [], # Not authorized
+ Unchanged => [], # No changes
+ Changed => [ { id => 1 }, { uint => 1 } ], # [ id, chrev]; DB entry has been successfully changed
+ Success => [],
+ CSRF => [], # Invalid CSRF token
+ Invalid => [], # POST data did not validate the schema
+ Content => [{}], # Rendered HTML content (for markdown/bbcode APIs)
+);
+
+
+# Generate the elm_Response() functions
+for my $name (keys %apis) {
+ no strict 'refs';
+ $apis{$name} = [ map tuwf->compile($_), $apis{$name}->@* ];
+ *{'elm_'.$name} = sub {
+ my @args = map {
+ $apis{$name}[$_]->validate($_[$_])->data if tuwf->debug;
+ $apis{$name}[$_]->analyze->coerce_for_json($_[$_], unknown => 'reject')
+ } 0..$#{$apis{$name}};
+ tuwf->resJSON({$name, \@args})
+ };
+ push @EXPORT, 'elm_'.$name;
+}
+
+
+
+
+# Formatting functions
+sub indent($) { $_[0] =~ s/\n/\n /gr }
+sub list { indent "\n[ ".join("\n, ", @_)."\n]" }
+sub string($) { '"'.($_[0] =~ s/([\\"])/\\$1/gr).'"' }
+sub tuple { '('.join(', ', @_).')' }
+sub bool($) { $_[0] ? 'True' : 'False' }
+sub to_camel { (ucfirst $_[0]) =~ s/_([a-z])/'_'.uc $1/egr; }
+
+# Generate a variable definition: name, type, value
+sub def($$$) { sprintf "\n%s : %s\n%1\$s = %s\n", @_; }
+
+
+# Generate an Elm type definition corresponding to a TUWF::Validate schema
+sub def_type {
+ my($name, $obj) = @_;
+ my $data = '';
+ my @keys = $obj->{keys} ? grep $obj->{keys}{$_}{keys}||($obj->{keys}{$_}{values}&&$obj->{keys}{$_}{values}{keys}), sort keys $obj->{keys}->%* : ();
+
+ $data .= def_type($name . to_camel($_), $obj->{keys}{$_}{values} || $obj->{keys}{$_}) for @keys;
+
+ $data .= sprintf "\ntype alias %s = %s\n\n", $name, $obj->elm_type(
+ keys => +{ map +($_, ($obj->{keys}{$_}{values} ? 'List ' : '') . $name . to_camel($_)), @keys }
+ );
+ $data
+}
+
+
+# Generate HTML5 validation attribute lists corresponding to a TUWF::Validate schema
+# TODO: Deduplicate some regexes (weburl, email)
+# TODO: Throw these inside a struct for better namespacing?
+sub def_validation {
+ my($name, $obj) = @_;
+ $obj = $obj->{values} if $obj->{values};
+ my $data = '';
+
+ $data .= def_validation($name . to_camel($_), $obj->{keys}{$_}) for $obj->{keys} ? sort keys $obj->{keys}->%* : ();
+
+ my %v = $obj->html5_validation();
+ $data .= def $name, 'List (Html.Attribute msg)', '[ '.join(', ',
+ $v{required} ? 'A.required True' : (),
+ $v{minlength} ? "A.minlength $v{minlength}" : (),
+ $v{maxlength} ? "A.maxlength $v{maxlength}" : (),
+ $v{min} ? "A.min $v{min}" : (),
+ $v{max} ? "A.max $v{max}" : (),
+ $v{pattern} ? 'A.pattern '.string($v{pattern}) : ()
+ ).']' if !$obj->{keys};
+ $data;
+}
+
+
+# Generate an Elm JSON encoder taking a corresponding def_type() as input
+sub encoder {
+ my($name, $type, $obj) = @_;
+ def $name, "$type -> JE.Value", $obj->elm_encoder(json_encode => 'JE.');
+}
+
+
+
+
+sub write_module {
+ my($module, $contents) = @_;
+ my $fn = sprintf '%s/elm/Gen/%s.elm', config->{root}, $module;
+
+ # The imports aren't necessary in all the files, but might as well add them.
+ $contents = <<~"EOF";
+ -- This file is automatically generated from lib/VNWeb/Elm.pm.
+ -- Do not edit, your changes will be lost.
+ module Gen.$module exposing (..)
+ import Http
+ import Html
+ import Html.Attributes as A
+ import Json.Encode as JE
+ import Json.Decode as JD
+ $contents
+ EOF
+
+ # Don't write anything if the file hasn't changed.
+ my $oldcontents = do {
+ local $/=undef; my $F;
+ open($F, '<:utf8', $fn) ? <$F> : '';
+ };
+ return if $oldcontents eq $contents;
+
+ open my $F, '>:utf8', $fn or die "$fn: $!";
+ print $F $contents;
+}
+
+
+
+
+
+# Create type definitions and a JSON encoder for a typical form.
+# Usage:
+#
+# elm_form 'FormName', $TO_ELM_SCHEMA, $TO_SERVER_SCHEMA;
+#
+# That will create a Gen.FormName module with the following definitions:
+#
+# type alias Recv = { .. }
+# type alias Send = { .. }
+# encode : Send -> JE.Value
+# valFieldName : List Html.Attribute
+#
+sub elm_form {
+ return if !tuwf->{elmgen};
+ my($name, $out, $in) = @_;
+
+ my $data = '';
+ $data .= def_type Recv => $out->analyze;
+ $data .= def_type Send => $in->analyze;
+ $data .= encoder encode => 'Send', $in->analyze;
+ $data .= def_validation val => $in->analyze;
+
+ write_module $name, $data;
+}
+
+
+
+# Generate the Gen.Api module with the Response type and decoder.
+sub write_api {
+
+ # Extract all { type => 'hash' } schemas and give them their own
+ # definition, so that it's easy to refer to those records in other places
+ # of the Elm code, similar to def_type().
+ my(@union, @decode);
+ my $data = '';
+ my $len = max map length, keys %apis;
+ for (sort keys %apis) {
+ my($name, $schema) = ($_, $apis{$_});
+ my $def = $name;
+ my $dec = sprintf 'JD.field "%s"%s <| %s', $name,
+ ' 'x($len-(length $name)),
+ @$schema == 0 ? "JD.succeed $name" :
+ @$schema == 1 ? "JD.map $name" : sprintf 'JD.map%d %s', scalar @$schema, $name;
+ my $tname = "Api$name";
+ for my $argn (0..$#$schema) {
+ my $arg = $schema->[$argn]->analyze();
+ my $jd = $arg->elm_decoder(json_decode => 'JD.', level => 3);
+ $dec .= " (JD.index $argn $jd)";
+ if($arg->{keys}) {
+ $data .= def_type $tname, $arg;
+ $def .= " $tname";
+ } elsif($arg->{values} && $arg->{values}{keys}) {
+ $data .= def_type $tname, $arg->{values};
+ $def .= " (List $tname)";
+ } else {
+ $def .= ' '.$arg->elm_type();
+ }
+ }
+ push @union, $def;
+ push @decode, $dec;
+ }
+ $data .= sprintf "\ntype Response\n = HTTPError Http.Error\n | %s\n", join "\n | ", @union;
+ $data .= sprintf "\ndecode : JD.Decoder Response\ndecode = JD.oneOf\n [ %s\n ]", join "\n , ", @decode;
+
+ write_module Api => $data;
+};
+
+
+sub write_types {
+ my $data = '';
+
+ $data .= def urlStatic => String => string config->{url_static};
+
+ write_module Types => $data;
+}
+
+
+if(tuwf->{elmgen}) {
+ mkdir config->{root}.'/elm/Gen';
+ write_api;
+ write_types;
+ open my $F, '>', config->{root}.'/elm/Gen/.generated';
+ print $F scalar gmtime;
+}
+
+
+1;
diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm
index 66ab52d6..d1498c1e 100644
--- a/lib/VNWeb/HTML.pm
+++ b/lib/VNWeb/HTML.pm
@@ -21,6 +21,7 @@ our @EXPORT = qw/
debug_
join_
user_
+ elm_
framework_
revision_
/;
@@ -61,6 +62,13 @@ sub user_ {
}
+# Instantiate an Elm module
+sub elm_($$$) {
+ my($mod, $schema, $data) = @_;
+ div_ 'data-elm-module' => 'DocEdit',
+ 'data-elm-flags' => JSON::XS->new->encode($schema->analyze->coerce_for_json($data, unknown => 'remove')), '';
+}
+
sub _head_ {
@@ -78,7 +86,8 @@ sub _head_ {
link_ rel => 'alternate', type => 'application/atom+xml', href => "/feeds/changes.atom", title => 'Recent Changes';
link_ rel => 'alternate', type => 'application/atom+xml', href => "/feeds/posts.atom", title => 'Recent Posts';
}
- meta_ name => 'robots', content => 'noindex, follow' if $o->{noindex};
+ meta_ name => 'csrf-token', content => auth->csrftoken;
+ meta_ name => 'robots', content => 'noindex' if defined $o->{index} && !$o->{index};
# Opengraph metadata
if($o->{og}) {
@@ -288,7 +297,7 @@ sub _hidden_msg_ {
# Options:
# title => $title
-# noindex => 1/0
+# index => 1/0, default 1
# feeds => 1/0
# search => $query
# og => { opengraph metadata }
@@ -313,7 +322,8 @@ sub framework_ {
_maintabs_ \%o;
$cont->() unless $o{hiddenmsg} && _hidden_msg_ \%o;
div_ id => 'footer', \&_footer_;
- }
+ };
+ script_ type => 'application/javascript', src => config->{url_static}.'/f/v2rw.js', '';
}
}
}
diff --git a/lib/VNWeb/Prelude.pm b/lib/VNWeb/Prelude.pm
index ecc5a606..26d0763e 100644
--- a/lib/VNWeb/Prelude.pm
+++ b/lib/VNWeb/Prelude.pm
@@ -14,6 +14,10 @@
# use VNWeb::Auth;
# use VNWeb::HTML;
# use VNWeb::DB;
+# use VNWeb::Validation;
+# use VNWeb::Elm;
+#
+# + A few other handy tools.
#
# WARNING: This should not be used from the above modules.
package VNWeb::Prelude;
@@ -22,6 +26,11 @@ use strict;
use warnings;
use feature ':5.26';
use utf8;
+use VNWeb::Elm;
+use VNWeb::Auth;
+use TUWF;
+use JSON::XS;
+
sub import {
my $c = caller;
@@ -44,11 +53,14 @@ sub import {
use VNWeb::Auth;
use VNWeb::HTML;
use VNWeb::DB;
+ use VNWeb::Validation;
+ use VNWeb::Elm;
1;
EOM;
no strict 'refs';
*{$c.'::RE'} = *RE;
+ *{$c.'::json_api'} = \&json_api;
}
@@ -73,4 +85,39 @@ our %RE = (
drev => qr{d$id$rev?},
);
+
+
+# Easy wrapper to create a simple API that accepts JSON data on POST requests.
+# The CSRF token and the input data are validated before the subroutine is
+# called.
+#
+# Usage:
+#
+# json_api '/some/url', {
+# username => { maxlength => 10 },
+# }, sub {
+# my $validated_data = shift;
+# };
+sub json_api {
+ my($path, $keys, $sub) = @_;
+
+ my $schema = ref $keys eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $keys }) : $keys;
+
+ TUWF::post $path => sub {
+ if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
+ warn "Invalid CSRF token in request\n";
+ return elm_CSRF;
+ }
+
+ my $data = tuwf->validate(json => $schema);
+ if(!$data) {
+ warn "JSON validation failed\ninput: " . JSON::XS->new->allow_nonref->pretty->canonical->encode(tuwf->reqJSON) . "\nerror: " . JSON::XS->new->encode($data->err) . "\n";
+ return elm_Invalid;
+ }
+
+ $sub->($data->data);
+ warn "Non-JSON response to a json_api request, is this intended?\n" if tuwf->resHeader('Content-Type') !~ /^application\/json/;
+ };
+}
+
1;
diff --git a/lib/VNWeb/Validation.pm b/lib/VNWeb/Validation.pm
index a014b11d..80af1d34 100644
--- a/lib/VNWeb/Validation.pm
+++ b/lib/VNWeb/Validation.pm
@@ -6,10 +6,76 @@ use VNWeb::Auth;
use Exporter 'import';
our @EXPORT = qw/
+ form_compile
+ form_changed
can_edit
/;
+TUWF::set custom_validations => {
+ id => { uint => 1, max => 1<<40 },
+ editsum => { required => 1, length => [ 2, 5000 ] },
+};
+
+
+# Recursively remove keys from hashes that have a '_when' key that doesn't
+# match $when. This is a quick and dirty way to create multiple validation
+# schemas from a single schema. For example:
+#
+# {
+# title => { _when => 'input' },
+# name => { },
+# }
+#
+# If $when is 'input', then this function returns:
+# { title => {}, name => {} }
+# Otherwise, it returns:
+# { name => {} }
+sub _stripwhen {
+ my($when, $o) = @_;
+ return $o if ref $o ne 'HASH';
+ +{ map $_ eq '_when' || (ref $o->{$_} eq 'HASH' && defined $o->{$_}{_when} && $o->{$_}{_when} !~ $when) ? () : ($_, _stripwhen($when, $o->{$_})), keys %$o }
+}
+
+
+# Short-hand to compile a validation schema for a form. Usage:
+#
+# form_compile $when, {
+# title => { _when => 'input' },
+# name => { },
+# ..
+# };
+sub form_compile {
+ tuwf->compile({ type => 'hash', keys => _stripwhen @_ });
+}
+
+
+sub _eq_deep {
+ my($a, $b) = @_;
+ return 0 if ref $a ne ref $b;
+ return 0 if defined $a != defined $b;
+ return 1 if !defined $a;
+ return 1 if !ref $a && $a eq $b;
+ return 1 if ref $a eq 'ARRAY' && (@$a == @$b && !grep !_eq_deep($a->[$_], $b->[$_]), 0..$#$a);
+ return 1 if ref $a eq 'HASH' && _eq_deep([sort keys %$a], [sort keys %$b]) && !grep !_eq_deep($a->{$_}, $b->{$_}), keys %$a;
+ 0
+}
+
+
+# Usage: form_changed $schema, $a, $b
+# Returns 1 if there is a difference between the data ($a) and the form input
+# ($b), using the normalization defined in $schema. The $schema must validate.
+sub form_changed {
+ my($schema, $a, $b) = @_;
+ my $na = $schema->validate($a)->data;
+ my $nb = $schema->validate($b)->data;
+
+ #warn "a=".JSON::XS->new->pretty->canonical->encode($na);
+ #warn "b=".JSON::XS->new->pretty->canonical->encode($nb);
+ !_eq_deep $na, $nb;
+}
+
+
# Returns whether the current user can edit the given database entry.
sub can_edit {
my($type, $entry) = @_;