http.bend
bend-kit-http@0.28.0.0 · 6,392 lines · 0 definitions
1# HTTP/1.1 and HTTP/2 client, with an HTTP/1.1 server. Source: https://github.com/paymog/bend-kit/tree/main/http
2import Base
3import bend-kit-http@0.28.0.0/admission.bend as Admission
4# By hash: bend-kit-url@0.4.1.0, -encoding@0.3.0.0, -json@0.5.0.1, -bytes@0.3.0.0, -zlib@0.2.0.0.
5import bend-kit-wire@0.4.4.0/wire.bend as Wire
6import bend-kit-http2@0.1.2.0/http2.bend as H2
7import bend-kit-http2@0.1.2.0/hpack.bend as Hpack
8import bend-kit-bytes@0.3.1.0/bytes.bend as HBytes
9import bend-kit-time@0.1.0.0/time.bend as Time
10import bend-kit-int@0.2.0.0/int.bend as Int
11import bend-kit-concurrency@0.1.0.0/concurrency.bend as Conc
12import bend-kit-url@0.4.1.0/url.bend as Url
13import bend-kit-encoding@0.3.0.0/encoding.bend as Enc
14import bend-kit-json@0.5.0.1/json.bend as Json
15import bend-kit-bytes@0.3.0.0/bytes.bend as Bytes
16import bend-kit-dns@0.5.0.0/dns.bend as Dns
17import bend-kit-zlib@0.2.0.0/zlib.bend as Zlib
18
19# HTTP/1.1 codec and client (RFC 9112) for http:// and https:// (OpenSSL 3 at run time).
20# parse: start-line → field lines → blank → body length (§6.3); chunked (§7.1).
21# Bodies are Bytes. The String parsers below are the spec: one Char per octet.
22# fetch reads until frame() says the response is whole. It returns Result, not Maybe.
23# Build with -o for big bodies: the `bend file.bend` runner overflows on ~30 KB strings; native binaries do not.
24# import bend-kit-http@0.22.0.0/http.bend as Http
25
26type Req is Type:
27 Req{method: String, path: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
28
29type Res is Type:
30 Res{status: U32, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
31
32# The body type and its conversions, so a caller needs no bytes import.
33def Body() -> Type:
34 Bytes.Bytes
35
36# A byte string (one Char per octet) to a body, and back.
37def from_string(+s: String) -> Bytes.Bytes:
38 Bytes.from_string(s)
39
40def to_string(b: Bytes.Bytes) -> String:
41 Bytes.to_string(b)
42
43def length(b: Bytes.Bytes) -> Bytes.Bytes & U32:
44 Bytes.length(b)
45
46# Why fetch failed. Wire errors keep the errno and the text the effect already had.
47# ponytail: 60 and 110 are ETIMEDOUT on macOS and Linux. Windows is out of scope.
48type Err is Data:
49 ErrUrl{}
50 ErrDns{}
51 ErrConnect{code: U32, why: String}
52 ErrTls{code: U32, why: String}
53 ErrRead{code: U32, why: String}
54 ErrWrite{code: U32, why: String}
55 ErrTimeout{}
56 ErrRedirect{}
57 ErrBad{}
58
59def err.late(+code: U32) -> Bool:
60 Bool.or(U32.is_eq(code, 60), U32.is_eq(code, 110))
61
62def err.pick(e: Err, late: Bool) -> Err:
63 match late:
64 case True{}:
65 ErrTimeout{}
66 case False{}:
67 e
68
69def err.or_late(code: U32, e: Err) -> Err:
70 err.pick(e, err.late(code))
71
72type Fields is Data:
73 FieldsBad{}
74 FieldsOk{m: Map<&2, List<&2, String>>}
75
76# One list per field name, in arrival order. header() is the first value.
77# Set-Cookie is never joined. Encode writes one line per value.
78def empty() -> Map<&2, List<&2, String>>:
79 Map.new(&2, List<&2, String>)
80
81def fields.of(r: Map<&2, List<&2, String>> & List<&2, String>) -> List<&2, String>:
82 (h, xs) = r
83 xs
84
85def fields(+h: Map<&2, List<&2, String>>, k: String) -> List<&2, String>:
86 fields.of(Map.get(List<&2, String>, Nil{}, h, k))
87
88def header.first(xs: List<&2, String>) -> String:
89 match xs:
90 case Nil{}:
91 ""
92 case Con{v, t}:
93 v
94
95def header(+h: Map<&2, List<&2, String>>, k: String) -> String:
96 header.first(fields(h, k))
97
98def field.last(xs: List<&2, String>) -> String:
99 match xs:
100 case Nil{}:
101 ""
102 case Con{v, Nil{}}:
103 v
104 case Con{v, t}:
105 field.last(t)
106
107# Transfer-Encoding is a list; chunked, when present, is the last coding.
108def header.last(+h: Map<&2, List<&2, String>>, k: String) -> String:
109 field.last(fields(h, k))
110
111def snoc(xs: List<&2, String>, v: String) -> List<&2, String>:
112 match xs:
113 case Nil{}:
114 [v]
115 case Con{h, t}:
116 Con{h, snoc(t, v)}
117
118def set(m: Map<&2, List<&2, String>>, k: String, v: String) -> Map<&2, List<&2, String>>:
119 Map.set(&2, List<&2, String>, m, k, [v])
120
121def add(+m: Map<&2, List<&2, String>>, +k: String, v: String) -> Map<&2, List<&2, String>>:
122 Map.set(&2, List<&2, String>, m, k, snoc(fields(m, k), v))
123
124def sanitize.cons(ch: Char, rest: String, drop: Bool) -> String:
125 match drop:
126 case True{}:
127 rest
128 case False{}:
129 SCon{ch, rest}
130
131def sanitize(s: String) -> String:
132 match s:
133 case SNil{}:
134 SNil{}
135 case SCon{Chr{+c}, t}:
136 sanitize.cons(Chr{c}, sanitize(t), Bool.or(U32.is_eq(c, 13), U32.is_eq(c, 10)))
137
138def drop_cr.last.if(cr: Bool, c: U32) -> String:
139 match cr:
140 case True{}:
141 SNil{}
142 case False{}:
143 SCon{Chr{c}, SNil{}}
144
145def drop_cr.last(+c: U32) -> String:
146 drop_cr.last.if(U32.is_eq(c, 13), c)
147
148# prev is the char before s; it is kept unless it is a final CR.
149def drop_cr.go(s: String, prev: U32) -> String:
150 match s:
151 case SNil{}:
152 drop_cr.last(prev)
153 case SCon{Chr{c}, t}:
154 SCon{Chr{prev}, drop_cr.go(t, c)}
155
156def drop_cr(s: String) -> String:
157 match s:
158 case SNil{}:
159 SNil{}
160 case SCon{Chr{c}, t}:
161 drop_cr.go(t, c)
162
163# w holds the last four octets; a char past 255 clears it.
164def blank_end.go(s: String, w: U32) -> Bool:
165 match s:
166 case SNil{}:
167 U32.is_eq(w, 218762506)
168 case SCon{Chr{+c}, t}:
169 blank_end.go(t, Bool.pick(U32, U32.is_lt(c, 256), (w * 256 + c : U32), 0))
170
171# String.ends_with(s, "\r\n\r\n") in one pass, with no reversed copy.
172def blank_end(s: String) -> Bool:
173 blank_end.go(s, 0)
174
175def trim_end.cons(h: Char, r: String, space: Bool) -> String:
176 match r:
177 case SNil{}:
178 match space:
179 case True{}:
180 SNil{}
181 case False{}:
182 SCon{h, SNil{}}
183 case SCon{a, t}:
184 SCon{h, SCon{a, t}}
185
186# String.trim_end without the two reversed copies.
187def trim_end(s: String) -> String:
188 match s:
189 case SNil{}:
190 SNil{}
191 case SCon{+h, t}:
192 trim_end.cons(h, trim_end(t), Char.is_space(h))
193
194def trim(s: String) -> String:
195 trim_end(String.trim_start(s))
196
197# Bool.pick evaluates both arms; a split that recursed inside it would reverse acc at every byte.
198def take.cut(acc: String, rest: String) -> String & String:
199 (String.reverse(String.drop(acc, 1n)), rest)
200
201# hit: the last char pushed onto acc was the stop char.
202def take_sp.go(s: String, acc: String, hit: Bool) -> String & String:
203 match s:
204 case SNil{}:
205 match hit:
206 case True{}:
207 take.cut(acc, SNil{})
208 case False{}:
209 (String.reverse(acc), SNil{})
210 case SCon{Chr{+c}, t}:
211 match hit:
212 case True{}:
213 take.cut(acc, SCon{Chr{c}, t})
214 case False{}:
215 take_sp.go(t, SCon{Chr{c}, acc}, U32.is_eq(c, 32))
216
217def take_sp(s: String) -> String & String:
218 take_sp.go(s, SNil{}, False{})
219
220def start_line.ver(m: String, pv: String & String) -> String & String & String:
221 (p, v) = pv
222 (m, p, drop_cr(v))
223
224def start_line.rest(mr: String & String) -> String & String & String:
225 (m, r) = mr
226 start_line.ver(m, take_sp(r))
227
228def start_line(s: String) -> String & String & String:
229 start_line.rest(take_sp(s))
230
231def split_at_blank.go(s: String, e: Bool, w: U32, acc: String) -> String & String:
232 match s:
233 case SNil{}:
234 (String.reverse(acc), SNil{})
235 case SCon{Chr{+a}, t}:
236 match e:
237 case True{}:
238 (String.reverse(acc), SCon{Chr{a}, t})
239 case False{}:
240 +w2 = (w * 256 + a : U32)
241 split_at_blank.go(t, U32.is_eq(w2, 218762506), w2, SCon{Chr{a}, acc})
242
243# split_at_blank, plus whether the head ends in the blank line.
244def split_at_blank.flag.go(+raw: String, s: String, off: Nat, w: U32, e: Bool) -> String & String & Bool:
245 match s:
246 case SNil{}:
247 (String.take(raw, off), SNil{}, e)
248 case SCon{Chr{+a}, t}:
249 match e:
250 case True{}:
251 (String.take(raw, off), SCon{Chr{a}, t}, True{})
252 case False{}:
253 +w2 = (w * 256 + a : U32)
254 +off1 = (1n + off : Nat)
255 split_at_blank.flag.go(raw, t, off1, w2, U32.is_eq(w2, 218762506))
256
257def split_at_blank.pair(r: String & String & Bool) -> String & String:
258 (head, rest, whole) = r
259 (head, rest)
260
261def split_at_blank(+s: String) -> String & String:
262 split_at_blank.pair(split_at_blank.flag.go(s, s, 0n, 0, False{}))
263
264def split_colon.go(s: String, acc: String, hit: Bool) -> String & String:
265 match s:
266 case SNil{}:
267 match hit:
268 case True{}:
269 take.cut(acc, SNil{})
270 case False{}:
271 (String.reverse(acc), SNil{})
272 case SCon{Chr{+c}, t}:
273 match hit:
274 case True{}:
275 take.cut(acc, SCon{Chr{c}, t})
276 case False{}:
277 split_colon.go(t, SCon{Char.to_lower(Chr{c}), acc}, U32.is_eq(c, 58))
278
279def split_colon(+s: String) -> String & String:
280 split_colon.go(s, SNil{}, False{})
281
282def has_header.of(r: Map<&2, List<&2, String>> & Bool) -> Bool:
283 (h, b) = r
284 b
285
286def has_header(+h: Map<&2, List<&2, String>>, k: String) -> Bool:
287 has_header.of(Map.has(&2, List<&2, String>, h, k))
288
289def folded(+line: String) -> Bool:
290 Bool.or(String.starts_with(line, " "), String.starts_with(line, "\t"))
291
292def tracked(+k: String) -> Bool:
293 Bool.or(String.eq(k, "host"), String.eq(k, "content-length"))
294
295def fields_put.dup(m: Map<&2, List<&2, String>>, k: String, v: String, bad: Bool) -> Fields:
296 match bad:
297 case True{}:
298 FieldsBad{}
299 case False{}:
300 FieldsOk{add(m, k, v)}
301
302def fields_put.tracked(+m: Map<&2, List<&2, String>>, +k: String, v: String, t: Bool) -> Fields:
303 match t:
304 case True{}:
305 fields_put.dup(m, k, v, has_header(m, k))
306 case False{}:
307 FieldsOk{add(m, k, v)}
308
309def fields_put.key(+m: Map<&2, List<&2, String>>, +k: String, v: String) -> Fields:
310 fields_put.tracked(m, k, v, tracked(k))
311
312def fields_put.kv(m: Map<&2, List<&2, String>>, kv: String & String) -> Fields:
313 (k, v) = kv
314 fields_put.key(m, k, trim(v))
315
316def fields_put.fold(m: Map<&2, List<&2, String>>, line: String, fold: Bool) -> Fields:
317 match fold:
318 case True{}:
319 FieldsBad{}
320 case False{}:
321 fields_put.kv(m, split_colon(line))
322
323def fields_put.empty(m: Map<&2, List<&2, String>>, +line: String, e: Bool) -> Fields:
324 match e:
325 case True{}:
326 FieldsOk{m}
327 case False{}:
328 fields_put.fold(m, line, folded(line))
329
330def fields_put.ok(m: Map<&2, List<&2, String>>, +line: String) -> Fields:
331 fields_put.empty(m, line, String.is_empty(line))
332
333def fields_put(acc: Fields, line: String) -> Fields:
334 match acc:
335 case FieldsBad{}:
336 FieldsBad{}
337 case FieldsOk{m}:
338 fields_put.ok(m, line)
339
340def parse.headers.done(acc: Fields) -> Maybe<&2, Map<&2, List<&2, String>>>:
341 match acc:
342 case FieldsBad{}:
343 None{}
344 case FieldsOk{m}:
345 Some{m}
346
347
348def parse.headers.scan.line(acc: String, fields: Fields) -> Fields:
349 match acc:
350 case SCon{Chr{13}, t}:
351 fields_put(fields, String.reverse(t))
352 case other:
353 fields_put(fields, String.reverse(other))
354
355def parse.headers.scan(s: String, acc: String, fields: Fields) -> Fields:
356 match s:
357 case SNil{}:
358 parse.headers.scan.line(acc, fields)
359 case SCon{Chr{10}, t}:
360 parse.headers.scan(t, SNil{}, parse.headers.scan.line(acc, fields))
361 case SCon{c, t}:
362 parse.headers.scan(t, SCon{c, acc}, fields)
363
364def parse.headers.raw(s: String) -> Maybe<&2, Map<&2, List<&2, String>>>:
365 parse.headers.done(parse.headers.scan(s, SNil{}, FieldsOk{empty()}))
366
367def parse.first(s: String, acc: String) -> String & String:
368 match s:
369 case SNil{}:
370 (String.reverse(acc), SNil{})
371 case SCon{Chr{10}, t}:
372 (String.reverse(acc), t)
373 case SCon{c, t}:
374 parse.first(t, SCon{c, acc})
375
376def parse_u32.digit(+c: U32) -> Bool:
377 Bool.and(U32.is_le(48, c), U32.is_le(c, 57))
378
379def parse_u32.add(acc: U32, c: U32) -> U32:
380 (acc * 10 + (c - 48 : U32) : U32)
381
382def parse_u32.done(acc: U32, bad: Bool) -> Maybe<&2, U32>:
383 match bad:
384 case True{}:
385 None{}
386 case False{}:
387 Some{acc}
388
389def parse_u32.go(s: String, acc: U32, bad: Bool) -> Maybe<&2, U32>:
390 match s:
391 case SNil{}:
392 parse_u32.done(acc, bad)
393 case SCon{Chr{+c}, t}:
394 parse_u32.go(t, parse_u32.add(acc, c), Bool.or(bad, Bool.not(parse_u32.digit(c))))
395
396def parse_u32(s: String) -> Maybe<&2, U32>:
397 match s:
398 case SNil{}:
399 None{}
400 case SCon{Chr{+c}, t}:
401 parse_u32.go(t, parse_u32.add(0, c), Bool.not(parse_u32.digit(c)))
402
403# More: a valid prefix. Bad: cannot become a body. Body: a whole chunked body.
404type Hold is Data:
405 HoldMore{}
406 HoldBad{}
407 HoldBody{b: String}
408 HoldUntil{b: String}
409
410def is_hex(+c: U32) -> Bool:
411 Bool.or(parse_u32.digit(c), Bool.or(Bool.and(U32.is_le(97, c), U32.is_le(c, 102)), Bool.and(U32.is_le(65, c), U32.is_le(c, 70))))
412
413def hexv(+c: U32) -> U32:
414 Bool.pick(U32, parse_u32.digit(c), (c - 48 : U32), Bool.pick(U32, U32.is_le(c, 70), (c - 55 : U32), (c - 87 : U32)))
415
416# A chunked body decoder that reads each byte once, so a body fed in pieces
417# costs O(bytes) in total. Tr{j}: j bytes of the closing CRLF CRLF matched.
418type Dc is Data:
419 DcSize{acc: U32, seen: Bool}
420 DcExt{n: U32}
421 DcSizeLf{n: U32}
422 DcData{k: U32}
423 DcDataCr{}
424 DcDataLf{}
425 DcTr{j: U32}
426 DcDone{}
427 DcBad{}
428
429# st: where the decoder is. racc: the body so far, reversed. rest: bytes after a Done body.
430type Dco is Data:
431 Dco{st: Dc, racc: String, rest: String}
432
433def dc.start() -> Dc:
434 DcSize{0, False{}}
435
436def dc.size.semi(+n: U32, semi: Bool) -> Dc:
437 match semi:
438 case True{}:
439 DcExt{n}
440 case False{}:
441 DcBad{}
442
443def dc.size.cr(+n: U32, +c: U32, cr: Bool) -> Dc:
444 match cr:
445 case True{}:
446 DcSizeLf{n}
447 case False{}:
448 dc.size.semi(n, U32.is_eq(c, 59))
449
450def dc.size.end(+n: U32, +c: U32, seen: Bool) -> Dc:
451 match seen:
452 case False{}:
453 DcBad{}
454 case True{}:
455 dc.size.cr(n, c, U32.is_eq(c, 13))
456
457# A size that would overflow 32 bits ends the digits, and size.end then refuses it.
458def dc.size(+acc: U32, seen: Bool, +c: U32, digit: Bool) -> Dc:
459 match digit:
460 case True{}:
461 DcSize{(acc * 16 + hexv(c) : U32), True{}}
462 case False{}:
463 dc.size.end(acc, c, seen)
464
465# RFC 9112 §7.1.1: recipients ignore unknown chunk extensions; a bare LF is not CRLF.
466def dc.ext.lf(+n: U32, lf: Bool) -> Dc:
467 match lf:
468 case True{}:
469 DcBad{}
470 case False{}:
471 DcExt{n}
472
473def dc.ext(+n: U32, +c: U32, cr: Bool) -> Dc:
474 match cr:
475 case True{}:
476 DcSizeLf{n}
477 case False{}:
478 dc.ext.lf(n, U32.is_eq(c, 10))
479
480def dc.sized(+n: U32, zero: Bool) -> Dc:
481 match zero:
482 case True{}:
483 DcTr{2}
484 case False{}:
485 DcData{n}
486
487def dc.size.lf(+n: U32, lf: Bool) -> Dc:
488 match lf:
489 case True{}:
490 dc.sized(n, U32.is_eq(n, 0))
491 case False{}:
492 DcBad{}
493
494# k data bytes are left and m of them were just read.
495def dc.data(+k: U32, +m: U32) -> Dc:
496 Bool.pick(Dc, U32.is_le(k, m), DcDataCr{}, DcData{(k - m : U32)})
497
498def dc.pick(ok: Bool, next: Dc) -> Dc:
499 match ok:
500 case True{}:
501 next
502 case False{}:
503 DcBad{}
504
505# ponytail: trailer fields are dropped unparsed (§7.1.2 allows discarding)
506def dc.tr.hit(+j: U32) -> Dc:
507 Bool.pick(Dc, U32.is_eq(j, 3), DcDone{}, DcTr{(j + 1 : U32)})
508
509def dc.tr(+j: U32, +c: U32, hit: Bool) -> Dc:
510 match hit:
511 case True{}:
512 dc.tr.hit(j)
513 case False{}:
514 Bool.pick(Dc, U32.is_eq(c, 13), DcTr{1}, DcTr{0})
515
516def dc.tr.want(+j: U32) -> U32:
517 Bool.pick(U32, U32.is_eq(U32.mod(j, 2), 0), 13, 10)
518
519def dc.byte(h: Char) -> U32:
520 Chr{c} = h
521 c
522
523# One byte c. Done and Bad never look at it, and a data byte is not inspected.
524def dc.step(st: Dc, +c: U32) -> Dc:
525 match st:
526 case DcBad{}:
527 DcBad{}
528 case DcSize{+acc, seen}:
529 dc.size(acc, seen, c, Bool.and(is_hex(c), U32.is_le(acc, 268435455)))
530 case DcExt{+n}:
531 dc.ext(n, c, U32.is_eq(c, 13))
532 case DcSizeLf{+n}:
533 dc.size.lf(n, U32.is_eq(c, 10))
534 case DcDataCr{}:
535 dc.pick(U32.is_eq(c, 13), DcDataLf{})
536 case DcDataLf{}:
537 dc.pick(U32.is_eq(c, 10), dc.start())
538 case DcTr{+j}:
539 dc.tr(j, c, U32.is_eq(c, dc.tr.want(j)))
540 case DcData{+k}:
541 dc.data(k, 1)
542 case DcDone{}:
543 DcDone{}
544
545def dc.live(st: Dc) -> Bool:
546 match st:
547 case DcDone{}:
548 False{}
549 case DcBad{}:
550 False{}
551 case DcSize{a, b}:
552 True{}
553 case DcExt{n}:
554 True{}
555 case DcSizeLf{n}:
556 True{}
557 case DcData{k}:
558 True{}
559 case DcDataCr{}:
560 True{}
561 case DcDataLf{}:
562 True{}
563 case DcTr{j}:
564 True{}
565
566def dc.feed(s: String, st: Dc, racc: String) -> Dco:
567 match s:
568 case SNil{}:
569 Dco{st, racc, ""}
570 case SCon{h, t}:
571 match st:
572 case DcBad{}:
573 Dco{DcBad{}, racc, ""}
574 case DcDone{}:
575 Dco{DcDone{}, racc, SCon{h, t}}
576 case DcData{+k}:
577 dc.feed(t, dc.data(k, 1), SCon{h, racc})
578 case DcSize{+acc, seen}:
579 dc.feed(t, dc.step(DcSize{acc, seen}, dc.byte(h)), racc)
580 case DcExt{+n}:
581 dc.feed(t, dc.step(DcExt{n}, dc.byte(h)), racc)
582 case DcSizeLf{+n}:
583 dc.feed(t, dc.step(DcSizeLf{n}, dc.byte(h)), racc)
584 case DcDataCr{}:
585 dc.feed(t, dc.step(DcDataCr{}, dc.byte(h)), racc)
586 case DcDataLf{}:
587 dc.feed(t, dc.step(DcDataLf{}, dc.byte(h)), racc)
588 case DcTr{+j}:
589 dc.feed(t, dc.step(DcTr{j}, dc.byte(h)), racc)
590
591def chunk.hold(o: Dco) -> Hold:
592 Dco{st, racc, rest} = o
593 match st:
594 case DcDone{}:
595 HoldBody{String.reverse(racc)}
596 case DcBad{}:
597 HoldBad{}
598 case DcSize{a, b}:
599 HoldMore{}
600 case DcExt{n}:
601 HoldMore{}
602 case DcSizeLf{n}:
603 HoldMore{}
604 case DcData{k}:
605 HoldMore{}
606 case DcDataCr{}:
607 HoldMore{}
608 case DcDataLf{}:
609 HoldMore{}
610 case DcTr{j}:
611 HoldMore{}
612
613def chunk.live(s: String) -> Hold:
614 chunk.hold(dc.feed(s, dc.start(), ""))
615
616def chunk.rest(o: Dco) -> Maybe<&2, String>:
617 Dco{st, racc, rest} = o
618 match st:
619 case DcDone{}:
620 Some{rest}
621 case DcBad{}:
622 None{}
623 case DcSize{a, b}:
624 None{}
625 case DcExt{n}:
626 None{}
627 case DcSizeLf{n}:
628 None{}
629 case DcData{k}:
630 None{}
631 case DcDataCr{}:
632 None{}
633 case DcDataLf{}:
634 None{}
635 case DcTr{j}:
636 None{}
637
638def chunk.suffix(s: String) -> Maybe<&2, String>:
639 chunk.rest(dc.feed(s, dc.start(), ""))
640
641def chunk.decode.hold(h: Hold) -> Maybe<&2, String>:
642 match h:
643 case HoldMore{}:
644 None{}
645 case HoldBad{}:
646 None{}
647 case HoldUntil{b}:
648 None{}
649 case HoldBody{b}:
650 Some{b}
651
652def chunk.decode(s: String) -> Maybe<&2, String>:
653 chunk.decode.hold(chunk.live(s))
654
655def bytes.snd(r: Bytes.Bytes & Bytes.Bytes) -> Bytes.Bytes:
656 (a, b) = r
657 b
658
659def found.at(+from: U32, m: Maybe<&2, U32>) -> Maybe<&2, U32>:
660 match m:
661 case None{}:
662 None{}
663 case Some{+j}:
664 Some{(from + j : U32)}
665
666# A chunked body decoded from piece[i..]: a data run is sliced whole, and every other byte steps dc.
667type Cs is Type:
668 Cs{piece: Bytes.Bytes, i: U32, st: Dc, parts: List<&1, Bytes.Bytes>}
669
670# st: where the decoder stopped. parts: the data so far, newest first. rest: the bytes after a Done body.
671type Ck is Type:
672 Ck{st: Dc, parts: List<&1, Bytes.Bytes>, rest: Bytes.Bytes}
673
674def ck.next(+len: U32, +i: U32, +st: Dc, piece: Bytes.Bytes, parts: List<&1, Bytes.Bytes>) -> Bool & Cs:
675 (Bool.and(U32.is_lt(i, len), dc.live(st)), Cs{piece, i, st, parts})
676
677def ck.data(+len: U32, +i: U32, +k: U32, +m: U32, parts: List<&1, Bytes.Bytes>, r: Bytes.Bytes & Bytes.Bytes) -> Bool & Cs:
678 (piece, run) = r
679 ck.next(len, (i + m : U32), dc.data(k, m), piece, Con{run, parts})
680
681def ck.byte(+len: U32, +i: U32, st: Dc, parts: List<&1, Bytes.Bytes>, r: Bytes.Bytes & Maybe<&2, U32>) -> Bool & Cs:
682 (piece, m) = r
683 match m:
684 case None{}:
685 ck.next(len, i, DcBad{}, piece, parts)
686 case Some{+c}:
687 ck.next(len, (i + 1 : U32), dc.step(st, c), piece, parts)
688
689def ck.step(+len: U32, cs: Cs) -> Bool & Cs:
690 Cs{piece, +i, st, parts} = cs
691 match st:
692 case DcData{+k}:
693 +m = U32.min(k, (len - i : U32))
694 ck.data(len, i, k, m, parts, Bytes.slice(piece, i, m))
695 case DcDone{}:
696 (False{}, Cs{piece, i, DcDone{}, parts})
697 case DcBad{}:
698 (False{}, Cs{piece, i, DcBad{}, parts})
699 case DcSize{+acc, seen}:
700 ck.byte(len, i, DcSize{acc, seen}, parts, Bytes.get(piece, i))
701 case DcExt{+n}:
702 ck.byte(len, i, DcExt{n}, parts, Bytes.get(piece, i))
703 case DcSizeLf{+n}:
704 ck.byte(len, i, DcSizeLf{n}, parts, Bytes.get(piece, i))
705 case DcDataCr{}:
706 ck.byte(len, i, DcDataCr{}, parts, Bytes.get(piece, i))
707 case DcDataLf{}:
708 ck.byte(len, i, DcDataLf{}, parts, Bytes.get(piece, i))
709 case DcTr{+j}:
710 ck.byte(len, i, DcTr{j}, parts, Bytes.get(piece, i))
711
712def ck.rest(st: Dc, parts: List<&1, Bytes.Bytes>, r: Bytes.Bytes & Bytes.Bytes) -> Ck:
713 (piece, rest) = r
714 Ck{st, parts, rest}
715
716def ck.end(+len: U32, cs: Cs) -> Ck:
717 Cs{piece, +i, st, parts} = cs
718 ck.rest(st, parts, Bytes.slice(piece, i, (len - i : U32)))
719
720# Each step reads at least one byte, so len steps are enough.
721def ck.feed(f: Nat, +len: U32, r: Bool & Cs) -> Ck:
722 match f:
723 case 0n:
724 (go, cs) = r
725 ck.end(len, cs)
726 case 1n+p:
727 (go, cs) = r
728 match go:
729 case False{}:
730 ck.end(len, cs)
731 case True{}:
732 ck.feed(p, len, ck.step(len, cs))
733
734def ck(piece: Bytes.Bytes, +st: Dc, parts: List<&1, Bytes.Bytes>) -> Ck:
735 Bytes.Bytes{+len, buf} = piece
736 ck.feed(U32.to_nat(len), len, ck.next(len, 0, st, Bytes.Bytes{len, buf}, parts))
737
738def parse.res.cl.have(+rest: String, +k: Nat, short: Bool) -> Hold:
739 match short:
740 case True{}:
741 HoldMore{}
742 case False{}:
743 HoldBody{String.take(rest, k)}
744
745def parse.res.cl.k(+rest: String, +k: Nat) -> Hold:
746 parse.res.cl.have(rest, k, Nat.is_lt(String.length(rest), k))
747
748def parse.res.cl.n(rest: String, n: Maybe<&2, U32>) -> Hold:
749 match n:
750 case None{}:
751 HoldBad{}
752 case Some{k}:
753 parse.res.cl.k(rest, U32.to_nat(k))
754
755def parse.body.cl(+h: Map<&2, List<&2, String>>, rest: String, hascl: Bool) -> Hold:
756 match hascl:
757 case False{}:
758 HoldBody{""}
759 case True{}:
760 parse.res.cl.n(rest, parse_u32(header(h, "content-length")))
761
762# RFC 9112 §6.3 (4): a request coding other than chunked cannot be framed.
763def parse.body.chunked.eq(rest: String, ok: Bool) -> Hold:
764 match ok:
765 case False{}:
766 HoldBad{}
767 case True{}:
768 chunk.live(rest)
769
770def parse.body.chunked.val(te: String, rest: String) -> Hold:
771 parse.body.chunked.eq(rest, String.eq(String.to_lower(te), "chunked"))
772
773def parse.body.chunked(+h: Map<&2, List<&2, String>>, rest: String, hascl: Bool) -> Hold:
774 match hascl:
775 case True{}:
776 HoldBad{}
777 case False{}:
778 parse.body.chunked.val(header.last(h, "transfer-encoding"), rest)
779
780def parse.body.te(+h: Map<&2, List<&2, String>>, rest: String, te: Bool) -> Hold:
781 match te:
782 case True{}:
783 parse.body.chunked(h, rest, has_header(h, "content-length"))
784 case False{}:
785 parse.body.cl(h, rest, has_header(h, "content-length"))
786
787def parse.body(+h: Map<&2, List<&2, String>>, rest: String) -> Hold:
788 parse.body.te(h, rest, has_header(h, "transfer-encoding"))
789
790# Bad: never a request. More: the head is not whole; read on. Head: the head is whole
791# and valid, and the body is still coming (req.body is empty). Req: a whole request.
792type Got is Type:
793 GotBad{}
794 GotMore{}
795 GotHead{req: Req}
796 GotReq{req: Req}
797
798def parse.finish(method: String, path: String, h: Map<&2, List<&2, String>>, body: Hold) -> Got:
799 match body:
800 case HoldBad{}:
801 GotBad{}
802 case HoldMore{}:
803 GotHead{Req{method, path, h, Bytes.new(0)}}
804 case HoldUntil{b}:
805 GotBad{}
806 case HoldBody{b}:
807 GotReq{Req{method, path, h, Bytes.from_string(b)}}
808
809def parse.host(method: String, path: String, +h: Map<&2, List<&2, String>>, rest: String, has: Bool) -> Got:
810 match has:
811 case False{}:
812 GotBad{}
813 case True{}:
814 parse.finish(method, path, h, parse.body(h, rest))
815
816# RFC 9112 §3.2: only HTTP/1.1 requires Host.
817def parse.fields(method: String, path: String, rest: String, v11: Bool, fs: Maybe<&2, Map<&2, List<&2, String>>>) -> Got:
818 match fs:
819 case None{}:
820 GotBad{}
821 case Some{+h}:
822 parse.host(method, path, h, rest, Bool.or(Bool.not(v11), has_header(h, "host")))
823
824def target_ok(+p: String) -> Bool:
825 Bool.or(String.starts_with(p, "/"), Bool.or(String.eq(p, "*"), String.starts_with(p, "http://")))
826
827def parse.target(method: String, +path: String, headers: String, rest: String, v11: Bool, ok: Bool) -> Got:
828 match ok:
829 case False{}:
830 GotBad{}
831 case True{}:
832 parse.fields(method, path, rest, v11, parse.headers.raw(headers))
833
834def parse.ver(method: String, +path: String, +v: String, headers: String, rest: String, ok: Bool) -> Got:
835 match ok:
836 case False{}:
837 GotBad{}
838 case True{}:
839 parse.target(method, path, headers, rest, String.eq(v, "HTTP/1.1"), target_ok(path))
840
841def parse.empty_method(method: String, path: String, +v: String, headers: String, rest: String, empty: Bool) -> Got:
842 match empty:
843 case True{}:
844 GotBad{}
845 case False{}:
846 parse.ver(method, path, v, headers, rest, Bool.or(String.eq(v, "HTTP/1.1"), String.eq(v, "HTTP/1.0")))
847
848def parse.start3(mpv: String & String & String, headers: String, rest: String) -> Got:
849 (+method, path, v) = mpv
850 parse.empty_method(method, path, v, headers, rest, String.is_empty(method))
851
852def parse.lines(lr: String & String, rest: String) -> Got:
853 (line, headers) = lr
854 parse.start3(start_line(line), headers, rest)
855
856
857def parse.head(+head: String, rest: String, whole: Bool) -> Got:
858 match whole:
859 case False{}:
860 GotMore{}
861 case True{}:
862 parse.lines(parse.first(head, SNil{}), rest)
863
864def parse.of(hb: String & String & Bool) -> Got:
865 (head, rest, whole) = hb
866 parse.head(head, rest, whole)
867
868# serve reads until this is not GotMore.
869def parse.got(+raw: String) -> Got:
870 parse.of(split_at_blank.flag.go(raw, raw, 0n, 0, False{}))
871
872
873def parse.req(g: Got) -> Maybe<&1, Req>:
874 match g:
875 case GotReq{req}:
876 Some{req}
877 case GotBad{}:
878 None{}
879 case GotMore{}:
880 None{}
881 case GotHead{req}:
882 None{}
883
884def parse(raw: String) -> Maybe<&1, Req>:
885 parse.req(parse.got(raw))
886
887def parse.res.cl(+h: Map<&2, List<&2, String>>, rest: String, hascl: Bool) -> Hold:
888 match hascl:
889 case False{}:
890 HoldBody{rest}
891 case True{}:
892 parse.res.cl.n(rest, parse_u32(header(h, "content-length")))
893
894def parse.res.chunked.eq(rest: String, ok: Bool) -> Hold:
895 match ok:
896 case False{}:
897 HoldUntil{rest}
898 case True{}:
899 chunk.live(rest)
900
901def parse.res.chunked.val(te: String, rest: String) -> Hold:
902 parse.res.chunked.eq(rest, String.eq(String.to_lower(te), "chunked"))
903
904def parse.res.chunked(+h: Map<&2, List<&2, String>>, rest: String, hascl: Bool) -> Hold:
905 match hascl:
906 case True{}:
907 HoldBad{}
908 case False{}:
909 parse.res.chunked.val(header.last(h, "transfer-encoding"), rest)
910
911def parse.res.te(+h: Map<&2, List<&2, String>>, rest: String, te: Bool) -> Hold:
912 match te:
913 case True{}:
914 parse.res.chunked(h, rest, has_header(h, "content-length"))
915 case False{}:
916 parse.res.cl(h, rest, has_header(h, "content-length"))
917
918def parse.res.body(+h: Map<&2, List<&2, String>>, rest: String) -> Hold:
919 parse.res.te(h, rest, has_header(h, "transfer-encoding"))
920
921# Bad: never a message. More: a valid prefix; read on. Done: a whole response.
922type Frame is Type:
923 FrameBad{}
924 FrameMore{}
925 FrameDone{res: Res}
926
927# RFC 9112 §8: a message cut short by close is incomplete, not valid.
928def frame.cut(closed: Bool) -> Frame:
929 match closed:
930 case True{}:
931 FrameBad{}
932 case False{}:
933 FrameMore{}
934
935def frame.wait(res: Res, wait: Bool) -> Frame:
936 match wait:
937 case True{}:
938 FrameMore{}
939 case False{}:
940 FrameDone{res}
941
942def frame.done(status: U32, h: Map<&2, List<&2, String>>, body: Hold, +closed: Bool, open: Bool) -> Frame:
943 match body:
944 case HoldBad{}:
945 FrameBad{}
946 case HoldMore{}:
947 frame.cut(closed)
948 case HoldUntil{b}:
949 frame.wait(Res{status, h, Bytes.from_string(b)}, Bool.not(closed))
950 case HoldBody{b}:
951 frame.wait(Res{status, h, Bytes.from_string(b)}, Bool.and(open, Bool.not(closed)))
952
953# RFC 9112 §6.3 (8): no TE and no CL ⇒ the body runs until the server closes.
954def frame.open(+h: Map<&2, List<&2, String>>) -> Bool:
955 Bool.not(Bool.or(has_header(h, "transfer-encoding"), has_header(h, "content-length")))
956
957# RFC 9112 §6.3 (1): HEAD, 1xx, 204 and 304 responses end at the blank line.
958def frame.nobody(+status: U32, head: Bool) -> Bool:
959 Bool.or(head, Bool.or(U32.is_lt(status, 200), Bool.or(U32.is_eq(status, 204), U32.is_eq(status, 304))))
960
961# 101 is the final response. Other 1xx are interim; a final response follows.
962def frame.interim(+status: U32) -> Bool:
963 Bool.and(U32.is_lt(status, 200), Bool.not(U32.is_eq(status, 101)))
964
965def frame.status(status: U32, +h: Map<&2, List<&2, String>>, rest: String, closed: Bool, nobody: Bool) -> Frame:
966 match nobody:
967 case True{}:
968 FrameDone{Res{status, h, Bytes.new(0)}}
969 case False{}:
970 frame.done(status, h, parse.res.body(h, rest), closed, frame.open(h))
971
972def parse.res.fields(+status: U32, rest: String, fs: Maybe<&2, Map<&2, List<&2, String>>>, closed: Bool, head: Bool) -> Frame:
973 match fs:
974 case None{}:
975 FrameBad{}
976 case Some{h}:
977 frame.status(status, h, rest, closed, frame.nobody(status, head))
978
979def parse.res.num(code: Maybe<&2, U32>, headers: String, rest: String, closed: Bool, head: Bool) -> Frame:
980 match code:
981 case None{}:
982 FrameBad{}
983 case Some{n}:
984 parse.res.fields(n, rest, parse.headers.raw(headers), closed, head)
985
986def parse.res.ver(code: String, headers: String, rest: String, closed: Bool, head: Bool, ok: Bool) -> Frame:
987 match ok:
988 case False{}:
989 FrameBad{}
990 case True{}:
991 parse.res.num(parse_u32(code), headers, rest, closed, head)
992
993def parse.res.start3(mpv: String & String & String, headers: String, rest: String, closed: Bool, head: Bool) -> Frame:
994 (+ver, code, reason) = mpv
995 parse.res.ver(code, headers, rest, closed, head, Bool.or(String.eq(ver, "HTTP/1.1"), String.eq(ver, "HTTP/1.0")))
996
997def parse.res.lines(lr: String & String, rest: String, closed: Bool, head: Bool) -> Frame:
998 (line, headers) = lr
999 parse.res.start3(start_line(line), headers, rest, closed, head)
1000
1001def parse.res.blank(hd: String, rest: String, +closed: Bool, head: Bool, ok: Bool) -> Frame:
1002 match ok:
1003 case False{}:
1004 frame.cut(closed)
1005 case True{}:
1006 parse.res.lines(parse.first(hd, SNil{}), rest, closed, head)
1007
1008def parse.res.of(hb: String & String, closed: Bool, head: Bool) -> Frame:
1009 (+hd, rest) = hb
1010 parse.res.blank(hd, rest, closed, head, blank_end(hd))
1011
1012type Lead is Data:
1013 LeadCut{}
1014 LeadFinal{}
1015 LeadSkip{+rest: String}
1016
1017def frame.lead.if(rest: String, interim: Bool) -> Lead:
1018 match interim:
1019 case True{}:
1020 LeadSkip{rest}
1021 case False{}:
1022 LeadFinal{}
1023
1024def frame.lead.num(n: Maybe<&2, U32>, rest: String) -> Lead:
1025 match n:
1026 case None{}:
1027 LeadFinal{}
1028 case Some{s}:
1029 frame.lead.if(rest, frame.interim(s))
1030
1031def frame.lead.code(mpv: String & String & String, rest: String) -> Lead:
1032 (ver, code, reason) = mpv
1033 frame.lead.num(parse_u32(code), rest)
1034
1035def frame.lead.lines(xs: List<&2, String>, rest: String) -> Lead:
1036 match xs:
1037 case Nil{}:
1038 LeadFinal{}
1039 case Con{line, headers}:
1040 frame.lead.code(start_line(line), rest)
1041
1042def frame.lead.blank(+hd: String, rest: String, ok: Bool) -> Lead:
1043 match ok:
1044 case False{}:
1045 LeadCut{}
1046 case True{}:
1047 frame.lead.lines(String.lines(hd), rest)
1048
1049def frame.lead(hb: String & String) -> Lead:
1050 (+hd, rest) = hb
1051 frame.lead.blank(hd, rest, blank_end(hd))
1052
1053def frame.at.cont(+raw: String, lead: Lead) -> String:
1054 match lead:
1055 case LeadCut{}:
1056 raw
1057 case LeadFinal{}:
1058 raw
1059 case LeadSkip{rest}:
1060 rest
1061
1062def frame.at.zero.go(+raw: String, closed: Bool, head: Bool, lead: Lead) -> Frame:
1063 match lead:
1064 case LeadCut{}:
1065 frame.cut(closed)
1066 case LeadFinal{}:
1067 parse.res.of(split_at_blank(raw), closed, head)
1068 case LeadSkip{rest}:
1069 FrameBad{}
1070
1071def frame.at.zero.of(+raw: String, closed: Bool, head: Bool) -> Frame:
1072 frame.at.zero.go(raw, closed, head, frame.lead(split_at_blank(raw)))
1073
1074def frame.at.pos.do(f: Nat, +raw: String, closed: Bool, head: Bool, hb: String & String, lead: Lead) -> Frame:
1075 match f:
1076 case 0n:
1077 match lead:
1078 case LeadCut{}:
1079 frame.cut(closed)
1080 case LeadFinal{}:
1081 parse.res.of(hb, closed, head)
1082 case LeadSkip{+rest}:
1083 frame.at.zero.of(rest, closed, head)
1084 case 1n+g:
1085 match lead:
1086 case LeadCut{}:
1087 frame.cut(closed)
1088 case LeadFinal{}:
1089 parse.res.of(hb, closed, head)
1090 case LeadSkip{+rest}:
1091 frame.at.pos.do(g, rest, closed, head, split_at_blank(rest), frame.lead(split_at_blank(rest)))
1092
1093def frame.at.zero(+raw: String, closed: Bool, head: Bool) -> Frame:
1094 frame.at.zero.of(raw, closed, head)
1095
1096# ponytail: 8 interim responses; raise the fuel if a server sends more
1097def frame.at(fuel: Nat, +raw: String, closed: Bool, head: Bool) -> Frame:
1098 match fuel:
1099 case 0n:
1100 frame.at.zero(raw, closed, head)
1101 case 1n+f:
1102 frame.at.pos.do(f, raw, closed, head, split_at_blank(raw), frame.lead(split_at_blank(raw)))
1103
1104# frame(bytes so far, server closed?, request was HEAD?)
1105def frame(raw: String, closed: Bool, head: Bool) -> Frame:
1106 frame.at(8n, raw, closed, head)
1107
1108def frame.res(f: Frame) -> Maybe<&1, Res>:
1109 match f:
1110 case FrameDone{res}:
1111 Some{res}
1112 case FrameBad{}:
1113 None{}
1114 case FrameMore{}:
1115 None{}
1116
1117def parse_res(raw: String) -> Maybe<&1, Res>:
1118 frame.res(frame(raw, True{}, False{}))
1119
1120def res_fields.res(res: Res, k: String) -> List<&2, String>:
1121 Res{status, headers, body} = res
1122 fields(headers, k)
1123
1124def res_fields(m: Maybe<&1, Res>, k: String) -> List<&2, String>:
1125 match m:
1126 case None{}:
1127 Nil{}
1128 case Some{res}:
1129 res_fields.res(res, k)
1130
1131# The response body as it arrives. Len: bytes left. Chunk: the decoder. Close: until the
1132# server closes. Done: the body is whole. Bad: it cannot become a body.
1133type Rb is Data:
1134 RbLen{left: U32}
1135 RbChunk{st: Dc}
1136 RbClose{}
1137 RbDone{}
1138 RbBad{}
1139
1140def rb.cl(n: Maybe<&2, U32>) -> Maybe<&2, Rb>:
1141 match n:
1142 case None{}:
1143 None{}
1144 case Some{+k}:
1145 Some{Bool.pick(Rb, U32.is_zero(k), RbDone{}, RbLen{k})}
1146
1147def rb.te(+h: Map<&2, List<&2, String>>, cl: Bool) -> Maybe<&2, Rb>:
1148 match cl:
1149 case True{}:
1150 None{}
1151 case False{}:
1152 Some{Bool.pick(Rb, String.eq(String.to_lower(header.last(h, "transfer-encoding")), "chunked"), RbChunk{dc.start()}, RbClose{})}
1153
1154def rb.len(+h: Map<&2, List<&2, String>>, te: Bool) -> Maybe<&2, Rb>:
1155 match te:
1156 case True{}:
1157 rb.te(h, has_header(h, "content-length"))
1158 case False{}:
1159 Bool.pick(Maybe<&2, Rb>, has_header(h, "content-length"), rb.cl(parse_u32(header(h, "content-length"))), Some{RbClose{}})
1160
1161# RFC 9112 §6.3: how the body of this response ends. None: it cannot be framed.
1162def rb.of(+h: Map<&2, List<&2, String>>, nobody: Bool) -> Maybe<&2, Rb>:
1163 match nobody:
1164 case True{}:
1165 Some{RbDone{}}
1166 case False{}:
1167 rb.len(h, has_header(h, "transfer-encoding"))
1168
1169# rb: how the body goes on. parts: body bytes so far, newest first. rest: bytes past a Done body.
1170type Bf is Type:
1171 Bf{rb: Rb, parts: List<&1, Bytes.Bytes>, rest: Bytes.Bytes}
1172
1173def rb.len.cut(parts: List<&1, Bytes.Bytes>, +len: U32, +left: U32, r: Bytes.Bytes & Bytes.Bytes) -> Bf:
1174 (piece, data) = r
1175 Bf{RbDone{}, Con{data, parts}, bytes.snd(Bytes.slice(piece, left, (len - left : U32)))}
1176
1177def rb.len.have(short: Bool, +left: U32, parts: List<&1, Bytes.Bytes>, +len: U32, piece: Bytes.Bytes) -> Bf:
1178 match short:
1179 case True{}:
1180 Bf{RbLen{(left - len : U32)}, Con{piece, parts}, Bytes.new(0)}
1181 case False{}:
1182 rb.len.cut(parts, len, left, Bytes.slice(piece, 0, left))
1183
1184def rb.chunk(c: Ck) -> Bf:
1185 Ck{st, parts, rest} = c
1186 match st:
1187 case DcDone{}:
1188 Bf{RbDone{}, parts, rest}
1189 case DcBad{}:
1190 Bf{RbBad{}, parts, rest}
1191 case DcSize{a, b}:
1192 Bf{RbChunk{DcSize{a, b}}, parts, rest}
1193 case DcExt{x}:
1194 Bf{RbChunk{DcExt{x}}, parts, rest}
1195 case DcSizeLf{x}:
1196 Bf{RbChunk{DcSizeLf{x}}, parts, rest}
1197 case DcData{k}:
1198 Bf{RbChunk{DcData{k}}, parts, rest}
1199 case DcDataCr{}:
1200 Bf{RbChunk{DcDataCr{}}, parts, rest}
1201 case DcDataLf{}:
1202 Bf{RbChunk{DcDataLf{}}, parts, rest}
1203 case DcTr{j}:
1204 Bf{RbChunk{DcTr{j}}, parts, rest}
1205
1206# The body bytes in piece, added to parts.
1207def rb.feed(rb: Rb, parts: List<&1, Bytes.Bytes>, piece: Bytes.Bytes) -> Bf:
1208 match rb:
1209 case RbLen{+left}:
1210 Bytes.Bytes{+len, buf} = piece
1211 rb.len.have(U32.is_lt(len, left), left, parts, len, Bytes.Bytes{len, buf})
1212 case RbChunk{st}:
1213 rb.chunk(ck(piece, st, parts))
1214 case RbClose{}:
1215 Bf{RbClose{}, Con{piece, parts}, Bytes.new(0)}
1216 case RbDone{}:
1217 Bf{RbDone{}, parts, piece}
1218 case RbBad{}:
1219 Bf{RbBad{}, parts, piece}
1220
1221# RFC 9112 §8: only a close-delimited body may end at close.
1222def rb.eof(rb: Rb) -> Bool:
1223 match rb:
1224 case RbClose{}:
1225 True{}
1226 case RbDone{}:
1227 True{}
1228 case RbLen{n}:
1229 False{}
1230 case RbChunk{st}:
1231 False{}
1232 case RbBad{}:
1233 False{}
1234
1235def rb.body(parts: List<&1, Bytes.Bytes>) -> Bytes.Bytes:
1236 Bytes.concat(List.reverse(&1, Bytes.Bytes, parts))
1237
1238# The head scan. Seek: look for the blank line from byte from; k interim heads are behind.
1239# Wait: no blank line yet. Res: the final head, how its body ends, and the bytes after it.
1240type Hs is Type:
1241 HsSeek{buf: Bytes.Bytes, from: U32, k: U32}
1242 HsWait{buf: Bytes.Bytes, k: U32}
1243 HsBad{}
1244 HsRes{res: Res, rb: Rb, rest: Bytes.Bytes}
1245
1246def hs.final(+status: U32, +h: Map<&2, List<&2, String>>, rest: Bytes.Bytes, m: Maybe<&2, Rb>) -> Hs:
1247 match m:
1248 case None{}:
1249 HsBad{}
1250 case Some{rb}:
1251 HsRes{Res{status, h, Bytes.new(0)}, rb, rest}
1252
1253def hs.skip(more: Bool, +k: U32, rest: Bytes.Bytes) -> Hs:
1254 match more:
1255 case True{}:
1256 HsSeek{rest, 0, (k + 1 : U32)}
1257 case False{}:
1258 HsBad{}
1259
1260def hs.pick(interim: Bool, +head: Bool, +k: U32, +status: U32, +h: Map<&2, List<&2, String>>, rest: Bytes.Bytes) -> Hs:
1261 match interim:
1262 case True{}:
1263 hs.skip(U32.is_lt(k, 8), k, rest)
1264 case False{}:
1265 hs.final(status, h, rest, rb.of(h, frame.nobody(status, head)))
1266
1267def hs.res(+head: Bool, +k: U32, rest: Bytes.Bytes, res: Res) -> Hs:
1268 Res{+status, +h, body} = res
1269 hs.pick(frame.interim(status), head, k, status, h, rest)
1270
1271# The head alone, framed as a HEAD response so it stops at the blank line.
1272def hs.parsed(+head: Bool, +k: U32, rest: Bytes.Bytes, f: Frame) -> Hs:
1273 match f:
1274 case FrameDone{res}:
1275 hs.res(head, k, rest, res)
1276 case FrameBad{}:
1277 HsBad{}
1278 case FrameMore{}:
1279 HsBad{}
1280
1281def hs.split(+head: Bool, +k: U32, +hlen: U32, +len: U32, r: Bytes.Bytes & Bytes.Bytes) -> Hs:
1282 (buf, hb) = r
1283 hs.parsed(head, k, bytes.snd(Bytes.slice(buf, hlen, (len - hlen : U32))), parse.res.of(split_at_blank(Bytes.to_string(hb)), False{}, True{}))
1284
1285def hs.hit(+head: Bool, +k: U32, +len: U32, buf: Bytes.Bytes, at: Maybe<&2, U32>) -> Hs:
1286 match at:
1287 case None{}:
1288 HsWait{buf, k}
1289 case Some{+i}:
1290 +hlen = (i + 4 : U32)
1291 hs.split(head, k, hlen, len, Bytes.slice(buf, 0, hlen))
1292
1293def hs.seek.of(+head: Bool, +k: U32, +len: U32, +from: U32, buf: Bytes.Bytes, r: Bytes.Bytes & Maybe<&2, U32>) -> Hs:
1294 (tail, m) = r
1295 hs.hit(head, k, len, buf, found.at(from, m))
1296
1297def hs.seek(+head: Bool, +k: U32, +len: U32, +from: U32, r: Bytes.Bytes & Bytes.Bytes) -> Hs:
1298 (buf, tail) = r
1299 hs.seek.of(head, k, len, from, buf, Bytes.find(tail, "\r\n\r\n"))
1300
1301def hs.step(+head: Bool, st: Hs) -> Hs:
1302 match st:
1303 case HsSeek{buf, +from, +k}:
1304 Bytes.Bytes{+len, b} = buf
1305 hs.seek(head, k, len, from, Bytes.slice(Bytes.Bytes{len, b}, from, (len - from : U32)))
1306 case HsWait{buf, k}:
1307 HsWait{buf, k}
1308 case HsBad{}:
1309 HsBad{}
1310 case HsRes{res, rb, rest}:
1311 HsRes{res, rb, rest}
1312
1313# Each step ends the scan or passes one interim head, and at most 8 interim heads pass.
1314def hs.scan(fuel: Nat, +head: Bool, st: Hs) -> Hs:
1315 match fuel:
1316 case 0n:
1317 match st:
1318 case HsSeek{buf, from, k}:
1319 HsBad{}
1320 case HsWait{buf, k}:
1321 HsWait{buf, k}
1322 case HsBad{}:
1323 HsBad{}
1324 case HsRes{res, rb, rest}:
1325 HsRes{res, rb, rest}
1326 case 1n+f:
1327 hs.scan(f, head, hs.step(head, st))
1328
1329# piece joins buf; only the new bytes, and the 3 before them, can finish the blank line.
1330def hs.more(+head: Bool, +k: U32, buf: Bytes.Bytes, piece: Bytes.Bytes) -> Hs:
1331 Bytes.Bytes{+ol, ob} = buf
1332 hs.scan(10n, head, HsSeek{Bytes.append(Bytes.Bytes{ol, ob}, piece), Bool.pick(U32, U32.is_lt(ol, 3), 0, (ol - 3 : U32)), k})
1333
1334# Untrusted servers must not grow the buffer without bound.
1335def fetch.max() -> Nat:
1336 U32.to_nat(16777216)
1337
1338# A response read in pieces. Head: the head is not whole yet. Body: it is, and parts is the body so far.
1339# Len: a Content-Length body in one buffer of that size, with left bytes still to come.
1340type Rv is Type:
1341 RvHead{buf: Bytes.Bytes, k: U32}
1342 RvBody{res: Res, rb: Rb, parts: List<&1, Bytes.Bytes>}
1343 RvLen{res: Res, left: U32, body: Bytes.Bytes}
1344
1345# More: read on. Done: the response, and the bytes after it when the body is self-delimited.
1346type Rt is Type:
1347 RtMore{rv: Rv}
1348 RtBad{}
1349 RtDone{res: Res, rest: Maybe<&1, Bytes.Bytes>}
1350
1351def rv.start() -> Rv:
1352 RvHead{Bytes.new(0), 0}
1353
1354def rv.whole(res: Res, b: Bytes.Bytes, rest: Maybe<&1, Bytes.Bytes>) -> Rt:
1355 Res{status, headers, body} = res
1356 RtDone{Res{status, headers, b}, rest}
1357
1358def rv.done(res: Res, parts: List<&1, Bytes.Bytes>, rest: Maybe<&1, Bytes.Bytes>) -> Rt:
1359 rv.whole(res, rb.body(parts), rest)
1360
1361def rl.put.of(+total: U32, +len: U32, r: Array<U32> & Array<U32>) -> Bytes.Bytes & Bytes.Bytes:
1362 (src, dst) = r
1363 (Bytes.Bytes{total, dst}, Bytes.Bytes{len, src})
1364
1365# The first m bytes of piece, written into body after the total - left bytes already there.
1366def rl.put(+m: U32, +left: U32, body: Bytes.Bytes, piece: Bytes.Bytes) -> Bytes.Bytes & Bytes.Bytes:
1367 Bytes.Bytes{+total, dst} = body
1368 Bytes.Bytes{+len, src} = piece
1369 rl.put.of(total, len, Bytes.copy(m, src, dst, 0, (total - left : U32)))
1370
1371def rl.fed(short: Bool, res: Res, +left: U32, +len: U32, r: Bytes.Bytes & Bytes.Bytes) -> Rt:
1372 match short:
1373 case True{}:
1374 (body, piece) = r
1375 RtMore{RvLen{res, (left - len : U32), body}}
1376 case False{}:
1377 (body, piece) = r
1378 rv.whole(res, body, Some{bytes.snd(Bytes.slice(piece, left, (len - left : U32)))})
1379
1380def rl.feed(res: Res, +left: U32, body: Bytes.Bytes, piece: Bytes.Bytes) -> Rt:
1381 Bytes.Bytes{+len, buf} = piece
1382 rl.fed(U32.is_lt(len, left), res, left, len, rl.put(U32.min(len, left), left, body, Bytes.Bytes{len, buf}))
1383
1384def rv.fed(res: Res, bf: Bf) -> Rt:
1385 Bf{rb, parts, rest} = bf
1386 match rb:
1387 case RbDone{}:
1388 rv.done(res, parts, Some{rest})
1389 case RbBad{}:
1390 RtBad{}
1391 case RbLen{n}:
1392 RtMore{RvBody{res, RbLen{n}, parts}}
1393 case RbChunk{st}:
1394 RtMore{RvBody{res, RbChunk{st}, parts}}
1395 case RbClose{}:
1396 RtMore{RvBody{res, RbClose{}, parts}}
1397
1398# Some{left}: a Content-Length body small enough to allocate up front. Larger ones fail at the fetch cap.
1399def rb.buf(rb: Rb) -> Maybe<&2, U32>:
1400 match rb:
1401 case RbLen{+left}:
1402 Bool.pick(Maybe<&2, U32>, Nat.is_lt(fetch.max(), U32.to_nat(left)), None{}, Some{left})
1403 case RbChunk{st}:
1404 None{}
1405 case RbClose{}:
1406 None{}
1407 case RbDone{}:
1408 None{}
1409 case RbBad{}:
1410 None{}
1411
1412def rv.body(m: Maybe<&2, U32>, res: Res, rb: Rb, rest: Bytes.Bytes) -> Rt:
1413 match m:
1414 case None{}:
1415 rv.fed(res, rb.feed(rb, Nil{}, rest))
1416 case Some{+left}:
1417 rl.feed(res, left, Bytes.new(left), rest)
1418
1419def rv.head(hs: Hs) -> Rt:
1420 match hs:
1421 case HsWait{buf, k}:
1422 RtMore{RvHead{buf, k}}
1423 case HsBad{}:
1424 RtBad{}
1425 case HsSeek{buf, from, k}:
1426 RtBad{}
1427 case HsRes{res, +rb, rest}:
1428 rv.body(rb.buf(rb), res, rb, rest)
1429
1430def rv.eof(res: Res, parts: List<&1, Bytes.Bytes>, ok: Bool) -> Rt:
1431 match ok:
1432 case True{}:
1433 rv.done(res, parts, None{})
1434 case False{}:
1435 RtBad{}
1436
1437# One read: piece, or the server closed (RFC 9112 §8: a message cut short is not a message).
1438def rv.step(closed: Bool, +head: Bool, rv: Rv, piece: Bytes.Bytes) -> Rt:
1439 match closed:
1440 case True{}:
1441 match rv:
1442 case RvHead{buf, k}:
1443 RtBad{}
1444 case RvBody{res, rb, parts}:
1445 rv.eof(res, parts, rb.eof(rb))
1446 case RvLen{res, left, body}:
1447 RtBad{}
1448 case False{}:
1449 match rv:
1450 case RvHead{buf, +k}:
1451 rv.head(hs.more(head, k, buf, piece))
1452 case RvBody{res, rb, parts}:
1453 rv.fed(res, rb.feed(rb, parts, piece))
1454 case RvLen{res, +left, body}:
1455 rl.feed(res, left, body, piece)
1456
1457def rv.end(closed: Bool, +head: Bool, t: Rt) -> Rt:
1458 match closed:
1459 case False{}:
1460 t
1461 case True{}:
1462 match t:
1463 case RtMore{rv}:
1464 rv.step(True{}, head, rv, Bytes.new(0))
1465 case RtBad{}:
1466 RtBad{}
1467 case RtDone{res, rest}:
1468 RtDone{res, rest}
1469
1470def rv.go(xs: List<&2, String>, closed: Bool, +head: Bool, t: Rt) -> Rt:
1471 match xs:
1472 case Nil{}:
1473 rv.end(closed, head, t)
1474 case Con{+x, rest}:
1475 match t:
1476 case RtMore{rv}:
1477 rv.go(rest, closed, head, rv.step(False{}, head, rv, Bytes.from_string(x)))
1478 case RtBad{}:
1479 RtBad{}
1480 case RtDone{res, r}:
1481 RtDone{res, r}
1482
1483def rt.frame(t: Rt) -> Frame:
1484 match t:
1485 case RtMore{rv}:
1486 FrameMore{}
1487 case RtBad{}:
1488 FrameBad{}
1489 case RtDone{res, rest}:
1490 FrameDone{res}
1491
1492# What the read loop makes of these pieces, then a close when closed is set.
1493def res.frame(xs: List<&2, String>, closed: Bool, +head: Bool) -> Frame:
1494 rt.frame(rv.go(xs, closed, head, RtMore{rv.start()}))
1495
1496def rt.rest(t: Rt) -> Maybe<&1, Bytes.Bytes>:
1497 match t:
1498 case RtMore{rv}:
1499 None{}
1500 case RtBad{}:
1501 None{}
1502 case RtDone{res, rest}:
1503 rest
1504
1505def after.of(m: Maybe<&1, Bytes.Bytes>) -> Maybe<&2, String>:
1506 match m:
1507 case None{}:
1508 None{}
1509 case Some{b}:
1510 Some{Bytes.to_string(b)}
1511
1512# Bytes after a complete self-delimited message. None if it is not one yet.
1513def after(+raw: String, +head: Bool) -> Maybe<&2, String>:
1514 after.of(rt.rest(rv.go([raw], False{}, head, RtMore{rv.start()})))
1515
1516def req.v11.ver(mpv: String & String & String) -> Bool:
1517 (+method, path, v) = mpv
1518 String.eq(v, "HTTP/1.1")
1519
1520def req.v11.line(+line: String) -> Bool:
1521 req.v11.ver(start_line(line))
1522
1523def req.v11.lines(xs: List<&2, String>) -> Bool:
1524 match xs:
1525 case Nil{}:
1526 False{}
1527 case Con{line, headers}:
1528 req.v11.line(line)
1529
1530def req.v11.pick(+head: String, ok: Bool) -> Bool:
1531 match ok:
1532 case False{}:
1533 False{}
1534 case True{}:
1535 req.v11.lines(String.lines(head))
1536
1537def req.v11.of(hb: String & String) -> Bool:
1538 (+head, rest) = hb
1539 req.v11.pick(head, blank_end(head))
1540
1541def req.v11(+raw: String) -> Bool:
1542 req.v11.of(split_at_blank(raw))
1543
1544def req.conn_close(+headers: Map<&2, List<&2, String>>) -> Bool:
1545 String.eq(String.to_lower(header(headers, "connection")), "close")
1546
1547def res.conn_close(+headers: Map<&2, List<&2, String>>) -> Bool:
1548 String.eq(String.to_lower(header(headers, "connection")), "close")
1549
1550def serve.fail_close(+status: U32) -> Bool:
1551 Bool.or(U32.is_eq(status, 400), Bool.or(U32.is_eq(status, 413), U32.is_eq(status, 431)))
1552
1553def serve.keep.ok(fail: Bool, res_close: Bool) -> Bool:
1554 match fail:
1555 case True{}:
1556 False{}
1557 case False{}:
1558 Bool.not(res_close)
1559
1560def serve.keep.v11(v11: Bool, +req_close: Bool, +status: U32, res_close: Bool) -> Bool:
1561 match v11:
1562 case False{}:
1563 False{}
1564 case True{}:
1565 match req_close:
1566 case True{}:
1567 False{}
1568 case False{}:
1569 serve.keep.ok(serve.fail_close(status), res_close)
1570
1571def serve.keep(+headers: Map<&2, List<&2, String>>, v11: Bool, +status: U32, +res: Map<&2, List<&2, String>>) -> Bool:
1572 serve.keep.v11(v11, req.conn_close(headers), status, res.conn_close(res))
1573
1574
1575def again.keep(close: Bool, x: Bytes.Bytes) -> Maybe<&1, Bytes.Bytes>:
1576 match close:
1577 case True{}:
1578 None{}
1579 case False{}:
1580 Some{x}
1581
1582def again.rest(close: Bool, rest: Maybe<&1, Bytes.Bytes>) -> Maybe<&1, Bytes.Bytes>:
1583 match rest:
1584 case None{}:
1585 None{}
1586 case Some{x}:
1587 again.keep(close, x)
1588
1589# The bytes past the response when the socket can take another request: the request did not
1590# ask to close, the response is self-delimited, and the peer did not say close.
1591def again(close: Bool, +h: Map<&2, List<&2, String>>, rest: Maybe<&1, Bytes.Bytes>) -> Maybe<&1, Bytes.Bytes>:
1592 match close:
1593 case True{}:
1594 None{}
1595 case False{}:
1596 again.rest(String.eq(String.to_lower(header(h, "connection")), "close"), rest)
1597
1598def res_body.res(res: Res) -> Bytes.Bytes:
1599 Res{status, headers, body} = res
1600 body
1601
1602def res_body(m: Maybe<&1, Res>) -> Bytes.Bytes:
1603 match m:
1604 case None{}:
1605 Bytes.new(0)
1606 case Some{res}:
1607 res_body.res(res)
1608
1609def text(res: Res) -> String:
1610 Enc.utf8.decode(res_body.res(res))
1611
1612# UTF-8 is checked, not repaired: bad UTF-8 in a string gives None (RFC 8259 §8.1).
1613def json(res: Res) -> Maybe<&1, Json.Val>:
1614 Json.parse.bytes(res_body.res(res))
1615
1616def got_body.req(req: Req) -> Bytes.Bytes:
1617 Req{method, path, headers, body} = req
1618 body
1619
1620def got_body(m: Maybe<&1, Req>) -> Bytes.Bytes:
1621 match m:
1622 case None{}:
1623 Bytes.new(0)
1624 case Some{req}:
1625 got_body.req(req)
1626
1627def body.of(hb: String & String) -> String:
1628 (h, b) = hb
1629 b
1630
1631def body(s: String) -> String:
1632 body.of(split_at_blank.go(s, False{}, 0, SNil{}))
1633
1634def headers_lines(+k: String, vs: List<&2, String>, acc: String) -> String:
1635 match vs:
1636 case Nil{}:
1637 acc
1638 case Con{v, t}:
1639 headers_lines(k, t, acc ++ ("\r\n" ++ sanitize(k) ++ ": " ++ sanitize(v)))
1640
1641def headers_block.go(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>, acc: String) -> String:
1642 match xs:
1643 case Nil{}:
1644 acc
1645 case (k, vs) <> t:
1646 headers_block.go(t, headers_lines(k, vs, acc))
1647
1648def headers_block(h: Map<&2, List<&2, String>>) -> String:
1649 headers_block.go(Map.to_list(&2, List<&2, String>, h), "")
1650
1651# RFC 9110 §15. An unknown code gets an empty reason, which RFC 9112 §4 allows.
1652type Reason is Data:
1653 Reason{code: U32, text: String}
1654
1655def reasons() -> List<&2, Reason>:
1656 [Reason{100, "Continue"}, Reason{101, "Switching Protocols"}, Reason{103, "Early Hints"},
1657 Reason{200, "OK"}, Reason{201, "Created"}, Reason{202, "Accepted"}, Reason{203, "Non-Authoritative Information"}, Reason{204, "No Content"}, Reason{205, "Reset Content"}, Reason{206, "Partial Content"},
1658 Reason{300, "Multiple Choices"}, Reason{301, "Moved Permanently"}, Reason{302, "Found"}, Reason{303, "See Other"}, Reason{304, "Not Modified"}, Reason{307, "Temporary Redirect"}, Reason{308, "Permanent Redirect"},
1659 Reason{400, "Bad Request"}, Reason{401, "Unauthorized"}, Reason{402, "Payment Required"}, Reason{403, "Forbidden"}, Reason{404, "Not Found"}, Reason{405, "Method Not Allowed"}, Reason{406, "Not Acceptable"}, Reason{407, "Proxy Authentication Required"}, Reason{408, "Request Timeout"}, Reason{409, "Conflict"}, Reason{410, "Gone"}, Reason{411, "Length Required"}, Reason{412, "Precondition Failed"}, Reason{413, "Content Too Large"}, Reason{414, "URI Too Long"}, Reason{415, "Unsupported Media Type"}, Reason{416, "Range Not Satisfiable"}, Reason{417, "Expectation Failed"}, Reason{421, "Misdirected Request"}, Reason{422, "Unprocessable Content"}, Reason{426, "Upgrade Required"}, Reason{428, "Precondition Required"}, Reason{429, "Too Many Requests"}, Reason{431, "Request Header Fields Too Large"},
1660 Reason{500, "Internal Server Error"}, Reason{501, "Not Implemented"}, Reason{502, "Bad Gateway"}, Reason{503, "Service Unavailable"}, Reason{504, "Gateway Timeout"}, Reason{505, "HTTP Version Not Supported"}]
1661
1662def reason.go(xs: List<&2, Reason>, +status: U32) -> String:
1663 match xs:
1664 case Nil{}:
1665 ""
1666 case Con{Reason{k, v}, t}:
1667 Bool.pick(String, U32.is_eq(k, status), v, reason.go(t, status))
1668
1669def reason(+status: U32) -> String:
1670 reason.go(reasons(), status)
1671
1672def response(+status: U32, headers: Map<&2, List<&2, String>>, body: String) -> String:
1673 ("HTTP/1.1 " ++ U32.show(status) ++ " " ++ reason(status) ++ headers_block(headers)) ++ ("\r\n\r\n" ++ body)
1674
1675def encode.body(head: Bool, top: Bytes.Bytes, body: Bytes.Bytes) -> Bytes.Bytes:
1676 match head:
1677 case True{}:
1678 top
1679 case False{}:
1680 Bytes.append(top, body)
1681
1682def encode.len(+status: U32, headers: Map<&2, List<&2, String>>, head: Bool, body: Bytes.Bytes) -> Bytes.Bytes:
1683 Bytes.Bytes{+len, buf} = body
1684 encode.body(head, Bytes.from_string(response(status, set(headers, "content-length", U32.show(len)), "")), Bytes.Bytes{len, buf})
1685
1686# RFC 9110 §6.4.1, §8.6: 1xx, 204 and 304 have no body; HEAD gets the length but no body.
1687def encode.pick(+status: U32, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, head: Bool, nobody: Bool) -> Bytes.Bytes:
1688 match nobody:
1689 case True{}:
1690 Bytes.from_string(response(status, headers, ""))
1691 case False{}:
1692 encode.len(status, headers, head, body)
1693
1694def encode.on(r: Res, head: Bool) -> Bytes.Bytes:
1695 Res{+status, headers, body} = r
1696 encode.pick(status, headers, body, head, frame.nobody(status, False{}))
1697
1698def encode(r: Res) -> Bytes.Bytes:
1699 encode.on(r, False{})
1700
1701def request(method: String, path: String, headers: Map<&2, List<&2, String>>, body: String) -> String:
1702 (method ++ " " ++ path ++ " HTTP/1.1" ++ headers_block(headers)) ++ ("\r\n\r\n" ++ body)
1703
1704def req.reserved(+k: String) -> Bool:
1705 Bool.or(Bool.or(String.eq(k, "host"), String.eq(k, "connection")), Bool.or(String.eq(k, "content-length"), String.eq(k, "transfer-encoding")))
1706
1707def req.put.one(m: Map<&2, List<&2, String>>, +k: String, vs: List<&2, String>, skip: Bool) -> Map<&2, List<&2, String>>:
1708 match skip:
1709 case True{}:
1710 m
1711 case False{}:
1712 Map.set(&2, List<&2, String>, m, k, vs)
1713
1714def req.put(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>, m: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
1715 match xs:
1716 case Nil{}:
1717 m
1718 case (k, vs) <> t:
1719 +lk = String.to_lower(k)
1720 req.put(t, req.put.one(m, lk, vs, req.reserved(lk)))
1721
1722# RFC 9110 §8.6: no Content-Length on a bodiless request whose method gives a body no meaning.
1723def req.cl(+m: Map<&2, List<&2, String>>, +method: String, +len: U32) -> Map<&2, List<&2, String>>:
1724 +bodied = Bool.or(Bool.not(U32.is_zero(len)), Bool.or(String.eq(method, "POST"), Bool.or(String.eq(method, "PUT"), String.eq(method, "PATCH"))))
1725 Bool.pick(Map<&2, List<&2, String>>, bodied, set(m, "content-length", U32.show(len)), m)
1726
1727# Caller headers are lowercased so they cannot duplicate ours; host, connection,
1728# content-length and transfer-encoding are always ours (no smuggling through them).
1729def encode_req.word(close: Bool) -> String:
1730 match close:
1731 case True{}:
1732 "close"
1733 case False{}:
1734 "keep-alive"
1735
1736def encode_req.on(+method: String, target: String, host: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, close: Bool) -> Bytes.Bytes:
1737 Bytes.Bytes{+len, buf} = body
1738 +h = set(set(req.put(Map.to_list(&2, List<&2, String>, headers), empty()), "host", host), "connection", encode_req.word(close))
1739 Bytes.append(Bytes.from_string(request(method, target, req.cl(h, method, len), "")), Bytes.Bytes{len, buf})
1740
1741def encode_req(+method: String, target: String, host: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> Bytes.Bytes:
1742 encode_req.on(method, target, host, headers, body, True{})
1743
1744# Redirects (RFC 9110 §15.4, as WHATWG fetch applies them)
1745# --------------------------------------------------------
1746
1747# One request to make: headers are already lowercased (see req.put).
1748type Hop is Type:
1749 Hop{method: String, url: Url.Abs, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
1750
1751def redirect.code(+s: U32) -> Bool:
1752 Bool.or(Bool.or(U32.is_eq(s, 301), U32.is_eq(s, 302)), Bool.or(U32.is_eq(s, 303), Bool.or(U32.is_eq(s, 307), U32.is_eq(s, 308))))
1753
1754def redirect.origin(a: Url.Abs) -> String:
1755 Url.Abs{scheme, host, port, target} = a
1756 scheme ++ "://" ++ host ++ ":" ++ U32.show(port)
1757
1758def redirect.del(ks: List<&2, String>, m: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
1759 match ks:
1760 case Nil{}:
1761 m
1762 case Con{k, t}:
1763 redirect.del(t, Map.del(&2, List<&2, String>, m, k))
1764
1765def redirect.hdrs(+h: Map<&2, List<&2, String>>, drop: Bool, cross: Bool) -> Map<&2, List<&2, String>>:
1766 +h2 = Bool.pick(Map<&2, List<&2, String>>, drop, redirect.del(["content-type", "content-encoding", "content-language", "content-location"], h), h)
1767 Bool.pick(Map<&2, List<&2, String>>, cross, redirect.del(["authorization", "cookie", "proxy-authorization"], h2), h2)
1768
1769# 303 turns any method but HEAD into GET; 301 and 302 turn POST into GET;
1770# 307 and 308 keep method and body. A GET carries no body or body headers.
1771# Credentials do not follow a hop to another origin.
1772def redirect.body(drop: Bool, body: Bytes.Bytes) -> Bytes.Bytes:
1773 match drop:
1774 case True{}:
1775 Bytes.new(0)
1776 case False{}:
1777 body
1778
1779def redirect.to(+status: U32, +method: String, +from: Url.Abs, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, next: Maybe<&2, Url.Abs>) -> Maybe<&1, Hop>:
1780 match next:
1781 case None{}:
1782 None{}
1783 case Some{+to}:
1784 +drop = Bool.or(Bool.and(U32.is_eq(status, 303), Bool.not(String.eq(method, "HEAD"))), Bool.and(Bool.or(U32.is_eq(status, 301), U32.is_eq(status, 302)), String.eq(method, "POST")))
1785 Some{Hop{Bool.pick(String, drop, "GET", method), to, redirect.hdrs(headers, drop, Bool.not(String.eq(redirect.origin(from), redirect.origin(to)))), redirect.body(drop, body)}}
1786
1787def redirect.hop(status: U32, h: Hop, loc: String) -> Maybe<&1, Hop>:
1788 Hop{method, +url, headers, body} = h
1789 redirect.to(status, method, url, headers, body, Url.resolve(url, loc))
1790
1791def redirect.if(status: U32, h: Hop, loc: String, ok: Bool) -> Maybe<&1, Hop>:
1792 match ok:
1793 case False{}:
1794 None{}
1795 case True{}:
1796 redirect.hop(status, h, loc)
1797
1798# The next request after a response, or None when it is not a redirect we follow.
1799def redirect(+status: U32, +headers: Map<&2, List<&2, String>>, h: Hop) -> Maybe<&1, Hop>:
1800 redirect.if(status, h, header(headers, "location"), Bool.and(redirect.code(status), has_header(headers, "location")))
1801
1802# Cookies (RFC 6265bis §5)
1803# ------------------------
1804
1805# A stored cookie. domain is lowercase, with no leading dot; host_only sends it to that host alone.
1806# expiry None is a session cookie. http_only and same_site ("strict", "lax", "none" or "default")
1807# are kept, not enforced: fetch has no browsing client, so its requests are same-site (§5.2).
1808type Cookie is Data:
1809 Cookie{name: String, value: String, domain: String, host_only: Bool, path: String, secure: Bool, http_only: Bool, same_site: String, expiry: Maybe<&2, Time.Instant>}
1810
1811# The cookies, oldest first, and the caller's clock. No cookie in it has expired by now.
1812type Jar is Data:
1813 Jar{now: Time.Instant, cookies: List<&2, Cookie>}
1814
1815def jar.new(now: Time.Instant) -> Jar:
1816 Jar{now, Nil{}}
1817
1818def jar.cookies(j: Jar) -> List<&2, Cookie>:
1819 Jar{now, cs} = j
1820 cs
1821
1822def cookie.live.at(+now: Time.Instant, e: Maybe<&2, Time.Instant>) -> Bool:
1823 match e:
1824 case None{}:
1825 True{}
1826 case Some{t}:
1827 Cmp.is_lt(Time.Instant.cmp(now, t))
1828
1829# Alive at now: no expiry, or an expiry after now.
1830def cookie.live(+now: Time.Instant, c: Cookie) -> Bool:
1831 Cookie{name, value, domain, host_only, path, secure, http_only, same_site, expiry} = c
1832 cookie.live.at(now, expiry)
1833
1834def jar.live(cs: List<&2, Cookie>, +now: Time.Instant) -> List<&2, Cookie>:
1835 match cs:
1836 case Nil{}:
1837 Nil{}
1838 case Con{+c, t}:
1839 List.filter.put(Cookie, c, jar.live(t, now), cookie.live(now, c))
1840
1841# The jar at a later time: cookies expired by now are evicted (§5.7).
1842def jar.at(j: Jar, +now: Time.Instant) -> Jar:
1843 Jar{old, cs} = j
1844 Jar{now, jar.live(cs, now)}
1845
1846def cookie.cut.found(r: String & String) -> String & String & Bool:
1847 (a, b) = r
1848 (a, b, True{})
1849
1850# hit: the last char pushed onto acc was c.
1851def cookie.cut.go(s: String, +c: U32, acc: String, hit: Bool) -> String & String & Bool:
1852 match s:
1853 case SNil{}:
1854 match hit:
1855 case True{}:
1856 cookie.cut.found(take.cut(acc, SNil{}))
1857 case False{}:
1858 (String.reverse(acc), SNil{}, False{})
1859 case SCon{Chr{+x}, t}:
1860 match hit:
1861 case True{}:
1862 cookie.cut.found(take.cut(acc, SCon{Chr{x}, t}))
1863 case False{}:
1864 cookie.cut.go(t, c, SCon{Chr{x}, acc}, U32.is_eq(x, c))
1865
1866# s split at its first c: before, after, and whether c was there.
1867def cookie.cut(s: String, +c: U32) -> String & String & Bool:
1868 cookie.cut.go(s, c, SNil{}, False{})
1869
1870def cookie.fst(r: String & String & Bool) -> String:
1871 (a, b, found) = r
1872 a
1873
1874# The path of an origin-form target: the part before "?".
1875def cookie.target_path(t: String) -> String:
1876 cookie.fst(cookie.cut(t, 63))
1877
1878# Longer than n octets.
1879def cookie.over(s: String, +n: U32) -> Bool:
1880 match s:
1881 case SNil{}:
1882 False{}
1883 case SCon{c, t}:
1884 Bool.or(U32.is_eq(n, 0), cookie.over(t, (n - 1 : U32)))
1885
1886# %x00-08 / %x0A-1F / %x7F: control characters other than HTAB.
1887def cookie.ctl(s: String) -> Bool:
1888 match s:
1889 case SNil{}:
1890 False{}
1891 case SCon{Chr{+c}, t}:
1892 Bool.or(Bool.or(U32.is_lt(c, 9), Bool.and(U32.is_gt(c, 9), U32.is_lt(c, 32))), Bool.or(U32.is_eq(c, 127), cookie.ctl(t)))
1893
1894def cookie.ascii(s: String) -> Bool:
1895 match s:
1896 case SNil{}:
1897 True{}
1898 case SCon{Chr{+c}, t}:
1899 Bool.and(U32.is_lt(c, 128), cookie.ascii(t))
1900
1901def cookie.ip4(s: String) -> Bool:
1902 match s:
1903 case SNil{}:
1904 True{}
1905 case SCon{Chr{+c}, t}:
1906 Bool.and(Bool.or(parse_u32.digit(c), U32.is_eq(c, 46)), cookie.ip4(t))
1907
1908# An IP literal rather than a host name: IPv6 has a colon, IPv4 is digits and dots.
1909def cookie.ip(+h: String) -> Bool:
1910 Bool.or(String.contains(h, ":"), cookie.ip4(h))
1911
1912# §5.1.3: s is d, or a host name under d on a label boundary.
1913def cookie.domain_match(+s: String, +d: String) -> Bool:
1914 Bool.or(String.eq(s, d), Bool.and(String.ends_with(s, "." ++ d), Bool.not(cookie.ip(s))))
1915
1916# A reversed path with its last segment and slash dropped.
1917def cookie.up(rs: String) -> String:
1918 match rs:
1919 case SNil{}:
1920 SNil{}
1921 case SCon{Chr{47}, t}:
1922 t
1923 case SCon{Chr{c}, t}:
1924 cookie.up(t)
1925
1926# §5.1.4: the request path up to its last "/", or "/".
1927def cookie.default_path(+p: String) -> String:
1928 +up = String.reverse(cookie.up(String.reverse(p)))
1929 Bool.pick(String, Bool.or(Bool.not(String.starts_with(p, "/")), String.is_empty(up)), "/", up)
1930
1931# §5.1.4: request path p path-matches cookie path c.
1932def cookie.path_match(+p: String, +c: String) -> Bool:
1933 Bool.or(String.eq(p, c), Bool.and(String.starts_with(p, c), Bool.or(String.ends_with(c, "/"), String.starts_with(String.drop(p, String.length(c)), "/"))))
1934
1935type Hms is Data:
1936 Hms{h: U32, m: U32, s: U32}
1937
1938# §5.1.1 cookie-date: the first time, day, month and year tokens found.
1939type Cdate is Data:
1940 Cdate{time: Maybe<&2, Hms>, day: Maybe<&2, U32>, month: Maybe<&2, U32>, year: Maybe<&2, U32>}
1941
1942def cookie.date.delim(+c: U32) -> Bool:
1943 Bool.or(U32.is_eq(c, 9), Bool.or(Bool.and(U32.is_ge(c, 32), U32.is_le(c, 47)), Bool.or(Bool.and(U32.is_ge(c, 59), U32.is_le(c, 64)), Bool.or(Bool.and(U32.is_ge(c, 91), U32.is_le(c, 96)), Bool.and(U32.is_ge(c, 123), U32.is_le(c, 126))))))
1944
1945def cookie.date.push(acc: String, ts: List<&2, String>) -> List<&2, String>:
1946 match acc:
1947 case SNil{}:
1948 ts
1949 case SCon{h, t}:
1950 Con{String.reverse(SCon{h, t}), ts}
1951
1952def cookie.date.step(d: Bool, +c: U32, acc: String, ts: List<&2, String>) -> String & List<&2, String>:
1953 match d:
1954 case True{}:
1955 (SNil{}, cookie.date.push(acc, ts))
1956 case False{}:
1957 (SCon{Chr{c}, acc}, ts)
1958
1959# The date-tokens, last first. st: the token so far (reversed) and the tokens before it.
1960def cookie.date.tokens(s: String, st: String & List<&2, String>) -> List<&2, String>:
1961 match s:
1962 case SNil{}:
1963 (acc, ts) = st
1964 cookie.date.push(acc, ts)
1965 case SCon{Chr{+c}, t}:
1966 (acc, ts) = st
1967 cookie.date.tokens(t, cookie.date.step(cookie.date.delim(c), c, acc, ts))
1968
1969def cookie.date.head(+s: String) -> Bool:
1970 match s:
1971 case SNil{}:
1972 False{}
1973 case SCon{Chr{+c}, t}:
1974 parse_u32.digit(c)
1975
1976# The digits at the start of s: (count, value, rest). d: s starts with a digit.
1977def cookie.date.run(s: String, d: Bool, +n: U32, +acc: U32) -> U32 & U32 & String:
1978 match s:
1979 case SNil{}:
1980 (n, acc, SNil{})
1981 case SCon{Chr{+c}, +t}:
1982 match d:
1983 case True{}:
1984 cookie.date.run(t, cookie.date.head(t), (n + 1 : U32), (acc * 10 + (c - 48 : U32) : U32))
1985 case False{}:
1986 (n, acc, SCon{Chr{c}, t})
1987
1988def cookie.date.within(r: U32 & U32 & String, +lo: U32, +hi: U32) -> Maybe<&1, U32 & String>:
1989 (+n, v, rest) = r
1990 Bool.pick(Maybe<&1, U32 & String>, Bool.and(U32.is_ge(n, lo), U32.is_le(n, hi)), Some{(v, rest)}, None{})
1991
1992# lo to hi digits and what follows them, which does not start with a digit.
1993def cookie.date.num(+s: String, +lo: U32, +hi: U32) -> Maybe<&1, U32 & String>:
1994 cookie.date.within(cookie.date.run(s, cookie.date.head(s), 0, 0), lo, hi)
1995
1996def cookie.date.val(m: Maybe<&1, U32 & String>) -> Maybe<&2, U32>:
1997 match m:
1998 case None{}:
1999 None{}
2000 case Some{(v, t)}:
2001 Some{v}
2002
2003def cookie.date.colon(s: String) -> Maybe<&2, String>:
2004 match s:
2005 case SNil{}:
2006 None{}
2007 case SCon{Chr{58}, t}:
2008 Some{t}
2009 case SCon{Chr{c}, t}:
2010 None{}
2011
2012def cookie.date.sec(+h: U32, +m: U32, r: Maybe<&1, U32 & String>) -> Maybe<&2, Hms>:
2013 match r:
2014 case None{}:
2015 None{}
2016 case Some{(s, t)}:
2017 Some{Hms{h, m, s}}
2018
2019def cookie.date.min.c(+h: U32, +m: U32, c: Maybe<&2, String>) -> Maybe<&2, Hms>:
2020 match c:
2021 case None{}:
2022 None{}
2023 case Some{+t}:
2024 cookie.date.sec(h, m, cookie.date.num(t, 1, 2))
2025
2026def cookie.date.min(+h: U32, r: Maybe<&1, U32 & String>) -> Maybe<&2, Hms>:
2027 match r:
2028 case None{}:
2029 None{}
2030 case Some{(m, t)}:
2031 cookie.date.min.c(h, m, cookie.date.colon(t))
2032
2033def cookie.date.hour.c(+h: U32, c: Maybe<&2, String>) -> Maybe<&2, Hms>:
2034 match c:
2035 case None{}:
2036 None{}
2037 case Some{+t}:
2038 cookie.date.min(h, cookie.date.num(t, 1, 2))
2039
2040def cookie.date.hour(r: Maybe<&1, U32 & String>) -> Maybe<&2, Hms>:
2041 match r:
2042 case None{}:
2043 None{}
2044 case Some{(h, t)}:
2045 cookie.date.hour.c(h, cookie.date.colon(t))
2046
2047# hms-time: 1*2DIGIT ":" 1*2DIGIT ":" 1*2DIGIT, then anything but a digit.
2048def cookie.date.time(+tok: String) -> Maybe<&2, Hms>:
2049 cookie.date.hour(cookie.date.num(tok, 1, 2))
2050
2051def cookie.date.month.go(xs: List<&2, String>, +w: String, +i: U32) -> Maybe<&2, U32>:
2052 match xs:
2053 case Nil{}:
2054 None{}
2055 case Con{x, t}:
2056 Bool.pick(Maybe<&2, U32>, String.eq(x, w), Some{i}, cookie.date.month.go(t, w, (i + 1 : U32)))
2057
2058# The month named by the first three letters, from 1.
2059def cookie.date.month(+tok: String) -> Maybe<&2, U32>:
2060 cookie.date.month.go(["jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec"], String.to_lower(String.take(tok, 3n)), 1)
2061
2062# Each try* below: the flag is set, so go on; or the token matches, so stop; or go on.
2063def cookie.date.year(y: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, d: Maybe<&2, U32>, m: Maybe<&2, U32>) -> Cdate:
2064 match y:
2065 case None{}:
2066 Cdate{t, d, m, cookie.date.val(cookie.date.num(tok, 2, 4))}
2067 case Some{v}:
2068 Cdate{t, d, m, Some{v}}
2069
2070def cookie.date.month.got(g: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, d: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2071 match g:
2072 case None{}:
2073 cookie.date.year(y, tok, t, d, None{})
2074 case Some{v}:
2075 Cdate{t, d, Some{v}, y}
2076
2077def cookie.date.month.try(m: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, d: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2078 match m:
2079 case None{}:
2080 cookie.date.month.got(cookie.date.month(tok), tok, t, d, y)
2081 case Some{v}:
2082 cookie.date.year(y, tok, t, d, Some{v})
2083
2084def cookie.date.day.got(g: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, m: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2085 match g:
2086 case None{}:
2087 cookie.date.month.try(m, tok, t, None{}, y)
2088 case Some{v}:
2089 Cdate{t, Some{v}, m, y}
2090
2091def cookie.date.day.try(d: Maybe<&2, U32>, +tok: String, t: Maybe<&2, Hms>, m: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2092 match d:
2093 case None{}:
2094 cookie.date.day.got(cookie.date.val(cookie.date.num(tok, 1, 2)), tok, t, m, y)
2095 case Some{v}:
2096 cookie.date.month.try(m, tok, t, Some{v}, y)
2097
2098def cookie.date.time.got(g: Maybe<&2, Hms>, +tok: String, d: Maybe<&2, U32>, m: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2099 match g:
2100 case None{}:
2101 cookie.date.day.try(d, tok, None{}, m, y)
2102 case Some{v}:
2103 Cdate{Some{v}, d, m, y}
2104
2105def cookie.date.time.try(t: Maybe<&2, Hms>, +tok: String, d: Maybe<&2, U32>, m: Maybe<&2, U32>, y: Maybe<&2, U32>) -> Cdate:
2106 match t:
2107 case None{}:
2108 cookie.date.time.got(cookie.date.time(tok), tok, d, m, y)
2109 case Some{v}:
2110 cookie.date.day.try(d, tok, Some{v}, m, y)
2111
2112def cookie.date.fold(ts: List<&2, String>, st: Cdate) -> Cdate:
2113 match ts:
2114 case Nil{}:
2115 st
2116 case Con{+tok, rest}:
2117 Cdate{t, d, m, y} = st
2118 cookie.date.fold(rest, cookie.date.time.try(t, tok, d, m, y))
2119
2120# 70–99 are 19xx, 0–69 are 20xx.
2121def cookie.date.fix(+y: U32) -> U32:
2122 Bool.pick(U32, U32.is_le(y, 69), (y + 2000 : U32), Bool.pick(U32, U32.is_le(y, 99), (y + 1900 : U32), y))
2123
2124def cookie.date.at(+y: U32, +d: U32, mo: U32, h: U32, mi: U32, s: U32) -> Maybe<&2, Time.Instant>:
2125 Bool.pick(Maybe<&2, Time.Instant>, Bool.and(U32.is_ge(y, 1601), Bool.and(U32.is_ge(d, 1), U32.is_le(d, 31))), Time.mk(Time.DateTime{Time.Date{y, mo, d}, h, mi, s, 0}), None{})
2126
2127def cookie.date.fin(st: Cdate) -> Maybe<&2, Time.Instant>:
2128 match st:
2129 case Cdate{Some{Hms{h, mi, s}}, Some{d}, Some{mo}, Some{y}}:
2130 cookie.date.at(cookie.date.fix(y), d, mo, h, mi, s)
2131 case _:
2132 None{}
2133
2134# §5.1.1: a cookie-date such as "Sun, 06 Nov 1994 08:49:37 GMT" or "Thu, 01-Jan-70 00:00:01 GMT".
2135# Time.mk refuses a day past the month's end and a time past 23:59:59.
2136def cookie.date(s: String) -> Maybe<&2, Time.Instant>:
2137 cookie.date.fin(cookie.date.fold(List.reverse(&2, String, cookie.date.tokens(s, (SNil{}, Nil{}))), Cdate{None{}, None{}, None{}, None{}}))
2138
2139# §5.6.1–§5.6.7: the last of each attribute. expires is the date as sent; max_age is capped seconds.
2140# Neither is a time from now yet: a Cav with a Time.Instant and now beside it is too wide (bendlang/bend#1069).
2141type Cav is Data:
2142 Cav{expires: Maybe<&2, Time.Instant>, max_age: Maybe<&2, U32>, domain: String, path: Maybe<&2, String>, secure: Bool, http_only: Bool, same_site: String}
2143
2144def cookie.cav() -> Cav:
2145 Cav{None{}, None{}, "", None{}, False{}, False{}, "default"}
2146
2147# §5.5: 400 days, the longest a cookie lives.
2148def cookie.limit() -> U32:
2149 34560000
2150
2151def cookie.later(+now: Time.Instant, +secs: U32) -> Time.Instant:
2152 Time.Instant.add(now, Time.Duration.of_secs(Int.I64.from_u32(secs)))
2153
2154def cookie.expires.cap(+now: Time.Instant, m: Maybe<&2, Time.Instant>) -> Maybe<&2, Time.Instant>:
2155 match m:
2156 case None{}:
2157 None{}
2158 case Some{+t}:
2159 +lim = cookie.later(now, cookie.limit())
2160 Some{Bool.pick(Time.Instant, Cmp.is_lt(Time.Instant.cmp(lim, t)), lim, t)}
2161
2162def cookie.max_age.zero(m: Maybe<&2, U32>) -> Maybe<&2, U32>:
2163 match m:
2164 case None{}:
2165 None{}
2166 case Some{s}:
2167 Some{0}
2168
2169def cookie.max_age.nz(s: String) -> String:
2170 match s:
2171 case SNil{}:
2172 SNil{}
2173 case SCon{Chr{48}, t}:
2174 cookie.max_age.nz(t)
2175 case SCon{Chr{c}, t}:
2176 SCon{Chr{c}, t}
2177
2178# More than 9 significant digits is past the limit (and would overflow parse_u32).
2179def cookie.max_age.cap(long: Bool, m: Maybe<&2, U32>) -> Maybe<&2, U32>:
2180 match m:
2181 case None{}:
2182 None{}
2183 case Some{s}:
2184 Some{Bool.pick(U32, long, cookie.limit(), s)}
2185
2186def cookie.max_age.secs(+v: String, neg: Bool) -> Maybe<&2, U32>:
2187 match neg:
2188 case True{}:
2189 cookie.max_age.zero(parse_u32(String.drop(v, 1n)))
2190 case False{}:
2191 cookie.max_age.cap(cookie.over(cookie.max_age.nz(v), 9), parse_u32(v))
2192
2193# Zero or less is the earliest time, so the cookie is already expired.
2194def cookie.max_age.at(+now: Time.Instant, m: Maybe<&2, U32>) -> Maybe<&2, Time.Instant>:
2195 match m:
2196 case None{}:
2197 None{}
2198 case Some{+s}:
2199 Some{Bool.pick(Time.Instant, U32.is_eq(s, 0), Time.Instant.epoch(), cookie.later(now, U32.min(s, cookie.limit())))}
2200
2201# §5.6.2: DIGIT*, or "-" and DIGIT*. Anything else is ignored.
2202def cookie.max_age(+v: String) -> Maybe<&2, U32>:
2203 cookie.max_age.secs(v, String.starts_with(v, "-"))
2204
2205def cookie.same_site(+v: String) -> String:
2206 +l = String.to_lower(v)
2207 Bool.pick(String, Bool.or(String.eq(l, "strict"), Bool.or(String.eq(l, "lax"), String.eq(l, "none"))), l, "default")
2208
2209type Av is Data:
2210 AvExpires{}
2211 AvMaxAge{}
2212 AvDomain{}
2213 AvPath{}
2214 AvSecure{}
2215 AvHttpOnly{}
2216 AvSameSite{}
2217 AvOther{}
2218
2219def cookie.av.kind(+k: String) -> Av:
2220 Bool.pick(Av, String.eq(k, "expires"), AvExpires{}, Bool.pick(Av, String.eq(k, "max-age"), AvMaxAge{}, Bool.pick(Av, String.eq(k, "domain"), AvDomain{}, Bool.pick(Av, String.eq(k, "path"), AvPath{}, Bool.pick(Av, String.eq(k, "secure"), AvSecure{}, Bool.pick(Av, String.eq(k, "httponly"), AvHttpOnly{}, Bool.pick(Av, String.eq(k, "samesite"), AvSameSite{}, AvOther{})))))))
2221
2222# An Expires or Max-Age that does not parse leaves the earlier one. A leading dot of Domain is dropped.
2223def cookie.av.put(k: Av, a: Cav, +v: String) -> Cav:
2224 match k a:
2225 case AvExpires{} Cav{e, m, d, p, s, h, ss}:
2226 Cav{Maybe.or(&2, Time.Instant, cookie.date(v), e), m, d, p, s, h, ss}
2227 case AvMaxAge{} Cav{e, m, d, p, s, h, ss}:
2228 Cav{e, Maybe.or(&2, U32, cookie.max_age(v), m), d, p, s, h, ss}
2229 case AvDomain{} Cav{e, m, d, p, s, h, ss}:
2230 Cav{e, m, String.to_lower(Bool.pick(String, String.starts_with(v, "."), String.drop(v, 1n), v)), p, s, h, ss}
2231 case AvPath{} Cav{e, m, d, p, s, h, ss}:
2232 Cav{e, m, d, Some{v}, s, h, ss}
2233 case AvSecure{} Cav{e, m, d, p, s, h, ss}:
2234 Cav{e, m, d, p, True{}, h, ss}
2235 case AvHttpOnly{} Cav{e, m, d, p, s, h, ss}:
2236 Cav{e, m, d, p, s, True{}, ss}
2237 case AvSameSite{} Cav{e, m, d, p, s, h, ss}:
2238 Cav{e, m, d, p, s, h, cookie.same_site(v)}
2239 case AvOther{} Cav{e, m, d, p, s, h, ss}:
2240 Cav{e, m, d, p, s, h, ss}
2241
2242# §5.6: name and value trimmed; a value over 1024 octets drops the attribute.
2243def cookie.av(+a: Cav, kv: String & String & Bool) -> Cav:
2244 (k, v, found) = kv
2245 +tv = trim(v)
2246 Bool.pick(Cav, cookie.over(tv, 1024), a, cookie.av.put(cookie.av.kind(String.to_lower(trim(k))), a, tv))
2247
2248def cookie.avs(xs: List<&2, String>, a: Cav) -> Cav:
2249 match xs:
2250 case Nil{}:
2251 a
2252 case Con{x, t}:
2253 cookie.avs(t, cookie.av(a, cookie.cut(x, 61)))
2254
2255# §5.6: with no "=", the name is empty and the pair is the value.
2256def cookie.nv(r: String & String & Bool) -> String & String:
2257 (a, b, found) = r
2258 match found:
2259 case True{}:
2260 (trim(a), trim(b))
2261 case False{}:
2262 ("", trim(a))
2263
2264def cookie.prefixed(+s: String, +p: String) -> Bool:
2265 String.starts_with(String.to_lower(s), p)
2266
2267# §5.7 steps 8–10: (domain, host-only), or None to ignore the cookie.
2268# ponytail: the public-suffix check knows single-label suffixes only (com, org, localhost). Multi-label
2269# ones (co.uk, github.io) need the publicsuffix.org list; ship it as data when a caller needs it.
2270def cookie.domain.of(+host: String, +d: String) -> Maybe<&1, String & Bool>:
2271 +suffix = Bool.and(Bool.not(String.is_empty(d)), Bool.not(String.contains(d, ".")))
2272 +d2 = Bool.pick(String, Bool.and(suffix, String.eq(d, host)), "", d)
2273 Bool.pick(Maybe<&1, String & Bool>, Bool.or(Bool.and(suffix, Bool.not(String.eq(d, host))), Bool.not(cookie.ascii(d))), None{},
2274 Bool.pick(Maybe<&1, String & Bool>, String.is_empty(d2), Some{(host, True{})},
2275 Bool.pick(Maybe<&1, String & Bool>, cookie.domain_match(host, d2), Some{(d2, False{})}, None{})))
2276
2277def cookie.path.of(p: Maybe<&2, String>, +req: String) -> String:
2278 match p:
2279 case None{}:
2280 cookie.default_path(req)
2281 case Some{+v}:
2282 Bool.pick(String, String.starts_with(v, "/"), v, cookie.default_path(req))
2283
2284# §5.7 steps 12–20: Secure needs https; SameSite=None needs Secure; the __Secure- and __Host- prefixes.
2285def cookie.make.dm(dm: Maybe<&1, String & Bool>, +name: String, +value: String, +path: String, has_path: Bool, +secure: Bool, http_only: Bool, +same_site: String, expiry: Maybe<&2, Time.Instant>, https: Bool) -> Maybe<&2, Cookie>:
2286 match dm:
2287 case None{}:
2288 None{}
2289 case Some{(domain, +host_only)}:
2290 +host = Bool.and(Bool.and(secure, host_only), Bool.and(has_path, String.eq(path, "/")))
2291 +bad = Bool.or(Bool.or(Bool.and(secure, Bool.not(https)), Bool.and(String.eq(same_site, "none"), Bool.not(secure))),
2292 Bool.or(Bool.or(Bool.and(cookie.prefixed(name, "__secure-"), Bool.not(secure)), Bool.and(cookie.prefixed(name, "__host-"), Bool.not(host))),
2293 Bool.and(String.is_empty(name), Bool.or(cookie.prefixed(value, "__secure-"), cookie.prefixed(value, "__host-")))))
2294 Bool.pick(Maybe<&2, Cookie>, bad, None{}, Some{Cookie{name, value, domain, host_only, path, secure, http_only, same_site, expiry}})
2295
2296# Max-Age wins over Expires, whatever their order (§5.7 step 6). Both count from now.
2297def cookie.expiry(+now: Time.Instant, m: Maybe<&2, U32>, e: Maybe<&2, Time.Instant>) -> Maybe<&2, Time.Instant>:
2298 Maybe.or(&2, Time.Instant, cookie.max_age.at(now, m), cookie.expires.cap(now, e))
2299
2300def cookie.make(+now: Time.Instant, a: Url.Abs, +name: String, +value: String, c: Cav) -> Maybe<&2, Cookie>:
2301 Url.Abs{scheme, host, port, target} = a
2302 Cav{e, m, d, +p, secure, http_only, same_site} = c
2303 cookie.make.dm(cookie.domain.of(host, d), name, value, cookie.path.of(p, cookie.target_path(target)), Maybe.is_some(&2, String, p), secure, http_only, same_site, cookie.expiry(now, m, e), String.eq(scheme, "https"))
2304
2305# An empty name and value, or more than 4096 octets of them, is ignored.
2306def cookie.parse.nv(+now: Time.Instant, a: Url.Abs, nv: String & String, avs: List<&2, String>) -> Maybe<&2, Cookie>:
2307 (+name, +value) = nv
2308 Bool.pick(Maybe<&2, Cookie>, Bool.or(Bool.and(String.is_empty(name), String.is_empty(value)), cookie.over(name ++ value, 4096)), None{}, cookie.make(now, a, name, value, cookie.avs(avs, cookie.cav())))
2309
2310def cookie.parse.go(+now: Time.Instant, a: Url.Abs, xs: List<&2, String>) -> Maybe<&2, Cookie>:
2311 match xs:
2312 case Nil{}:
2313 None{}
2314 case Con{first, avs}:
2315 cookie.parse.nv(now, a, cookie.nv(cookie.cut(first, 61)), avs)
2316
2317# §5.6 and §5.7: one Set-Cookie value received from a at now, or None when it is ignored.
2318def cookie.parse(+now: Time.Instant, a: Url.Abs, +line: String) -> Maybe<&2, Cookie>:
2319 Bool.pick(Maybe<&2, Cookie>, cookie.ctl(line), None{}, cookie.parse.go(now, a, String.split(line, ';')))
2320
2321def cookie.https(a: Url.Abs) -> Bool:
2322 Url.Abs{scheme, host, port, target} = a
2323 String.eq(scheme, "https")
2324
2325def cookie.secure(c: Cookie) -> Bool:
2326 Cookie{name, value, domain, host_only, path, secure, http_only, same_site, expiry} = c
2327 secure
2328
2329# Same name, domain, host-only flag and path: the new cookie replaces the old one.
2330def cookie.same(+a: Cookie, +b: Cookie) -> Bool:
2331 Cookie{n1, v1, d1, h1, p1, s1, o1, ss1, e1} = a
2332 Cookie{n2, v2, d2, h2, p2, s2, o2, ss2, e2} = b
2333 Bool.and(Bool.and(String.eq(n1, n2), String.eq(d1, d2)), Bool.and(Bool.not(Bool.xor(h1, h2)), String.eq(p1, p2)))
2334
2335# §5.7 step 16: a secure cookie that a new cookie from plain http must not overlay.
2336def cookie.shadows(+old: Cookie, +c: Cookie) -> Bool:
2337 Cookie{n1, v1, +d1, h1, p1, s1, o1, ss1, e1} = old
2338 Cookie{n2, v2, +d2, h2, p2, s2, o2, ss2, e2} = c
2339 Bool.and(Bool.and(String.eq(n1, n2), s1), Bool.and(Bool.or(cookie.domain_match(d1, d2), cookie.domain_match(d2, d1)), cookie.path_match(p2, p1)))
2340
2341def cookie.shadowed(cs: List<&2, Cookie>, +c: Cookie) -> Bool:
2342 match cs:
2343 case Nil{}:
2344 False{}
2345 case Con{+o, t}:
2346 Bool.or(cookie.shadows(o, c), cookie.shadowed(t, c))
2347
2348# cs with the cookie c replaces swapped for c (keeping its place, so its creation order), or c last.
2349# A c that is not live only removes the old one: that is how a server deletes a cookie.
2350def cookie.put(cs: List<&2, Cookie>, +c: Cookie, +live: Bool) -> List<&2, Cookie>:
2351 match cs:
2352 case Nil{}:
2353 Bool.pick(List<&2, Cookie>, live, [c], Nil{})
2354 case Con{+o, +t}:
2355 Bool.pick(List<&2, Cookie>, cookie.same(o, c), Bool.pick(List<&2, Cookie>, live, Con{c, t}, t), Con{o, cookie.put(t, c, live)})
2356
2357def jar.put.c(m: Maybe<&2, Cookie>, j: Jar, +https: Bool) -> Jar:
2358 match m:
2359 case None{}:
2360 Jar{now, cs} = j
2361 Jar{now, cs}
2362 case Some{+c}:
2363 Jar{+now, +cs} = j
2364 Jar{now, Bool.pick(List<&2, Cookie>, Bool.and(Bool.not(Bool.or(https, cookie.secure(c))), cookie.shadowed(cs, c)), cs, cookie.put(cs, c, cookie.live(now, c)))}
2365
2366def jar.put.one(j: Jar, +a: Url.Abs, x: String) -> Jar:
2367 Jar{+now, cs} = j
2368 jar.put.c(cookie.parse(now, a, x), Jar{now, cs}, cookie.https(a))
2369
2370def jar.put.all(xs: List<&2, String>, j: Jar, +a: Url.Abs) -> Jar:
2371 match xs:
2372 case Nil{}:
2373 j
2374 case Con{x, t}:
2375 jar.put.all(t, jar.put.one(j, a, x), a)
2376
2377# Every set-cookie field of h, in order, as received from a.
2378def jar.store.abs(j: Jar, +a: Url.Abs, +h: Map<&2, List<&2, String>>) -> Jar:
2379 jar.put.all(fields(h, "set-cookie"), j, a)
2380
2381def jar.store.url(j: Jar, u: Maybe<&2, Url.Abs>, +h: Map<&2, List<&2, String>>) -> Jar:
2382 match u:
2383 case None{}:
2384 j
2385 case Some{+a}:
2386 jar.store.abs(j, a, h)
2387
2388# The jar after res came from url, and res as it was. Header names are lowercase, as parse gives them.
2389# An unparsable url stores nothing.
2390def jar.store(j: Jar, url: String, res: Res) -> Jar & Res:
2391 Res{status, +headers, body} = res
2392 (jar.store.url(j, Url.absolute(url), headers), Res{status, headers, body})
2393
2394# §5.8.3: domain (exact when host-only), path, and Secure only over https.
2395def cookie.sends(+host: String, +path: String, +https: Bool, +c: Cookie) -> Bool:
2396 Cookie{n, v, +d, +ho, +p, s, o, ss, e} = c
2397 Bool.and(Bool.pick(Bool, ho, String.eq(host, d), cookie.domain_match(host, d)), Bool.and(cookie.path_match(path, p), Bool.or(Bool.not(s), https)))
2398
2399def cookie.pick(cs: List<&2, Cookie>, +host: String, +path: String, +https: Bool) -> List<&2, Cookie>:
2400 match cs:
2401 case Nil{}:
2402 Nil{}
2403 case Con{+c, t}:
2404 List.filter.put(Cookie, c, cookie.pick(t, host, path, https), cookie.sends(host, path, https, c))
2405
2406# The sort order of §5.8.3: longer paths first; the stable sort keeps creation order among equals.
2407def cookie.longer(a: Cookie, b: Cookie) -> Bool:
2408 Cookie{n1, v1, d1, h1, p1, s1, o1, ss1, e1} = a
2409 Cookie{n2, v2, d2, h2, p2, s2, o2, ss2, e2} = b
2410 Bool.not(Nat.is_lt(String.length(p1), String.length(p2)))
2411
2412def cookie.pair(c: Cookie) -> String:
2413 Cookie{+n, +v, d, h, p, s, o, ss, e} = c
2414 Bool.pick(String, String.is_empty(n), v, n ++ "=" ++ v)
2415
2416def cookie.pairs(cs: List<&2, Cookie>) -> List<&2, String>:
2417 match cs:
2418 case Nil{}:
2419 Nil{}
2420 case Con{c, t}:
2421 Con{cookie.pair(c), cookie.pairs(t)}
2422
2423# §5.8.3: the cookie-string for a request to a, or "" when no cookie matches.
2424def jar.string(j: Jar, a: Url.Abs) -> String:
2425 Jar{now, cs} = j
2426 Url.Abs{scheme, +host, port, target} = a
2427 String.join(cookie.pairs(List.sort(~Cookie, ~cookie.longer, cookie.pick(cs, host, cookie.target_path(target), String.eq(scheme, "https")))), "; ")
2428
2429# One cookie field: the caller's own cookie values first, then the jar's.
2430def jar.header(+h: Map<&2, List<&2, String>>, +s: String) -> Map<&2, List<&2, String>>:
2431 +old = String.join(fields(h, "cookie"), "; ")
2432 Bool.pick(Map<&2, List<&2, String>>, String.is_empty(s), h, set(h, "cookie", Bool.pick(String, String.is_empty(old), s, old ++ "; " ++ s)))
2433
2434def jar.apply.url(j: Jar, u: Maybe<&2, Url.Abs>, +h: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
2435 match u:
2436 case None{}:
2437 h
2438 case Some{a}:
2439 jar.header(h, jar.string(j, a))
2440
2441# The headers with the jar's cookies for a request to url in their cookie field (lowercase, as fetch
2442# sends names). An unparsable url adds nothing.
2443def jar.apply(j: Jar, url: String, +h: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
2444 jar.apply.url(j, Url.absolute(url), h)
2445
2446# The jar, if any, that a fetch threads through its hops.
2447def jar.opt.apply(m: Maybe<&2, Jar>, a: Url.Abs, +h: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
2448 match m:
2449 case None{}:
2450 h
2451 case Some{j}:
2452 jar.header(h, jar.string(j, a))
2453
2454def jar.opt.res(j: Jar, +a: Url.Abs, r: Result<&1, &1, Err, Res>) -> Maybe<&2, Jar> & Result<&1, &1, Err, Res>:
2455 match r:
2456 case Fail{e}:
2457 (Some{j}, Fail{e})
2458 case Done{res}:
2459 Res{status, +headers, body} = res
2460 (Some{jar.store.abs(j, a, headers)}, Done{Res{status, headers, body}})
2461
2462def jar.opt.store(m: Maybe<&2, Jar>, +a: Url.Abs, r: Result<&1, &1, Err, Res>) -> Maybe<&2, Jar> & Result<&1, &1, Err, Res>:
2463 match m:
2464 case None{}:
2465 (None{}, r)
2466 case Some{j}:
2467 jar.opt.res(j, a, r)
2468
2469def io.recv.words(tls: Bool, s: Socket, max: U32, ms: U32) -> IO(Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>):
2470 match tls:
2471 case True{}:
2472 Wire.tls.recv.words(s, max, ms)
2473 case False{}:
2474 Wire.recv.words(s, max, ms)
2475
2476def io.send.words(tls: Bool, s: Socket, +len: U32, buf: Array<U32>) -> IO(Socket & Result<&1, &1, U32 & String, Unit>):
2477 match tls:
2478 case True{}:
2479 Wire.tls.send.words(s, len, buf)
2480 case False{}:
2481 Wire.send.words(s, len, buf)
2482
2483def io.send.bytes(tls: Bool, s: Socket, b: Bytes.Bytes) -> IO(Socket & Result<&1, &1, U32 & String, Unit>):
2484 Bytes.Bytes{+len, buf} = b
2485 io.send.words(tls, s, len, buf)
2486
2487def io.close(tls: Bool, s: Socket) -> IO(Unit):
2488 match tls:
2489 case True{}:
2490 Wire.tls.close(s)
2491 case False{}:
2492 Socket.close(s)
2493
2494def fetch.close(tls: Bool, s: Socket, r: Result<&1, &1, Err, Res>) -> IO(Result<&1, &1, Err, Res>):
2495 do IO<Result<&1, &1, Err, Res>>:
2496 io.close(tls, s)
2497 return r
2498
2499# none: no response byte arrived, so an idempotent request may be retried (RFC 9112 §9.3.1).
2500# sock: the socket, when it can take another request.
2501type Out is Type:
2502 OutDone{res: Res, sock: Maybe<&1, Socket>, rest: Bytes.Bytes}
2503 OutFail{e: Err, none: Bool}
2504
2505def fetch.boxed(r: Result<&1, &1, Err, Res>, none: Bool) -> Out:
2506 match r:
2507 case Done{res}:
2508 OutDone{res, None{}, Bytes.new(0)}
2509 case Fail{e}:
2510 OutFail{e, none}
2511
2512def fetch.bad(tls: Bool, s: Socket, e: Maybe<&2, Err>) -> IO(Result<&1, &1, Err, Res>):
2513 match e:
2514 case None{}:
2515 fetch.close(tls, s, Fail{ErrBad{}})
2516 case Some{err}:
2517 fetch.close(tls, s, Fail{err})
2518
2519def fetch.shut(tls: Bool, s: Socket, r: Result<&1, &1, Err, Res>, none: Bool) -> IO(Out):
2520 do IO<Out>:
2521 x : Result<&1, &1, Err, Res> <- fetch.close(tls, s, r)
2522 return fetch.boxed(x, none)
2523
2524def fetch.hold.go(tls: Bool, s: Socket, res: Res, left: Maybe<&1, Bytes.Bytes>) -> IO(Out):
2525 match left:
2526 case Some{x}:
2527 IO.pure(Out, OutDone{res, Some{s}, x})
2528 case None{}:
2529 fetch.shut(tls, s, Done{res}, False{})
2530
2531def fetch.hold(tls: Bool, close: Bool, s: Socket, res: Res, left: Maybe<&1, Bytes.Bytes>) -> IO(Out):
2532 Res{status, +headers, body} = res
2533 fetch.hold.go(tls, s, Res{status, headers, body}, again(close, headers, left))
2534
2535def fetch.failout(tls: Bool, s: Socket, e: Maybe<&2, Err>, none: Bool) -> IO(Out):
2536 do IO<Out>:
2537 r : Result<&1, &1, Err, Res> <- fetch.bad(tls, s, e)
2538 return fetch.boxed(r, none)
2539
2540# Read state: the response so far and the bytes read, or how it ended.
2541# none: no byte arrived, so an idempotent request may be retried.
2542type Fl is Type:
2543 FlMore{rv: Rv, n: U32}
2544 FlBad{err: Maybe<&2, Err>, none: Bool}
2545 FlDone{res: Res, rest: Maybe<&1, Bytes.Bytes>}
2546
2547def fetch.rt(+n: U32, t: Rt) -> Fl:
2548 match t:
2549 case RtMore{rv}:
2550 FlMore{rv, n}
2551 case RtBad{}:
2552 FlBad{None{}, U32.is_zero(n)}
2553 case RtDone{res, rest}:
2554 FlDone{res, rest}
2555
2556# 64 KiB of head past the body cap, as serve allows.
2557def fetch.over(+n: U32) -> Bool:
2558 Nat.is_lt(Nat.add(fetch.max(), 65536n), U32.to_nat(n))
2559
2560def fetch.piece.cap(over: Bool, +head: Bool, rv: Rv, +n2: U32, +len: U32, buf: Array<U32>) -> Fl:
2561 match over:
2562 case True{}:
2563 FlBad{None{}, False{}}
2564 case False{}:
2565 fetch.rt(n2, rv.step(U32.is_zero(len), head, rv, Bytes.Bytes{len, buf}))
2566
2567def fetch.piece(+head: Bool, rv: Rv, +n: U32, p: U32 & Array<U32>) -> Fl:
2568 (+len, buf) = p
2569 +n2 = (n + len : U32)
2570 fetch.piece.cap(fetch.over(n2), head, rv, n2, len, buf)
2571
2572def fetch.next(+head: Bool, rv: Rv, +n: U32, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Socket & Fl:
2573 (s, r) = m
2574 match r:
2575 case Fail{(+code, why)}:
2576 (s, FlBad{Some{err.or_late(code, ErrRead{code, why})}, U32.is_zero(n)})
2577 case Done{p}:
2578 (s, fetch.piece(head, rv, n, p))
2579
2580# Reads until the response is whole or cannot be; an empty read means the server closed.
2581@unsafe
2582def fetch.loop(+close: Bool, +head: Bool, +tls: Bool, +ms: U32, st: Socket & Fl) -> IO(Out):
2583 (s, fl) = st
2584 match fl:
2585 case FlMore{rv, +n}:
2586 do IO<Out>:
2587 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- io.recv.words(tls, s, 65536, ms)
2588 fetch.loop(close, head, tls, ms, fetch.next(head, rv, n, m))
2589 case FlBad{err, none}:
2590 fetch.failout(tls, s, err, none)
2591 case FlDone{res, rest}:
2592 fetch.hold(tls, close, s, res, rest)
2593
2594def exchange.sent(+tls: Bool, +ms: U32, +close: Bool, +head: Bool, m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Out):
2595 (s, r) = m
2596 match r:
2597 case Fail{(+code, why)}:
2598 fetch.shut(tls, s, Fail{err.or_late(code, ErrWrite{code, why})}, True{})
2599 case Done{u}:
2600 fetch.loop(close, head, tls, ms, (s, FlMore{rv.start(), 0}))
2601
2602def exchange.go(+tls: Bool, +ms: U32, +close: Bool, +head: Bool, s: Socket, wire: Bytes.Bytes) -> IO(Out):
2603 do IO<Out>:
2604 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, wire)
2605 exchange.sent(tls, ms, close, head, sent)
2606
2607def exchange.tup(o: Out) -> Maybe<&1, Socket> & Result<&1, &1, Err, Res> & Bytes.Bytes:
2608 match o:
2609 case OutFail{e, none}:
2610 (None{}, Fail{e}, Bytes.new(0))
2611 case OutDone{res, sock, rest}:
2612 (sock, Done{res}, rest)
2613
2614# One request on an open socket. Some{socket}: it can take another request.
2615def exchange(+tls: Bool, +ms: U32, +close: Bool, +head: Bool, s: Socket, wire: Bytes.Bytes) -> IO(Maybe<&1, Socket> & Result<&1, &1, Err, Res> & Bytes.Bytes):
2616 do IO<Maybe<&1, Socket> & Result<&1, &1, Err, Res> & Bytes.Bytes>:
2617 o : Out <- exchange.go(tls, ms, close, head, s, wire)
2618 return exchange.tup(o)
2619
2620# Paths to a PEM client chain and its private key for mutual TLS.
2621type Cert is Data:
2622 Cert{chain: String, key: String}
2623
2624type Proxy is Data:
2625 ProxyDirect{}
2626 ProxyVia{host: String, port: U32, authorization: String}
2627
2628type Route is Data:
2629 RouteDirect{tls: Bool, host: String, port: U32, cert: Maybe<&2, Cert>}
2630 RouteProxy{tls: Bool, host: String, port: U32, sni: String,
2631 authority: String, authorization: String, cert: Maybe<&2, Cert>}
2632
2633# Connection pool: idle sockets by origin and client identity, newest first, at most cap per key.
2634# fetch uses a fresh pool per call.
2635
2636type Conn is Type:
2637 Conn{tls: Bool, s: Socket}
2638 ConnH2{s: Socket, client: H2.Client}
2639
2640type Send is Type:
2641 Send{method: String, target: String, authority: String,
2642 headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
2643
2644type H2Step is Type:
2645 H2Reply{s: Socket, reply: H2.Reply}
2646 H2Sent{client: H2.Client, events: List<&1, H2.ClientEvent>,
2647 sent: Result<&1, &1, Err, Socket>}
2648 H2Events{s: Socket, client: H2.Client, result: Result<&1, &1, Err, Maybe<&1, Res>>}
2649 H2Received{client: H2.Client,
2650 answer: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>}
2651
2652type TunnelStep is Type:
2653 TunnelRead{s: Socket, raw: String}
2654 TunnelHead{s: Socket, raw: String, frame: Frame}
2655 TunnelGot{raw: String,
2656 answer: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>}
2657
2658type Pool is Type:
2659 Pool{cap: U32, idle: Map<&1, List<&1, Conn>>}
2660
2661def pool.new.with(+cap: U32) -> Pool:
2662 Pool{cap, Map.new(&1, List<&1, Conn>)}
2663
2664# Up to 8 idle sockets per origin.
2665def pool.new() -> Pool:
2666 pool.new.with(8)
2667
2668def pool.key(+scheme: String, +host: String, +port: U32) -> String:
2669 scheme ++ "://" ++ host ++ ":" ++ U32.show(port)
2670
2671def pool.key.cert(+base: String, cert: Maybe<&2, Cert>) -> String:
2672 match cert:
2673 case None{}:
2674 base
2675 case Some{Cert{+chain, +key}}:
2676 base ++ "|cert:" ++ Nat.show(String.length(chain)) ++ ":" ++ chain
2677 ++ Nat.show(String.length(key)) ++ ":" ++ key
2678
2679def pool.take.of(+cap: U32, +key: String, r: Map<&1, List<&1, Conn>> & Maybe<&1, List<&1, Conn>>) -> Pool & Maybe<&1, Conn>:
2680 (m, got) = r
2681 match got:
2682 case None{}:
2683 (Pool{cap, m}, None{})
2684 case Some{xs}:
2685 match xs:
2686 case Nil{}:
2687 (Pool{cap, m}, None{})
2688 case Con{c, t}:
2689 (Pool{cap, Map.set(&1, List<&1, Conn>, m, key, t)}, Some{c})
2690
2691# The socket given back last.
2692def pool.take(p: Pool, +key: String) -> Pool & Maybe<&1, Conn>:
2693 Pool{+cap, idle} = p
2694 pool.take.of(cap, key, Map.pop(&1, List<&1, Conn>, idle, key))
2695
2696def conn.close(c: Conn) -> IO(Unit):
2697 match c:
2698 case Conn{tls, s}:
2699 io.close(tls, s)
2700 case ConnH2{s, client}:
2701 Wire.tls.close(s)
2702
2703# The first n sockets; the rest are closed.
2704def conns.cut(xs: List<&1, Conn>, n: Nat) -> IO(List<&1, Conn>):
2705 match xs:
2706 case Nil{}:
2707 IO.pure(List<&1, Conn>, Nil{})
2708 case Con{c, t}:
2709 match n:
2710 case 0n:
2711 do IO<List<&1, Conn>>:
2712 conn.close(c)
2713 conns.cut(t, 0n)
2714 case 1n+k:
2715 do IO<List<&1, Conn>>:
2716 r : List<&1, Conn> <- conns.cut(t, k)
2717 return c <> r
2718
2719def pool.give.of(+cap: U32, +key: String, c: Conn, limit: Nat,
2720 r: Map<&1, List<&1, Conn>> & Maybe<&1, List<&1, Conn>>) -> IO(Pool):
2721 (m, old) = r
2722 do IO<Pool>:
2723 xs : List<&1, Conn> <- conns.cut(c <> Maybe.default(&1, List<&1, Conn>, old, Nil{}), limit)
2724 return Pool{cap, Map.set(&1, List<&1, Conn>, m, key, xs)}
2725
2726# Past the limit (cap for HTTP/1.1, one session for HTTP/2), close the oldest idle connection.
2727def pool.give(p: Pool, +key: String, c: Conn) -> IO(Pool):
2728 Pool{+cap, idle} = p
2729 match c:
2730 case Conn{tls, s}:
2731 pool.give.of(cap, key, Conn{tls, s}, U32.to_nat(cap), Map.pop(&1, List<&1, Conn>, idle, key))
2732 case ConnH2{s, client}:
2733 pool.give.of(cap, key, ConnH2{s, client}, Bool.pick(Nat, U32.is_zero(cap), 0n, 1n),
2734 Map.pop(&1, List<&1, Conn>, idle, key))
2735
2736def pool.close.go(xs: List<&1, List<&1, Conn>>) -> IO(Unit):
2737 match xs:
2738 case Nil{}:
2739 IO.pure(Unit, Unit{})
2740 case Con{cs, t}:
2741 do IO<Unit>:
2742 none : List<&1, Conn> <- conns.cut(cs, 0n)
2743 pool.close.go(t)
2744
2745def pool.close(p: Pool) -> IO(Unit):
2746 Pool{cap, idle} = p
2747 pool.close.go(Map.values(&1, List<&1, Conn>, idle))
2748
2749# RFC 9110 §9.2.2
2750def pool.idempotent(+method: String) -> Bool:
2751 Bool.or(String.eq(method, "GET"), Bool.or(String.eq(method, "HEAD"), Bool.or(String.eq(method, "OPTIONS"), Bool.or(String.eq(method, "TRACE"), Bool.or(String.eq(method, "PUT"), String.eq(method, "DELETE"))))))
2752
2753def conn.tls(m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Result<&1, &1, Err, Conn>):
2754 (s, r) = m
2755 match r:
2756 case Fail{(+code, why)}:
2757 do IO<Result<&1, &1, Err, Conn>>:
2758 Wire.tls.close(s)
2759 return Fail{err.or_late(code, ErrTls{code, why})}
2760 case Done{u}:
2761 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{True{}, s}})
2762
2763def conn.h2.sent(client: H2.Client, r: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Result<&1, &1, Err, Conn>):
2764 (s, sent) = r
2765 match sent:
2766 case Fail{(+code, why)}:
2767 do IO<Result<&1, &1, Err, Conn>>:
2768 Wire.tls.close(s)
2769 return Fail{err.or_late(code, ErrWrite{code, why})}
2770 case Done{u}:
2771 IO.pure(Result<&1, &1, Err, Conn>, Done{ConnH2{s, client}})
2772
2773def conn.h2.start(s: Socket, r: H2.Client & HBytes.Bytes) -> IO(Result<&1, &1, Err, Conn>):
2774 (client, HBytes.Bytes{len, buf}) = r
2775 do IO<Result<&1, &1, Err, Conn>>:
2776 sent : Socket & Result<&1, &1, U32 & String, Unit> <- Wire.tls.send.words(s, len, buf)
2777 conn.h2.sent(client, sent)
2778
2779def conn.tls.protocol(proto: String, s: Socket) -> IO(Result<&1, &1, Err, Conn>):
2780 match proto:
2781 case "h2":
2782 conn.h2.start(s, H2.client.start())
2783 case "http/1.1":
2784 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{True{}, s}})
2785 case "":
2786 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{True{}, s}})
2787 case other:
2788 do IO<Result<&1, &1, Err, Conn>>:
2789 Wire.tls.close(s)
2790 return Fail{ErrTls{71, "unsupported ALPN: " ++ other}}
2791
2792def conn.tls.alpn(m: Socket & Result<&1, &1, U32 & String, String>) -> IO(Result<&1, &1, Err, Conn>):
2793 (s, r) = m
2794 match r:
2795 case Fail{(+code, why)}:
2796 do IO<Result<&1, &1, Err, Conn>>:
2797 Wire.tls.close(s)
2798 return Fail{err.or_late(code, ErrTls{code, why})}
2799 case Done{proto}:
2800 conn.tls.protocol(proto, s)
2801
2802def conn.secure.no.cert(offer: Bool, s: Socket, host: String, +ms: U32) ->
2803 IO(Result<&1, &1, Err, Conn>):
2804 match offer:
2805 case True{}:
2806 do IO<Result<&1, &1, Err, Conn>>:
2807 hs : Socket & Result<&1, &1, U32 & String, String> <-
2808 Wire.tls.connect.alpn(s, host, ms, "h2,http/1.1")
2809 conn.tls.alpn(hs)
2810 case False{}:
2811 do IO<Result<&1, &1, Err, Conn>>:
2812 hs : Socket & Result<&1, &1, U32 & String, Unit> <- Wire.tls.connect(s, host, ms)
2813 conn.tls(hs)
2814
2815def conn.secure.tls(cert: Maybe<&2, Cert>, s: Socket, host: String, +ms: U32,
2816 offer: Bool) -> IO(Result<&1, &1, Err, Conn>):
2817 match cert:
2818 case None{}:
2819 conn.secure.no.cert(offer, s, host, ms)
2820 case Some{Cert{chain, key}}:
2821 do IO<Result<&1, &1, Err, Conn>>:
2822 hs : Socket & Result<&1, &1, U32 & String, Unit> <-
2823 Wire.tls.connect.cert(s, host, ms, chain, key)
2824 conn.tls(hs)
2825
2826# A failed handshake is an error, never plaintext.
2827def conn.secure(+ms: U32, sni: String, s: Socket, tls: Bool,
2828 cert: Maybe<&2, Cert>, offer: Bool) -> IO(Result<&1, &1, Err, Conn>):
2829 match tls:
2830 case False{}:
2831 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{False{}, s}})
2832 case True{}:
2833 conn.secure.tls(cert, s, sni, ms, offer)
2834
2835def conn.made(+ms: U32, sni: String, tls: Bool, cert: Maybe<&2, Cert>,
2836 offer: Bool, r: Result<&1, &1, U32 & String, Socket>) ->
2837 IO(Result<&1, &1, Err, Conn>):
2838 match r:
2839 case Fail{(+code, why)}:
2840 IO.pure(Result<&1, &1, Err, Conn>, Fail{err.or_late(code, ErrConnect{code, why})})
2841 case Done{s}:
2842 conn.secure(ms, sni, s, tls, cert, offer)
2843
2844def conn.open(+tls: Bool, +ms: U32, sni: String, ip: String, port: U32) ->
2845 IO(Result<&1, &1, Err, Conn>):
2846 do IO<Result<&1, &1, Err, Conn>>:
2847 c : Result<&1, &1, U32 & String, Socket> <- Wire.connect(ip, port, ms)
2848 conn.made(ms, sni, tls, None{}, False{}, c)
2849
2850# ponytail: addresses are tried in order, not raced; a broken first route can consume the step timeout.
2851type Dial is Type:
2852 Dial{port: U32, ms: U32, deadline: Nat, action: IO(Result<&1, &1, U32 & String, Socket>)}
2853
2854def conn.dial.time(+ip: String, +port: U32, +deadline: Nat, now: Nat, expired: Bool) ->
2855 IO(Result<&1, &1, U32 & String, Socket>):
2856 match expired:
2857 case True{}:
2858 IO.pure(Result<&1, &1, U32 & String, Socket>, Fail{(60, "connect timeout")})
2859 case False{}:
2860 Wire.connect(ip, port, U32.from_nat(Nat.sub(deadline, now)))
2861
2862def conn.dial.with(+ip: String, +port: U32, +ms: U32, +deadline: Nat, +now: Nat, unlimited: Bool) ->
2863 IO(Result<&1, &1, U32 & String, Socket>):
2864 match unlimited:
2865 case True{}:
2866 Wire.connect(ip, port, 0)
2867 case False{}:
2868 conn.dial.time(ip, port, deadline, now, Nat.is_le(deadline, now))
2869
2870def conn.dial.try(+ip: String, +port: U32, +ms: U32, +deadline: Nat) ->
2871 IO(Result<&1, &1, U32 & String, Socket>):
2872 do IO<Result<&1, &1, U32 & String, Socket>>:
2873 now : Nat <- IO.now()
2874 conn.dial.with(ip, port, ms, deadline, now, U32.is_zero(ms))
2875
2876def conn.dial.after(r: Result<&1, &1, U32 & String, Socket>, ip: String, +port: U32, +ms: U32, +deadline: Nat) ->
2877 IO(Result<&1, &1, U32 & String, Socket>):
2878 match r:
2879 case Done{s}:
2880 IO.pure(Result<&1, &1, U32 & String, Socket>, Done{s})
2881 case Fail{e}:
2882 conn.dial.try(ip, port, ms, deadline)
2883
2884def conn.dial.more(prev: IO(Result<&1, &1, U32 & String, Socket>), ip: String, +port: U32, +ms: U32, +deadline: Nat) ->
2885 IO(Result<&1, &1, U32 & String, Socket>):
2886 do IO<Result<&1, &1, U32 & String, Socket>>:
2887 r : Result<&1, &1, U32 & String, Socket> <- prev
2888 conn.dial.after(r, ip, port, ms, deadline)
2889
2890def conn.dial.fold(d: Dial, ip: String) -> Dial:
2891 Dial{+port, +ms, +deadline, action} = d
2892 Dial{port, ms, deadline, conn.dial.more(action, ip, port, ms, deadline)}
2893
2894def conn.dial.run(d: Dial) -> IO(Result<&1, &1, U32 & String, Socket>):
2895 Dial{port, ms, deadline, action} = d
2896 action
2897
2898def conn.dial.all(+port: U32, +ms: U32, +start: Nat, first: String, rest: List<&2, String>) ->
2899 IO(Result<&1, &1, U32 & String, Socket>):
2900 match rest:
2901 case Nil{}:
2902 Wire.connect(first, port, ms)
2903 case Con{ip, tail}:
2904 +deadline = Nat.add(start, U32.to_nat(ms))
2905 conn.dial.run(List.foldl(~&2, ~String, ~Dial, ~conn.dial.fold, Con{ip, tail},
2906 Dial{port, ms, deadline, Wire.connect(first, port, ms)}))
2907
2908def conn.open.all(+tls: Bool, +ms: U32, +host: String, +port: U32,
2909 ips: List<&2, String>, cert: Maybe<&2, Cert>, offer: Bool) ->
2910 IO(Result<&1, &1, Err, Conn>):
2911 match ips:
2912 case Nil{}:
2913 IO.pure(Result<&1, &1, Err, Conn>, Fail{ErrDns{}})
2914 case Con{addr, rest}:
2915 do IO<Result<&1, &1, Err, Conn>>:
2916 start : Nat <- IO.now()
2917 r : Result<&1, &1, U32 & String, Socket> <- conn.dial.all(port, ms, start, addr, rest)
2918 conn.made(ms, host, tls, cert, offer, r)
2919
2920def proxy.auth.safe(s: String) -> Bool:
2921 match s:
2922 case SNil{}:
2923 True{}
2924 case SCon{Chr{+c}, rest}:
2925 Bool.and(U32.is_ge(c, 32), Bool.and(U32.is_ne(c, 127), proxy.auth.safe(rest)))
2926
2927def proxy.auth.checked(+decoded: String, valid: Bool) -> Maybe<&2, String>:
2928 match valid:
2929 case False{}:
2930 None{}
2931 case True{}:
2932 Some{"Basic " ++ Bytes.to_base64(Bytes.from_string(decoded))}
2933
2934def proxy.auth.value(m: Maybe<&2, String>) -> Maybe<&2, String>:
2935 match m:
2936 case None{}:
2937 None{}
2938 case Some{+decoded}:
2939 proxy.auth.checked(decoded, Bool.and(Url.has(decoded, 58), proxy.auth.safe(decoded)))
2940
2941def proxy.from.abs(authorization: String, m: Maybe<&2, Url.Abs>) -> Maybe<&2, Proxy>:
2942 match m:
2943 case None{}:
2944 None{}
2945 case Some{Url.Abs{scheme, host, port, target}}:
2946 Some{ProxyVia{host, port, authorization}}
2947
2948def proxy.from.user(user: String, host: String) -> Maybe<&2, Proxy>:
2949 do Maybe<&2, Proxy>:
2950 authorization : String <- proxy.auth.value(Url.pct.decode(user))
2951 proxy.from.abs(authorization, Url.absolute("http://" ++ host))
2952
2953def proxy.from.authority(has_user: Bool, authority: String, split: String & String) ->
2954 Maybe<&2, Proxy>:
2955 match has_user:
2956 case False{}:
2957 proxy.from.abs("", Url.absolute("http://" ++ authority))
2958 case True{}:
2959 (user, host) = split
2960 proxy.from.user(user, host)
2961
2962def proxy.from.parts(parts: String & String) -> Maybe<&2, Proxy>:
2963 (+authority, path) = parts
2964 match path:
2965 case SNil{}:
2966 proxy.from.authority(Url.has(authority, 64), authority, Url.take_to(authority, 64))
2967 case other:
2968 None{}
2969
2970def proxy.from.url.if(valid: Bool, raw: String) -> Maybe<&2, Proxy>:
2971 match valid:
2972 case False{}:
2973 None{}
2974 case True{}:
2975 proxy.from.parts(Url.take_to(String.drop(raw, 7n), 47))
2976
2977def proxy.from.url(+raw: String) -> Maybe<&2, Proxy>:
2978 proxy.from.url.if(String.starts_with(String.to_lower(raw), "http://"), raw)
2979
2980def proxy.no.domain(+host: String, +suffix: String) -> Bool:
2981 Bool.or(String.eq(host, suffix), String.ends_with(host, "." ++ suffix))
2982
2983def proxy.no.suffix(+host: String, +raw: String) -> Bool:
2984 match raw:
2985 case SCon{Chr{46}, +suffix}:
2986 proxy.no.domain(host, suffix)
2987 case other:
2988 proxy.no.domain(host, raw)
2989
2990def proxy.no.port(valid: Bool, +host: String, suffix: String) -> Bool:
2991 match valid:
2992 case False{}:
2993 False{}
2994 case True{}:
2995 proxy.no.suffix(host, suffix)
2996
2997def proxy.no.named(+host: String, +port: U32, parts: String & String) -> Bool:
2998 (suffix, port_text) = parts
2999 match port_text:
3000 case SNil{}:
3001 proxy.no.suffix(host, suffix)
3002 case other:
3003 proxy.no.port(String.eq(port_text, U32.show(port)), host, suffix)
3004
3005def proxy.no.literal(+host: String, +port: U32, +name: String) -> Bool:
3006 Bool.or(String.eq(name, host), Bool.or(String.eq(name, "[" ++ host ++ "]"),
3007 Bool.or(String.eq(name, host ++ ":" ++ U32.show(port)),
3008 String.eq(name, "[" ++ host ++ "]:" ++ U32.show(port)))))
3009
3010def proxy.no.token(+host: String, +port: U32, token: String) -> Bool:
3011 +name = String.to_lower(trim(token))
3012 Bool.or(String.eq(name, "*"),
3013 Bool.or(proxy.no.literal(host, port, name),
3014 Bool.and(Bool.not(Url.has(host, 58)),
3015 proxy.no.named(host, port, Url.take_to(name, 58)))))
3016
3017def proxy.no.list(xs: List<&2, String>, +host: String, +port: U32) -> Bool:
3018 match xs:
3019 case Nil{}:
3020 False{}
3021 case Con{token, rest}:
3022 Bool.or(proxy.no.token(host, port, token), proxy.no.list(rest, host, port))
3023
3024def proxy.no_match(+host: String, +port: U32, no_proxy: String) -> Bool:
3025 proxy.no.list(String.split(no_proxy, ','), String.to_lower(host), port)
3026
3027def proxy.env.value(r: Result<&1, &1, U32 & String, String>) -> String:
3028 match r:
3029 case Fail{e}:
3030 ""
3031 case Done{value}:
3032 value
3033
3034def proxy.env.lower(r: Result<&1, &1, U32 & String, String>, upper: String) ->
3035 IO(String):
3036 match r:
3037 case Done{value}:
3038 IO.pure(String, value)
3039 case Fail{e}:
3040 do IO<String>:
3041 got : Result<&1, &1, U32 & String, String> <- IO.get_env(upper)
3042 return proxy.env.value(got)
3043
3044def proxy.env(lower: String, upper: String) -> IO(String):
3045 do IO<String>:
3046 got : Result<&1, &1, U32 & String, String> <- IO.get_env(lower)
3047 proxy.env.lower(got, upper)
3048
3049def proxy.from.env(value: String) -> Maybe<&2, Proxy>:
3050 match value:
3051 case SNil{}:
3052 Some{ProxyDirect{}}
3053 case other:
3054 proxy.from.url(value)
3055
3056def proxy.choose(bypass: Bool, value: String) -> Maybe<&2, Proxy>:
3057 match bypass:
3058 case True{}:
3059 Some{ProxyDirect{}}
3060 case False{}:
3061 proxy.from.env(value)
3062
3063def proxy.select(+scheme: String, +host: String, +port: U32) ->
3064 IO(Maybe<&2, Proxy>):
3065 +secure = String.eq(scheme, "https")
3066 do IO<Maybe<&2, Proxy>>:
3067 bypass : String <- proxy.env("no_proxy", "NO_PROXY")
3068 value : String <- proxy.env(Bool.pick(String, secure, "https_proxy", "http_proxy"),
3069 Bool.pick(String, secure, "HTTPS_PROXY", "HTTP_PROXY"))
3070 return proxy.choose(proxy.no_match(host, port, bypass), value)
3071
3072def h2.header.skip(+name: String) -> Bool:
3073 match name:
3074 case SCon{Chr{58}, rest}:
3075 True{}
3076 case other:
3077 Bool.or(req.reserved(name),
3078 Bool.or(String.eq(name, "keep-alive"),
3079 Bool.or(String.eq(name, "proxy-connection"),
3080 Bool.or(String.eq(name, "upgrade"), String.eq(name, "te")))))
3081
3082def h2.header.mode(+name: String) -> U32:
3083 Bool.pick(U32,
3084 Bool.or(String.eq(name, "authorization"),
3085 Bool.or(String.eq(name, "cookie"), String.eq(name, "proxy-authorization"))),
3086 2, 0)
3087
3088def h2.header.values(+name: String, +mode: U32, vs: List<&2, String>) -> List<&2, Hpack.Field>:
3089 match vs:
3090 case Nil{}:
3091 Nil{}
3092 case Con{v, tail}:
3093 Hpack.Field{name, sanitize(v), mode} <> h2.header.values(name, mode, tail)
3094
3095def h2.header.tokens(vs: List<&2, String>) -> List<&2, String>:
3096 match vs:
3097 case Nil{}:
3098 Nil{}
3099 case Con{value, rest}:
3100 List.append(&2, String, String.split(value, ','), h2.header.tokens(rest))
3101
3102def h2.header.nominated.one(enabled: Bool, vs: List<&2, String>,
3103 rest: List<&2, String>) -> List<&2, String>:
3104 match enabled:
3105 case True{}:
3106 List.append(&2, String, h2.header.tokens(vs), rest)
3107 case False{}:
3108 rest
3109
3110def h2.header.nominated(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>) ->
3111 List<&2, String>:
3112 match xs:
3113 case Nil{}:
3114 Nil{}
3115 case (name, values) <> tail:
3116 h2.header.nominated.one(String.eq(String.to_lower(name), "connection"),
3117 values, h2.header.nominated(tail))
3118
3119def h2.header.has(xs: List<&2, String>, +key: String) -> Bool:
3120 match xs:
3121 case Nil{}:
3122 False{}
3123 case Con{value, rest}:
3124 Bool.or(String.eq(String.to_lower(trim(value)), key), h2.header.has(rest, key))
3125
3126def h2.header.item(skip: Bool, +name: String, vs: List<&2, String>,
3127 tail: List<&2, Hpack.Field>) -> List<&2, Hpack.Field>:
3128 match skip:
3129 case True{}:
3130 tail
3131 case False{}:
3132 List.append(&2, Hpack.Field, h2.header.values(name, h2.header.mode(name), vs), tail)
3133
3134def h2.header.items(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>,
3135 +nominated: List<&2, String>) -> List<&2, Hpack.Field>:
3136 match xs:
3137 case Nil{}:
3138 Nil{}
3139 case (name, values) <> tail:
3140 +key = String.to_lower(name)
3141 h2.header.item(Bool.or(h2.header.skip(key), h2.header.has(nominated, key)),
3142 key, values, h2.header.items(tail, nominated))
3143
3144def h2.request.fields(+method: String, target: String, authority: String,
3145 headers: Map<&2, List<&2, String>>) -> List<&2, Hpack.Field>:
3146 +xs = Map.to_list(&2, List<&2, String>, headers)
3147 List.append(&2, Hpack.Field,
3148 [Hpack.Field{":method", method, 0}, Hpack.Field{":scheme", "https", 0},
3149 Hpack.Field{":authority", authority, 0}, Hpack.Field{":path", target, 0}],
3150 h2.header.items(xs, h2.header.nominated(xs)))
3151
3152def h2.response.status.value(+value: String, valid: Bool) -> Maybe<&2, U32>:
3153 match valid:
3154 case False{}:
3155 None{}
3156 case True{}:
3157 parse_u32(value)
3158
3159def h2.response.status(xs: List<&2, Hpack.Field>) -> Maybe<&2, U32>:
3160 match xs:
3161 case Nil{}:
3162 None{}
3163 case Con{Hpack.Field{name, +value, mode}, tail}:
3164 match name:
3165 case ":status":
3166 h2.response.status.value(value, Nat.is_eq(String.length(value), 3n))
3167 case other:
3168 h2.response.status(tail)
3169
3170def h2.response.headers(xs: List<&2, Hpack.Field>, acc: Map<&2, List<&2, String>>) ->
3171 Map<&2, List<&2, String>>:
3172 match xs:
3173 case Nil{}:
3174 acc
3175 case Con{Hpack.Field{name, value, mode}, tail}:
3176 match name:
3177 case SCon{Chr{58}, rest}:
3178 h2.response.headers(tail, acc)
3179 case other:
3180 h2.response.headers(tail, add(acc, String.to_lower(name), value))
3181
3182def h2.response.final(interim: Bool, +status: U32, headers: List<&2, Hpack.Field>,
3183 body: HBytes.Bytes) -> Result<&1, &1, Err, Maybe<&1, Res>>:
3184 match interim:
3185 case True{}:
3186 Done{None{}}
3187 case False{}:
3188 HBytes.Bytes{len, buf} = body
3189 Done{Some{Res{status, h2.response.headers(headers, empty()), Bytes.Bytes{len, buf}}}}
3190
3191def h2.response.valid(valid: Bool, +status: U32, headers: List<&2, Hpack.Field>,
3192 body: HBytes.Bytes) -> Result<&1, &1, Err, Maybe<&1, Res>>:
3193 match valid:
3194 case False{}:
3195 Fail{ErrBad{}}
3196 case True{}:
3197 h2.response.final(U32.is_lt(status, 200), status, headers, body)
3198
3199def h2.response.parsed(m: Maybe<&2, U32>, headers: List<&2, Hpack.Field>,
3200 body: HBytes.Bytes) -> Result<&1, &1, Err, Maybe<&1, Res>>:
3201 match m:
3202 case None{}:
3203 Fail{ErrBad{}}
3204 case Some{+status}:
3205 h2.response.valid(Bool.and(U32.is_ge(status, 100), U32.is_lt(status, 600)),
3206 status, headers, body)
3207
3208def h2.response(+fields: List<&2, Hpack.Field>, body: HBytes.Bytes) ->
3209 Result<&1, &1, Err, Maybe<&1, Res>>:
3210 h2.response.parsed(h2.response.status(fields), fields, body)
3211
3212def h2.event.fold(acc: Result<&1, &1, Err, Maybe<&1, Res>>,
3213 event: H2.ClientEvent) -> Result<&1, &1, Err, Maybe<&1, Res>>:
3214 match acc:
3215 case Fail{e}:
3216 Fail{e}
3217 case Done{Some{res}}:
3218 Done{Some{res}}
3219 case Done{None{}}:
3220 match event:
3221 case H2.Response{id, headers, body}:
3222 h2.response(headers, body)
3223 case H2.Reset{id, code}:
3224 Fail{ErrBad{}}
3225 case H2.Shutdown{last, code}:
3226 Done{None{}}
3227 case H2.Pong{data}:
3228 Done{None{}}
3229
3230def h2.send.report(r: Socket & Result<&1, &1, U32 & String, Unit>) ->
3231 IO(Result<&1, &1, Err, Socket>):
3232 (s, sent) = r
3233 match sent:
3234 case Fail{(+code, why)}:
3235 do IO<Result<&1, &1, Err, Socket>>:
3236 Wire.tls.close(s)
3237 return Fail{err.or_late(code, ErrWrite{code, why})}
3238 case Done{unit}:
3239 IO.pure(Result<&1, &1, Err, Socket>, Done{s})
3240
3241def h2.send.one(prev: Result<&1, &1, Err, Socket>, b: HBytes.Bytes) ->
3242 IO(Result<&1, &1, Err, Socket>):
3243 match prev:
3244 case Fail{e}:
3245 IO.pure(Result<&1, &1, Err, Socket>, Fail{e})
3246 case Done{s}:
3247 HBytes.Bytes{len, buf} = b
3248 do IO<Result<&1, &1, Err, Socket>>:
3249 sent : Socket & Result<&1, &1, U32 & String, Unit> <- Wire.tls.send.words(s, len, buf)
3250 h2.send.report(sent)
3251
3252def h2.send.fold(prev: IO(Result<&1, &1, Err, Socket>), b: HBytes.Bytes) ->
3253 IO(Result<&1, &1, Err, Socket>):
3254 do IO<Result<&1, &1, Err, Socket>>:
3255 r : Result<&1, &1, Err, Socket> <- prev
3256 h2.send.one(r, b)
3257
3258def h2.send(xs: List<&1, HBytes.Bytes>, s: Socket) -> IO(Result<&1, &1, Err, Socket>):
3259 List.foldl(~&1, ~HBytes.Bytes, ~IO(Result<&1, &1, Err, Socket>), ~h2.send.fold,
3260 xs, IO.pure(Result<&1, &1, Err, Socket>, Done{s}))
3261
3262def h2.received.step(over: Bool, s: Socket, client: H2.Client,
3263 +len: U32, buf: Array<U32>) -> H2Step:
3264 match over:
3265 case True{}:
3266 H2Reply{s, H2.Failed{H2.Error{1, True{}, 0}}}
3267 case False{}:
3268 H2Reply{s, H2.client.receive(client, HBytes.Bytes{len, buf})}
3269
3270def h2.fail(s: Socket, e: Err) -> IO(Result<&1, &1, Err, Conn & Res>):
3271 do IO<Result<&1, &1, Err, Conn & Res>>:
3272 Wire.tls.close(s)
3273 return Fail{e}
3274
3275def h2.loop(n: Nat, step: H2Step, +ms: U32, +used: U32) ->
3276 IO(Result<&1, &1, Err, Conn & Res>):
3277 match n:
3278 case 0n:
3279 match step:
3280 case H2Reply{s, reply}:
3281 h2.fail(s, ErrBad{})
3282 case H2Sent{client, events, sent}:
3283 match sent:
3284 case Fail{e}:
3285 IO.pure(Result<&1, &1, Err, Conn & Res>, Fail{e})
3286 case Done{s}:
3287 h2.fail(s, ErrBad{})
3288 case H2Events{s, client, result}:
3289 h2.fail(s, ErrBad{})
3290 case H2Received{client, answer}:
3291 (s, r) = answer
3292 h2.fail(s, ErrBad{})
3293 case 1n+p:
3294 match step:
3295 case H2Reply{s, reply}:
3296 match reply:
3297 case H2.Failed{error}:
3298 h2.fail(s, ErrBad{})
3299 case H2.Ready{client, writes, events}:
3300 do IO<Result<&1, &1, Err, Conn & Res>>:
3301 sent : Result<&1, &1, Err, Socket> <- h2.send(writes, s)
3302 h2.loop(p, H2Sent{client, events, sent}, ms, used)
3303 case H2Sent{client, events, sent}:
3304 match sent:
3305 case Fail{e}:
3306 IO.pure(Result<&1, &1, Err, Conn & Res>, Fail{e})
3307 case Done{s}:
3308 h2.loop(p, H2Events{s, client,
3309 List.foldl(~&1, ~H2.ClientEvent,
3310 ~Result<&1, &1, Err, Maybe<&1, Res>>, ~h2.event.fold,
3311 events, Done{None{}})}, ms, used)
3312 case H2Events{s, client, result}:
3313 match result:
3314 case Fail{e}:
3315 h2.fail(s, e)
3316 case Done{Some{res}}:
3317 IO.pure(Result<&1, &1, Err, Conn & Res>,
3318 Done{(ConnH2{s, client}, res)})
3319 case Done{None{}}:
3320 do IO<Result<&1, &1, Err, Conn & Res>>:
3321 r : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <-
3322 Wire.tls.recv.words(s, 16384, ms)
3323 h2.loop(p, H2Received{client, r}, ms, used)
3324 case H2Received{client, answer}:
3325 match answer:
3326 case (s, Fail{(+code, why)}):
3327 h2.fail(s, err.or_late(code, ErrRead{code, why}))
3328 case (s, Done{(0, buf)}):
3329 h2.fail(s, ErrBad{})
3330 case (s, Done{(+len, buf)}):
3331 +total = (used + len : U32)
3332 h2.loop(p, h2.received.step(fetch.over(total), s, client, len, buf), ms, total)
3333
3334def h2.exchange(s: Socket, client: H2.Client, +ms: U32, request: Send) ->
3335 IO(Result<&1, &1, Err, Conn & Res>):
3336 Send{method, target, authority, headers, Bytes.Bytes{len, buf}} = request
3337 h2.loop(Nat.mul(4n, Nat.add(fetch.max(), 65536n)),
3338 H2Reply{s, H2.client.request(client,
3339 h2.request.fields(method, target, authority, headers), HBytes.Bytes{len, buf})},
3340 ms, 0)
3341
3342def proxy.connect.fail(s: Socket, e: Err) -> IO(Result<&1, &1, Err, Conn>):
3343 do IO<Result<&1, &1, Err, Conn>>:
3344 io.close(False{}, s)
3345 return Fail{e}
3346
3347def proxy.connect.extra(m: Maybe<&2, String>, s: Socket, +ms: U32,
3348 sni: String, cert: Maybe<&2, Cert>) -> IO(Result<&1, &1, Err, Conn>):
3349 match m:
3350 case None{}:
3351 proxy.connect.fail(s, ErrBad{})
3352 case Some{rest}:
3353 match rest:
3354 case SNil{}:
3355 conn.secure(ms, sni, s, True{}, cert, True{})
3356 case other:
3357 proxy.connect.fail(s, ErrBad{})
3358
3359def proxy.connect.status(ok: Bool, +status: U32, raw: String, s: Socket,
3360 +ms: U32, sni: String, cert: Maybe<&2, Cert>) ->
3361 IO(Result<&1, &1, Err, Conn>):
3362 match ok:
3363 case False{}:
3364 proxy.connect.fail(s, ErrConnect{status, "proxy CONNECT refused"})
3365 case True{}:
3366 proxy.connect.extra(after(raw, True{}), s, ms, sni, cert)
3367
3368def proxy.connect.finish(res: Res, raw: String, s: Socket, +ms: U32,
3369 sni: String, cert: Maybe<&2, Cert>) -> IO(Result<&1, &1, Err, Conn>):
3370 Res{+status, headers, body} = res
3371 proxy.connect.status(Bool.and(U32.is_ge(status, 200), U32.is_lt(status, 300)),
3372 status, raw, s, ms, sni, cert)
3373
3374def proxy.connect.frame(raw: String, over: Bool) -> Frame:
3375 match over:
3376 case True{}:
3377 FrameBad{}
3378 case False{}:
3379 frame(raw, False{}, True{})
3380
3381def proxy.connect.chunk(empty: Bool, s: Socket, raw: String,
3382 +len: U32, buf: Array<U32>) -> TunnelStep:
3383 match empty:
3384 case True{}:
3385 TunnelHead{s, raw, FrameBad{}}
3386 case False{}:
3387 TunnelRead{s, raw ++ Bytes.to_string(Bytes.Bytes{len, buf})}
3388
3389def proxy.connect.loop(n: Nat, step: TunnelStep, +ms: U32, +sni: String,
3390 +cert: Maybe<&2, Cert>) -> IO(Result<&1, &1, Err, Conn>):
3391 match n:
3392 case 0n:
3393 match step:
3394 case TunnelRead{s, raw}:
3395 proxy.connect.fail(s, ErrBad{})
3396 case TunnelHead{s, raw, result}:
3397 proxy.connect.fail(s, ErrBad{})
3398 case TunnelGot{raw, answer}:
3399 (s, result) = answer
3400 proxy.connect.fail(s, ErrBad{})
3401 case 1n+p:
3402 match step:
3403 case TunnelRead{s, +raw}:
3404 proxy.connect.loop(p, TunnelHead{s, raw,
3405 proxy.connect.frame(raw, Nat.is_gt(String.length(raw), 65536n))},
3406 ms, sni, cert)
3407 case TunnelHead{s, raw, result}:
3408 match result:
3409 case FrameBad{}:
3410 proxy.connect.fail(s, ErrBad{})
3411 case FrameMore{}:
3412 do IO<Result<&1, &1, Err, Conn>>:
3413 answer : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <-
3414 io.recv.words(False{}, s, 4096, ms)
3415 proxy.connect.loop(p, TunnelGot{raw, answer}, ms, sni, cert)
3416 case FrameDone{res}:
3417 proxy.connect.finish(res, raw, s, ms, sni, cert)
3418 case TunnelGot{raw, answer}:
3419 match answer:
3420 case (s, Fail{(+code, why)}):
3421 proxy.connect.fail(s, err.or_late(code, ErrRead{code, why}))
3422 case (s, Done{(+len, buf)}):
3423 proxy.connect.loop(p,
3424 proxy.connect.chunk(U32.is_zero(len), s, raw, len, buf),
3425 ms, sni, cert)
3426
3427def proxy.connect.header(+authority: String, authorization: String) -> String:
3428 match authorization:
3429 case SNil{}:
3430 "CONNECT " ++ authority ++ " HTTP/1.1\r\nHost: " ++ authority ++ "\r\n\r\n"
3431 case other:
3432 "CONNECT " ++ authority ++ " HTTP/1.1\r\nHost: " ++ authority
3433 ++ "\r\nProxy-Authorization: " ++ authorization ++ "\r\n\r\n"
3434
3435def proxy.connect.sent(r: Socket & Result<&1, &1, U32 & String, Unit>,
3436 +ms: U32, sni: String, cert: Maybe<&2, Cert>) ->
3437 IO(Result<&1, &1, Err, Conn>):
3438 (s, sent) = r
3439 match sent:
3440 case Fail{(+code, why)}:
3441 proxy.connect.fail(s, err.or_late(code, ErrWrite{code, why}))
3442 case Done{unit}:
3443 proxy.connect.loop(Nat.mul(3n, 65536n), TunnelRead{s, ""}, ms, sni, cert)
3444
3445def proxy.connect(s: Socket, +ms: U32, sni: String, authority: String,
3446 authorization: String, cert: Maybe<&2, Cert>) ->
3447 IO(Result<&1, &1, Err, Conn>):
3448 do IO<Result<&1, &1, Err, Conn>>:
3449 sent : Socket & Result<&1, &1, U32 & String, Unit> <-
3450 io.send.bytes(False{}, s, Bytes.from_string(proxy.connect.header(authority, authorization)))
3451 proxy.connect.sent(sent, ms, sni, cert)
3452
3453def proxy.route.tls(tls: Bool, s: Socket, +ms: U32, sni: String,
3454 authority: String, authorization: String, cert: Maybe<&2, Cert>) ->
3455 IO(Result<&1, &1, Err, Conn>):
3456 match tls:
3457 case False{}:
3458 IO.pure(Result<&1, &1, Err, Conn>, Done{Conn{False{}, s}})
3459 case True{}:
3460 proxy.connect(s, ms, sni, authority, authorization, cert)
3461
3462def proxy.route.connected(tls: Bool, +ms: U32, sni: String, authority: String,
3463 authorization: String, cert: Maybe<&2, Cert>,
3464 r: Result<&1, &1, Err, Conn>) -> IO(Result<&1, &1, Err, Conn>):
3465 match r:
3466 case Fail{e}:
3467 IO.pure(Result<&1, &1, Err, Conn>, Fail{e})
3468 case Done{c}:
3469 match c:
3470 case Conn{plain, s}:
3471 proxy.route.tls(tls, s, ms, sni, authority, authorization, cert)
3472 case ConnH2{s, client}:
3473 do IO<Result<&1, &1, Err, Conn>>:
3474 Wire.tls.close(s)
3475 return Fail{ErrBad{}}
3476
3477def proxy.route.open(+ms: U32, +tls: Bool, +host: String, +port: U32,
3478 +sni: String, +authority: String, +authorization: String,
3479 cert: Maybe<&2, Cert>) -> IO(Result<&1, &1, Err, Conn>):
3480 do IO<Result<&1, &1, Err, Conn>>:
3481 ips : List<&2, String> <- Dns.resolve.all(host)
3482 conn : Result<&1, &1, Err, Conn> <-
3483 conn.open.all(False{}, ms, host, port, ips, None{}, False{})
3484 proxy.route.connected(tls, ms, sni, authority, authorization, cert, conn)
3485
3486def route.open(+ms: U32, route: Route) -> IO(Result<&1, &1, Err, Conn>):
3487 match route:
3488 case RouteDirect{tls, +host, port, cert}:
3489 do IO<Result<&1, &1, Err, Conn>>:
3490 ips : List<&2, String> <- Dns.resolve.all(host)
3491 conn.open.all(tls, ms, host, port, ips, cert, True{})
3492 case RouteProxy{tls, host, port, sni, authority, authorization, cert}:
3493 proxy.route.open(ms, tls, host, port, sni, authority, authorization, cert)
3494
3495def conn.ex.h1(+tls: Bool, s: Socket, +ms: U32, request: Send) -> IO(Out):
3496 Send{+method, target, authority, headers, body} = request
3497 exchange.go(tls, ms, False{}, String.eq(method, "HEAD"), s,
3498 encode_req.on(method, target, authority, headers, body, False{}))
3499
3500# A socket with bytes past the response is out of step with the server, so it is closed.
3501def pool.keep.s(p: Pool, +key: String, +tls: Bool, res: Res, s: Socket, clean: Bool) -> IO(Pool & Result<&1, &1, Err, Res>):
3502 match clean:
3503 case True{}:
3504 do IO<Pool & Result<&1, &1, Err, Res>>:
3505 p2 : Pool <- pool.give(p, key, Conn{tls, s})
3506 return (p2, Done{res})
3507 case False{}:
3508 do IO<Pool & Result<&1, &1, Err, Res>>:
3509 io.close(tls, s)
3510 return (p, Done{res})
3511
3512def pool.keep.m(p: Pool, +key: String, +tls: Bool, res: Res, +clean: Bool, sock: Maybe<&1, Socket>) -> IO(Pool & Result<&1, &1, Err, Res>):
3513 match sock:
3514 case None{}:
3515 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Done{res}))
3516 case Some{s}:
3517 pool.keep.s(p, key, tls, res, s, clean)
3518
3519def pool.keep(p: Pool, +key: String, +tls: Bool, res: Res, sock: Maybe<&1, Socket>, rest: Bytes.Bytes) -> IO(Pool & Result<&1, &1, Err, Res>):
3520 Bytes.Bytes{+len, buf} = rest
3521 pool.keep.m(p, key, tls, res, U32.is_zero(len), sock)
3522
3523def pool.after(p: Pool, +key: String, +tls: Bool, o: Out) -> IO(Pool & Result<&1, &1, Err, Res>):
3524 match o:
3525 case OutFail{e, none}:
3526 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{e}))
3527 case OutDone{res, sock, rest}:
3528 pool.keep(p, key, tls, res, sock, rest)
3529
3530def pool.h2.reusable(c: Conn) -> Bool & Conn:
3531 match c:
3532 case Conn{tls, s}:
3533 (True{}, Conn{tls, s})
3534 case ConnH2{s, H2.Client{input, streams, encoder, decoder, +control}}:
3535 H2.Control{next, active, frame_max, initial, max_streams, send_window,
3536 recv_window, first, ack, continuation, +goaway} = control
3537 (Maybe.is_none(&2, U32, goaway),
3538 ConnH2{s, H2.Client{input, streams, encoder, decoder, control}})
3539
3540def pool.h2.keep(p: Pool, +key: String, res: Res, state: Bool & Conn) ->
3541 IO(Pool & Result<&1, &1, Err, Res>):
3542 (reusable, c) = state
3543 match reusable:
3544 case True{}:
3545 do IO<Pool & Result<&1, &1, Err, Res>>:
3546 next : Pool <- pool.give(p, key, c)
3547 return (next, Done{res})
3548 case False{}:
3549 do IO<Pool & Result<&1, &1, Err, Res>>:
3550 conn.close(c)
3551 return (p, Done{res})
3552
3553def pool.h2.result(p: Pool, +key: String, r: Result<&1, &1, Err, Conn & Res>) ->
3554 IO(Pool & Result<&1, &1, Err, Res>):
3555 match r:
3556 case Fail{e}:
3557 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{e}))
3558 case Done{(c, res)}:
3559 pool.h2.keep(p, key, res, pool.h2.reusable(c))
3560
3561def pool.h2.ex(p: Pool, +key: String, +ms: U32, request: Send,
3562 s: Socket, client: H2.Client) -> IO(Pool & Result<&1, &1, Err, Res>):
3563 do IO<Pool & Result<&1, &1, Err, Res>>:
3564 r : Result<&1, &1, Err, Conn & Res> <- h2.exchange(s, client, ms, request)
3565 pool.h2.result(p, key, r)
3566
3567def pool.fresh.conn(p: Pool, +key: String, +ms: U32, request: Send,
3568 r: Result<&1, &1, Err, Conn>) -> IO(Pool & Result<&1, &1, Err, Res>):
3569 match r:
3570 case Fail{e}:
3571 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{e}))
3572 case Done{c}:
3573 match c:
3574 case Conn{+tls, s}:
3575 do IO<Pool & Result<&1, &1, Err, Res>>:
3576 o : Out <- conn.ex.h1(tls, s, ms, request)
3577 pool.after(p, key, tls, o)
3578 case ConnH2{s, client}:
3579 pool.h2.ex(p, key, ms, request, s, client)
3580
3581def pool.fresh(p: Pool, +key: String, +ms: U32, request: Send, route: Route) ->
3582 IO(Pool & Result<&1, &1, Err, Res>):
3583 do IO<Pool & Result<&1, &1, Err, Res>>:
3584 c : Result<&1, &1, Err, Conn> <- route.open(ms, route)
3585 pool.fresh.conn(p, key, ms, request, c)
3586
3587# A reused socket the server already closed fails before any response byte.
3588def pool.retry(+none: Bool, +idem: Bool) -> Bool:
3589 Bool.and(none, idem)
3590
3591def pool.stale(p: Pool, +key: String, +ms: U32, request: Send,
3592 e: Err, again: Bool, route: Route) ->
3593 IO(Pool & Result<&1, &1, Err, Res>):
3594 match again:
3595 case True{}:
3596 pool.fresh(p, key, ms, request, route)
3597 case False{}:
3598 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{e}))
3599
3600def pool.reused(p: Pool, +key: String, +tls: Bool, +ms: U32, +idem: Bool,
3601 spare: Send, o: Out, route: Route) ->
3602 IO(Pool & Result<&1, &1, Err, Res>):
3603 match o:
3604 case OutFail{e, +none}:
3605 pool.stale(p, key, ms, spare, e, pool.retry(none, idem), route)
3606 case OutDone{res, sock, rest}:
3607 pool.keep(p, key, tls, res, sock, rest)
3608
3609# Copy only the reused HTTP/1.1 request body, for a stale-socket retry.
3610def pool.idle.h1.bodies(p: Pool, +key: String, +tls: Bool, +ms: U32, +idem: Bool,
3611 s: Socket, +method: String, +target: String, +authority: String,
3612 +headers: Map<&2, List<&2, String>>, r: Bytes.Bytes & Bytes.Bytes,
3613 route: Route) -> IO(Pool & Result<&1, &1, Err, Res>):
3614 (wire, spare) = r
3615 do IO<Pool & Result<&1, &1, Err, Res>>:
3616 o : Out <- conn.ex.h1(tls, s, ms, Send{method, target, authority, headers, wire})
3617 pool.reused(p, key, tls, ms, idem,
3618 Send{method, target, authority, headers, spare}, o, route)
3619
3620def pool.idle.h1(p: Pool, +key: String, +tls: Bool, +ms: U32, +idem: Bool,
3621 s: Socket, request: Send, route: Route) ->
3622 IO(Pool & Result<&1, &1, Err, Res>):
3623 Send{+method, +target, +authority, +headers, body} = request
3624 pool.idle.h1.bodies(p, key, tls, ms, idem, s, method, target,
3625 authority, headers, Bytes.slice(body, 0, 4294967295), route)
3626
3627def pool.idle.reuse(p: Pool, +key: String, +ms: U32, +idem: Bool,
3628 c: Conn, request: Send, route: Route) ->
3629 IO(Pool & Result<&1, &1, Err, Res>):
3630 match c:
3631 case Conn{tls, s}:
3632 pool.idle.h1(p, key, tls, ms, idem, s, request, route)
3633 case ConnH2{s, client}:
3634 pool.h2.ex(p, key, ms, request, s, client)
3635
3636def pool.idle(taken: Pool & Maybe<&1, Conn>, +key: String, +ms: U32,
3637 +idem: Bool, request: Send, route: Route) ->
3638 IO(Pool & Result<&1, &1, Err, Res>):
3639 (p, m) = taken
3640 match m:
3641 case None{}:
3642 pool.fresh(p, key, ms, request, route)
3643 case Some{c}:
3644 pool.idle.reuse(p, key, ms, idem, c, request, route)
3645
3646def proxy.http.headers(headers: Map<&2, List<&2, String>>,
3647 authorization: String) -> Map<&2, List<&2, String>>:
3648 match authorization:
3649 case SNil{}:
3650 headers
3651 case other:
3652 set(headers, "proxy-authorization", authorization)
3653
3654def proxy.absolute(scheme: String, host_field: String, target: String) -> String:
3655 scheme ++ "://" ++ host_field ++ target
3656
3657def proxy.request(secure: Bool, +scheme: String, method: String,
3658 +target: String, +hf: String, headers: Map<&2, List<&2, String>>,
3659 body: Bytes.Bytes, authorization: String) -> Send:
3660 match secure:
3661 case True{}:
3662 Send{method, target, hf, Map.del(&2, List<&2, String>, headers,
3663 "proxy-authorization"), body}
3664 case False{}:
3665 Send{method, proxy.absolute(scheme, hf, target), hf,
3666 proxy.http.headers(headers, authorization), body}
3667
3668def pool.origin.proxy(p: Pool, +method: String, +ms: U32,
3669 headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, +hf: String,
3670 +scheme: String, +host: String, +port: U32, +target: String,
3671 +cert: Maybe<&2, Cert>, proxy: Proxy) ->
3672 IO(Pool & Result<&1, &1, Err, Res>):
3673 match proxy:
3674 case ProxyDirect{}:
3675 +key = pool.key.cert(pool.key(scheme, host, port), cert)
3676 pool.idle(pool.take(p, key), key, ms, pool.idempotent(method),
3677 Send{method, target, hf, headers, body},
3678 RouteDirect{String.eq(scheme, "https"), host, port, cert})
3679 case ProxyVia{+proxy_host, +proxy_port, +authorization}:
3680 +secure = String.eq(scheme, "https")
3681 +key = pool.key.cert(pool.key(scheme, host, port)
3682 ++ "|proxy:" ++ proxy_host ++ ":" ++ U32.show(proxy_port)
3683 ++ "|auth:" ++ authorization, cert)
3684 pool.idle(pool.take(p, key), key, ms, pool.idempotent(method),
3685 proxy.request(secure, scheme, method, target, hf, headers, body, authorization),
3686 RouteProxy{secure, proxy_host, proxy_port, host,
3687 Url.host_field.wrap(host, Url.has(host, 58)) ++ ":" ++ U32.show(port),
3688 authorization, cert})
3689
3690def pool.origin.choice(p: Pool, method: String, ms: U32,
3691 headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, hf: String,
3692 scheme: String, host: String, port: U32, target: String,
3693 cert: Maybe<&2, Cert>, choice: Maybe<&2, Proxy>) ->
3694 IO(Pool & Result<&1, &1, Err, Res>):
3695 match choice:
3696 case None{}:
3697 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{ErrUrl{}}))
3698 case Some{proxy}:
3699 pool.origin.proxy(p, method, ms, headers, body, hf, scheme, host, port,
3700 target, cert, proxy)
3701
3702def pool.origin(p: Pool, method: String, ms: U32,
3703 headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, hf: String,
3704 a: Url.Abs, known: Bool, cert: Maybe<&2, Cert>,
3705 choice: Maybe<&2, Proxy>) ->
3706 IO(Pool & Result<&1, &1, Err, Res>):
3707 Url.Abs{scheme, host, port, target} = a
3708 match known:
3709 case False{}:
3710 IO.pure(Pool & Result<&1, &1, Err, Res>, (p, Fail{ErrUrl{}}))
3711 case True{}:
3712 pool.origin.choice(p, method, ms, headers, body, hf, scheme, host,
3713 port, target, cert, choice)
3714
3715def pool.scheme.ok(a: Url.Abs) -> Bool:
3716 Url.Abs{+scheme, host, port, target} = a
3717 Bool.or(String.eq(scheme, "http"), String.eq(scheme, "https"))
3718
3719def pool.one.back(h: Hop, pr: Pool & Result<&1, &1, Err, Res>) -> Pool & Result<&1, &1, Err, Res> & Hop:
3720 (p, r) = pr
3721 (p, r, h)
3722
3723# sent is headers plus any jar cookies; the hop keeps headers, so cookies never pile up across hops.
3724def pool.one.of(p: Pool, +method: String, +url: Url.Abs,
3725 headers: Map<&2, List<&2, String>>, sent: Map<&2, List<&2, String>>,
3726 +ms: U32, r: Bytes.Bytes & Bytes.Bytes, cert: Maybe<&2, Cert>) ->
3727 IO(Pool & Result<&1, &1, Err, Res> & Hop):
3728 Url.Abs{+scheme, +host, +port, target} = url
3729 (body, wire) = r
3730 do IO<Pool & Result<&1, &1, Err, Res> & Hop>:
3731 choice : Maybe<&2, Proxy> <- proxy.select(scheme, host, port)
3732 pr : Pool & Result<&1, &1, Err, Res> <-
3733 pool.origin(p, method, ms, sent, wire, Url.host_field(url),
3734 url, pool.scheme.ok(url), cert, choice)
3735 return pool.one.back(Hop{method, url, headers, body}, pr)
3736
3737# One request, on an idle socket to its origin when the pool has one. The hop comes back for the redirect.
3738def pool.one(p: Pool, h: Hop, +ms: U32, cert: Maybe<&2, Cert>, jar: Maybe<&2, Jar>) -> IO(Pool & Result<&1, &1, Err, Res> & Hop):
3739 Hop{+method, +url, +headers, body} = h
3740 pool.one.of(p, method, url, headers, jar.opt.apply(jar, url, headers), ms, Bytes.slice(body, 0, 4294967295), cert)
3741
3742type Next is Type:
3743 NDone{res: Result<&1, &1, Err, Res>}
3744 NStop{}
3745 NGo{left: Nat, hop: Hop}
3746
3747type Mode is Data:
3748 ModeFollow{}
3749 ModeManual{}
3750 ModeError{}
3751
3752# left: redirects still allowed after the request we just finished.
3753def fetch.hop(left: Nat, h: Hop) -> Next:
3754 match left:
3755 case 0n:
3756 NStop{}
3757 case 1n+p:
3758 NGo{p, h}
3759
3760def fetch.decide.r(left: Nat, r: Res, next: Maybe<&1, Hop>) -> Next:
3761 match next:
3762 case None{}:
3763 NDone{Done{r}}
3764 case Some{h}:
3765 fetch.hop(left, h)
3766
3767def fetch.decide.res(left: Nat, h: Hop, r: Res) -> Next:
3768 Res{+status, +headers, body} = r
3769 fetch.decide.r(left, Res{status, headers, body}, redirect(status, headers, h))
3770
3771def fetch.decide(left: Nat, h: Hop, m: Result<&1, &1, Err, Res>) -> Next:
3772 match m:
3773 case Fail{e}:
3774 NDone{Fail{e}}
3775 case Done{r}:
3776 fetch.decide.res(left, h, r)
3777
3778def fetch.error.res(r: Res, bad: Bool) -> Next:
3779 match bad:
3780 case True{}:
3781 NDone{Fail{ErrRedirect{}}}
3782 case False{}:
3783 NDone{Done{r}}
3784
3785def fetch.error(h: Hop, m: Result<&1, &1, Err, Res>) -> Next:
3786 match m:
3787 case Fail{e}:
3788 NDone{Fail{e}}
3789 case Done{r}:
3790 Res{+status, +headers, body} = r
3791 fetch.error.res(Res{status, headers, body}, Bool.and(redirect.code(status), has_header(headers, "location")))
3792
3793def fetch.policy(mode: Mode, left: Nat, h: Hop, m: Result<&1, &1, Err, Res>) -> Next:
3794 match mode:
3795 case ModeFollow{}:
3796 fetch.decide(left, h, m)
3797 case ModeManual{}:
3798 NDone{m}
3799 case ModeError{}:
3800 fetch.error(h, m)
3801
3802# A caller's own Accept-Encoding wins; enc is the codings fetch can undo.
3803def accept.enc(+h: Map<&2, List<&2, String>>, +enc: String) -> Map<&2, List<&2, String>>:
3804 Bool.pick(Map<&2, List<&2, String>>, has_header(h, "accept-encoding"), h, set(h, "accept-encoding", enc))
3805
3806def fetch.start(method: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, u: Maybe<&2, Url.Abs>, +enc: String) -> Next:
3807 match u:
3808 case None{}:
3809 NDone{Fail{ErrUrl{}}}
3810 case Some{a}:
3811 NGo{20n, Hop{method, a, accept.enc(req.put(Map.to_list(&2, List<&2, String>, headers), empty()), enc), body}}
3812
3813# The redirect loop's state: the pool, what to do next, the client identity, and the jar if any.
3814type Hops is Type:
3815 Hops{p: Pool, next: Next, cert: Maybe<&2, Cert>, jar: Maybe<&2, Jar>}
3816
3817def pool.next.move(p: Pool, +old: String, cert: Maybe<&2, Cert>, jar: Maybe<&2, Jar>, n: Next) -> Hops:
3818 match n:
3819 case NGo{left, h}:
3820 Hop{method, +url, headers, body} = h
3821 Hops{p, NGo{left, Hop{method, url, headers, body}},
3822 Bool.pick(Maybe<&2, Cert>, String.eq(old, redirect.origin(url)), cert, None{}), jar}
3823 case NDone{r}:
3824 Hops{p, NDone{r}, None{}, jar}
3825 case NStop{}:
3826 Hops{p, NStop{}, None{}, jar}
3827
3828def pool.next.of(+mode: Mode, left: Nat, cert: Maybe<&2, Cert>, p: Pool, +url: Url.Abs, h: Hop, r: Maybe<&2, Jar> & Result<&1, &1, Err, Res>) -> Hops:
3829 (jar, m) = r
3830 pool.next.move(p, redirect.origin(url), cert, jar, fetch.policy(mode, left, h, m))
3831
3832# The jar takes the response's Set-Cookie fields first, redirect or not.
3833def pool.next(+mode: Mode, left: Nat, cert: Maybe<&2, Cert>, jar: Maybe<&2, Jar>, x: Pool & Result<&1, &1, Err, Res> & Hop) -> Hops:
3834 (p, m, h) = x
3835 Hop{method, +url, headers, body} = h
3836 pool.next.of(mode, left, cert, p, url, Hop{method, url, headers, body}, jar.opt.store(jar, url, m))
3837
3838def pool.hops.one(+mode: Mode, +ms: U32, +cert: Maybe<&2, Cert>, +jar: Maybe<&2, Jar>, p: Pool, h: Hop, left: Nat) -> IO(Hops):
3839 do IO<Hops>:
3840 x : Pool & Result<&1, &1, Err, Res> & Hop <- pool.one(p, h, ms, cert, jar)
3841 return pool.next(mode, left, cert, jar, x)
3842
3843# NGo.left is how many redirects may follow this request. 20 is WHATWG's limit.
3844# The jar, when there is one, gives cookies to every hop and takes them from every response.
3845@unsafe
3846def pool.hops(+mode: Mode, +ms: U32, st: Hops) -> IO(Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>):
3847 Hops{p, n, cert, cj} = st
3848 match n:
3849 case NDone{m}:
3850 IO.pure(Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>, (p, m, cj))
3851 case NStop{}:
3852 IO.pure(Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>, (p, Fail{ErrRedirect{}}, cj))
3853 case NGo{+left, h}:
3854 do IO<Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>>:
3855 next : Hops <- pool.hops.one(mode, ms, cert, cj, p, h, left)
3856 pool.hops(mode, ms, next)
3857
3858# Content-Encoding (RFC 9110 §8.4): each value, trimmed and lowercased, in the order applied.
3859def ce.keep(+w: String, +rest: List<&2, String>) -> List<&2, String>:
3860 Bool.pick(List<&2, String>, String.is_empty(w), rest, Con{w, rest})
3861
3862def ce.norm(xs: List<&2, String>) -> List<&2, String>:
3863 match xs:
3864 case Nil{}:
3865 Nil{}
3866 case Con{v, t}:
3867 ce.keep(String.to_lower(trim(v)), ce.norm(t))
3868
3869def ce.split(xs: List<&2, String>) -> List<&2, String>:
3870 match xs:
3871 case Nil{}:
3872 Nil{}
3873 case Con{v, t}:
3874 List.append(&2, String, ce.norm(String.split(v, ',')), ce.split(t))
3875
3876# Ok: decoded so far. Bad: a coding failed. Skip: a coding we cannot decode, so the body stays as sent.
3877type Dec is Data:
3878 DecOk{b: String}
3879 DecBad{}
3880 DecSkip{}
3881
3882def ce.of(m: Maybe<&2, String>) -> Dec:
3883 match m:
3884 case None{}:
3885 DecBad{}
3886 case Some{b}:
3887 DecOk{b}
3888
3889# Servers send deflate both with and without the zlib wrapper.
3890def ce.deflate(+b: String, m: Maybe<&2, String>) -> Dec:
3891 match m:
3892 case Some{out}:
3893 DecOk{out}
3894 case None{}:
3895 ce.of(Zlib.inflate(b))
3896
3897def ce.apply(+c: String, +b: String) -> Dec:
3898 Bool.pick(Dec, Bool.or(String.eq(c, "gzip"), String.eq(c, "x-gzip")), ce.of(Zlib.gunzip(b)),
3899 Bool.pick(Dec, String.eq(c, "deflate"), ce.deflate(b, Zlib.unzlib(b)),
3900 Bool.pick(Dec, String.eq(c, "identity"), DecOk{b}, DecSkip{})))
3901
3902def ce.go(cs: List<&2, String>, d: Dec) -> Dec:
3903 match cs:
3904 case Nil{}:
3905 d
3906 case Con{+c, t}:
3907 match d:
3908 case DecOk{+b}:
3909 ce.go(t, ce.apply(c, b))
3910 case DecBad{}:
3911 DecBad{}
3912 case DecSkip{}:
3913 DecSkip{}
3914
3915def decoded.pick(d: Dec, +status: U32, headers: Map<&2, List<&2, String>>, body: String) -> Result<&1, &1, Err, Res>:
3916 match d:
3917 case DecOk{b}:
3918 Done{Res{status, headers, Bytes.from_string(b)}}
3919 case DecBad{}:
3920 Fail{ErrBad{}}
3921 case DecSkip{}:
3922 Done{Res{status, headers, Bytes.from_string(body)}}
3923
3924# ponytail: the codings run on a String copy of the body; give zlib a Bytes input if gzip bodies get big.
3925def decoded.cs(+status: U32, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, cs: List<&2, String>) -> Result<&1, &1, Err, Res>:
3926 match cs:
3927 case Nil{}:
3928 Done{Res{status, headers, body}}
3929 case Con{c, t}:
3930 +s = Bytes.to_string(body)
3931 decoded.pick(ce.go(Con{c, t}, DecOk{s}), status, headers, s)
3932
3933def decoded.go(empty: Bool, +status: U32, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> Result<&1, &1, Err, Res>:
3934 match empty:
3935 case True{}:
3936 Done{Res{status, headers, body}}
3937 case False{}:
3938 decoded.cs(status, headers, body, List.reverse(&2, String, ce.split(fields(headers, "content-encoding"))))
3939
3940# The body decoded per Content-Encoding; the headers stay as sent. A corrupt body is ErrBad.
3941def decoded(res: Res) -> Result<&1, &1, Err, Res>:
3942 Res{+status, +headers, body} = res
3943 Bytes.Bytes{+len, buf} = body
3944 decoded.go(U32.is_zero(len), status, headers, Bytes.Bytes{len, buf})
3945
3946def decoded.m(r: Result<&1, &1, Err, Res>) -> Maybe<&1, Res>:
3947 match r:
3948 case Done{x}:
3949 Some{x}
3950 case Fail{e}:
3951 None{}
3952
3953def decoded.some(res: Res) -> Maybe<&1, Res>:
3954 decoded.m(decoded(res))
3955
3956def ce.words(r: Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Maybe<&1, Bytes.Bytes>:
3957 match r:
3958 case Fail{e}:
3959 None{}
3960 case Done{(+len, buf)}:
3961 Some{Bytes.Bytes{len, buf}}
3962
3963# A decoded body stops at 16 MiB, like a received one.
3964def ce.eff(~eff: U32 -> U32 -> Array<U32> -> IO(Result<&1, &1, U32 & String, U32 & Array<U32>>), b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3965 Bytes.Bytes{+len, buf} = b
3966 do IO<Maybe<&1, Bytes.Bytes>>:
3967 r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- eff(16777216, len, buf)
3968 return ce.words(r)
3969
3970def ce.dec(d: Dec) -> Maybe<&1, Bytes.Bytes>:
3971 match d:
3972 case DecOk{b}:
3973 Some{Bytes.from_string(b)}
3974 case DecBad{}:
3975 None{}
3976 case DecSkip{}:
3977 None{}
3978
3979# ponytail: deflate runs on the pure decoder, which also takes raw DEFLATE; servers rarely send it.
3980def ce.io.deflate(on: Bool, b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3981 match on:
3982 case True{}:
3983 +s = Bytes.to_string(b)
3984 IO.pure(Maybe<&1, Bytes.Bytes>, ce.dec(ce.deflate(s, Zlib.unzlib(s))))
3985 case False{}:
3986 IO.pure(Maybe<&1, Bytes.Bytes>, Some{b})
3987
3988def ce.io.zstd(on: Bool, +c: String, b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3989 match on:
3990 case True{}:
3991 ce.eff(~Zlib.zstd.words, b)
3992 case False{}:
3993 ce.io.deflate(String.eq(c, "deflate"), b)
3994
3995def ce.io.br(on: Bool, +c: String, b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
3996 match on:
3997 case True{}:
3998 ce.eff(~Zlib.brotli.words, b)
3999 case False{}:
4000 ce.io.zstd(String.eq(c, "zstd"), c, b)
4001
4002# One known coding undone: gzip, x-gzip, br, zstd, deflate, or identity.
4003def ce.io.gz(on: Bool, +c: String, b: Bytes.Bytes) -> IO(Maybe<&1, Bytes.Bytes>):
4004 match on:
4005 case True{}:
4006 ce.eff(~Zlib.inflate.words, b)
4007 case False{}:
4008 ce.io.br(String.eq(c, "br"), c, b)
4009
4010def ce.io.go(cs: List<&2, String>, m: Maybe<&1, Bytes.Bytes>) -> IO(Maybe<&1, Bytes.Bytes>):
4011 match cs:
4012 case Nil{}:
4013 match m:
4014 case None{}:
4015 IO.pure(Maybe<&1, Bytes.Bytes>, None{})
4016 case Some{b}:
4017 IO.pure(Maybe<&1, Bytes.Bytes>, Some{b})
4018 case Con{+c, t}:
4019 match m:
4020 case None{}:
4021 IO.pure(Maybe<&1, Bytes.Bytes>, None{})
4022 case Some{b}:
4023 do IO<Maybe<&1, Bytes.Bytes>>:
4024 n : Maybe<&1, Bytes.Bytes> <- ce.io.gz(Bool.or(String.eq(c, "gzip"), String.eq(c, "x-gzip")), c, b)
4025 ce.io.go(t, n)
4026
4027def ce.has(xs: List<&2, String>, +c: String) -> Bool:
4028 match xs:
4029 case Nil{}:
4030 False{}
4031 case Con{x, t}:
4032 Bool.or(String.eq(c, x), ce.has(t, c))
4033
4034def ce.known(cs: List<&2, String>, +ok: List<&2, String>) -> Bool:
4035 match cs:
4036 case Nil{}:
4037 True{}
4038 case Con{c, t}:
4039 Bool.and(ce.has(ok, c), ce.known(t, ok))
4040
4041def decoded.io.pick(m: Maybe<&1, Bytes.Bytes>, +status: U32, headers: Map<&2, List<&2, String>>) -> Result<&1, &1, Err, Res>:
4042 match m:
4043 case Some{b}:
4044 Done{Res{status, headers, b}}
4045 case None{}:
4046 Fail{ErrBad{}}
4047
4048def decoded.io.run(known: Bool, +status: U32, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, cs: List<&2, String>) -> IO(Result<&1, &1, Err, Res>):
4049 match known:
4050 case True{}:
4051 do IO<Result<&1, &1, Err, Res>>:
4052 m : Maybe<&1, Bytes.Bytes> <- ce.io.go(cs, Some{body})
4053 return decoded.io.pick(m, status, headers)
4054 case False{}:
4055 IO.pure(Result<&1, &1, Err, Res>, Done{Res{status, headers, body}})
4056
4057def decoded.io.go(empty: Bool, +enc: String, +status: U32, +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Result<&1, &1, Err, Res>):
4058 match empty:
4059 case True{}:
4060 IO.pure(Result<&1, &1, Err, Res>, Done{Res{status, headers, body}})
4061 case False{}:
4062 +cs = List.reverse(&2, String, ce.split(fields(headers, "content-encoding")))
4063 decoded.io.run(ce.known(cs, Con{"identity", Con{"x-gzip", ce.split(Con{enc, Nil{}})}}), status, headers, body, cs)
4064
4065# decoded through the C libraries, for the codings in enc. A body with any other coding stays as sent.
4066def decoded.io(+enc: String, res: Res) -> IO(Result<&1, &1, Err, Res>):
4067 Res{+status, +headers, body} = res
4068 Bytes.Bytes{+len, buf} = body
4069 decoded.io.go(U32.is_zero(len), enc, status, headers, Bytes.Bytes{len, buf})
4070
4071# An effect on empty input fails with ENOENT only when its library does not load.
4072def codings.ok(r: Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Bool:
4073 match r:
4074 case Fail{(+c, why)}:
4075 Bool.not(U32.is_eq(c, 2))
4076 case Done{p}:
4077 True{}
4078
4079def codings.has(~eff: U32 -> U32 -> Array<U32> -> IO(Result<&1, &1, U32 & String, U32 & Array<U32>>), b: Bytes.Bytes) -> IO(Bool):
4080 Bytes.Bytes{+len, buf} = b
4081 do IO<Bool>:
4082 r : Result<&1, &1, U32 & String, U32 & Array<U32>> <- eff(0, len, buf)
4083 return codings.ok(r)
4084
4085def codings.add(has: Bool, +enc: String, +c: String) -> String:
4086 Bool.pick(String, has, enc ++ ", " ++ c, enc)
4087
4088# gzip and deflate, then br and zstd when their C library loads.
4089def codings() -> IO(String):
4090 do IO<String>:
4091 b : Bool <- codings.has(~Zlib.brotli.words, Bytes.new(0))
4092 z : Bool <- codings.has(~Zlib.zstd.words, Bytes.new(0))
4093 return codings.add(z, codings.add(b, "gzip, deflate", "br"), "zstd")
4094
4095# The final response of a fetch, after redirects.
4096def fetch.final(+enc: String, r: Result<&1, &1, Err, Res>) -> IO(Result<&1, &1, Err, Res>):
4097 match r:
4098 case Done{res}:
4099 decoded.io(enc, res)
4100 case Fail{e}:
4101 IO.pure(Result<&1, &1, Err, Res>, Fail{e})
4102
4103def pool.final(+enc: String, pr: Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>) -> IO(Pool & Result<&1, &1, Err, Res>):
4104 (p, r, jar) = pr
4105 do IO<Pool & Result<&1, &1, Err, Res>>:
4106 d : Result<&1, &1, Err, Res> <- fetch.final(enc, r)
4107 return (p, d)
4108
4109def pool.how.enc(+enc: String, p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32, mode: Mode, cert: Maybe<&2, Cert>) -> IO(Pool & Result<&1, &1, Err, Res>):
4110 do IO<Pool & Result<&1, &1, Err, Res>>:
4111 pr : Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar> <- pool.hops(mode, ms, Hops{p, fetch.start(method, headers, body, Url.absolute(url), enc), cert, None{}})
4112 pool.final(enc, pr)
4113
4114def pool.how.cert(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32, mode: Mode, cert: Maybe<&2, Cert>) -> IO(Pool & Result<&1, &1, Err, Res>):
4115 do IO<Pool & Result<&1, &1, Err, Res>>:
4116 enc : String <- codings()
4117 pool.how.enc(enc, p, method, url, headers, body, ms, mode, cert)
4118
4119# pool.how(p, "GET", "https://example.com/x?y=1", headers, body, ms, mode) follows redirects
4120# on p's idle sockets. Fail is a bad URL, a failed lookup, connect, handshake, send, read,
4121# a malformed response, more than 20 redirects, or a step past ms. Bodies are bytes.
4122def pool.how(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32, mode: Mode) -> IO(Pool & Result<&1, &1, Err, Res>):
4123 pool.how.cert(p, method, url, headers, body, ms, mode, None{})
4124
4125def pool.fetch.with(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32) -> IO(Pool & Result<&1, &1, Err, Res>):
4126 pool.how(p, method, url, headers, body, ms, ModeFollow{})
4127
4128def pool.fetch(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Pool & Result<&1, &1, Err, Res>):
4129 pool.fetch.with(p, method, url, headers, body, 30000)
4130
4131def pool.fetch.cert.with(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, chain: String, key: String, ms: U32) -> IO(Pool & Result<&1, &1, Err, Res>):
4132 pool.how.cert(p, method, url, headers, body, ms, ModeFollow{}, Some{Cert{chain, key}})
4133
4134def pool.fetch.cert(p: Pool, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, chain: String, key: String) -> IO(Pool & Result<&1, &1, Err, Res>):
4135 pool.fetch.cert.with(p, method, url, headers, body, chain, key, 30000)
4136
4137# One request for fetch.all: the arguments of fetch, as a record.
4138type Fetch is Type:
4139 Fetch{method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes}
4140
4141def fetch.all.job(p: Pool, f: Fetch) -> IO(Pool & Result<&1, &1, Err, Res>):
4142 Fetch{method, url, headers, body} = f
4143 pool.fetch(p, method, url, headers, body)
4144
4145def fetch.all.pools(n: Nat) -> List<Pool>:
4146 match n:
4147 case 0n:
4148 Nil{}
4149 case 1n+p:
4150 pool.new() <> fetch.all.pools(p)
4151
4152def fetch.all.close(ps: List<Pool>) -> IO(Unit):
4153 match ps:
4154 case Nil{}:
4155 IO.pure(Unit, Unit{})
4156 case p <> rest:
4157 do IO<Unit>:
4158 pool.close(p)
4159 fetch.all.close(rest)
4160
4161def fetch.all.done(r: List<Pool> & List<Result<&1, &1, Err, Res>>) -> IO(List<Result<&1, &1, Err, Res>>):
4162 (ps, rs) = r
4163 do IO<List<Result<&1, &1, Err, Res>>>:
4164 fetch.all.close(ps)
4165 return rs
4166
4167# No requests start no workers, since Conc.pool needs at least one.
4168def fetch.all.go(xs: List<Fetch>, +workers: Nat) -> IO(List<Result<&1, &1, Err, Res>>):
4169 match xs:
4170 case Nil{}:
4171 IO.pure(List<Result<&1, &1, Err, Res>>, Nil{})
4172 case x <> rest:
4173 do IO<List<Result<&1, &1, Err, Res>>>:
4174 r : List<Pool> & List<Result<&1, &1, Err, Res>> <-
4175 Conc.pool(~Pool, ~Fetch, ~Result<&1, &1, Err, Res>, ~fetch.all.job, fetch.all.pools(workers), x <> rest)
4176 fetch.all.done(r)
4177
4178def fetch.all.of(+n: U32, nx: Nat & List<Fetch>) -> IO(List<Result<&1, &1, Err, Res>>):
4179 (+len, xs) = nx
4180 fetch.all.go(xs, Nat.min(len, Nat.max(1n, U32.to_nat(n))))
4181
4182# Each request as fetch would make it, on at most n workers (0 counts as 1, and
4183# never more workers than requests). Each worker owns its own Pool, so an idle
4184# socket is reused only by the worker that opened it; every pool is closed at the
4185# end. Results come back in the order of reqs.
4186def fetch.all(reqs: List<Fetch>, +n: U32) -> IO(List<Result<&1, &1, Err, Res>>):
4187 fetch.all.of(n, Conc.count(Fetch, reqs))
4188
4189# The hops always hand the jar back; j is only the type's fallback.
4190def pool.jar.final(+enc: String, j: Jar, pr: Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar>) -> IO(Pool & Jar & Result<&1, &1, Err, Res>):
4191 (p, r, jar) = pr
4192 do IO<Pool & Jar & Result<&1, &1, Err, Res>>:
4193 d : Result<&1, &1, Err, Res> <- fetch.final(enc, r)
4194 return (p, Maybe.default(&2, Jar, jar, j), d)
4195
4196def pool.jar.enc(+enc: String, p: Pool, +j: Jar, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Pool & Jar & Result<&1, &1, Err, Res>):
4197 do IO<Pool & Jar & Result<&1, &1, Err, Res>>:
4198 pr : Pool & Result<&1, &1, Err, Res> & Maybe<&2, Jar> <- pool.hops(ModeFollow{}, 30000, Hops{p, fetch.start(method, headers, body, Url.absolute(url), enc), None{}, Some{j}})
4199 pool.jar.final(enc, j, pr)
4200
4201# pool.fetch with a cookie jar (RFC 6265bis). Before every hop, redirects included, the jar's
4202# cookies for that URL join the request's cookie field; after every response, redirects included,
4203# its Set-Cookie fields go into the jar. The jar's clock is the caller's: advance it with jar.at.
4204def pool.fetch.jar(p: Pool, j: Jar, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Pool & Jar & Result<&1, &1, Err, Res>):
4205 do IO<Pool & Jar & Result<&1, &1, Err, Res>>:
4206 enc : String <- codings()
4207 pool.jar.enc(enc, p, j, method, url, headers, body)
4208def fetch.end(pr: Pool & Result<&1, &1, Err, Res>) -> IO(Result<&1, &1, Err, Res>):
4209 (p, r) = pr
4210 do IO<Result<&1, &1, Err, Res>>:
4211 pool.close(p)
4212 return r
4213
4214# fetch is pool.how on a fresh pool that closes afterwards.
4215def fetch.how(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32, mode: Mode) -> IO(Result<&1, &1, Err, Res>):
4216 do IO<Result<&1, &1, Err, Res>>:
4217 pr : Pool & Result<&1, &1, Err, Res> <- pool.how(pool.new(), method, url, headers, body, ms, mode)
4218 fetch.end(pr)
4219
4220def fetch.with(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, ms: U32) -> IO(Result<&1, &1, Err, Res>):
4221 fetch.how(method, url, headers, body, ms, ModeFollow{})
4222
4223def fetch.cert.with(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, chain: String, key: String, ms: U32) -> IO(Result<&1, &1, Err, Res>):
4224 do IO<Result<&1, &1, Err, Res>>:
4225 pr : Pool & Result<&1, &1, Err, Res> <- pool.fetch.cert.with(pool.new(), method, url, headers, body, chain, key, ms)
4226 fetch.end(pr)
4227
4228def fetch.cert(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, chain: String, key: String) -> IO(Result<&1, &1, Err, Res>):
4229 fetch.cert.with(method, url, headers, body, chain, key, 30000)
4230
4231# fetch.with and a 30 s step timeout.
4232def fetch(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Result<&1, &1, Err, Res>):
4233 fetch.with(method, url, headers, body, 30000)
4234
4235def get(url: String) -> IO(Result<&1, &1, Err, Res>):
4236 fetch("GET", url, empty(), Bytes.new(0))
4237
4238# POST v as compact JSON, with content-type: application/json.
4239def post.json(url: String, v: Json.Val) -> IO(Result<&1, &1, Err, Res>):
4240 fetch("POST", url, set(empty(), "content-type", "application/json"), Json.encode.bytes(v))
4241
4242# Base URLs: resolve(base, ref) is ref against the absolute http(s) URL base (RFC 3986 §5.2),
4243# written back as a URL for fetch. None when base is not absolute or ref has another scheme.
4244def resolve.show(a: Url.Abs) -> String:
4245 Url.Abs{+scheme, host, port, +target} = a
4246 scheme ++ "://" ++ Url.host_field(Url.Abs{scheme, host, port, target}) ++ target
4247
4248def resolve.to(m: Maybe<&2, Url.Abs>) -> Maybe<&2, String>:
4249 match m:
4250 case None{}:
4251 None{}
4252 case Some{a}:
4253 Some{resolve.show(a)}
4254
4255def resolve.base(m: Maybe<&2, Url.Abs>, +ref: String) -> Maybe<&2, String>:
4256 match m:
4257 case None{}:
4258 None{}
4259 case Some{b}:
4260 resolve.to(Url.resolve(b, ref))
4261
4262def resolve(base: String, +ref: String) -> Maybe<&2, String>:
4263 resolve.base(Url.absolute(base), ref)
4264
4265# Retry. The wait before retry n (0 first) is 500 ms doubled n times, at most 30 s;
4266# its upper half is jitter r: backoff(n, r) = half + r mod (half + 1).
4267def retry.cap() -> U32:
4268 30000
4269
4270def retry.base(n: Nat) -> U32:
4271 match n:
4272 case 0n:
4273 500
4274 case 1n+p:
4275 U32.min((retry.base(p) * 2 : U32), retry.cap())
4276
4277def retry.backoff.half(+half: U32, +r: U32) -> U32:
4278 (half + (r % (half + 1)) : U32)
4279
4280def retry.backoff(n: Nat, +r: U32) -> U32:
4281 retry.backoff.half((retry.base(n) / 2 : U32), r)
4282
4283# ms clamped to 0 .. retry.cap().
4284def retry.after.ms(+ms: Int.I64) -> U32:
4285 Bool.pick(U32, Int.I64.is_neg(ms), 0,
4286 Bool.pick(U32, Int.I64.is_lt(ms, Int.I64.from_u32(retry.cap())), Int.I64.to_u32(ms), retry.cap()))
4287
4288def retry.after.date(m: Maybe<&2, Time.Instant>, now: Time.Instant) -> Maybe<&2, U32>:
4289 match m:
4290 case None{}:
4291 None{}
4292 case Some{date}:
4293 Some{retry.after.ms(Time.Duration.to_ms(Time.Instant.since(date, now)))}
4294
4295# More than 5 digits is past the cap, and would overflow parse_u32.
4296def retry.after.secs(+v: String, now: Time.Instant, n: Maybe<&2, U32>) -> Maybe<&2, U32>:
4297 match n:
4298 case None{}:
4299 retry.after.date(Time.http_date.parse(v), now)
4300 case Some{s}:
4301 Some{Bool.pick(U32, Nat.is_lt(5n, String.length(v)), retry.cap(), U32.min((s * 1000 : U32), retry.cap()))}
4302
4303# Retry-After (RFC 9110 §10.2.3) as ms from now, at most retry.cap(): delay-seconds, or an
4304# HTTP-date (a past date is 0). None when v is empty or neither form.
4305def retry.after(+v: String, now: Time.Instant) -> Maybe<&2, U32>:
4306 retry.after.secs(v, now, parse_u32(v))
4307
4308def retry.wait(m: Maybe<&2, U32>, n: Nat, +r: U32) -> U32:
4309 match m:
4310 case None{}:
4311 retry.backoff(n, r)
4312 case Some{ms}:
4313 ms
4314
4315# The wait before retry n: Retry-After v when it reads as a delay, else backoff with jitter r.
4316def retry.delay(+v: String, now: Time.Instant, n: Nat, +r: U32) -> U32:
4317 retry.wait(retry.after(v, now), n, r)
4318
4319# Statuses a later try may clear.
4320def retry.status(+s: U32) -> Bool:
4321 Bool.or(Bool.or(U32.is_eq(s, 408), U32.is_eq(s, 429)),
4322 Bool.or(Bool.or(U32.is_eq(s, 500), U32.is_eq(s, 502)), Bool.or(U32.is_eq(s, 503), U32.is_eq(s, 504))))
4323
4324# A refused connect or a timeout may clear; any other error would repeat.
4325def retry.fail(e: Err) -> Result<&1, &1, Err, Res> & Maybe<&2, String>:
4326 match e:
4327 case ErrConnect{code, why}:
4328 (Fail{ErrConnect{code, why}}, Some{""})
4329 case ErrTimeout{}:
4330 (Fail{ErrTimeout{}}, Some{""})
4331 case other:
4332 (Fail{other}, None{})
4333
4334def retry.res(res: Res) -> Result<&1, &1, Err, Res> & Maybe<&2, String>:
4335 Res{+status, +headers, body} = res
4336 (Done{Res{status, headers, body}}, Bool.pick(Maybe<&2, String>, retry.status(status), Some{header(headers, "retry-after")}, None{}))
4337
4338def retry.judge.try(r: Result<&1, &1, Err, Res>) -> Result<&1, &1, Err, Res> & Maybe<&2, String>:
4339 match r:
4340 case Fail{e}:
4341 retry.fail(e)
4342 case Done{res}:
4343 retry.res(res)
4344
4345# One try, judged: the result as it came, and Some{Retry-After value} ("" when absent)
4346# when an idempotent request may try again.
4347def retry.judge(idem: Bool, r: Result<&1, &1, Err, Res>) -> Result<&1, &1, Err, Res> & Maybe<&2, String>:
4348 match idem:
4349 case False{}:
4350 (r, None{})
4351 case True{}:
4352 retry.judge.try(r)
4353
4354# ponytail: a failed random source gives jitter 0, so the wait is the lower half.
4355def retry.jitter(r: Result<&1, &1, U32 & String, U32>) -> U32:
4356 match r:
4357 case Fail{e}:
4358 0
4359 case Done{x}:
4360 x
4361
4362def retry.sleep(+v: String, n: Nat) -> IO(Unit):
4363 do IO<Unit>:
4364 now : Time.Instant <- Time.now()
4365 rnd : Result<&1, &1, U32 & String, U32> <- IO.random_u32()
4366 IO.sleep(retry.delay(v, now, n, retry.jitter(rnd)))
4367
4368def retry.kept(body: Bytes.Bytes, j: Result<&1, &1, Err, Res> & Maybe<&2, String>) -> Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String>:
4369 (r, m) = j
4370 (body, r, m)
4371
4372# One fetch of the copy; the body comes back for the next try.
4373def retry.one(+idem: Bool, +method: String, +url: String, +headers: Map<&2, List<&2, String>>,
4374 r: Bytes.Bytes & Bytes.Bytes) -> IO(Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String>):
4375 (body, spare) = r
4376 do IO<Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String>>:
4377 got : Result<&1, &1, Err, Res> <- fetch(method, url, headers, spare)
4378 return retry.kept(body, retry.judge(idem, got))
4379
4380# left: retries still allowed. n: the retry to wait for next, 0 first.
4381def retry.go(left: Nat, +n: Nat, +idem: Bool, +method: String, +url: String,
4382 +headers: Map<&2, List<&2, String>>,
4383 t: Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String>) -> IO(Result<&1, &1, Err, Res>):
4384 match left:
4385 case 0n:
4386 (body, r, m) = t
4387 IO.pure(Result<&1, &1, Err, Res>, r)
4388 case 1n+p:
4389 (body, r, m) = t
4390 match m:
4391 case None{}:
4392 IO.pure(Result<&1, &1, Err, Res>, r)
4393 case Some{v}:
4394 do IO<Result<&1, &1, Err, Res>>:
4395 retry.sleep(v, n)
4396 tried : Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String> <-
4397 retry.one(idem, method, url, headers, Bytes.slice(body, 0, 4294967295))
4398 retry.go(p, 1n+n, idem, method, url, headers, tried)
4399
4400# fetch.retry(n, method, url, headers, body) is fetch, tried again up to n times while an
4401# idempotent method (GET, HEAD, OPTIONS, TRACE, PUT, DELETE) gets a connect error, a timeout,
4402# or 408, 429, 500, 502, 503, or 504. POST, PATCH and other methods get one try. It waits
4403# Retry-After (seconds or HTTP-date, at most 30 s) when given, else the backoff. When retries
4404# run out, the last response or error comes back as it was.
4405def retry.start(enabled: Bool, n: U32, +method: String, +url: String,
4406 +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
4407 IO(Result<&1, &1, Err, Res>):
4408 match enabled:
4409 case False{}:
4410 fetch(method, url, headers, body)
4411 case True{}:
4412 do IO<Result<&1, &1, Err, Res>>:
4413 first : Bytes.Bytes & Result<&1, &1, Err, Res> & Maybe<&2, String> <-
4414 retry.one(True{}, method, url, headers, Bytes.slice(body, 0, 4294967295))
4415 retry.go(U32.to_nat(n), 0n, True{}, method, url, headers, first)
4416
4417def fetch.retry(+n: U32, +method: String, +url: String,
4418 +headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) ->
4419 IO(Result<&1, &1, Err, Res>):
4420 retry.start(Bool.and(U32.is_ne(n, 0), pool.idempotent(method)),
4421 n, method, url, headers, body)
4422
4423# Streaming (a body read or sent in pieces). A decoded stream owns its decoders.
4424# What the next read returns: read more, a raw piece, a decoded piece, the end, or an error.
4425type Po is Type:
4426 PoNone{}
4427 PoPiece{b: Bytes.Bytes}
4428 PoReady{b: Bytes.Bytes}
4429 PoEnd{}
4430 PoBad{e: Err}
4431
4432type Stream is Type:
4433 Stream{tls: Bool, s: Socket, ms: U32, res: Res, rb: Rb, out: Po, decs: List<&1, Zlib.Decoder>}
4434
4435type Pc is Type:
4436 Pc{rb: Rb, out: Po}
4437
4438# A body piece, or none when empty: more reads the next piece, and not more is the end.
4439def pc.po(more: Bool, empty: Bool, b: Bytes.Bytes) -> Po:
4440 match empty:
4441 case True{}:
4442 Bool.pick(Po, more, PoNone{}, PoEnd{})
4443 case False{}:
4444 PoPiece{b}
4445
4446def pc.piece(more: Bool, +rb: Rb, b: Bytes.Bytes) -> Pc:
4447 Bytes.Bytes{+len, buf} = b
4448 Pc{rb, pc.po(more, U32.is_zero(len), Bytes.Bytes{len, buf})}
4449
4450def pc.fed.of(b: Bytes.Bytes, st: Rb) -> Pc:
4451 match st:
4452 case RbDone{}:
4453 pc.piece(False{}, RbDone{}, b)
4454 case RbBad{}:
4455 Pc{RbDone{}, PoBad{ErrBad{}}}
4456 case RbLen{n}:
4457 pc.piece(True{}, RbLen{n}, b)
4458 case RbChunk{st}:
4459 pc.piece(True{}, RbChunk{st}, b)
4460 case RbClose{}:
4461 pc.piece(True{}, RbClose{}, b)
4462
4463def pc.fed(bf: Bf) -> Pc:
4464 Bf{st, parts, rest} = bf
4465 pc.fed.of(rb.body(parts), st)
4466
4467# The body bytes that just arrived: what they add to the body, and how it ends.
4468def pc.of(rb: Rb, piece: Bytes.Bytes) -> Pc:
4469 pc.fed(rb.feed(rb, Nil{}, piece))
4470
4471# The server closed. Only a close-delimited body may end this way (RFC 9112 §8).
4472def pc.end(ok: Bool) -> Pc:
4473 match ok:
4474 case True{}:
4475 Pc{RbDone{}, PoEnd{}}
4476 case False{}:
4477 Pc{RbDone{}, PoBad{ErrBad{}}}
4478
4479def pc.eof(st: Rb) -> Pc:
4480 pc.end(rb.eof(st))
4481
4482def stream.mk(+tls: Bool, s: Socket, +ms: U32, res: Res, decs: List<&1, Zlib.Decoder>, pc: Pc) -> Stream:
4483 Pc{rb, out} = pc
4484 Stream{tls, s, ms, res, rb, out, decs}
4485
4486def stream.got.piece(+tls: Bool, s: Socket, +ms: U32, res: Res, decs: List<&1, Zlib.Decoder>, +rb: Rb, p: U32 & Array<U32>) -> Stream:
4487 (+len, buf) = p
4488 stream.mk(tls, s, ms, res, decs, Bool.pick(Pc, U32.is_zero(len), pc.eof(rb), pc.of(rb, Bytes.Bytes{len, buf})))
4489
4490def stream.got(+tls: Bool, +ms: U32, res: Res, decs: List<&1, Zlib.Decoder>, +rb: Rb, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Stream:
4491 (s, r) = m
4492 match r:
4493 case Fail{(+code, why)}:
4494 Stream{tls, s, ms, res, RbDone{}, PoBad{err.or_late(code, ErrRead{code, why})}, decs}
4495 case Done{p}:
4496 stream.got.piece(tls, s, ms, res, decs, rb, p)
4497
4498def stream.after(+rb: Rb) -> Po:
4499 match rb:
4500 case RbDone{}:
4501 PoEnd{}
4502 case RbBad{}:
4503 PoEnd{}
4504 case RbLen{n}:
4505 PoNone{}
4506 case RbChunk{st}:
4507 PoNone{}
4508 case RbClose{}:
4509 PoNone{}
4510
4511type Fed is Type:
4512 Fed{decs: List<&1, Zlib.Decoder>, body: Result<&1, &1, Err, Bytes.Bytes>}
4513
4514def stream.feed.received(done: List<&1, Zlib.Decoder>, m: Zlib.Decoder & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Fed:
4515 (d, r) = m
4516 match r:
4517 case Fail{e}:
4518 Fed{d <> done, Fail{ErrBad{}}}
4519 case Done{(+len, buf)}:
4520 Fed{d <> done, Done{Bytes.Bytes{len, buf}}}
4521
4522def stream.feed.step(st: Fed, d: Zlib.Decoder) -> IO(Fed):
4523 Fed{done, body} = st
4524 match body:
4525 case Fail{e}:
4526 IO.pure(Fed, Fed{d <> done, Fail{e}})
4527 case Done{b}:
4528 Bytes.Bytes{+len, buf} = b
4529 do IO<Fed>:
4530 m : Zlib.Decoder & Result<&1, &1, U32 & String, U32 & Array<U32>> <-
4531 Zlib.dec.feed.words(d, 16777216, len, buf)
4532 return stream.feed.received(done, m)
4533
4534def stream.feed.one(prev: IO(Fed), d: Zlib.Decoder) -> IO(Fed):
4535 do IO<Fed>:
4536 st : Fed <- prev
4537 stream.feed.step(st, d)
4538
4539def stream.feed.reverse(st: Fed) -> Fed:
4540 Fed{done, body} = st
4541 Fed{List.reverse(&1, Zlib.Decoder, done), body}
4542
4543def stream.feed.all(decs: List<&1, Zlib.Decoder>, b: Bytes.Bytes) -> IO(Fed):
4544 do IO<Fed>:
4545 st : Fed <- List.foldl(~&1, ~Zlib.Decoder, ~IO(Fed), ~stream.feed.one, decs,
4546 IO.pure(Fed, Fed{Nil{}, Done{b}}))
4547 return stream.feed.reverse(st)
4548
4549def stream.ready(empty: Bool, +rb: Rb, b: Bytes.Bytes) -> Po:
4550 match empty:
4551 case True{}:
4552 stream.after(rb)
4553 case False{}:
4554 PoReady{b}
4555
4556def stream.feed.got(+tls: Bool, s: Socket, +ms: U32, res: Res, +rb: Rb, st: Fed) -> Stream:
4557 Fed{decs, body} = st
4558 match body:
4559 case Fail{e}:
4560 Stream{tls, s, ms, res, rb, PoBad{e}, decs}
4561 case Done{b}:
4562 Bytes.Bytes{+len, buf} = b
4563 Stream{tls, s, ms, res, rb, stream.ready(U32.is_zero(len), rb, Bytes.Bytes{len, buf}), decs}
4564
4565def stream.feed.st(st: Stream, b: Bytes.Bytes) -> IO(Stream):
4566 Stream{+tls, s, +ms, res, +rb, out, decs} = st
4567 match decs:
4568 case Nil{}:
4569 IO.pure(Stream, Stream{tls, s, ms, res, rb, PoReady{b}, Nil{}})
4570 case Con{d, rest}:
4571 do IO<Stream>:
4572 fed : Fed <- stream.feed.all(Con{d, rest}, b)
4573 return stream.feed.got(tls, s, ms, res, rb, fed)
4574
4575def stream.finish.ok(r: Result<&1, &1, U32 & String, Unit>) -> Bool:
4576 match r:
4577 case Fail{e}:
4578 False{}
4579 case Done{u}:
4580 True{}
4581
4582def stream.finish(decs: List<&1, Zlib.Decoder>) -> IO(Bool):
4583 match decs:
4584 case Nil{}:
4585 IO.pure(Bool, True{})
4586 case Con{d, rest}:
4587 do IO<Bool>:
4588 r : Result<&1, &1, U32 & String, Unit> <- Zlib.dec.finish(d)
4589 tail : Bool <- stream.finish(rest)
4590 return Bool.and(stream.finish.ok(r), tail)
4591
4592def stream.ended(good: Bool, +tls: Bool, s: Socket, +ms: U32, res: Res, +rb: Rb) ->
4593 Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>:
4594 match good:
4595 case True{}:
4596 (Stream{tls, s, ms, res, rb, PoEnd{}, Nil{}}, Done{None{}})
4597 case False{}:
4598 (Stream{tls, s, ms, res, rb, PoBad{ErrBad{}}, Nil{}}, Fail{ErrBad{}})
4599
4600# The next piece of the body; None at the end. A piece is never empty.
4601@unsafe
4602def stream.read(st: Stream) -> IO(Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>):
4603 Stream{+tls, s, +ms, res, +rb, out, decs} = st
4604 match out:
4605 case PoPiece{b}:
4606 do IO<Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>>:
4607 next : Stream <- stream.feed.st(Stream{tls, s, ms, res, rb, PoNone{}, decs}, b)
4608 stream.read(next)
4609 case PoReady{b}:
4610 IO.pure(Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>,
4611 (Stream{tls, s, ms, res, rb, stream.after(rb), decs}, Done{Some{b}}))
4612 case PoEnd{}:
4613 do IO<Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>>:
4614 good : Bool <- stream.finish(decs)
4615 return stream.ended(good, tls, s, ms, res, rb)
4616 case PoBad{+e}:
4617 IO.pure(Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>,
4618 (Stream{tls, s, ms, res, rb, PoBad{e}, decs}, Fail{e}))
4619 case PoNone{}:
4620 do IO<Stream & Result<&1, &1, Err, Maybe<&1, Bytes.Bytes>>>:
4621 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- io.recv.words(tls, s, 65536, ms)
4622 stream.read(stream.got(tls, ms, res, decs, rb, m))
4623
4624# Status and headers. Its body is empty: read the body with stream.read.
4625def stream.res(st: Stream) -> Stream & Res:
4626 Stream{tls, s, ms, res, rb, out, decs} = st
4627 Res{+status, +headers, body} = res
4628 (Stream{tls, s, ms, Res{status, headers, body}, rb, out, decs}, Res{status, headers, Bytes.new(0)})
4629
4630def stream.close(st: Stream) -> IO(Unit):
4631 Stream{tls, s, ms, res, rb, out, decs} = st
4632 do IO<Unit>:
4633 good : Bool <- stream.finish(decs)
4634 io.close(tls, s)
4635
4636# Head read state: still scanning, cut short or bad, or the head with the bytes after it.
4637type Sh is Type:
4638 ShMore{buf: Bytes.Bytes, k: U32}
4639 ShBad{err: Maybe<&2, Err>}
4640 ShRes{res: Res, rb: Rb, rest: Bytes.Bytes}
4641
4642def sh.of(hs: Hs) -> Sh:
4643 match hs:
4644 case HsWait{buf, k}:
4645 ShMore{buf, k}
4646 case HsBad{}:
4647 ShBad{None{}}
4648 case HsSeek{buf, from, k}:
4649 ShBad{None{}}
4650 case HsRes{res, rb, rest}:
4651 ShRes{res, rb, rest}
4652
4653def sh.piece(+head: Bool, buf: Bytes.Bytes, +k: U32, p: U32 & Array<U32>) -> Sh:
4654 (+len, b) = p
4655 Bool.pick(Sh, U32.is_zero(len), ShBad{None{}}, sh.of(hs.more(head, k, buf, Bytes.Bytes{len, b})))
4656
4657def sh.next(+head: Bool, buf: Bytes.Bytes, +k: U32, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Socket & Sh:
4658 (s, r) = m
4659 match r:
4660 case Fail{(+code, why)}:
4661 (s, ShBad{Some{err.or_late(code, ErrRead{code, why})}})
4662 case Done{p}:
4663 (s, sh.piece(head, buf, k, p))
4664
4665def fetch.fail.of(r: Result<&1, &1, Err, Res>) -> Result<&1, &1, Err, Stream>:
4666 match r:
4667 case Fail{e}:
4668 Fail{e}
4669 case Done{res}:
4670 Fail{ErrBad{}}
4671
4672# Reads until the final head is in; the body bytes that came with it are the first piece.
4673@unsafe
4674def stream.head(+tls: Bool, +ms: U32, +head: Bool, st: Socket & Sh) -> IO(Result<&1, &1, Err, Stream>):
4675 (s, sh) = st
4676 match sh:
4677 case ShMore{buf, +k}:
4678 do IO<Result<&1, &1, Err, Stream>>:
4679 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- io.recv.words(tls, s, 65536, ms)
4680 stream.head(tls, ms, head, sh.next(head, buf, k, m))
4681 case ShBad{err}:
4682 do IO<Result<&1, &1, Err, Stream>>:
4683 r : Result<&1, &1, Err, Res> <- fetch.bad(tls, s, err)
4684 return fetch.fail.of(r)
4685 case ShRes{res, rb, rest}:
4686 IO.pure(Result<&1, &1, Err, Stream>, Done{stream.mk(tls, s, ms, res, Nil{}, pc.of(rb, rest))})
4687
4688def stream.sent(+tls: Bool, +ms: U32, +head: Bool, m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Result<&1, &1, Err, Stream>):
4689 (s, r) = m
4690 match r:
4691 case Fail{(+code, why)}:
4692 do IO<Result<&1, &1, Err, Stream>>:
4693 io.close(tls, s)
4694 return Fail{err.or_late(code, ErrWrite{code, why})}
4695 case Done{u}:
4696 stream.head(tls, ms, head, (s, ShMore{Bytes.new(0), 0}))
4697
4698def stream.conn(r: Result<&1, &1, Err, Conn>, +ms: U32, +head: Bool, wire: Bytes.Bytes) -> IO(Result<&1, &1, Err, Stream>):
4699 match r:
4700 case Fail{e}:
4701 IO.pure(Result<&1, &1, Err, Stream>, Fail{e})
4702 case Done{c}:
4703 match c:
4704 case Conn{+tls, s}:
4705 do IO<Result<&1, &1, Err, Stream>>:
4706 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, wire)
4707 stream.sent(tls, ms, head, sent)
4708 case ConnH2{s, client}:
4709 do IO<Result<&1, &1, Err, Stream>>:
4710 Wire.tls.close(s)
4711 return Fail{ErrBad{}}
4712
4713# One connection per stream; the request says close.
4714def stream.origin(+ms: U32, +head: Bool, wire: Bytes.Bytes, a: Url.Abs, known: Bool) -> IO(Result<&1, &1, Err, Stream>):
4715 Url.Abs{+scheme, +host, +port, target} = a
4716 match known:
4717 case False{}:
4718 IO.pure(Result<&1, &1, Err, Stream>, Fail{ErrUrl{}})
4719 case True{}:
4720 do IO<Result<&1, &1, Err, Stream>>:
4721 ips : List<&2, String> <- Dns.resolve.all(host)
4722 c : Result<&1, &1, Err, Conn> <- conn.open.all(String.eq(scheme, "https"), ms, host, port, ips, None{}, False{})
4723 stream.conn(c, ms, head, wire)
4724
4725def stream.one.of(+method: String, +url: Url.Abs, +headers: Map<&2, List<&2, String>>, +ms: U32, r: Bytes.Bytes & Bytes.Bytes) -> IO(Hop & Result<&1, &1, Err, Stream>):
4726 Url.Abs{scheme, host, port, +target} = url
4727 (body, wire) = r
4728 do IO<Hop & Result<&1, &1, Err, Stream>>:
4729 got : Result<&1, &1, Err, Stream> <- stream.origin(ms, String.eq(method, "HEAD"), encode_req.on(method, target, Url.host_field(url), headers, wire, True{}), url, pool.scheme.ok(url))
4730 return (Hop{method, url, headers, body}, got)
4731
4732# One request on its own connection. The hop comes back for the redirect.
4733def stream.one(h: Hop, +ms: U32) -> IO(Hop & Result<&1, &1, Err, Stream>):
4734 Hop{+method, +url, +headers, body} = h
4735 stream.one.of(method, url, headers, ms, Bytes.slice(body, 0, 4294967295))
4736
4737# Go: the next request. Drop: close this stream, then go on. Done: the answer.
4738type Sn is Type:
4739 SnGo{left: Nat, hop: Hop}
4740 SnDrop{st: Stream, next: Next}
4741 SnDone{r: Result<&1, &1, Err, Stream>}
4742
4743def sn.of(n: Next) -> Sn:
4744 match n:
4745 case NGo{l, h}:
4746 SnGo{l, h}
4747 case NStop{}:
4748 SnDone{Fail{ErrRedirect{}}}
4749 case NDone{m}:
4750 match m:
4751 case Fail{e}:
4752 SnDone{Fail{e}}
4753 case Done{r}:
4754 SnDone{Fail{ErrBad{}}}
4755
4756def stream.decide.n(st: Stream, n: Next) -> Sn:
4757 match n:
4758 case NDone{m}:
4759 SnDone{Done{st}}
4760 case NGo{l, h}:
4761 SnDrop{st, NGo{l, h}}
4762 case NStop{}:
4763 SnDrop{st, NStop{}}
4764
4765def stream.decide.of(+left: Nat, hop: Hop, sr: Stream & Res) -> Sn:
4766 (st, res) = sr
4767 stream.decide.n(st, fetch.decide(left, hop, Done{res}))
4768
4769def stream.decide(+left: Nat, x: Hop & Result<&1, &1, Err, Stream>) -> Sn:
4770 (hop, r) = x
4771 match r:
4772 case Fail{e}:
4773 SnDone{Fail{e}}
4774 case Done{st}:
4775 stream.decide.of(left, hop, stream.res(st))
4776
4777@unsafe
4778def stream.hops(+ms: U32, sn: Sn) -> IO(Result<&1, &1, Err, Stream>):
4779 match sn:
4780 case SnDone{r}:
4781 IO.pure(Result<&1, &1, Err, Stream>, r)
4782 case SnGo{+left, hop}:
4783 do IO<Result<&1, &1, Err, Stream>>:
4784 x : Hop & Result<&1, &1, Err, Stream> <- stream.one(hop, ms)
4785 stream.hops(ms, stream.decide(left, x))
4786 case SnDrop{st, next}:
4787 do IO<Result<&1, &1, Err, Stream>>:
4788 stream.close(st)
4789 stream.hops(ms, sn.of(next))
4790
4791type Opened is Type:
4792 Opened{decs: List<&1, Zlib.Decoder>, bad: Bool}
4793
4794def stream.open.got(st: Opened, r: Result<&1, &1, U32 & String, Zlib.Decoder>) -> Opened:
4795 Opened{decs, bad} = st
4796 match r:
4797 case Fail{e}:
4798 Opened{decs, True{}}
4799 case Done{d}:
4800 Opened{d <> decs, bad}
4801
4802def stream.open.add(st: Opened, m: IO(Result<&1, &1, U32 & String, Zlib.Decoder>)) -> IO(Opened):
4803 do IO<Opened>:
4804 r : Result<&1, &1, U32 & String, Zlib.Decoder> <- m
4805 return stream.open.got(st, r)
4806
4807def stream.open.zstd(zstd: Bool, st: Opened) -> IO(Opened):
4808 match zstd:
4809 case True{}:
4810 stream.open.add(st, Zlib.zstd.new())
4811 case False{}:
4812 IO.pure(Opened, st)
4813
4814def stream.open.br(br: Bool, +c: String, st: Opened) -> IO(Opened):
4815 match br:
4816 case True{}:
4817 stream.open.add(st, Zlib.brotli.new())
4818 case False{}:
4819 stream.open.zstd(String.eq(c, "zstd"), st)
4820
4821def stream.open.gz(gz: Bool, +c: String, st: Opened) -> IO(Opened):
4822 match gz:
4823 case True{}:
4824 stream.open.add(st, Zlib.inflate.new())
4825 case False{}:
4826 stream.open.br(String.eq(c, "br"), c, st)
4827
4828def stream.open.step(+c: String, st: Opened) -> IO(Opened):
4829 Opened{decs, bad} = st
4830 match bad:
4831 case True{}:
4832 IO.pure(Opened, Opened{decs, True{}})
4833 case False{}:
4834 stream.open.gz(Bool.or(String.eq(c, "gzip"), Bool.or(String.eq(c, "x-gzip"), String.eq(c, "deflate"))),
4835 c, Opened{decs, False{}})
4836
4837def stream.open.one(prev: IO(Opened), c: String) -> IO(Opened):
4838 do IO<Opened>:
4839 st : Opened <- prev
4840 stream.open.step(c, st)
4841
4842def stream.open.all(cs: List<&2, String>) -> IO(Opened):
4843 List.foldl(~&2, ~String, ~IO(Opened), ~stream.open.one, cs, IO.pure(Opened, Opened{Nil{}, False{}}))
4844
4845def stream.put.decs(st: Stream, decs: List<&1, Zlib.Decoder>) -> Stream:
4846 Stream{tls, s, ms, res, rb, out, old} = st
4847 Stream{tls, s, ms, res, rb, out, decs}
4848
4849def stream.init.opened(st: Stream, opened: Opened) -> IO(Result<&1, &1, Err, Stream>):
4850 Opened{decs, bad} = opened
4851 match bad:
4852 case True{}:
4853 do IO<Result<&1, &1, Err, Stream>>:
4854 stream.close(stream.put.decs(st, decs))
4855 return Fail{ErrBad{}}
4856 case False{}:
4857 IO.pure(Result<&1, &1, Err, Stream>, Done{stream.put.decs(st, List.reverse(&1, Zlib.Decoder, decs))})
4858
4859def stream.init.known(known: Bool, st: Stream, cs: List<&2, String>) -> IO(Result<&1, &1, Err, Stream>):
4860 match known:
4861 case False{}:
4862 IO.pure(Result<&1, &1, Err, Stream>, Done{st})
4863 case True{}:
4864 do IO<Result<&1, &1, Err, Stream>>:
4865 opened : Opened <- stream.open.all(cs)
4866 stream.init.opened(st, opened)
4867
4868def stream.init.st(+enc: String, st: Stream) -> IO(Result<&1, &1, Err, Stream>):
4869 Stream{tls, s, ms, res, rb, out, decs} = st
4870 Res{+status, +headers, body} = res
4871 +cs = List.reverse(&2, String, ce.split(fields(headers, "content-encoding")))
4872 stream.init.known(ce.known(cs, Con{"identity", Con{"x-gzip", ce.split(Con{enc, Nil{}})}}),
4873 Stream{tls, s, ms, Res{status, headers, body}, rb, out, decs}, cs)
4874
4875def stream.init(+enc: String, r: Result<&1, &1, Err, Stream>) -> IO(Result<&1, &1, Err, Stream>):
4876 match r:
4877 case Fail{e}:
4878 IO.pure(Result<&1, &1, Err, Stream>, Fail{e})
4879 case Done{st}:
4880 stream.init.st(enc, st)
4881
4882def stream.start(method: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, u: Maybe<&2, Url.Abs>) -> Sn:
4883 match u:
4884 case None{}:
4885 SnDone{Fail{ErrUrl{}}}
4886 case Some{a}:
4887 SnGo{20n, Hop{method, a, req.put(Map.to_list(&2, List<&2, String>, headers), empty()), body}}
4888
4889# Open a raw stream. Its body bytes and headers remain as sent.
4890def open.raw.with(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, +ms: U32) -> IO(Result<&1, &1, Err, Stream>):
4891 stream.hops(ms, stream.start(method, headers, body, Url.absolute(url)))
4892
4893def open.raw(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Result<&1, &1, Err, Stream>):
4894 open.raw.with(method, url, headers, body, 30000)
4895
4896def open.with.enc(+enc: String, method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, +ms: U32) -> IO(Result<&1, &1, Err, Stream>):
4897 do IO<Result<&1, &1, Err, Stream>>:
4898 r : Result<&1, &1, Err, Stream> <-
4899 stream.hops(ms, stream.start(method, accept.enc(headers, enc), body, Url.absolute(url)))
4900 stream.init(enc, r)
4901
4902# Follow redirects, then decode each body piece by Content-Encoding. Unknown codings stay raw.
4903def open.with(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes, +ms: U32) -> IO(Result<&1, &1, Err, Stream>):
4904 do IO<Result<&1, &1, Err, Stream>>:
4905 enc : String <- codings()
4906 open.with.enc(enc, method, url, headers, body, ms)
4907
4908def open(method: String, url: String, headers: Map<&2, List<&2, String>>, body: Bytes.Bytes) -> IO(Result<&1, &1, Err, Stream>):
4909 open.with(method, url, headers, body, 30000)
4910
4911# Upload: the request body sent in chunks (RFC 9112 §7.1). err: the first failed write.
4912type Up is Type:
4913 Up{tls: Bool, s: Socket, ms: U32, head: Bool, err: Maybe<&2, Err>}
4914
4915def hex.digit(+n: U32) -> Char:
4916 Chr{Bool.pick(U32, U32.is_lt(n, 10), (48 + n : U32), (87 + n : U32))}
4917
4918def hex.go(k: Nat, +n: U32, acc: String) -> String:
4919 match k:
4920 case 0n:
4921 acc
4922 case 1n+p:
4923 hex.go(p, U32.shrn(n, 4n), SCon{hex.digit(U32.and(n, 15)), acc})
4924
4925def hex.trim(+s: String) -> String:
4926 match s:
4927 case SNil{}:
4928 SNil{}
4929 case SCon{Chr{+c}, +t}:
4930 Bool.pick(String, Bool.and(U32.is_eq(c, 48), Bool.not(String.is_empty(t))), hex.trim(t), SCon{Chr{c}, t})
4931
4932def hex(+n: U32) -> String:
4933 hex.trim(hex.go(8n, n, ""))
4934
4935def up.sent(+tls: Bool, +ms: U32, +head: Bool, m: Socket & Result<&1, &1, U32 & String, Unit>) -> Up:
4936 (s, r) = m
4937 match r:
4938 case Fail{(+code, why)}:
4939 Up{tls, s, ms, head, Some{err.or_late(code, ErrWrite{code, why})}}
4940 case Done{u}:
4941 Up{tls, s, ms, head, None{}}
4942
4943def up.conn(r: Result<&1, &1, Err, Conn>, +ms: U32, +head: Bool, wire: String) -> IO(Result<&1, &1, Err, Up>):
4944 match r:
4945 case Fail{e}:
4946 IO.pure(Result<&1, &1, Err, Up>, Fail{e})
4947 case Done{c}:
4948 match c:
4949 case Conn{+tls, s}:
4950 do IO<Result<&1, &1, Err, Up>>:
4951 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, Bytes.from_string(wire))
4952 return Done{up.sent(tls, ms, head, sent)}
4953 case ConnH2{s, client}:
4954 do IO<Result<&1, &1, Err, Up>>:
4955 Wire.tls.close(s)
4956 return Fail{ErrBad{}}
4957
4958def up.head(+method: String, +target: String, +hf: String, +headers: Map<&2, List<&2, String>>) -> String:
4959 request(method, target, set(set(set(req.put(Map.to_list(&2, List<&2, String>, headers), empty()), "host", hf), "connection", "close"), "transfer-encoding", "chunked"), "")
4960
4961def up.origin(+method: String, +ms: U32, headers: Map<&2, List<&2, String>>, a: Url.Abs, known: Bool) -> IO(Result<&1, &1, Err, Up>):
4962 Url.Abs{+scheme, +host, +port, +target} = a
4963 match known:
4964 case False{}:
4965 IO.pure(Result<&1, &1, Err, Up>, Fail{ErrUrl{}})
4966 case True{}:
4967 do IO<Result<&1, &1, Err, Up>>:
4968 ips : List<&2, String> <- Dns.resolve.all(host)
4969 c : Result<&1, &1, Err, Conn> <- conn.open.all(String.eq(scheme, "https"), ms, host, port, ips, None{}, False{})
4970 up.conn(c, ms, String.eq(method, "HEAD"), up.head(method, target, Url.host_field(a), headers))
4971
4972def up.url(+method: String, +ms: U32, headers: Map<&2, List<&2, String>>, u: Maybe<&2, Url.Abs>) -> IO(Result<&1, &1, Err, Up>):
4973 match u:
4974 case None{}:
4975 IO.pure(Result<&1, &1, Err, Up>, Fail{ErrUrl{}})
4976 case Some{+a}:
4977 up.origin(method, ms, headers, a, pool.scheme.ok(a))
4978
4979# Http.upload(method, url, headers) sends the head. A streamed body cannot be replayed, so redirects are not followed.
4980def upload.with(+method: String, url: String, headers: Map<&2, List<&2, String>>, +ms: U32) -> IO(Result<&1, &1, Err, Up>):
4981 up.url(method, ms, headers, Url.absolute(url))
4982
4983def upload(+method: String, url: String, headers: Map<&2, List<&2, String>>) -> IO(Result<&1, &1, Err, Up>):
4984 upload.with(method, url, headers, 30000)
4985
4986def up.wrote(+tls: Bool, +ms: U32, +head: Bool, m: Socket & Result<&1, &1, U32 & String, Unit>) -> Up & Result<&2, &2, Err, Unit>:
4987 (s, r) = m
4988 match r:
4989 case Fail{(+code, why)}:
4990 +e = err.or_late(code, ErrWrite{code, why})
4991 (Up{tls, s, ms, head, Some{e}}, Fail{e})
4992 case Done{u}:
4993 (Up{tls, s, ms, head, None{}}, Done{Unit{}})
4994
4995# One write per chunk, so the size line and the data do not wait on each other (Nagle).
4996def up.put(+tls: Bool, s: Socket, +ms: U32, +head: Bool, +len: U32, piece: Bytes.Bytes, skip: Bool) -> IO(Up & Result<&2, &2, Err, Unit>):
4997 match skip:
4998 case True{}:
4999 IO.pure(Up & Result<&2, &2, Err, Unit>, (Up{tls, s, ms, head, None{}}, Done{Unit{}}))
5000 case False{}:
5001 do IO<Up & Result<&2, &2, Err, Unit>>:
5002 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, Bytes.concat(Con{Bytes.from_string(hex(len) ++ "\r\n"), Con{piece, Con{Bytes.from_string("\r\n"), Nil{}}}}))
5003 return up.wrote(tls, ms, head, sent)
5004
5005def up.chunk(+tls: Bool, s: Socket, +ms: U32, +head: Bool, piece: Bytes.Bytes) -> IO(Up & Result<&2, &2, Err, Unit>):
5006 Bytes.Bytes{+len, buf} = piece
5007 up.put(tls, s, ms, head, len, Bytes.Bytes{len, buf}, U32.is_zero(len))
5008
5009# One chunk. An empty piece sends nothing, since an empty chunk would end the body.
5010def upload.write(up: Up, piece: Bytes.Bytes) -> IO(Up & Result<&2, &2, Err, Unit>):
5011 Up{+tls, s, +ms, +head, err} = up
5012 match err:
5013 case Some{+e}:
5014 IO.pure(Up & Result<&2, &2, Err, Unit>, (Up{tls, s, ms, head, Some{e}}, Fail{e}))
5015 case None{}:
5016 up.chunk(tls, s, ms, head, piece)
5017
5018# Ends the body and returns the response as a stream.
5019def upload.finish(up: Up) -> IO(Result<&1, &1, Err, Stream>):
5020 Up{+tls, s, +ms, +head, err} = up
5021 match err:
5022 case Some{e}:
5023 do IO<Result<&1, &1, Err, Stream>>:
5024 io.close(tls, s)
5025 return Fail{e}
5026 case None{}:
5027 do IO<Result<&1, &1, Err, Stream>>:
5028 sent : Socket & Result<&1, &1, U32 & String, Unit> <- io.send.bytes(tls, s, Bytes.from_string("0\r\n\r\n"))
5029 stream.sent(tls, ms, head, sent)
5030
5031type ServerConfig is Data:
5032 ServerConfig{host: String, port: U32, body_bytes: U32, header_bytes: U32,
5033 connections: U32, requests: U32, buffered: U32, header_ms: U32, body_ms: U32,
5034 idle_ms: U32, write_ms: U32}
5035
5036# Shared framing settings; all live readers reserve admission before allocation.
5037type Limits is Data:
5038 Limits{body: Nat, headers: U32, header_ms: U32, body_ms: U32, idle_ms: U32, write_ms: U32}
5039
5040# Bytes.words rounds with len+3 in U32. A retained cap plus the fixed 65536
5041# receive overshoot must still fit before that addition, including temporary copies.
5042def limits.representable() -> U32:
5043 4294901756
5044
5045def limits.validate.ok(valid: Bool) -> IO(Unit):
5046 match valid:
5047 case True{}:
5048 IO.pure(Unit, Unit{})
5049 case False{}:
5050 IO.die(Unit, 22, "request cap plus 65536-byte recv overshoot and 3-byte packed rounding must fit U32")
5051
5052def limits.validate(+max: Nat) -> IO(Unit):
5053 limits.validate.ok(Nat.is_gt(max, 0n) && Nat.is_le(max, U32.to_nat(limits.representable())))
5054
5055def limits(max: Nat) -> Limits:
5056 Limits{max, 65536, 5000, 30000, 30000, 30000}
5057
5058def limits.config(config: ServerConfig) -> Limits:
5059 ServerConfig{host, port, body, headers, connections, requests, buffered, header_ms, body_ms, idle_ms, write_ms} = config
5060 Limits{U32.to_nat(body), headers, header_ms, body_ms, idle_ms, write_ms}
5061
5062# One absolute deadline, never replenished by progress.
5063type Phase is Data:
5064 Phase{kind: U32, until: Time.Duration}
5065
5066def phase.new(+kind: U32, ms: U32, now: Time.Duration) -> Phase:
5067 Phase{kind, Time.Duration.add(now, Time.Duration.of_ms(ms))}
5068
5069def phase.remaining(+until: Time.Duration, +now: Time.Duration) -> U32:
5070 Bool.pick(U32, Cmp.is_lt(Time.Duration.cmp(now, until)),
5071 U32.max(1, Int.I64.to_u32(Time.Duration.to_ms(Time.Duration.sub(until, now)))), 0)
5072
5073def bounded.sent(m: Socket & (U32 & Result<&1, &1, U32 & String, Unit>)) -> Socket & Result<&1, &1, U32 & String, Unit>:
5074 (s, (accepted, result)) = m
5075 (s, result)
5076
5077def bounded.send.ready(expired: Bool, s: Socket, b: Bytes.Bytes, ms: U32) -> IO(Socket & Result<&1, &1, U32 & String, Unit>):
5078 match expired:
5079 case True{}:
5080 IO.pure(Socket & Result<&1, &1, U32 & String, Unit>, (s, Fail{(60, "write deadline expired")}))
5081 case False{}:
5082 Bytes.Bytes{len, words} = b
5083 do IO<Socket & Result<&1, &1, U32 & String, Unit>>:
5084 sent : Socket & (U32 & Result<&1, &1, U32 & String, Unit>) <- Wire.send.words.deadline(s, len, words, ms)
5085 return bounded.sent(sent)
5086
5087def bounded.send(s: Socket, b: Bytes.Bytes, until: Time.Duration) -> IO(Socket & Result<&1, &1, U32 & String, Unit>):
5088 do IO<Socket & Result<&1, &1, U32 & String, Unit>>:
5089 now : Time.Duration <- Time.mono()
5090 +ms : U32 = phase.remaining(until, now)
5091 bounded.send.ready(U32.is_zero(ms), s, b, ms)
5092
5093def reply.bytes(res: Res, head: Bool, close: Bool) -> Bytes.Bytes:
5094 Res{+status, +headers, body} = res
5095 encode.on(Res{status, Bool.pick(Map<&2, List<&2, String>>, close, set(headers, "connection", "close"), headers), body}, head)
5096
5097def reply.fail.bytes(+status: U32) -> Res:
5098 Res{status, set(empty(), "connection", "close"), Bytes.from_string(reason(status))}
5099
5100def reply.drain.of(m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Socket & Bool:
5101 (s, r) = m
5102 match r:
5103 case Fail{e}:
5104 (s, False{})
5105 case Done{data}:
5106 (len, words) = data
5107 (s, Bool.not(U32.is_zero(len)))
5108
5109# ponytail: cap drain at 32 MiB and 2.55 s; use socket half-close if larger peers need guaranteed delivery.
5110def reply.drain(n: Nat, alive: Bool, +until: Time.Duration, st: Socket & Bool) -> IO(Unit):
5111 match n:
5112 case 0n:
5113 (s, more) = st
5114 Socket.close(s)
5115 case 1n+p:
5116 match alive:
5117 case False{}:
5118 (s, more) = st
5119 Socket.close(s)
5120 case True{}:
5121 (s, more) = st
5122 match more:
5123 case False{}:
5124 Socket.close(s)
5125 case True{}:
5126 do IO<Unit>:
5127 got : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- Wire.recv.words(s, 65536, 50)
5128 now : Time.Duration <- Time.mono()
5129 reply.drain(p, Cmp.is_lt(Time.Duration.cmp(now, until)), until, reply.drain.of(got))
5130
5131def reply.sent.close(m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Unit):
5132 (s, r) = m
5133 match r:
5134 case Fail{e}:
5135 Socket.close(s)
5136 case Done{u}:
5137 do IO<Unit>:
5138 now : Time.Duration <- Time.mono()
5139 reply.drain(U32.to_nat(512), True{}, Time.Duration.add(now, Time.Duration.of_ms(2500)), (s, True{}))
5140
5141def reply_fail(s: Socket, +status: U32, ms: U32) -> IO(Unit):
5142 do IO<Unit>:
5143 now : Time.Duration <- Time.mono()
5144 sent : Socket & Result<&1, &1, U32 & String, Unit> <-
5145 bounded.send(s, encode(reply.fail.bytes(status)), Time.Duration.add(now, Time.Duration.of_ms(ms)))
5146 reply.sent.close(sent)
5147
5148
5149# The head is parsed once, when it is whole. Body pieces are kept as they come and joined once.
5150type Sv is Type:
5151 SvHead{buf: Bytes.Bytes}
5152 SvLen{req: Req, v11: Bool, left: U32, parts: List<&1, Bytes.Bytes>}
5153 SvChunk{req: Req, v11: Bool, n: U32, st: Dc, parts: List<&1, Bytes.Bytes>}
5154
5155# More: read on, first answering 100 Continue when cont is set.
5156type Turn is Type:
5157 TurnClose{}
5158 TurnFail{status: U32}
5159 TurnReq{req: Req, rest: Bytes.Bytes, v11: Bool}
5160 TurnMore{sv: Sv, cont: Bool}
5161
5162def serve.max() -> Nat:
5163 fetch.max()
5164
5165def sv.none() -> Sv:
5166 SvHead{Bytes.new(0)}
5167
5168def sv.body(req: Req, +v11: Bool, parts: List<&1, Bytes.Bytes>, rest: Bytes.Bytes) -> Turn:
5169 Req{method, path, headers, body} = req
5170 TurnReq{Req{method, path, headers, rb.body(parts)}, rest, v11}
5171
5172def sv.len.cut(req: Req, +v11: Bool, parts: List<&1, Bytes.Bytes>, +len: U32, +left: U32, r: Bytes.Bytes & Bytes.Bytes) -> Turn:
5173 (piece, last) = r
5174 sv.body(req, v11, Con{last, parts}, bytes.snd(Bytes.slice(piece, left, (len - left : U32))))
5175
5176def sv.len.have(short: Bool, req: Req, +v11: Bool, +left: U32, parts: List<&1, Bytes.Bytes>, +len: U32, piece: Bytes.Bytes) -> Turn:
5177 match short:
5178 case True{}:
5179 TurnMore{SvLen{req, v11, (left - len : U32), Con{piece, parts}}, False{}}
5180 case False{}:
5181 sv.len.cut(req, v11, parts, len, left, Bytes.slice(piece, 0, left))
5182
5183def sv.len(req: Req, +v11: Bool, +left: U32, parts: List<&1, Bytes.Bytes>, piece: Bytes.Bytes) -> Turn:
5184 Bytes.Bytes{+len, buf} = piece
5185 sv.len.have(U32.is_lt(len, left), req, v11, left, parts, len, Bytes.Bytes{len, buf})
5186
5187def sv.chunk.of(req: Req, +v11: Bool, +n: U32, c: Ck) -> Turn:
5188 Ck{st, parts, rest} = c
5189 match st:
5190 case DcDone{}:
5191 sv.body(req, v11, parts, rest)
5192 case DcBad{}:
5193 TurnFail{400}
5194 case DcSize{a, b}:
5195 TurnMore{SvChunk{req, v11, n, DcSize{a, b}, parts}, False{}}
5196 case DcExt{x}:
5197 TurnMore{SvChunk{req, v11, n, DcExt{x}, parts}, False{}}
5198 case DcSizeLf{x}:
5199 TurnMore{SvChunk{req, v11, n, DcSizeLf{x}, parts}, False{}}
5200 case DcData{k}:
5201 TurnMore{SvChunk{req, v11, n, DcData{k}, parts}, False{}}
5202 case DcDataCr{}:
5203 TurnMore{SvChunk{req, v11, n, DcDataCr{}, parts}, False{}}
5204 case DcDataLf{}:
5205 TurnMore{SvChunk{req, v11, n, DcDataLf{}, parts}, False{}}
5206 case DcTr{j}:
5207 TurnMore{SvChunk{req, v11, n, DcTr{j}, parts}, False{}}
5208
5209def sv.chunk.parts.cons(+len: U32, buf: Array<U32>, counted: List<&1, Bytes.Bytes> & Nat) -> List<&1, Bytes.Bytes> & Nat:
5210 (rest, n) = counted
5211 (Con{Bytes.Bytes{len, buf}, rest}, Nat.add(U32.to_nat(len), n))
5212
5213def sv.chunk.parts(xs: List<&1, Bytes.Bytes>, old: List<&1, Bytes.Bytes>) -> List<&1, Bytes.Bytes> & Nat:
5214 match xs:
5215 case Nil{}:
5216 (old, 0n)
5217 case Con{b, tail}:
5218 Bytes.Bytes{+len, buf} = b
5219 sv.chunk.parts.cons(len, buf, sv.chunk.parts(tail, old))
5220
5221def sv.chunk.cap(big: Bool, req: Req, +v11: Bool, n: U32, st: Dc, parts: List<&1, Bytes.Bytes>, rest: Bytes.Bytes) -> Turn:
5222 match big:
5223 case True{}:
5224 TurnFail{413}
5225 case False{}:
5226 sv.chunk.of(req, v11, n, Ck{st, parts, rest})
5227
5228def sv.chunk.counted(+max: Nat, req: Req, v11: Bool, n: U32, st: Dc, rest: Bytes.Bytes, counted: List<&1, Bytes.Bytes> & Nat) -> Turn:
5229 (parts, size) = counted
5230 +total = Nat.add(U32.to_nat(n), size)
5231 sv.chunk.cap(Nat.is_lt(max, total) || Nat.is_lt(U32.to_nat(4294967295), total), req, v11,
5232 U32.from_nat(total), st, parts, rest)
5233
5234def sv.chunk.decoded(max: Nat, req: Req, v11: Bool, n: U32, old: List<&1, Bytes.Bytes>, c: Ck) -> Turn:
5235 Ck{st, parts, rest} = c
5236 sv.chunk.counted(max, req, v11, n, st, rest, sv.chunk.parts(parts, old))
5237
5238def sv.chunk(+max: Nat, req: Req, +v11: Bool, +n: U32, st: Dc, parts: List<&1, Bytes.Bytes>, piece: Bytes.Bytes) -> Turn:
5239 sv.chunk.decoded(max, req, v11, n, parts, ck(piece, st, Nil{}))
5240
5241# RFC 9110 §10.1.1: answer 100 Continue only when the body is still to come.
5242def sv.cont(want: Bool, t: Turn) -> Turn:
5243 match t:
5244 case TurnMore{sv, c}:
5245 TurnMore{sv, want}
5246 case TurnClose{}:
5247 TurnClose{}
5248 case TurnFail{s}:
5249 TurnFail{s}
5250 case TurnReq{req, rest, v11}:
5251 TurnReq{req, rest, v11}
5252
5253def sv.cl.k(big: Bool, req: Req, +v11: Bool, +k: U32, rest: Bytes.Bytes) -> Turn:
5254 match big:
5255 case True{}:
5256 TurnFail{413}
5257 case False{}:
5258 sv.len(req, v11, k, Nil{}, rest)
5259
5260def sv.cl(+max: Nat, req: Req, +v11: Bool, rest: Bytes.Bytes, n: Maybe<&2, U32>) -> Turn:
5261 match n:
5262 case None{}:
5263 TurnFail{400}
5264 case Some{+k}:
5265 sv.cl.k(Nat.is_lt(max, U32.to_nat(k)), req, v11, k, rest)
5266
5267def sv.frame(+max: Nat, req: Req, +v11: Bool, rest: Bytes.Bytes, te: Bool) -> Turn:
5268 Req{method, path, +headers, body} = req
5269 match te:
5270 case True{}:
5271 sv.chunk(max, Req{method, path, headers, body}, v11, 0, dc.start(), Nil{}, rest)
5272 case False{}:
5273 sv.cl(max, Req{method, path, headers, body}, v11, rest, parse_u32(header(headers, "content-length")))
5274
5275def sv.expects(+v11: Bool, +headers: Map<&2, List<&2, String>>) -> Bool:
5276 Bool.and(v11, String.eq(String.to_lower(header(headers, "expect")), "100-continue"))
5277
5278def sv.got.head(+max: Nat, +v11: Bool, rest: Bytes.Bytes, req: Req) -> Turn:
5279 Req{method, path, +headers, body} = req
5280 sv.cont(sv.expects(v11, headers), sv.frame(max, Req{method, path, headers, body}, v11, rest, has_header(headers, "transfer-encoding")))
5281
5282def sv.parsed(+max: Nat, +v11: Bool, rest: Bytes.Bytes, g: Got) -> Turn:
5283 match g:
5284 case GotBad{}:
5285 TurnFail{400}
5286 case GotMore{}:
5287 TurnFail{400}
5288 case GotReq{req}:
5289 TurnReq{req, rest, v11}
5290 case GotHead{req}:
5291 sv.got.head(max, v11, rest, req)
5292
5293def sv.split(+max: Nat, +hlen: U32, +len: U32, r: Bytes.Bytes & Bytes.Bytes) -> Turn:
5294 (buf, hb) = r
5295 +head = Bytes.to_string(hb)
5296 sv.parsed(max, req.v11(head), bytes.snd(Bytes.slice(buf, hlen, (len - hlen : U32))), parse.got(head))
5297
5298def sv.hit.none(big: Bool, buf: Bytes.Bytes) -> Turn:
5299 match big:
5300 case True{}:
5301 TurnFail{431}
5302 case False{}:
5303 TurnMore{SvHead{buf}, False{}}
5304
5305def sv.hit.some(big: Bool, +max: Nat, +hlen: U32, +len: U32, buf: Bytes.Bytes) -> Turn:
5306 match big:
5307 case True{}:
5308 TurnFail{431}
5309 case False{}:
5310 sv.split(max, hlen, len, Bytes.slice(buf, 0, hlen))
5311
5312# RFC 6585 §5: refuse a head over the configured byte limit.
5313def sv.hit(+max: Nat, +headers: U32, +len: U32, buf: Bytes.Bytes, at: Maybe<&2, U32>) -> Turn:
5314 match at:
5315 case None{}:
5316 sv.hit.none(U32.is_lt(headers, len), buf)
5317 case Some{+i}:
5318 +hlen = (i + 4 : U32)
5319 sv.hit.some(U32.is_lt(headers, hlen), max, hlen, len, buf)
5320
5321def sv.seek.of(+max: Nat, +headers: U32, +len: U32, +from: U32, buf: Bytes.Bytes, r: Bytes.Bytes & Maybe<&2, U32>) -> Turn:
5322 (tail, m) = r
5323 sv.hit(max, headers, len, buf, found.at(from, m))
5324
5325def sv.seek(+max: Nat, +headers: U32, +len: U32, +from: U32, r: Bytes.Bytes & Bytes.Bytes) -> Turn:
5326 (buf, tail) = r
5327 sv.seek.of(max, headers, len, from, buf, Bytes.find(tail, "\r\n\r\n"))
5328
5329# Only the new bytes, and the 3 before them, can finish the blank line.
5330def sv.head.at(+max: Nat, +headers: U32, +from: U32, buf: Bytes.Bytes) -> Turn:
5331 Bytes.Bytes{+len, b} = buf
5332 sv.seek(max, headers, len, from, Bytes.slice(Bytes.Bytes{len, b}, from, (len - from : U32)))
5333
5334def sv.head(+max: Nat, +headers: U32, buf: Bytes.Bytes, piece: Bytes.Bytes) -> Turn:
5335 Bytes.Bytes{+ol, ob} = buf
5336 sv.head.at(max, headers, Bool.pick(U32, U32.is_lt(ol, 3), 0, (ol - 3 : U32)), Bytes.append(Bytes.Bytes{ol, ob}, piece))
5337
5338def sv.closed.pick(empty: Bool) -> Turn:
5339 match empty:
5340 case True{}:
5341 TurnClose{}
5342 case False{}:
5343 TurnFail{400}
5344
5345def sv.closed.head(buf: Bytes.Bytes) -> Turn:
5346 Bytes.Bytes{+len, b} = buf
5347 sv.closed.pick(U32.is_eq(len, 0))
5348
5349# A close mid-request is a request cut short (RFC 9112 §8).
5350def sv.step(closed: Bool, +max: Nat, +headers: U32, sv: Sv, piece: Bytes.Bytes) -> Turn:
5351 match closed:
5352 case True{}:
5353 match sv:
5354 case SvHead{buf}:
5355 sv.closed.head(buf)
5356 case SvLen{req, v11, left, parts}:
5357 TurnFail{400}
5358 case SvChunk{req, v11, n, st, parts}:
5359 TurnFail{400}
5360 case False{}:
5361 match sv:
5362 case SvHead{buf}:
5363 sv.head(max, headers, buf, piece)
5364 case SvLen{req, +v11, +left, parts}:
5365 sv.len(req, v11, left, parts, piece)
5366 case SvChunk{req, +v11, +n, st, parts}:
5367 sv.chunk(max, req, v11, n, st, parts, piece)
5368
5369def sv.frame.req(t: Turn) -> Maybe<&1, String & String>:
5370 match t:
5371 case TurnReq{req, rest, v11}:
5372 Req{method, path, headers, body} = req
5373 Some{(Bytes.to_string(body), Bytes.to_string(rest))}
5374 case TurnMore{sv, c}:
5375 None{}
5376 case TurnFail{s}:
5377 None{}
5378 case TurnClose{}:
5379 None{}
5380
5381def sv.frame.go(xs: List<&2, String>, t: Turn) -> Maybe<&1, String & String>:
5382 match xs:
5383 case Nil{}:
5384 sv.frame.req(t)
5385 case Con{+x, rest}:
5386 match t:
5387 case TurnMore{sv, c}:
5388 sv.frame.go(rest, sv.step(False{}, serve.max(), 65536, sv, Bytes.from_string(x)))
5389 case TurnReq{req, r, v11}:
5390 sv.frame.req(TurnReq{req, r, v11})
5391 case TurnFail{s}:
5392 None{}
5393 case TurnClose{}:
5394 None{}
5395
5396# The body and the bytes after it, once the pieces make a whole request; None otherwise.
5397def serve.frame(xs: List<&2, String>) -> Maybe<&1, String & String>:
5398 sv.frame.go(xs, TurnMore{sv.none(), False{}})
5399
5400def talk.piece(settings: Limits, sv: Sv, p: U32 & Array<U32>) -> Turn:
5401 Limits{max, headers, hm, bm, im, wm} = settings
5402 (+len, buf) = p
5403 sv.step(U32.is_eq(len, 0), max, headers, sv, Bytes.Bytes{len, buf})
5404
5405def talk.next(settings: Limits, sv: Sv, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> Socket & Turn:
5406 (s, r) = m
5407 match r:
5408 case Fail{(code, message)}:
5409 (s, Bool.pick(Turn, err.late(code), TurnFail{408}, TurnClose{}))
5410 case Done{p}:
5411 (s, talk.piece(settings, sv, p))
5412
5413def talk.after.pick(empty: Bool, settings: Limits, rest: Bytes.Bytes) -> Turn:
5414 match empty:
5415 case True{}:
5416 TurnMore{sv.none(), False{}}
5417 case False{}:
5418 Limits{max, headers, hm, bm, im, wm} = settings
5419 sv.step(False{}, max, headers, sv.none(), rest)
5420
5421def talk.after.rest(settings: Limits, rest: Bytes.Bytes, s: Socket) -> Socket & Turn:
5422 Bytes.Bytes{+len, buf} = rest
5423 (s, talk.after.pick(U32.is_eq(len, 0), settings, Bytes.Bytes{len, buf}))
5424
5425def talk.after.keep(keep: Bool, settings: Limits, rest: Bytes.Bytes, s: Socket) -> Socket & Turn:
5426 match keep:
5427 case False{}:
5428 (s, TurnClose{})
5429 case True{}:
5430 talk.after.rest(settings, rest, s)
5431
5432def talk.after(settings: Limits, keep: Bool, rest: Bytes.Bytes, m: Socket & Result<&1, &1, U32 & String, Unit>) -> Socket & Turn:
5433 (s, r) = m
5434 match r:
5435 case Fail{e}:
5436 (s, TurnClose{})
5437 case Done{u}:
5438 talk.after.keep(keep, settings, rest, s)
5439
5440def talk.send(+settings: Limits, s: Socket, rest: Bytes.Bytes, +headers: Map<&2, List<&2, String>>, v11: Bool, +head: Bool, res: Res) -> IO(Socket & Turn):
5441 Limits{max, cap, hm, bm, im, wm} = settings
5442 Res{+status, +rh, body} = res
5443 +keep = serve.keep(headers, v11, status, rh)
5444 do IO<Socket & Turn>:
5445 now : Time.Duration <- Time.mono()
5446 sent : Socket & Result<&1, &1, U32 & String, Unit> <-
5447 bounded.send(s, reply.bytes(Res{status, rh, body}, head, Bool.not(keep)), Time.Duration.add(now, Time.Duration.of_ms(wm)))
5448 return talk.after(settings, keep, rest, sent)
5449
5450def talk.cont(cont: Bool, s: Socket, ms: U32) -> IO(Socket & Result<&1, &1, U32 & String, Unit>):
5451 match cont:
5452 case False{}:
5453 IO.pure(Socket & Result<&1, &1, U32 & String, Unit>, (s, Done{Unit{}}))
5454 case True{}:
5455 do IO<Socket & Result<&1, &1, U32 & String, Unit>>:
5456 now : Time.Duration <- Time.mono()
5457 bounded.send(s, Bytes.from_string("HTTP/1.1 100 Continue\r\n\r\n"), Time.Duration.add(now, Time.Duration.of_ms(ms)))
5458
5459def phase.head(empty: Bool, settings: Limits, now: Time.Duration) -> Phase:
5460 match empty:
5461 case True{}:
5462 Limits{max, cap, hm, bm, im, wm} = settings
5463 phase.new(0, im, now)
5464 case False{}:
5465 Limits{max, cap, hm, bm, im, wm} = settings
5466 phase.new(1, hm, now)
5467
5468def phase.start(settings: Limits, sv: Sv, now: Time.Duration) -> Phase & Sv:
5469 Limits{max, cap, hm, bm, im, wm} = settings
5470 match sv:
5471 case SvHead{buf}:
5472 Bytes.Bytes{+len, words} = buf
5473 (phase.head(U32.is_zero(len), Limits{max, cap, hm, bm, im, wm}, now), SvHead{Bytes.Bytes{len, words}})
5474 case SvLen{req, v11, left, parts}:
5475 (phase.new(2, bm, now), SvLen{req, v11, left, parts})
5476 case SvChunk{req, v11, n, st, parts}:
5477 (phase.new(2, bm, now), SvChunk{req, v11, n, st, parts})
5478
5479def phase.select(settings: Limits, sv: Sv, now: Time.Duration, previous: Maybe<&2, Phase>) -> Phase & Sv:
5480 match previous:
5481 case None{}:
5482 phase.start(settings, sv, now)
5483 case Some{phase}:
5484 (phase, sv)
5485
5486# Buffered pipelined headers have already ended before upload callbacks run.
5487def phase.body(previous: Maybe<&2, Phase>, settings: Limits, now: Time.Duration) -> Phase:
5488 match previous:
5489 case Some{phase}:
5490 phase
5491 case None{}:
5492 Limits{max, cap, hm, bm, im, wm} = settings
5493 phase.new(2, bm, now)
5494
5495def phase.after(+settings: Limits, +now: Time.Duration, +phase: Phase, t: Turn) -> Turn & Phase:
5496 Limits{max, cap, hm, bm, im, wm} = settings
5497 Phase{+kind, until} = phase
5498 match t:
5499 case TurnMore{sv, cont}:
5500 match sv:
5501 case SvHead{buf}:
5502 (TurnMore{SvHead{buf}, cont}, Bool.pick(Phase, U32.is_zero(kind), phase.new(1, hm, now), phase))
5503 case SvLen{req, v11, left, parts}:
5504 (TurnMore{SvLen{req, v11, left, parts}, cont}, Bool.pick(Phase, U32.is_eq(kind, 2), phase, phase.new(2, bm, now)))
5505 case SvChunk{req, v11, n, st, parts}:
5506 (TurnMore{SvChunk{req, v11, n, st, parts}, cont}, Bool.pick(Phase, U32.is_eq(kind, 2), phase, phase.new(2, bm, now)))
5507 case TurnReq{req, rest, v11}:
5508 (TurnReq{req, rest, v11}, phase)
5509 case TurnFail{+status}:
5510 (Bool.pick(Turn, U32.is_zero(kind) && U32.is_eq(status, 408), TurnClose{}, TurnFail{status}), phase)
5511 case TurnClose{}:
5512 (TurnClose{}, phase)
5513
5514def phase.expired(phase: Phase) -> Turn:
5515 Phase{kind, until} = phase
5516 Bool.pick(Turn, U32.is_zero(kind), TurnClose{}, TurnFail{408})
5517
5518def talk.received.state(s: Socket, next: Turn & Phase) -> (Socket & Turn) & Phase:
5519 (t, p) = next
5520 ((s, t), p)
5521
5522def talk.received.phase(settings: Limits, phase: Phase, now: Time.Duration, next: Socket & Turn) -> (Socket & Turn) & Phase:
5523 (s, t) = next
5524 talk.received.state(s, phase.after(settings, now, phase, t))
5525
5526def talk.received.late(expired: Bool, +settings: Limits, +phase: Phase, now: Time.Duration, sv: Sv, m: Socket & Result<&1, &1, U32 & String, U32 & Array<U32>>) -> (Socket & Turn) & Phase:
5527 match expired:
5528 case True{}:
5529 (s, r) = m
5530 ((s, phase.expired(phase)), phase)
5531 case False{}:
5532 talk.received.phase(settings, phase, now, talk.next(settings, sv, m))
5533
5534def talk.read.ready(expired: Bool, +settings: Limits, s: Socket, sv: Sv, +phase: Phase, ms: U32) -> IO((Socket & Turn) & Phase):
5535 match expired:
5536 case True{}:
5537 IO.pure((Socket & Turn) & Phase, ((s, phase.expired(phase)), phase))
5538 case False{}:
5539 Phase{kind, +until} = phase
5540 do IO<(Socket & Turn) & Phase>:
5541 m : Socket & Result<&1, &1, U32 & String, U32 & Array<U32>> <- Wire.recv.words(s, 65536, ms)
5542 +now : Time.Duration <- Time.mono()
5543 return talk.received.late(Bool.not(Cmp.is_lt(Time.Duration.cmp(now, until))), settings, phase, now, sv, m)
5544
5545def talk.read(+settings: Limits, sv: Sv, +phase: Phase, m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO((Socket & Turn) & Phase):
5546 Phase{kind, until} = phase
5547 (s, r) = m
5548 match r:
5549 case Fail{e}:
5550 IO.pure((Socket & Turn) & Phase, ((s, TurnClose{}), phase))
5551 case Done{u}:
5552 do IO<(Socket & Turn) & Phase>:
5553 now : Time.Duration <- Time.mono()
5554 +ms : U32 = phase.remaining(until, now)
5555 talk.read.ready(U32.is_zero(ms), settings, s, sv, phase, ms)
5556
5557def talk.recv.selected(+settings: Limits, s: Socket, cont: Bool, selected: Phase & Sv) -> IO((Socket & Turn) & Phase):
5558 Limits{max, cap, hm, bm, im, wm} = settings
5559 (phase, state) = selected
5560 do IO<(Socket & Turn) & Phase>:
5561 sent : Socket & Result<&1, &1, U32 & String, Unit> <- talk.cont(cont, s, wm)
5562 talk.read(settings, state, phase, sent)
5563
5564def talk.recv(+settings: Limits, s: Socket, sv: Sv, cont: Bool, previous: Maybe<&2, Phase>) -> IO((Socket & Turn) & Phase):
5565 do IO<(Socket & Turn) & Phase>:
5566 now : Time.Duration <- Time.mono()
5567 talk.recv.selected(settings, s, cont, phase.select(settings, sv, now, previous))
5568
5569type Serving is Type:
5570 Serving{connection: Socket & Turn, phase: Maybe<&2, Phase>}
5571
5572def talk.state(received: (Socket & Turn) & Phase) -> Serving:
5573 (connection, phase) = received
5574 Serving{connection, Some{phase}}
5575
5576def serve.write.state(after: Maybe<&1, Socket & Turn>) -> Maybe<&1, Serving>:
5577 match after:
5578 case None{}:
5579 None{}
5580 case Some{connection}:
5581 Some{Serving{connection, None{}}}
5582
5583# A buffered-work unit owns one connection's incomplete request, decoded body,
5584# and pipelined remainder from before its first recv until the task really returns.
5585# ponytail: idle sockets also reserve buffer units; split idle/read leases if idle utilization matters.
5586def admission.done(+inbox: Chan(Admission.Command), operation: IO(Unit)) -> IO(Unit):
5587 do IO<Unit>:
5588 operation
5589 Admission.give(inbox, 0)
5590
5591def admission.head(req: Req) -> Bool:
5592 Req{method, path, headers, body} = req
5593 String.eq(method, "HEAD")
5594
5595def admission.turn.head(turn: Turn) -> Bool:
5596 match turn:
5597 case TurnReq{req, rest, v11}:
5598 admission.head(req)
5599 case TurnMore{sv, cont}:
5600 match sv:
5601 case SvHead{buf}:
5602 False{}
5603 case SvLen{req, v11, left, parts}:
5604 admission.head(req)
5605 case SvChunk{req, v11, n, state, parts}:
5606 admission.head(req)
5607 case TurnFail{status}:
5608 False{}
5609 case TurnClose{}:
5610 False{}
5611
5612# This rejection has parsed metadata, so normal HEAD body suppression still applies.
5613def admission.reject(s: Socket, head: Bool, ms: U32) -> IO(Unit):
5614 do IO<Unit>:
5615 now : Time.Duration <- Time.mono()
5616 sent : Socket & Result<&1, &1, U32 & String, Unit> <-
5617 bounded.send(s, reply.bytes(reply.fail.bytes(503), head, True{}), Time.Duration.add(now, Time.Duration.of_ms(ms)))
5618 reply.sent.close(sent)
5619
5620def admission.request(
5621 ~C: Data, ~h: C -> Req -> IO(Res), admitted: Bool, +inbox: Chan(Admission.Command),
5622 context: C, +settings: Limits, s: Socket, req: Req, rest: Bytes.Bytes, v11: Bool
5623) -> IO(Maybe<&1, Socket & Turn>):
5624 match admitted:
5625 case False{}:
5626 Limits{max, cap, hm, bm, im, wm} = settings
5627 do IO<Maybe<&1, Socket & Turn>>:
5628 admission.reject(s, admission.head(req), wm)
5629 return None{}
5630 case True{}:
5631 Req{+method, path, +headers, body} = req
5632 do IO<Maybe<&1, Socket & Turn>>:
5633 res : Res <- h(context, Req{method, path, headers, body})
5634 next : Socket & Turn <- talk.send(settings, s, rest, headers, v11, String.eq(method, "HEAD"), res)
5635 Admission.give(inbox, 1)
5636 return Some{next}
5637
5638
5639@unsafe
5640def talk(~C: Data, ~h: C -> Req -> IO(Res), +context: C, +settings: Limits, +inbox: Chan(Admission.Command), st: Maybe<&1, Serving>) -> IO(Unit):
5641 Limits{max, cap, hm, bm, im, wm} = settings
5642 match st:
5643 case None{}:
5644 IO.pure(Unit, Unit{})
5645 case Some{Serving{(s, t), phase}}:
5646 match t:
5647 case TurnMore{sv, cont}:
5648 do IO<Unit>:
5649 received : (Socket & Turn) & Phase <- talk.recv(settings, s, sv, cont, phase)
5650 talk(~C, ~h, context, settings, inbox, Some{talk.state(received)})
5651 case TurnReq{req, rest, v11}:
5652 do IO<Unit>:
5653 admitted : Bool <- Admission.take(inbox, 1)
5654 next : Maybe<&1, Socket & Turn> <- admission.request(~C, ~h, admitted, inbox, context, settings, s, req, rest, v11)
5655 talk(~C, ~h, context, settings, inbox, serve.write.state(next))
5656 case TurnFail{status}:
5657 reply_fail(s, status, wm)
5658 case TurnClose{}:
5659 Socket.close(s)
5660
5661def conn.admitted(~h: Req -> IO(Res), admitted: Bool, +settings: Limits, +inbox: Chan(Admission.Command), l: Listener, s: Socket) -> IO(Listener):
5662 match admitted:
5663 case False{}:
5664 do IO<Listener>:
5665 Socket.close(s)
5666 return l
5667 case True{}:
5668 do IO<Listener>:
5669 IO.spawn(Unit, admission.done(inbox, talk(~Unit, ~(context => req => h(req)), Unit{}, settings, inbox,
5670 Some{Serving{(s, TurnMore{sv.none(), False{}}), None{}}})))
5671 return l
5672
5673def conn(~h: Req -> IO(Res), +settings: Limits, +inbox: Chan(Admission.Command), m: Listener & Result<&1, &1, U32 & String, Socket>) -> IO(Listener):
5674 (l, r) = m
5675 do IO<Listener>:
5676 s : Socket <- IO.pass(Socket, r)
5677 admitted : Bool <- Admission.take(inbox, 0)
5678 conn.admitted(~h, admitted, settings, inbox, l, s)
5679
5680@unsafe
5681def loop(~h: Req -> IO(Res), +settings: Limits, +inbox: Chan(Admission.Command), l: Listener) -> IO(Unit):
5682 do IO<Unit>:
5683 m : Listener & Result<&1, &1, U32 & String, Socket> <- TCP.accept(l)
5684 l2 : Listener <- conn(~h, settings, inbox, m)
5685 loop(~h, settings, inbox, l2)
5686
5687def serve.on.with(~h: Req -> IO(Res), host: String, +port: U32, +max: Nat) -> IO(Unit):
5688 do IO<Unit>:
5689 limits.validate(max)
5690 l : Listener <- IO.try(Listener, TCP.listen(host, port))
5691 +inbox : Chan(Admission.Command) <- Admission.open(Admission.Caps{128, 128, 128})
5692 loop(~h, limits(max), inbox, l)
5693
5694def serve.on(~h: Req -> IO(Res), host: String, +port: U32) -> IO(Unit):
5695 serve.on.with(~h, host, port, serve.max())
5696
5697def serve.with(~h: Req -> IO(Res), +port: U32, +max: Nat) -> IO(Unit):
5698 serve.on.with(~h, "0.0.0.0", port, max)
5699
5700def serve(~h: Req -> IO(Res), +port: U32) -> IO(Unit):
5701 serve.with(~h, port, serve.max())
5702
5703# Finite positive settings, not zero/unlimited sentinels.
5704type StartupError is Data:
5705 InvalidConfig{}
5706 BindError{code: U32, message: String}
5707
5708# Application-owned affine dependencies never enter this transport owner.
5709type Server<-C: Data> is Type:
5710 Server{listener: Listener, context: C, config: ServerConfig, admission: Chan(Admission.Command)}
5711
5712def server.config(host: String, port: U32) -> ServerConfig:
5713 ServerConfig{host, port, 16777216, 65536, 128, 128, 128, 5000, 30000, 30000, 30000}
5714
5715# Host deadline effects use signed 32-bit milliseconds.
5716def server.deadline.valid(+ms: U32) -> Bool:
5717 U32.is_gt(ms, 0) && U32.is_le(ms, 2147483647)
5718
5719def server.config.valid(config: ServerConfig) -> Bool:
5720 ServerConfig{host, port, +body, +headers, connections, requests, buffered, header_ms, body_ms, idle_ms, write_ms} = config
5721 U32.is_le(port, 65535) && U32.is_gt(body, 0) && U32.is_le(body, limits.representable()) &&
5722 U32.is_gt(headers, 0) && U32.is_le(headers, limits.representable()) &&
5723 U32.is_gt(connections, 0) && U32.is_gt(requests, 0) && U32.is_gt(buffered, 0) &&
5724 server.deadline.valid(header_ms) && server.deadline.valid(body_ms) &&
5725 server.deadline.valid(idle_ms) && server.deadline.valid(write_ms)
5726
5727def server.started(~C: Data, ~O: Type, context: C, owner: O, +config: ServerConfig, result: Result<&1, &1, U32 & String, Listener>) -> IO(O & Result<&2, &1, StartupError, Server<C>>):
5728 ServerConfig{host, port, body, headers, connections, requests, buffered, hm, bm, im, wm} = config
5729 match result:
5730 case Fail{error}:
5731 (code, message) = error
5732 IO.pure(O & Result<&2, &1, StartupError, Server<C>>, (owner, Fail{BindError{code, message}}))
5733 case Done{listener}:
5734 do IO<O & Result<&2, &1, StartupError, Server<C>>>:
5735 inbox : Chan(Admission.Command) <- Admission.open(Admission.Caps{connections, requests, buffered})
5736 return (owner, Done{Server{listener, context, config, inbox}})
5737
5738def server.start.valid(~C: Data, ~O: Type, valid: Bool, context: C, owner: O, +config: ServerConfig) -> IO(O & Result<&2, &1, StartupError, Server<C>>):
5739 match valid:
5740 case False{}:
5741 IO.pure(O & Result<&2, &1, StartupError, Server<C>>, (owner, Fail{InvalidConfig{}}))
5742 case True{}:
5743 ServerConfig{host, port, body, headers, connections, requests, buffered, header_ms, body_ms, idle_ms, write_ms} = config
5744 do IO<O & Result<&2, &1, StartupError, Server<C>>>:
5745 result : Result<&1, &1, U32 & String, Listener> <- TCP.listen(host, port)
5746 server.started(~C, ~O, context, owner, config, result)
5747
5748# Done is the readiness signal: TCP.listen has installed an accepting socket.
5749# Both branches return the preopened application owner unchanged.
5750def server.start(~C: Data, ~O: Type, context: C, owner: O, +config: ServerConfig) -> IO(O & Result<&2, &1, StartupError, Server<C>>):
5751 server.start.valid(~C, ~O, server.config.valid(config), context, owner, config)
5752
5753def server.close(~C: Data, server: Server<C>) -> IO(Unit):
5754 Server{listener, context, config, inbox} = server
5755 do IO<Unit>:
5756 Listener.close(listener)
5757 Admission.close(inbox)
5758
5759# Copyable read-only observations remain usable while server.run owns the listener.
5760type ServerStats is Data:
5761 ServerStats{inbox: Chan(Admission.Command)}
5762
5763type ServerCounts is Data:
5764 ServerCounts{connections: U32, active: U32, buffered: U32,
5765 connection_high: U32, active_high: U32, buffered_high: U32,
5766 connection_rejected: Nat, active_rejected: Nat, buffered_rejected: Nat}
5767
5768def server.observer(~C: Data, server: Server<C>) -> Server<C> & ServerStats:
5769 Server{listener, context, config, +inbox} = server
5770 (Server{listener, context, config, inbox}, ServerStats{inbox})
5771
5772def server.counts(counts: Maybe<&2, Admission.Counts>) -> Maybe<&2, ServerCounts>:
5773 match counts:
5774 case None{}:
5775 None{}
5776 case Some{Admission.Counts{c, a, b, ch, ah, bh, cr, ar, br}}:
5777 Some{ServerCounts{c, a, b, ch, ah, bh, cr, ar, br}}
5778
5779# None means accounting has closed after the listener and its retained operations.
5780# This is not a drain result or a per-response write outcome.
5781def server.stats(observer: ServerStats) -> IO(Maybe<&2, ServerCounts>):
5782 ServerStats{inbox} = observer
5783 do IO<Maybe<&2, ServerCounts>>:
5784 counts : Maybe<&2, Admission.Counts> <- Admission.snapshot(inbox)
5785 return server.counts(counts)
5786
5787def server.admitted(~C: Data, ~h: C -> Req -> IO(Res), admitted: Bool, +context: C, +config: ServerConfig, +inbox: Chan(Admission.Command), listener: Listener, socket: Socket) -> IO(Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>):
5788 match admitted:
5789 case False{}:
5790 do IO<Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>>:
5791 Socket.close(socket)
5792 return (Server{listener, context, config, inbox}, Fail{(11, "transport capacity exhausted")})
5793 case True{}:
5794 do IO<Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>>:
5795 finished : Chan(Unit) <- IO.fork(Unit, admission.done(inbox,
5796 talk(~C, ~h, context, limits.config(config), inbox, Some{Serving{(socket, TurnMore{sv.none(), False{}}), None{}}})))
5797 return (Server{listener, context, config, inbox}, Done{finished})
5798
5799def server.accepted(~C: Data, ~h: C -> Req -> IO(Res), +context: C, +config: ServerConfig, +inbox: Chan(Admission.Command), result: Listener & Result<&1, &1, U32 & String, Socket>) -> IO(Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>):
5800 (listener, got) = result
5801 match got:
5802 case Fail{error}:
5803 IO.pure(Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>, (Server{listener, context, config, inbox}, Fail{error}))
5804 case Done{socket}:
5805 do IO<Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>>:
5806 admitted : Bool <- Admission.take(inbox, 0)
5807 server.admitted(~C, ~h, admitted, context, config, inbox, listener, socket)
5808
5809# One accepting step, so the caller retains explicit listener ownership.
5810def server.accept(~C: Data, ~h: C -> Req -> IO(Res), server: Server<C>) -> IO(Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>):
5811 Server{listener, context, config, inbox} = server
5812 do IO<Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>>:
5813 result : Listener & Result<&1, &1, U32 & String, Socket> <- TCP.accept(listener)
5814 server.accepted(~C, ~h, context, config, inbox, result)
5815
5816type ServerLoop<-C: Data> is Type:
5817 ServerListening{server: Server<C>}
5818 ServerAccepted{result: Server<C> & Result<&1, &1, U32 & String, Chan(Unit)>}
5819 ServerFailed{retry: Bool, server: Server<C>, error: U32 & String}
5820
5821def error.capacity(error: U32 & String) -> Bool:
5822 (code, message) = error
5823 U32.is_eq(code, 11) && String.eq(message, "transport capacity exhausted")
5824
5825
5826# A single recursive state machine avoids recursion hidden inside a template.
5827@unsafe
5828def server.run.loop(~C: Data, ~h: C -> Req -> IO(Res), step: ServerLoop<C>) -> IO(Server<C> & (U32 & String)):
5829 match step:
5830 case ServerListening{server}:
5831 do IO<Server<C> & (U32 & String)>:
5832 result : Server<C> & Result<&1, &1, U32 & String, Chan(Unit)> <- server.accept(~C, ~h, server)
5833 server.run.loop(~C, ~h, ServerAccepted{result})
5834 case ServerAccepted{accepted}:
5835 (server, result) = accepted
5836 match result:
5837 case Fail{+error}:
5838 server.run.loop(~C, ~h, ServerFailed{error.capacity(error), server, error})
5839 case Done{finished}:
5840 do IO<Server<C> & (U32 & String)>:
5841 Chan.close(Unit, finished)
5842 server.run.loop(~C, ~h, ServerListening{server})
5843 case ServerFailed{retry, server, error}:
5844 match retry:
5845 case True{}:
5846 server.run.loop(~C, ~h, ServerListening{server})
5847 case False{}:
5848 IO.pure(Server<C> & (U32 & String), (server, error))
5849
5850def server.run(~C: Data, ~h: C -> Req -> IO(Res), server: Server<C>) -> IO(Server<C> & (U32 & String)):
5851 server.run.loop(~C, ~h, ServerListening{server})
5852
5853def serve.stream.nonempty(~S: Type, ~piece: S -> Bytes.Bytes -> IO(S & Bool), empty: Bool, state: S, b: Bytes.Bytes) -> IO(S & Bool):
5854 match empty:
5855 case True{}:
5856 IO.pure(S & Bool, (state, False{}))
5857 case False{}:
5858 piece(state, b)
5859
5860# The piece callback returns True to discard the rest of this request body.
5861def serve.stream.one(~S: Type, ~piece: S -> Bytes.Bytes -> IO(S & Bool), drop: Bool, state: S, b: Bytes.Bytes) -> IO(S & Bool):
5862 match drop:
5863 case True{}:
5864 IO.pure(S & Bool, (state, True{}))
5865 case False{}:
5866 Bytes.Bytes{+len, buf} = b
5867 serve.stream.nonempty(~S, ~piece, U32.is_eq(len, 0), state, Bytes.Bytes{len, buf})
5868
5869def serve.stream.parts(~S: Type, ~piece: S -> Bytes.Bytes -> IO(S & Bool), xs: List<&1, Bytes.Bytes>, st: S & Bool) -> IO(S & Bool):
5870 match xs:
5871 case Nil{}:
5872 IO.pure(S & Bool, st)
5873 case Con{b, rest}:
5874 (state, drop) = st
5875 do IO<S & Bool>:
5876 next : S & Bool <- serve.stream.one(~S, ~piece, drop, state, b)
5877 serve.stream.parts(~S, ~piece, rest, next)
5878
5879def serve.stream.feed(~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool), req: Req, m: Maybe<&1, S & Bool>, parts: List<&1, Bytes.Bytes>) -> IO(S & Bool):
5880 match m:
5881 case None{}:
5882 do IO<S & Bool>:
5883 state : S <- start(req)
5884 serve.stream.parts(~S, ~piece, parts, (state, False{}))
5885 case Some{st}:
5886 serve.stream.parts(~S, ~piece, parts, st)
5887
5888def serve.stream.respond(~S: Type, ~finish: S -> IO(Res), +settings: Limits, s: Socket, rest: Bytes.Bytes, +headers: Map<&2, List<&2, String>>, v11: Bool, +method: String, st: S & Bool) -> IO(Socket & Turn):
5889 (state, dropped) = st
5890 do IO<Socket & Turn>:
5891 res : Res <- finish(state)
5892 talk.send(settings, s, rest, headers, v11, String.eq(method, "HEAD"), res)
5893
5894def admission.ready(t: Turn) -> Bool & Turn:
5895 match t:
5896 case TurnReq{req, rest, v11}:
5897 (True{}, TurnReq{req, rest, v11})
5898 case TurnMore{sv, cont}:
5899 match sv:
5900 case SvHead{buf}:
5901 (False{}, TurnMore{SvHead{buf}, cont})
5902 case SvLen{req, v11, left, parts}:
5903 (True{}, TurnMore{SvLen{req, v11, left, parts}, cont})
5904 case SvChunk{req, v11, n, state, parts}:
5905 (True{}, TurnMore{SvChunk{req, v11, n, state, parts}, cont})
5906 case TurnFail{status}:
5907 (False{}, TurnFail{status})
5908 case TurnClose{}:
5909 (False{}, TurnClose{})
5910
5911def admission.give.held(held: Bool, inbox: Chan(Admission.Command)) -> IO(Unit):
5912 match held:
5913 case False{}:
5914 IO.pure(Unit, Unit{})
5915 case True{}:
5916 Admission.give(inbox, 1)
5917
5918type StreamServing<-S: Type> is Type:
5919 StreamCheck{held: Bool, connection: Serving, state: Maybe<&1, S & Bool>}
5920 StreamReady{held: Bool, ready: Bool, connection: Serving, state: Maybe<&1, S & Bool>}
5921 StreamChecked{held: Bool, admitted: Bool, connection: Serving, state: Maybe<&1, S & Bool>}
5922
5923def serve.stream.ready(~S: Type, held: Bool, socket: Socket, phase: Maybe<&2, Phase>,
5924 state: Maybe<&1, S & Bool>, result: Bool & Turn) -> StreamServing<S>:
5925 (ready, turn) = result
5926 StreamReady{held, ready, Serving{(socket, turn), phase}, state}
5927
5928def admission.stream.take(needed: Bool, inbox: Chan(Admission.Command)) -> IO(Bool):
5929 match needed:
5930 case False{}:
5931 IO.pure(Bool, True{})
5932 case True{}:
5933 Admission.take(inbox, 1)
5934
5935# One recursive state machine keeps template callbacks out of mutual recursion.
5936@unsafe
5937def serve.stream.talk(
5938 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
5939 ~finish: S -> IO(Res), +settings: Limits, +inbox: Chan(Admission.Command), step: StreamServing<S>
5940) -> IO(Unit):
5941 Limits{max, cap, hm, bm, im, wm} = settings
5942 match step:
5943 case StreamCheck{held, connection, state}:
5944 Serving{(socket, turn), phase} = connection
5945 serve.stream.talk(~S, ~start, ~piece, ~finish, settings, inbox,
5946 serve.stream.ready(~S, held, socket, phase, state, admission.ready(turn)))
5947 case StreamReady{+held, +ready, connection, state}:
5948 do IO<Unit>:
5949 admitted : Bool <- admission.stream.take(Bool.not(held) && ready, inbox)
5950 serve.stream.talk(~S, ~start, ~piece, ~finish, settings, inbox,
5951 StreamChecked{held || ready, admitted, connection, state})
5952 case StreamChecked{held, admitted, connection, m}:
5953 match admitted:
5954 case False{}:
5955 Serving{(socket, turn), phase} = connection
5956 admission.reject(socket, admission.turn.head(turn), wm)
5957 case True{}:
5958 Serving{(s, t), phase} = connection
5959 match t:
5960 case TurnClose{}:
5961 do IO<Unit>:
5962 Socket.close(s)
5963 admission.give.held(held, inbox)
5964 case TurnFail{status}:
5965 do IO<Unit>:
5966 reply_fail(s, status, wm)
5967 admission.give.held(held, inbox)
5968 case TurnReq{req, rest, v11}:
5969 Req{+method, path, +headers, body} = req
5970 do IO<Unit>:
5971 next : S & Bool <- serve.stream.feed(~S, ~start, ~piece,
5972 Req{method, path, headers, Bytes.new(0)}, m, [body])
5973 after : Socket & Turn <- serve.stream.respond(~S, ~finish, settings, s, rest, headers, v11, method, next)
5974 Admission.give(inbox, 1)
5975 serve.stream.talk(~S, ~start, ~piece, ~finish, settings, inbox,
5976 StreamCheck{False{}, Serving{after, None{}}, None{}})
5977 case TurnMore{sv, cont}:
5978 match sv:
5979 case SvHead{buf}:
5980 do IO<Unit>:
5981 received : (Socket & Turn) & Phase <- talk.recv(settings, s, SvHead{buf}, cont, phase)
5982 serve.stream.talk(~S, ~start, ~piece, ~finish, settings, inbox,
5983 StreamCheck{held, talk.state(received), m})
5984 case SvLen{req, +v11, +left, parts}:
5985 Req{+method, +path, +headers, body} = req
5986 do IO<Unit>:
5987 now : Time.Duration <- Time.mono()
5988 reading : Phase = phase.body(phase, settings, now)
5989 next : S & Bool <- serve.stream.feed(~S, ~start, ~piece,
5990 Req{method, path, headers, body}, m, List.reverse(&1, Bytes.Bytes, parts))
5991 received : (Socket & Turn) & Phase <- talk.recv(settings, s,
5992 SvLen{Req{method, path, headers, Bytes.new(0)}, v11, left, Nil{}}, cont, Some{reading})
5993 serve.stream.talk(~S, ~start, ~piece, ~finish, settings, inbox,
5994 StreamCheck{held, talk.state(received), Some{next}})
5995 case SvChunk{req, +v11, +n, st, parts}:
5996 Req{+method, +path, +headers, body} = req
5997 do IO<Unit>:
5998 now : Time.Duration <- Time.mono()
5999 reading : Phase = phase.body(phase, settings, now)
6000 next : S & Bool <- serve.stream.feed(~S, ~start, ~piece,
6001 Req{method, path, headers, body}, m, List.reverse(&1, Bytes.Bytes, parts))
6002 received : (Socket & Turn) & Phase <- talk.recv(settings, s,
6003 SvChunk{Req{method, path, headers, Bytes.new(0)}, v11, n, st, Nil{}}, cont, Some{reading})
6004 serve.stream.talk(~S, ~start, ~piece, ~finish, settings, inbox,
6005 StreamCheck{held, talk.state(received), Some{next}})
6006
6007
6008def serve.stream.conn.admitted(
6009 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool), ~finish: S -> IO(Res),
6010 admitted: Bool, +settings: Limits, +inbox: Chan(Admission.Command), l: Listener, s: Socket
6011) -> IO(Listener):
6012 match admitted:
6013 case False{}:
6014 do IO<Listener>:
6015 Socket.close(s)
6016 return l
6017 case True{}:
6018 do IO<Listener>:
6019 IO.spawn(Unit, admission.done(inbox, serve.stream.talk(~S, ~start, ~piece, ~finish, settings, inbox,
6020 StreamCheck{False{}, Serving{(s, TurnMore{sv.none(), False{}}), None{}}, None{}})))
6021 return l
6022
6023def serve.stream.conn(
6024 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
6025 ~finish: S -> IO(Res), +settings: Limits, +inbox: Chan(Admission.Command), m: Listener & Result<&1, &1, U32 & String, Socket>
6026) -> IO(Listener):
6027 (l, r) = m
6028 do IO<Listener>:
6029 s : Socket <- IO.pass(Socket, r)
6030 admitted : Bool <- Admission.take(inbox, 0)
6031 serve.stream.conn.admitted(~S, ~start, ~piece, ~finish, admitted, settings, inbox, l, s)
6032
6033@unsafe
6034def serve.stream.loop(
6035 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
6036 ~finish: S -> IO(Res), +settings: Limits, +inbox: Chan(Admission.Command), l: Listener
6037) -> IO(Unit):
6038 do IO<Unit>:
6039 m : Listener & Result<&1, &1, U32 & String, Socket> <- TCP.accept(l)
6040 l2 : Listener <- serve.stream.conn(~S, ~start, ~piece, ~finish, settings, inbox, m)
6041 serve.stream.loop(~S, ~start, ~piece, ~finish, settings, inbox, l2)
6042
6043def serve.stream.on.with(
6044 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
6045 ~finish: S -> IO(Res), host: String, +port: U32, +max: Nat
6046) -> IO(Unit):
6047 do IO<Unit>:
6048 limits.validate(max)
6049 l : Listener <- IO.try(Listener, TCP.listen(host, port))
6050 +inbox : Chan(Admission.Command) <- Admission.open(Admission.Caps{128, 128, 128})
6051 serve.stream.loop(~S, ~start, ~piece, ~finish, limits(max), inbox, l)
6052
6053def serve.stream.with(
6054 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool),
6055 ~finish: S -> IO(Res), +port: U32, +max: Nat
6056) -> IO(Unit):
6057 serve.stream.on.with(~S, ~start, ~piece, ~finish, "0.0.0.0", port, max)
6058
6059def serve.stream.started(
6060 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool), ~finish: S -> IO(Res),
6061 result: Unit & Result<&2, &1, StartupError, Server<Unit>>
6062) -> IO(Result<&2, &2, StartupError, Unit>):
6063 (owner, got) = result
6064 match got:
6065 case Fail{error}:
6066 IO.pure(Result<&2, &2, StartupError, Unit>, Fail{error})
6067 case Done{server}:
6068 Server{listener, context, config, inbox} = server
6069 do IO<Result<&2, &2, StartupError, Unit>>:
6070 serve.stream.loop(~S, ~start, ~piece, ~finish, limits.config(config), inbox, listener)
6071 return Done{Unit{}}
6072
6073def serve.stream.config(
6074 ~S: Type, ~start: Req -> IO(S), ~piece: S -> Bytes.Bytes -> IO(S & Bool), ~finish: S -> IO(Res),
6075 config: ServerConfig
6076) -> IO(Result<&2, &2, StartupError, Unit>):
6077 do IO<Result<&2, &2, StartupError, Unit>>:
6078 started : Unit & Result<&2, &1, StartupError, Server<Unit>> <- server.start(~Unit, ~Unit, Unit{}, Unit{}, config)
6079 serve.stream.started(~S, ~start, ~piece, ~finish, started)
6080
6081type WriterMode is Data:
6082 WriteKnown{left: U32}
6083 WriteChunk{}
6084 WriteNone{}
6085
6086type Writer is Type:
6087 Writer{s: Maybe<&1, Socket>, mode: WriterMode, until: Time.Duration}
6088
6089type WriteHead<-S: Type> is Type:
6090 WriteHead{status: U32, headers: Map<&2, List<&2, String>>, length: Maybe<&2, U32>, state: S}
6091
6092def writer.sent(+mode: WriterMode, +until: Time.Duration, m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Writer):
6093 (s, r) = m
6094 match r:
6095 case Fail{e}:
6096 do IO<Writer>:
6097 Socket.close(s)
6098 return Writer{None{}, mode, until}
6099 case Done{u}:
6100 IO.pure(Writer, Writer{Some{s}, mode, until})
6101
6102def writer.raw(w: Writer, b: Bytes.Bytes) -> IO(Writer):
6103 Writer{socket, +mode, +until} = w
6104 match socket:
6105 case None{}:
6106 IO.pure(Writer, Writer{None{}, mode, until})
6107 case Some{s}:
6108 do IO<Writer>:
6109 sent : Socket & Result<&1, &1, U32 & String, Unit> <- bounded.send(s, b, until)
6110 writer.sent(mode, until, sent)
6111
6112def writer.chunk(s: Socket, b: Bytes.Bytes, +len: U32, until: Time.Duration) -> IO(Writer):
6113 do IO<Writer>:
6114 head : Writer <- writer.raw(Writer{Some{s}, WriteChunk{}, until}, Bytes.from_string(hex(len) ++ "\r\n"))
6115 data : Writer <- writer.raw(head, b)
6116 writer.raw(data, Bytes.from_string("\r\n"))
6117
6118def writer.known(ok: Bool, s: Socket, +left: U32, len: U32, b: Bytes.Bytes, +until: Time.Duration) -> IO(Writer):
6119 match ok:
6120 case False{}:
6121 do IO<Writer>:
6122 Socket.close(s)
6123 return Writer{None{}, WriteKnown{left}, until}
6124 case True{}:
6125 writer.raw(Writer{Some{s}, WriteKnown{(left - len : U32)}, until}, b)
6126
6127def writer.chunk.go(empty: Bool, s: Socket, b: Bytes.Bytes, len: U32, until: Time.Duration) -> IO(Writer):
6128 match empty:
6129 case True{}:
6130 IO.pure(Writer, Writer{Some{s}, WriteChunk{}, until})
6131 case False{}:
6132 writer.chunk(s, b, len, until)
6133
6134def writer.write.mode(s: Socket, mode: WriterMode, b: Bytes.Bytes, until: Time.Duration) -> IO(Writer):
6135 match mode:
6136 case WriteNone{}:
6137 IO.pure(Writer, Writer{Some{s}, WriteNone{}, until})
6138 case WriteKnown{+left}:
6139 Bytes.Bytes{+len, buf} = b
6140 writer.known(U32.is_le(len, left), s, left, len, Bytes.Bytes{len, buf}, until)
6141 case WriteChunk{}:
6142 Bytes.Bytes{+len, buf} = b
6143 writer.chunk.go(U32.is_zero(len), s, Bytes.Bytes{len, buf}, len, until)
6144
6145def writer.write(w: Writer, b: Bytes.Bytes) -> IO(Writer):
6146 Writer{socket, mode, until} = w
6147 match socket:
6148 case None{}:
6149 IO.pure(Writer, Writer{None{}, mode, until})
6150 case Some{s}:
6151 writer.write.mode(s, mode, b, until)
6152
6153def writer.result(w: Writer) -> Maybe<&1, Socket>:
6154 Writer{socket, mode, until} = w
6155 socket
6156
6157def writer.finish.known(complete: Bool, s: Socket) -> IO(Maybe<&1, Socket>):
6158 match complete:
6159 case True{}:
6160 IO.pure(Maybe<&1, Socket>, Some{s})
6161 case False{}:
6162 do IO<Maybe<&1, Socket>>:
6163 Socket.close(s)
6164 return None{}
6165
6166def writer.finish.mode(s: Socket, mode: WriterMode, until: Time.Duration) -> IO(Maybe<&1, Socket>):
6167 match mode:
6168 case WriteNone{}:
6169 IO.pure(Maybe<&1, Socket>, Some{s})
6170 case WriteKnown{left}:
6171 writer.finish.known(U32.is_zero(left), s)
6172 case WriteChunk{}:
6173 do IO<Maybe<&1, Socket>>:
6174 end : Writer <- writer.raw(Writer{Some{s}, WriteChunk{}, until}, Bytes.from_string("0\r\n\r\n"))
6175 return writer.result(end)
6176
6177def writer.finish(w: Writer) -> IO(Maybe<&1, Socket>):
6178 Writer{socket, mode, until} = w
6179 match socket:
6180 case None{}:
6181 IO.pure(Maybe<&1, Socket>, None{})
6182 case Some{s}:
6183 writer.finish.mode(s, mode, until)
6184
6185def writer.header.one(m: Map<&2, List<&2, String>>, +key: String, vs: List<&2, String>, framing: Bool) -> Map<&2, List<&2, String>>:
6186 match framing:
6187 case True{}:
6188 m
6189 case False{}:
6190 Map.set(&2, List<&2, String>, m, key, vs)
6191
6192def writer.headers(xs: List<&2, Sigma<&2, &2, String, _ => List<&2, String>>>, m: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
6193 match xs:
6194 case Nil{}:
6195 m
6196 case (k, vs) <> rest:
6197 +key = String.to_lower(k)
6198 +framing = Bool.or(String.eq(key, "content-length"), String.eq(key, "transfer-encoding"))
6199 writer.headers(rest, writer.header.one(m, key, vs, framing))
6200
6201def writer.plan.body(headers: Map<&2, List<&2, String>>, length: Maybe<&2, U32>) -> WriterMode & Map<&2, List<&2, String>>:
6202 match length:
6203 case Some{+n}:
6204 (WriteKnown{n}, set(headers, "content-length", U32.show(n)))
6205 case None{}:
6206 (WriteChunk{}, set(headers, "transfer-encoding", "chunked"))
6207
6208def writer.plan(nobody: Bool, headers: Map<&2, List<&2, String>>, length: Maybe<&2, U32>) -> WriterMode & Map<&2, List<&2, String>>:
6209 match nobody:
6210 case True{}:
6211 (WriteNone{}, headers)
6212 case False{}:
6213 writer.plan.body(headers, length)
6214
6215def serve.write.after(settings: Limits, keep: Bool, rest: Bytes.Bytes, socket: Maybe<&1, Socket>) -> Maybe<&1, Socket & Turn>:
6216 match socket:
6217 case None{}:
6218 None{}
6219 case Some{s}:
6220 Some{talk.after.keep(keep, settings, rest, s)}
6221
6222def serve.write.finish(settings: Limits, keep: Bool, rest: Bytes.Bytes, w: Writer) -> IO(Maybe<&1, Socket & Turn>):
6223 do IO<Maybe<&1, Socket & Turn>>:
6224 done : Maybe<&1, Socket> <- writer.finish(w)
6225 return serve.write.after(settings, keep, rest, done)
6226
6227def serve.write.body(~S: Type, ~write: S -> Writer -> IO(Writer), settings: Limits, keep: Bool, rest: Bytes.Bytes, state: S, s: Socket, mode: WriterMode, suppress: Bool, until: Time.Duration) -> IO(Maybe<&1, Socket & Turn>):
6228 match suppress:
6229 case True{}:
6230 serve.write.finish(settings, keep, rest, Writer{Some{s}, WriteNone{}, until})
6231 case False{}:
6232 do IO<Maybe<&1, Socket & Turn>>:
6233 w : Writer <- write(state, Writer{Some{s}, mode, until})
6234 serve.write.finish(settings, keep, rest, w)
6235
6236def serve.write.open(~S: Type, ~write: S -> Writer -> IO(Writer), settings: Limits, keep: Bool, rest: Bytes.Bytes, state: S, mode: WriterMode, suppress: Bool, until: Time.Duration, m: Socket & Result<&1, &1, U32 & String, Unit>) -> IO(Maybe<&1, Socket & Turn>):
6237 (s, r) = m
6238 match r:
6239 case Fail{e}:
6240 do IO<Maybe<&1, Socket & Turn>>:
6241 Socket.close(s)
6242 return None{}
6243 case Done{u}:
6244 serve.write.body(~S, ~write, settings, keep, rest, state, s, mode, suppress, until)
6245
6246def writer.connection(keep: Bool, headers: Map<&2, List<&2, String>>) -> Map<&2, List<&2, String>>:
6247 match keep:
6248 case True{}:
6249 headers
6250 case False{}:
6251 set(headers, "connection", "close")
6252
6253def serve.write.send.plan(
6254 ~S: Type, ~write: S -> Writer -> IO(Writer), +settings: Limits, s: Socket, rest: Bytes.Bytes,
6255 +keep: Bool, +head: Bool, +status: U32, state: S, plan: WriterMode & Map<&2, List<&2, String>>
6256) -> IO(Maybe<&1, Socket & Turn>):
6257 Limits{max, cap, hm, bm, im, wm} = settings
6258 (mode, headers) = plan
6259 sent_headers = writer.connection(keep, headers)
6260 do IO<Maybe<&1, Socket & Turn>>:
6261 now : Time.Duration <- Time.mono()
6262 +until : Time.Duration = Time.Duration.add(now, Time.Duration.of_ms(wm))
6263 sent : Socket & Result<&1, &1, U32 & String, Unit> <-
6264 bounded.send(s, Bytes.from_string(response(status, sent_headers, "")), until)
6265 serve.write.open(~S, ~write, settings, keep, rest, state, mode,
6266 frame.nobody(status, head), until, sent)
6267
6268def serve.write.send(
6269 ~S: Type, ~write: S -> Writer -> IO(Writer), settings: Limits, s: Socket, rest: Bytes.Bytes,
6270 +headers: Map<&2, List<&2, String>>, v11: Bool, +head: Bool, out: WriteHead<S>
6271) -> IO(Maybe<&1, Socket & Turn>):
6272 WriteHead{+status, rh, length, state} = out
6273 +normalized = writer.headers(Map.to_list(&2, List<&2, String>, rh), empty())
6274 +keep = serve.keep(headers, v11, status, normalized)
6275 serve.write.send.plan(~S, ~write, settings, s, rest, keep, head, status, state,
6276 writer.plan(frame.nobody(status, False{}), normalized, length))
6277
6278def admission.write(
6279 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer),
6280 admitted: Bool, +inbox: Chan(Admission.Command), +settings: Limits,
6281 s: Socket, req: Req, rest: Bytes.Bytes, v11: Bool
6282) -> IO(Maybe<&1, Socket & Turn>):
6283 match admitted:
6284 case False{}:
6285 Limits{max, cap, hm, bm, im, wm} = settings
6286 do IO<Maybe<&1, Socket & Turn>>:
6287 admission.reject(s, admission.head(req), wm)
6288 return None{}
6289 case True{}:
6290 Req{+method, path, +headers, body} = req
6291 do IO<Maybe<&1, Socket & Turn>>:
6292 out : WriteHead<S> <- start(Req{method, path, headers, body})
6293 after : Maybe<&1, Socket & Turn> <- serve.write.send(~S, ~write, settings, s, rest, headers, v11, String.eq(method, "HEAD"), out)
6294 Admission.give(inbox, 1)
6295 return after
6296
6297@unsafe
6298def serve.write.talk(
6299 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer),
6300 +settings: Limits, +inbox: Chan(Admission.Command), st: Maybe<&1, Serving>
6301) -> IO(Unit):
6302 Limits{max, cap, hm, bm, im, wm} = settings
6303 match st:
6304 case None{}:
6305 IO.pure(Unit, Unit{})
6306 case Some{Serving{(s, t), phase}}:
6307 match t:
6308 case TurnMore{sv, cont}:
6309 do IO<Unit>:
6310 received : (Socket & Turn) & Phase <- talk.recv(settings, s, sv, cont, phase)
6311 serve.write.talk(~S, ~start, ~write, settings, inbox, Some{talk.state(received)})
6312 case TurnReq{req, rest, v11}:
6313 do IO<Unit>:
6314 admitted : Bool <- Admission.take(inbox, 1)
6315 after : Maybe<&1, Socket & Turn> <- admission.write(~S, ~start, ~write, admitted, inbox, settings, s, req, rest, v11)
6316 serve.write.talk(~S, ~start, ~write, settings, inbox, serve.write.state(after))
6317 case TurnFail{status}:
6318 reply_fail(s, status, wm)
6319 case TurnClose{}:
6320 Socket.close(s)
6321
6322def serve.write.conn.admitted(
6323 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer),
6324 admitted: Bool, +settings: Limits, +inbox: Chan(Admission.Command), l: Listener, s: Socket
6325) -> IO(Listener):
6326 match admitted:
6327 case False{}:
6328 do IO<Listener>:
6329 Socket.close(s)
6330 return l
6331 case True{}:
6332 do IO<Listener>:
6333 IO.spawn(Unit, admission.done(inbox, serve.write.talk(~S, ~start, ~write, settings, inbox,
6334 Some{Serving{(s, TurnMore{sv.none(), False{}}), None{}}})))
6335 return l
6336
6337def serve.write.conn(
6338 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer),
6339 +settings: Limits, +inbox: Chan(Admission.Command), m: Listener & Result<&1, &1, U32 & String, Socket>
6340) -> IO(Listener):
6341 (l, r) = m
6342 do IO<Listener>:
6343 s : Socket <- IO.pass(Socket, r)
6344 admitted : Bool <- Admission.take(inbox, 0)
6345 serve.write.conn.admitted(~S, ~start, ~write, admitted, settings, inbox, l, s)
6346
6347@unsafe
6348def serve.write.loop(
6349 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer),
6350 +settings: Limits, +inbox: Chan(Admission.Command), l: Listener
6351) -> IO(Unit):
6352 do IO<Unit>:
6353 m : Listener & Result<&1, &1, U32 & String, Socket> <- TCP.accept(l)
6354 l2 : Listener <- serve.write.conn(~S, ~start, ~write, settings, inbox, m)
6355 serve.write.loop(~S, ~start, ~write, settings, inbox, l2)
6356
6357def serve.write.on.with(
6358 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer),
6359 host: String, +port: U32, +max: Nat
6360) -> IO(Unit):
6361 do IO<Unit>:
6362 limits.validate(max)
6363 l : Listener <- IO.try(Listener, TCP.listen(host, port))
6364 +inbox : Chan(Admission.Command) <- Admission.open(Admission.Caps{128, 128, 128})
6365 serve.write.loop(~S, ~start, ~write, limits(max), inbox, l)
6366
6367def serve.write.with(
6368 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer),
6369 +port: U32, +max: Nat
6370) -> IO(Unit):
6371 serve.write.on.with(~S, ~start, ~write, "0.0.0.0", port, max)
6372
6373def serve.write.started(
6374 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer),
6375 result: Unit & Result<&2, &1, StartupError, Server<Unit>>
6376) -> IO(Result<&2, &2, StartupError, Unit>):
6377 (owner, got) = result
6378 match got:
6379 case Fail{error}:
6380 IO.pure(Result<&2, &2, StartupError, Unit>, Fail{error})
6381 case Done{server}:
6382 Server{listener, context, config, inbox} = server
6383 do IO<Result<&2, &2, StartupError, Unit>>:
6384 serve.write.loop(~S, ~start, ~write, limits.config(config), inbox, listener)
6385 return Done{Unit{}}
6386
6387def serve.write.config(
6388 ~S: Type, ~start: Req -> IO(WriteHead<S>), ~write: S -> Writer -> IO(Writer), config: ServerConfig
6389) -> IO(Result<&2, &2, StartupError, Unit>):
6390 do IO<Result<&2, &2, StartupError, Unit>>:
6391 started : Unit & Result<&2, &1, StartupError, Server<Unit>> <- server.start(~Unit, ~Unit, Unit{}, Unit{}, config)
6392 serve.write.started(~S, ~start, ~write, started)