#221 uri encoding fixes

Changes

@@ -1,3 +1,6 @@
+0.39
+ - API updates for any service up to the date of release
+
 0.38 19 Jun 2018
  - Fix test suite so that credentials_process tests don't need extra modules (#251, #248)
  - API updates for any service up to the date of release

Makefile

@@ -1,5 +1,5 @@
 test:
-	carton exec -- prove -v -I lib -I auto-lib t/
+	carton exec -- prove -r -v -I lib -I auto-lib t/
 
 pod-test:
 	for i in `find auto-lib/Paws/ -name \*.pm`; do podchecker $$i; done;

auto-lib/Paws.pm

@@ -57,7 +57,7 @@ __PACKAGE__->meta->make_immutable;
 
 package Paws;
 
-our $VERSION = '0.38';
+our $VERSION = '0.39';
 
 use Moose;
 use MooseX::ClassAttribute;

auto-lib/Paws/Route53/ChangeTagsForResource.pm

@@ -13,7 +13,7 @@ package Paws::Route53::ChangeTagsForResource;
   class_has _api_method  => (isa => 'Str', is => 'ro', default => 'POST');
   class_has _returns => (isa => 'Str', is => 'ro', default => 'Paws::Route53::ChangeTagsForResourceResponse');
   class_has _result_key => (isa => 'Str', is => 'ro');
-  
+
 1;
 
 ### main pod documentation begin ###
@@ -110,4 +110,3 @@ The source code is located here: L<https://github.com/pplu/aws-sdk-perl>
 Please report bugs to: L<https://github.com/pplu/aws-sdk-perl/issues>
 
 =cut
-

builder-lib/Paws/API/Builder/Paws.pm

