File Coverage

blib/lib/AWS/Lambda/PSGI.pm
Criterion Covered Total %
statement 209 240 87.0
branch 45 68 66.1
condition 27 41 65.8
subroutine 28 34 82.3
pod 0 8 0.0
total 309 391 79.0


line stmt bran cond sub pod time code
1             package AWS::Lambda::PSGI;
2 3     3   3612 use 5.026000;
  3         12  
3 3     3   19 use utf8;
  3         7  
  3         25  
4 3     3   142 use strict;
  3         9  
  3         74  
5 3     3   12 use warnings;
  3         11  
  3         186  
6 3     3   705 use URI::Escape;
  3         2352  
  3         262  
7 3     3   2200 use Plack::Util;
  3         12236  
  3         114  
8 3     3   22 use bytes ();
  3         6  
  3         66  
9 3     3   1227 use MIME::Base64;
  3         1909  
  3         323  
10 3     3   761 use JSON::Types;
  3         490  
  3         206  
11 3     3   23 use Encode;
  3         12  
  3         273  
12 3     3   1275 use Try::Tiny;
  3         5432  
  3         250  
13 3     3   1844 use Plack::Middleware::ReverseProxy;
  3         12942  
  3         149  
14 3     3   1257 use AWS::Lambda;
  3         13  
  3         189  
15 3     3   23 use Scalar::Util qw(reftype);
  3         7  
  3         281  
16 3     3   24 use JSON::XS qw(encode_json);
  3         6  
  3         11187  
