view release on metacpan or  search on metacpan

t/unit/glacier_request.t  view on Meta::CPAN

		ok $g->{secret} eq 'secret';
		ok $g->{vault} eq 'vault';
		ok $g->{host} eq 'glacier.region.amazonaws.com';
		cmp_set headers('x-amz-glacier-version' => '2012-06-01', 'Host' => $g->{host}), $g->{headers};
	};

	it "should work with token" => sub {
		for my $token (qw/mytokenJHGYJUHhT 0/) {
			my $g = App::MtAws::GlacierRequest->new({%common_options, token => $token});
			ok $g->{token} eq $token;
			cmp_set
				$g->{headers},
				headers('x-amz-glacier-version' => '2012-06-01', 'Host' => $g->{host}, 'x-amz-security-token' => $token);
		}
	};

	it "should work with timeout" => sub {
		for my $timeout (qw/0 120 86400/) {
			my $g = App::MtAws::GlacierRequest->new({region=>'region', key=>'key', secret=>'secret',
				protocol=>'http', vault=>'vault', timeout => $timeout});
			ok $g->{timeout} eq $timeout;
			($g->{method}, $g->{url}) = ('GET', 'test');
			my @opts;
			LWP::UserAgent->expects('new')->returns(sub { @opts = @_; undef});
			eval{my $resp = $g->perform_lwp();};
			cmp_deeply [@opts], [qw/LWP::UserAgent timeout/, $timeout];
		}
	};

	it "should die without region" => sub {
		ok ! eval { App::MtAws::GlacierRequest->new({key=>'key', secret=>'secret', protocol=>'http', vault=>'vault', timeout => 180}) };
	};

	it "should die without secret" => sub {
		ok ! eval { App::MtAws::GlacierRequest->new({key=>'key', region=>'region', protocol=>'http', vault=>'vault', timeout => 180}) };
	};

	it "should die without timeout" => sub {
		ok ! eval { App::MtAws::GlacierRequest->new({key=>'key', region=>'region', protocol=>'http', vault=>'vault', secret => 'secret'}) };
	};

	it "should die without protocol" => sub {
		ok ! eval { App::MtAws::GlacierRequest->new({key=>'key', region=>'region', secret=>'secret', vault=>'vault', timeout => 180}) };
	};

	it "should not die without vault" => sub {
		ok eval { App::MtAws::GlacierRequest->new({key=>'key', region=>'region', secret=>'secret', protocol=>'http', timeout => 180}) };
	};

	it "should die with wrong protocol" => sub {
		ok ! eval { App::MtAws::GlacierRequest->new({key=>'key', region=>'region', secret=>'secret', protocol => 'xyz', timeout => 180}) };
	};

	it "should not die with https" => sub {
		ok eval { App::MtAws::GlacierRequest->new({key=>'key', region=>'region', secret=>'secret', protocol => 'https', timeout => 180}) };
	};
};


describe "create_multipart_upload" => sub {
	it "should throw exception if filename too long" => sub {
		my $g = App::MtAws::GlacierRequest->new({%common_options});
		my $filename = 'x' x 2000;
		my $t = time();
		ok ! defined eval { $g->create_multipart_upload(2, $filename, $t); 1 };
		ok is_exception('file_name_too_big');
		is get_exception->{filename}, $filename;
		is exception_message(get_exception),
			"Either relative filename \"$filename\" is too big to store in Amazon Glacier metadata. ".
			"(Limit is about 700 ASCII characters or 350 2-byte UTF-8 characters)".
			" or file modification time \"$t\" out of range".
			"(Only years from 1000 to 9999 are supported)";
	};
};

describe "perform_lwp" => sub {
	it "should work with 2xx codes" => sub {
		for my $code (200..209) {
			my $g = App::MtAws::GlacierRequest->new({%common_options});
			($g->{method}, $g->{url}) = ('GET', 'test');
			LWP::UserAgent->expects('request')->returns(HTTP::Response->new($code, 'OK'));
			my $resp = $g->perform_lwp();
			is $resp->code, $code;
		}
	};
	it "should construct correct User-Agent" => sub {
		my $g = App::MtAws::GlacierRequest->new({%common_options});
		($g->{method}, $g->{url}) = ('GET', 'test');
		LWP::UserAgent->expects('request')->returns(sub {
			my ($self, $req) = @_;
			is $self->agent, "mt-aws-glacier/$App::MtAws::VERSION$App::MtAws::VERSION_MATURITY (http://mt-aws.com/) libwww-perl/".LWP->VERSION();
			HTTP::Response->new(200, 'OK')
		});
		my $resp = $g->perform_lwp();
	};
	describe "throttle" => sub {
		it 'should work' => sub {
			my @sleep_args;
			my $retries = App::MtAws::GlacierRequest::_max_retries();
			is $retries, 100;
			App::MtAws::GlacierRequest->expects('_sleep')->returns(sub { push @sleep_args, shift } )->exactly($retries);
			App::MtAws::GlacierRequest::throttle($_) for (1..App::MtAws::GlacierRequest::_max_retries);
			cmp_deeply [ @sleep_args ],
				[ (1) x 5, (5) x 5, (15) x 10, (60) x 30, (180) x 50 ]
		};
	};
	describe "throttling" => sub {
		my $retries = 3;
		it "should throttle 408/500" => sub {
			for my $code (qw/408 500/) {
				my $g = App::MtAws::GlacierRequest->new({%common_options});
				($g->{method}, $g->{url}) = ('GET', 'test');
				my @throttle_args;
				App::MtAws::GlacierRequest->expects('_max_retries')->any_number->returns($retries);
				App::MtAws::GlacierRequest->expects('throttle')->returns(sub { push @throttle_args, shift } )->exactly($retries);
				LWP::UserAgent->expects('request')->returns(HTTP::Response->new($code))->exactly($retries);
				my $resp = capture_stdout(my $out, sub {
					assert_raises_exception sub {
						$g->perform_lwp();
					}, exception 'too_many_tries' => "Request was not successful after $retries retries";
				});