summaryrefslogtreecommitdiff
path: root/lib/VN3/Prelude.pm
blob: a10a66acb013f131c1acd03db7741233896d6f63 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
# Importing this module is equivalent to:
#
#  use strict;
#  use warnings;
#  use v5.10;
#  use utf8;
#
#  use TUWF ':Html5', 'mkclass';
#  use Exporter 'import';
#  use Time::HiRes 'time';
#
#  use VNDBUtil;
#  use VNDB::Types;
#  use VNWeb::Auth;
#  use VN3::HTML;
#  use VN3::DB;
#  use VN3::Types;
#  use VN3::Validation;
#  use VN3::BBCode;
#  use VN3::ElmGen;
#
# WARNING: This should not be used from the above modules.
#
# This module also exports a few utility functions for writing URI handlers.
package VN3::Prelude;

use strict;
use warnings;
use utf8;
use feature ':5.10';
use TUWF;
use VNWeb::Auth;
use VN3::ElmGen;

sub import {
    my $c = caller;

    strict->import;
    warnings->import;
    feature->import(':5.10');
    utf8->import;

    die $@ if !eval <<"    EOM;";
    package $c;

    use TUWF ':Html5', 'mkclass';
    use Exporter 'import';
    use Time::HiRes 'time';

    use VNDBUtil;
    use VNDB::Types;
    use VNWeb::Auth;
    use VN3::HTML;
    use VN3::DB;
    use VN3::Types;
    use VN3::Validation;
    use VN3::BBCode;
    use VN3::ElmGen;
    1;
    EOM;

    no strict 'refs';
    *{$c.'::json_api'} = \&json_api;
}



# 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;
#   };
my $elm_Invalid = elm_api 'Invalid', {};
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";
            $elm_CSRF->();
            return;
        }

        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";
            $elm_Invalid->($data->err);
            return;
        }

        $sub->($data->data);
        warn "Non-JSON response to a json_api request, is this intended?\n" if tuwf->resHeader('Content-Type') !~ /^application\/json/;
    };
}

1;