view release on metacpan or  search on metacpan

lib/Mojolicious/Plugin/InputValidation.pm  view on Meta::CPAN

}

package IV_BOOL;
use base 'IV_ANY';
sub new { my $class = shift; bless {@_}, $class }
sub accepts {
    my ($self, $value, $path) = @_;
    return 1 if ($self->nillable and not defined $value)
             or ($self->empty and defined $value and !ref $value and $value eq '')
             or (ref($value) =~ /^JSON::PP::Boolean$/);

    my $val = ref $value || $value;
    $self->error("Value '$val' is not a boolean at path " . ($path || '/'));
    return 0;
}

package IV_ARRAY;
use base 'IV_ANY';
sub new {
    my $class     = shift;
    my $options   = {};

    while (@_) {
        my $elem = shift;
        if (ref $elem eq 'ARRAY') {
            $options->{pattern} = $elem;
        }
        else {
            $options->{$elem} = shift;
        }
    }

    bless $options, $class
}
sub accepts {
    my ($self, $value, $path) = @_;

    return 1 if $self->nillable and not defined $value;

    unless (ref $value eq 'ARRAY') {
        $self->error("Array expected at path " . ($path || '/'));
        return 0;
    }

    my $elems = scalar @$value;

    if (defined $self->{max} && $elems > $self->{max}) {
        $self->error(sprintf("Too many elements in array (%d vs %d) at path %s",
            $elems, $self->{max}, $path || '/'));
        return 0;
    }

    if (defined $self->{min} && $elems < $self->{min}) {
        $self->error(sprintf("Too few elements in array (%d vs %d) at path %s",
            $elems, $self->{min}, $path || '/'));
        return 0;
    }

    if ($self->{of}) {
        for (my $i = 0; $i < ($self->{max} // $elems); $i++) {
            my $err = Mojolicious::Plugin::InputValidation::_validate_structure($value->[$i], $self->{of}, "$path/$i");

            if ($err) {
                $self->error($err);
                return 0;
            }
        }
    }
    elsif ($self->{pattern} && !$self->{min} && !$self->{min}) {
        for (my $i = 0; $i < scalar @{$self->{pattern}}; $i++) {
            my $err = Mojolicious::Plugin::InputValidation::_validate_structure($value->[$i], $self->{pattern}[$i], "$path/$i");

            if ($err) {
                $self->error($err);
                return 0;
            }
        }
    }
    else {
        $self->error('Error: illegal pattern for array at path ' . ($path // '/'));
        return 0;
    }

    return 1;
}

package IV_OBJECT;
use base 'IV_ANY';
sub new {
    my $class     = shift;
    my $options   = {};

    while (@_) {
        my $elem = shift;
        if (ref $elem eq 'HASH') {
            $options->{pattern} = $elem;
        }
        else {
            $options->{$elem} = shift;
        }
    }

    bless $options, $class
}
sub accepts {
    my ($self, $value, $path) = @_;

    return 1 if $self->nillable and not defined $value;

    unless (ref $value eq 'HASH') {
        $self->error("Object expected at path " . ($path || '/'));
        return 0;
    }

    my @have_keys  = sort keys %$value;
    my @want_keys  = sort keys %{$self->{pattern}};
    my %want_keys  = map { $_ => 1 } @want_keys;
    my %have_keys  = map { $_ => 1 } @have_keys;
    my @unexpected = grep { !$want_keys{$_} } @have_keys;
    my @missing    = grep { !$have_keys{$_} && !$self->{pattern}{$_}->optional } @want_keys;

    if (@unexpected) {
        $self->error(sprintf("Unexpected keys '%s' found at path %s", join(',', @unexpected), $path || '/'));
        return 0;
    }

    if (@missing) {
        $self->error(sprintf("Missing keys '%s' at path %s", join(',', @missing), $path || '/'));
        return 0;
    }

    for my $key (grep { $have_keys{$_} } @want_keys) {
        my $err = Mojolicious::Plugin::InputValidation::_validate_structure($value->{$key}, $self->{pattern}{$key}, "$path/$key");

        if ($err) {
            $self->error($err);
            return 0;
        }
    }

    return 1;
}

package IV_DATETIME;
use base 'IV_ANY';
sub new { my $class = shift; bless {@_}, $class }
sub pattern {
    my $self         = shift;
    $self->{pattern} = shift if @_;
    $self->{pattern} || qr/^20\d\d-\d\d-\d\dT\d\d:\d\d:\d\d(\.\d\d\d)?(Z|[+-]\d\d\d\d)$/
}
sub accepts {
    my ($self, $value, $path) = @_;
    return 1 if ($self->nillable and not defined $value)
             or ($self->empty and defined $value and !ref $value and $value eq '')
             or ($value =~ $self->pattern);

    $self->error("Value '$value' does not match datetime format at path " . ($path || '/'));
    return 0;
}

package Mojolicious::Plugin::InputValidation;
use Mojo::Base 'Mojolicious::Plugin';
no strict 'subs';

our $VERSION = '0.10';

use Mojo::Util 'monkey_patch';

sub iv_datetime { IV_DATETIME->new(@_) }
sub iv_object   { IV_OBJECT->new(@_) }
sub iv_array    { IV_ARRAY->new(@_) }
sub iv_int      { IV_INT->new(@_) }
sub iv_float    { IV_FLOAT->new(@_) }
sub iv_bool     { IV_BOOL->new(@_) }
sub iv_word     { IV_WORD->new(@_) }
sub iv_any      { IV_ANY->new(@_) }

sub import {
    my $caller = caller;
    monkey_patch $caller, 'iv_datetime', \&iv_datetime;
    monkey_patch $caller, 'iv_object',   \&iv_object;
    monkey_patch $caller, 'iv_array',    \&iv_array;
    monkey_patch $caller, 'iv_int',      \&iv_int;
    monkey_patch $caller, 'iv_float',    \&iv_float;
    monkey_patch $caller, 'iv_bool',     \&iv_bool;
    monkey_patch $caller, 'iv_word',     \&iv_word;
    monkey_patch $caller, 'iv_any',      \&iv_any;
}

sub register {
    my ($self, $app, $conf) = @_;

    $app->helper(validate_json_request => sub {
        my ($c, $pattern) = @_;
        return _validate_structure($c->req->json, $pattern);
    });
    $app->helper(validate_params => sub {
        my ($c, $pattern) = @_;
        return _validate_structure($c->params, $pattern);
    });
    $app->helper(validate_structure => sub {
        my ($c, $structure, $pattern) = @_;
        return _validate_structure($structure, $pattern);
    });
}

sub _validate_structure {
    my ($input, $pattern, $path) = @_;

    if (ref $pattern eq 'HASH') {
        $pattern = iv_object($pattern);
    }
    elsif (ref $pattern eq 'ARRAY') {
        $pattern = iv_array($pattern);
    }

    return sprintf("Error: pattern '%s' must be of kind iv_*", $pattern)
        unless UNIVERSAL::isa($pattern, IV_ANY);

    return $pattern->error unless $pattern->accepts($input, $path // '');

    return '';
}

=encoding utf8

=head1 NAME

Mojolicious::Plugin::InputValidation - Validate incoming requests

=head1 SYNOPSIS

  use Mojolicious::Lite;
  plugin 'InputValidation';

  # This needs to be done where one wants to use the iv_* routines.
  use Mojolicious::Plugin::InputValidation;

  post '/books' => sub {
      my $c = shift;

      # Validate incoming requests against our data model.
      if (my $error = $c->validate_json_request({
          title    => iv_any,
          abstract => iv_any(optional => 1, empty => 1),
          author   => {
              firstname => iv_word,
              lastname  => iv_word,
          },
          published => iv_datetime,
          price     => iv_float,
          revision  => iv_int,
          isbn      => iv_any(pattern => qr/^[0-9\-]{10,13}$/),
          advertise => iv_bool,
      })) {
          return $c->render(status => 400, text => $error);
      }

      # Now the payload is safe to use.
      my $payload = $c->req->json;
      ...
  };

=head1 DESCRIPTION

L<Mojolicious::Plugin::InputValidation> compares structures against a pattern.
The pattern is usually a nested structure, so the compare methods search
recursively for the first non-matching value. If such a value is found a
speaking error message is returned, otherwise a false value.

=head1 METHODS

L<Mojolicious::Plugin::InputValidation> adds methods to the connection object
in a mojolicous controller. This way input validation becomes easy.

=head2 validate_json_request

  my $error = $c->validate_json_request($pattern);

This method try to match the json request payload ($c->req->json) against the
given pattern. If the payload matches, a false value is returned. If the payload
on the other hand does not match the pattern, the first non-matching value is
returned along with a speaking error message. The error message could look like:

  "Unexpected keys 'id,name' found at path /author"

=head1 TYPES

The pattern consists of one or more types the input is matched against.
The following types are available.

=over 4

=item iv_any

This is the base type for all other types. By default it matches defined values
only. It supports beeing optional, means that it is okay if this element is
missing entirely in the payload.
When this type is marked as nillable, it also accepts a null/undef value.
To accept an empty string, mark it as empty.
This type supports a regex pattern to match against. All options can be combined.

  {
      foo  => iv_any,
      bar  => iv_any(optional => 1, empty => 1),
      baz  => iv_any(nillable => 1),
      quux => iv_any(pattern => qr/^new|mint|used$/),
  }

=item iv_int

This type matches integers, literally digits with an optional leading dash.

  {
      foo => iv_int,
      bar => iv_int(optional => 1),
      baz => iv_int(nillable => 1),
  }

=item iv_float

This type matches floats, so digits divided by a single dot, with an optional
leading dash.

  {
      foo => iv_float,
      bar => iv_float(optional => 1),
      baz => iv_float(nillable => 1),
  }

=item iv_bool

This type matches booleans: true and false.

  {
      foo => iv_bool,
      bar => iv_bool(optional => 1),
      baz => iv_bool(nillable => 1),