File Coverage

blib/lib/AWS/Lambda/PSGI.pm
Criterion Covered Total %
statement 168 192 87.5
branch 32 46 69.5
condition 28 39 71.7
subroutine 22 28 78.5
pod 0 8 0.0
total 250 313 79.8


line stmt bran cond sub pod time code
1             package AWS::Lambda::PSGI;
2 2     2   2010 use 5.026000;
  2         8  
3 2     2   10 use utf8;
  2         3  
  2         30  
4 2     2   43 use strict;
  2         4  
  2         66  
5 2     2   10 use warnings;
  2         4  
  2         47  
6 2     2   498 use URI::Escape;
  2         1504  
  2         134  
7 2     2   1061 use Plack::Util;
  2         6891  
  2         54  
8 2     2   13 use bytes ();
  2         4  
  2         38  
9 2     2   960 use MIME::Base64;
  2         1330  
  2         138  
10 2     2   524 use JSON::Types;
  2         265  
  2         100  
11 2     2   608 use Encode;
  2         14216  
  2         138  
12 2     2   606 use Try::Tiny;
  2         2099  
  2         110  
13 2     2   946 use Plack::Middleware::ReverseProxy;
  2         6121  
  2         66  
14 2     2   1215 use AWS::Lambda;
  2         21  
  2         4037  
