APISchema

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    received the program in object code or executable form alone.)

Source code for a work means the preferred form of the work for making
modifications to it.  For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.

  4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License.  However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.

  5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.

  6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions.  You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.

  7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time.  Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.

Each version is given a distinguishing version number.  If the Program
specifies a version number of the license which applies to it and "any

LICENSE  view on Meta::CPAN

may not charge a fee for this Package itself. However, you may distribute this
Package in aggregate with other (possibly commercial) programs as part of a
larger (possibly commercial) software distribution provided that you do not
advertise this Package as a product of your own.

6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.

7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.

8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.

9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

The End

cpanfile  view on Meta::CPAN

requires 'URL::Encode';
requires 'HTML::Escape';
requires 'Text::MicroTemplate';
requires 'Text::MicroTemplate::Extended';
requires 'Text::MicroTemplate::DataSection';
requires 'Text::Markdown::Hoedown';
requires 'HTTP::Message';
requires 'Valiemon', '0.04';
requires 'URI::Escape';

on 'test' => sub {
    requires 'Path::Class';
    requires 'Test::More', '0.98';
    requires 'Test::Class';
    requires 'Test::Deep';
    requires 'Test::Fatal';
    requires 'Test::Deep::JSON';
    requires 'HTTP::Request::Common';
};

eg/bmi.psgi  view on Meta::CPAN


my $schema = APISchema::DSL::process {
    include '../t/fixtures/bmi.def';
};

my $router = do {
    my $generator = APISchema::Generator::Router::Simple->new;
    $generator->generate_router($schema);
};

my $app = sub {
    my $env = shift;

    my $match = $router->match($env);

    return [404, [], ['not found']] unless $match;

    my $req = Plack::Request->new($env);

    my $payload = decode_json($req->content);

eg/bmi.psgi  view on Meta::CPAN

        schema => $schema,
    )->to_app;
    mount '/mock/' => builder {
        enable "APISchema::ResponseValidator", schema => $schema;
        enable "APISchema::RequestValidator",  schema => $schema;

        Plack::App::APISchema::MockServer->new(
            schema => $schema,
        )->to_app;
    };
    mount '/doc.md' => sub {
        my $generator = APISchema::Generator::Markdown->new;
        my $content = $generator->format_schema($schema);
        [200, ['Content-Type' => 'text/plain; charset=utf-8;'], [$content]];
    };

    mount '/' => $app;
}

__END__

lib/APISchema/DSL.pm  view on Meta::CPAN


our %METHODS = (
    ( map { $_ => $_ } qw(HEAD GET POST PUT DELETE PATCH) ),
    FETCH => [qw(GET HEAD)],
);
our @DIRECTIVES = (qw(include filter resource title description), keys %METHODS);
our @EXPORT = @DIRECTIVES;

my $_directive = {};

