File Coverage

blib/lib/PAGI/Server/EventValidator.pm
Criterion Covered Total %
statement 65 85 76.4
branch 59 94 62.7
condition 24 54 44.4
subroutine 15 19 78.9
pod 3 3 100.0
total 166 255 65.1


line stmt bran cond sub pod time code
1             package PAGI::Server::EventValidator;
2              
3 2     2   293171 use strict;
  2         3  
  2         71  
4 2     2   10 use warnings;
  2         2  
  2         126  
5              
6             our $VERSION = '0.002000';
7              
8 2     2   10 use Carp qw(croak);
  2         2  
  2         2971  
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 12493 my ($event) = @_;
26 17   50     32 my $type = $event->{type} // '';
27              
28 17 100       30 if ($type eq 'http.response.start') {
    100          
    50          
29 7         11 _validate_http_response_start($event);
30             }
31             elsif ($type eq 'http.response.body') {
32 7         10 _validate_http_response_body($event);
33             }
34             elsif ($type eq 'http.response.trailers') {
35 3         6 _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   9 my ($event) = @_;
42              
43             # status is required (Int)
44             croak "http.response.start requires 'status' field"
45 7 100       154 unless exists $event->{status};
46             croak "http.response.start 'status' must be an integer"
47 6 100 100     172 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       74 unless ref $event->{headers} eq 'ARRAY';
53             }
54             }
55              
56             sub _validate_http_response_body {
57 7     7   9 my ($event) = @_;
58              
59             # Exactly one of body, file, or fh must be present
60 7         7 my $has_body = exists $event->{body};
61 7         8 my $has_file = exists $event->{file};
62 7         7 my $has_fh = exists $event->{fh};
63 7         7 my $count = $has_body + $has_file + $has_fh;
64              
65 7 100       153 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     12 if (exists $event->{offset} && defined $event->{offset}) {
70             croak "http.response.body 'offset' must be an integer"
71 1 50       71 unless $event->{offset} =~ /^\d+$/;
72             }
73              
74             # length must be integer if present
75 4 100 66     12 if (exists $event->{length} && defined $event->{length}) {
76             croak "http.response.body 'length' must be an integer"
77 1 50       70 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     11 if (exists $event->{headers} && defined $event->{headers}) {
86             croak "http.response.trailers 'headers' must be an array reference"
87 2 100       82 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 11117 my ($event) = @_;
97 11   50     28 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         7 _validate_websocket_send_event($event);
104             }
105             elsif ($type eq 'websocket.close') {
106 3         9 _validate_websocket_close($event);
107             }
108             elsif ($type eq 'websocket.keepalive') {
109 4         10 _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   6 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         4 my $count = $has_bytes + $has_text;
136              
137 4 100       225 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   5 my ($event) = @_;
143              
144             # code must be integer if present
145 3 100 66     17 if (exists $event->{code} && defined $event->{code}) {
146             croak "websocket.close 'code' must be an integer"
147 2 100       160 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       120 unless exists $event->{interval};
157             croak "websocket.keepalive 'interval' must be a number"
158 3 100 66     127 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 7440 my ($event) = @_;
193 10   50     26 my $type = $event->{type} // '';
194              
195 10 50       35 if ($type eq 'sse.start') {
    100          
    100          
    50          
196 0         0 _validate_sse_start($event);
197             }
198             elsif ($type eq 'sse.send') {
199 4         8 _validate_sse_send_event($event);
200             }
201             elsif ($type eq 'sse.comment') {
202 3         8 _validate_sse_comment($event);
203             }
204             elsif ($type eq 'sse.keepalive') {
205 3         6 _validate_sse_keepalive($event);
206             }
207             # http.fullflush has no required fields beyond type
208             }
209              
210             sub _validate_sse_start {
211 0     0   0 my ($event) = @_;
212              
213             # status must be integer if present
214 0 0 0     0 if (exists $event->{status} && defined $event->{status}) {
215             croak "sse.start 'status' must be an integer"
216 0 0       0 unless $event->{status} =~ /^\d+$/;
217             }
218              
219             # headers must be ArrayRef if present
220 0 0 0     0 if (exists $event->{headers} && defined $event->{headers}) {
221             croak "sse.start 'headers' must be an array reference"
222 0 0       0 unless ref $event->{headers} eq 'ARRAY';
223             }
224             }
225              
226             sub _validate_sse_send_event {
227 4     4   7 my ($event) = @_;
228              
229             # data is required (String)
230             croak "sse.send requires 'data' field"
231 4 100       124 unless exists $event->{data};
232             croak "sse.send 'data' must be a string"
233 3 100 66     98 unless defined $event->{data} && !ref $event->{data};
234             }
235              
236             sub _validate_sse_comment {
237 3     3   6 my ($event) = @_;
238              
239             # comment is required (String)
240             croak "sse.comment requires 'comment' field"
241 3 100       121 unless exists $event->{comment};
242             croak "sse.comment 'comment' must be a string"
243 2 100 66     97 unless defined $event->{comment} && !ref $event->{comment};
244             }
245              
246             sub _validate_sse_keepalive {
247 3     3   6 my ($event) = @_;
248              
249             # interval is required (Number)
250             croak "sse.keepalive requires 'interval' field"
251 3 100       121 unless exists $event->{interval};
252             croak "sse.keepalive 'interval' must be a number"
253 2 100 66     90 unless defined $event->{interval} && $event->{interval} =~ /^[\d.]+$/;
254             }
255              
256             1;
257              
258             __END__