File Coverage

blib/lib/PAGI/Server/EventValidator.pm
Criterion Covered Total %
statement 65 99 65.6
branch 59 116 50.8
condition 24 66 36.3
subroutine 15 22 68.1
pod 3 3 100.0
total 166 306 54.2


line stmt bran cond sub pod time code
1             package PAGI::Server::EventValidator;
2              
3 2     2   330895 use strict;
  2         5  
  2         90  
4 2     2   15 use warnings;
  2         5  
  2         207  
5              
6             our $VERSION = '0.002005';
7              
8 2     2   10 use Carp qw(croak);
  2         3  
  2         5400  
9              
10             # =============================================================================
11             # PAGI::Server::EventValidator - Dev-mode event field validation
12             #
13             # Per main.mkdn: Servers must raise exceptions if events are missing required
14             # fields or event fields are of the wrong type.
15             #
16             # This module provides optional validation for PAGI events. Enable in dev mode
17             # for early bug detection; disable in production for zero overhead.
18             # =============================================================================
19              
20             # =============================================================================
21             # HTTP Event Validation
22             # =============================================================================
23              
24             sub validate_http_send {
25 17     17 1 12402 my ($event) = @_;
26 17   50     34 my $type = $event->{type} // '';
27              
28 17 100       34 if ($type eq 'http.response.start') {
    100          
    50          
29 7         10 _validate_http_response_start($event);
30             }
31             elsif ($type eq 'http.response.body') {
32 7         9 _validate_http_response_body($event);
33             }
34             elsif ($type eq 'http.response.trailers') {
35 3         5 _validate_http_response_trailers($event);
36             }
37             # http.fullflush has no required fields beyond type
38             }
39              
40             sub _validate_http_response_start {
41 7     7   7 my ($event) = @_;
42              
43             # status is required (Int)
44             croak "http.response.start requires 'status' field"
45 7 100       152 unless exists $event->{status};
46             croak "http.response.start 'status' must be an integer"
47 6 100 100     192 unless defined $event->{status} && $event->{status} =~ /^\d+$/;
48              
49             # headers must be ArrayRef if present
50 4 100 66     11 if (exists $event->{headers} && defined $event->{headers}) {
51             croak "http.response.start 'headers' must be an array reference"
52 3 100       97 unless ref $event->{headers} eq 'ARRAY';
53             }
54             }
55              
56             sub _validate_http_response_body {
57 7     7   7 my ($event) = @_;
58              
59             # Exactly one of body, file, or fh must be present
60 7         18 my $has_body = exists $event->{body};
61 7         7 my $has_file = exists $event->{file};
62 7         7 my $has_fh = exists $event->{fh};
63 7         9 my $count = $has_body + $has_file + $has_fh;
64              
65 7 100       162 croak "http.response.body requires exactly one of body/file/fh (got $count)"
66             unless $count <= 1; # 0 is OK - defaults to empty body
67              
68             # offset must be integer if present
69 5 100 66     11 if (exists $event->{offset} && defined $event->{offset}) {
70             croak "http.response.body 'offset' must be an integer"
71 1 50       70 unless $event->{offset} =~ /^\d+$/;
72             }
73              
74             # length must be integer if present
75 4 100 66     13 if (exists $event->{length} && defined $event->{length}) {
76             croak "http.response.body 'length' must be an integer"
77 1 50       73 unless $event->{length} =~ /^\d+$/;
78             }
79             }
80              
81             sub _validate_http_response_trailers {
82 3     3   4 my ($event) = @_;
83              
84             # headers must be ArrayRef if present
85 3 100 66     10 if (exists $event->{headers} && defined $event->{headers}) {
86             croak "http.response.trailers 'headers' must be an array reference"
87 2 100       83 unless ref $event->{headers} eq 'ARRAY';
88             }
89             }
90              
91             # =============================================================================
92             # WebSocket Event Validation
93             # =============================================================================
94              
95             sub validate_websocket_send {
96 11     11 1 6083 my ($event) = @_;
97 11   50     23 my $type = $event->{type} // '';
98              
99 11 50       32 if ($type eq 'websocket.accept') {
    100          
    100          
    50          
    0          
    0          
100 0         0 _validate_websocket_accept($event);
101             }
102             elsif ($type eq 'websocket.send') {
103 4         5 _validate_websocket_send_event($event);
104             }
105             elsif ($type eq 'websocket.close') {
106 3         5 _validate_websocket_close($event);
107             }
108             elsif ($type eq 'websocket.keepalive') {
109 4         7 _validate_websocket_keepalive($event);
110             }
111             elsif ($type eq 'websocket.http.response.start') {
112 0         0 _validate_ws_denial_start($event);
113             }
114             elsif ($type eq 'websocket.http.response.body') {
115 0         0 _validate_ws_denial_body($event);
116             }
117             }
118              
119             sub _validate_websocket_accept {
120 0     0   0 my ($event) = @_;
121              
122             # headers must be ArrayRef if present
123 0 0 0     0 if (exists $event->{headers} && defined $event->{headers}) {
124             croak "websocket.accept 'headers' must be an array reference"
125 0 0       0 unless ref $event->{headers} eq 'ARRAY';
126             }
127             }
128              
129             sub _validate_websocket_send_event {
130 4     4   5 my ($event) = @_;
131              
132             # Exactly one of bytes or text must be present
133 4         5 my $has_bytes = exists $event->{bytes};
134 4         5 my $has_text = exists $event->{text};
135 4         6 my $count = $has_bytes + $has_text;
136              
137 4 100       153 croak "websocket.send requires exactly one of bytes/text (got $count)"
138             unless $count == 1;
139             }
140              
141             sub _validate_websocket_close {
142 3     3   3 my ($event) = @_;
143              
144             # code must be integer if present
145 3 100 66     12 if (exists $event->{code} && defined $event->{code}) {
146             croak "websocket.close 'code' must be an integer"
147 2 100       92 unless $event->{code} =~ /^\d+$/;
148             }
149             }
150              
151             sub _validate_websocket_keepalive {
152 4     4   5 my ($event) = @_;
153              
154             # interval is required (Number)
155             croak "websocket.keepalive requires 'interval' field"
156 4 100       85 unless exists $event->{interval};
157             croak "websocket.keepalive 'interval' must be a number"
158 3 100 66     96 unless defined $event->{interval} && $event->{interval} =~ /^[\d.]+$/;
159             }
160              
161             sub _validate_ws_denial_start {
162 0     0   0 my ($event) = @_;
163              
164             # status is required (Int)
165             croak "websocket.http.response.start requires 'status' field"
166 0 0       0 unless exists $event->{status};
167             croak "websocket.http.response.start 'status' must be an integer"
168 0 0 0     0 unless defined $event->{status} && $event->{status} =~ /^\d+$/;
169              
170             # headers must be ArrayRef if present
171 0 0 0     0 if (exists $event->{headers} && defined $event->{headers}) {
172             croak "websocket.http.response.start 'headers' must be an array reference"
173 0 0       0 unless ref $event->{headers} eq 'ARRAY';
174             }
175             }
176              
177             sub _validate_ws_denial_body {
178 0     0   0 my ($event) = @_;
179              
180             # more must be integer if present
181 0 0 0     0 if (exists $event->{more} && defined $event->{more}) {
182             croak "websocket.http.response.body 'more' must be an integer"
183 0 0       0 unless $event->{more} =~ /^\d+$/;
184             }
185             }
186              
187             # =============================================================================
188             # SSE Event Validation
189             # =============================================================================
190              
191             sub validate_sse_send {
192 10     10 1 5975 my ($event) = @_;
193 10   50     22 my $type = $event->{type} // '';
194              
195 10 50       28 if ($type eq 'sse.start') {
    100          
    100          
    50          
    0          
    0          
    0          
196 0         0 _validate_sse_start($event);
197             }
198             elsif ($type eq 'sse.send') {
199 4         7 _validate_sse_send_event($event);
200             }
201             elsif ($type eq 'sse.comment') {
202 3         6 _validate_sse_comment($event);
203             }
204             elsif ($type eq 'sse.keepalive') {
205 3         5 _validate_sse_keepalive($event);
206             }
207             elsif ($type eq 'sse.close') {
208 0         0 _validate_sse_close($event);
209             }
210             elsif ($type eq 'sse.http.response.start') {
211 0         0 _validate_sse_decline_start($event);
212             }
213             elsif ($type eq 'sse.http.response.body') {
214 0         0 _validate_sse_decline_body($event);
215             }
216             # http.fullflush has no required fields beyond type
217             }
218              
219             sub _validate_sse_decline_start {
220 0     0   0 my ($event) = @_;
221              
222             croak "sse.http.response.start requires 'status' field"
223 0 0 0     0 unless exists $event->{status} && defined $event->{status};
224             croak "sse.http.response.start 'status' must be an integer"
225 0 0       0 unless $event->{status} =~ /^\d+$/;
226 0 0 0     0 if (exists $event->{headers} && defined $event->{headers}) {
227             croak "sse.http.response.start 'headers' must be an array reference"
228 0 0       0 unless ref $event->{headers} eq 'ARRAY';
229             }
230             }
231              
232             sub _validate_sse_decline_body {
233 0     0   0 my ($event) = @_;
234              
235 0 0 0     0 if (exists $event->{more} && defined $event->{more}) {
236             croak "sse.http.response.body 'more' must be an integer"
237 0 0       0 unless $event->{more} =~ /^\d+$/;
238             }
239             }
240              
241             sub _validate_sse_close {
242 0     0   0 my ($event) = @_;
243              
244             # reason is optional and server-side only; if present it must be a string
245 0 0 0     0 if (exists $event->{reason} && defined $event->{reason}) {
246             croak "sse.close 'reason' must be a string"
247 0 0       0 if ref $event->{reason};
248             }
249             }
250              
251             sub _validate_sse_start {
252 0     0   0 my ($event) = @_;
253              
254             # status must be integer if present
255 0 0 0     0 if (exists $event->{status} && defined $event->{status}) {
256             croak "sse.start 'status' must be an integer"
257 0 0       0 unless $event->{status} =~ /^\d+$/;
258             }
259              
260             # headers must be ArrayRef if present
261 0 0 0     0 if (exists $event->{headers} && defined $event->{headers}) {
262             croak "sse.start 'headers' must be an array reference"
263 0 0       0 unless ref $event->{headers} eq 'ARRAY';
264             }
265             }
266              
267             sub _validate_sse_send_event {
268 4     4   23 my ($event) = @_;
269              
270             # data is required (String)
271             croak "sse.send requires 'data' field"
272 4 100       107 unless exists $event->{data};
273             croak "sse.send 'data' must be a string"
274 3 100 66     78 unless defined $event->{data} && !ref $event->{data};
275             }
276              
277             sub _validate_sse_comment {
278 3     3   2 my ($event) = @_;
279              
280             # comment is required (String)
281             croak "sse.comment requires 'comment' field"
282 3 100       84 unless exists $event->{comment};
283             croak "sse.comment 'comment' must be a string"
284 2 100 66     96 unless defined $event->{comment} && !ref $event->{comment};
285             }
286              
287             sub _validate_sse_keepalive {
288 3     3   4 my ($event) = @_;
289              
290             # interval is required (Number)
291             croak "sse.keepalive requires 'interval' field"
292 3 100       83 unless exists $event->{interval};
293             croak "sse.keepalive 'interval' must be a number"
294 2 100 66     80 unless defined $event->{interval} && $event->{interval} =~ /^[\d.]+$/;
295             }
296              
297             1;
298              
299             __END__