17              
18             sub new {
19 2     2 0 557442 my $proto = shift;
20 2   33     18 my $class = ref $proto || $proto;
21            
22 2         5 my $self;
23 2 50 33     15 if (@_ == 1 && ref $_[0] eq 'HASH') {
24 0         0 $self = bless {%{$_[0]}}, $class;
  0         0  
25             } else {
26 2         8 $self = bless {@_}, $class;
27             }
28              
29 2 50       17 if (!defined $self->{invoke_mode}) {
30             my $mode = $ENV{PERL5_LAMBDA_PSGI_INVOKE_MODE}
31             || $ENV{AWS_LWA_INVOKE_MODE} # for compatibility with https://github.com/awslabs/aws-lambda-web-adapter
32 2   50     22 || "BUFFERED";
33 2         12 $self->{invoke_mode} = uc $mode;
34             }
35            
36 2         8 return $self;
37             }
38              
39 0     0 0 0 sub prepare_app { return }
40              
41             sub app {
42 0 0   0 0 0 return $_[0]->{app} if scalar(@_) == 1;
43 0 0       0 return $_[0]->{app} = scalar(@_) == 2 ? $_[1] : [ @_[1..$#_ ]];
44             }
45              
46             sub to_app {
47 0     0 0 0 my $self = shift;
48 0         0 $self->prepare_app;
49 0     0   0 return sub { $self->call(@_) };
  0         0  
50             }
51              
52             sub wrap {
53 0     0 0 0 my($self, $app, @args) = @_;
54              
55             # Lambda function runs as reverse proxy backend.
56             # So, we always enable ReverseProxy middleware.
57 0         0 $app = Plack::Middleware::ReverseProxy->wrap($app);
58              
59 0 0       0 if (ref $self) {
60 0         0 $self->{app} = $app;
61             } else {
62 0         0 $self = $self->new({ app => $app, @args });
63             }
64 0         0 return $self->to_app;
65             }
66              
67             sub call {
68 0     0 0 0 my($self, $env, $ctx) = @_;
69              
70             # $ctx is added by #26
71             # fall back to $AWS::Lambda::context because of backward compatibility.
72 0   0     0 $ctx ||= $AWS::Lambda::context;
73              
74 0 0       0 if ($self->{invoke_mode} eq "RESPONSE_STREAM") {
75 0         0 my $input = $self->_format_input_v2($env, $ctx);
76 0         0 $input->{'psgi.streaming'} = Plack::Util::TRUE;
77 0         0 my $res = $self->app->($input);
78 0         0 return $self->_handle_response_stream($res);
79             } else {
80 0         0 my $input = $self->format_input($env, $ctx);
81 0         0 my $res = $self->app->($input);
82 0         0 return $self->format_output($res);
83             }
84             }
85              
86             sub format_input {
87 14     14 0 192215 my ($self, $payload, $ctx) = @_;
88 14 50       75 if (my $context = $payload->{requestContext}) {
89 14 100       57 if ($context->{elb}) {
90             # Application Load Balancer https://docs.aws.amazon.com/elasticloadbalancing/latest/application/lambda-functions.html
91 3         18 return $self->_format_input_v1($payload, $ctx);
92             }
93             }
94 11 100       48 if (my $version = $payload->{version}) {
95 6 50       32 if ($version =~ /^1[.]/) {
96             # API Gateway for REST https://docs.aws.amazon.com/apigateway/latest/developerguide/set-up-lambda-proxy-integrations.html
97 0         0 return $self->_format_input_v1($payload, $ctx);
98             }
99 6 50       35 if ($version =~ /^2[.]/) {
100             # API Gateway for HTTP https://docs.aws.amazon.com/apigateway/latest/developerguide/http-api-develop-integrations-lambda.html
101 6         60 return $self->_format_input_v2($payload, $ctx);
102             }
103             }
104 5         62 return $self->_format_input_v1($payload, $ctx);
105             }
106              
107             sub _format_input_v1 {
108 8     8   26 my ($self, $payload, $ctx) = @_;
109 8         19 my $env = {};
110              
111             # merge queryStringParameters and multiValueQueryStringParameters
112             my $query = {
113 8   100     61 %{$payload->{queryStringParameters} // {}},
114 8   100     17 %{$payload->{multiValueQueryStringParameters} // {}},
  8         48  
115             };
116 8         24 my @params;
117 8         42 while (my ($key, $value) = each %$query) {
118 4 50       17 if (ref($value) eq 'ARRAY') {
119 4         14 for my $v (@$value) {
120 7         32 push @params, "$key=$v";
121             }
122             } else {
123 0         0 push @params, "$key=$value";
124             }
125             }
126 8         38 $env->{QUERY_STRING} = join '&', @params;
127              
128             # merge headers and multiValueHeaders
129             my $headers = {
130 8   100     67 %{$payload->{headers} // {}},
131 8   100     18 %{$payload->{multiValueHeaders} // {}},
  8         86  
132             };
133 8         46 while (my ($key, $value) = each %$headers) {
134 66         260 $key =~ s/-/_/g;
135 66         134 $key = uc $key;
136 66 100       168 if ($key !~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) {
137 60         144 $key = "HTTP_$key";
138             }
139 66 100       158 if (ref $value eq "ARRAY") {
140 48         118 $value = join ", ", @$value;
141             }
142 66         1660 $env->{$key} = $value;
143             }
144              
145 8         35 $env->{'psgi.version'} = [1, 1];
146 8         52 $env->{'psgi.errors'} = *STDERR;
147 8         24 $env->{'psgi.run_once'} = Plack::Util::FALSE;
148 8         20 $env->{'psgi.multithread'} = Plack::Util::FALSE;
149 8         25 $env->{'psgi.multiprocess'} = Plack::Util::FALSE;
150 8         20 $env->{'psgi.streaming'} = Plack::Util::FALSE;
151 8         36 $env->{'psgi.nonblocking'} = Plack::Util::FALSE;
152 8         20 $env->{'psgix.harakiri'} = Plack::Util::TRUE;
153 8         28 $env->{'psgix.input.buffered'} = Plack::Util::TRUE;
154              
155             # inject the request id that compatible with Plack::Middleware::RequestId
156 8 100       34 if ($ctx) {
157 1         8 $env->{'psgix.request_id'} = $ctx->aws_request_id;
158 1         5 $env->{'HTTP_X_REQUEST_ID'} = $ctx->aws_request_id;
159             }
160              
161 8   100     70 my $body = encode_utf8($payload->{body} // '');
162 8 100       142 if ($payload->{isBase64Encoded}) {
163 3         42 $body = decode_base64 $body;
164             }
165 8         209 open my $input, "<", \$body;
166 8         56 $env->{REQUEST_METHOD} = $payload->{httpMethod};
167 8         27 $env->{'psgi.input'} = $input;
168 8   66     66 $env->{CONTENT_LENGTH} //= bytes::length($body);
169 8         99 $env->{REQUEST_URI} = $payload->{path};
170 8 100       27 if ($env->{QUERY_STRING}) {
171 4         17 $env->{REQUEST_URI} .= '?' . $env->{QUERY_STRING};
172             }
173 8         61 $env->{PATH_INFO} = URI::Escape::uri_unescape($payload->{path});
174              
175 8         149 $env->{SCRIPT_NAME} = '';
176 8         21 my $requestContext = $payload->{requestContext};
177 8 50       22 if ($requestContext) {
178 8         17 my $path = $requestContext->{path};
179 8         17 my $stage = $requestContext->{stage};
180 8 50 66     50 if ($stage && $path && $path ne $payload->{path}) {
      66        
181 5         19 $env->{SCRIPT_NAME} = "/$stage";
182             }
183             }
184              
185 8         67 return $env;
186             }
187              
188             sub _format_input_v2 {
189 6     6   20 my ($self, $payload, $ctx) = @_;
190 6         14 my $env = {};
191              
192 6         30 $env->{QUERY_STRING} = $payload->{rawQueryString};
193              
194 6   50     31 my $headers = $payload->{headers} // {};
195 6         33 while (my ($key, $value) = each %$headers) {
196 53         160 $key =~ s/-/_/g;
197 53         101 $key = uc $key;
198 53 100       144 if ($key !~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) {
199 46         95 $key = "HTTP_$key";
200             }
201 53         953 $env->{$key} = $value;
202             }
203              
204 6         34 $env->{'psgi.version'} = [1, 1];
205 6         36 $env->{'psgi.errors'} = *STDERR;
206 6         19 $env->{'psgi.run_once'} = Plack::Util::FALSE;
207 6         20 $env->{'psgi.multithread'} = Plack::Util::FALSE;
208 6         20 $env->{'psgi.multiprocess'} = Plack::Util::FALSE;
209 6         17 $env->{'psgi.streaming'} = Plack::Util::FALSE;
210 6         17 $env->{'psgi.nonblocking'} = Plack::Util::FALSE;
211 6         17 $env->{'psgix.harakiri'} = Plack::Util::TRUE;
212 6         19 $env->{'psgix.input.buffered'} = Plack::Util::TRUE;
213              
214             # inject the request id that compatible with Plack::Middleware::RequestId
215 6 50       20 if ($ctx) {
216 0         0 $env->{'psgix.request_id'} = $ctx->aws_request_id;
217 0         0 $env->{'HTTP_X_REQUEST_ID'} = $ctx->aws_request_id;
218             }
219              
220 6   100     54 my $body = encode_utf8($payload->{body} // '');
221 6 100       57 if ($payload->{isBase64Encoded}) {
222 2         35 $body = decode_base64 $body;
223             }
224 6         119 open my $input, "<", \$body;
225 6         24 $env->{'psgi.input'} = $input;
226 6   66     60 $env->{CONTENT_LENGTH} //= bytes::length($body);
227 6         38 my $requestContext = $payload->{requestContext};
228 6         30 $env->{REQUEST_METHOD} = $requestContext->{http}{method};
229 6         29 $env->{REQUEST_URI} = $payload->{rawPath};
230 6 100       21 if ($env->{QUERY_STRING}) {
231 2         8 $env->{REQUEST_URI} .= '?' . $env->{QUERY_STRING};
232             }
233 6         22 $env->{PATH_INFO} = $requestContext->{http}{path};
234 6         18 $env->{SCRIPT_NAME} = '';
235 6         33 return $env;
236             }
237              
238             sub format_output {
239 4     4 0 68498 my ($self, $response) = @_;
240 4         16 my ($status, $headers, $body) = @$response;
241              
242 4         10 my $singleValueHeaders = {};
243 4         8 my $multiValueHeaders = {};
244             Plack::Util::header_iter($headers, sub {
245 6     6   75 my ($k, $v) = @_;
246 6         30 $singleValueHeaders->{lc $k} = string $v;
247 6   100     48 push @{$multiValueHeaders->{lc $k} //= []}, string $v;
  6         41  
248 4         52 });
249              
250 4         54 my $content = '';
251 4 100       20 if (reftype($body) eq 'ARRAY') {
252 3         18 $content = join '', grep defined, @$body;
253             } else {
254 1         26 local $/ = \4096;
255 1         58 while (defined(my $buf = $body->getline)) {
256 1         8 $content .= $buf;
257             }
258 1         18 $body->close;
259             }
260              
261 4   50     32 my $type = $singleValueHeaders->{'content-type'} // 'application/octet-stream';
262 4         37 my $isBase64Encoded = $type !~ m(^text/.*|application/(:?json|javascript|xml))i;
263 4 100       13 if ($isBase64Encoded) {
264 1         8 $content = encode_base64 $content, '';
265             } else {
266             $content = try {
267             # is valid utf-8 string? try to decode as utf-8.
268 3     3   414 decode_utf8($content, Encode::FB_CROAK | Encode::LEAVE_SRC);
269             } catch {
270             # it looks not utf-8 encoding. fallback to base64 encoding.
271 1     1   37 $isBase64Encoded = 1;
272 1         11 encode_base64 $content, '';
273 3         35 };
274             }
275              
276             return +{
277 4         97 isBase64Encoded => bool $isBase64Encoded,
278             headers => $singleValueHeaders,
279             multiValueHeaders => $multiValueHeaders,
280             statusCode => number $status,
281             body => string $content,
282             }
283             }
284              
285             sub _handle_response_stream {
286 3     3   48022 my ($self, $response) = @_;
287 3 100       19 if (reftype($response) ne "CODE") {
288 2         6 my $orig = $response;
289             $response = sub {
290 2     2   4 my $responder = shift;
291 2         6 $responder->($orig);
292 2         15 };
293             }
294              
295             return sub {
296 3     3   28 my $lambda_responder = shift;
297             my $psgi_responder = sub {
298 3         12 my $response = shift;
299 3         12 my ($status, $headers, $body) = @$response;
300              
301             # write the prelude.
302 3         11 my $writer = $lambda_responder->("application/vnd.awslambda.http-integration-response");
303 3         107 my $prelude = encode_json($self->_format_response_stream($status, $headers));
304 3         85 $prelude .= "\x00\x00\x00\x00\x00\x00\x00\x00";
305 3 50       32 $writer->write($prelude) or die "failed to write prelude: $!";
306              
307             # write the body.
308 3 100       99 if (!defined $body) {
309             # the caller will write the body.
310 1         4 return $writer;
311             }
312 2 100       9 if (reftype($body) eq 'ARRAY') {
313             # array-ref
314 1         3 for my $chunk (@$body) {
315 1 50       4 $writer->write($chunk) or die "failed to write chunk: $!";
316             }
317             } else {
318             # IO::Handle-like object
319 1         6 local $/ = \4096;
320 1         43 while (defined(my $chunk = $body->getline)) {
321 1 50       7 $writer->write($chunk) or die "failed to write chunk: $!";
322             }
323             }
324 2 50       56 $writer->close or die "failed to close writer: $!";
325 2         62 return;
326 3         58 };
327 3         12 $response->($psgi_responder);
328 3         20 };
329             }
330              
331             sub _format_response_stream {
332 3     3   12 my ($self, $status, $headers) = @_;
333 3         9 my $headers_hash = {};
334 3         5 my $cookies = [];
335              
336             Plack::Util::header_iter($headers, sub {
337 3     3   44 my ($k, $v) = @_;
338 3         29 $k = lc $k;
339 3 50       19 if ($k eq 'set-cookie') {
    50          
340 0         0 push @$cookies, string $v;
341             } elsif (exists $headers_hash->{$k}) {
342 0         0 $headers_hash->{$k} = ", $v";
343             } else {
344 3         18 $headers_hash->{$k} = string $v;
345             }
346 3         31 });
347              
348             return +{
349 3         67 statusCode => number $status,
350             headers => $headers_hash,
351             cookies => $cookies,
352             };
353             }
354              
355             1;
356             __END__