xt/api.t

   1 # This file is part of Koha.
   2 #
   3 # Koha is free software; you can redistribute it and/or modify it under the
   4 # terms of the GNU General Public License as published by the Free Software
   5 # Foundation; either version 3 of the License, or (at your option) any later
   6 # version.
   7 #
   8 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
   9 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  10 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along
  13 # with Koha; if not, see <http://www.gnu.org/licenses>.
  14
  15 use Modern::Perl;
  16
  17 use Test::More tests => 3;
  18
  19 use Test::Mojo;
  20 use Data::Dumper;
  21
  22 use FindBin();
  23 use IPC::Cmd qw(can_run);
  24
  25 my $t    = Test::Mojo->new('Koha::REST::V1');
  26 my $spec = $t->get_ok( '/api/v1/', 'Correctly fetched the spec' )->tx->res->json;
  27
  28 my $paths = $spec->{paths};
  29
  30 my @missing_additionalProperties = ();
  31
  32 foreach my $route ( keys %{$paths} ) {
  33     foreach my $verb ( keys %{ $paths->{$route} } ) {
  34
  35         # p($paths->{$route}->{$verb});
  36
  37         # check parameters []
  38         foreach my $parameter ( @{ $paths->{$route}->{$verb}->{parameters} } ) {
  39             if (   exists $parameter->{schema}
  40                 && exists $parameter->{schema}->{type}
  41                 && ref( $parameter->{schema}->{type} ) ne 'ARRAY'
  42                 && $parameter->{schema}->{type} eq 'object' ) {
  43
  44                 # it is an object type definition
  45                 if ( $parameter->{name} ne 'query' # our query parameter is under-specified
  46                     and not exists $parameter->{schema}->{additionalProperties} ) {
  47                     push @missing_additionalProperties,
  48                       { type  => 'parameter',
  49                         route => $route,
  50                         verb  => $verb,
  51                         name  => $parameter->{name}
  52                       };
  53                 }
  54             }
  55         }
  56
  57         # check responses  {}
  58         my $responses = $paths->{$route}->{$verb}->{responses};
  59         foreach my $response ( keys %{$responses} ) {
  60             if (   exists $responses->{$response}->{schema}
  61                 && exists $responses->{$response}->{schema}->{type}
  62                 && ref( $responses->{$response}->{schema}->{type} ) ne 'ARRAY'
  63                 && $responses->{$response}->{schema}->{type} eq 'object' ) {
  64
  65                 # it is an object type definition
  66                 if ( not exists $responses->{$response}->{schema}->{additionalProperties} ) {
  67                     push @missing_additionalProperties,
  68                       { type  => 'response',
  69                         route => $route,
  70                         verb  => $verb,
  71                         name  => $response
  72                       };
  73                 }
  74             }
  75         }
  76     }
  77 }
  78
  79 is( scalar @missing_additionalProperties, 0 )
  80   or diag Dumper \@missing_additionalProperties;
  81
  82 subtest 'The spec passes the swagger-cli validation' => sub {
  83
  84     plan tests => 1;
  85
  86     SKIP: {
  87         skip "Skipping tests, swagger-cli missing", 1
  88           unless can_run('swagger-cli');
  89
  90         my $spec_dir = "$FindBin::Bin/../api/v1/swagger";
  91         my $var      = qx{swagger-cli validate $spec_dir/swagger.yaml 2>&1};
  92         is( $?, 0, 'Validation exit code is 0' )
  93           or diag $var;
  94     }
  95 };