15              
16             sub new {
17 1     1 0 105 my $proto = shift;
18 1   33     9 my $class = ref $proto || $proto;
19            
20 1         2 my $self;
21 1 50 33     5 if (@_ == 1 && ref $_[0] eq 'HASH') {
22 0         0 $self = bless {%{$_[0]}}, $class;
  0         0  
23             } else {
24 1         4 $self = bless {@_}, $class;
25             }
26            
27 1         2 $self;
28             }
29              
30 0     0 0 0 sub prepare_app { return }
31              
32             sub app {
33 0 0   0 0 0 return $_[0]->{app} if scalar(@_) == 1;
34 0 0       0 return $_[0]->{app} = scalar(@_) == 2 ? $_[1] : [ @_[1..$#_ ]];
35             }
36              
37             sub to_app {
38 0     0 0 0 my $self = shift;
39 0         0 $self->prepare_app;
40 0     0   0 return sub { $self->call(@_) };
  0         0  
41             }
42              
43             sub wrap {
44 0     0 0 0 my($self, $app, @args) = @_;
45              
46             # Lambda function runs as reverse proxy backend.
47             # So, we always enable ReverseProxy middleware.
48 0         0 $app = Plack::Middleware::ReverseProxy->wrap($app);
49              
50 0 0       0 if (ref $self) {
51 0         0 $self->{app} = $app;
52             } else {
53 0         0 $self = $self->new({ app => $app, @args });
54             }
55 0         0 return $self->to_app;
56             }
57              
58             sub call {
59 0     0 0 0 my($self, $env, $ctx) = @_;
60              
61             # $ctx is added by #26
62             # fall back to $AWS::Lambda::context because of backward compatibility.
63 0   0     0 $ctx ||= $AWS::Lambda::context;
64              
65 0         0 my $input = $self->format_input($env, $ctx);
66 0         0 my $res = $self->app->($input);
67 0         0 return $self->format_output($res);
68             }
69              
70             sub format_input {
71 14     14 0 76410 my ($self, $payload, $ctx) = @_;
72 14 50       55 if (my $context = $payload->{requestContext}) {
73 14 100       35 if ($context->{elb}) {
74             # Application Load Balancer https://docs.aws.amazon.com/elasticloadbalancing/latest/application/lambda-functions.html
75 3         13 return $self->_format_input_v1($payload, $ctx);
76             }
77             }
78 11 100       28 if (my $version = $payload->{version}) {
79 6 50       24 if ($version =~ /^1[.]/) {
80             # API Gateway for REST https://docs.aws.amazon.com/apigateway/latest/developerguide/set-up-lambda-proxy-integrations.html
81 0         0 return $self->_format_input_v1($payload, $ctx);
82             }
83 6 50       30 if ($version =~ /^2[.]/) {
84             # API Gateway for HTTP https://docs.aws.amazon.com/apigateway/latest/developerguide/http-api-develop-integrations-lambda.html
85 6         24 return $self->_format_input_v2($payload, $ctx);
86             }
87             }
88 5         14 return $self->_format_input_v1($payload, $ctx);
89             }
90              
91             sub _format_input_v1 {
92 8     8   17 my ($self, $payload, $ctx) = @_;
93 8         16 my $env = {};
94              
95             # merge queryStringParameters and multiValueQueryStringParameters
96             my $query = {
97 8   100     34 %{$payload->{queryStringParameters} // {}},
98 8   100     12 %{$payload->{multiValueQueryStringParameters} // {}},
  8         38  
99             };
100 8         19 my @params;
101 8         41 while (my ($key, $value) = each %$query) {
102 4 50       18 if (ref($value) eq 'ARRAY') {
103 4         10 for my $v (@$value) {
104 7         31 push @params, "$key=$v";
105             }
106             } else {
107 0         0 push @params, "$key=$value";
108             }
109             }
110 8         37 $env->{QUERY_STRING} = join '&', @params;
111              
112             # merge headers and multiValueHeaders
113             my $headers = {
114 8   100     36 %{$payload->{headers} // {}},
115 8   100     12 %{$payload->{multiValueHeaders} // {}},
  8         118  
116             };
117 8         52 while (my ($key, $value) = each %$headers) {
118 66         181 $key =~ s/-/_/g;
119 66         125 $key = uc $key;
120 66 100       163 if ($key !~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) {
121 60         113 $key = "HTTP_$key";
122             }
123 66 100       135 if (ref $value eq "ARRAY") {
124 48         94 $value = join ", ", @$value;
125             }
126 66         231 $env->{$key} = $value;
127             }
128              
129 8         21 $env->{'psgi.version'} = [1, 1];
130 8         44 $env->{'psgi.errors'} = *STDERR;
131 8         16 $env->{'psgi.run_once'} = Plack::Util::FALSE;
132 8         16 $env->{'psgi.multithread'} = Plack::Util::FALSE;
133 8         15 $env->{'psgi.multiprocess'} = Plack::Util::FALSE;
134 8         18 $env->{'psgi.streaming'} = Plack::Util::FALSE;
135 8         26 $env->{'psgi.nonblocking'} = Plack::Util::FALSE;
136 8         17 $env->{'psgix.harakiri'} = Plack::Util::TRUE;
137 8         14 $env->{'psgix.input.buffered'} = Plack::Util::TRUE;
138              
139             # inject the request id that compatible with Plack::Middleware::RequestId
140 8 100       23 if ($ctx) {
141 1         6 $env->{'psgix.request_id'} = $ctx->aws_request_id;
142 1         8 $env->{'HTTP_X_REQUEST_ID'} = $ctx->aws_request_id;
143             }
144              
145 8   100     52 my $body = encode_utf8($payload->{body} // '');
146 8 100       84 if ($payload->{isBase64Encoded}) {
147 3         39 $body = decode_base64 $body;
148             }
149 8     1   151 open my $input, "<", \$body;
  1         7  
  1         1  
  1         5  
150 8         878 $env->{REQUEST_METHOD} = $payload->{httpMethod};
151 8         17 $env->{'psgi.input'} = $input;
152 8   100     46 $env->{CONTENT_LENGTH} //= bytes::length($body);
153 8         1472 $env->{REQUEST_URI} = $payload->{path};
154 8 100       16 if ($env->{QUERY_STRING}) {
155 4         14 $env->{REQUEST_URI} .= '?' . $env->{QUERY_STRING};
156             }
157 8         32 $env->{PATH_INFO} = URI::Escape::uri_unescape($payload->{path});
158              
159 8         116 $env->{SCRIPT_NAME} = '';
160 8         14 my $requestContext = $payload->{requestContext};
161 8 50       17 if ($requestContext) {
162 8         13 my $path = $requestContext->{path};
163 8         14 my $stage = $requestContext->{stage};
164 8 50 66     48 if ($stage && $path && $path ne $payload->{path}) {
      66        
165 5         14 $env->{SCRIPT_NAME} = "/$stage";
166             }
167             }
168              
169 8         56 return $env;
170             }
171              
172             sub _format_input_v2 {
173 6     6   14 my ($self, $payload, $ctx) = @_;
174 6         12 my $env = {};
175              
176 6         17 $env->{QUERY_STRING} = $payload->{rawQueryString};
177              
178 6   50     31 my $headers = $payload->{headers} // {};
179 6         31 while (my ($key, $value) = each %$headers) {
180 53         134 $key =~ s/-/_/g;
181 53         104 $key = uc $key;
182 53 100       138 if ($key !~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) {
183 46         80 $key = "HTTP_$key";
184             }
185 53         188 $env->{$key} = $value;
186             }
187              
188 6         25 $env->{'psgi.version'} = [1, 1];
189 6         24 $env->{'psgi.errors'} = *STDERR;
190 6         13 $env->{'psgi.run_once'} = Plack::Util::FALSE;
191 6         12 $env->{'psgi.multithread'} = Plack::Util::FALSE;
192 6         13 $env->{'psgi.multiprocess'} = Plack::Util::FALSE;
193 6         12 $env->{'psgi.streaming'} = Plack::Util::FALSE;
194 6         15 $env->{'psgi.nonblocking'} = Plack::Util::FALSE;
195 6         13 $env->{'psgix.harakiri'} = Plack::Util::TRUE;
196 6         10 $env->{'psgix.input.buffered'} = Plack::Util::TRUE;
197              
198             # inject the request id that compatible with Plack::Middleware::RequestId
199 6 50       13 if ($ctx) {
200 0         0 $env->{'psgix.request_id'} = $ctx->aws_request_id;
201 0         0 $env->{'HTTP_X_REQUEST_ID'} = $ctx->aws_request_id;
202             }
203              
204 6   100     30 my $body = encode_utf8($payload->{body} // '');
205 6 100       31 if ($payload->{isBase64Encoded}) {
206 2         28 $body = decode_base64 $body;
207             }
208 6         95 open my $input, "<", \$body;
209 6         16 $env->{'psgi.input'} = $input;
210 6   100     30 $env->{CONTENT_LENGTH} //= bytes::length($body);
211 6         21 my $requestContext = $payload->{requestContext};
212 6         17 $env->{REQUEST_METHOD} = $requestContext->{http}{method};
213 6         10 $env->{REQUEST_URI} = $payload->{rawPath};
214 6 100       29 if ($env->{QUERY_STRING}) {
215 2         7 $env->{REQUEST_URI} .= '?' . $env->{QUERY_STRING};
216             }
217 6         24 $env->{PATH_INFO} = $requestContext->{http}{path};
218 6         12 $env->{SCRIPT_NAME} = '';
219 6         33 return $env;
220             }
221              
222             sub format_output {
223 4     4 0 43776 my ($self, $response) = @_;
224 4         12 my ($status, $headers, $body) = @$response;
225              
226 4         7 my $singleValueHeaders = {};
227 4         6 my $multiValueHeaders = {};
228             Plack::Util::header_iter($headers, sub {
229 6     6   58 my ($k, $v) = @_;
230 6         17 $singleValueHeaders->{lc $k} = string $v;
231 6   100     38 push @{$multiValueHeaders->{lc $k} //= []}, string $v;
  6         33  
232 4         25 });
233              
234 4         51 my $content = '';
235 4 100       21 if (ref $body eq 'ARRAY') {
236 3         13 $content = join '', grep defined, @$body;
237             } else {
238 1         5 local $/ = \4096;
239 1         42 while (defined(my $buf = $body->getline)) {
240 1         80 $content .= $buf;
241             }
242 1         30 $body->close;
243             }
244              
245 4   50     21 my $type = $singleValueHeaders->{'content-type'} // 'application/octet-stream';
246 4         24 my $isBase64Encoded = $type !~ m(^text/.*|application/(:?json|javascript|xml))i;
247 4 100       10 if ($isBase64Encoded) {
248 1         10 $content = encode_base64 $content, '';
249             } else {
250             $content = try {
251             # is valid utf-8 string? try to decode as utf-8.
252 3     3   272 decode_utf8($content, Encode::FB_CROAK | Encode::LEAVE_SRC);
253             } catch {
254             # it looks not utf-8 encoding. fallback to base64 encoding.
255 1     1   47 $isBase64Encoded = 1;
256 1         6 encode_base64 $content, '';
257 3         19 };
258             }
259              
260             return +{
261 4         68 isBase64Encoded => bool $isBase64Encoded,
262             headers => $singleValueHeaders,
263             multiValueHeaders => $multiValueHeaders,
264             statusCode => number $status,
265             body => string $content,
266             }
267             }
268              
269             1;
270             __END__