sub process (&) {
    my $dsl = shift;

    my $schema = APISchema::Schema->new;

    local $_directive->{include} = sub {
        my ($file) = @_;
        -r $_[0] or Carp::croak(sprintf 'No such file: %s', $file);
        my $content = file($file)->slurp;
        my $with_utf8 = "use utf8;\n" . $content;
        eval $with_utf8;
        Carp::croak($@) if $@;
    };
    local $_directive->{title} = sub {
        $schema->title(@_);
    };
    local $_directive->{description} = sub {
        $schema->description(@_);
    };

    my @filters;
    local $_directive->{filter} = sub {
        push @filters, $_[0];
    };
    local $_directive->{resource} = sub {
        $schema->register_resource(@_);
    };

    local @$_directive{keys %METHODS} = map {
        my $m = $_;
        sub {
            my ($path, @args) = @_;
            for my $filter (reverse @filters) {
                local $Carp::CarpLevel += 1;
                @args = $filter->(@args);
            }
            my ($definition, $option) = @args;

            $schema->register_route(
                ( map {
                    defined $definition->{$_} ?

lib/APISchema/DSL.pm  view on Meta::CPAN

                method => $METHODS{$m},
            );
        };
    } keys %METHODS;

    $dsl->();
    return $schema;
}

# dispatch directives to the definitions
sub include ($) { $_directive->{include}->(@_) }
sub title ($) { $_directive->{title}->(@_) }
sub description ($) { $_directive->{description}->(@_) }
sub filter (&) { $_directive->{filter}->(@_) }
sub resource ($@) { $_directive->{resource}->(@_) }
for my $method (keys %METHODS) {
    no strict 'refs';
    *$method = sub ($@) { goto \&{ $_directive->{$method} } };
}

# disable the global definitions
@$_directive{@DIRECTIVES} = (sub {
    Carp::croak(sprintf(
        q(%s should be called inside 'process {}' block),
        join '/', @DIRECTIVES
    ));
}) x scalar @DIRECTIVES;

1;
__END__

lib/APISchema/Generator/Markdown.pm  view on Meta::CPAN

use warnings;

# lib
use APISchema::Generator::Markdown::Formatter;
use APISchema::Generator::Markdown::ExampleFormatter;
use APISchema::Generator::Markdown::ResourceResolver;

# cpan
use Text::MicroTemplate::DataSection qw();

sub new {
    my ($class) = @_;

    my $renderer = Text::MicroTemplate::DataSection->new(
        escape_func => undef
    );
    bless {
        renderer => $renderer,
        map {
            ( $_ => $renderer->build_file($_) );
        } qw(index toc route resource request response
             request_example response_example),
    }, $class;
}

sub resolve_encoding ($) {
    my ($resources) = @_;
    $resources = { body => $resources } unless ref $resources;
    my $encoding = $resources->{encoding} // { '' => 'auto' };
    $encoding = { '' => $encoding } unless ref $encoding;
    return { %$resources, encoding => $encoding };
}

sub format_schema {
    my ($self, $schema) = @_;

    my $renderer = $self->{renderer};
    my $routes = $schema->get_routes;
    my $resources = $schema->get_resources;

    my $root = $schema->get_resource_root;
    my $resolver = APISchema::Generator::Markdown::ResourceResolver->new(
        schema => $root,
    );

lib/APISchema/Generator/Markdown/ExampleFormatter.pm  view on Meta::CPAN

# lib
use APISchema::Generator::Markdown::Formatter qw(json);

# cpan
use URI::Escape qw(uri_escape_utf8);
use Class::Accessor::Lite (
    new => 1,
    ro => [qw(resolver spec)],
);

sub example {
    my $self = shift;
    return $self->resolver->example(@_);
}

sub header {
    my ($self) = @_;
    my $header = $self->spec->{header} or return '';
    my $resource = $header->definition or return '';
    my $example = $self->example($resource);

    return '' unless defined $example;
    return '' unless (ref $example) eq 'HASH';
    return '' unless scalar keys %$example;

    return join "\n", map {
        sprintf '%s: %s', $_ =~ s/[_]/-/gr, $example->{$_};
    } sort keys %$example;
}

sub parameter {
    my ($self) = @_;
    my $parameter = $self->spec->{parameter} or return '';
    my $resource = $parameter->definition or return '';
    my $example = $self->example($resource);

    return '' unless defined $example;
    return '' unless (ref $example) eq 'HASH';
    return '' unless scalar keys %$example;

    return '?' . join '&', map {
        # TODO multiple values?
        sprintf '%s=%s', map { uri_escape_utf8 $_ } $_, $example->{$_};
    } sort keys %$example;
}

sub body {
    my ($self) = @_;
    my $body = $self->spec->{body} or return '';
    my $resource = $body->definition or return '';
    my $example = $self->example($resource);

    return '' unless defined $example;

    return ref $example ? json($example) : $example;
}

sub header_and_body {
    my ($self) = @_;
    join("\n", grep { defined $_ && length $_ > 0 } $self->header, $self->body);
}

1;

lib/APISchema/Generator/Markdown/Formatter.pm  view on Meta::CPAN

use HTTP::Status qw(status_message);
use URI::Escape qw(uri_escape_utf8);
use JSON::XS ();
my $JSON = JSON::XS->new->canonical(1);

use constant +{
    RESTRICTIONS => [qw(required max_items min_items max_length min_length maximum minimum pattern)],
    SHORT_DESCRIPTION_LENGTH => 100,
};

sub type ($); # type has recursive call

sub type ($) {
    my $def = shift;
    my $bar = '|';

    if (ref $def) {
        for my $type (qw(oneOf anyOf allOf)) {
            if (my $union = $def->{$type}) {
                return join($bar, map { type($_) } @$union);
            }
        }
    }

lib/APISchema/Generator/Markdown/Formatter.pm  view on Meta::CPAN


    my $type = $def->{type};
    if ($type) {
        return sprintf '`%s`', $type unless ref $type;
        return join $bar, map { code($_) } @{$type} if ref $type eq 'ARRAY';
    }

    return 'undefined';
}

sub json ($) {
    my $x = shift;
    if (ref $x eq 'SCALAR') {
        if ($$x eq 1) {
            $x = 'true';
        } elsif ($$x eq 0) {
            $x = 'false';
        }
    } elsif (ref $x) {
        $x = $JSON->encode($x);
    } else {
        $x = $JSON->encode([$x]);
        $x =~ s/^\[(.*)\]$/$1/;
    }
    return $x;
}

my $PRETTY_JSON = JSON::XS->new->canonical(1)->indent(1)->pretty(1);
sub pretty_json ($) {
    my $x = shift;
    if (ref $x) {
        $x = $PRETTY_JSON->encode($x);
    } else {
        $x = $PRETTY_JSON->encode([$x]);
        $x =~ s/^\[\s*(.*)\s*\]\n$/$1/;
    }
    return $x;
}

sub _code ($) {
    my $text = shift;
    return '' unless defined $text;
    if ($text =~ /[`|]/) {
        $text =~ s/[|]/|/g;
        return sprintf '<code>%s</code>', $text;
    }
    return sprintf '`%s`', $text;
}

sub code ($;$) {
    my ($text, $exists) = @_;
    return $exists ? '`null`' : '' unless defined $text;
    return _code json $text;
}

sub anchor ($$) {
    my ($label, $obj) = @_;
    my $name = ref $obj ? $obj->title : $obj;
    return sprintf '%s-%s', $label, uri_escape_utf8($name);
}

sub restriction ($) {
    my $def = shift;
    return '' unless (ref $def) eq 'HASH';

    my @result = ();
    for my $r (sort @{+RESTRICTIONS}) {
        next unless defined $def->{$r};

        if (ref $def->{$r}) {
            push @result, _code sprintf "$r%s", json $def->{$r};
        } else {
            push @result, _code sprintf "$r(%s)", json $def->{$r};
        }
    }
    return join ' ', @result;
}

sub desc ($) {
    my $text = shift || '';
    $text = $text =~ s/[\r\n].*\z//sr;
    $text = substr($text, 0, SHORT_DESCRIPTION_LENGTH) . '...'
        if length($text) > SHORT_DESCRIPTION_LENGTH;
    return $text;
}

sub method ($) {
    my $method = shift;
    return $method->[0] if (ref $method || '') eq 'ARRAY';
    return $method;
}

sub methods ($) {
    my $method = shift;
    return join ', ', map { _code($_) } @$method
        if (ref $method || '') eq 'ARRAY';
    return _code($method);
}

sub content_type ($) {
    my $type = shift;
    return '-' unless length($type);
    return "`$type`";
}

sub http_status ($) {
    my $code = shift;
    return undef unless $code;
    return join(' ', $code, status_message($code));
}

sub http_status_code {
    return _code http_status shift;
}

1;

lib/APISchema/Generator/Markdown/ResourceResolver.pm  view on Meta::CPAN

use strict;
use warnings;

# cpan
use JSON::Pointer;
use Class::Accessor::Lite (
    new => 1,
    ro  => [qw(schema)],
);

sub _foreach_properties($$&) {
    my ($name_path, $definition, $callback) = @_;
    return unless (ref $definition || '') eq 'HASH';

    if ($definition->{items}) {
        my $items = $definition->{items};
        my $type = ref $items || '';
        if ($type eq 'HASH') {
            $callback->([@$name_path, '[]'], $items);
        } elsif ($type eq 'ARRAY') {
            $callback->([@$name_path, "[$_]"], $items->{$_}) for (0..$#$items);

lib/APISchema/Generator/Markdown/ResourceResolver.pm  view on Meta::CPAN


    if ($definition->{properties}) {
        my $items = $definition->{properties};
        my $type = ref $items || '';
        if ($type eq 'HASH') {
            $callback->([@$name_path, $_], $items->{$_}) for keys %$items;
        }
    }
}

sub _property_name (@) {
    my @name_path = @_;
    return '.' . join '.', @name_path;
}

sub _collect_properties {
    my ($self, $path, $definition) = @_;
    return {} unless (ref $definition || '') eq 'HASH';

    my $ref = $definition->{'$ref'};
    if ($ref) {
        $ref = $ref =~ s/^#//r;
        my $def = JSON::Pointer->get($self->schema, $ref);
        return $self->_collect_properties($path, $def)
            if $def && $ref !~ qr!^/resource/[^/]+$!;

        $definition = +{
            %$definition,
            description => $definition->{description} // $def->{description},
        };
    }

    my $result = { _property_name(@$path) => $definition };
    _foreach_properties($path, $definition, sub {
        $result = +{
            %$result,
            %{$self->_collect_properties(@_)},
        };
    });
    return $result;
}

sub _collect_example {
    my ($self, $path, $definition) = @_;
    return ($definition->{example}, 1) if exists $definition->{example};

    if (my $union = $definition->{oneOf} || $definition->{anyOf} || $definition->{allOf}) {
        return ($self->_collect_example($path, $union->[0]), 1);
    }

    my $ref = $definition->{'$ref'};
    if ($ref) {
        $ref = $ref =~ s/^#//r;
        my $def = JSON::Pointer->get($self->schema, $ref);
        return ($self->_collect_example($path, $def), 1) if $def;
    }

    my %result;
    my $type = $definition->{type} || '';
    _foreach_properties($path, $definition, sub {
        my ($example, $exists) = $self->_collect_example(@_);
        unless ($exists) {
            if (exists $_[1]->{default}) {
                $example = $_[1]->{default};
                $exists = 1;
            }
        }
        $result{$_[0]->[-1]} = $example if $exists;
    });

lib/APISchema/Generator/Markdown/ResourceResolver.pm  view on Meta::CPAN

        for (keys %result) {
            next unless $_ =~ /\A\[([0-9]+)\]\z/;
            $result[$1] = $result{$_};
        }
        return (\@result, 1);
    }

    return (undef, 0);
}

sub properties {
    my ($self, $resource) = @_;
    return $self->_collect_properties([], $resource);
}

sub example {
    my ($self, $resource) = @_;
    my ($example) = $self->_collect_example([], $resource);
    return $example;
}

1;

lib/APISchema/Generator/Router/Simple.pm  view on Meta::CPAN


use Hash::Merge::Simple qw(merge);
use Class::Load qw(load_class);
use Class::Accessor::Lite (
    new => 1,
    ro  => [qw(router_class)],
);

use constant ROUTER_CLASS => 'Router::Simple';

sub generate_router {
    my ($self, $schema) = @_;

    my $router_class = $self->router_class // ROUTER_CLASS;
    my $router = load_class($router_class)->new;

    $self->inject_routes($schema, $router);
}

sub inject_routes {
    my ($self, $schema, $router) = @_;

    my $router_class = ref $router;

    for my $route (@{$schema->get_routes}) {
        my $option = $route->option // {};
        $option = merge $option, $option->{$router_class} // {};
        $router->connect($route->title, $route->route => $route->destination, {
            method => $route->method,
            map { $_ => $option->{$_} } qw(host on_match),

lib/APISchema/JSON.pm  view on Meta::CPAN

use strict;
use warnings;

use Exporter 'import';
our @EXPORT = qw(encode_json_canonical);

use JSON::XS;

my $json = JSON::XS->new->utf8->canonical(1);

sub encode_json_canonical {
    my ($value) = @_;
    $json->encode($value);
}

1;

lib/APISchema/Route.pm  view on Meta::CPAN

# lib
use APISchema::Resource;

# cpan
use Class::Accessor::Lite (
    new => 1,
    rw => [qw(route title description destination method option
              request_resource response_resource)],
);

sub _canonical_resource {
    my ($self, $method, $resource_root, $extra_args, $filter) = @_;

    $method = "${method}_resource";
    my $resource = $self->$method();
    for (@$extra_args) {
        last unless $resource && ref $resource eq 'HASH';
        last unless $resource->{$_};
        $resource = $resource->{$_};
    }
    $resource = { body => $resource } unless ref $resource;

lib/APISchema/Route.pm  view on Meta::CPAN

                title => $name,
                definition => ,+{
                    %$resource_root,
                    '$ref' => sprintf '#/resource/%s', $name,
                },
            );
        } grep { $filter{$_} } qw(header parameter body),
    };
}

sub canonical_request_resource {
    my ($self, $resource_root, $extra_args, $filter) = @_;
    return $self->_canonical_resource(
        request => $resource_root,
        $extra_args // [], $filter // [],
    );
}

sub canonical_response_resource {
    my ($self, $resource_root, $extra_args, $filter) = @_;
    return $self->_canonical_resource(
        response => $resource_root,
        $extra_args // [], $filter // [],
    );
}

sub responsible_code_is_specified {
    my ($self) = @_;
    my $res = $self->response_resource;
    return unless $res && ref $res;

    my @codes = sort grep { $_ =~ qr!\A[0-9]+\z! } keys %$res;
    return @codes > 0;
}

sub responsible_codes {
    my ($self) = @_;

    return [200] unless $self->responsible_code_is_specified;

    my $res = $self->response_resource;
    my @codes = sort grep { $_ =~ qr!\A[0-9]+\z! } keys %$res;
    return @codes ? [@codes] : [200];
}

sub default_responsible_code {
    my ($self) = @_;

    $self->responsible_codes->[0];
}

1;

lib/APISchema/Schema.pm  view on Meta::CPAN

use warnings;
use 5.014;

use APISchema::Route;
use APISchema::Resource;

use Class::Accessor::Lite (
    rw => [qw(title description)],
);

sub new {
    my ($class) = @_;

    bless {
        resources => {},
        routes => [],
    }, $class;
}

sub register_resource {
    my ($self, $title, $definition) = @_;

    my $resource = APISchema::Resource->new(
        title => $title,
        definition => $definition,
    );
    $self->{resources}->{$title} = $resource;

    return $resource;
}

sub get_resources {
    my ($self) = @_;

    [ sort { $a->title cmp $b->title } values %{$self->{resources}} ];
}

sub get_resource_by_name {
    my ($self, $name) = @_;

    $self->{resources}->{$name || ''};
}

sub get_resource_root {
    my ($self) = @_;
    return +{
        resource   => +{ map {
            $_ => $self->{resources}->{$_}->definition;
        } keys %{$self->{resources}} },
        properties => {},
    };
}

sub _next_title_candidate {
    my ($self, $base_title) = @_;
    if ($base_title =~ /\(([0-9]+)\)$/) {
        my $index = $1 + 1;
        return $base_title =~ s/\([0-9]+\)$/($index)/r;
    } else {
        return $base_title . '(1)';
    }
}

sub register_route {
     my ($self, %values) = @_;

     # make fresh title
     my $title = $values{title} // $values{route} // 'empty_route';
     while ($self->get_route_by_name($title)) {
         $title = $self->_next_title_candidate($title);
     }

     my $route = APISchema::Route->new(
         %values,
         title => $title,
     );
     push @{$self->{routes}}, $route;
     return $route;
}

sub get_routes {
    my ($self) = @_;

    $self->{routes};
}

sub get_route_by_name {
    my ($self, $name) = @_;
    my ($route) = grep { ($_->title||'') eq $name } @{$self->get_routes};
    return $route;
}

1;

lib/APISchema/Validator.pm  view on Meta::CPAN

use constant +{
    DEFAULT_VALIDATOR_CLASS => 'Valiemon',
    TARGETS => [qw(header parameter body)],
    DEFAULT_ENCODING_SPEC => {
        'application/json'                  => 'json',
        'application/x-www-form-urlencoded' => 'url_parameter',
        # TODO yaml, xml
    },
};

sub _build_validator_class {
    return DEFAULT_VALIDATOR_CLASS;
}

sub _new {
    my $class = shift;
    return bless { @_ == 1 && ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class;
}

sub for_request {
    my $class = shift;
    return $class->_new(@_, fetch_resource_method => 'canonical_request_resource');
}

sub for_response {
    my $class = shift;
    return $class->_new(@_, fetch_resource_method => 'canonical_response_resource');
}

sub _valid_result { APISchema::Validator::Result->new_valid(@_) }
sub _error_result { APISchema::Validator::Result->new_error(@_) }

sub _resolve_encoding {
    my ($content_type, $encoding_spec) = @_;
    # TODO handle charset?
    $content_type = $content_type =~ s/\s*;.*$//r;
    $encoding_spec //= DEFAULT_ENCODING_SPEC;

    if (ref $encoding_spec) {
        $encoding_spec = $encoding_spec->{$content_type};
        return ( undef, { message => "Wrong content-type: $content_type" } )
            unless $encoding_spec;
    }

lib/APISchema/Validator.pm  view on Meta::CPAN

    my $method = $encoding_spec;
    return ( undef, {
        message      => "Unknown decoding method: $method",
        content_type => $content_type,
    } )
        unless APISchema::Validator::Decoder->new->can($method);

    return ($method, undef);
}

sub _validate {
    my ($validator_class, $decode, $target, $spec) = @_;

    my $obj = eval { APISchema::Validator::Decoder->new->$decode($target) };
    return { message => "Failed to parse $decode" } if $@;

    my $validator = $validator_class->new($spec->definition);
    my ($valid, $err) = $validator->validate($obj);

    return {
        attribute => $err->attribute,
        position  => $err->position,
        expected  => $err->expected,
        actual    => $err->actual,
        message   => "Contents do not match resource '@{[$spec->title]}'",
    } unless $valid;

    return; # avoid returning the last conditional value
}

sub validate {
    my ($self, $route_name, $target, $schema) = @_;

    my @target_keys = @{+TARGETS};
    my $valid = _valid_result(@target_keys);

    my $route = $schema->get_route_by_name($route_name)
        or return $valid;
    my $method = $self->fetch_resource_method;
    my $resource_root = $schema->get_resource_root;
    my $resource_spec = $route->$method(

lib/APISchema/Validator/Decoder.pm  view on Meta::CPAN

package APISchema::Validator::Decoder;
use strict;
use warnings;

# cpan
use JSON::XS qw(decode_json);
use URL::Encode qw(url_params_mixed);
use Class::Accessor::Lite ( new => 1 );

sub perl {
    my ($self, $body) = @_;
    return $body;
}

my $JSON = JSON::XS->new->utf8;
sub json {
    my ($self, $body) = @_;
    return $JSON->decode($body);
}

sub url_parameter {
    my ($self, $body) = @_;
    return undef unless defined $body;
    return url_params_mixed($body, 1);
}

1;

lib/APISchema/Validator/Result.pm  view on Meta::CPAN


# core
use List::MoreUtils qw(all);

# cpan
use Hash::Merge::Simple ();
use Class::Accessor::Lite (
    new => 1,
);

sub new_valid {
    my ($class, @targets) = @_;
    return $class->new(values => { map { ($_ => [1]) } @targets });
}

sub new_error {
    my ($class, $target, $err) = @_;
    return $class->new(values => { ( $target // '' ) => [ undef, $err] });
}

sub _values { shift->{values} // {} }

sub merge {
    my ($self, $other) = @_;
    $self->{values} = Hash::Merge::Simple::merge(
        $self->_values,
        $other->_values,
    );
    return $self;
}

sub errors {
    my $self = shift;
    return +{ map {
        my $err = $self->_values->{$_}->[1];
        $err ? ( $_ => $err ) : ();
    } keys %{$self->_values} };
}

sub is_valid {
    my $self = shift;
    return all { $self->_values->{$_}->[0] } keys %{$self->_values};
}

1;

lib/Plack/App/APISchema/Document.pm  view on Meta::CPAN

use warnings;
use parent qw(Plack::Component);
use Plack::Util::Accessor qw(schema);
use Text::Markdown::Hoedown qw(markdown);
use Text::MicroTemplate qw(encoded_string);
use Text::MicroTemplate::DataSection qw(render_mt);
use Encode qw(encode_utf8);

use APISchema::Generator::Markdown;

sub call {
    my ($self, $env) = @_;

    my $generator = APISchema::Generator::Markdown->new;
    my $markdown = $generator->format_schema($self->schema);

    my $body = markdown(
        $markdown,
        extensions => int(
            0
                | Text::Markdown::Hoedown::HOEDOWN_EXT_TABLES

lib/Plack/App/APISchema/MockServer.pm  view on Meta::CPAN

use Plack::Util::Accessor qw(schema);
use Plack::Request;
use Encode qw(encode_utf8);

use APISchema::JSON;

use APISchema::Generator::Router::Simple;
use APISchema::Generator::Markdown::ResourceResolver;
use APISchema::Generator::Markdown::ExampleFormatter;

sub call {
    my ($self, $env) = @_;

    my $req = Plack::Request->new($env);

    my ($matched, $router_simple_route) = $self->router->routematch($env);

    unless ($matched) {
        return [404, ['Content-Type' => 'text/plain; charset=utf-8'], ['not found']];
    }

lib/Plack/App/APISchema/MockServer.pm  view on Meta::CPAN

    my $formatter = APISchema::Generator::Markdown::ExampleFormatter->new(
        resolver => $resolver,
        spec     => $response_resource,
    );

    # TODO: serve all headers defined in example
    # TODO: format body with encoding
    return [$default_code, ['Content-Type' => 'application/json; charset=utf-8'], [encode_utf8($formatter->body)]];
}

sub router {
    my ($self) = @_;

    return $self->{router} if $self->{router};

    my $generator = APISchema::Generator::Router::Simple->new;
    $self->{router} = $generator->generate_router($self->schema);
}

1;
__END__

lib/Plack/Middleware/APISchema/RequestValidator.pm  view on Meta::CPAN

use parent qw(Plack::Middleware);
use HTTP::Status qw(:constants);
use Plack::Util::Accessor qw(schema validator);
use Plack::Request;
use APISchema::Generator::Router::Simple;
use APISchema::Validator;
use APISchema::JSON;

use constant DEFAULT_VALIDATOR_CLASS => 'Valiemon';

sub call {
    my ($self, $env) = @_;
    my $req = Plack::Request->new($env);

    my ($matched, $route) = $self->router->routematch($env);
    $matched or return $self->app->($env);

    my $validator = APISchema::Validator->for_request(
        validator_class => $self->validator // DEFAULT_VALIDATOR_CLASS,
    );
    my $result = $validator->validate($route->name => {

lib/Plack/Middleware/APISchema/RequestValidator.pm  view on Meta::CPAN

    my $status_code = $self->_resolve_status_code($result);
    return [
        $status_code,
        [ 'Content-Type' => 'application/json' ],
        [ encode_json_canonical($errors) ],
    ] if scalar keys %$errors;

    $self->app->($env);
}

sub router {
    my ($self) = @_;

    $self->{router} //= do {
        my $generator = APISchema::Generator::Router::Simple->new;
        $generator->generate_router($self->schema);
    };
}

sub _resolve_status_code {
    my ($self, $validation_result) = @_;
    my $error_message = $validation_result->errors->{body}->{message} // '';
    return $error_message =~ m/Wrong content-type/ ? HTTP_UNSUPPORTED_MEDIA_TYPE : HTTP_UNPROCESSABLE_ENTITY;
}


1;

lib/Plack/Middleware/APISchema/ResponseValidator.pm  view on Meta::CPAN

use parent qw(Plack::Middleware);
use Plack::Util ();
use Plack::Util::Accessor qw(schema validator);
use Plack::Response;
use APISchema::Generator::Router::Simple;
use APISchema::Validator;
use APISchema::JSON;

use constant DEFAULT_VALIDATOR_CLASS => 'Valiemon';

sub call {
    my ($self, $env) = @_;

    Plack::Util::response_cb($self->app->($env), sub {
        my $res = shift;

        my ($matched, $route) = $self->router->routematch($env);
        $matched or return;

        my $plack_res = Plack::Response->new(@$res);
        my $body;
        Plack::Util::foreach($res->[2] // [], sub { $body .= $_[0] });

        my $validator_class = $self->validator // DEFAULT_VALIDATOR_CLASS;
        my $validator = APISchema::Validator->for_response(
            validator_class => $validator_class,
        );
        my $result = $validator->validate($route->name => {
            status_code => $res->[0],
            header => +{ map {
                my $field = lc($_) =~ s/[-]/_/gr;
                ( $field => $plack_res->header($_) );

lib/Plack/Middleware/APISchema/ResponseValidator.pm  view on Meta::CPAN

                [ 'Content-Type' => 'application/json', 'X-Error-Cause' => $error_cause ],
                [ encode_json_canonical($errors) ],
            );
            return;
        }

        $res->[2] = [ $body ];
    });
}

sub router {
    my ($self) = @_;

    $self->{router} //= do {
        my $generator = APISchema::Generator::Router::Simple->new;
        $generator->generate_router($self->schema);
    };
}


1;

script/generate_markdown_document.pl  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;
use Encode qw(encode_utf8);

BEGIN {
    # cpan
    use Path::Class qw(file);
    my $Root = file(__FILE__)->dir->parent->resolve->absolute;
    unshift @INC, $Root->subdir('lib').q();
}

# lib
use APISchema::DSL;
use APISchema::Generator::Markdown;

unless ($ARGV[0]) {
    print <<EOM;
Usage: $0 <file>
Options:

t/APISchema-DSL.t  view on Meta::CPAN

package t::APISchema::Generator::Router::Simple;
use lib '.';
use t::test;
use Encode qw(decode_utf8);

sub _require : Test(startup => 1) {
    my ($self) = @_;

    BEGIN{ use_ok 'APISchema::DSL'; }
}

sub no_global : Tests {
    dies_ok {
        filter {};
    };

    dies_ok {
        title 'test';
    };

    dies_ok {
        description 'test';

t/APISchema-DSL.t  view on Meta::CPAN

    dies_ok {
        GET '/' => ();
    };

    dies_ok {
        POST '/' => ();
    };

}

sub process : Tests {
    lives_ok {
        my $schema = APISchema::DSL::process {};
        isa_ok $schema, 'APISchema::Schema';
    };

    dies_ok {
        GET '/' => ();
    };

    subtest 'title, description' => sub {
        lives_ok {
            my $schema = APISchema::DSL::process {
                title 'BMI API';
                description 'The API to calculate BMI';
            };
            isa_ok $schema, 'APISchema::Schema';
            is $schema->title, 'BMI API';
            is $schema->description, 'The API to calculate BMI';
        };
    };

    subtest 'Simple GET' => sub {
        lives_ok {
            my $schema = APISchema::DSL::process {
                GET '/' => {
                    title       => 'Simple GET',
                    destination => { some => 'property' },
                };
            };
            isa_ok $schema, 'APISchema::Schema';

            my $routes = $schema->get_routes;
            is scalar @$routes, 1;

            is $routes->[0]->route, '/';
            is $routes->[0]->title, 'Simple GET';
            is_deeply $routes->[0]->destination, { some => 'property' };
        };
    };

    subtest 'Support PATCH' => sub {
        lives_ok {
            my $schema = APISchema::DSL::process {
                PATCH '/my' => {
                    title       => 'Update My BMI',
                    destination => {
                        controller => 'BMI',
                        action     => 'update',
                    },
                };
            };

t/APISchema-DSL.t  view on Meta::CPAN

            is $routes->[0]->route, '/my';
            is $routes->[0]->title, 'Update My BMI';
            is $routes->[0]->method, 'PATCH';
            is_deeply $routes->[0]->destination, {
                controller => 'BMI',
                action     => 'update',
            };
        };
    };

    subtest 'Validation should be returned' => sub {
        lives_ok {
            my $schema = APISchema::DSL::process {
                title 'BMI API';
                description 'The API to calculate BMI';

                resource figure => {
                    type => 'object',
                    description => 'Figure, which includes weight and height',
                    properties => {
                        weight  => {

t/APISchema-DSL.t  view on Meta::CPAN

                POST '/bmi' => {
                    title           => 'BMI API',
                    description     => 'This API calculates your BMI.',
                    destination     => {
                        controller  => 'BMI',
                        action      => 'calculate',
                    },
                    request         => 'figure',
                    response        => 'bmi',
                }, {
                    on_match => sub { 1 },
                };
            };
            isa_ok $schema, 'APISchema::Schema';

            is_deeply [ sort {
                $a->title cmp $b->title;
            } @{$schema->get_resources} ], [ {
                title => 'bmi',
                definition => {
                    type => 'object',

t/APISchema-DSL.t  view on Meta::CPAN

            my $routes = $schema->get_routes;
            is scalar @$routes, 1;

            is $routes->[0]->route, '/bmi';
            is $routes->[0]->title, 'BMI API';
            is $routes->[0]->description, 'This API calculates your BMI.';
            is_deeply $routes->[0]->destination, {
                controller => 'BMI',
                action     => 'calculate',
            };
            cmp_deeply $routes->[0]->option, { on_match => code(sub { 1 }) };
            is $routes->[0]->request_resource, 'figure';
            is $routes->[0]->response_resource, 'bmi';
        };
    };
}

sub from_file : Tests {
    lives_ok {
        my $schema = APISchema::DSL::process {
            include 't/fixtures/bmi.def';
        };

        isa_ok $schema, 'APISchema::Schema';

        is $schema->title, 'BMI API';
        is $schema->description, 'The API to calculate BMI';

t/APISchema-DSL.t  view on Meta::CPAN

        my $routes = $schema->get_routes;
        is scalar @$routes, 1;

        is $routes->[0]->route, '/bmi';
        is $routes->[0]->title, 'BMI API';
        is $routes->[0]->description, 'This API calculates your BMI.';
        is_deeply $routes->[0]->destination, {
            controller => 'BMI',
            action     => 'calculate',
        };
        cmp_deeply $routes->[0]->option, { on_match => code(sub { 1 }) };
        is $routes->[0]->request_resource, 'figure';
        is $routes->[0]->response_resource, 'bmi';
    };

    dies_ok {
        my $schema = APISchema::DSL::process {
            include 'not-such-file';
        };
    };

t/APISchema-DSL.t  view on Meta::CPAN

        };
    };

    dies_ok {
        my $schema = APISchema::DSL::process {
            include 't/fixtures/runtime-error.def';
        };
    };
}

sub with_unicode : Tests {
    my $schema = APISchema::DSL::process {
        include 't/fixtures/user.def';
    };

    isa_ok $schema, 'APISchema::Schema';

    is $schema->title, decode_utf8('ユーザー');
    is $schema->description, decode_utf8('ユーザーの定義');

    cmp_deeply $schema->get_resource_by_name('user')->{definition}, {

t/APISchema-Generator-Markdown-Formatter.t  view on Meta::CPAN

package t::APISchema::Generator::Markdown::Formatter;
use lib '.';
use t::test;
use t::test::fixtures;

use APISchema::Generator::Markdown::Formatter ();

sub _type : Tests {
    for my $case (
        [{} => 'undefined'],
        [{type => 'object'} => '`object`'],
        [{type => ['object', 'number']} =>  '`"object"`&#124;`"number"`'],
        [{'$ref' => '#/resource/foo'} =>  '[`foo`](#resource-foo)'],
        [{oneOf => [{ type =>'object'}, {type =>'number'}]} =>  '`object`&#124;`number`'],
        [{type => 'string', enum => ['a', 'b', 'c']} =>  '`"a"`&#124;`"b"`&#124;`"c"`'],
        [{type => 'number', enum => [1, 2, 3]} =>  '`1`&#124;`2`&#124;`3`'],
    ) {
       is APISchema::Generator::Markdown::Formatter::type($case->[0]), $case->[1], $case->[2] || $case->[1];

t/APISchema-Generator-Markdown.t  view on Meta::CPAN

package t::APISchema::Generator::Markdown;
use lib '.';
use t::test;
use t::test::fixtures;
use utf8;

use APISchema::DSL;

sub _require : Test(startup => 1) {
    my ($self) = @_;

    use_ok 'APISchema::Generator::Markdown';
}

sub instantiate : Tests {
    my $generator = APISchema::Generator::Markdown->new;
    isa_ok $generator, 'APISchema::Generator::Markdown';
}

sub generate : Tests {
    subtest 'Simple' => sub {
        my $schema = t::test::fixtures::prepare_bmi;

        my $generator = APISchema::Generator::Markdown->new;
        my $markdown = $generator->format_schema($schema);

        like $markdown, qr{# BMI API};
        like $markdown, qr{^\Q    - [BMI API](#route-BMI%20API) - `POST` /bmi\E$}m;
        like $markdown, qr!{"height":1.6,"weight":50}!;
        like $markdown, qr!|`.` |`object` | | |`required["value"]` |Body mass index |!;
        like $markdown, qr!|`.height` |`number` | |`1.6` | |Height(m) |!;
    };

    subtest 'Complex' => sub {
        my $schema = t::test::fixtures::prepare_family;

        my $generator = APISchema::Generator::Markdown->new;
        my $markdown = $generator->format_schema($schema);

        like $markdown, qr{# Family API};
        like $markdown, qr!GET /person[?]name=Alice!;
        like $markdown, qr!{"message":"OK","status":"success"}!;
        like $markdown, qr![{"age":16,"name":"Alice"},{"age":14,"name":"Charlie"}]!;
        my $text1 = <<EOS;

t/APISchema-Generator-Markdown.t  view on Meta::CPAN

EOS
        like $markdown, qr!\Q$text1\E!;
        like $markdown, qr!|`.\[\]` |[`person`](#resource-person) | | | | |!;
        my $text2 = <<EOS;
200 OK
[{"age":16,"name":"Alice"},{"age":14,"name":"Charlie"}]
EOS
        like $markdown, qr!\Q$text2\E!;
    };

    subtest 'Status switch' => sub {
        my $schema = t::test::fixtures::prepare_status;

        my $generator = APISchema::Generator::Markdown->new;
        my $markdown = $generator->format_schema($schema);
        like $markdown, qr{#### Response `200 OK`};
        like $markdown, qr{\nHTTP/1.1 200 OK\nSucceeded!\n};
        like $markdown, qr{#### Response `400 Bad Request`};
    };

    subtest 'example with no containers' => sub {
        my $schema = APISchema::DSL::process {
          resource gender => {
            enum => ['male', 'female', 'other'],
            example => 'other',
          };
        };

        my $generator = APISchema::Generator::Markdown->new;
        my $markdown = $generator->format_schema($schema);

        like $markdown, qr/^"other"$/m;
    };

    subtest 'FETCH endpoint' => sub {
        my $schema = APISchema::DSL::process {
            FETCH '/' => {
                title => 'Fetch',
                destination => {},
            };
        };

        my $generator = APISchema::Generator::Markdown->new;
        my $markdown = $generator->format_schema($schema);

        like $markdown, qr{\Q- [Fetch](#route-Fetch) - `GET`, `HEAD` /\E}, 'FETCH expanded to GET and HEAD';
    };
}

sub generate_utf8 : Tests {
    subtest 'Simple' => sub {
        my $schema = t::test::fixtures::prepare_user;

        my $generator = APISchema::Generator::Markdown->new;
        my $markdown = $generator->format_schema($schema);

        like $markdown, qr!{\n   "first_name" : "小飼",\n   "last_name" : "弾"\n}!;
        like $markdown, qr!\Q|`.last_name` |`string` | |`"弾"` | |名 |\E!;
    };
}

sub boolean : Tests {
    my $schema = t::test::fixtures::prepare_boolean;

    my $generator = APISchema::Generator::Markdown->new;
    my $markdown = $generator->format_schema($schema);

    like $markdown, qr!\btrue\b!;
}

sub example_null : Tests {
    my $schema = t::test::fixtures::prepare_example_null;

    my $generator = APISchema::Generator::Markdown->new;
    my $markdown = $generator->format_schema($schema);

    like $markdown, qr!"value" : null!;
    like $markdown, qr!\Q|`.value` |`null` | |`null` | |The Value |\E!;
}

t/APISchema-Generator-Router-Simple.t  view on Meta::CPAN

package t::APISchema::Generator::Router::Simple;
use lib '.';
use t::test;
use t::test::fixtures;
use APISchema::Schema;
use Router::Simple;

sub _require : Test(startup => 1) {
    my ($self) = @_;

    use_ok 'APISchema::Generator::Router::Simple';
}

sub instantiate : Tests {
    my $generator = APISchema::Generator::Router::Simple->new;
    isa_ok $generator, 'APISchema::Generator::Router::Simple';
}

sub generate : Tests {
    my $schema = t::test::fixtures::prepare_bmi;

    my $generator = APISchema::Generator::Router::Simple->new;
    my $router = $generator->generate_router($schema);

    isa_ok $router, 'Router::Simple';

    cmp_deeply $router->match({ PATH_INFO => '/bmi', HTTP_HOST => 'localhost', REQUEST_METHOD => 'POST' } ), {
        controller      => 'BMI',
        action          => 'calculate',
    };

    note $router->as_string;
}

sub inject_routes : Tests {
    my $schema = t::test::fixtures::prepare_bmi;

    my $router = Router::Simple->new;
    $router->connect('/', {controller => 'Root', action => 'show'});

    my $generator = APISchema::Generator::Router::Simple->new;
    my $returned_router = $generator->inject_routes($schema => $router);

    is $returned_router, $router;

t/APISchema-Generator-Router-Simple.t  view on Meta::CPAN

        controller      => 'BMI',
        action          => 'calculate',
    };

    cmp_deeply $router->match({ PATH_INFO => '/', HTTP_HOST => 'localhost', REQUEST_METHOD => 'GETPOST' } ), {
        controller      => 'Root',
        action          => 'show',
    };
}

sub generate_custom_router : Tests {
    my $generator = APISchema::Generator::Router::Simple->new(
        router_class => 'Test::Router::Simple',
    );
    my $schema = APISchema::Schema->new;
    my $router = $generator->generate_router($schema);
    isa_ok $router, 'Test::Router::Simple';
}

package Test::Router::Simple;
use parent qw(Router::Simple);

t/APISchema-JSON.t  view on Meta::CPAN

package t::APISchema::JSON;
use lib '.';
use t::test;

sub _require : Test(startup => 1) {
    my ($self) = @_;

    BEGIN{ use_ok 'APISchema::JSON'; }
}

sub _encode_json_canonical : Tests {
    is APISchema::JSON::encode_json_canonical({b => 2, c => 3, a => 1}), '{"a":1,"b":2,"c":3}', 'keys are sorted';
    is APISchema::JSON::encode_json_canonical({nested => {b => 2, c => 3, a => 1}}), '{"nested":{"a":1,"b":2,"c":3}}', 'nested keys are sorted';
}

t/APISchema-Resource.t  view on Meta::CPAN

package t::APISchema::Resource;
use lib '.';
use t::test;

sub _require : Test(startup => 1) {
    my ($self) = @_;

    use_ok 'APISchema::Resource';
}

sub instantiate : Tests {
    my $resource = APISchema::Resource->new(
        title => 'Human',
        definition => {
            type => 'object',
            properties => {
                name  => { type => 'string'  },
                age => { type => 'integer' },
            },
            required => ['name', 'age'],
        },

t/APISchema-Route.t  view on Meta::CPAN

package t::APISchema::Route;
use lib '.';
use t::test;

sub _require : Test(startup => 1) {
    my ($self) = @_;

    use_ok 'APISchema::Route';
}

sub instantiate : Tests {
    my $route = APISchema::Route->new(
        route             => '/bmi/',
        title             => 'BMI API',
        description       => 'This API calculates your BMI.',
        destination       => {
            controller    => 'BMI',
            action        => 'calculate',
        },
        method            => 'POST',
        request_resource  => 'health',

t/APISchema-Route.t  view on Meta::CPAN

        destination       => {
            controller    => 'BMI',
            action        => 'calculate',
        },
        method            => 'POST',
        request_resource  => 'health',
        response_resource => 'bmi',
    );
}

sub responsible_codes : Tests {
    subtest 'when simple response resource' => sub {
        my $route = APISchema::Route->new(
            route             => '/bmi/',
            title             => 'BMI API',
            description       => 'This API calculates your BMI.',
            destination       => {
                controller    => 'BMI',
                action        => 'calculate',
            },
            method            => 'POST',
            request_resource  => 'health',
            response_resource => 'bmi',
        );
        cmp_deeply $route->responsible_codes, [200];
        is $route->default_responsible_code, 200;
        ok ! $route->responsible_code_is_specified;
    };

    subtest 'when multiple response codes are specified' => sub {
        my $route = APISchema::Route->new(
            route             => '/bmi/',
            title             => 'BMI API',
            description       => 'This API calculates your BMI.',
            destination       => {
                controller    => 'BMI',
                action        => 'calculate',
            },
            method            => 'POST',
            request_resource  => 'health',

t/APISchema-Schema.t  view on Meta::CPAN

package t::APISchema::Schema;
use lib '.';
use t::test;

sub _require : Test(startup => 1) {
    my ($self) = @_;

    use_ok 'APISchema::Schema';
}

sub instantiate : Tests {
    my $schema = APISchema::Schema->new;
    isa_ok $schema, 'APISchema::Schema';
}

sub resource : Tests {
    my $schema = APISchema::Schema->new;

    is $schema->get_resource_by_name('user'), undef;

    cmp_deeply $schema->get_resources, [];

    $schema->register_resource('user' => {
        type => 'object',
        properties => {
            name  => { type => 'string'  },

t/APISchema-Schema.t  view on Meta::CPAN

        },
    );

    is $schema->get_resource_by_name('not_user'), undef;

    cmp_deeply $schema->get_resources, [
        $schema->get_resource_by_name('user'),
    ];
}

sub route : Tests {
    subtest 'Basic' => sub {
        my $schema = APISchema::Schema->new;
        cmp_deeply $schema->get_routes, [];

        $schema->register_route(
            route             => '/bmi/',
            description       => 'This API calculates your BMI.',
            destination       => {
                controller    => 'BMI',
                action        => 'calculate',
            },

t/APISchema-Schema.t  view on Meta::CPAN

                    controller    => 'BMI',
                    action        => 'calculate',
                },
                method            => 'POST',
                request_resource  => 'health',
                response_resource => 'bmi',
            ),
        ];
    };

    subtest 'Naming' => sub {
        my $schema = APISchema::Schema->new;
        cmp_deeply $schema->get_routes, [];

        $schema->register_route(
            title => 'BMI API',
            route => '/bmi/',
        );
        is $schema->get_routes->[0]->title, 'BMI API';

        $schema->register_route(

t/APISchema-Schema.t  view on Meta::CPAN

        is $schema->get_routes->[6]->title, '/bmi/(2)';

        $schema->register_route();
        is $schema->get_routes->[7]->title, 'empty_route(1)';

        $schema->register_route();
        is $schema->get_routes->[8]->title, 'empty_route(2)';
    };
}

sub title_description : Tests {
    my $schema = APISchema::Schema->new;
    is $schema->title, undef;
    is $schema->description, undef;

    $schema->title('BMI');
    is $schema->title, 'BMI';

    $schema->description('The API to calculate BMI');
    is $schema->description, 'The API to calculate BMI';
}

t/APISchema-Validator.t  view on Meta::CPAN

package t::Plack::Middleware::APISchema::ResponseValidator;
use lib '.';
use t::test;
use t::test::fixtures;
use JSON::XS qw(encode_json);

sub _require : Test(startup => 1) {
    use_ok 'APISchema::Validator';
}

sub instantiate : Tests {
    subtest 'For request' => sub {
        my $validator = APISchema::Validator->for_request;
        isa_ok $validator, 'APISchema::Validator';
        is $validator->validator_class, 'Valiemon';
        is $validator->fetch_resource_method, 'canonical_request_resource';
    };

    subtest 'For response' => sub {
        my $validator = APISchema::Validator->for_response;
        isa_ok $validator, 'APISchema::Validator';
        is $validator->validator_class, 'Valiemon';
        is $validator->fetch_resource_method, 'canonical_response_resource';
    };

    subtest 'Result' => sub {
        my $r = APISchema::Validator::Result->new;
        isa_ok $r, 'APISchema::Validator::Result';

        my $valid = APISchema::Validator::Result->new_valid;
        isa_ok $valid, 'APISchema::Validator::Result';

        my $error = APISchema::Validator::Result->new_valid;
        isa_ok $error, 'APISchema::Validator::Result';
    };
}

sub result : Tests {
    subtest 'empty' => sub {
        my $r = APISchema::Validator::Result->new;
        ok $r->is_valid;
        is_deeply $r->errors, {};
    };

    subtest 'valid without target' => sub {
        my $r = APISchema::Validator::Result->new_valid;
        ok $r->is_valid;
        is_deeply $r->errors, {};
    };

    subtest 'valid with targets' => sub {
        my $r = APISchema::Validator::Result->new_valid(qw(foo));
        ok $r->is_valid;
        is_deeply $r->errors, {};
    };

    subtest 'error without target' => sub {
        my $r = APISchema::Validator::Result->new_error;
        ok !$r->is_valid;
    };

    subtest 'error without target' => sub {
        my $r = APISchema::Validator::Result->new_error(foo => 'bar');
        ok !$r->is_valid;
        is_deeply $r->errors, { foo => 'bar' };
    };

    subtest 'merge' => sub {
        my $r = APISchema::Validator::Result->new;

        $r->merge(APISchema::Validator::Result->new_valid());
        ok $r->is_valid;
        is_deeply $r->errors, {};

        $r->merge(APISchema::Validator::Result->new_valid(qw(foo)));
        ok $r->is_valid;
        is_deeply $r->errors, {};

        $r->merge(APISchema::Validator::Result->new_error(bar => 1));
        ok !$r->is_valid;
        is_deeply $r->errors, { bar => 1 };

        $r->merge(APISchema::Validator::Result->new_error(foo => 3));
        ok !$r->is_valid;
        is_deeply $r->errors, { foo => 3, bar => 1 };
    };
}

sub _simple_route ($$) {
    my ($schema, $keys)  =  @_;
    $keys = [qw(header parameter body)] unless defined $keys;
    $schema->register_route(
        route => '/endpoint',
        request_resource => {
            map { $_ => 'figure' } @$keys
        },
        response_resource => {
            map { $_ => 'bmi' } @$keys
        },
    );
    return $schema;
}

sub _forced_route ($$) {
    my ($schema, $keys)  =  @_;
    $keys = [qw(header parameter body)] unless defined $keys;
    $schema->register_route(
        route => '/endpoint',
        request_resource => {
            encoding => 'json',
            map { $_ => 'figure' } @$keys
        },
        response_resource => {
            encoding => 'json',
            map { $_ => 'bmi' } @$keys
        },
    );
    return $schema;
}

sub _invalid_encoding_route ($$) {
    my ($schema, $keys)  =  @_;
    $keys = [qw(header parameter body)] unless defined $keys;
    $schema->register_route(
        route => '/endpoint',
        request_resource => {
            encoding => 'hoge',
            map { $_ => 'figure' } @$keys
        },
        response_resource => {
            encoding => 'hoge',
            map { $_ => 'bmi' } @$keys
        },
    );
    return $schema;
}

sub _strict_route ($$) {
    my ($schema, $keys)  =  @_;
    $keys = [qw(header parameter body)] unless defined $keys;
    $schema->register_route(
        route => '/endpoint',
        request_resource => {
            encoding => { 'application/json' => 'json' },
            map { $_ => 'figure' } @$keys
        },
        response_resource => {
            encoding => { 'application/json' => 'json' },
            map { $_ => 'bmi' } @$keys
        },
    );
    return $schema;
}

sub validate_request : Tests {
    subtest 'valid with emtpy schema' => sub {
        my $schema = APISchema::Schema->new;
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            header => { foo => 'bar' },
            parameter => 'foo&bar',
            body => '{"foo":"bar"}',
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'valid with empty target' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, [];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {}, $schema);
        ok $result->is_valid;
    };

    subtest 'valid with some target and schema' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({weight => 50, height => 1.6}),
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid with missing property' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({weight => 50}),
            content_type => 'application/json',
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'body' ];
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') ];
        is_deeply [ map { $_->{encoding} } values %{$result->errors} ],
            [ ('json') ];
    };

    subtest 'invalid without body' => sub {
        for my $value ({}, '', undef) {
            my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body'];
            my $validator = APISchema::Validator->for_request;
            my $result = $validator->validate('/endpoint' => {
                body => $value,
            }, $schema);
            ok ! $result->is_valid;
            is_deeply [ keys %{$result->errors} ], [ 'body' ];
        }
    };

    subtest 'invalid without parameter' => sub {
        for my $value ({}, '', undef) {
            my $schema = _simple_route t::test::fixtures::prepare_bmi, ['parameter'];
            my $validator = APISchema::Validator->for_request;
            my $result = $validator->validate('/endpoint' => {
                parameter => $value,
            }, $schema);
            ok ! $result->is_valid;
            is_deeply [ keys %{$result->errors} ], [ 'parameter' ];
        }
    };


    subtest 'invalid with wrong encoding' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({weight => 50, height => 1.6}),
            content_type => 'application/x-www-form-urlencoded',
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'body' ];
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') ];
        is_deeply [ map { $_->{encoding} } values %{$result->errors} ],
            [ ('url_parameter') ];
    };

    subtest 'invalid with invalid encoding' => sub {
        my $schema = _invalid_encoding_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({weight => 50, height => 1.6}),
            content_type => 'application/json',
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'body' ];
        is_deeply [ map { $_->{message} } values %{$result->errors} ],
            [ ('Unknown decoding method: hoge') ];
    };

    subtest 'valid with forced encoding' => sub {
        my $schema = _forced_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({weight => 50, height => 1.6}),
            content_type => 'application/x-www-form-urlencoded',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'valid with strict content-type check' => sub {
        my $schema = _strict_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({weight => 50, height => 1.6}),
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid with wrong content type' => sub {
        my $schema = _strict_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $content_type = 'application/x-www-form-urlencoded';
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({weight => 50, height => 1.6}),
            content_type => $content_type,
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'body' ];
        is_deeply [ map { $_->{message} } values %{$result->errors} ],
            [ ("Wrong content-type: $content_type") ];
    };

    subtest 'valid parameter' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['parameter'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            parameter => 'weight=50&height=1.6',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid parameter' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['parameter'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            parameter => 'weight=50',
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') ];
        is_deeply [ map { $_->{encoding} } values %{$result->errors} ],
            [ ('url_parameter') ];
    };

    subtest 'valid header' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['header'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            header => { weight => 50, height => 1.6 },
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid header' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['header'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            header => { weight => 50 },
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'header' ];
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') ];
        is_deeply [ map { $_->{encoding} } values %{$result->errors} ],
            [ ('perl') ];
    };

    subtest 'all valid' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body', 'parameter', 'header'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            header => { weight => 50, height => 1.6 },
            parameter => 'weight=50&height=1.6',
            body => encode_json({weight => 50, height => 1.6}),
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'many invalid' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body', 'parameter', 'header'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('/endpoint' => {
            header => { weight => 50 },
            parameter => 'weight=50',
            body => encode_json({weight => 50}),
            content_type => 'application/json',
        }, $schema);
        ok !$result->is_valid;
        is scalar keys %{$result->errors}, 3;
        is_deeply [ sort keys %{$result->errors} ],
            [ qw(body header parameter) ];
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') x 3 ];
        is_deeply [ sort map { $_->{encoding} } values %{$result->errors} ],
            [ ('json', 'perl', 'url_parameter') ];
    };
}

sub validate_response : Tests {
    subtest 'valid with emtpy schema' => sub {
        my $schema = APISchema::Schema->new;
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            header => { foo => 'bar' },
            body => '{"foo":"bar"}',
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'valid with empty target' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, [];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {}, $schema);
        ok $result->is_valid;
    };

    subtest 'valid with some target and schema' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({value => 19.5}),
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid with missing property' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({hoge => 'foo'}),
            content_type => 'application/json',
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'body' ];
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') ];
        is_deeply [ map { $_->{encoding} } values %{$result->errors} ],
            [ ('json') ];
    };

    subtest 'invalid with wrong encoding' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({value => 19.5}),
            content_type => 'application/x-www-form-urlencoded',
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'body' ];
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') ];
        is_deeply [ map { $_->{encoding} } values %{$result->errors} ],
            [ ('url_parameter') ];
    };

    subtest 'invalid with invalid encoding' => sub {
        my $schema = _invalid_encoding_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({value => 19.5}),
            content_type => 'application/json',
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'body' ];
        is_deeply [ map { $_->{message} } values %{$result->errors} ],
            [ ('Unknown decoding method: hoge') ];
    };

    subtest 'valid with forced encoding' => sub {
        my $schema = _forced_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({value => 19.5}),
            content_type => 'application/x-www-form-urlencoded',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'valid with strict content-type check' => sub {
        my $schema = _strict_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({value => 19.5}),
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid with wrong content type' => sub {
        my $schema = _strict_route t::test::fixtures::prepare_bmi, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $content_type = 'application/x-www-form-urlencoded';
        my $result = $validator->validate('/endpoint' => {
            body => encode_json({value => 19.5}),
            content_type => $content_type,
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'body' ];
        is_deeply [ map { $_->{message} } values %{$result->errors} ],
            [ ("Wrong content-type: $content_type") ];
    };

    subtest 'valid header' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['header'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            header => { value => 19.5 },
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid header' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['header'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            header => {},
        }, $schema);
        ok !$result->is_valid;
        is_deeply [ keys %{$result->errors} ], [ 'header' ];
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') ];
        is_deeply [ map { $_->{encoding} } values %{$result->errors} ],
            [ ('perl') ];
    };

    subtest 'all valid' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body', 'header'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            header => { value => 19.5 },
            body => encode_json({value => 19.5}),
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'many invalid' => sub {
        my $schema = _simple_route t::test::fixtures::prepare_bmi, ['body', 'header'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('/endpoint' => {
            header => {},
            body => encode_json({}),
            content_type => 'application/json',
        }, $schema);
        ok !$result->is_valid;
        is scalar keys %{$result->errors}, 2;
        is_deeply [ sort keys %{$result->errors} ],
            [ qw(body header) ];
        is_deeply [ map { $_->{attribute} } values %{$result->errors} ],
            [ ('Valiemon::Attributes::Required') x 2 ];
        is_deeply [ sort map { $_->{encoding} } values %{$result->errors} ],
            [ ('json', 'perl') ];
    };

    subtest 'valid referenced resource' => sub {
        my $schema = _forced_route t::test::fixtures::prepare_family, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('Children GET API' => {
            body => encode_json([ {
                name => 'Alice',
                age  => 16,
            }, {
                name => 'Charlie',
                age  => 14,
            } ]),
            content_type => 'application/json',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid referenced resource' => sub {
        my $schema = _forced_route t::test::fixtures::prepare_family, ['body'];
        my $validator = APISchema::Validator->for_response;
        my $result = $validator->validate('Children GET API' => {
            body => encode_json([ {
                name => 'Alice',
                age  => 16,
            }, {
                age  => 14,
            } ]),
            content_type => 'application/json',
        }, $schema);
        ok !$result->is_valid;
    };

 SKIP: {
    skip 'Recursive dereference is not implemented in Valiemon', 2;
    subtest 'valid recursively referenced resource' => sub {
        my $schema = _forced_route t::test::fixtures::prepare_family, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('Children GET API' => {
            parameter => 'name=Bob',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'invalid recursively referenced resource' => sub {
        my $schema = _forced_route t::test::fixtures::prepare_family, ['body'];
        my $validator = APISchema::Validator->for_request;
        my $result = $validator->validate('Children GET API' => {
            parameter => 'person=Bob',
        }, $schema);
        ok !$result->is_valid;
    };

    };
}

sub status : Tests {
    my $schema = t::test::fixtures::prepare_status;
    my $validator = APISchema::Validator->for_response;

    subtest 'Status 200 with valid body' => sub {
        my $result = $validator->validate('Get API' => {
            status_code => 200,
            body => '200 OK',
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'Status 200 with invalid body' => sub {
        my $result = $validator->validate('Get API' => {
            status_code => 200,
            body => { status => 200, message => 'OK' },
        }, $schema);
        ok !$result->is_valid;
    };

    subtest 'Status 400 with valid body' => sub {
        my $result = $validator->validate('Get API' => {
            status_code => 400,
            body => encode_json({ status => 400, message => 'Bad Request' }),
        }, $schema);
        ok $result->is_valid;
    };

    subtest 'Status 400 with invalid body' => sub {
        my $result = $validator->validate('Get API' => {
            status_code => 400,
            body => '400 Bad Request',
        }, $schema);
        ok !$result->is_valid;
    };

    subtest 'Undefined status' => sub {
        my $result = $validator->validate('Get API' => {
            status_code => 599,
            body => { foo => 'bar' },
        }, $schema);
        ok $result->is_valid;
    };
}

t/APISchema.t  view on Meta::CPAN

package t::APISchema;
use lib '.';
use t::test;

sub _require : Test(startup => 1) {
    my ($self) = @_;

    use_ok 'APISchema';
}

sub version : Tests {
    cmp_ok $APISchema::VERSION, '>', 0, 'has positive version';
}



( run in 1.978 second using v1.01-cache-2.11-cpan-88abd93f124 )