1package Shared::Examples::Net::Amazon::S3::Request;
2# ABSTRACT: used for testing and as example
3$Shared::Examples::Net::Amazon::S3::Request::VERSION = '0.99';
4use strict;
5use warnings;
6
7use parent qw[ Exporter::Tiny ];
8
9use Test::More;
10use Test::Deep;
11
12use Moose qw[];
13use Moose::Object;
14use Moose::Util;
15use XML::LibXML;
16
17use Net::Amazon::S3;
18use Net::Amazon::S3::Bucket;
19
20use Shared::Examples::Net::Amazon::S3;
21
22our @EXPORT_OK = (
23	qw[ behaves_like_net_amazon_s3_request ],
24	qw[ expect_request_class ],
25	qw[ expect_request_instance ],
26);
27
28sub _canonical_xml {
29	my ($xml) = @_;
30
31	return $xml unless $xml;
32	return $xml if ref $xml;
33
34	my $canonical = eval {
35		XML::LibXML->load_xml (
36			string => $xml,
37			no_blanks => 1,
38		)->toStringC14N
39	};
40
41	return $xml unless defined $canonical;
42	return $canonical;
43}
44
45sub _test_meta_build_http_request {
46	my ($self, %params) = @_;
47
48	return $self->_build_signed_request (%params);
49}
50
51sub _test_class {
52	my ($request_class, %params) = @_;
53
54	$params{superclasses} ||= [];
55	$params{methods}{_build_http_request} = \& _test_meta_build_http_request;
56
57	push @{ $params{superclasses} }, $request_class;
58
59	return Moose::Meta::Class->create_anon_class (%params);
60}
61
62sub expect_request_class {
63	my ($request_class) = @_;
64
65	local $Test::Builder::Level = $Test::Builder::Level + 1;
66
67	return use_ok $request_class;
68}
69
70sub expect_request_instance {
71	my (%params) = @_;
72
73	local $Test::Builder::Level = $Test::Builder::Level + 1;
74
75	my %with = map +( substr ($_, 5) => delete $params{$_} ),
76		grep m/^with_/,
77		keys %params
78		;
79
80	$with{s3} = Shared::Examples::Net::Amazon::S3::s3_api_with_signature_2 (
81		host => $params{with_host} || 's3.amazonaws.com',
82	);
83
84	my $test_class = _test_class $params{request_class},
85		map +( $_ => $params{$_} ),
86		grep exists $params{$_},
87		qw [ roles ],
88		;
89
90	my $request = eval { $test_class->name->new (%with) };
91	my $error = $@;
92
93	if (exists $params{throws}) {
94		if (defined $request) {
95			fail "create instance should fail";
96		} else {
97			cmp_deeply $error, $params{throws}, "create instance should fail";
98		}
99	} else {
100		ok defined $request, "should create (mocked) instance of $params{request_class}"
101			or diag $error;
102	}
103
104	return $request;
105}
106
107sub expect_request_uri {
108	my ($request, $expected) = @_;
109
110	local $Test::Builder::Level = $Test::Builder::Level + 1;
111
112	return cmp_deeply
113		$request->http_request->request_uri,
114		$expected,
115		"it builds expected request uri"
116		;
117}
118
119sub expect_request_method {
120	my ($request, $expected) = @_;
121
122	local $Test::Builder::Level = $Test::Builder::Level + 1;
123
124	return cmp_deeply
125		$request->http_request->method,
126		$expected,
127		"it builds expected request method"
128		;
129}
130
131sub expect_request_headers {
132	my ($request, $expected) = @_;
133
134	local $Test::Builder::Level = $Test::Builder::Level + 1;
135
136	return cmp_deeply
137		$request->http_request->headers,
138		$expected,
139		"it builds expected request headers"
140		;
141}
142
143sub expect_request_content {
144	my ($request, $expected) = @_;
145
146	local $Test::Builder::Level = $Test::Builder::Level + 1;
147
148	# XML builders doesn't need to produce whitespaces for readability
149	# wherease test expectation should be as readable as possible
150	# compare canonicalized xml strings than
151
152	return is
153		_canonical_xml ($request->http_request->content),
154		_canonical_xml ($expected),
155		"it builds expected request XML content"
156		;
157}
158
159sub behaves_like_net_amazon_s3_request {
160	my ($title, %params) = @_;
161
162	local $Test::Builder::Level = $Test::Builder::Level + 1;
163
164	subtest $title => sub {
165		plan tests => 2 + scalar grep exists $params{$_},
166			qw[ expect_request_uri ],
167			qw[ expect_request_method ],
168			qw[ expect_request_headers ],
169			qw[ expect_request_content ],
170			;
171
172		expect_request_class $params{request_class};
173		my $request = expect_request_instance %params;
174
175		expect_request_uri $request => $params{expect_request_uri}
176			if exists  $params{expect_request_uri};
177
178		expect_request_method $request => $params{expect_request_method}
179			if exists  $params{expect_request_method};
180
181		expect_request_headers $request => $params{expect_request_headers}
182			if exists  $params{expect_request_headers};
183
184		expect_request_content $request => $params{expect_request_content}
185			if exists  $params{expect_request_content};
186	};
187}
188
1891;
190
191__END__
192
193=pod
194
195=encoding UTF-8
196
197=head1 NAME
198
199Shared::Examples::Net::Amazon::S3::Request - used for testing and as example
200
201=head1 VERSION
202
203version 0.99
204
205=head1 AUTHOR
206
207Branislav Zahradník <barney@cpan.org>
208
209=head1 COPYRIGHT AND LICENSE
210
211This software is copyright (c) 2021 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover, Branislav Zahradník.
212
213This is free software; you can redistribute it and/or modify it under
214the same terms as the Perl 5 programming language system itself.
215
216=cut
217