@@ -9,7 +9,7 @@ package Paws::API::Builder::Paws {
   use Moose;
 
   sub version {
-    '0.38';
+    '0.39';
   }
 
   sub services {

cpanfile

@@ -14,7 +14,7 @@ requires 'DateTime';
 requires 'DateTime::Format::ISO8601';
 requires 'URL::Encode';
 requires 'URL::Encode::XS';
-requires 'URI::Template';
+requires 'URI::Template' => '0.23';
 requires 'Config::INI';
 requires 'Digest::SHA';
 # For the paws CLI

examples/s3-common-methods.pl

@@ -14,8 +14,9 @@
 use Paws;
 
 my $service    = 'S3';
-my $region     = 'us-east-1';
-my $bucketname = 'paws-test-bucket';
+# my $region     = 'us-east-1';
+my $region     = 'us-west-2';
+my $bucketname = 'shadowcatjesstest';
 my $test_dir   = 'uploads/test_';
 
 
@@ -46,7 +47,7 @@
     $response = $s3->CreateBucket(
       Bucket => $bucketname,
       CreateBucketConfiguration => {
-        LocationConstraint => 'eu-west-1', 
+        LocationConstraint => 'us-west-2', 
       },
     );
     p $response;

lib/Paws/Net/Caller.pm

@@ -22,6 +22,7 @@ package Paws::Net::Caller;
     # HTTP::Tiny derives the Host header from the URL. It's an error to set it.
     delete $headers->{Host}; 
 
+#    print STDERR Data::Dumper::Dumper($requestObj);
     my $response = $self->ua->request(
       $requestObj->method,
       $requestObj->url,
@@ -30,6 +31,7 @@ package Paws::Net::Caller;
         (defined $requestObj->content)?(content => $requestObj->content):(),
       }
     );
+    print STDERR Data::Dumper::Dumper($response);
     return Paws::Net::APIResponse->new(
       status  => $response->{status},
       content => $response->{content},

lib/Paws/Net/FileMockCaller.pm

@@ -63,11 +63,19 @@ package Paws::Net::FileMockCaller;
     default => sub { shift->file_contents->{ request }->{ params } }
   );
 
+  has actual_request => (
+    is => 'rw',
+    isa => 'Object',
+    lazy => 1,
+    default => sub { '' },
+    );
+
   has _encoder => (is => 'ro', default => sub { JSON::MaybeXS->new(canonical => 1) });
 
   sub send_request {
     my ($self, $service, $call_object) = @_;
 
+    $self->actual_request($service->prepare_request_for_call($call_object));
     my $actual_call = $self->_encoder->encode($service->to_hash($call_object));
     my $recorded_call = $self->_encoder->encode($self->params);
 
@@ -92,7 +100,7 @@ package Paws::Net::FileMockCaller;
 
   sub caller_to_response {
     my ($self, $service, $call_object, $response) = @_;
- 
+
     return $self->real_caller->caller_to_response($service, $call_object, $response);   
   };
 

lib/Paws/Net/MockCaller.pm

@@ -8,6 +8,7 @@ package Paws::Net::MockCaller;
   use Moose::Util::TypeConstraints;
   use Path::Tiny;
   use Paws::Net::FileMockCaller;
+  use Paws::Net::NoResponseMockCaller;
 
   has real_caller => (
     is => 'ro', 
@@ -18,17 +19,25 @@ package Paws::Net::MockCaller;
     }
   );
 
+  has mock_type => (
+    is => 'ro',
+    isa => 'Str',
+    default => sub { 'FileMockCaller' },
+  );
+
   has mock_mode => (
     is => 'ro',
+    lazy => 1,
     isa => enum([ 'REPLAY', 'RECORD' ]),
-    required => 1,
+    required => 0,
     default => sub { $ENV{PAWS_MOCK_MODE} }
   );
 
   has mock_dir => (
     is => 'ro',
     isa => 'Str',
-    required => 1,
+    lazy => 1,
+    required => 0,
     default => sub { $ENV{PAWS_MOCK_DIR} }
   );
 
@@ -49,7 +58,8 @@ package Paws::Net::MockCaller;
     lazy => 1,
     default => sub {
       my $self = shift;
-      Paws::Net::FileMockCaller->new(
+      my $mock_class = 'Paws::Net::' . $self->mock_type;
+      $mock_class->new(
         real_caller => $self->real_caller,
       );
     }
@@ -60,60 +70,70 @@ package Paws::Net::MockCaller;
     isa => 'CodeRef',
   );
 
+  sub actual_request {
+    return $_[0]->caller->actual_request;
+  }
+
   sub send_request {
     my ($self, $service, $call_object) = @_;
 
-    $self->_test_file(sprintf("%s/%04d.response", $self->mock_dir, $self->_request_num));
-    $self->_next_request;
-
-    if ($self->mock_mode eq 'REPLAY') {
-      $self->caller->file($self->_test_file);
-      return $self->caller->send_request($service, $call_object);
-    } elsif ($self->mock_mode eq 'RECORD') {
-      return $self->real_caller->send_request($service, $call_object);
+    if ($self->mock_type eq 'FileMockCaller') {
+      $self->_test_file(sprintf("%s/%04d.response", $self->mock_dir, $self->_request_num));
+      $self->_next_request;
+
+      if ($self->mock_mode eq 'REPLAY') {
+        $self->caller->file($self->_test_file);
+        return $self->caller->send_request($service, $call_object);
+      } elsif ($self->mock_mode eq 'RECORD') {
+        return $self->real_caller->send_request($service, $call_object);
+      } else {
+        die "Unsupported record mode " . $self->mock_mode;
+      }
     } else {
-      die "Unsupported record mode " . $self->mock_mode;
+      return $self->caller->send_request($service, $call_object);
     }
   };
 
   sub caller_to_response {
     my ($self, $service, $call_object, $response) = @_;
-    my $content = $response->content;
-    my $headers = $response->headers;
-
-    $content =~ s/<(RequestId)>.*<\/(RequestId)>/<$1>000000000000000000000000000000000000<\/$2>/ if (defined $content);
-    $content =~ s/<(RequestID)>.*<\/(RequestID)>/<$1>000000000000000000000000000000000000<\/$2>/ if (defined $content);
-
-    if ($headers->{ "x-amzn-requestid" }) {
-      $headers->{ "x-amzn-requestid" }  = '000000000000000000000000000000000000' 
-    }
-
-    if ($headers->{ "x-amz-request-id" }) {
-      $headers->{ "x-amz-request-id" }  = '000000000000000000000000000000000000' 
-    }
 
-    if ($self->mock_mode eq 'RECORD') {
-      my $file = path $self->_test_file;
-      $file->parent->mkpath;
-
-      write_text($self->_test_file, encode_json({
-        request => {
-          params => $service->to_hash($call_object),
-          service => $service->service,
-          call => $call_object->_api_call,
-        },
-        response => { 
-          content => $response->content, 
-          headers => $response->headers,
-          status  => $response->status,
-        }
-      }));
-
-      my $result = $self->real_caller->caller_to_response($service, $call_object, $response);   
+    if ($self->mock_type eq 'FileMockCaller') {
+      my $content = $response->content;
+      my $headers = $response->headers;
+
+      $content =~ s/<(RequestId)>.*<\/(RequestId)>/<$1>000000000000000000000000000000000000<\/$2>/ if (defined $content);
+      $content =~ s/<(RequestID)>.*<\/(RequestID)>/<$1>000000000000000000000000000000000000<\/$2>/ if (defined $content);
+
+      if ($headers->{ "x-amzn-requestid" }) {
+        $headers->{ "x-amzn-requestid" }  = '000000000000000000000000000000000000' 
+      }
+
+      if ($headers->{ "x-amz-request-id" }) {
+        $headers->{ "x-amz-request-id" }  = '000000000000000000000000000000000000' 
+      }
+
+      if ($self->mock_mode eq 'RECORD') {
+        my $file = path $self->_test_file;
+        $file->parent->mkpath;
+
+        write_text($self->_test_file, encode_json({
+          request => {
+            params => $service->to_hash($call_object),
+            service => $service->service,
+            call => $call_object->_api_call,
+          },
+          response => { 
+            content => $response->content, 
+            headers => $response->headers,
+            status  => $response->status,
+          }
+        }));
+      }
+      my $result = $self->caller->caller_to_response($service, $call_object, $response);   
       $self->result_hook->($self, $result) if (defined $self->result_hook);
       return $result;
     } else {
-      return $self->real_caller->caller_to_response($service, $call_object, $response);
+      return $self->caller->caller_to_response($service, $call_object, $response);
     }
   };
 

lib/Paws/Net/NoResponseMockCaller.pm

@@ -0,0 +1,48 @@
+package Paws::Net::NoResponseMockCaller;
+  use Moose;
+
+  with 'Paws::Net::RetryCallerRole', 'Paws::Net::CallerRole';
+
+  use Paws::Net::APIResponse;
+  use File::Slurper qw(read_text write_text);
+  use JSON::MaybeXS;
+  use Moose::Util::TypeConstraints;
+  use Path::Tiny;
+
+  has file => (is => 'rw', isa => 'Str', trigger => \&_set_file);
+
+  has real_caller => (
+    is => 'ro',
+    does => 'Paws::Net::CallerRole',
+    default => sub {
+      require Paws::Net::Caller;
+      Paws::Net::Caller->new;
+    }
+  );
+
+  has actual_request => (
+    is => 'rw',
+    isa => 'Object',
+    lazy => 1,
+    default => sub { '' },
+    );
+
+  has _encoder => (is => 'ro', default => sub { JSON::MaybeXS->new(canonical => 1) });
+
+  sub send_request {
+    my ($self, $service, $call_object) = @_;
+
+    $self->actual_request($service->prepare_request_for_call($call_object));
+    my $actual_call = $self->_encoder->encode($service->to_hash($call_object));
+
+    # we don't care about the response
+    return {};
+  };
+
+  sub caller_to_response {
+    my ($self, $service, $call_object, $response) = @_;
+
+    return $response;
+  };
+
+1;

lib/Paws/Net/RestXmlCaller.pm

@@ -28,7 +28,7 @@ package Paws::Net::RestXmlCaller;
 
     my %p;
     foreach my $att (grep { $_ !~ m/^_/ } $params->meta->get_attribute_list) {
-      
+
       # e.g. S3 metadata objects, which are passed in the header
       next if $params->meta->get_attribute($att)->does('Paws::API::Attribute::Trait::ParamInHeaders');
 
@@ -79,6 +79,14 @@ package Paws::Net::RestXmlCaller;
     {
       if ($attribute->does('Paws::API::Attribute::Trait::ParamInURI')) {
         my $att_name = $attribute->name;
+        my $non_print = join('',  map { chr($_) } (128..255) );
+        if ($call->$att_name =~ /[{^}`\[\]><#%'"~|\\$non_print]/) {
+          return Paws::Exception->throw(
+            message => "Found unacceptable content in $att_name parameter",
+            code => 'InvalidInput',
+            request_id => '',
+           );
+        }
         if ($uri_attrib_is_greedy{$att_name}) {
             $vars->{ $attribute->uri_name } =  uri_escape_utf8($call->$att_name, q[^A-Za-z0-9\-\._~/]);
             $uri_template =~ s{$att_name\+}{\+$att_name}g;
@@ -120,7 +128,7 @@ package Paws::Net::RestXmlCaller;
       elsif ($attribute->does('Paws::API::Attribute::Trait::ParamInHeaders')) {
         my $map = $attribute->get_value($call)->Map;
         my $prefix = $attribute->header_prefix;
-        for my $header (keys %{$map}) { 
+        for my $header (keys %{$map}) {
           my $header_name = $prefix . $header;
           $request->headers->header( $header_name => $map->{$header} );
         }
@@ -179,11 +187,11 @@ package Paws::Net::RestXmlCaller;
 
     my $xml = '';
     foreach my $attribute ($call->meta->get_all_attributes) {
-      if ($attribute->has_value($call) and 
+      if ($attribute->has_value($call) and
           not $attribute->does('Paws::API::Attribute::Trait::ParamInHeader') and
           not $attribute->does('Paws::API::Attribute::Trait::ParamInQuery') and
           not $attribute->does('Paws::API::Attribute::Trait::ParamInURI') and
-          not $attribute->does('Paws::API::Attribute::Trait::ParamInBody') and 
+          not $attribute->does('Paws::API::Attribute::Trait::ParamInBody') and
           not $attribute->type_constraint eq 'Paws::S3::Metadata'
          ) {
         my $attribute_value = $attribute->get_value($call);